#!/usr/local/bin/perl
#
# Copyright (c) 2003-2008 Jeremy Kister
# Author: Jeremy Kister <devel @t jeremykisterc.om>
# Date: 2008-June-15 03:18 (EDT)
# Function: send messages via AIM/OSCAR

use strict;
use Net::OSCAR;
use Getopt::Std;
use Sys::Syslog;
use POSIX 'setsid';

$| = 1; #flush
my $idle_time=0;
my $commit_ok = 1; # 0 pending(not ok), 1=never commited, 2=flagged 0
my $allow_bfs=0;
my (%opt,%buddies,%ids,%hush,$sentaway,%autoack);
chdir('/') || die "could not chdir /: $!\n";

getopts('u:g:d:s:p:Db:f', \%opt);

$SIG{USR1} = sub {
	log_msg("received SIGUSR1: running queue");
	$idle_time = 0;
};

my $naim_user = $ENV{'NAIM_USER'} || $opt{s};
my $naim_pass = $ENV{'NAIM_PASS'} || $opt{p};

unless($naim_user && $naim_pass && $opt{b}){
	print <<EOH;
	naimd -s <screenname> -p <password> -b <Buddies> [-u <username>] [-g <group>] [-D] [-f] [-d </path/argus/sbin>] [-l facility]
	options:
		-s	AIM screenname (or set NAIM_USER in environment)
		-p	AIM password (or set NAIM_PASS in environment)
		-b	list of buddies (separate multiples by comma, no spaces in usernames)
		-u	username to run as
		-g	group to run as
		-D	print debugging info
		-f	run in foreground
		-d	path to sbin area
		-l	syslog facility
EOH
	;
	exit;
}

my $facility = $opt{l} || 'local1';

openlog( 'naimd', 'pid', $facility ) if($opt{D});

my $childpid;
daemonize(2) unless($opt{f});

# Change to nobody if you'd like, or to a user who has argusctl permissions.
if(defined($opt{g})){
	my $gid = (getgrnam($opt{g}))[2];
	$gid = $opt{g} if( !defined($gid) && $opt{g} =~ /^\d+$/ );
	slowdie("invalid group for -g option. aborting.") unless defined $gid;
	$( = $gid; $) = $gid;
}
if(defined($opt{u})){
	my $uid = (getpwnam($opt{u}))[2];
	$uid = $opt{u} if( !defined($uid) && $opt{u} =~ /^\d+$/ );
	slowdie("invalid user for -u option. aborting.") unless defined $uid;

	# fix /var/naim/ if owned by anyone other than $opt{u}

	if(-d '/var/naim/'){
		my $diruid = (stat('/var/naim/'))[4];
		if($uid != $diruid){
			log_msg("/var/naim not owned by $opt{u}: fixing..");
			chown($uid,$(,'/var/naim/') || slowdie("cannot chown /var/naim/ $!");
		}
		if(-d '/var/naim/queue'){
			my $diruid = (stat('/var/naim/queue/'))[4];
			if($uid != $diruid){
				log_msg("/var/naim/queue not owned by $opt{u}: fixing..");
				chown($uid,$(,'/var/naim/queue/') || slowdie("cannot chown /var/naim/queue/: $!");
			}
			# fix /var/naim/queue/ files if owned by anyone other than $opt{u}, (so we dont keep dying)
			if(opendir(DIR, '/var/naim/queue/')){
				foreach my $subdir (grep {!/^\./} readdir DIR){
					my $sdiruid = (stat("/var/naim/queue/${subdir}"))[4];
					if($sdiruid != $uid){
						log_msg("/var/naim/queue/${subdir} not owned by $opt{u}: fixing..");
						chown($uid,$(,"/var/naim/queue/${subdir}/") || slowdie("cannot chown $subdir/: $!");
					}
						
					if(opendir(SUBDIR, "/var/naim/queue/$subdir")){
						foreach my $file (grep {!/^\./} readdir SUBDIR){
							if($subdir eq 'tmp'){
								# files are worthless, could be half-written, unknown recips, etc.
								unlink("/var/naim/queue/tmp/$file") || log_msg("could not unlink tmp/$file: $!");
							}else{
								my $fileuid = (stat("/var/naim/queue/${subdir}/${file}"))[4];
								if($uid != $fileuid){
									log_msg("/var/naim/queue/${subdir}/${file} not owned by $opt{u}: fixing..");
									chown($uid,$(,"/var/naim/queue/${subdir}/${file}") || slowdie("cannot chown $file: $!");
								}
							}
						}
						closedir SUBDIR;
					}
				}
				closedir DIR;
			}	
		}else{
			log_msg("/var/naim/queue/ does not exist - creating..");
			mkdir('/var/naim/queue',0700) || slowdie("cannot create /var/naim/queue/: $!");
			chown($uid,$(,'/var/naim/queue/') || slowdie("cannot chown /var/naim/queue/: $!");
		}
	}else{
		log_msg("/var/naim/ does not exist - creating..");
		mkdir('/var/naim/',0700) || slowdie("cannot create /var/naim/: $!");
		chown($uid,$(,'/var/naim/') || slowdie("cannot chown /var/naim/: $!");
		log_msg("/var/naim/queue does not exist - creating..");
		mkdir('/var/naim/queue',0700) || slowdie("cannot create /var/naim/queue/: $!");
		chown($uid,$(,'/var/naim/queue/') || slowdie("cannot chown /var/naim/queue/: $!");
	}

	$! = 0;
	$< = $> = $uid;
	die "unable to change uid: $!\n" if $!;
}

my $sbin = $opt{d} || '/usr/local/sbin';
$opt{b} =~ s/\s+//g;
my @buddies = split(/,/, lc($opt{b}));

log_msg("Starting Server...");

my $aim = Net::OSCAR->new();
# Set up the handlers for commands issued by the server.
$aim->set_callback_signon_done(\&signon_done);
$aim->set_callback_im_in(\&im_in);
$aim->set_callback_im_ok(\&im_ok);
$aim->set_callback_error(\&error);
$aim->set_callback_evil(\&evil);
$aim->set_callback_buddy_info(\&buddy_info);
$aim->set_callback_buddylist_ok(\&buddylist_ok);
$aim->set_callback_buddylist_error(\&buddylist_error);
$aim->set_callback_buddy_in(\&buddy_in);
$aim->set_callback_buddy_out(\&buddy_out);

while(1){
	unless($aim->is_on){
		signon($aim);
	}
	# check to see if we have incoming messages waiting
	$aim->do_one_loop();

	run_queue();

	if($idle_time <= 5){
		if($sentaway){
			log_msg("WHO!? WHA!? -- damn it.. i hate being woken up!");
			$aim->set_away();
			$sentaway=0;
		}
		$idle_time++;
	}elsif($idle_time <= 20){
		sleep 1;
		$idle_time++;
	}else{
		sleep 5;
		$idle_time += 5;
		unless($sentaway){
			if($idle_time > 180){
				log_msg("<yawn> -- taking a nap..");
				$aim->set_away("Taking a nap..");
				$sentaway=1;
			}
		}
	}
}

sub run_queue {
	# check to see if we have outgoing messages waiting
	if(opendir(DIR, '/var/naim/queue/')){
		foreach my $subdir (grep {!/^(?:\.|tmp)/} readdir DIR){ # $subdir is recipient name
			if(opendir(SUBDIR, "/var/naim/queue/$subdir/")){
				my $sendmsg;
				foreach my $file (grep {!/^(?:\.|tmp)/} readdir SUBDIR){
					if($buddies{$subdir}){
						if( $hush{$subdir} && ($hush{$subdir} > time()) ){
							log_msg("skipping $subdir (hushed)");
						}else{
							if( $hush{$subdir} && ($hush{$subdir} < time()) ){
								log_msg("hush for $subdir has expired.");
								delete $hush{$subdir};
							}
							if(open(FILE, "/var/naim/queue/${subdir}/${file}")){
								while(<FILE>){
									$sendmsg .= $_;
								}
								close FILE;
							}
						}
					}else{
						log_msg("skipping $subdir (not online)");
					}
					unless(unlink("/var/naim/queue/${subdir}/${file}")){
						slowdie("cannot unlink ${subdir}/${file}: $!"); # we dont want to keep sending msg-die to clean
					}
				}
				if($sendmsg && $buddies{$subdir}){
					chomp($sendmsg);
					# stop client from changing things like :Ping to <happy face>ing
					$sendmsg =~ s/:/ -> /g;

					if($sendmsg =~ /^(\d+)\s\d{2}\/\S{3}\s\d{2}\s->\s/){
						# smells like a notification
						my $idno = $1;
						my $ackit;
						while(my($key,$value) = each %autoack){
							if($value > time()){
								$ackit = 1;
								# no last here - cycle through others who may be expired.
							}else{
								delete $autoack{$key};
								log_msg("AUTOACK: $key autoack expired.");
							}
						}
						if($ackit){
							log_msg("AUTOACK: acking pageid $idno");
							$sendmsg .= "\n" . "AUTOACK enabled: acking pageid $idno\n" .
							            `$sbin/argusctl notify_ack idno=$idno NAIMD::AUTOACK`;
						}
					}
					log_msg("$naim_user -> ${subdir}: ${sendmsg}");
					my $reqid = $aim->send_im($subdir, $sendmsg);
					if($reqid eq '0'){
						log_msg("message too long: dropped");
					}else{
						$ids{$reqid} = 1;
					}
					$idle_time=0;
				}
			}else{
				log_msg("cannot open /var/naim/queue/${subdir}");
			}
		}
		closedir DIR;
	}else{
		log_msg("could not open /var/naim/queue/: $!");
	}
}

sub signon {
	my $aim = shift;
	log_msg("about to connect to AIM");

	my $i = my $r = 1;
	until($aim->signon(screenname => $naim_user,
			       		 password	=> $naim_pass)){
		if($i == 10){
			sleep 60;
			$i=0;
		}else{
			sleep 1;
		}
		log_msg("attempting signon to aim [$i]");
		$i++;
	}
	  

	$i = $r = 1 ;
	until($aim->is_on){
		log_msg("waiting for signon confirmation [$i/60 - round $r]");
		$aim->do_one_loop();
		if($i == 60){
			log_msg("tried connecting 60 times.. sleeping 300 seconds");
			sleep 300;
			$i=0;
			$r++;
		}else{
			sleep 1;
		}
		$i++;
	}

	log_msg("about to add buddies");
	$aim->add_buddy('Buddies',@buddies);
	buddylist_safe_commit();
	$allow_bfs=1;

	#log_msg("about to add_permit");
	#$aim->add_permit(@buddies);
	#buddylist_safe_commit();
	#$allow_bfs=1;

}

sub buddylist_safe_commit {
	log_msg("see commit_ok: $commit_ok");
	for(my $i=0; $i<60; $i++){
		if($commit_ok){
			log_msg("have commit_ok, committing buddylist [$i/60].");
			$commit_ok = 2;
			$aim->commit_buddylist();
			$commit_ok = 0 if($commit_ok == 2);  # not if buddy_ok or buddy_error
			return;
		}else{
			log_msg("waiting for commit_ok [$i/60].");
			sleep 1;
		}
		$aim->do_one_loop();
	}
	unless($commit_ok){
		log_msg("buddy list did not commit: sleeping 5.");
		sleep 5;
	}
}

sub signon_done {
	my $self = shift;

	log_msg("connected to aim server as $naim_user.");
}

sub buddylist_ok {
	my $self = shift;

	log_msg("Buddy list OK");
	$commit_ok=1;
}

sub buddylist_error {
	my ($self,$error,$what) = @_;
	
	log_msg("Buddylist error: $error - what: $what");
	$commit_ok=1;
}

sub buddy_info {
	my ($self,$screenname,$data) = @_;

	next unless($allow_bfs);

	if($data->{away}){
		log_msg("$screenname is away");
	}
	$screenname = lc($screenname);
	$screenname =~ s/\s+//g;
	$buddies{$screenname} = $data->{onsince} || 1;
	log_msg("buddies{$screenname} = $buddies{$screenname}");
}

sub buddy_in {
	my ($self,$buddy,$group,$data) = @_;

	$buddy = lc($buddy);
	$buddy =~ s/\s+//g;
	if($data->{online}){
		if(grep /^${buddy}$/, @buddies){
			$buddies{$buddy} = $data->{onsince} || 1;
			log_msg("IN: $buddy [$group] is online");
		}else{
			# remove the buddy
			$aim->remove_buddy($group,$buddy);
			if($allow_bfs){
				buddylist_safe_commit();
		   	$allow_bfs=1;
			}
		}
	}
}

sub buddy_out {
	my ($self,$buddy,$group) = @_;

	next unless($allow_bfs);

	$buddy = lc($buddy);
	$buddy =~ s/\s+//g;

	log_msg("$buddy [$group] signed off");
	$buddies{$buddy} = 0;

	# buddy could have been signed on in multiple places
	$aim->get_info($buddy);
}

sub error {
	# called when an error occurs while communicating 
	my ($aim, $conn, $error, $description, $fatal) = @_;

	log_msg("ERROR: $error - description: $description - fatal: $fatal");
	if($error == 0){
		if($description =~ /connecting too frequently/){
			log_msg("sleeping 1200");
			sleep 1200;
		}else{
			# not finished signing on
			log_msg("sleeping 10");
			sleep 10;
		}
	}elsif($error == 4){
		# user not logged on
		next;
	}else{
		log_msg("sleeping 2");
		sleep 2;
	}
	if($fatal){
		log_msg("detected fatal error: $fatal");
		die "detected fatal error: $fatal\n";
	}
}

sub rate_alert {
	my ($aim,$level,$clear,$window,$worrisome) = @_;

	next if($level eq 'RATE_CLEAR');
	my $sleep = sprintf("%d",($clear * 1000));
	
	log_msg("ALERT: got level $level -> sleeping $sleep seconds");
	sleep $sleep;
}

sub evil {
	# when the bot recieves a warning.
	my ($aim,$newevil,$from) = @_;

	log_msg("EVIL: our warning is now ${newevil}% via [$from].");

	#Warn and block him, if its not anonymous
	if($from){
		#Remove spaces, make it lowercase.
		$from = lc($from);
		$from =~ s/\s+//g;

		# no warning ourselves
		if($from eq $naim_user){
			log_msg("wont evil self!");
		}else{
			$aim->evil($from, 0);
			$aim->add_deny($from);
			if($allow_bfs){
				buddylist_safe_commit();
				$allow_bfs=1;
			}
		}
	}
}

sub im_ok {
	my ($aim, $to, $reqid) = @_;
	
	if($ids{$reqid}){
		log_msg("im_ok: got success on id [$reqid] to [$to]");
		delete $ids{$reqid};
	}else{
		log_msg("im_ok: got success to unknown id: $reqid to [$to]");
	}
}

sub im_in {
	# called when the bot recieves an IM.
	my ($aim, $sender, $msg, $is_away) = @_;

	$sender =~ s/\s+//g;
	$sender = lc($sender);

	# never get tricked into accepting a message from "ourself"
	if($sender eq $naim_user){
		log_msg("INFO: got message from self: [$msg]!");
		return;
	}

	#Format the message without HTML.
	$msg =~ s/<(.|\n)+?>//g;

	my $log = ($is_away) ? '[AWAY]' : '';
	$log .= "$sender: $msg";
	log_msg($msg);

	# we can do fun stuff here (is secure as AIM buddy list)
	if($buddies{$sender}){
		my $send;
		if($msg =~ /^ACK:\s*(\d+|all)$/){
			my $pageid=$1;
			$send="Acking PageID: $pageid\n";
			$send .= `$sbin/argusctl notify_ack idno=$pageid NAIMD::$sender`;
		}elsif($msg =~ /^\/msg\s+(\S+)\s+(.+)/){
			my $resendee = $1;
			my $msgx = "[via $sender]: " . $2;
			my $reqid = $aim->send_im($resendee,$msgx);
			if($reqid eq '0'){
				log_msg("message too long: dropped");
				$send="Message to $resendee too long";
			}else{
				$ids{$reqid} = 1;
				$send="Message resent to $resendee";
			}
		}elsif($msg eq 'argusctl status'){
			$send=`$sbin/argusctl status`;
		}elsif($msg eq 'ping'){
			$send='pong';
		}elsif($msg eq 'whoson'){
			while(my($key,$value) = each %buddies){
				$send .= "$key -> $value\n" if($value);
			}
		}elsif($msg eq 'sleep'){
			log_msg("sleep command received - taking a nap");
			$aim->set_away("Sleeping..");
			$idle_time += 5;
			$sentaway=1;
		}elsif($msg =~ /^HUSH:\s*(\d+)$/){
			my $hush_min = $1;
			if($hush_min > 0){
				log_msg("hush command received: will not notify $sender for $hush_min minutes");
				$hush{$sender} = (time() + (${hush_min}*60));
				$send="HUSHed for $hush_min minutes";
			}else{
				log_msg("hush command received: hush manually expired.");
				delete $hush{$sender};
				$send="HUSH manually expired.";
			}
		}elsif($msg =~ /^AUTOACK: (\d+)([smhd]?)$/){
			my $time = $1;
			my $unit = $2 || 'm';
			if($time > 0){
				my %hash = (s => 'seconds', m => 'minutes', h => 'hours', d => 'days');

				log_msg("AUTOACK enabled by $sender for [$time] $hash{$unit}.");
				$send = "AUTOACKing all pages for [$time] $hash{$unit}.";

				my $secs = ($unit eq 's') ? $time :
				           ($unit eq 'm') ? ($time * 60) :
				           ($unit eq 'h') ? ($time * 60 * 60) :
				           ($unit eq 'd') ? ($time * 60 * 60 * 24) :
				           die "unknown unit: $unit\n";

				$autoack{$sender} = (time() + $secs);
			}else{
				delete $autoack{$sender};

				log_msg("${sender}'s AUTOACK disabled.");
				$send="AUTOACK disabled.";
			}
		}
		if(defined($send)){
			my $reqid = $aim->send_im($sender,$send);
			if($reqid eq '0'){
				log_msg("message too long: dropped");
			}else{
				$ids{$reqid} = 1; # bug in Net::OSCAR doesnt give same ID as in im_ok
			}
			log_msg("[$reqid] $naim_user -> ${sender}: ${send}");
			$idle_time=0; #only reset idle if a valid command was sent to us
		}
	}
}

sub slowdie {
	my $err = shift;
	log_msg($err);
	sleep 15;
	exit 1;
}

sub daemonize {
	# daemonize code stolen from jeff weisberg
	my $to	= shift;

	fork && exit;
	close STDIN;		open( STDIN,  "/dev/null" );
	close STDOUT;		open( STDOUT, "/dev/null" );
	close STDERR;		open( STDERR, "/dev/null" );
	setsid();

	$SIG{HUP} = $SIG{QUIT} = $SIG{INT} = $SIG{TERM} = sub { sighandler(@_) };

	write_pid("parent");

	# run as 2 processes
	while(1){
	  if( $childpid = fork ){
			# parent
			wait;
			$childpid = undef;
			sleep $to;
	  }else{
			# child
			write_pid("child");
			return;
	  }
	}
}

sub sighandler {
	
	if( $childpid > 1 ){
	  unlink("/var/run/naim/parent.pid", "/var/run/naim/child.pid");
	  kill "TERM", $childpid;
	  wait;
	}
	warn( "caught signal SIG$_[0] - exiting" );
	exit;
}

sub write_pid {
	my $name = shift;
	# save pid file
	
	unless(-d '/var/run/naimd/'){
		mkdir('/var/run/naimd/',0755) || slowdie "cannot mkdir /var/run/naimd: $!\n";
	}

	open(PIF, "> /var/run/naimd/$name.pid") || slowdie "cannot write /var/run/naimd/$name.pid: !\n";
	print PIF "$$\n";
	close PIF;
}

sub log_msg {
	my $msg = shift;

	syslog( 'info', $msg ) if($opt{D});
	print STDERR "$msg\n" if($opt{f} && $opt{D});
}