#!/usr/bin/perl -w  

# Sample of icq authorization
# Cyber Lords Community http://www.cyberlords.net

use Socket;  
use IO::Handle;  
use strict;  

sub print_data;  

my $server="login.icq.com";  
my $port=5190;  

my $uin="338953910";  
my $uin_length = pack('n',length($uin)); #длина уина в DWORD  

my $password="000666";  
my $password_length = pack('n',length($password)); #длина пароля в DWORD  

my $client_id="Fake icq-client special for poizon.net.ru =)"; #версия клиента в STRING  
my $client_id_length = pack('n',length($client_id)); # длина версии клиента в DWORD  

my @password_xor=("\xF3", "\x26", "\x81", "\xC4", "\x39", "\x86", "\xDB", "\x92", "\x71", "\xA3", "\xB9", "\xE6", "\x53", "\x7A", "\x95","\x7C"); # константы для "шифровки" пароля  

my $xored_password; # проксореный пароль  
my $i=0;  
foreach(split(//,$password)) {  
$xored_password.=$_ ^ $password_xor[$i++];  
$i=0 if $i eq @password_xor;  
} # ксорка пароля =)  

my $FLAP_id_byte="\x2a"; #всегда 2a #BYTE  
my $FLAP_channel="\x01"; # первый канал (New Connection Negotiation) #BYTE  
my $FLAP_datagram_seq_number="\x13\x5A"; #seq number. Случайно. должно быть больше 0x8000 и с каждой командой увеличиваться #WORD  
my $FLAP_data_size; # длина данных (не считая FlAP_header) #WORD  

my $FlAP_header; # заголовок FlAP  

my $data_protocol_version_number="\x00\x00\x00\x01"; #DWORD #версия протокола  
my $data_uin="\x00\x01".$uin_length.$uin; #STRING # 0001 - сигнатура уина  
my $data_password="\x00\x02".$password_length.$xored_password;      #STRING  
my $data_client_id_string="\x00\x03".$client_id_length.$client_id;  #STRING *версия клиента  
my $data_client_id_number="\x00\x16".pack('n',2).pack('n',266);     #WORD #хз, какая-то версия  
my $data_client_major_version="\x00\x17".pack('n',2).pack('n',4);   #WORD тут версии клиента  
my $data_client_minor_version="\x00\x18".pack('n',2).pack('n',65);  #WORD тут версии клиента  
my $data_client_lesser_version="\x00\x19".pack('n',2).pack('n',1);  #WORD тут версии клиента  
my $data_client_build_number="\x00\x1A".pack('n',2).pack('n',3281); #WORD тут версии клиента  
my $data_distribution_number="\x00\x14".pack('n',4).pack('N',85);   #DWORD тут версии клиента  
my $data_client_language="\x00\x0F".pack('n',2)."en";    #STRING язык клиента  
my $data_client_country="\x00\x0E".pack('n',2)."us";     #STRING страна клиента  

my $data; #формируем данные пакета  
$data.=$data_protocol_version_number;  
$data.=$data_uin;  
$data.=$data_password;  
$data.=$data_client_id_string;  
$data.=$data_client_id_number;  
$data.=$data_client_major_version;  
$data.=$data_client_minor_version;  
$data.=$data_client_lesser_version;  
$data.=$data_client_build_number;  
$data.=$data_distribution_number;  
$data.=$data_client_language;  
$data.=$data_client_country;  

$FLAP_data_size=pack('n',length($data));  

$FlAP_header.=$FLAP_id_byte; #формируем заголовок FLAP  
$FlAP_header.=$FLAP_channel;  
$FlAP_header.=$FLAP_datagram_seq_number;  
$FlAP_header.=$FLAP_data_size;  

my $auth_request=$FlAP_header.$data; # формируем пакет  

print "\n Connecting...\n";  
socket(SOCK,AF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "socket() failed: $!\n";  
connect(SOCK,sockaddr_in($port,inet_aton($server))) or return 0;  
SOCK->autoflush(1);  

my $answer_data;  

print "\n  Reading server welcom message...\n"; #получаем строку от сервера  
sysread(SOCK,$answer_data,1024);  
print_data($answer_data);  

print "\n\n  Sending auth packet...\n"; #шлём пакет  
print SOCK $auth_request;  
print_data($auth_request);  

print "\n\n  Reading answer...\n"; # получаем ответ (либо cookies в случае success, либо код ошибки)  
sysread(SOCK,$answer_data,1024);  
print_data($answer_data);  

if ($answer_data=~/\x00\x08/) {  
print "\n\n  Authorization error...";  
} else {  
print "\n\n  Authorization success...";  
}  

print "\n\n Exiting...\n";  
exit;  

sub print_data() {  

my ($data)=@_;  
my $i;  

foreach(split(//,$data)) {  
print unpack('H8',$_)." ";  
$i++;  
if ($i eq 16) {  
print "\n";  
$i=0;  
}  

}  

}