VPF::уничтожение данных класса при вызове второго конст

FooBar

Дата 8.4.2008, 15:30 (ссылка)

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

Загрузка ...

Шустрый

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

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

написал небольшой класс для работы с icq,

Код


package Ociky;

use strict;
use Socket;

use constant {
SNAC1    => "\x00\x03\x00\x08\x49\x43\x51\x42\x61\x73\x69\x63\x00\x16\x00".
            "\x02\x01\x0A\x00\x17\x00\x02\x00\x14\x00\x18\x00\x02\x00\x22".
            "\x00\x19\x00\x02\x00\x00\x00\x1A\x00\x02\x09\x11\x00\x14\x00".
            "\x04\x00\x00\x04\x3D\x00\x0F\x00\x02\x65".
            "\x6E\x00\x0E\x00\x02\x75\x73",
Roast    => "\xF3\x26\x81\xC4\x39\x86\xDB\x92\x71\xA3\xB9\xE6\x53\x7A\x95\x7C",
SNAC2    => "\x00\x00\x00\x01\x00\x06\x01\x00",
SNAC3    => "\x00\x01\x00\x02\x00\x00\x00\x00\x00\x01\x00\x01\x00\x03\x01\x10".
            "\x02\x8A\x00\x02\x00\x01\x01\x10\x02\x8A\x00\x03\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",
mSNAC1   => "\x00\x04\x00\x06\x00\x00\x00\x00\x00\x02\x1D\x91\xEF\x52\xEA\x92\xD3\x3F\x00\x02",
mSNAC2   => "\x00\x00\x1D\x91\xEF\x52\xEA\x92\xD3\x3F\x09\x46\x13\x49\x4C\x7F".
            "\x11\xD1\x82\x22\x44\x45\x53\x54\x00\x00\x00\x0A\x00\x02\x00\x01".
            "\x00\x0F\x00\x00\x27\x11",
mSNAC3   => "\x1B\x00\x08".("\x00"x19)."\x03\x00\x00\x00\x00\x02\x00\x0E\x00".
            "\x02".("\x00"x13)."\x01\x00\x00\x00\x00\x01",
ICQ_Host => 'login.icq.com',
ICQ_Port => 5190
};

sub new {
    my (undef,$uin,$password) = @_;
    my $self = {};
    bless($self);
    my $SNAC = "\x00\x00\x00\x01\x00\x01".int2bytes(length($uin)).$uin.
               "\x00\x02".int2bytes(length($password)).
               substr($password^Roast,0,length($password)).SNAC1;
    my $FLAP = "\x2A\x01".seqNum().int2bytes(length($SNAC));
    my $socket;
    socket($socket,AF_INET,SOCK_STREAM,getprotobyname('tcp'));
    connect($socket,sockaddr_in(ICQ_Port,inet_aton(ICQ_Host)));
    
    my $response;
    recv($socket,$response,10,0);
    send($socket,$FLAP.$SNAC,0);
    recv($socket,$response,2048,0);
    close($socket);
    if(my($BOS_Host,$BOS_Port) = $response=~/(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(\d{1,5})/o) {
        my $i = 0;
        for(;;$i++) { last if substr($response,$i,4) eq "\x00\x06\x01\x00" }
        my $Cookie = substr($response,4+$i,256);
        print "[+] $uin reconnect to bos server: $BOS_Host:$BOS_Port\n";
        
        $SNAC = SNAC2.$Cookie;
        $FLAP = "\x2A\x01".seqNum().int2bytes(length($SNAC));
        
        socket($self->{SOCK},AF_INET,SOCK_STREAM,getprotobyname('tcp'));
        connect($self->{SOCK},sockaddr_in($BOS_Port,inet_aton($BOS_Host)));
        recv($self->{SOCK},$response,10,0);
        send($self->{SOCK},$FLAP.$SNAC,0);
        recv($self->{SOCK},$response,1024,0);
        
        $FLAP = "\x2A\x02".seqNum().int2bytes(length(SNAC3));
        send($self->{SOCK},$FLAP.SNAC3,0);
        return $self
    } else { return }
}

sub sendim {
    my $self = shift;
    my ($targetUin,$message) = @_;
    my $SNAC = mSNAC1.pack('h',length($targetUin)).$targetUin."\x00\x05".
               int2bytes(length($message)+102).mSNAC2.
               int2bytes(length($message)+62).mSNAC3.
               pack('v',length("$message\0")).$message.
               "\x00\x00\x00\x00\x00\xFF\xFF\xFF\x00";
    my $FLAP = "\x2A\x02".seqNum().int2bytes(length($SNAC));
    send($self->{SOCK},$FLAP.$SNAC,0)
}

BEGIN {
    my $seqNum = int(rand(65535));
    sub seqNum {
        $seqNum++;
        $seqNum = 0 if $seqNum > 65535;
        return int2bytes($seqNum)
    }
}

sub int2bytes { return pack('n',shift) }

1

вызываю его методы вот таким образом

Код


#!/usr/bin/perl -w
use strict;
use Ociky;

my $icq = Ociky->new(123456,'p@$$W0rD');
$icq->sendim(31337, 'Hello!');
<>;

номер выходит в онлайн, отсылает сообщение

но если вызвать вот так:

Код


#!/usr/bin/perl -w
use strict;
use Ociky;

my $icq1 = Ociky->new(4543534,'sdfdsfds');
my $icq2 = Ociky->new(7663434,'csd4dfd');
$icq2->sendim(31337, 'Hello!');
$icq1->sendim(31337, 'Hello!');
<>;

то приходит сообщение только с $icq2, а $icq1 заходит в сеть и сразу из нее вылетает. по всей видимости при вызове второго метода new происходит уничтожение данных класса $icq1, вопрос в том как от этой проблемы избавится?

tishaishii

Дата 8.4.2008, 17:49 (ссылка)

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

Загрузка ...

Создатель

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

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

use Net::ICQ

ginnie

Дата 8.4.2008, 17:59 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

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

FooBar, надо смотреть ошибки при соединении. Уничтожение данных класса $icq1 происходить не должно, т.к. там из данных только $self->{SOCK}.

Кроме того, неверно реализована функция seqNum(), т.к. она использует общую для всех объектов переменную $seqNum (по идее она должна быть для каждого объекта своя).

--------------------

Написать код, понятный компьютеру, может каждый, но только хорошие программисты пишут код, понятный людям. (Мартин Фаулер. Рефакторинг)

FooBar

Дата 8.4.2008, 18:53 (ссылка)

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

Загрузка ...

Шустрый

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

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

tishaishii, я знаю и о Net::ICQ и о Net::OSCAR, но мне прежде всего интересно разобраться в самом протоколе,
ginnie, спасибо, это происходило из за номера пакета который генерировался функцией seqNum(), хотя в описании протокола говорилось что он не имеет значения.
сам патч: $self->{SEQNUM} = sub { $seqNum++; $seqNum = 0 if $seqNum > 65535; return int2bytes($seqNum) }; &{$self->{SEQNUM}}

ginnie

Дата 8.4.2008, 19:06 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

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

FooBar, предлагаю нормальный вариант:

в конструкторе new() пишем

Код


$self->{SEQNUM} = int(rand(65535));

и модифицируем функцию seqNum()

Код


sub seqNum {
    $self->{SEQNUM}++;
    $self->{SEQNUM} = 0 if ($self->{SEQNUM} > 65535);
    return int2bytes($seqNum)
}

--------------------

nitr

Дата 8.4.2008, 23:45 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

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

Поддержу ответ ginnie, я так и делал (однажды).

FooBar, молодец, что решил разобраться. Сколько знаю, мало кто может понять протокол smile

Но ваш модуль "слишком тяжёлый". Например, метод new, такого стиля я ещё не встречал, думаю, стоит разделить на "функциональные" части. Вам же проще в дальнейшем будет.

P.S.: Если приноровиться, то как логгер ошибок можно использовать Data::Dumper::Dumper ;)

--------------------

I love ArchLinux

KSURi

Дата 9.4.2008, 00:28 (ссылка)

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

Загрузка ...

Опытный

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

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

nitr, спецификацию протокола открыли недавно.
Раньше оно посложнее было, имхо, т.к. люди полагались только на снифер. Я свой модуль (около года назад) так и не дописал дальше выхода в онлайн, не хватило терпения =(

--------------------

Died at Life.pl line 21

nitr

Дата 9.4.2008, 01:22 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

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

KSURi, так я приводил здесь несколько ресурсов на "неофициальное описание", которое хоть и было построено на данных сниффера и других источников, но работало "как часы" smile

Писать свой модуль, даже не знаю, имхо, только для изучения или мини-сервисов/ботов. А так надо, чтобы Net::OSCAR обновлялся и совершенствовался.
Открыли протокол это хорошо, но он проще от этого не стал ;)

--------------------

I love ArchLinux

KSURi

Дата 9.4.2008, 01:35 (ссылка)

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

Загрузка ...

Опытный

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

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

Да, я читал несколько "неофициальных" статей по исследованию протокола, но они были написаны для относительно старых версий (7ая против текущей 11ой) и там были описаны только процедуры логина и отправки сообщений.
Мне не хватило терпения доделать отправку/прием сообщения по той "документации", а вот как делать, например, получение офлайновых сообщений, direct connect, передавать файлы и прочие вещи, которые не были описаны вообще нигде, я слабо представлял.

--------------------

Died at Life.pl line 21

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