Даниил Подрабинек (grohman) wrote in ru_shell,
Даниил Подрабинек
grohman
ru_shell

MyICQbot

У всех ли есть внешний ip-адрес? Все ли могут, сидя на работе/в университете/где угодно скачивать на свой домашний ПК какие-либо файлы? Предположим, вам известен url фильма который вы хотели бы вечером посмотреть у себя дома. Но кому бы захотелось придя домой его скачивать, а не сразу смотреть? :)
Подобных примеров можно придумать очень много. Особенно, если нету внешнего ip-адреса (привет пользователям стрима;-) ).
Дабы решить эту вселенскую несправедливость, было решено написать icq-бота, который мог бы скачивать файлы на тот хост, на котором запущен. В качестве языка написания был выбран perl, потому как 1) для него уже существует Net::OSCAR.
2) За основу нашего бота был взят бот drmist'а написанный на perl %)

Прежде всего нужен работающий Net::OSCAR, которого у вас скорее всего нет. Ставится просто, через cpan.
# cpan
cpan > install Net::OSCAR

Бот понимает команды
!get url
!status filename

url может быть http или ftp. Или ещё что угодно, с чем умеет работать wget. 
Ну и ещё, конечно, нужно зарегистрировать уин для бота на icq.com %)
Очень интересные вещи описаны в man Net::OSCAR

#!/usr/bin/perl
$mypath = "~/MyICQDownloads";

use IO::Socket::INET;
use Net::OSCAR;
use Net::DNS;
use Text::Iconv;

%functions = ("get" => \&icq_bot_get,
"status" => \&icq_bot_status);

$conv = Text::Iconv->new('utf-8','windows-1251');
$resolver = Net::DNS::Resolver->new();
$oscar = Net::OSCAR->new();
$oscar->set_callback_im_in(\&message_callback);
$oscar->signon(999999999, "MyPass1") 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_get {
$url = $_[0];
local $get = "/usr/bin/wget -b -P $mypath $url";
@url=split /(.*\/)/, $url;
local $prog = system "$get -o $mypath/@url[2].log 1>&2 > /dev/null";
return "$url >>> downloading to $mypath\n Use \"!status @url[2]\" without quotes for last logs";
}

sub icq_bot_status {
local $file = $_[0];
$log = `tail -n 2 $mypath/$file.log`;
return $log;
}


Очевидно, что возможностей модернизации здесь крайне много.
Но всех мыслей в голове не удержишь (ну да, я тоже подумал об icq2ssh, наверное было бы забавно), хочется узнать ваше мнение и предложения по улучшению бота. Предложения с примерами кода категорически приветствуются.
Tags: perl wget icq
  • Post a new comment

    Error

    default userpic

    Your IP address will be recorded 

  • 2 comments