ICQ check by Gar|k [PERL]
Вот решил воложить свои ранние игры с протоколом ICQ
Скрипт писался чисто в целях изучения протокола, поэтому тут нет подержки проксей и тд.
Код:
#!/usr/bin/perl
use IO::Socket;
#(c)oded by Gar|k / ICQ check
$uin=$ARGV[0];
$password=$ARGV[1];
$maxtime=2; # такая тема: кароче если пасс не правльный то ответа от серва не приходит
# тоесть и прочитать его невозможно =( из-за этого прога тормозит аж на 30 секунд
# поэтому я сделал таймер на выполнение комманды
# 2 секунды вполне хватает на получение ответа от сервера
$pass=xorpas($password);
# возможные ошибки при авторизации
%AUTH_ER=(
"\x00\x01"=>'Invalid nick or password',
"\x00\x02"=>'Service temporarily unavailable',
"\x00\x03"=>'All other errors',
"\x00\x04"=>'Incorrect nick or password, re-enter',
"\x00\x05"=>'Mismatch nick or password, re-enter',
"\x00\x06"=>'Internal client error (bad input to authorizer)',
"\x00\x07"=>'Invalid account',
"\x00\x08"=>'Deleted account',
"\x00\x09"=>'Expired account',
"\x00\x0A"=>'No access to database',
"\x00\x0B"=>'No access to resolver',
"\x00\x0C"=>'Invalid database fields',
"\x00\x0D"=>'Bad database status',
"\x00\x0E"=>'Bad resolver status',
"\x00\x0F"=>'Internal error',
"\x00\x10"=>'Service temporarily offline',
"\x00\x11"=>'Suspended account',
"\x00\x12"=>'DB send error',
"\x00\x13"=>'DB link error',
"\x00\x14"=>'Reservation map error',
"\x00\x15"=>'Reservation link error',
"\x00\x16"=>'The users num connected from this IP has reached the maximum',
"\x00\x17"=>'The users num connected from this IP has reached the maximum (reservation)',
"\x00\x18"=>'Rate limit exceeded (reservation). Please try to reconnect in a few minutes',
"\x00\x19"=>'User too heavily warned',
"\x00\x1A"=>'Reservation timeout',
"\x00\x1B"=>'You are using an older version of ICQ. Upgrade required',
"\x00\x1C"=>'You are using an older version of ICQ. Upgrade recommended',
"\x00\x1D"=>'Rate limit exceeded. Please try to reconnect in a few minutes',
"\x00\x1E"=>'Can\'t register on the ICQ network. Reconnect in a few minutes',
"\x00\x20"=>'Invalid SecurID',
"\x00\x22"=>'Account suspended because of your age (age < 13)' );
# шаблоны пакетов
$AUTH_FAILED="\x00\x01\x00..*\x00\x04\x00..*\x00\x08\x00\x02(..)"; # ошибка авторизции
$SRV_COOKIE= "\x00\x01...*\x00\x05...*\x00\x06...*"; # ответ сервара на правильный пароль
###
# справка, а то я сам долго впирался (тут все в 16-ричном виде)
#
# * BYTE is a 8 bit integer
# * WORD is a 2-byte integer (BE)
# * DWORD is a 4-byte integer (BE)
# * STRING is a succession of (ascii) characters without length-leading or null-char-ending
#
# FLAP --------------------------------+
# 2A byte FLAP id byte
# xx byte FLAP channel
# xx xx word FLAP datagram seq number
# xx xx word FLAP data size
# -------------------------------------+
#
# TLV ---------------------------------+
# xx xx word TLV type number
# xx xx word TLV length value
# -------------------------------------+
#
# обясняю на примере:
# | 00 17 || 00 02 || 00 04 | - TLV(17) word client major versionr
# numer length value
###
# пакет отсылаемый серверу
$lp=length($pass);
$lu=length($uin);
$n=117; # длина пакета без пароля и юина
$n=$n+$lp+$lu;
# аааа длина пакета жопа аааа
$CLI_IDENT=
"\x2A\x01\x13\x5A\x00".h($n). # FLAP channel 0x01 длина \ч83
"\x00\x00\x00\x01". # dword
"\x00\x01\x00".h($lu).$uin. # TLV(1) string uin
"\x00\x02\x00".h($lp).$pass. # TLV(2) array xor password
"\x00\x03\x00\x33".'ICQ Inc. - Product of ICQ (TM).2000b.4.65.1.3281.85'. # TLV(3) string client name,version
"\x00\x16\x00\x02\x01\x0A". # TLV(16) word client id number
"\x00\x17\x00\x02\x00\x04". # TLV(17) word client major versionr
"\x00\x18\x00\x02\x00\x41". # TLV(18) word client minor version
"\x00\x19\x00\x02\x00\x01". # TLV(19) word client lesser version
"\x00\x1A\x00\x02\x0C\xD1". # TLV(1A) word client build number
"\x00\x14\x00\x04\x00\x00\x00\x55". # TLV(14) dword client distribution number
"\x00\x0F\x00\x02\x65\x6E". # TLV(0F) string client language
"\x00\x0E\x00\x02\x75\x73"; # TLV(0E) string client country
# если чел в онлайне то его выбрасывает, это стремно =(
# поэтому мы не будет проверять тех, кто в сети
sub status {
my ($http,$zap,$s,$on);
$http = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "status.icq.com", PeerPort => "80");
$zap="GET /online.gif?icq=$uin HTTP/1.1\n"
."User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)\n"
."Referer: www.icq.com\n"
."Host: status.icq.com\n"
."Accept: text/*;q=0,9\n"
."Connection: close\n\n";
print $http $zap;
$on=0;
while($s=<$http>)
{
chomp($s);
if($s=~/online(.)\.gif/){$on=$1;close($http);}
}
close($http);
return $on; }
# хз почему но так надо =) эт типа пакуем в hex чтоб в переменнлй правильно было не 1A а 0x1A
sub h
{
my $n=$_[0];
return pack("H*",sprintf("%2.2x",$n));
}
# пароль отправдяемый в сокете зашифрован тупо xor-ом
sub xorpas {
my ($Password) = @_;
my ($FinishedString);
my @Pass = split (//, $Password);
foreach (@Pass){$_ = ord($_);}
my @encoding_table = (
0xf3, 0x26, 0x81, 0xc4,
0x39, 0x86, 0xdb, 0x92,
0x71, 0xa3, 0xb9, 0xe6,
0x53, 0x7a, 0x95, 0x7c);
for (my $i = 0; $i < length($Password); $i++){
$FinishedString .= chr($Pass[$i] ^ $encoding_table[$i]);
}
return ($FinishedString);
}
sub ex {$pack=$_[0];$c=0;next;}
sub check
{
print "Status: ";
if(status==1){print "online\n";exit;}else{ print "offline\n"; }
alarm($maxtime);
#print "start proc $i $pid\n";
$socket = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "login.icq.com", PeerPort => "5190",Timeout => 5) || die("false\n");
$pack='';
$c=1;
$aut=0;
$n=0;
while($c==1)
{
# print "$n: ".length($socket)." $aut\n";
if($aut==0)
{
print $socket $CLI_IDENT;$aut=1;$n++;
next;
}
$socket->recv($lol,32,0);chomp($lol);
if(length($lol)==0){ ex('FALSE');}
$pack.=$lol;
if($pack=~/$AUTH_FAILED/){ex("ERROR: ".$AUTH_ER{$1});}
if($pack=~/$SRV_COOKIE/) {ex("Password: $password");}
$n++;
}
print "$pack\n";
close($socket);
exit;
}
for($i=0;$i<1;$i++)
{
$pid=fork();
if($pid eq '0'){✓}else{waitpid($pid,0);}
}
exit;
|
