#!/store/bin/perl
################################################################################
#
# RCS:          $Id: $
# Author:       Geir Inge Jensen
# Created:      Wed Jan 10 16:05:19 1996
# Modified:     Thu Apr 25 15:08:05 1996 (geiri@staff.cs.uit.no)
# Description:  TACOMA HTML gateway
#
# (c) Copyright 1996, Tacoma project, all rights reserved.
#
################################################################################

$PGP = '/store/bin/pgp -f';
$TACOMA = 'http://www.cs.uit.no/DOS/Tacoma/';
$TMPDIR = '/tmp';
$PGPPATH = "/www/users/staff/geiri/tacoma/.pgp";
$TACPORT = 14141;
$TACHOST = 'dslab3';
$PRINT_BRIEFCASE = 0;
$DISCARD_AGENTS = "^contact\$|^agentid\$|^tclcode\$|^\*\#tclcode\$";

sub TACOMA_GetInput {
	if ($ENV{'REQUEST_METHOD'} eq "GET") {
        $query = $ENV{'QUERY_STRING'};
    } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
        for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) { $query .= getc; }
    } 

	local(@environment) = split(/[\?\&]/, $query);

	for (@environment) {
        ($name, $value) = split(/=/);
		$value =~ tr/+/ /;
		($env{"$name"} = $value) =~ s/%(..)/pack("c",hex($1))/ge;
		$env{"$name"} =~ s/\s+/ /g;
		$env{"$name"} =~ s/\s+$//;
	}
}

sub TACOMA_Intruder {
	unlink "$TMPDIR/TacomaPGP.$$" if (-f "$TMPDIR/TacomaPGP.$$");
	unlink "$TMPDIR/TacomaCheckPGP.$$" if (-f "$TMPDIR/TacomaCheckPGP.$$");

	print "<H1>Access Violation</H1>\n";
	print "Sorry, but the agent code was not signed correctly!\n";

	print "<HR SIZE=4>The <A HREF=\"$TACOMA\"><B>Tacoma</B> project</A>\n";

	print "</BODY></HTML>\n";
	exit 0;
}

sub TACOMA_Error {
	local($msg) = @_;

	unlink "$TMPDIR/TacomaPGP.$$" if (-f "$TMPDIR/TacomaPGP.$$");
	unlink "$TMPDIR/TacomaCheckPGP.$$" if (-f "$TMPDIR/TacomaCheckPGP.$$");

	print "<H1>Error during parsing of agent</H1>\n";
	print "Sorry, but an error was detected!<P>\n";

	print "<PRE>$msg</PRE>\n";

	print "<HR SIZE=4>The <A HREF=\"$TACOMA\"><B>Tacoma</B> project</A>\n";

	print "</BODY></HTML>\n";
	exit 0;
}

sub TACOMA_UnMarshall {
	local($message) = $env{'CODE'};
	
	return(split(/\%0A/, $message));
}

sub TACOMA_CheckPGP {
	local(@code) = @_;
	local($line);
	local(@checked);

	$ENV{"PGPPATH"} = $PGPPATH;

	open(TMP, ">$TMPDIR/TacomaPGP.$$") || &TACOMA_Error("$!");
	foreach $line (@code) { print TMP "$line\n"; }
	close(TMP);

	open(PGP, "$PGP < $TMPDIR/TacomaPGP.$$ 2>$TMPDIR/TacomaCheckPGP.$$ |") 
		|| &TACOMA_Error("$!");
	@code = (<PGP>);
	close(PGP);

	# Now, Check the signature.
	open(CHECK, "<$TMPDIR/TacomaCheckPGP.$$") || &TACOMA_Error("$!");
	while (<CHECK>) {
		if (/^Good signature from/) {
			$PGP_OK = 1;
			last;
		}
	}
	close(CHECK);
	&TACOMA_Intruder unless defined ($PGP_OK);

	unlink "$TMPDIR/TacomaPGP.$$";
	unlink "$TMPDIR/TacomaCheckPGP.$$";

	return @code;
}

sub TACOMA_CreateBriefCase {
	local(@code) = @_;
	local(@bc);
	
	local($id) = time . $$;

	push(@bc, "CONTACT ag_tcl AGENTID $id TCLCODE {AGENT_CODE {}} *#TCLCODE 1 AGENT_CODE {");
	push(@bc, @code);
	push(@bc, "}\n\04\n");
	return @bc;
}

sub TACOMA_CheckTacFWStatus {
	$input = <TCP>;
	$input =~ s/\0//g;
	print "<B>TAC FireWall reports $input</B><BR>\n";
	$input = <TCP>;
}

sub TACOMA_SendBriefCase {
	local(@bc) = @_;

	# Talk with the firewall
	$input = <TCP>;
	$input =~ s/\d//g;
	print "TAC Firewall welcome message: <B>$input</B><BR>\n";
	$input = <TCP>;

	print TCP "1 ";
	foreach $line (@bc) { print TCP "$line"; }

	$input = <TCP>;
	$input =~ s/\d//g;
	print "TAC FireWall agent status: <B>$input</B><BR>\n";
	$input = <TCP>;
}

sub TACOMA_ReadExitValue {
	local($value) = @_;
	print "TAC FireWall return status: <B>$value</B>\n"	if ($value != 0);
}

sub TACOMA_ReadReply {
	local(@reply);

	while (<TCP>) {
		push(@reply, "$_");
	}

	return @reply;
}

sub TACOMA_DecomposeBriefCase {
	local(@bc) = @_;
	local($line);
	local(@parts);
	local($depth) = 0;
	local($discard) = 0;

	print "<PRE>";
	foreach $line (@bc) {
		chop($line);
		unless (defined $first) {
			$line =~ s/^\d //;
			$first = 1;
		}
#		$line =~ s/^.*AGENTID\s\d+\s// if ($line =~ /^CONTACT/);
		if ($depth >= 2 && $line !~ /\{|\}/) {
			print $line . "\n" unless $discard;
			next;
		}
		@parts = ($line =~ /([^\{\}]*[\{\}])/g);
		if ($line =~ /[\{\}]([^\{\}]+)$/) {
			push(@parts, $1);
		}
PART:
		foreach $p (@parts) { 
			if ($depth == 0 && $p != /^\s*$/) {
				while (1) {
					($folder, $p) = ($p =~ /^\s*([^\s]+)\s(.*)$/);
					if ($folder =~ /$DISCARD_AGENTS/i) {
						$discard = 1;
					} else { $discard = 0; }
					print "</PRE><HR SIZE=0 WIDTH=90%><H2>$folder</H2><PRE>\n"
						unless $discard;
					$depth++;
					if ($p =~ /^\s*\{/) {
						$depth++; next PART;
					} else {
						($contents, $p) = ($p =~ /^([^\s]+)\s(.*)$/);
						print "$contents" unless $discard;
						$depth = 0;
						next PART if ($p =~ /^\s*$/);
					}
				}
			}
			if ($depth == 2 && $p =~ /.*\}$/) {
				$p =~ s/(.*)\s*\}$/\1/;
				print "$p" unless $discard;
				$depth = 0;
				next;
			}
			if ($depth >= 2) {
				$depth++ if ($p =~ /\{/);
				$depth-- if ($p =~ /\}/);
				print "$p" unless $discard;
			}
		}
		print "\n" unless $discard;
	}
}

sub TACOMA_SetupConnection {
	local($line);

	# Set up the connection
	$sockaddr = 'S n a4 x8';
	chop($hostname = `hostname`);

	$remote = pack($sockaddr, 2, $TACPORT, (gethostbyname($TACHOST))[4]);
	$lokal = pack($sockaddr, 2, 0, (gethostbyname($hostname))[4]);

    socket(TCP, 2, 1, 6) || &TACOMA_Error("Socket failure: $!");
    setsockopt(TCP, 0xffff, 1, 0x0004);
    bind(TCP, $lokal) || &TACOMA_Error("Bind: $!");

    connect(TCP, $remote) || &TACOMA_Error("Unable to connect: $!");
    select(TCP); $| = 1; select(STDOUT);
}

sub TACOMA_ShutdownConnection {
	# Shut down the connection
	shutdown(TCP, 2);
}


print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>TACOMA HTML Gateway</TITLE></HEAD><BODY>\n";

print "<CENTER><H1>Tacoma agent execution result</H1></CENTER>\n";

&TACOMA_GetInput();
@message = &TACOMA_UnMarshall();
@code = &TACOMA_CheckPGP(@message);
@briefcase = &TACOMA_CreateBriefCase(@code);
&TACOMA_SetupConnection();
&TACOMA_SendBriefCase(@briefcase);
@reply = &TACOMA_ReadReply();
&TACOMA_ShutdownConnection();
&TACOMA_ReadExitValue($reply[$#reply]);
&TACOMA_DecomposeBriefCase(@reply);

if ($PRINT_BRIEFCASE) {
	print "<HR></PRE><H2>Briefcase returned</H2><PRE>\n";
	foreach $line (@reply) { print "$line"; }
	print "</PRE>";
}

print "<HR SIZE=4>The <A HREF=\"$TACOMA\"><B>Tacoma</B> project</A>\n";
print "</BODY></HTML>\n";

exit 0;