#!/usr/bin/perl -w

use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Digest::MD5 qw(md5_hex);
use Template;
use lib "./lib";
use RiveScript;
use Mail::Sendmail;
use Data::Dumper;

print "Content-Type: text/plain\n\n";

# Be reasonable in the amount of uploaded data.
$CGI::POST_MAX = 1024*1024; # 1 MB

# In case of abuse, who do we send the e-mail to?
my %abuse = (
	Smtp    => 'localhost',
	From    => 'Try RiveScript <tryonline@rivescript.com>',
	To      => 'root@kirsle.net,root@cuvou.net,noah.petherbridge@gmail.com',
	Subject => 'Abuse Detected',
);

my $q = new CGI();
my $js = {}; # Java Scripts

# Get their basic info.
my $session = $q->param("session") || '';
my $action = $q->param("action") || '';
$session =~ s/[^A-Za-z0-9]//g;

# Verify their session exists.
if (!length $session || !-d "./sessions/$session") {
	print "error: session not found";
	exit(0);
}

# If the response contains JavaScript objects, the request needs
# to return some raw code for the page to execute to provoke the
# scripts.
my $js_output = '';

# Handle the action.
if ($action eq "upload") {
	# Accept their code.
	my $code = $q->param("code") || '';
	$code =~ s/&plus;/+/ig;

	open (WRITE, ">./sessions/$session/code.rs");
	print WRITE $code;
	close (WRITE);
	print "code accepted";
	exit(0);
}
elsif ($action eq "chat") {
	# They're chatting. Do they have code?
	if (!-f "./sessions/$session/code.rs") {
		print "error: no code was uploaded";
		exit(0);
	}

	# Do they have a message?
	my $message = $q->param("message") || '';
	if (length $message == 0) {
		print "error: no message given";
		exit(0);
	}

	# Load their session variables.
	my $vars = {};
	if (-f "./sessions/$session/vars.txt") {
		$vars = do "./sessions/$session/vars.txt";
	}

	# Wrap all this in an alarm, just in case!
	eval {
		local $SIG{ALRM} = sub { die };
		alarm (15);

		# Create the RiveScript object.
		my $rs = new RiveScript();

		# Destroy the Perl handler, and set up a JavaScript handler.
		$rs->setHandler (perl => undef);
		$rs->setHandler (javascript => \&handle_js);

		# Set all their vars.
		foreach my $var (keys %{$vars}) {
			$rs->setUservar ("internet", $var => $vars->{$var});
		}

		# Load their code.
		$rs->loadFile ("./sessions/$session/code.rs");
		$rs->sortReplies();

		# Send their message.
		my $reply = $rs->reply ("internet", $message);
		print "$reply<<rivescript-javascript-object>>$js_output";

		# Save their session.
		$vars = $rs->getUservars ("internet");
		open (VARS, ">./sessions/$session/vars.txt");
		print VARS Dumper($vars);
		close (VARS);
	};
	if ($@) {
		print "Server error: severe syntax errors or processing time too long!\n\nThe server said: $@";

		# If it's a simple syntax error, don't freak out too much.
		if ($@ =~ /^Syntax error in/) {
			exit(0);
		}

		# Get their code.rs file.
		open (READ, "./sessions/$session/code.rs");
		my @src = <READ>;
		close (READ);
		chomp @src;

		# Send an e-mail.
		&abuse($@, join("\n",@src));

		# Log the error message.
		open (LOG, ">>errors.log");
		print LOG localtime(time()) . "\n"
			. "$ENV{REMOTE_ADDR}\n"
			. "$@\n\n"
			. join("\n",@src) . "\n\n"
			. "=====\n\n";
		close (LOG);

		# Terminate their session.
		opendir (DIR, "./sessions/$session");
		foreach my $file (sort(grep(!/^\./, readdir(DIR)))) {
			unlink("./sessions/$session/$file");
		}
		closedir (DIR);
		rmdir("./sessions/$session");
	}

	exit(0);
}

print "error: unknown procedure";

sub abuse {
	my ($error,$src) = @_;

	$abuse{Message} = localtime(time()) . "\n"
		. "$ENV{REMOTE_ADDR}\n"
		. "$@\n\n"
		. "$src\n\n"
		. "=====\n";

	# Send the e-mail!
	sendmail(%abuse);
}

sub handle_js {
	my ($rs,$action,$name,$data) = @_;

	if ($action eq "load") {
		# Loading the code.
		$js->{$name} = $data;
	}
	else {
		# We need to add the code to the JS structure and return
		# a span with a random ID... the code's result goes into
		# the span.
		my $rand = int(rand(99999));
		my $span = "<span id=\"jsobj_$rand\"></span>";

		my $code = "var fields$rand = new Array();\n";
		for (my $i = 0; $i < scalar @{$data}; $i++) {
			$data->[$i] =~ s/([\\"])/\\$1/ig;
			$data->[$i] =~ s/\n/\\n/ig;
			$data->[$i] =~ s/[\x0d\x0a]//ig;
			$code .= "fields${rand}[$i] = \"$data->[$i]\";\n";
		}

		$code .= "function rsobject_$rand (args) {\n"
			. "$js->{$name}\n"
			. "}\n"
			. "document.getElementById('jsobj_$rand').innerHTML = rsobject_$rand(fields$rand);\n";

		$js_output .= $code;
		return $span;

#		# Come up with code for the web browser.
#		my $rand = int(rand(99999));
#		$code .= "function rsobject_$rand (args) {\n"
#			. "$js->{$name}\n"
#			. "}"
#			. "document.writeln( rsobject_$rand(fields) );\n";

#		return "<script type=\"text/javascript\">$code</script>";
	}
}