Новый логин Вконтакте — 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

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

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

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

«
»