AnyEvent-MSN
view release on metacpan or search on metacpan
lib/AnyEvent/MSN.pm view on Meta::CPAN
);
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'
);
# Server configuration
has policies => (
is => 'bare',
isa => 'HashRef',
clearer => '_reset_policies',
writer => '_set_policies',
traits => ['Hash'],
handles => {_add_policy => 'set',
_del_policy => 'delete',
policy => 'get',
policies => 'kv' # XXX - Really?
}
);
# SOAP
has SSOsites => (
is => 'ro', # Single Sign On
isa => 'ArrayRef[ArrayRef]',
traits => ['Array'],
default => sub {
[['http://Passport.NET/tb', ''],
['messengerclear.live.com', 'MBI_KEY_OLD'],
['messenger.msn.com', '?id=507'],
['messengersecure.live.com', 'MBI_SSL'],
['contacts.msn.com', 'MBI'],
['storage.msn.com', 'MBI'],
['sup.live.com', 'MBI']
];
}
);
has auth_tokens => (is => 'bare',
isa => 'HashRef',
clearer => '_reset_auth_tokens',
writer => '_set_auth_tokens',
traits => ['Hash'],
handles => {_add_auth_token => 'set',
_del_auth_token => 'delete',
auth_token => 'get',
auth_tokens => 'kv'
}
);
has contacts => (is => 'ro',
isa => 'HashRef',
clearer => '_reset_contacts',
writer => '_set_contacts',
traits => ['Hash'],
);
# Simple callbacks
has 'on_' . $_ => (
traits => ['Code'],
is => 'ro',
isa => 'CodeRef',
default => sub {
sub {1}
},
handles => {'_trigger_' . $_ => 'execute_method'},
)
lib/AnyEvent/MSN.pm view on Meta::CPAN
clearer => '_reset_redirect' # XXX - Currently unused internally
);
# Auto connect
sub BUILD {
my ($s, $p) = @_;
return if $p->{no_autoconnect};
$s->connect;
}
sub connect {
my $s = shift;
$s->_unset_connected;
$s->_set_handle(
AnyEvent::Handle->new(
connect => [$s->host, $s->port],
on_connect => sub {
# Get ready to read data from server
$s->handle->push_read(
'AnyEvent::MSN::Protocol' => sub {
my ($cmd, $tid, @data) = @_;
my $method = $s->can('_handle_packet_' . lc($cmd));
$method ||= sub {
$s->_trigger_error(
'Unhandled command type: ' . $cmd,
0);
};
if ($cmd =~ m[^(?:GCF|MSG|NFY|NOT|SDG|UBX|PUT)$])
{ # payload types
$s->handle->unshift_read(
chunk => $data[-1] // $tid, # GFC:0, MSG:2
sub {
my ($_h, $_c) = @_;
$s->$method(
$tid, @data,
$cmd =~ m[GCF] ? $s->_parse_xml($_c)
: $cmd =~ m[(?:MSG|NFY|SDG)] ?
AnyEvent::MSN::Protocol::__parse_msn_headers(
$_c)
: $_c
);
}
);
}
elsif ($cmd =~ m[^\d+$]) { # Error!
$s->_trigger_error(
AnyEvent::MSN::Protocol::err2str($cmd, @data)
);
}
else {
$s->$method($tid, @data);
}
}
);
# Send version negotiation
$s->send('VER %d %s CVR0', $s->tid, $s->protocol_version);
# Schedule first PNG in two mins
$s->_set_ping_timer(AE::timer 120,
180, sub { $s->send('PNG') });
},
on_connect_error =>
sub { shift; $s->_trigger_fatal_error(shift) },
on_error => sub {
my $h = shift;
$s->_trigger_fatal_error(reverse @_);
$h->destroy;
},
on_eof => sub {
$_[0]->destroy;
$s->cleanup('connection closed');
}
)
);
}
# Commands from notification server
sub _handle_packet_adl {
my $s = shift;
# ACK for outgoing ADL
# $s->send('BLP %d AL', $s->tid);
}
sub _handle_packet_chl { # Official client challenge
my ($s, $tid, @data) = @_;
my $data =
AnyEvent::MSN::Protocol::CreateQRYHash($data[0], $s->product_id,
$s->product_key);
$s->send("QRY %d %s %d\r\n%s",
$s->tid, $s->product_id, length($data), $data);
}
sub _handle_packet_cvr { # Client version recommendation
my ($s, $tid, $r, $min_a, $min_b, $url_dl, $url_info) = @_;
# We don't do anything with this yet but...
# The first parameter is a recommended version of
# the client for you to use, or "1.0.0000" if your
# client information is not recognised.
# The second parameter is identical to the first.
# The third parameter is the minimum version of the
# client it's safe for you to use, or the current
# version if your client information is not
# recognised.
# The fourth parameter is a URL you can download the
# recommended version of the client from.
# The fifth parameter is a URL the user can go to to
# get more information about the client.
$s->send('USR %d SSO I %s', $s->tid, $s->passport);
}
sub _handle_packet_gcf { # Get config
my ($s, $tid, $len, $r) = @_;
if ($tid == 0) { # probably Policy list
$s->_set_policies($r->{Policy});
#for (@{$s->policy('SHIELDS')->{config}{block}{regexp}{imtext}}) {
# my $regex = MIME::Base64::decode_base64($_);
lib/AnyEvent/MSN.pm view on Meta::CPAN
when (m[text/x-msmsgsinitialmdatanotification]) {
#warn 'You\'ve got mail!/aol'
}
default { $s->_trigger_error('Unknown message type: ' . $_) }
}
}
sub _handle_packet_nfy {
my ($s, $type, $len, $headers, $data) = @_;
=begin comment
use Data::Printer;
dd $type, $len, $headers, $data;
dd $s->_parse_xml($data);
=cut
given ($headers->{Uri}) {
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/&/&/sg;
$token =~ s/</</sg;
$token =~ s/>/>/sg;
$token =~ s/"/"/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"'
( run in 0.796 second using v1.01-cache-2.11-cpan-39bf76dae61 )