#!/usr/bin/perl
#
#  Copyright saturn@surrealchat.net and tabris@tabris.net
#
#  Licensed under the GNU Public License 
#  http://www.gnu.org/licenses/gpl.txt
#

use strict;
no strict "refs";
use Socket;
use Time::Local;
use Sys::Hostname;

#not all hosts have this.
#so we'll have to tradeoff some stuff.
#use Time::HiRes qw(sleep);

my $debug = 1;
my $master = 'tabris';
my %conf;

$SIG{CHLD} = 'IGNORE';

my $hostname = Sys::Hostname::hostname();

my $nick = $hostname;
$nick =~ s/\..*//;
# this is a nick!ident@host mask for those allowed to control the bot.
# Use single quotes, or escape the @ char.
#my @auth = ('*!*@*.ops');
my @auth = ('*!northman@*netadmin.SCnet.ops', '*!northman@SCnet-C753E282.dsl.klmzmi.ameritech.net');
my ($remote, $local, $port, $iaddr, $paddr, $proto, $line, $myhost);
my $nl = "\015\012";

# You should specify a default server in $remote
$remote  = shift || '';
# local is the IP to bind to. 
# good for multihomed boxes or hosts with multiple IPs
$local   = undef;
$port    = shift || 6667;
my $uptimechan = shift || '#uptime';
my %chans;
$chans{lc $uptimechan} = 1;

if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
$iaddr   = inet_aton($remote)               || die "no host: $remote";
$paddr   = sockaddr_in($port, $iaddr);
$proto   = getprotobyname('tcp');

if (not $debug) {
    exit if fork();
}

close(STDIN) unless $debug;
close(STDOUT) unless $debug;

socket(IRC, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
bind(IRC, sockaddr_in(0, inet_aton($local))) unless $local == undef;
connect(IRC, $paddr)    || die "connect: $!";
#IRC->autoflush(1);

{ my $ofh = select(IRC); $|=1; select($ofh); }

sub gracefully_die {
    my ($restarting) = @_;

	if ($restarting) {
	    exec "perl ./uptimebot.pl $remote $port $uptimechan";
	} else {
	    exit;
	}
}
ircsend("NICK $nick");
ircsend("USER UptimeBot vpenis $hostname :$hostname Uptime Bot");
#ircsend("PASS ");

#handle the first ping.
#this one is really important to get right
#b/c it is used by the server to make sure you're
#not just spoofing (or using certain kinds of blind proxies)
while(my $line = <IRC>) {
       print " >> $line" if $debug;
	if($line =~ /^PING :(\S+)/) {
		ircsend("PONG :$1");
	}
	# if server tells us we're logged in, break loop
	elsif($line =~ /(376|422) $nick/) {
       		last;
	}
}

#ircsend('NickServ :IDENTIFY ');
#ircsend('HostServ :ON');
ircsend("MODE $nick +Bdp".$nl."JOIN $uptimechan");

#start the pingtimer and
#set the handler for the
#alarm signal as the pingtimer

$SIG{ALRM} = \&pingtimer; # nee sigalrm
alarm 60;
irchandle();

#shouldn't ever get here, as irchandle becomes the main loop.
close(IRC);

sub ircsend {
	my $a = shift;
	print IRC $a, $nl;
	print " << ", $a, "\n" if $debug;
}

sub notice {
	my $rnick = shift;

	while(my $x=shift) {ircsend("NOTICE $rnick :$x");}
}

sub privmsg {
	my $rnick = shift;

	while(my $x=shift) {ircsend("PRIVMSG $rnick :$x");}
}

sub writeHash {
	my $hash = $_[0];
	my $file = $_[1];

	open HASH, ">$file";

	my @keys = keys(%$hash); my @values = values(%$hash);

	for(my $i=0; $i<@keys; $i++) {
		if($values[$i][0]) {
			chomp $keys[$i];
			print HASH $keys[$i], " =[ ";
			foreach my $atom (@{$values[$i]}) {
				print HASH $atom, ", ";
			}
			print HASH "\n";
		} else {
			chomp $keys[$i]; chomp $values[$i];
			print HASH $keys[$i], " = ", $values[$i], "\n";
		}
	}

	close HASH;
}

sub readHash {
	my $file = $_[0];
	my %hash;

	open HASH, $file;
	while(my $line = <HASH>) {
		if($line =~ / =\[ /) {
			my ($key, $value) = split(/ =\[ /, $line);
			chomp $key; chomp $value;
			$hash{$key} = [ split(/, /, $value) ];
		} else {
			my ($key, $value) = split(/ = /, $line);
			chomp $key; chomp $value;
			$hash{$key} = $value;
		}
	}
	close HASH;

	return (%hash);
}

#sub dsave {
#	my ($data, $file) = @_;
#
#	my $x = FreezeThaw::freeze($data);
#	open FILE, ">$file";
#	print FILE $x;
#	close FILE;
#}

#sub dload {
#	my ($file) = @_;
#
#	open FILE, $file;
#	my $in = <FILE>;
#	my ($x) = FreezeThaw::thaw($in) if $in;
#	close FILE;

#	return $x;
#}

sub auth($) {
	my ($in) = @_;
	#$in =~ /^:(.+?)\s/;
	#my $ident = $1;
	my @ident = split(/\!|\@/, $in);

	foreach my $x (@auth) {
		my @x = split(/\!|\@/, $x);
		my $ok = 1;

		for(my $i=0; $i<@x; $i++) {
			if($x[$i] eq "*") {
				next;
			}

			elsif($x[$i] =~ /^\*(.*)/) {
				$ok=0 unless $ident[$i] =~ /$1$/i;
			}

			elsif($x[$i] =~ /(.*)\*$/) {
				$ok=0 unless $ident[$i] =~ /^$1/i;
			}

			else {
				$ok=0 unless lc $ident[$i] eq lc $x[$i];
			}
			last unless $ok;
		}

		return 1 if $ok == 1;
	}

	return 0;
}

sub irchandle() {
LINE:	while(my $in = <IRC>) {
		chomp $in; $in =~ s/\r//g;

		print " >> $in\n" if $debug;

		if($in =~ /^PING\s*(\S*)/i) {
			ircsend("PONG $1");
		}

                if($in =~ /^:(.*?)!.* NICK :(\S+)/) {
                        if($nick eq $1) {
                                $nick = $2;
                        }
                        next;
                }

                $myhost = $1 if($in =~ /^:(\S+) 001 \Q$nick\E/);

		if($in =~ /:(.*?)!.*(PRIVMSG|NOTICE) $nick\s*:\001(\S+) (.*?)\001?$/i) {
			my ($rnick, $op, $msg) = ($1, $3, $4);

			notice($conf{"Debugger"}, $rnick, $msg) if $conf{"Debug"};

			next LINE;
		}

		if($in =~ /:(.*?)!.*PRIVMSG (#\S+)\s*:(.*)/i) {
			my ($rnick, $chan, $msg) = ($1, $2, $3);
			#print "$rnick, $chan, $msg";
			$chan = lc $chan;
			next LINE unless ($chans{$chan});

			if(($msg =~ /^uptime/i) or ($msg =~ /^!uptime/i)) {
				my $uname = qx/uname -sr/; $uname =~ s/\n//;
				my $uptime = qx/uptime/; $uptime =~ s/\n//;
				privmsg($chan, "Uptime for $hostname ($uname): is".$uptime);
				next;
			}

			if(($msg =~ /^lusers/i) or ($msg =~ /^!lusers/i)) {
				my $users = qx/users/; $users =~ s/\n//;
				$users = join(' ', unique(split(/ /, $users)));
				privmsg($chan, "Users logged onto $hostname: ".$users);
				next;
			}
		}


		if($in =~ /:(\S+) PRIVMSG $nick\s*:(.*)/i) {
			my ($rmask, $msg) = ($1, $2);
			my ($rnick, undef, undef) = split(/\!|\@/, $rmask);

			if($msg =~ /^uptime/i) {
				my $uname = qx/uname -sr/; $uname =~ s/\n//;
				my $uptime = qx/uptime/; $uptime =~ s/\n//;
				privmsg($rnick, "Uptime for $hostname ($uname): is".$uptime);
				next;
			}
			elsif(($msg =~ /^lusers/i) or ($msg =~ /^!lusers/i)) {
				my $users = qx/users/; $users =~ s/\n//;
				$users = join(' ', unique(split(/ /, $users)));
				privmsg($rnick, "Users logged onto $hostname: ".$users);
				next;
			}

			unless(auth($rmask)) {
				notice($rnick, "Permission denied.") if $debug and !($rmask =~ /serv/i);
				next;
			}

			if($msg =~ /^help/i) {
				notice($rnick,
					"- This is UptimeBot.",
					"- ",
					"- Available Commands:",
					"-  JOIN #channel: Join a channel.",
					"-  PART #channel: Leave a channel.",
					"-  NOTICE nick message: Say something.",
					"-  MSG nick message: Say it again.",
					"-  RAW message: Say it from the heart.",
					"-",
					"-  LUSERS: List users logged in.",
#					"-  CONF: View configuration.",
#					"-  SET name value: Edit configuration.",
#					"-  AUTH hostmask: Allow someone to control me.",
#					"-  REHASH: Revert configuration.",
#					"-  SAVE: Save configuration.",
					"-  QUIT: Commit suicide.",
					"-  RESTART: Save data and restart.");
			}

			elsif($msg =~ /^notice (\S*) (.*)/i) {
				notice($1, $2);
			}

			elsif($msg =~ /^msg (\S*) (.*)/i) {
				privmsg($1, $2);
			}

			elsif($msg =~ /^raw (.*)/i) {
				ircsend($1);
			}

			elsif($msg =~ /^JOIN (\S+)/i) {
				ircsend("JOIN $1");
				$chans{lc $1} = 1;
			}

			elsif($msg =~ /^PART (\S+)/i) {
				ircsend("PART $1");
				delete($chans{lc $1});
			}

			elsif($msg =~ /^quit/) {
				ircsend("QUIT :Received QUIT command.");
				sleep (1);
				
				gracefully_die(0);

			}

			elsif($msg =~ /^restart/) {
				ircsend("QUIT :Restarting.");
				sleep (1);
				
				gracefully_die(1);
			}

		}
		if($in =~ /:$myhost .*(PRIVMSG|NOTICE) $nick\s*:(.*)/i) {
			my $msg = $2;

		}
	}

	gracefully_die(1);
}


sub writeArray {
        my $array = $_[0];
        my $file = $_[1];

        open ARRAY, ">$file";

        foreach my $x (@$array) {
                print ARRAY $x . "\n";
        }

        close ARRAY;
}

sub readArray {
        my $file = $_[0];
        my @array;

        open ARRAY, $file;

        while(my $x = <ARRAY>) {
                chomp $x;
                push @array, $x;
        }

        close ARRAY;

        return (@array);
}

sub pingtimer { # nee sigalrm
        ircsend("PING :$remote");
        alarm 60;
}

#we don't actually call this from anywhere
#but the SCnet implementation seems to need
#it to handle when the socket is closed on us
#due to a kill.
sub sigpipe {
        graceful_die(1); #if $child;
}

sub unique(@) {
	my (@input_array) = @_;
	my %seen;
	foreach my $item (@input_array) {
		$seen{$item}++;
	}
	#return sort(keys(%seen));
	return map("$_($seen{$_})", sort(keys(%seen)));
}