Новый логин Вконтакте — Perl, Curl

12 марта 2010, 13:37

Собственно, уже не мудрствуя лукаво — кто хоть немного знает перл — разберётся.

Вконтакте добавили редиректики, что не помешает доблестному Curl через них пройти и получить куку в файл.

#!/usr/bin/perl -w
use strict;
use WWW::Curl::Easy;
use Carp;

sub getURL {
  my $params = shift;

  croak q[HASH needed as param] if ref ($params) ne 'HASH';
  croak q[HREF needed in HASH] if (!exists ($params->{href}));

  $params->{href} = q[http://].$params->{href} if $params->{href} !~ /^http (s)?:\/\//;
  
  my $result = 'false';
  open my $oldout, «>&STDOUT» or die «Can't dup STDOUT: $!»;

  close STDOUT;
  open STDOUT, «> /dev/null»;
  my $retcode;

  my $curl;
  {
    $curl = new WWW::Curl::Easy;
    $curl->setopt (CURLOPT_URL, $params->{href});
    $curl->setopt (CURLOPT_USERAGENT,q[q[Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2) Gecko/20100115 Firefox/3.6]]);
    $curl->setopt (CURLOPT_POST,1) if $params->{post};
    $curl->setopt (CURLOPT_POSTFIELDS,$params->{post}) if $params->{post};
    $curl->setopt (CURLOPT_COOKIEJAR, $params->{cookie_file}) if $params->{cookie_file};
    $curl->setopt (CURLOPT_COOKIEFILE, $params->{cookie_file}) if $params->{cookie_file};
    $curl->setopt (CURLOPT_FOLLOWLOCATION,1);
    open (my $tmp_for_curl, ">", \$result);
    $curl->setopt (CURLOPT_FILE,$tmp_for_curl);
    $retcode = $curl->perform;
  }

  close STDOUT;
  open STDOUT, «>&», $oldout or die «Can't dup \$oldout: $!»;

  return {
        content         => $result,
        retcode         => $retcode,
        http_code        => $curl->getinfo (CURLINFO_HTTP_CODE),
        effective_url      => $curl->getinfo (CURLINFO_EFFECTIVE_URL),
        content_type      => $curl->getinfo (CURLINFO_CONTENT_TYPE)
      };
}

my $login     =  q[your@email];
my $password    =  q[password];
my $cookie_file  =  q[./cookie_file]
$login       =~  s/@/%40/;
my $result     =  getURL ({
                href => q[http://vkontakte.ru/login.php],
                post => qq[op=>a_login_attempt&email=$login&pass=$password&expire=0],
                cookie_file => $cookie_file
            });

Теги: , , , , ,
Комментировать

13 комментариев

  1. frezer:
    12 марта 2010 в 15:58

    Спасибо. Попозже гляну и протестирую.

    //

    В старой версии имеет смысл в самом посте написать, что не работает больше и сюда поставить ссылку, так как я пришёл сюда через Яндекс, а там та тема на втором месте в выдаче по такому запросу «логин вконтакте Perl», а если добавить ещё слово «скрипт», то вообще на первом.

  2. Andrew Skazkin:
    12 марта 2010 в 16:02

    Ага, проставил ссылку=)

  3. ClanMax:
    10 мая 2010 в 16:11

    Ругается на open my $oldout, «>&STDOUT» or die «Can't dup STDOUT: $!»;

    Unrecognized character \xC2 at ./cookies.pl line 15.

    В чем проблема?

  4. ewindt:
    16 ноября 2010 в 11:39

    скачал с cpan.org модуль curl

    копирнул каталог WWW со всем содержимым в perl\lib

    в скрипт пишу:

    use WWW::Curl::Easy;

    но компиляция вываливается на 9-й строке в www\curl\easy.pm:

    use WWW::Curl ();

    можете помочь?

  5. justnoxx:
    12 апреля 2011 в 22:43

    Да вы, я посмотрю, психи=)

    Пример логина вконтакта, сваял минут за 15, стало интересно, в чем проблема.

    Собсна код:

    [code]

    #!/usr/bin/perl

    use strict;

    use WWW::Mechanize;

    use Compress::Zlib;

    use Text::Iconv;

    sub decodeContent{

    my $content=shift;

    my $decodedContent;

    if ($decodedContent=Compress::Zlib::memGunzip ($content)){

    $content=$decodedContent;

    }

    return $content;

    }

    my $url='http://vk.com';

    my $mech=WWW::Mechanize->new ();

    $mech->add_header (agent => 'Mozilla/5.0');

    $mech->get ($url) or die («invalid request\n»);

    my $content=decodeContent ($mech->response->content ());

    #print $content;

    $content=~/charset=([\w\d\-]*)/gis;

    print 'charset:',$1,"\n";

    my $charset=$1;

    $mech->submit_form (

    form_name => 'login',

    fields => {

    email => 'my@e.mail',

    pass=>'pass',

    act=>'login',

    q=>'1',

    al_frame=>'1',

    expire=>'',

    captcha_sid=>'',

    captcha_key=>'', },

    );

    my $current=Compress::Zlib::memGunzip ($mech->response->content ());

    $current=~/onlogindone\('(.*?)'\)/is;

    print «\n»,'login:',$1,"\n";

    my $username=$1;

    my $urlnext=$url.$1;

    $mech->get ($urlnext);

    my $page=$mech->response->content ();

    if (my $decodedPage=Compress::Zlib::memGunzip ($page)){

    print «page was coded\n»;

    $page=$decodedPage;

    }

    else{

    print «page was not coded\n»

    }

    my $conv=Text::Iconv->new ($charset,'utf8');

    $page=$conv->convert ($page);

    my $file=$username;

    $file=~s!\/!!;

    $file.='.html';

    $file='>'.$file;

    open (FILE, $file) or die («cant open file \n»);

    print FILE $page;

    [/code]

    Пишет стартовую ХТМЛ страницу в файл. Логины пароли подставляйте свои.

  6. justnoxx:
    13 апреля 2011 в 0:43

    Я сейчас как раз ваяю библиотечку для perl, ориентированную на социальные сети. Уже есть поддержка facebook. На днях допишу вконтакт, как только будет свободное время от работы=) Кстати, механайз таки вещь. Я его научил работать с javascript ссылками, точил под парсинг asp сайтов с __doPostBack. Приятно, что такой замечательный язык, как perl пользуется популярностью, хотя в последнее время все больше и больше замечаю, что меготрувебдевелоперы пишут парсеры на пхп, печааль=)

  7. justnoxx:
    13 апреля 2011 в 1:04

    Могу поделиться ссылочкой, как будет готово)

Комментировать

Войдите чтобы оставить комментарий.

«
»