charset results from the CPAN

charset

AnyEvent-MSN

view release on metacpan or search on metacpan

        when ('/user') {
            given ($type) {
                when ('PUT') {
                    my $xml = $s->_parse_xml($data);
                    if ((!defined $headers->{By})
                        && $headers->{From} eq '1:' . $s->passport)
                    {    # Without guid
                        $s->set_status($s->status)
                            ;    # Not fully logged in until sent
                        $s->_set_connected();
                        $s->_trigger_connect;
                    }
                    else {
                        $s->_trigger_user_notification($headers, $xml);
                    }
                }
                when ('DEL') {

                    # Remove from list
                }
                default {...}
            }
        }
        when ('/circle') {
            my $xml = $s->_parse_xml($data);
            $s->_trigger_create_circle($headers, $xml);
        }
        default {...}
    }
}
sub _handle_packet_not { my $s = shift; }
sub _handle_packet_out { my $s = shift; }

sub _handle_packet_put {
    my $s = shift;

    # ACK for our PUT packets
}

sub _handle_packet_qng {
    my ($s, $next) = @_;

    # PONG in reply to our PNG
    $s->_set_ping_timer(AE::timer $next, $next, sub { $s->send('PNG') });
}

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

    #
    my $token = $s->auth_token('contacts.msn.com')
        ->{'wst:RequestedSecurityToken'}{'wsse:BinarySecurityToken'}{content};
    $token =~ s/&/&amp;/sg;
    $token =~ s/</&lt;/sg;
    $token =~ s/>/&gt;/sg;
    $token =~ s/"/&quot;/sg;

    # Reply to good challenge. Expect no body.
    $s->_soap_request(
        'https://local-bay.contacts.msn.com/abservice/SharingService.asmx',
        {   'content-type' => 'text/xml; charset=utf-8',
            SOAPAction =>
                '"http://www.msn.com/webservices/AddressBook/FindMembership"'
        },
        sprintf(<<'XML', $token),
<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
    <soap:Header>
        <ABApplicationHeader xmlns="http://www.msn.com/webservices/AddressBook">
            <ApplicationId>CFE80F9D-180F-4399-82AB-413F33A1FA11</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>
        <FindMembership xmlns="http://www.msn.com/webservices/AddressBook">
            <ServiceFilter>
                <Types>
                    <Space></Space>
                    <SocialNetwork></SocialNetwork>
                    <Profile></Profile>
                    <Invitation></Invitation>
                    <Messenger></Messenger>
                </Types>
            </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);
        }

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

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;
                #dd $xml;
                $s->_trigger_error(
                       $xml->{'soap:Body'}{'soap:Fault'}{'soap:Reason'}
                           {'soap:Text'}{'content'}
                           // $xml->{'soap:Body'}{'soap:Fault'}{'faultstring'}
                           // $hdr->{Reason});
            }
        )
    );
}

# Methods exposed publicly
sub disconnect {    # cleanly disconnect from switchboard
    my $s = shift;
    $s->send('OUT');
    $s->handle->on_drain(
        sub {
            $s->handle->destroy;
        }
    );
    $s->_clear_redirect;    # Start from scratch next time
}

sub send_message {
    my ($s, $to, $msg, $format) = @_;
    $to = '1:' . $to if $to !~ m[^\d+:];
    $format //= 'FN=Segoe%20UI; EF=; CO=0; CS=1; PF=0';

    # FN: Font name (url safe)
    # EF: String containing...
    # - B for Bold
    # - U for Underline
    # - I for Italics
    #ã€€- S for Strikethrough
    # CO: Color (hex without #)
    my $data
        = sprintf
        qq[Routing: 1.0\r\nTo: %s\r\nFrom: 1:%s;epid=%s\r\n\r\nReliability: 1.0\r\n\r\nMessaging: 2.0\r\nMessage-Type: Text\r\nContent-Type: text/plain; charset=UTF-8\r\nContent-Length: %d\r\nX-MMS-IM-Format: %s\r\n\r\n%s],
        $to, $s->passport, $s->guid, length($msg), $format, $msg;
    $s->send(qq'SDG 0 %d\r\n%s', length($data), $data);
}

sub nudge {
    my ($s, $to) = @_;
    $to = '1:' . $to if $to !~ m[^\d+:];
    my $data
        = sprintf
        qq[Routing: 1.0\r\nTo: %s\r\nFrom: 1:%s;epid=%s\r\n\r\nReliability: 1.0\r\n\r\nMessaging: 2.0\r\nMessage-Type: Nudge\r\nService-Channel: IM/Online\r\nContent-Type: text/plain; charset=UTF-8\r\nContent-Length: 0\r\n\r\n],
        $to, $s->passport, $s->guid;
    $s->send("SDG 0 %d\r\n%s", length($data), $data);
}

sub add_contact {
    my ($s, $contact) = @_;

    #
    my $token = $s->auth_token('contacts.msn.com')
        ->{'wst:RequestedSecurityToken'}{'wsse:BinarySecurityToken'}{content};
    $token =~ s/&/&amp;/sg;
    $token =~ s/</&lt;/sg;
    $token =~ s/>/&gt;/sg;
    $token =~ s/"/&quot;/sg;

    #
    $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/ABContactAdd"'
        },
        sprintf(<<'XML', $token, $contact),
<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
   xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
   xmlns:xsd="http://www.w3.org/2001/XMLSchema"
   xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">
     <soap:Header>
        <ABApplicationHeader xmlns="http://www.msn.com/webservices/AddressBook">
            <ApplicationId>CFE80F9D-180F-4399-82AB-413F33A1FA11</ApplicationId>
            <IsMigration>false</IsMigration>
            <PartnerScenario>ContactSave</PartnerScenario>
        </ABApplicationHeader>
        <ABAuthHeader xmlns="http://www.msn.com/webservices/AddressBook">
            <TicketToken>%s</TicketToken>
            <ManagedGroupRequest>false</ManagedGroupRequest>
        </ABAuthHeader>
    </soap:Header>
 <soap:Body>
 <ABContactAdd xmlns="http://www.msn.com/webservices/AddressBook">
            <abId>
                00000000-0000-0000-0000-000000000000
            </abId>
            <contacts>
                <Contact xmlns="http://www.msn.com/webservices/AddressBook">
                    <contactInfo>
                        <contactType>LivePending</contactType>
                        <passportName>%s</passportName>
                        <isMessengerUser>true</isMessengerUser>
                        <MessengerMemberInfo>
                        <DisplayName>minimum clorpvfgt</DisplayName>
                        </MessengerMemberInfo>
                    </contactInfo>
                </Contact>
            </contacts>
            <options>
                <EnableAllowListManagement>
                    true
                </EnableAllowListManagement>
            </options>
        </ABContactAdd>

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

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

sub remove_contact {
    my ($s, $contact) = @_;

    #
    my $token = $s->auth_token('contacts.msn.com')
        ->{'wst:RequestedSecurityToken'}{'wsse:BinarySecurityToken'}{content};
    $token =~ s/&/&amp;/sg;
    $token =~ s/</&lt;/sg;
    $token =~ s/>/&gt;/sg;
    $token =~ s/"/&quot;/sg;

    #
    $s->_soap_request(
        'https://contacts.msn.com/abservice/abservice.asmx',
        {'content-type' => 'text/xml; charset=utf-8',
         SOAPAction =>
             '"http://www.msn.com/webservices/AddressBook/ABContactDelete"'
        },
        sprintf(<<'XML', $token, $contact),
<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
   xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
   xmlns:xsd="http://www.w3.org/2001/XMLSchema"
   xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">
     <soap:Header>
        <ABApplicationHeader xmlns="http://www.msn.com/webservices/AddressBook">
            <ApplicationId>CFE80F9D-180F-4399-82AB-413F33A1FA11</ApplicationId>
            <IsMigration>false</IsMigration>
            <PartnerScenario>ContactSave</PartnerScenario>
        </ABApplicationHeader>
        <ABAuthHeader xmlns="http://www.msn.com/webservices/AddressBook">
            <TicketToken>%s</TicketToken>
            <ManagedGroupRequest>false</ManagedGroupRequest>
        </ABAuthHeader>
    </soap:Header>
 <soap:Body>
 <ABContactAdd xmlns="http://www.msn.com/webservices/AddressBook">
            <abId>
                00000000-0000-0000-0000-000000000000
            </abId>
            <contacts>
                <Contact xmlns="http://www.msn.com/webservices/AddressBook">
                    <contactInfo>
                        <contactType>LivePending</contactType>
                        <passportName>%s</passportName>
                        <isMessengerUser>true</isMessengerUser>
                        <MessengerMemberInfo>
                        <DisplayName>minimum clorpvfgt</DisplayName>
                        </MessengerMemberInfo>
                    </contactInfo>
                </Contact>
            </contacts>
            <options>
                <EnableAllowListManagement>
                    true
                </EnableAllowListManagement>
            </options>
        </ABContactAdd>
 </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;

( run in 0.716 second using v1.01-cache-2.11-cpan-c966e8aa7e8 )