goodbyicq.pl

#!/usr/bin/env perl

use Net::OSCAR;
use Net::SMTP;
use Authen::SASL;
use HTML::Entities;
use Encode;
use strict;
use constant {
    SELFLOG => './run/icq.log', # stderr output goes here when daemon
    SELFPID => './run/icq.pid', # process pid goes here when daemon
    HISTDIR => './history', # directory for icq history
    TZ => 'Asia/Novosibirsk', # If server timezone different from that you prefer
    MAILHOST => 'smtp.list.ru', # smtp mail server
    MAILLOGIN => 'xxx@list.ru', # smtp login
    MAILPASSW => 'xxx', # smtp password
    MAILTO => 'xxx@gmail.com', # send mail here
    ICQLOGIN => '1234567', # icq uin
    ICQPASSW => 'xxxxxxx', # icq password
    STATUS => 'This is Net::OSCAR bot', # icq status
    BLACKLIST => ['3234343', '23444542'], # array of blacklisted uins
    BLACKMSG  => 'I hate you', # message for blacklisted
    MSG => "I can't use this shit anymore. Use email or jabber to contact me. Here it is: xxx\@gmail.com" # massage for others
};

if($ARGV[0] eq '-d') {
    require Proc::Daemon;
    Proc::Daemon->VERSION(0.05);

    Proc::Daemon->new(
        child_STDERR => SELFLOG ? SELFLOG: '/dev/null',
        pid_file => SELFPID,
        work_dir => '.',
    )->Init();
}

$ENV{'TZ'} = TZ;

my $CURDATE = date();
my $online = 1;
my $icq = Net::OSCAR->new(capabilities => ['extended_status']);
$icq->set_callback_signon_done(\&signon_done);
$icq->set_callback_im_in(\&im_in);
$icq->set_callback_error(\&error);
$icq->signon(screenname => ICQLOGIN, password => ICQPASSW);

$SIG{'INT'} = $SIG{'TERM'} = sub { $online = 0 };

while($online) {
    $icq->do_one_loop();

    if(HISTDIR && $CURDATE ne date()) {
        send_mail( get_html($icq) );
        $CURDATE = date();
    }
}
$icq->signoff();

sub signon_done
{
    my $icq = shift;
    $icq->set_extended_status(STATUS) if STATUS;
}

sub im_in
{
    my ($icq, $sender, $msg) = @_;

    if(HISTDIR) {
        my ($sec, $min, $hour) = localtime;

        my $subdir = HISTDIR . '/' . $CURDATE;
        unless(-e $subdir) {
            mkdir $subdir, 0755;
        }

        if($msg =~ /\00|\04/) {
            # icq, qip, other shit
            Encode::from_to($msg, 'ucs-2be', 'windows-1251');
        }

        open my $fh, '>>', $subdir . '/' . $sender;
        print $fh "<small>$hour:$min:$sec $CURDATE</small><br><pre>", encode_entities($msg, '\x0-\x40'), "</pre><hr>\n";
        close $fh;
    }

    if(BLACKLIST && array_exists(BLACKLIST, $sender)) {
        $icq->send_im($sender, BLACKMSG);
    }
    else {
        $icq->send_im($sender, MSG);
    }
}

sub error
{
    if($_[4]) {
        # fatal error
        die $_[3];
    }
    else {
        warn $_[3];
    }
}

sub array_exists
{
    my ($array, $needle) = @_;

    $needle eq $_ and return 1 foreach @$array;
    return 0;
}

sub date
{
    my ($mday, $mon, $year) = (localtime)[3,4,5];
    ++$mon;
    $year += 1900;
    return join('.', $mday, $mon, $year);
}

sub get_html
{
    my $icq = shift;

    my $subdir = HISTDIR . '/' . $CURDATE;
    opendir my $dh, $subdir
        or return;
    my $html;
    while(defined(my $f = readdir($dh))) {
        if($f ne '.' && $f ne '..') {
            $html .= "<h3>$f - " . $icq->buddy($f)->{alias} . "</h3>";
            open my $fh, $subdir . '/' . $f
                or next;
            local $/ = undef;
            $html .= <$fh>;
            close $fh;
        }
    }
    close $dh;

    return $html;
}

sub send_mail
{
    my $body = shift
        or return;
    my $smtp = Net::SMTP->new(MAILHOST);
    $smtp->auth(MAILLOGIN, MAILPASSW)
        or return;
    $smtp->mail(MAILLOGIN);
    $smtp->to(MAILTO);
    $smtp->data(
        "To: " . MAILTO . "\r\n",
        "Content-Type: text/html; charset=windows-1251\r\n",
        "Subject: new icq messages on $CURDATE\r\n\r\n",
        $body
    );
    $smtp->quit();
}