#!/usr/bin/perl -w

# Simple authorization/sending/receiving script special for Poizon.Net.Ru

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

sub print_data;
sub get_cookies;
sub xor_password;
sub list_services;
sub get_in_icq;
sub get_in_msg;

my $server="login.icq.com"; # авторизатор
my $port=5190; # порт авторизатора

my $uin="330866043"; # уин, нак который заходить
my $password="vivviv"; # пароль
my $client_id="Fake icq-client special for poizon.net.ru =)"; #версия клиента в STRING

my $to_uin="822003"; # куда слать месагу
my $send_message="justa test!! Do Not Reply To This Message!!"; # текст сообщения

my %families_list= ( #расшифровка номеров групп сервисов
1 => "Generic service controls",
2 => "Location services",
3 => "Buddy List management service",
4 => "ICBM (messages) service",
5 => "Advertisements service",
6 => "Invitation service",
7 => "Administrative service",
8 => "Popup notices service",
9 => "Privacy management service",
10 => "User lookup service (not used any more)",
11 => "Usage stats service",
12 => "Translation service",
13 => "Chat navigation service",
14 => "Chat service",
15 => "Directory user search",
16 => "Server-stored buddy icons (SSBI) service",
19 => "Server Side Information (SSI) service",
21 => "ICQ specific extensions service",
23 => "Authorization/registration service",
34 => "Unknown",
133 => "Broadcast service - IServerd extension"
);

my $i=0;
my $temp_string;
my $answer_data;  # ответ сервера
my $auth_request; #посылаемый пакет

my $FlAP_header; # заголовок FLAP пакета (сигнатура начала данных, номер канала,  sequence number, длина данных)
my $data; # данные пакета
my $BOS_server_address; # ип основного сервера для работы с icq
my $BOS_server_port; # порт сервера

$data= #(основнные данные)
"\x00\x00\x00\x01". #версия протокола
"\x00\x01".pack('n',length($uin)).$uin. #сигнатура уина, длина уина, уин
"\x00\x02".pack('n',length($password)).xor_password($password). #то же для пароля
"\x00\x03".pack('n',length($client_id)).$client_id. # то же для клиента
"\x00\x16".pack('n',2).pack('n',266). # версии клиента: мажор, минор, билд и тд
"\x00\x17".pack('n',2).pack('n',4). # -||-
"\x00\x18".pack('n',2).pack('n',65). # -||-
"\x00\x19".pack('n',2).pack('n',1). # -||-
"\x00\x1A".pack('n',2).pack('n',3281). # -||-
"\x00\x14".pack('n',4).pack('N',85). # -||-
"\x00\x0F".pack('n',2)."en". # язык клиента
"\x00\x0E".pack('n',2)."us"; # страна клмента

$FlAP_header=
"\x2a". #всегда! начинается с \x2a
"\x01". # первый канал (New Connection Negotiation)
"\x13\x5A". # seq number (random). 
pack('n',length($data)); # размер данных ($data). WORD

$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);

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

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... Exiting\n";
exit;
}
print "\n\n  Authorization success...\n";

close(SOCK);

#  GETTING BOS ADRESS/PORT

($BOS_server_address, $BOS_server_port)=$answer_data=~/\x2a\x04.{4}\x00\x01.{2}$uin\x00\x05.{2}([0-9\.]+):([0-9]+)\x00/;
#получаем BOS server address и BOS server port

# ---------- Client sends cookie (cli_cookie) /oscar_spec/cli_cookie.html
undef $data;
undef $FlAP_header;

$data=
"\x00\x00\x00\x01". #версия протокола
"\x00\x06".pack('n',256).get_cookies($answer_data); #0x00006 (сигнатура куки), длина куки (256), сами куки из предыдущего запроса

$FlAP_header= # формируем FLAP заголовок (1 канал)
"\x2a".
"\x01".
"\x13\x5B".
pack('n',length($data));

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

print "\n\n  Connecting to BOS server ($BOS_server_address:$BOS_server_port)...";

socket(SOCK,AF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "socket() failed: $!\n";
connect(SOCK,sockaddr_in($BOS_server_port,inet_aton($BOS_server_address))) or return 0;
SOCK->autoflush(1); # конектим к BOS серверу

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

print "\n\n  Sending cookies to server...\n"; #шлём FLAP пакет с куками
print_data($auth_request);
print SOCK $auth_request;

print "\n\n  Reading server answer (SRV_FAMILIES)...\n"; #получаем ответ (список номеров доступных сервисов)
sysread(SOCK,$answer_data,1024);
print_data($answer_data);

# ---------- Server sends supported services list (SNAC(01,03)) /oscar_spec/snac_01_03.html
$answer_data=substr($answer_data,16,length($answer_data)); # отрезаем лишние байты
print "\n\n Supported services:\n"; 
list_services($answer_data); # выводим список групп сервисов с расшифровкой


# ----------- Client ask for services version numbers (SNAC(01,17)) /oscar_spec/snac_01_17.html

undef $data;
undef $FlAP_header;

$data= #формируем запрос на получение версий служб
"\x00\x01". # SNAC family # запрос для первой группы (Generic service controls)
"\x00\x17". # SNAC subtype # служба (SNAC 01_17) Request server services versions
"\x00\x00". # SNAC flags # флаги
"\x00\x00\x00\x00". # SNAC request-id (random)
# from CenterICQ
"\x00\x01". # family number #1
"\x00\x03". # family version

"\x00\x02". # family number #2
"\x00\x01". # family version

"\x00\x03". # etc. и тд
"\x00\x01". # etc.

"\x00\x15". # etc.
"\x00\x01". # etc.

"\x00\x04". # etc.
"\x00\x01". # etc.

"\x00\x06". # etc.
"\x00\x01". # etc.

"\x00\x09". # etc.
"\x00\x01". # etc.

"\x00\x0a". # etc.
"\x00\x01"  # etc.
;

$FlAP_header= #формируем FLAP заголовок (2 канал)
"\x2a".
"\x02". # второй канал (SNAC data)
"\x13\x5c".
pack('n',length($data));

$auth_request=$FlAP_header.$data;

print "\n\n  Sending request for family versions to server...\n";
print_data($auth_request);
print SOCK $auth_request;

print "\n\n  Reading server answer (SRV_FAMILIES_VERSIONS)...\n"; # получаем версии служб
sysread(SOCK,$answer_data,1024);
print_data($answer_data);

# ----------- Server sends its services version numbers (SNAC(01,18)) /oscar_spec/snac_01_18.html

#

# -----------  Client ask server for rate limits info (SNAC(01,06)) /oscar_spec/snac_01_06.html

undef $data;
undef $FlAP_header;

$data= #составляем запрос на получение списка ограничений сервера
"\x00\x01". # группа 1
"\x00\x06". # сервис 0x0006 (Request rate limits information)
"\x00\x00". # флаги
"\x00\x00\x00\x00"; #ид

$FlAP_header=
"\x2a".
"\x02". # второй канал
"\x13\x5d".
pack('n',length($data));

$auth_request=$FlAP_header.$data;

print "\n\n  Sending request for rate limits info...\n";
print_data($auth_request);
print SOCK $auth_request;

print "\n\n  Reading server answer (SRV_RATE_LIMIT_INFO)...\n";
sysread(SOCK,$answer_data,2048);
print_data($answer_data);

# -----------  Server sends rate limits information (SNAC(01,07)) /oscar_spec/snac_01_07.html

#

# ----------- Client ack connection rate limits (SNAC(01,08)) /oscar_spec/snac_01_08.html

undef $data;
undef $FlAP_header;

$data=      #From CenterICQ
"\x00\x01".
"\x00\x08".
"\x00\x00".
"\x00\x00\x00\x00".
"\x00\x01".
"\x00\x02".
"\x00\x03".
"\x00\x04".
"\x00\x05"
;

$FlAP_header=
"\x2a".
"\x02".
"\x13\x5e".
pack('n',length($data));

$auth_request=$FlAP_header.$data;

print "\n\n  ack connection rate limit...\n";
print_data($auth_request);
print SOCK $auth_request;

# ----------- Client sends its status to server (SNAC(01,1E)) /oscar_spec/snac_01_1e.html

undef $data;
undef $FlAP_header; 

$data= # составляем запрос на передачу серверу своего статуса (online)
"\x00\x01". # первая группа служб
"\x00\x1e". # сервис 0x001e (Set status (set location info)) SNAC 01_1e
"\x00\x00". # флаг
"\x00\x00\x00\x00". # ид
"\x00\x06". # TLV.Type = 0x0006 (Type-Length-Value)user status / status flags
"\x00\x04". # длина TLV
"\x01\00\x00\x00" # данные TLV (статус юзера - online. смотри /oscar_spec/lists.html#user_status)
;

$FlAP_header=
"\x2a".
"\x02". #второй канал
"\x13\x5f".
pack('n',length($data));

$auth_request=$FlAP_header.$data;

print "\n\n  Sending status to server...\n";
print_data($auth_request);
print SOCK $auth_request;

print "\n\n  Reading server answer... (SNAC(01,0F))\n";
sysread(SOCK,$answer_data,2048);
print_data($answer_data);

# ---------- reading server response (SNAC(01,0F))

#

# ---------- Client READY command (SNAC(01,02))

undef $data;
undef $FlAP_header; # From cemterICQ

$data= # отсылаем команду READY серверу (необходимо отослать в течении первых 30 секунд)
"\x00\x01". # номер группы 1
"\x00\x02". # номер службы (Client is now online and ready for normal function)
"\x00\x00". # флаг
"\x00\x00\x00\x00". #ид

"\x00\x01". # family number #1
"\x00\x03". # family #1 version
"\x01\x10". # family #1 tool id
"\x02\x8a". # family #1 tool version

"\x00\x02". # etc.
"\x00\x01".
"\x01\x01".
"\x02\x8a".

"\x00\x03". # etc
"\x00\x01".
"\x01\x10".
"\x02\x8a".

"\x00\x15".
"\x00\x01".
"\x01\x10".
"\x02\x8a".

"\x00\x04".
"\x00\x01".
"\x01\x10".
"\x02\x8a".

"\x00\x06".
"\x00\x01".
"\x01\x10".
"\x02\x8a".

"\x00\x09".
"\x00\x01".
"\x01\x10".
"\x02\x8a".

"\x00\x0a".
"\x00\x01".
"\x01\x10".
"\x02\x8a";

$FlAP_header=
"\x2a".
"\x02".
"\x13\x60".
pack('n',length($data));

$auth_request=$FlAP_header.$data;

print "\n\n  Sending READY command to server...\n";
print_data($auth_request);
print SOCK $auth_request; # отправляем серверу и мы он-лайн!

print "\n\n  UIN ON-LINE...\n";

# --------- SENDING MESSAGE ------------ #

# отсылаем сообщение на уин

undef $data;
undef $FlAP_header;

my $part1= # формируем запрос для отправки сообщения по каналу 2
"\x00\x04\x00\x06". # # группа 4 (ICBM service) служба 6 ( Send message thru server)
"\x00\x00". # флаг
"\x00\x00\x00\x00". # ид
"\xe4\x70\x7c\xbf". # msg-id ид сообщения
"\x67\xfd\x91\x6f". # msg-id ид сообщения
"\x00\x02". # channel второй канал для отсылки сообщения
pack("w",length($to_uin)). # icq length длина icq получателя
$to_uin. # icq получателя
"\x00\x05"; # TLV.Type(0x05) - rendezvous message data, установка значения
# тут длина TLV, но его мы вставим позже
my $part2=
"\x00\x00". # message type, тип сообщения
"\xe4\x70\x7c\xbf". # msg-id ид (то же что и выше)
"\x67\xfd\x91\x6f". # msg-id ид (то же что и выше)
"\x09\x46\x13\x49\x4c\x7f\x11\xd1\x82\x22\x44\x45\x53\x54\x00\x00". # guid (формат данных) смотри /oscar_spec/capabilities.html (09461349-4c7f-11d1-8222-4445535-40000)
"\x00\x0a". # unknown TLV.Type хз 
"\x00\x02". # Length длина этого хз
"\x00\x01". # unknown хз
"\x00\x0f". # unknown TLV.Type
"\x00\x00". # Length
"\x27\x11"; # TLV.Type(0x2711) - extention data (устанавливаем данные)
# тут должна быть блина TLV 0x2711,, но её мы установим позже
my $part3=
"\x1b\x00". # length of following data
"\x07\x00". # protocol version
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00". # plugin or zero bytes хз что
"\x00\x00". # unknown хз
"\x03\x00\x00\x00". # client capabilities flags хз
"\x00". # unknown хз
"\xe9\xff". # seems to be a downcounter хз
"\x0e\x00". # length of following data
"\xe9\xff". # seems to be a downcounter хз
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00". # unknown, usually zeros хз
"\x01". # message type типа сообщения (01 - plain text)
"\x00". # message flags
"\x00\x00". # status code
"\x01\x00". # priority code

pack("v",length("$send_message\0")). #  длина сообщения
"$send_message\x00". # само сообщение с \0 в конце
"\x00\x00\x00\x00". # text color (rgbn, optional)
"\xff\xff\xff\x00"; # background color (rgbn, optional)

$data=$part1.pack('n',length($part2.$part3)+2).$part2.pack('n',length($part3)).$part3; # составляем данные, подставляя все TLV размеры

$data.=
"\x00\x03". # request an ack from server (требовать от сервера ответ)
"\x00\x00"; # длина TLV данных (0)

$FlAP_header= # FLAP заголовок
"\x2a".
"\x02".
"\x13\x61".
pack('n',length($data));

$auth_request=$FlAP_header.$data;

print "\n\n  Sending message to server...\n";
print_data($auth_request);
print SOCK $auth_request; # отсылаем запрос и соотвественно сообщение

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


while(1){
sysread(SOCK,$answer_data,2048); # ждём входящих сообщений (очень хуёво)
print "\n\nIncoming message from ".get_in_icq($answer_data).": \n"; # выводим их на экран (очень хуёво)
print get_in_msg($answer_data)."\n"; #(очень хуёво)
}
## FUNCTIONS

sub print_data() { # выводим данные в hex

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

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

}

}

sub get_cookies() { # выдераем куки из ответа сервера 

my ($data)=@_;
my $cookies;
my $i=0;
my $c=0;
foreach(split(//,$data)) {
$i=1 if($c eq "\x00" && $_ eq "\x06");
$cookies.=$_ if $i eq 1;
$c=$_;
}
return substr($cookies,3,length($cookies));

}

sub xor_password() { # ксорим пароль

my ($password)=@_;

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;
}

return $xored_password;

}

sub list_services() { # делаем список групп служб
my ($data)=@_;
my $temp_string;
while($temp_string=substr($data,0,2)) {

print unpack('n',$temp_string)." (0x".unpack('H8',$temp_string).") ".
$families_list{unpack('n',$temp_string)}."\n";

$data=substr($data,2,length($data));
}

}

sub get_in_icq() { # ведыерам номер icq из входящего сообщения (очень хуёво)
my ($data)=@_;
my $icq;
$icq=substr($data,27,length($data));
$icq=~/^([0-9]+)/;
return $1;
}


sub get_in_msg() { # выдераем текст сообщения (очень хуёво)
my ($data)=@_;
$data=~/^.{6}\x00\x04\x00\x07.+\x00(.+)$/;
return $1;
}