VPF::icq - разбор полетов oscar - Форум программистов

kirufka

Дата 28.12.2008, 07:08 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 25
Регистрация: 2.10.2008
Где: Москва

Репутация: нет
Всего: нет

Пытаюсь на perl'е написать маленький icq клиент, сделал подключение(это уверенно так как из finch'а меня выкидывает когда захожу через свой), но вот борюсь с выводом в онлайн, боюсь что будет дальше...
У меня вот есть вопрос кто знает, что такое $BOS_server_address и где его взять? он получается непосредственно от сервера или это статический адрес как login.icq.com . тоже самое и про $BOS_server_port. И если кто может привести код вывода контакта именно в онлайн чтобы хотябы было видно в списке контактов у других людей smile

. Привожу свой код, который в онлайн не выводит:

Код


#!perl
use warnings;
use strict;
use Socket;
use IO::Handle;
####################################################
my $DEBUG = 0;
my ($uin, $pass) = ($ARGV[0], $ARGV[1]);
####################################################
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 "NO :  $uin;$pass \n";
    } elsif($answer_data =~/(d*.d*.d*.d*):(d*)/o) {
        print "DEBUG $answer_data\n" if $DEBUG == 1;
        print "YES :  $uin;$pass \n";
    } else {
        print "DEBUG $answer_data\n" if $DEBUG == 1;
        print "ERROR  $uin;$pass  - So many enters. Try later\n";
    }
  close SOCK;
  undef $data;
  undef $flap;

  my $BOS_server_address = "login.icq.com";
  my $BOS_server_port = 5190;
  my $FlAP_header;
  $data="\x00\x00\x00\x01\x00\x06".pack('n',256).get_cookies($answer_data);
  ###########################
  $seq_num = 0 if $seq_num > 65535;
  $FlAP_header="\x2a\x01".pack('n',$seq_num++).pack('n',length($data));
  $auth_request=$FlAP_header.$data;

  socket(SOCK, AF_INET, SOCK_STREAM, getprotobyname('tcp')) or die "Cannot open socket: $!\n";
  connect(SOCK, sockaddr_in($BOS_server_port, inet_aton($BOS_server_address))) or return 0;
  SOCK->autoflush(1);
  sysread(SOCK,$answer_data,1024);
  print SOCK $auth_request;
  sysread(SOCK,$answer_data,1024);
  
  undef $data;
  undef $FlAP_header;
  
  $data="\x00\x01\x00\x17".("\x00" x 7)."\x01\x00\x03\x00\x02\x00\x01\x00\x03\x00\x01\x00\x  15\x00\x01\x00\x04\x00\x01\x00\x06\x00\x01\x00\x09  \x00\x01\x00\x0a\x00\x01";
  $seq_num = 0 if $seq_num > 65535;
  $FlAP_header="\x2a\x02".pack('n',$seq_num++).pack('n',length($data));
  $auth_request=$FlAP_header.$data;
  print SOCK $auth_request;
  sysread(SOCK,$answer_data,1024);
  
  undef $data;
  undef $FlAP_header;

  $data="\x00\x01\x00\x06".("\x00" x 6);
  $seq_num = 0 if $seq_num > 65535;
  $FlAP_header="\x2a\x02".pack('n',$seq_num++).pack('n',length($data));
  $auth_request=$FlAP_header.$data;
  print SOCK $auth_request;
  sysread(SOCK,$answer_data,2048);

  undef $data;
  undef $FlAP_header;
  
  $data="\x00\x01\x00\x08".("\x00" x 7)."\x01\x00\x02\x00\x03\x00\x04\x00\x05";
  $seq_num = 0 if $seq_num > 65535;
  $FlAP_header="\x2a"."\x02".pack('n',$seq_num++).pack('n',length($data));
  $auth_request=$FlAP_header.$data;
  print SOCK $auth_request;

  undef $data;
  undef $FlAP_header;

  $data="\x00\x01\x00\x1e".("\x00" x 7)."\x06\x00\x04\x01\00\x00\x00";
  $seq_num = 0 if $seq_num > 65535;
  $FlAP_header="\x2a\x02".pack('n',$seq_num++).pack('n',length($data));
  $auth_request=$FlAP_header.$data;
  print SOCK $auth_request;
  sysread(SOCK,$answer_data,2048);
  
  undef $data;
  undef $FlAP_header;

  $data="\x00\x01\x00\x02".("\x00" x 7)."\x01\x00\x03\x01\x10\x02\x8a\x00\x02\x00\x01\x01\x  01\x02\x8a\x00\x03\x00\x01\x01\x10\x02\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\x02\x8a\x00\x0a\x00\x01\x01\x10\x02\x  8a";
  $seq_num = 0 if $seq_num > 65535;
  $FlAP_header="\x2a\x02".pack('n',$seq_num++).pack('n',length($data));
  $auth_request=$FlAP_header.$data;
  print SOCK $auth_request;
  print "\n UIN: $uin ON-LINE.\n";
  sleep(5000);
  }
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=$_;
    }}
####################################################405114051
icq_check($uin, $pass);

юзается это по типу script.pl 363423583 vashparol

tolkien

Дата 28.12.2008, 09:47 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: 4
Всего: 4

Проблема не в perl, а в знании протокола ICQ. Может вам задать этот вопрос еще в какой нибудь разделе где разбирают сами сетевые протоколы.

kirufka

Дата 28.12.2008, 14:16 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 25
Регистрация: 2.10.2008
Где: Москва

Репутация: нет
Всего: нет

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

Но не знал куда запихнуть вопрос, только что в администрирование web-серверов и служб, но там что то все про apache итп... И решил раз язык на котором пишу perl то и запостить сюда... А то что проблема в знание протокола это да) они чото опять там мутят какую то фигню, то что нормальные доки в настоящее время найти сложно, с жабером все было проще smile

ЗЫ ща на свежую голову поискал, нашёл доку хорошую: http://iserverd1.khstu.ru/oscar кому интересно. А вопрос всё ещё действителен, хотелось бы увидеть кто как реализовывал коннект и получение контактлиста с этим чудо тупым протоколом

Это сообщение отредактировал(а) kirufka - 28.12.2008, 14:26

FooBar

Дата 29.12.2008, 04:34 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 58
Регистрация: 25.2.2008

Репутация: 1
Всего: 3

kirufka, после отсылки пакета с паролем тебе приходит ответ, в нём содержится адрес бос сервера, и 256 байт мусора, так называемых cookies, потом ты должен подключится к бос серверу и отослать ему эти 256 байт, точно уже не помню, там еще несколькими пакетами нужно обменяться, и после этого уже можно висеть онлайн, вот кстати моя тема http://forum.vingrad.ru/forum/topic-205213/kw-класс.html когда я заморачивался с осеку протоколом. Для разбора протокола удобен wireshark, так же можно посмотреть реализацию на пхп intrigue.ru, еще есть модуль Net::OSCAR

biophreak

Дата 30.12.2008, 09:37 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 72
Регистрация: 13.5.2007

Репутация: нет
Всего: нет

Ай-яй-яй, хоть бы копирайты на скрипт оставил...

PS: http://phreak.org.ru/icqsend.txt - скрипт выводит уин в онлайн и отсылает сообщение уину, который принял первым аргументом при запуске
PPS: Да, про код знаю, не ругайте...писался давно и под тяжелыми наркотиками

Это сообщение отредактировал(а) biophreak - 30.12.2008, 09:49

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »