fuzzyping has asked for the wisdom of the Perl Monks concerning the following question:
#!/usr/bin/perl use strict; use warnings; use Fcntl; use POSIX; use Net::OSCAR qw(:all); use Data::Dumper; my $aimuser = 'username'; my $aimpass = 'password'; my $nagiosuser = 'nagios'; my $home = '/usr/local/nagios/var'; my $input = 'aimbot.fifo'; my $log = 'aimbot.log'; my $debug = 0; my $pid = fork; exit if $pid; die "Couldn't fork: $!" unless defined $pid; POSIX::setsid() || die "Can't start a new session: $!"; my $time_to_die = 0; sub signal_handler { $time_to_die = 1; } $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler; until ($time_to_die) { sub signon_done { print LOG "SIGNON DONE: Successfully connected at `dat +e`"; } sub connection_changed { my($oscar, $connection, $status) = @_; print LOG "STATUS CHANGE: $status\n" if $debug; } sub admin_error { my($oscar, $reqtype, $error, $errurl) = @_; print LOG "ADMIN ERROR: $error, Please refer to $errur +l\n" if $debug; } sub buddylist_error { my($oscar, $error, $what) = @_; print LOG "BUDDYLIST ERROR: $what\n" if $debug; } sub error { my($oscar, $connection, $error, $description, $fatal) += @_; print LOG "ERROR: $description\n" if $debug; } sub rate_alert { my($oscar, $level, $clear, $window, $worrisome) = @_; print LOG "RATE ALERT: level=$level, clear=$clear, win +dow=$window, worrisome=$worrisome\n" if $debug; } sub snac_unknown { my($oscar, $connection, $snac, $data) = @_; print LOG "SNAC UNKNOWN: " . Dumper($snac) . "\n" if $ +debug; } sub log { my($oscar, $level, $message) = @_; print LOG "LOG \[$level\]: $message\n"; } sysopen(LOG, "$home/$log", O_WRONLY | O_APPEND | O_CREAT, 0664 +) || die "Can't open logfile $home/$log: $!"; select LOG; $|=1; $oscar = new Net::OSCAR; $oscar->set_callback_signon_done(\&signon_done); $oscar->set_callback_connection_changed(\&connection_changed); $oscar->set_callback_admin_error(\&admin_error); $oscar->set_callback_buddylist_error(\&buddylist_error); $oscar->set_callback_error(\&error); $oscar->set_callback_rate_alert(\&rate_alert); $oscar->set_callback_snac_unknown(\&snac_unknown); $oscar->set_callback_log(\&log); $oscar->loglevel(1); $oscar->signon(screenname => $aimuser, password => $aimpass) | +| die $!; unlink "$home/$input" if (-e "$home/$input"); POSIX::mkfifo("$home/$input", 0660) || die "Can't create $home +/$input: $!"; print LOG "$0: created $home/$input as a named pipe\n" || die +"Can't write to $home/$log: $!"; sysopen(IN, "$home/$input", O_NONBLOCK|O_RDONLY) || die "Can't + open named pipe: $!"; while (1) { $oscar->do_one_loop(); while (<IN>) { if (/\w+/) { /^(\w+)\:?(.*)$/; my($buddy, $message) = ($1, $2); $oscar->send_im($buddy, $message); } } } sysclose(IN); }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Unable to write logs or catch signals
by davidrw (Prior) on Jan 22, 2006 at 23:30 UTC | |
by fuzzyping (Chaplain) on Jan 23, 2006 at 00:26 UTC |