Пишем ICQ бота
В данной статье рассматривается пример создания ICQ-бота. В качестве операционной системы, под которую будет написан бот, была выбрана unix, как одна из самых распространенных (тут я имею ввиду все unixlike операционные системы: linux, *bsd, hp-ux, solaris и тп - лично я тестировал скрипт под FreeBSD). В качестве языка программирования - Perl, поскольку скрипты на перле легче всего переносимы между unixlike операционными системами. Первый вопрос, которым я себя озадачил при попытке написать icq-бота: как осуществить взаимодействие с icq-сервером? Изучать протокол icq и самому писать клиент на сокетах или использовать готовое решение? К сожалению, протокол icq не документирован (имеются только неофициальные описания) и к тому же часто меняется. Я решил воспользоваться наработками других программистов, благо, как выяснилось, в них нет недостатка.
Под перл существует по крайней мере четыре модуля для работы с протоколом icq: Net::ICQ, Net::ICQ2000, Net::ICQ2000_Easy и Net::OSCAR; Модуль Net::ICQ устарел и больше не является рабочим. Модуль Net::ICQ2000 рабочий, но предоставляет не очень удобный интерфейс для использования протокола. Net::ICQ2000_Easy является надстройкой над Net::ICQ2000 и компенсирует указанный недостаток. Однако мне не удалось найти его в портах, .pm модуль, взятый с оффсайта производителя будучи скопированным в /usr/local/lib/perl5/site_perl/5.8.8/Net и прописанным в директиве use непостижимым образом вызывал ошибку 'Can't locate Net/ICQ2000_Easy.pm in @INC...', cpan о таком модуле вобще не слышал. В общем даже если бы мне удалось установить этот модуль на локалхосте, у людей, которым захочется воспользоваться моим скриптом, возникла бы масса проблем. В результате я остановился на Net::OSCAR - модуль оказался рабочим и очень удобным.
Но модуль Net::OSCAR скорее всего не будет установлен на Вашей машине по умолчанию. Установить его можно либо через cpan:
Code
# cpan
cpan> install Net::OSCAR
cpan> exit
Либо, если у Вас FreeBSD - из портов:
Code
# cd /usr/ports/net-im/p5-Net-OSCAR
# make install clean && rehash
Полное описание модуля можно прочитать на соответствующих man-страницах
Code
# man Net::OSCAR
Его возможности действительно впечатляют. Можно не только обмениваться сообщениями, отслеживать изменения статуса пользователей, создавать группы и добавлять людей в список 'buddies', но и использовать прокси, обмениваться файлами и создавать комнаты. Не поддерживаются разве что игры типа шахмат и барашков smile.gif. Из ман-страниц наиболее важной для нас информацией являются основные методы класса Net::OSCAR.
signon(<uin>, <pass> [<host>, <port>]) - зайти в icq под уином <uin>, используя пароль <pass>. Функция имеет два необязательных параметра - хост и порт, соответствующие icq-серверу. По умолчанию - login.icq.com и 5190 соответственно. В случае ошибки возвращает 0, иначе - значение, отличное от нуля.
do_one_loop() - эту функцию нужно поместить в цикл в основном или отдельном потоке, чтобы класс обрабатывал данные, получаемые от сервера.
send_im(<uin>, <msg>) - послать сообщение <msg> на уин <uin>
signoff() - порвать соединение с сервером
set_callback_im_in(<func>) - установить обработчик входящих сообщений. функция-параметр будет принимать в качестве параметров объект icq-клиента, уин отправителя и сообщение.
Полученных знаний достаточно для того, чтобы принимать и обрабатывать команды. Осталось только придумать, что будет делать наш бот. Я решил долго не мучиться и впихнуть в него основные функции своего irc-бота (он еще не дописан, но некоторые из Вас уже могли видеть его демонстрацию). Вот команды, которым я научил своего бота:
!google <request> - поиск в гугле
!weather <city> - узнать погоду на сегодня в заданном городе
!dn2ip/ip2dn <dn> - определить IP, соответствующий заданному доменному имени/обратное преобразование
!mx <host> - получить MX записи для заданного хоста
С реализацией этих функций, а также всего бота в целом, можно ознакомится, посмотрев в прилогающийся исходный код:
Code
#! /usr/bin/perl
# Простой icq-бот на перле
# (ц) drmist@STNC 2006
use IO::Socket::INET;
use Net::OSCAR;
use Net::DNS;
use Text::Iconv;
%functions = ("google" => \&icq_bot_google,
"weather" => \&icq_bot_weather,
"dn2ip" => \&icq_bot_dn2ip,
"ip2dn" => \&icq_bot_ip2dn,
"mx" => \&icq_bot_mx);
$conv = Text::Iconv->new('utf-8','windows-1251');
$resolver = Net::DNS::Resolver->new();
$oscar = Net::OSCAR->new();
$oscar->set_callback_im_in(\&message_callback);
# свезло мне однако такой симпотный девятизнак c первого раза зарегать
$oscar->signon(353567373, "Password") or die("Login failed\n");
$quit = 0;
while(!$quit) { $oscar->do_one_loop(); }
sub message_callback {
local($cmd, $params, $result);
local $result = "";
local($client, $uin, $msg) = @_;
if(($cmd, $params) = $msg =~ /^\!([^\ ]+) (.+)$/)
{
$result = exists($functions{$cmd}) ? $functions{$cmd}($params) : "";
$client->send_im($uin, $result) if $result;
}
}
sub icq_bot_dn2ip { local $dn = $_[0]; local $t = gethostbyname($dn); return $t ? "$dn\'s ip is ".inet_ntoa($t) : "Host does not exists"; }
sub icq_bot_ip2dn { local $ip = $_[0]; local $dn = gethostbyaddr(inet_aton($ip), AF_INET); return $dn ? "$ip == $dn" : "Failed";}
sub icq_bot_mx {
local $curr; local $result = ""; local $host = $_[0];
local @mx = mx($resolver, $host) or return " Failed";
foreach $curr(@mx) { $result .= " ".$curr->preference." - ".$curr->exchange.";"; }
return $result;
}
sub icq_bot_google {
local($url, $title, $text);
local($request) = $_[0];
local $data = http_get("www.google.com", "/search?filter=0&hl=ru&num=1&start=0&q=".url_encode($request), 1);
if(($url, $title, $text) = $data =~ /<h2 class=r><a class=l href=\"([^\"]+)\">(.+)<table border=0 cellpadding=0 cellspacing=0><tr><td class=j><font size=-1>(.+)<br><span class=a>/) {
$title = html_decode($conv->convert($title)); $text = html_decode($conv->convert($text));
if($title =~ /^(.+) \- \[ [^\]]+ \]$/){ $title = $1; }
return "$title: $text [$url]"; }
else { return "Nothing found"; }
}
sub icq_bot_weather {
local $tmp;
local $request = $_[0];
local $result = "";
local $data = http_get("weather.yandex.ru", "/search.xml?text=".url_encode($request), 0);
if(($tmp) = $data =~ /Location: \.([^\r\n]+)\r\n/)
{
$data = http_get("weather.yandex.ru", $tmp, 1);
($tmp) = $data =~ /<h2><b>([^\<]+)<\/b>/; $result = "$tmp: ";
($tmp) = $data =~ /<tr><td class=\"t t[0-9]{1,2}\">([^\<]+)<b><i><\/i><\/b><\/td>/; $result .= "$tmp ";
$result .= join(". ", $data =~ /<td><div>([^\<]+)<\/div>([^\<]+)<\/td><td><div>([^\<]+).<\/div>([^\<]+)<\/td><td><div>([^\<]+)<\/div>([^\<]+)<\/td>/);
return $result;
} else { return "Nothing found"; }
}
sub http_get {
local $tmp;
local $data = "";
local ($host, $request, $skip_headers) = @_;
local $sock = IO::Socket::INET->new("$host:80") or return "";
print $sock "GET $request HTTP/1.0\r\nHost: $host\r\nAccept-Charset: cp1251;q=0.7,*;q=0.7\r\n".
"User-Agent: Mozilla/5.0 (X11; U; FreeBSD i386; en-US; rv:1.8.0.4) Gecko/20060903 Firefox/1.5.0.4\r\n\r\n";
while(sysread($sock, $tmp, 1024) > 0){ $data .= $tmp; }; close $sock;
if($skip_headers){ $tmp = index($data, "\r\n\r\n") + 4; $data = substr($data, $tmp, length($data) - $tmp); }
return $data;
}
sub url_encode {
local $text = $_[0];
$text =~ s/([^a-zA-Z0-9]{1})/sprintf("%%%02x",ord($1))/eg;
return $text;
}
sub html_decode {
local $data = $_[0];
$data =~ s/\<[^\>]+\>//g;
$data =~ s/\<\;/\</;
$data =~ s/\>\;/\>/;
$data =~ s/\"\;/\"/;
$data =~ s/\&\;/\&/;
$data =~ s/\·\;/\xB7/;
return $data;
}