MAIL.ru авторизация на perl

Discussion in 'PHP' started by rdrule, 17 Apr 2009.

  1. rdrule

    rdrule New Member

    Joined:
    4 Mar 2009
    Messages:
    0
    Likes Received:
    3
    Reputations:
    0
    Здравствуйте, подскажите в чем проблема.
    Недавно начал изучать перл, и задался целью написать скрипт авторизации на MAIL.ru
    вот код

    Code:
    #!/usr/bin/perl
    use IO::Socket;
    use strict;
    
    my $login = "Логин";
    my $domain = "mail.ru";
    my $password = "пароль";
    
    
    #STEP 1
    my $hostname = "win.mail.ru";  
    my $path = "/cgi-bin/login";
    
    my $sock = new IO::Socket::INET(PeerAddr  =>$hostname,PeerPort  => 80,PeerProto => 'tcp',TimeOut   => 5); 
    
    my $headers = "GET $path HTTP/1.0\r\n"; 
    $headers .= "Host: $hostname\r\n";   
    $headers .= "Connection: keep-alive\r\n\r\n";  
    
    my $answ;
    print $sock $headers; 
    sysread( $sock, $answ, 4096); 
    
    my $mrcu = '';
    $answ=~ s/\w{28}/$mrcu=$&/gime;
    close $sock;
    
    
    #STEP 2
    $path = "/cgi-bin/auth";
    $sock = new IO::Socket::INET(PeerAddr  =>$hostname,PeerPort  => 80,PeerProto => 'tcp',TimeOut   => 5); 
    my $data = "page=&post=&login_from=&Login=$login&Domain=$domain&Password=$password&\r\n\r\n";  
    
    $headers = "POST $path HTTP/1.0\r\n";   
    $headers .= "Host: $hostname\r\n";   
    $headers .= "Content-type: application/x-www-form-urlencoded\r\n";  
    $headers .= "Content-Length: ".length($data)."\r\n";  
    $headers .= "Cookie: mrcu=$mrcu\r\n"; 
    $headers .= "Connection: Close\r\n\r\n";
    
    print $sock ($headers.$data); 
    sysread( $sock, my $answ, 4096); 
    
    my ($mpop, $t, $location) = '';
    $answ=~ s/\w{10}\:\S*/$mpop=$&/gime;chop $mpop;$answ=~ s/\w{10}\:\S*//gim;
    $answ=~ s/(\w{88})/$t=$&/gime;
    $mpop=~ s/\:\S{98}/$location=$&/gime;
    $location=~ s/\://gim;$location="http://win.mail.ru/cgi-bin/checkcookie?id=".$location;
    close $sock;
    
    #STEP 3
    $sock = new IO::Socket::INET(PeerAddr  =>$hostname,PeerPort  => 80,PeerProto => 'tcp',TimeOut   => 5); 
    
    $headers = "GET $location HTTP/1.1\r\n"; 
    $headers .= "Host: $hostname\r\n";   
    $headers .= "Content-type: application/x-www-form-urlencoded\r\n";  
    $headers .= "Cookie: mrcu=$mrcu; Mpop=$mpop; t=$t]\r\n"; 
    $headers .= "Connection: keep-alive\r\n\r\n";  
    
    print $sock ($headers.$data); 
    sysread( $sock, my $answ, 4096); 
    close $sock;
    
    #STEP 4
    $hostname = "win.mail.ru";  
    $path = "http://win.mail.ru/cgi-bin/start?back=1"; 
    
    $sock = new IO::Socket::INET(PeerAddr  =>$hostname,PeerPort  => 80,PeerProto => 'tcp',TimeOut   => 20); 
    
    $headers = "GET $path HTTP/1.1\r\n"; 
    $headers .= "Host: $hostname\r\n";   
    $headers .= "Content-type: application/x-www-form-urlencoded\r\n";  
    $headers .= "Accept-Language: ru-RU,ru;q=0.9,en;q=0.8\r\n"; 
    $headers .= "Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1\r\n"; 
    $headers .= "Cookie: mrcu=$mrcu; Mpop=$mpop; t=$t\r\n"; 
    $headers .= "Connection: keep-alive\r\n\r\n";
    
    print $sock ($headers.$data); 
    sysread( $sock, my $main, 80000); 
    
    print $main;
    Авторизация, как я понял, проходит в 4 этапа:
    1)при входе на сайт нам дают "печеньку" $mrcu
    2)потом идет авторизация, и нам дают еще $mpop и $t
    3)идет редирект на проверку кукисов
    4)сам вход на мейл

    проблема заключаеться в том, что после 4го шага скрипт не грузит полность страничку, а только заголовки+1 ява скрипт

    подскажите что не так и поправьте код пожалуйста
     
    2 people like this.
  2. Sharky

    Sharky Elder - Старейшина

    Joined:
    1 May 2006
    Messages:
    487
    Likes Received:
    312
    Reputations:
    46
    может в там в заголовках редирект?
     
  3. rdrule

    rdrule New Member

    Joined:
    4 Mar 2009
    Messages:
    0
    Likes Received:
    3
    Reputations:
    0
    сервер выдает

    Code:
    HTTP/1.1 200 OK                                                                                                                      
    Server: nginx/0.7.41                                                                                                                 
    Date: Fri, 17 Apr 2009 15:50:28 GMT                                                                                                  
    Content-Type: text/html; charset=windows-1251                                                                                        
    Connection: keep-alive                                                                                                               
    Cache-Control: no-cache,no-store,must-revalidate                                                                                     Pragma: no-cache                                                                                                                     
    Expires: Thu, 17 Apr 2008 15:50:28 GMT                                                                                               Last-
    Modified: Fri, 17 Apr 2009 19:50:28 GMT                                                                                         Content-
    Length: 75712          
     
  4. Gar|k

    Gar|k Moderator

    Joined:
    20 Mar 2009
    Messages:
    1,166
    Likes Received:
    266
    Reputations:
    82
    могу предположить следующее.... recv не обязательно получает указаное количество байт... тоесть вся страница приходит в разных покетах

    вот пример реализации "правильной" функции получения и отправки данных на Си

    Code:
    int sendall(SOCKET s, char *buf, int len, int flags)
    {
        int total = 0;
        int n;
    
        while(total < len)
        {
            n = send(s, buf+total, len-total, flags);
            if(n == -1) { break; }
            total += n;
        }
    
        return (n==-1 ? -1 : total);
    }
    
    // принять ВСЕ ... - правильная функция
    int recvall(SOCKET s, char *buf, int len, int flags)
    {
        int total = 0;
        int n;
    
        while(total < len)
        {
            n = recv(s, buf+total, len-total, flags);
            if(n == -1) { break; }
            total += n;
        }
    
        return (n==-1 ? -1 : total);
    }
    
    на PERL давно не писал, но если сам не сможешь помогу перевести код
     
    _________________________
  5. Kaimi

    Kaimi Well-Known Member

    Joined:
    23 Aug 2007
    Messages:
    1,732
    Likes Received:
    811
    Reputations:
    231
    Code:
    use warnings;
    use IO::Socket;
    $|=1;
    
    my $login = "login";
    my $domain = "mail.ru";
    my $password = "pass";
    
    my $answ1 = req('win.mail.ru', '/cgi-bin/auth', 'POST', "Login=$login&Domain=$domain&Password=$password", 0);
    my $ck1 = collect($answ1);
    $answ1 =~ /<HTML>http:\/\/win.mail.ru(.+?)<\/HTML>/;
    req('win.mail.ru', $1, 'GET', 0, $ck1);
    my $answ2 = req('win.mail.ru', '/cgi-bin/start?back=1', 'GET', 0, $ck1);
    print $answ2;
    
    sub collect
    {
     my $data = $_[0];
     my $cookie = undef;
     while($data =~ /Set-Cookie: (.+?)(;|\r)/igs)
     {
      $cookie .= $1."; ";
     }
     return $cookie;
    }
    sub req
    {
     my($host, $path, $type, $data, $cookies) = @_;
     
     my $sock = new IO::Socket::INET(
    			PeerAddr  => $host,
    			PeerPort  => 80,
    			PeerProto => 'tcp',
    			TimeOut   => 5);
    
     my $request = "$type $path HTTP/1.0\n".
     "Host: $host\n".
     "Cookie: $cookies\n";
     
     if($type eq "POST")
     {
      $request .= "Content-type: application/x-www-form-urlencoded\n".
      "Content-Length: ".length($data)."\n\n".$data;
     }
     else
     {
      $request .= "\n";
     }
     
     print $sock $request;
     
     my $answ = undef;
     while(my $buf = <$sock>)
     {
      $answ .= $buf;
     }
    
     return $answ;
    }
    
     
    _________________________
  6. rdrule

    rdrule New Member

    Joined:
    4 Mar 2009
    Messages:
    0
    Likes Received:
    3
    Reputations:
    0
    спасибо за ответы.
    Теперь всё работает, по видимому всё дело было в recv

    p.s: а до Kaimi мне еще жить и жить)))
     
Loading...
Similar Threads - MAIL авторизация perl
  1. GAiN
    Replies:
    3
    Views:
    7,643