AnyEvent-MSN
view release on metacpan or search on metacpan
lib/AnyEvent/MSN.pm view on Meta::CPAN
package AnyEvent::MSN;
{ $AnyEvent::MSN::VERSION = 0.002 }
use lib '../../lib';
use 5.012;
use Moose;
use Moose::Util::TypeConstraints;
use AnyEvent qw[];
use AnyEvent::Handle qw[];
use AnyEvent::HTTP qw[];
use Try::Tiny;
use XML::Twig;
use AnyEvent::MSN::Protocol;
use AnyEvent::MSN::Types;
use MIME::Base64 qw[];
#
#use Data::Dump;
#
our $DEBUG = 0;
sub DEBUG {$DEBUG}
# XXX - During dev only
#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',
lib/AnyEvent/MSN.pm view on Meta::CPAN
: $op == 2 ? 'Ack'
: $op == 3 ? 'Init'
: 'BROKEN'
),
base_id => $baseid,
msg_len => $ml
};
#
}
#dd $header;
#p($packet =~ m[^(.+?)\r\n(.+)\r\n\r\n(.)$]s);
my ($p2p_action, $p2p_head, $p2p_body)
= ($packet =~ m[^(.+?)\r\n(.+)\r\n\r\n(.)$]s);
#dd $head, $p2p_action,
# AnyEvent::MSN::Protocol::__parse_msn_headers($p2p_head),
# $p2p_body;
#warn 'Data'
# XXX - trigger a callback of some sort
}
when ('Signal/P2P') { warn 'P2P' }
when ('Signal/ForceAbchSync') { }
when ('Signal/CloseIMWindow') { }
when ('Signal/MarkIMWindowRead') { }
when ('Signal/Turn') { };
when ('Signal/AudioMeta') { }
when ('Signal/AudioTunnel') { }
default {...}
}
}
sub _handle_packet_usr {
my ($s, $tid, $subtype, $_s, $policy, $nonce) = @_;
if ($subtype eq 'OK') {
# Sent after we send ADL command. Lastcommand in the logon?
}
elsif ($subtype eq 'SSO') {
my $x = 1;
my @tokens = map {
sprintf <<'TOKEN', $x++, $_->[0], $_->[1] } @{$s->SSOsites};
<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[^\?]) {
...;
}
}
lib/AnyEvent/MSN.pm view on Meta::CPAN
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[&][&]sg;
$x =~ s[<][<]sg;
$x =~ s[>][>]sg;
$x =~ s["]["]sg;
$x;
}
sub __html_unescape {
my $x = shift;
$x =~ s[<][<]sg;
$x =~ s[>][>]sg;
$x =~ s["]["]sg;
$x =~ s[&][&]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>
It's... your... password.
=back
Optional parameters to C<new> include...
=over
=item C<status>
This will be used as your initial online status. Please see the section
entitled L<Online Status|/"Online Status"> for more information.
=item C<friendly_name>
This sets the display or friendly name for the client. This is what your
friends see on their buddylists.
=item C<personal_message>
This is the short message typically shown below the friendly name.
=item C<no_autoconnect>
Normally, L<AnyEvent::MSN-E<gt>new( ... )|/new> automatically initiates the
L<client login|/connect> stage. If this is set to a true value, that doesn't
happen and you'll need to call L<connect|/connect> yourself.
=item C<on_connect>
This is callback is triggered when we have completed the login stage but
before we set our initial status.
=item C<on_im>
This callback is triggered when we receive an instant message. It is passed
the raw headers (which contain a 'From' value) and the actual message.
=item C<on_nudge>
This callback is triggered when we recieve a nudge. The callback is passed the
raw headers (which contain a 'From' value).
=item C<on_error>
This callback is triggered when we meet any sort of non-fatal error. This
callback is passed a texual message for display.
=item C<on_fatal_error>
This callback is triggered when we meet an error which prevents normal client
operations. This could be a major SOAP error or even an unexpected disconnect.
This callback is passed a textual message for display.
=item C<on_user_notification>
...
on_user_notification => sub { my ($s, $head, $presence) = @_; ... }
...
This callback is triggered when a contact updates their public information.
( run in 1.096 second using v1.01-cache-2.11-cpan-f56aa216473 )