escape results from the CPAN

AnyEvent-MSN

view release on metacpan or search on metacpan

            </ServiceFilter>
        </FindMembership>
    </soap:Body>
</soap:Envelope>
XML
        sub {
            my $contacts = shift;

            # XXX - Do something with these contacts
            #...
        }
    );
    $s->_soap_request(
        'https://local-bay.contacts.msn.com/abservice/abservice.asmx',
        {   'content-type' => 'text/xml; charset=utf-8',
            SOAPAction =>
                '"http://www.msn.com/webservices/AddressBook/ABFindContactsPaged"'
        },
        sprintf(<<'XML', $token),
<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
    <soap:Header>
        <ABApplicationHeader xmlns="http://www.msn.com/webservices/AddressBook">
            <ApplicationId>3794391A-4816-4BAC-B34B-6EC7FB5046C6</ApplicationId>
            <IsMigration>false</IsMigration>
            <PartnerScenario>Initial</PartnerScenario>
        </ABApplicationHeader>
        <ABAuthHeader xmlns="http://www.msn.com/webservices/AddressBook">
            <TicketToken>%s</TicketToken>
            <ManagedGroupRequest>false</ManagedGroupRequest>
        </ABAuthHeader>
    </soap:Header>
    <soap:Body>
        <ABFindall xmlns="http://www.msn.com/webservices/AddressBook">
            <abID>00000000-0000-0000-0000-000000000000</abID>
        </ABFindall>
        <ABFindContactsPaged xmlns="http://www.msn.com/webservices/AddressBook">
            <extendedContent>AB AllGroups CircleResult</extendedContent>
            <abView>MessengerClient8</abView>
            <filterOptions>
                <DeltasOnly>false</DeltasOnly>
                <ContactFilter>
                    <IncludeShellContacts>true</IncludeShellContacts>
                    <IncludeHiddenContacts>true</IncludeHiddenContacts>
                </ContactFilter>
                <LastChanged>0001-01-01T00:00:00.00-08:00</LastChanged>
            </filterOptions>
            <pageContext>
                <PageSize>1500</PageSize>
                <Direction>Forward</Direction>
            </pageContext>
        </ABFindContactsPaged>
    </soap:Body>
</soap:Envelope>
XML
        sub {
            my $contacts = shift;

            # XXX - Do something with these contacts
            $s->_set_contacts($contacts);
            my $ticket
                = __html_unescape(
                    $s->contacts->{'soap:Body'}{'ABFindContactsPagedResponse'}
                        {'ABFindContactsPagedResult'}{'CircleResult'}
                        {'CircleTicket'});
            $s->send('USR %d SHA A %s',
                     $s->tid, MIME::Base64::encode_base64($ticket, ''));

            #
            my $x =    # XML modules get it wrong if we only have 1 buddy
                $s->contacts->{'soap:Body'}{'ABFindContactsPagedResponse'}
                {'ABFindContactsPagedResult'}{'Contacts'}{'Contact'};
            $x = [$x] if ref $x ne 'ARRAY';
            $s->add_temporary_contact(map { $_->{contactInfo}{passportName} }
                                      @$x);
        }
    );
}

sub _handle_packet_rml {
    my ($s, $tid, $ok) = @_;

=begin comment
        use Data::Printer;
        dd @_;
=cut
    ...;
}

sub _handle_packet_sbs {
    my $s = shift;

    # No one seems to know what this is. Official client ignores it?
}

sub _handle_packet_sdg {
    my ($s, $tid, $size, $head, $body) = @_;

    #dd [$head, $body];
    given ($head->{'Message-Type'}) {
        when ('Text') {
            given ($head->{'Service-Channel'}) {
                $s->_trigger_im($head, $body) when 'IM/Online';
                $s->_trigger_im($head, $body) when undef;
                warn 'Offline Msg!' when 'IM/Offline';
                default {
                    warn 'unknown IM!!!!!'
                }
            }
        }
        $s->_trigger_nudge($head) when 'Nudge';
        when ('Wink')           { warn 'Wink' }
        when ('CustomEmoticon') { warn 'Custom Emoticon' }
        when ('Control/Typing') { warn 'Typing!' }
        when ('Data') {
            my ($header, $packet, $footer);
            if ($head->{To} !~ m[{.+}]) {

# 0                   1                   2                   3                   4                   5
# 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
# |  SID  |  ID   | Data Offset   | Total Size    |Length | Flags | AckID |AckUID | Ack Data Size |DATA....

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

            <wst:RequestSecurityToken Id="RST%d">
                <wst:RequestType>http://schemas.xmlsoap.org/ws/2004/04/security/trust/Issue</wst:RequestType>
                <wsp:AppliesTo>
                    <wsa:EndpointReference>
                        <wsa:Address>%s</wsa:Address>
                    </wsa:EndpointReference>
                </wsp:AppliesTo>
                <wsse:PolicyReference URI="%s"></wsse:PolicyReference>
            </wst:RequestSecurityToken>
TOKEN
        $s->_soap_request(
            ($s->passport =~ m[\@msn.com$]i
             ?
                 'https://msnia.login.live.com/pp550/RST.srf'
             : 'https://login.live.com/RST.srf'
            ),
            {},    # headers
            sprintf(<<'XML', $s->password, $s->passport, join '', @tokens),
<Envelope xmlns="http://schemas.xmlsoap.org/soap/envelope/" xmlns:wsse="http://schemas.xmlsoap.org/ws/2003/06/secext" xmlns:saml="urn:oasis:names:tc:SAML:1.0:assertion" xmlns:wsp="http://schemas.xmlsoap.org/ws/2002/12/policy" xmlns:wsu="http://docs.o...
    <Header>
        <wsse:Security>
            <wsse:UsernameToken Id="user">
                <wsse:Password>%s</wsse:Password>
                <wsse:Username>%s</wsse:Username>
            </wsse:UsernameToken>
        </wsse:Security>
        <ps:AuthInfo Id="PPAuthInfo" xmlns:ps="http://schemas.microsoft.com/Passport/SoapServices/PPCRL">
            <ps:Cookies></ps:Cookies>
            <ps:UIVersion>1</ps:UIVersion>
            <ps:HostingApp>{7108E71A-9926-4FCB-BCC9-9A9D3F32E423}</ps:HostingApp>
            <ps:BinaryVersion>4</ps:BinaryVersion>
            <ps:RequestParams>AQAAAAIAAABsYwQAAAAxMDMz</ps:RequestParams>
        </ps:AuthInfo>
    </Header>
    <Body>
        <ps:RequestMultipleSecurityTokens Id="RSTS" xmlns:ps="http://schemas.microsoft.com/Passport/SoapServices/PPCRL">
%s        </ps:RequestMultipleSecurityTokens>
    </Body>
</Envelope>
XML
            sub {
                my $d = shift;
                for my $token (
                        @{  $d->{'S:Body'}
                                {'wst:RequestSecurityTokenResponseCollection'}
                                {'wst:RequestSecurityTokenResponse'}
                        }
                    )
                {   $s->_add_auth_token(
                            $token->{'wsp:AppliesTo'}{'wsa:EndpointReference'}
                                {'wsa:Address'},
                            $token
                    );
                }

                #
                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'))

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

 </soap:Body>
</soap:Envelope>
XML
        sub {

            #dd @_;
            $s->remove_temporary_contact($contact);
            ...;
        }
    );
}

# Remove a contact:
# RML 12 112\r\n
# <ml><d n="penilecolada.com"><c n="junk" t="1"><s l="3" n="IM" /><s l="3" n="PE" /><s l="3" n="PF"/></c></d></ml>
sub add_temporary_contact {
    my $s = shift;
    my %contacts;
    for my $contact (@_) {
        my ($user, $domain) = split /\@/, $contact, 2;
        push @{$contacts{$domain}}, $user;
    }
    my $data = sprintf '<ml%s>%s</ml>', ($s->connected ? '' : ' l="1"'),
        join '', map {
        sprintf '<d n="%s">%s</d>', $_, join '', map {
            sprintf '<c n="%s" t="1">%s</c>', $_, join '',
                map {"<s l='3' n='$_' />"}
                qw[IM PE PF]
            } sort @{$contacts{$_}}
        } sort keys %contacts;
    my $tid = $s->tid;
    $s->send("ADL %d %d\r\n%s", $tid, length($data), $data);
    $tid;
}

sub remove_buddy {
    my $s = shift;
    my $data = sprintf <<'', reverse split '@', shift, 2;
<ml>
    <d n="%s">
        <c n="%s" t="1">
            <s l="3" n="IM" />
            <s l="3" n="PE" />
            <s l="3" n="PF" />
        </c>
    </d>
</ml>

    my $tid = $s->tid;
    $s->send("RML %d %d\r\n%s", $tid, length($data), $data);
    $tid;
}
after set_status => sub {
    my ($s, $status) = @_;
    my $body = sprintf '<user>' . '<s n="PE">
            <UserTileLocation>0</UserTileLocation><FriendlyName>%s</FriendlyName><PSM>%s</PSM><RUM></RUM><RLT>0</RLT></s>'
        . '<s n="IM"><Status>%s</Status><CurrentMedia></CurrentMedia></s>'
        . '<sep n="PD"><ClientType>1</ClientType><EpName>%s</EpName><Idle>false</Idle><State>%s</State></sep>'
        . '<sep n="PE" epid="%s"><VER>MSNMSGR:15.4.3508.1109</VER><TYP>1</TYP><Capabilities>2952790016:557056</Capabilities></sep>'
        . '<sep n="IM"><Capabilities>2953838624:132096</Capabilities></sep>'
        . '</user>', __html_escape($s->friendly_name),
        __html_escape($s->personal_message),
        $status,
        __html_escape($s->location), $status, $s->guid;
    my $out
        = sprintf
        qq[To: 1:%s\r\nRouting: 1.0\r\nFrom: 1:%s;epid=%s\r\n\r\nStream: 1\r\nFlags: ACK\r\nReliability: 1.0\r\n\r\nContent-Length: %d\r\nContent-Type: application/user+xml\r\nPublication: 1.0\r\nUri: /user\r\n\r\n%s],
        $s->passport,
        $s->passport, $s->guid, length($body), $body;
    $s->send("PUT %d %d\r\n%s", $s->tid, length($out), $out);
};

# Testing/Incomplete stuff
sub create_group_chat {
    my $s    = shift;
    my $body = '';      # For now.
    my $out
        = sprintf
        qq[To: 10:00000000-0000-0000-0000-000000000000\@live.com\r\nRouting: 1.0\r\nFrom: 1:%s;epid=%s\r\n\r\nStream: 1\r\nFlags: ACK\r\nReliability: 1.0\r\n\r\nContent-Length: %d\r\nContent-Type: application/multiparty+xml\r\nPublication: 1.0\r\nUri...
        $s->passport, $s->guid, length($body), $body;
    $s->send("PUT %d %d\r\n%s", $s->tid, length($out), $out);
}

# Random private methods
sub _parse_xml {
    my ($s, $data) = @_;
    state $xml_twig //= XML::Twig->new();
    my $xml = {};
    use Carp;

=begin comment Carp::confess('...') if ! length $data ;
=cut
    try {
        $xml_twig->parse($data);
        $xml = $xml_twig->simplify(keyattr => [qw[type id value]]);
    }
    catch { $s->_trigger_fatal_error(qq[parsing XML: $_]) };
    $xml;
}

# Non-OOP utility functions
sub __html_escape {
    my $x = shift;
    $x =~ s[&][&amp;]sg;
    $x =~ s[<][&lt;]sg;
    $x =~ s[>][&gt;]sg;
    $x =~ s["][&quot;]sg;
    $x;
}

sub __html_unescape {
    my $x = shift;
    $x =~ s[&lt;][<]sg;
    $x =~ s[&gt;][>]sg;
    $x =~ s[&quot;]["]sg;
    $x =~ s[&amp;][&]sg;
    $x;
}

#
__PACKAGE__->meta->make_immutable();
no Moose;
1;

=pod

=head1 NAME

AnyEvent::MSN - Simple, Less Annoying Client for Microsoft's Windows Live Messenger Network

=head1 Synopsis

    use AnyEvent::MSN;
    my $msn = AnyEvent::MSN->new(
        passport => 'you@hotmail.com',
        password => 'sekrit',
        on_im => sub { # Simiple echo bot
            my ($msn, $head, $body) = @_;
            $msn->im($head->{From}, $body)
        }
    );
    AnyEvent->condvar->recv;

=head1 Description

TODO

=head1 Methods

Well, the public bits anyway...

=over

=item new

    my $msn = AnyEvent::MSN->new(passport => 'you@hotmail.com', password => 'password');

This constructs a new L<AnyEvent::MSN> object. Required parameters are:

=over

=item C<passport>

This is an email address.

Microsoft calls them C<passport>s in some documentation, C<username> and plain
ol' C<address> in other places. For future versions of the API (think 1.0),
I'm leaning towards the least awkward: C<username>. Just... keep that in mind.

=item C<password>

( run in 1.869 second using v1.01-cache-2.11-cpan-39bf76dae61 )