#!/usr/bin/perl -wT
#
# autopsy gui server
# Autopsy Forensics Browser
#
# Brian Carrier [carrier@cerias.purdue.edu]
#
# This file requires The Coroners Toolkit (TCT)
#    www.fish.com/tct/
#
# and TCTUTILs
#   www.cerias.purdue.edu/homes/carrier/forensics
#
#  $Revision: 0.2 $
#
# Copyright (c) 2001 by Brian Carrier.  All rights reserved
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# 1. Redistributions of source code must retain the above copyright notice,
#    this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. The name of the author may not be used to endorse or promote
#    products derived from this software without specific prior written
#    permission.
#
#
# THIS SOFTWARE IS NOT AFFILIATED WITH PURDUE UNIVERSITY OR THE CENTER FOR
# EDUCATION IN INFORMATION ASSURANCE AND SECURITY (CERIAS) AND THEY BEAR
# NO RESPONSIBILITY FOR ITS USE OR MISUSE.
#
#
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR ANY PARTICULAR PURPOSE.
# IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, LOSS OF USE, DATA, OR PROFITS OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

#
# refer to Security Considerations in README for a description of the 
# cookie authentication
#

use lib '/usr/local/autopsy/';
require 5.002;

use autopsyfunc;	
use strict;
use Socket;

# Import variables from conf.pl
use vars '$PROGNAME', '$MORGDIR', '$INVESTIG';

#
# ------ BEGIN USER SETTINGS
#
my $USE_STIMEOUT = 0;	# if set to 1, the server will stop after STIMEOUT
my $STIMEOUT = 3600;	# seconds that server times out due to no activity
                        # This is recommended if cookies are not used
my $CTIMEOUT = 15;		# seconds that child waits for input from client

my $USE_COOKIE = 1;		# Set to 1 for cookie authentication
my $COOKIE_FILE = '.autopsy.cook';	# save current cookie

my $USE_LOG = 1;		# set to 1 for logging, 0 for none
my $LOG_FILE = 'autopsy.log';	# Log connections and errors

#
# ------ END USER SETTINGS
#

# remove environment stuff that we don't need and that could be insecure
$ENV{PATH} = '';
delete @ENV{ 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
$| = 1;

sub usage {
    print "usage: $0 [-m morguedir] [-i name] port remoteaddr\n";
	exit 1;
}

if ((scalar(@ARGV) < 2) || (scalar(@ARGV) > 6)) {
	usage();
}

# Were options given?
while (scalar (@ARGV) > 2) {
	my $f = shift;

	# Morgue Directory
	if ($f eq '-m') {
		if (scalar (@ARGV) == 0) {
			print "Missing Directory\n";
			usage();
		}

		my $d = shift;
		# We need to do this for the tainting
		# We don't need to check for special characters in this case because
		# all commands will be run with the same permissions as the
		# original user.  We will check for the obvious ';' though
		if ($d =~ /;/) {
			print "Illegal argument\n";
			exit (1);
		}

		# If the path is relative, autopsyfunc will get screwed up when
		# this is run from a directory other than where autopsyfunc is
		# so force full paths
		elsif ($d !~ /^\//) {
			print "Morgue path must be full path (i.e. begin with /)\n";
			exit(1);
		}
		elsif ($d =~ /(.*)/) {
			$d =$1;
			# Verify it exists
			if (!(-d $d)) {
				print "invalid directory: $d\n";
				exit (1);
			}

			# Verify it is a morgue directory
			elsif (!(-e $d.'/fsmorgue')) {
				print "fsmorgue file missing in $d\n";
				exit (1);
			} 
			else {
				$MORGDIR = $1;
			}
		}
	}
	# Investigators Name
	elsif ($f eq '-i') {
		if (scalar (@ARGV) == 0) {
			print "Missing investigators name\n";
			usage();
		}
		$INVESTIG = shift;
	}
	else {
		print "Invalid flag: $f\n";
		usage();
	}
}



# Get port to listen on
my $port = shift;
if ($port =~ /(\d+)/) {
	$port = $1;
}
else {
	print "invalid port: $port\n";
	usage();
}


# Get remote address
my $rema = shift;
my @acl_addr;		# Array of host addresses
my $hn;				# Host name
my $tmp;
if ($rema =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {
	($hn, $tmp, $tmp, $tmp, @acl_addr) = gethostbyname($rema);
}
else {
	($hn, $tmp, $tmp, $tmp, @acl_addr) = gethostbyname($rema);
}

unless (defined $tmp) {
	print "Host not found: $rema\n";
	usage();
}


print "\n    Autopsy Forensic Browser ver $VER\n";
print "    Investigator: $INVESTIG\n\n";

# open log with permissions only for owner
if ($USE_LOG == 1) {
	open AUTLOG, ">>$LOG_FILE" or die "Can't open: $LOG_FILE";
	chmod 0400, $LOG_FILE;
}

sub logmsg 
{
	return unless ($USE_LOG == 1);

	my $str = shift;
	my $date = localtime;
	print AUTLOG "$date: $str";
}


# Setup socket
my $proto = getprotobyname('tcp');
socket (Server, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, 1) or die "setsockopt: $!";
setsockopt(Server, SOL_SOCKET, SO_KEEPALIVE, 1) or die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) or die "bind: $!";
listen(Server, SOMAXCONN) or die "listen: $!";

my $magic;		# magic authentication cookie


# Determine the address that will be used to access this server
my $lclhost;
my @ta = unpack('C4', $acl_addr[0]);

# If we are being accessed by localhost, we need that and not the hostname
if (($ta[0] == 127) && ($ta[1] == 0) &&
  ($ta[2] == 0) && ($ta[3] == 1)) {
	$lclhost = "localhost";
}
else {
	$lclhost = `/bin/hostname`;
	chop $lclhost;
}

print "Paste this as your browser URL on $rema:\n";
if  ($USE_COOKIE == 1) {

	# Try for a real random device, or use rand if all else fails
	if (-e "/dev/urandom") {
		my $r;
		open RAND, "</dev/urandom" or die "can not open /dev/urandom";
		read RAND, $r, 4;
		close RAND;
		$magic = unpack "I", $r;
	}
	else {
		$magic = int(rand 0xffffffff);
	}

	print "\t$lclhost:$port/$magic/$PROGNAME\n";

	# Save to file in case the stdout gets overwritten
	open COOK, ">$COOKIE_FILE" or die "can not open cookie file";
	chmod 0400, $COOKIE_FILE;
	print COOK "$magic\n";
	close COOK;

} else {
	print "\t$lclhost:$port/$PROGNAME\n";
}

logmsg "listening on port $port for conn from $hn ($INVESTIG)\n";

# Set the server alarm
$SIG{ALRM} = \&sig_alarm_server;

# Wait for Connections
while (1) {

	alarm ($STIMEOUT) if ($USE_STIMEOUT == 1);

	my $raddr = accept(CLIENT, Server); 
	my ($rport, $riaddr) = sockaddr_in($raddr);

	if (0 == fork) {
		open(STDOUT, ">&CLIENT") or die "Can't dup client to stdout";
		open(STDIN, "<&CLIENT") or die "Can't dup client to stdin";
		$| = 1;

		my @rip = unpack('C4', $riaddr);
		# logmsg "Connection from: $rip[0].$rip[1].$rip[2].$rip[3]\n";

		# Check ACL
		foreach $tmp (@acl_addr) {
			if ($tmp eq $riaddr) {
				spawn_cli($riaddr);
				close CLIENT;
				exit 0;
			}
		}

		forbid ();
		logmsg "ERROR: Unauthorized Connection from:".
		   "$rip[0].$rip[1].$rip[2].$rip[3]\n";

		close CLIENT;
		exit 1;
	}
	else {
		close CLIENT;
	}
}


# Error messages
sub forbid 
{
	print "HTTP/1.0 403 Forbidden\n";
	print "Content-type: text/html\n\n".
		"<HTML><H1>access denied</H1></HTML>\n";
}

sub bad_req 
{
	print "HTTP/1.0 404 Bad Request\n";
	print "Content-type: text/html\n\n".
		"<HTML><H1>invalid URL: ".shift()."</H1><HR></HTML>\n";
}


# Alarm Functions
sub sig_alarm_client 
{
	logmsg "Connection timed out\n";
	close CLIENT;
	exit 1;
}

sub sig_alarm_server 
{
	print "Server Timeout ($STIMEOUT seconds), Exiting\n";
	logmsg "Server Timeout ($STIMEOUT seconds), Exiting\n";
	exit 0;
}

# Pass the remote IP address as the argument for logging
sub spawn_cli 
{
	# Set timeout for 10 seconds if we dont get any input
	alarm ($CTIMEOUT);
	$SIG{ALRM} = \&sig_alarm_client;

	while (<STDIN>) {

		if (/^GET \/+(\S*)\s?HTTP/) {
			my $url = $1;
			my $script;
			my $args;

			# Magic Cookie 
			# If we are using cookies, then the url should be:
			# cookie/autopsy?var=val ...
			if (($USE_COOKIE == 1)
			  && ($url =~ /^(\d+)\/+([\w\.]+)(?:\?(.*))?$/)) {

			  	if ($1 != $magic) {
					my @rip = unpack('C4', shift());
					logmsg "ERROR: Incorrect Cookie from:".
					   "$rip[0].$rip[1].$rip[2].$rip[3]\n";
					forbid();
					return 1;
				}

				$script = $2;
				$args = $3;
			}
			# if we aren't using cookies, then it should be:
			# autopsy?var=val ...
			elsif (($USE_COOKIE == 0)
			  && ($url =~ /^\/?([\w\.]+)(?:\?(.*))?$/)) {
				$script = $1;
				$args = $2;
			}
			else {
				bad_req($url);
				logmsg "Invalid URL: $url\n";
				return 1;
			}

			if ($script eq $PROGNAME) {
				unless (defined $args) {
					$args = "";
				}

				# Turn timer off
				alarm (0);

				# Print status
				print "HTTP/1.0 200 OK\n";
				autopsy_main($args);
			}
			else {
				bad_req($url);
				logmsg "Unknown function: $script\n";
			}
			return 0;
		}
	} # end of while (<>)

} # end of spawn_cli

