view release on metacpan or  search on metacpan

lib/AnyEvent/MSN.pm  view on Meta::CPAN

#use Data::Printer;
sub DEMOLISH {
    my $s = shift;
    $s->handle->destroy if $s->_has_handle && $s->handle;
    $s->_clear_soap_requests;
}

# Basic connection info
has host => (is      => 'ro',
             writer  => '_set_host',
             isa     => 'Str',
             default => 'messenger.hotmail.com'
);
has port => (is      => 'ro',
             writer  => '_set_port',
             isa     => 'Int',
             default => 1863
);

# Authentication info from user
has passport => (
    is       => 'ro',
    isa      => 'AnyEvent::MSN::Types::Passport',
    required => 1,
    handles  => {
        username => sub {
            shift->passport =~ m[^(.+)\@.+$];
            $1;
        },
        userhost => sub { shift->passport =~ m[^.+\@(.+)$]; $1 }
    }
);
has password => (is => 'ro', isa => 'Str', required => 1);

# Extra stuff from user
has [qw[friendly_name personal_message]] =>
    (is => 'ro', isa => 'Str', default => '');
has status => (
         is      => 'ro',
         isa     => 'AnyEvent::MSN::Types::OnlineStatus',
         default => 'NLN',
         writer  => 'set_status'                            # exposed publicly
);

# Client info for MSNP21
has protocol_version => (
    is  => 'ro',
    isa => subtype(
        as 'Str' => where {m[^(?:MSNP\d+\s*)+$]} => message {
            'Protocol versions look like: MSNP18 MSNP21';
        }
    ),
    writer  => '_set_protocol_version',
    clearer => '_reset_protocol_version',
    default => 'MSNP21',
    lazy    => 1
);
map { has $_->[0] => (is => 'ro', isa => 'Str', default => $_->[1]) }
    [qw[product_id PROD0120PW!CCV9@]],
    [qw[product_key C1BX{V4W}Q3*10SM]],
    [qw[locale_id 0x0409]],
    [qw[os_type winnt]],
    [qw[os_ver 6.1.1]],
    [qw[arch i386]],
    [qw[client_name MSNMSGR]],
    [qw[client_version 15.4.3508.1109]],
    [qw[client_string MSNMSGR]];
has guid => (
    is     => 'ro',
    => isa => subtype(
        as 'Str' => where {
            my $hex = qr[[\da-f]];
            m[{$hex{8}(?:-$hex{4}){3}-$hex{12}}$];
        } => message {
            'Malformed GUID. Should look like: {12345678-abcd-1234-abcd-123456789abc}';
        }
    ),
    builder => '_build_guid'
);

sub _build_guid {
    state $r //= sub {
        join '', map { ('a' .. 'f', 0 .. 9)[rand 15] } 1 .. shift;
    };
    sprintf '{%8s-%4s-%4s-%4s-%12s}', $r->(8), $r->(4), $r->(4), $r->(4),
        $r->(12);
}
has location => (is => 'ro', isa => 'Str', default => 'Perl/AnyEvent::MSN');

# Internals
has handle => (
    is  => 'ro',
    isa => 'Object',

    # weak_ref  => 1,
    predicate => '_has_handle',
    writer    => '_set_handle',
    clearer   => '_reset_handle',
    handles   => {
        send => sub {
            my $s = shift;
            $s->handle->push_write('AnyEvent::MSN::Protocol' => @_)
                if $s->_has_handle;    # XXX - Else mention it...
            }
    }
);
has tid => (is      => 'ro',
            isa     => 'Int',
            lazy    => 1,
            clearer => '_reset_tid',
            builder => '_build_tid',
            traits  => ['Counter'],
            handles => {'_inc_tid' => 'inc'}
);
sub _build_tid {0}
after tid => sub { shift->_inc_tid };    # Auto inc
has ping_timer => (is     => 'ro',
                   isa    => 'Ref',                     # AE::timer
                   writer => '_set_ping_timer'
);

lib/AnyEvent/MSN.pm  view on Meta::CPAN

                    );
                }

                #
                if ($policy =~ m[MBI]) {
                    my $token = $s->auth_token('messengerclear.live.com')
                        ;    # or http://Passport.NET/tb
                    my $token_
                        = __html_escape($token->{'wst:RequestedSecurityToken'}
                                     {'wsse:BinarySecurityToken'}{'content'});
                    $s->send('USR %d SSO S %s %s %s',
                             $s->tid,
                             $token->{'wst:RequestedSecurityToken'}
                                 {'wsse:BinarySecurityToken'}{'content'},
                             AnyEvent::MSN::Protocol::SSO(
                                           $nonce,
                                           $token->{'wst:RequestedProofToken'}
                                               {'wst:BinarySecret'}
                             ),
                             $s->guid
                    );
                }
                elsif ($policy =~ m[^\?]) {
                    ...;
                }
            }
        );
    }
    elsif ($subtype eq 'OK') {

        # XXX - logged in okay. What now?
    }
    else {
        ...;
    }
}

sub _handle_packet_ubx {    # Buddy has changed something
    my ($s, $passport, $len, $payload) = @_;
    my $xml = $s->_parse_xml($payload);
    if ($len == 0 && $passport eq '1:' . $s->passport) {
    }
    else {

        #dd $xml;
        my ($user) = ($passport =~ m[:(.+)$]);
        $s->_add_temporary_contact($user, $xml);
    }
}

sub _handle_packet_uux {    # ACK for UUX
}

sub _handle_packet_ver {    # Negotiated protocol version
    my ($s, $tid, $r) = @_;
    $s->_set_protocol_version($r);

    # Send basic client info
    $s->send('CVR %d %s %s %s %s %s %s %s %s%s',
             $s->tid,
             $s->locale_id,
             $s->os_type,
             $s->os_ver,
             $s->arch,
             $s->client_name,
             $s->client_version,
             $s->client_string,
             $s->passport,
             (' ' . ($s->_has_redirect ? $s->redirect : ' 0'))
    );
}

sub _handle_packet_xfr {    # Transver to another switchboard
    my $s = shift;
    my ($tid, $type, $addr, $u, $d, $redirect) = @_;
    $s->send('OUT');
    $s->handle->destroy;
    my ($host, $port) = ($addr =~ m[^(.+):(\d+)$]);
    $s->_set_host($host);
    $s->_set_port($port);
    $s->_set_redirect($redirect);
    $s->connect;
}

# SOAP client
has soap_requests => (isa     => 'HashRef[AnyEvent::Util::guard]',
                      traits  => ['Hash'],
                      handles => {_add_soap_request    => 'set',
                                  _del_soap_request    => 'delete',
                                  _clear_soap_requests => 'clear'
                      }
);

sub _soap_request {
    my ($s, $uri, $headers, $content, $cb) = @_;
    my %headers = (
           'user-agent'   => 'MSNPM 1.0',
           'content-type' => 'application/soap+xml; charset=utf-8; action=""',
           'Expect'       => '100-continue',
           'connection'   => 'Keep-Alive'
    );

    #warn $content;
    @headers{keys %$headers} = values %$headers;
    $s->_add_soap_request(
        $uri,
        AnyEvent::HTTP::http_request(
            POST       => $uri,
            headers    => \%headers,
            timeout    => 15,
            persistent => 1,
            body       => $content,
            sub {
                my ($body, $hdr) = @_;
                my $xml = $s->_parse_xml($body);
                $s->_del_soap_request($uri);
                return $cb->($xml)
                    if $hdr->{Status} =~ /^2/
                        && !defined $xml->{'S:Fault'};

                #dd $hdr;