package WWW::Contact::Hotmail; use Moose; extends 'WWW::Contact::Base'; use HTTP::Request::Common qw/POST/; use HTML::TokeParser::Simple; use HTML::Entities (); our $VERSION = '0.46'; our $AUTHORITY = 'cpan:FAYLAND'; sub get_contacts { my ($self, $email, $password) = @_; # reset $self->errstr(undef); $self->debug(1); my @contacts; my ( $username, $domain ) = split('@', $email); my $ua = $self->ua; $self->debug("start get_contacts from Hotmail"); # to form $self->get('http://www.hotmail.com/') || return; my $content = $ua->content; # name="PPFT" id="i0327" value="Bw4Y3kJtiK6yV7ABYe!x*UuPc4ojFA3Hd9L5p5Y3YI8jpFmz3zE1oUjkvr8gGJhvdbe4KJMCYYBY3!Rvw6gnzeg2*o8UXoFzVNuEbpEyDviKY0n6INA07ZCrpC3hCNymZcj4dywAIUcIDroGGxGLX1IEUctXOCQY!GlHcjEvondo6cSF9!!tjN*6qu!X"/>'; my ($PPFT) = ( $content =~ /name\=\"PPFT\".*?value\=\"(.*?)\"/ ); # srf_uPost=\'https://login.live.com/ppsecure/post.srf?wa=wsignin1.0&rpsnv=10&ct=1225096129&rver=4.5.2130.0&wp=MBI&wreply=http:%2F%2Fmail.live.com%2Fdefault.aspx&id=64855&bk=1225096129\' my ($post_url) = ( $content =~ /srf_uPost\=\'([^\']+)\'/ ); # from http://login.live.com/WLLogin_JS.srf?x=6.0.11557.0&lc=1033 # g_DO["compaq.net"]="https://msnia.login.live.com/ppsecure/post.srf";g_DO["hotmail.co.jp"]="https://login.live.com/ppsecure/post.srf";g_DO["hotmail.co.uk"]="https://login.live.com/ppsecure/post.srf";g_DO["hotmail.com"]="https://login.live.com/ppsecure/post.srf";g_DO["hotmail.de"]="https://login.live.com/ppsecure/post.srf";g_DO["hotmail.fr"]="https://login.live.com/ppsecure/post.srf";g_DO["hotmail.it"]="https://login.live.com/ppsecure/post.srf";g_DO["messengeruser.com"]="https://login.live.com/ppsecure/post.srf";g_DO["msn.com"]="https://msnia.login.live.com/ppsecure/post.srf";g_DO["passport.com"]="https://login.live.com/ppsecure/post.srf";g_DO["webtv.net"]="https://login.live.com/ppsecure/post.srf"; if ( $domain eq 'compaq.net' or $domain eq 'msn.com' ) { # var g_QS="wa=wsignin1.0&rpsnv=11&ct=1266924668&rver=6.0.5285.0&wp=MBI&wreply=http:%2F%2Fmail.live.com%2Fdefault.aspx&lc=1033&id=64855&mkt=en-us&bk=1266924668"; my ($post_param) = ($content =~ /g_QS\s*\=\s*[\"\']([^\'\"]+)[\"\']/); $post_url = 'https://msnia.login.live.com/ppsecure/post.srf?' . $post_param; } # switch(g_iActiveCredtype){case 1:if(g_fLWASilentAuth==true)s.type.value=30;else s.type.value=11;break;case 2:s.type.value=12;if(s.CS.value==""){if(!SubmitCardSpace())return false;}break;case 4:s.type.value=14;if(g_fEIDSupported&&typeof g_EIDScriptDL!="undefined"){if(!EIDSubmit(s))return false;}break;case 3:s.type.value=13; my $type = 11; # XXX? It's a bit complicated. need FIX later. # try me, STUPID Microsoft always wants to get rid of US! $ua->request(POST $post_url, [ idsbho => 1, PwdPad => 'IfYouAreReadingThisYouHaveTooMuch', LoginOptions => 3, CS => undef, FedState => undef, PPSX => 'PassportR', type => $type, login => $email, passwd => $password, NewUser => 1, PPFT => $PPFT, i1 => 0, i2 => 0, ]); # var srf_sErr=\'The e-mail address or password is incorrect. Please try again.\'; my ( $has_error ) = ( $ua->content =~ /srf_sErr\=\'([^\']+)\'/ ); if ( $has_error ) { $self->errstr('Wrong Username or Password'); return; } $ua->cookie_jar->clear( '.live.com', '/', 'WLSSC' ); # my ( $url ) = ( $ua->content =~ /replace\(\"([^\"]+)\"/ ); if ( $url ) { $self->get( $url ) || return; } # You spoke, Hotmail listened if ( $ua->content =~ /MessageAtLoginForm/ ) { $self->submit_form( form_name => 'MessageAtLoginForm', ) || return; } # TodayDefault, Our latest improvements # my ( undef, undef, $maildomain ) = ( $ua->content =~ /base\s+href\=\"(.*?)(&\#47\;&\#47\;|\/\/)((.*?)\.mail\.live\.com)/ ); my ( $uid ) = ( $ua->content =~ /n\&\#61\;(\d+)/ ); # n= unless ( $uid ) { $self->errstr('Wrong Username or Password'); return; } $self->get("http://$maildomain/mail/ContactMainLight.aspx?n=$uid") || return; @contacts = $self->get_contacts_from_html( $ua->content ); if ( scalar @contacts > 24 ) { # more pages, scalar @contacts == 25 my $page = $self->get_contacts_page_from_html($ua->content); if ( $page > 1 ) { foreach my $p (2..$page) { $self->get("http://$maildomain/mail/ContactMainLight.aspx?n=$uid&Page=$p") || next; push @contacts, $self->get_contacts_from_html($ua->content); } } } # remove email itself @contacts = grep { $_->{email} ne $email } @contacts; return wantarray ? @contacts : \@contacts; } sub get_contacts_from_html { my ($self, $content) = @_; my @contacts; # cxp_ic_control_data my ( $data ) = ( $content =~ /cxp_ic_control_data(.*?)\}\;/s ); if ($data) { my @lines = split(/\n/, $data); foreach my $line ( @lines ) { # ICc0:['0ea61975fb7fb339','1',['sm','si','ct'],'fayland lam','55ff0c7e-2c36-41cc-aa12-fb1db452f171','1055559157186278201','fayland\x40gmail.com','fayland\x40gmail.com','','1',[['Send e-mail','','','submitToCompose\x28\x2755ff0c7e-2c36-41cc-aa12-fb1db452f171\x27, \x27EditMessageLight.aspx\x3fn\x3d1423059530\x27\x29'],['Edit contact info','ContactEditLight.aspx\x3fContactID\x3d55ff0c7e-2c36-41cc-aa12-fb1db452f171\x26n\x3d1980367392','','','_self']]], my ( $email ) = ( $line =~ /\'([^\']+\\x40(.*?))\'/ ); next unless $email; $email =~ s/\\x40/\@/; my ( $name ) = ( $line =~ /\]\,\s*\'([^\']+)\'/ ); # Funky encoding of some non-alphanumberic chars in Hotmail names fix by OALDERS (RT 46280) if ( $name =~ /\\x/ ) { $name =~ s{\\x([A-Fa-f0-9]{2})}{chr(hex($1))}egxms; $name = HTML::Entities::decode_entities($name); } push @contacts, { email => $email, name => $name, }; } } else { # ic_control_data ( $data ) = ( $content =~ /ic_control_data(.*?)\}\;/s ); my @lines = split(/\n/, $data); foreach my $line ( @lines ) { # "ic2":["","1",["se","vd"],"33","0832c2b8-aeba-4c9c-a359-5dfff5664610","0","333\u004022.com","cid\u003a0",[],"","","1",[],"","","","" my ( $email ) = ( $line =~ /[\'\"]([^\'\"]+\\u0040(.*?))[\'\"]/ ); next unless $email; $email =~ s/\\u0040/\@/; my ( $name ) = ( $line =~ /\]\,\s*[\'\"]([^\'\"]+)[\'\"]/ ); # Funky encoding of some non-alphanumberic chars in Hotmail names fix by OALDERS (RT 46280) if ( $name =~ /\\u/ ) { $name =~ s/\\u(....)/ pack 'U*', hex($1) /eg; } push @contacts, { email => $email, name => $name, }; } } return @contacts; } sub get_contacts_page_from_html { my ($self, $content) = @_; my $page = 1; foreach my $line (split /\n/, $content) { #
  • meta->make_immutable; 1; __END__ =head1 NAME WWW::Contact::Hotmail - Get contacts/addressbook from Hotmail/Live Mail =head1 SYNOPSIS use WWW::Contact; use Data::Dumper; my $wc = WWW::Contact->new(); my @contacts = $wc->get_contacts('itsa@hotmail.com', 'password'); my $errstr = $wc->errstr; if ($errstr) { die $errstr; } else { print Dumper(\@contacts); } =head1 DESCRIPTION Get contacts from Hotmail/Live Mail L. Extends L =head1 WARNING Microsoft is always changing the web interface to get rid of something like us. So it might be broken soon. use it at your own risk! =head1 SEE ALSO L, L, L =head1 AUTHOR Fayland Lam, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2008 Fayland Lam, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut