#!/usr/bin/perl -w

# Diablo Fserve for X-chat irc client.
# Copyright (C) 1999  Joseph Elwell

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# to compile: perlcc -o fserve.so fserve.pl

#Configure these values.
$fserveOn = 1;
$fserve_root = "/mnt/win/";
$offering = "Backup Files";
$trigger = "!trigger";
@channels = ("#joesa");
$timer = 300000; 	# in milli-seconds 
$maxSends = 1;
$max_queues = 50;
$max_queues_per_nick = 4;
$home_dir = "/home/USER/.xchat/";
$debug = 1;
#Do NOT edit anything below if you do not know PERL.
#Do NOT edit anything below if you do not know PERL.
#Do NOT edit anything below if you do not know PERL.

IRC::print("\0035:: Loaded Diablo by Joseph Elwell e-mail bugs to jelwell\@singleclick.com::\003");
IRC::print("\0035:: To Configure Type /fserve::\003");
IRC::register ("Diablo", ".4", "", "");
&initialize();
IRC::add_command_handler("fserve", "fserve_handler");
IRC::add_message_handler("PRIVMSG", "checkTrigger");
IRC::add_message_handler("DCC", "dccMsg");

IRC::add_print_handler("DCC Connected", "connected");

#To find the codes check: /usr/src/redhat/SOURCES/xchat-1.3.12/src/common/text.c
IRC::add_print_handler("DCC SEND Complete", "sendNext");
IRC::add_print_handler("DCC SEND Failed", "sendNext");
IRC::add_print_handler("DCC Stall", "sendNext");
IRC::add_print_handler("DCC RECV File Open Error", "sendNext");
IRC::add_print_handler("DCC RECV Failed", "sendNext");

#Each line is a new entry in the array.
@msg = ("Download only what you've uploaded, this is meant to be a backup system.","If you have 5Revolution X, or Vib Ribbon email wares\@hotmail.com");

IRC::add_timeout_handler($timer, "timer");

@queueNames = ();
@queueFiles = ();
%nickqueues = {};
%nickdir = {};
&inputQueues();

sub fserve_handler()
{
	my ($input) = @_;
	my $userInput = "";
	if(substr($input, 0, length("on")) eq "on")
	{
		$fserveOn = 1;
	}
	elsif(substr($input, 0, length("off")) eq "off")
	{
		$fserveOn = 0;
	}
	elsif(substr($input, 0, length("root")) eq "root")
	{
		$userInput = substr($input, length("root") + 1);
		$fserve_root = $userInput;
	}
	elsif(substr($input, 0, length("trigger")) eq "trigger")
	{
		$userInput = substr($input, length("trigger") + 1);
		$trigger = $userInput;
	}
	elsif(substr($input, 0, length("timer")) eq "timer")
	{
		$userInput = substr($input, length("timer") + 1);
		$timer = $userInput; 	# in milli-seconds 
	}
	elsif(substr($input, 0, length("maxSends")) eq "maxSends")
	{
		$userInput = substr($input, length("maxSends") + 1);
		$maxSends = $userInput;
	}
	elsif(substr($input, 0, length("maxQueues")) eq "maxQueues")
	{
		$userInput = substr($input, length("maxQueues") + 1);
		$max_queues = $userInput;
	}
	elsif(substr($input, 0, length("maxQueuesPerNick")) eq "maxQueuesPerNick")
	{
		$userInput = substr($input, length("maxQueuesPerNick") + 1);
		$max_queues_per_nick = $userInput;
	}
	elsif(substr($input, 0, length("perl")) eq "perl")
	{
		$userInput = substr($input, length("perl") + 1);
		eval($userInput);
	}
	elsif(substr($input, 0, length("offers")) eq "offers")
	{
		$userInput = substr($input, length("offers") + 1);
		$offering = $userInput;
	}
	elsif(substr($input, 0, length("channels")) eq "offers")
	{
		$userInput = substr($input, length("offers") + 1);
		push(@channels, $userInput);
	}
	elsif(substr($input, 0, length("debug")) eq "debug")
	{
		$userInput = substr($input, length("debug") + 1);
		if ($userInput eq "on")
		{
			$debug = 1;
		}
		else
		{
			$debug = 0;
		}
	}
	else
	{
		IRC::print("Command Not understood. Check spelling:\n");
		$input = "";
	}
	IRC::print("$input\n");
	if ($input eq "")
	{
		IRC::print("\0035:: List of valid Commands: ::\003");
		IRC::print("\0035:: <SOMETHING> means type in the value here::\003");
		IRC::print("\0035:: For example: /fserve trigger !fserve ::\003");
		IRC::print("\0035:: Or: /fserve root /home/jackdoe/fserve/ ::\003");
		IRC::print("\0035 /fserve on\003");
		IRC::print("\0035 /fserve off\003");
		IRC::print("\0035 /fserve root <ABSOLUTE ROOT>\003");
		IRC::print("\0035 /fserve trigger <trigger>\003");
		IRC::print("\0035 /fserve timer <timer in milliseconds (like 300000)>\003");
		IRC::print("\0035 /fserve maxSends <number>\003");
		IRC::print("\0035 /fserve maxQueues <number>\003");
		IRC::print("\0035 /fserve maxQueuesPerNick <number>\003");
		IRC::print("\0035 /fserve debug on\003");
		IRC::print("\0035 /fserve debug off\003");
		IRC::print("\0035 /fserve perl <PERL CODE>\003");
	}
	return 1;
}

sub shutdown()
{
	&logCommand("DEBUG::Shutting down");
	$fserveOn = 0;
	IRC::command("/dcc closeall");
	IRC::print("Diablo Fserve shutdown");
}

sub updateTimeout($nick)
{
	my($nick) = @_;
	my($filename) = $homdir . "/diablo/$nick";
	open(FILE, $filename);
	close(FILE);
	$now = time;
#	open
#	utime $now, $now, $filename;
}

sub checkTimeout($nick)
{
	my($filename) = $homdir . "/diablo/$nick";
	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
		$atime,$mtime,$ctime,$blksize,$blocks)
				= stat($filename);
}

sub initialize()
{
	&logCommand("DEBUG::Initializing");
	if (!-d "~/.xchat")
	{
		mkdir("~/.xchat", 0777);
	}
	if (!-d "~/.xchat/diablo")
	{
		mkdir("~/.xchat/diablo", 0777);
	}
}

sub logCommand($cmd)
{
	@cmd = @_;
	if ($debug == 1)
	{
		$logfile = $homedir . "/diablo/logfile.log";
		open (LOG, ">>$homedir");
		print LOG "@cmd\n";
		close(LOG);
	}
}

sub inputQueues()
{
	my $i = 0;
	$logfile = $homedir . "/diablo/queues.log";
	open (QUEUES, "<$logfile");
	while(<QUEUES>)
	{
		$input = $_;
		($nickqueue, $filequeue) = split(/DIABLOFSERVESEPERATOR/, $input);
		$queueNames[$i] = $nickqueue;
		$queueFiles[$i] = $filequeue;
	
	}
	close(QUEUES);
}

sub outputQueues()
{
	$logfile = $homedir . "/diablo/queues.log";
	open (QUEUES, "+>$logfile");
	for($i=0; $i<$#queueNames; $i++)
	{
		my $nickqueue = $queueNames[$i];
		my $filequeue = $queueFiles[$i];
		my $output = $nickqueue . "/DIABLOFSERVESEPERATOR/" . $filequeue;
		print QUEUES "$output\n";
	}
	close(QUEUES);
}

sub sendNext()
{
	&logCommand("DEBUG::Sending File @_");
	&outputQueues();
#	IRC::print("Sending file");
	my $numSends = &listSends("fakeNick", "");
#	IRC::print("Number of Files Sending: $numSends");
	if ($#queueNames >= 0 && $fserveOn == 1 && $numSends < $maxSends )
	{
		$nick = shift(@queueNames);
		$file = shift(@queueFiles);
		$nickqueues{$nick} = $nickqueues{$nick} - 1;
		$dccCommand = "/dcc send $nick \"" . $file . "\"";
		IRC::command($dccCommand);
	}
}

sub checkSends()
{
		sendNext();
}

sub listQueues($nick, $cmd)
{
	my ($nick, $cmd) = @_;
	&logCommand("DEBUG::Listing Queues");
	# $cmd should be "/msg" or "/msg =" for dcc
	for($i=0; $i<$#queueNames; $i++)
	{
		$nickqueue = $queueNames[$i];
		$filequeue = $queueFiles[$i];
		$cmdtoSend = $cmd . "$nick Slot $i" . "/" . "$max_queues : $nickqueue has queued $filequeue";
		IRC::command($cmdtoSend);
	}
	if ($i == 0)
	{
		IRC::command($cmd . "$nick No Files have been queued.");
	}
}

sub clearQueue($nick, $cmd)
{
	my ($nick, $cmd) = @_;
	my $success = 0;
	# $cmd should be "/msg " or "/msg =" for dcc
	for($i=0; $i<$#queueNames; $i++)
	{
		$nickqueue = $queueNames[$i];
		if ($nickqueue eq $nick)
		{
			splice(@nickqueue, $i, 1, splice(@nickqueue, 0, $i));
			$cmdtoSend = $cmd . "$nick $nickqueue successfully removed $filequeue from the queue";
			IRC::command($cmdtoSend);
			$success = 1;
		}
	}
	if ($success == 0)
	{
		$cmdtoSend = $cmd . "$nick Could not find any files queued by $nick";
		IRC::command($cmdtoSend);
		
	}
}

sub delQueue($nick, $file, $cmd)
{
	my ($nick, $file, $cmd) = @_;
	my $success = 0;
	# $cmd should be "/msg " or "/msg =" for dcc
	for($i=0; $i<$#queueNames; $i++)
	{
		$nickqueue = $queueNames[$i];
		$filequeue = $queueFiles[$i];
		if ($nickqueue eq $nick && $filequeue eq $file)
		{
			splice(@nickqueue, $i, 1, splice(@nickqueue, 0, $i));
			splice(@filequeue, $i, 1, splice(@nickqueue, 0, $i));
			$cmdtoSend = $cmd . "$nick $nickqueue successfully removed $filequeue from the queue";
			IRC::command($cmdtoSend);
			$success = 1;
		}
	}
	if ($success == 0)
	{
		$cmdtoSend = $cmd . "$nick Could not find $nick with $file in the queue";
		IRC::command($cmdtoSend);
		
	}
	
}

sub addQueue($nick, $file)
{
	my ($nick, $file) = @_;
	&logCommand("DEBUG::Adding Queue");
	if (!fileExists($file))
	{
		IRC::command("/msg =$nick $file does not exist. This fserve is case sensitive");
		return 0;
	}
	if ($nickqueues{$nick} >= $max_queues_per_nick)
	{
		IRC::command("/msg =$nick You've filled all your queue spots");
#		&bootNick($nick);
		return 0;
	}
	if ($#queueNames == $max_queues)
	{
		IRC::command("/msg =$nick The $#queueNames/$max_queues queues are all full.");
		return 0;
	}
	$nickqueues{$nick} += 1;
	push(@queueNames, $nick);
	push(@queueFiles, $file);
	$counter = $#queueNames + 1;
	$commandtoSend = "/msg =$nick The file: $file has been placed in request spot " . $counter;
	IRC::command($commandtoSend);
	checkSends();
}

sub fileExists($file)
{
	my ($file) = @_;
	&logCommand("DEBUG::FileExists");
#	$outtemp = substr($file, 0, length($fserve_root));
#	$outtemp .=  " != $fserve_root";
	if (substr($file, 0, length($fserve_root)) ne $fserve_root || !-e $file)
	{
#		IRC::print("NO $outtemp where the new file : $file");
		return 0;
	}
	else
	{
#		IRC::print("YES $outtemp where the new file : $file");
		return 1;
	}
}

sub listDir($nick)
{
	my ($nick) = @_;
	&logCommand("DEBUG::ListDir");
	if (!$nickdir{$nick})
	{
		$nickdir{$nick} = $fserve_root;
	}
	opendir(DIR, "$nickdir{$nick}");	# better end with /
	while($entry = readdir(DIR))
	{ 
		$dir = $nickdir{$nick};
		$dir .=  $entry;
		if (-d $dir)
		{
			$entry =  "$entry/"
		}
         		IRC::command("/msg =$nick $entry");
	}
	closedir(DIR);
       	IRC::command("/msg =$nick [$nickdir{$nick}]");
}

sub checkTrigger()
{
        my $line = shift(@_);
        if ($fserveOn == 1)
        {
                $line =~ /:(.*)!(.*@.*) .*:(.*)/;
		$nick = $1;
                if ($3 eq $trigger)
		{
			if ($nickqueues{$nick} >= $max_queues_per_nick)
			{
				&logCommand("DEBUG::Trigger Queues Full");
				IRC::command("/msg $nick All your queue spots are filled, you will be allowed back on when you have open queue spots");
			}
			else
			{
				&logCommand("DEBUG::Triggered");
#				IRC::print "$nick triggered you.";
				openUpTo($nick);
			}
		}
        }
        return 0;
}

sub openUpTo($nick)
{
	my ($nick) = @_;
	#TODO
	#checkNickDupe($nick);
	IRC::command("/dcc chat $nick");
	$nickdir{$nick} = $fserve_root;
#	IRC::print("nickdir is $nickdir{$nick}");
	&logCommand("DEBUG::Opening up");
}

sub connected()
{
	my $line = shift(@_);
        #IRC::print "--> $line";
        $chat = substr($line, 1, 4);
        $line =~ s/ /A/c;
        $line =~ s/ /A/c;
        $line =~ / /g;
        $num = pos($line);
        $nick = substr($line, 6, $num-6);
        if ($chat eq "CHAT")
        {
		foreach $message (@msg)
		{
			IRC::command("/msg =$nick $message");
		}
		&listDir($nick);
        }
	&logCommand("DEBUG::Connected");
  	return 0;
}

sub timer()
{
	&logCommand("DEBUG::Timer called");
	IRC::add_timeout_handler($timer, "timer");
	$num_queues = $#queueNames + 1;
	$ad_queues = $num_queues . "/" . $max_queues;
	$fserve_ad = "2(6File 6Serve 6Online2) 2Trigger:(6" . $trigger . "2) 2Queues:(6" . $ad_queues . "2) Offering:(6" . $offering . "2)";
	foreach $channel (@channels)
	{
		IRC::command("/msg $channel $fserve_ad");
	}
}

sub getChannels()
{
	return ("#psxunderground");
	my @list = IRC::channel_list();
	my @online_channels = ();
	while ($list[0])
	{
		my $chan = shift(@list);
		my $server = shift(@list);
		my $nick = shift(@list);
		push @online_channels, $chan;
	}
#	return @online_channels;
}

sub listSends($nick, $cmd)
{
	my ($nick, $cmd) = @_;
	&logCommand("DEBUG::Listing Sends");
	my @dcc_list = IRC::dcc_list();
	my $send_count = 0;
	my $i=0;
#	IRC::print("Listing $#dcc_list Sends");
	
	while($i<$#dcc_list)
	{
		$dcc_object = {
			nick => $dcc_list[$i],
			file => $dcc_list[++$i],
			type => $dcc_list[++$i],
			stat => $dcc_list[++$i],
			cps => $dcc_list[++$i],
			size => $dcc_list[++$i],
			resumable => $dcc_list[++$i],
			addr => $dcc_list[++$i],
			destfile => $dcc_list[++$i],
		};
		++$i;
#                IRC::print("nick: $dcc_object->{type}");
#                IRC::print("file: $dcc_object->{file}");
#                IRC::print("type: $dcc_object->{type}");
#                IRC::print("stat: $dcc_object->{stat}");
#                IRC::print("cps: $dcc_object->{cps}");
#                IRC::print("size: $dcc_object->{size}");
#                IRC::print("resumable: $dcc_object->{resumable}");
#                IRC::print("addr: $dcc_object->{addr}");
#                IRC::print("destfile: $dcc_object->{destfile}");
		if ($dcc_object->{type} == 0 && $dcc_object->{stat} == 1)
		{
			my $cmdtoSend = $cmd . "$nick Sending $dcc_object->{nick} $dcc_object->{file} at $dcc_object->{cps} cps";
			IRC::command($cmdtoSend) if ($cmd ne "");
			$send_count++;
		}
		elsif ($dcc_object->{type} == 0 && $dcc_object->{stat} == 2)
		{
#			$send_count++;
		}
	}
	if ($send_count == 0)
	{
		IRC::command($cmd . "$nick No Files are being sent.") if ($cmd ne "");
	}
	return $send_count;
}

sub dccMsg()
{
	my $line = shift(@_);
	&logCommand($line);
        $line =~ s/ /A/c;
        $line =~ / /g;
        $num = pos($line);
        $shortenedline = substr($line, $num);
        $shortenedline =~ /:/g;
        $num2 = pos($shortenedline);
        $nick = substr($shortenedline, 0, $num2-1);
        $command = substr($shortenedline, $num2+1);
	if (($command eq "dir") || ($command eq "ls"))
        {
		&listDir($nick);
	}
	elsif (substr($command, 0, 2) eq "cd")
        {
		#Protect from cd'ing below fserve root...

		@dirs = split(/\//, $nickdir{$nick});
		if (substr($command, 3, 2) eq "..")
		{
			pop(@dirs);
#			$dirs[$#dirs] = "";
			$newdir = join('/', @dirs);
			$newdir .= "/";
			&changeDir($nick, $newdir);
		}
		else
		{
			$newdir = substr($command, 3);
			$newdir =~ s/[;`'\/><{}]*//g;
#			$newdir =~ s/`//g;
#			$newdir =~ s/'//g;
#			$newdir =~ s/\///g;
#			$newdir =~ s/>//g;
#			$newdir =~ s/<//g;
#			$newdir =~ s/{//g;
#			$newdir =~ s/}//g;
			if($newdir ne ".")
			{
				$newdir = $nickdir{$nick} . $newdir . "/";
				&changeDir($nick, $newdir);
			}
		}
	}
	elsif (substr($command, 0, 3) eq "get")
        {
		$file = substr($command, 4);
#		$file =~ s/ //g;
		$file =~ s/\//-/g;
		$file = $nickdir{$nick} . $file;
#		IRC::print("$nick trying to get file $file");
		&addQueue($nick, $file)
	}
	elsif (substr($command, 0, 4) eq "quit" || substr($command, 0, 4) eq "exit" || substr($command, 0, 3) eq "bye")
	{
		#TODO add a friendly quit proc		
		IRC::command("/msg =$nick The quit command isn't working, please just manually close the chat");
#		IRC::command("/dcc close chat $nick");
	}
	elsif (substr($command, 0, 5) eq "queue")
        {
		&listQueues($nick, "/msg =");
	}
	elsif (substr($command, 0, 8) eq "delqueue")
        {
		$file = substr($command, 9);
		$file =~ s/ //g;
		$file =~ s/\#//g;
#		&delQueue($nick, $file, "/dcc");
	}
	elsif (substr($command, 0, 8) eq "clearqueue")
        {
#		&clearQueue($nick, "/msg =");
	}
	elsif (substr($command, 0, 5) eq "sends")
        {
		&listSends($nick, "/msg =");
	}
	else #(substr($command, 0, 4) eq "help")
	{
		IRC::command("/msg =$nick commands that work:");
		IRC::command("/msg =$nick help sends queue cd dir ls get quit");
	}
}

sub bootNick($nick)
{
	my ($nick) = @_;
#	IRC::command("/dcc close chat $nick");
}

sub changeDir($nick, $newdir)
{
	my ($nick, $newdir) = @_;
	&logCommand("DEBUG::Changind Directory");
	$outtemp = substr($newdir, 0, length($fserve_root));
	$outtemp .=  " != $fserve_root";
#	IRC::print("$outtemp where the new directory: $newdir");
	if (substr($newdir, 0, length($fserve_root)) ne $fserve_root || !( -d $newdir ) )
	{
		IRC::command("/msg =$nick Could not change to specified directory");
		return 0;
	}
	else
	{
		$nickdir{$nick} = $newdir;
          	IRC::command("/msg =$nick [$nickdir{$nick}]");
		return 1;
	}
}