#!/usr/bin/perl
use strict;
use warnings;

use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use CGI;
use DBI;
use Digest::CRC qw(crc32);
use Encode qw(from_to encode_utf8 decode_utf8);
use File::Basename;
use File::Find;
use File::Temp qw/ tempdir /;
use IPC::Open3;
use Log::Log4perl;
use POSIX qw(strftime);
use Symbol qw(gensym);
use LWP::Simple;
use Nivlheim::Database;

sub parse_query_string();
sub run_command($);
sub uts_to_rfc3339($);

# Restrict access to only localhost, and disallow proxy connections
my $ip = $ENV{'REMOTE_ADDR'};
if (defined($ENV{'HTTP_X_FORWARDED_FOR'}) || ($ip ne "127.0.0.1" && $ip ne "::1")) {
	print "Status: 403\r\n\r\n";
	exit;
}

# Config
my $confdir = "/var/www/nivlheim";

# Logging
my $logger;
eval {
	Log::Log4perl->init("$confdir/log4perl.conf");
	$logger = Log::Log4perl->get_logger("processarchive");
};
if ($@) {
	# Probably unable to write to the log file (typically permission denied)
	# but we don't want that to prevent the data flow.
	$logger = Log::Log4perl->get_logger("syslogger");
}

# Check parameters
my %params = parse_query_string();
unless (exists $params{'file'}) {
	print "Status: 400\r\n\r\nMissing parameter: file\n";
	$logger->debug("Missing parameter: file");
	exit;
}
if ($params{'file'} =~ m![\\/]!) {
	print "Status: 403\r\n\r\n";
	$logger->debug("File path contains slashes; not allowed");
	exit;
}
my $archivefile = $params{'file'};
$archivefile = "$confdir/queue/$archivefile";
unless (-f $archivefile) {
	print "Status: 410\r\n\r\nCan't find the archive file.\n";
	$logger->debug("Can't find the archive file");
	exit;
}
unless (-r $archivefile) {
	print "Status: 400\r\n\r\nUnable to read the archive file.\n";
	$logger->debug("Unable to read the archive file");
	exit;
}

# Connect to database
$logger->debug("Connecting to database");
my $dbh = Nivlheim::Database->connect_to_db();
$dbh->begin_work(); # start a transaction

# Unpack the archive
eval{
	$logger->debug("Create temp dir");
	my $dir = tempdir( CLEANUP => 1 );
	$logger->debug("Unpacking into $dir");
	chdir($dir);
	if ($archivefile =~ /\.tgz$/) {
		run_command("/bin/tar -xzf $archivefile --warning=no-timestamp");
	}
	elsif ($archivefile =~ /\.zip$/) {
		run_command("/usr/bin/unzip -oqq $archivefile 2>&1");
	}
	else {
		# The way the client is currently written, this will not happen.
		die "Unknown archive file format.";
	}

	# make sure the file modes allow to chdir into
	chmod(0755, "$dir/files", "$dir/commands");

	# Text files from Windows are usually UTF-16, so let's convert those
	$logger->debug("zip file, check files for UTF-16 and convert where applicable");
	if ($archivefile =~ /\.zip$/) {
		my $zip = Archive::Zip->new();
		unless ($zip->read($archivefile) == AZ_OK) {
			die 'read error';
		}
		foreach my $fname ($zip->memberNames()) {
			$fname =~ s/\\/\//g;  # convert backslashes to forward slashes
			next if (-d "$dir/$fname");
			if (open (my $F, "$dir/$fname")) {
				# read the file, check for BOM
				my $content = do { local $/; <$F>; };
				close($F);
				if (ord(substr($content,0,1)) == 0xFF && ord(substr($content,1,1)) == 0xFE) {
					# UTF-16 BOM, little endian
					from_to($content, 'UTF-16', 'UTF-8');
					open($F, ">$dir/$fname");
					print $F $content;
					close($F);
				}
			}
		}
	}

	# Remove ssh private keys if they are present
	unlink("$dir/files/etc/ssh/ssh_host_rsa_key");
	unlink("$dir/files/etc/ssh/ssh_host_dsa_key");
	unlink("$dir/files/etc/ssh/ssh_host_ecdsa_key");

	# Remove log files that should not be sent to Nivlheim in the first place
	unlink("$dir/files/var/log/*");

	# read the meta data file
	$logger->debug("Read meta file");
	my %meta = ();
	open(my $F, "$archivefile.meta") || die "Unable to open metafile";
	while (<$F>) {
		my ($key, $val) = split /\s*=\s*/;
		$val =~ s/[\r\n]//g;
		$meta{$key} = $val;
	}
	close($F);

	# TEMPORARY FIX:
	# There's a bug in the Windows client, in some cases it gives the hostname without the domain.
	# See: https://github.com/unioslo/nivlheim/issues/138
	if (($meta{os_hostname} !~ /\./) && (-r "${dir}/commands/DomainName")) {
		if (open($F,"${dir}/commands/DomainName")) {
			<$F>; # discard the first line, which is the command itself
			$_ = <$F>;
			s/[\r\n]//g;
			$meta{os_hostname} .= ".$_";
			close($F);
		}
	}
	# END of fix

	my $iso_received = uts_to_rfc3339($meta{'received'});

	$logger->debug("Prepare database statements");

	my $currentfiles = $dbh->selectall_hashref("SELECT fileid,filename FROM files "
		."WHERE certfp=? AND current", "filename", undef, ($meta{certfp}));

	my $sth = $dbh->prepare("INSERT INTO files(ipaddr,os_hostname,"
		."certcn,certfp,filename,received,mtime,content,crc32,is_command,"
		."clientversion,originalcertid) "
		."VALUES(?,?,?,?, ?,?,?,?,?, ?,?, "
		."(SELECT certid FROM certificates WHERE fingerprint=?))");

	my $sth_setcurrent = $dbh->prepare("UPDATE files SET current=true,received=now() "
		."WHERE fileid=? AND NOT current");

	my $sth_clearcurrent = $dbh->prepare("UPDATE files SET current=false "
		."WHERE fileid=? AND current");

	my $sth_clearparsed = $dbh->prepare("UPDATE files SET parsed=false WHERE fileid=?");

	my $sth_crc = $dbh->prepare("SELECT crc32,fileid FROM files "
		."WHERE certfp=? AND filename=? ORDER BY received DESC LIMIT 1");

	# Must not set lastseen back in time if re-parsing an old file
	my $sth_hostinfo1 = $dbh->prepare("UPDATE hostinfo SET lastseen=?, clientversion=? ".
		"WHERE certfp=? AND lastseen<?");
	# If the machine has changed its ip address or hostname, set dnsttl to null to trigger a new evaluation
	my $sth_hostinfo2 = $dbh->prepare("UPDATE hostinfo SET ipaddr=?, os_hostname=?, ".
		"dnsttl=null WHERE (ipaddr!=? OR os_hostname!=?) AND certfp=?");

	my $unchangedfilecount = 0;

	# Is there a hostinfo record for this certificate?
	@_ = $dbh->selectrow_array(
		"SELECT count(*) FROM hostinfo WHERE certfp=?", undef, ($meta{certfp}));
	my $hostinfo_record_exists = $_[0];

	# For each file
	sub callback1 {
		# Skip directories
		return if -d $File::Find::name;

		# Skip files that aren't in the files or commands folders
		return unless $File::Find::name =~ m!/(files|commands)/!;
		$logger->debug("Processing " . basename($File::Find::name));

		# Make an ISO timestamp from the modified time of the file
		my $mtime = (stat($File::Find::name))[9];
		my $iso_mtime = uts_to_rfc3339($mtime);

		# Read the content
		my ($content, $originalfilename);
		my $is_command = ($File::Find::name =~ m!/commands/!) ? 1 : 0;
		my $F;
		if (!open($F, $File::Find::name)) {
			$logger->error("Unable to open ".$File::Find::name.": $!");
			return;
		}
		binmode $F;
		if ($is_command) {
			# The first line of the file is the original command line
			$originalfilename = <$F>;
			$originalfilename =~ s/[\r\n]//g;
			$content = join '', <$F>;
		} else {
			local $/ = undef;
			$content = <$F>;
			if ($File::Find::name =~ m!.*/files(/.*)!) {
				$originalfilename = $1;
			} else {
				$logger->error("Failed parsing filename from  ".$File::Find::name);
				return;
			}
		}
		close $F;

		# Detect Latin-1 and convert it to UTF-8.
		# http://stackoverflow.com/questions/22868271/how-to-detect-latin1-and-utf-8/22868803#22868803
		# If it doesn't work to decode the content as utf-8, we can assume
		# that it is Latin-1 and treat it accordingly.
		my $de = eval { decode_utf8($content, Encode::FB_CROAK|Encode::LEAVE_SRC) };
		unless ($de) {
			$content = encode_utf8($content);
		}

		# Remove control characters, except for CR, LF and TAB.
		$content =~ tr/\000-\010/ /;
		$content =~ tr/\013-\014/ /;
		$content =~ tr/\016-\037/ /;

		# Compute a checksum
		my $crc32 = crc32($content);
		if ($crc32 > 0x7FFFFFFF) { $crc32 = -((~$crc32 & 0xFFFFFFFF)+1); }

		# See if this file differs from the previous copy.
		# If they are equal, there's no point in storing this copy.
		$sth_crc->execute(($meta{certfp}, $originalfilename));
		if ($dbh->err) { die $dbh->errstr; }
		my $aref = $sth_crc->fetchrow_arrayref;
		$sth_crc->finish;
		if (defined($aref)) {
			my $oldcrc = $$aref[0];
			my $fileid = $$aref[1];
			if (defined($oldcrc) && $crc32 eq $oldcrc) {
				$logger->debug("   Unchanged.");
				# Is there a hostinfo record for this certificate?
				if ($hostinfo_record_exists) {
					# There is a hostinfo record.
					# Since this file isn't going to be inserted and parsed, update hostinfo directly
					$sth_hostinfo1->execute(($iso_received, $meta{clientversion}, $meta{certfp}, $iso_received));
					$sth_hostinfo2->execute(($meta{ip}, $meta{os_hostname}, $meta{ip}, $meta{os_hostname}, $meta{certfp}));
					$unchangedfilecount++;
				} else {
					# There is NO hostinfo record.
					# It looks like the machine was archived and just now came back.
					# Set parsed=false so the file will be parsed again,
					# because the hostinfo values must be re-populated.
					$sth_clearparsed->execute(($fileid));
				}
				# Make sure this file record keeps it "current" flag set
				$sth_setcurrent->execute(($fileid));
				delete $currentfiles->{$originalfilename};
				return;
			}
		}

		# Set current to false for the previous version of this file
		if (exists($currentfiles->{$originalfilename})) {
			$sth_clearcurrent->execute(($currentfiles->{$originalfilename}->{'fileid'}));
			delete $currentfiles->{$originalfilename};
		}

		# Run the database INSERT operation
		$logger->debug("   INSERT");
		my @values = ($meta{ip}, $meta{os_hostname},
			$meta{certcn}, $meta{certfp}, $originalfilename,
			$iso_received, $iso_mtime, $content, $crc32, $is_command,
			$meta{clientversion}, $meta{certfp});
		$sth->execute(@values) or $logger->error($sth->errstr);
		if ($dbh->err) { die $dbh->errstr; }
	}
	find(\&callback1, $dir);
	$logger->debug("Completed inserting new files into the database");

	# clear the "current" flag for files that weren't in this package
	$logger->debug("Clear the current flag for deleted files");
	my @no_longer_current = ();
	foreach (keys %{$currentfiles}) {
		my $fileid = $currentfiles->{$_}->{'fileid'};
		$sth_clearcurrent->execute(($fileid));
		push @no_longer_current, $fileid;
	}

	$logger->debug("Commit database transaction");
	$dbh->commit;
	unlink($archivefile, "$archivefile.meta");

	# Create a task that will call the API to signal that these files are
	# no longer current, so they can be removed from the search cache.
	$logger->debug("Call API 'unsetCurrent'");
	if ($#no_longer_current>-1) {
		get("http://localhost:4040/api/internal/unsetCurrent?ids="
			. join(',', @no_longer_current));
	}

	# Report the number of unchanged files to the system service
	# so they too are counted (for statistical purposes)
	$logger->debug("Call API 'countFiles'");
	if ($unchangedfilecount > 0) {
		get("http://localhost:4040/api/internal/countFiles?n=".$unchangedfilecount);
	}
};
if ($@) {
	$logger->error($@);
	$dbh->rollback;
	$dbh->disconnect;
	print CGI::header(
		-type => 'text/plain',
		-status => '500 Internal Server Error'
	);
	print $@;
	exit 1;
};

$logger->debug("Finished.");

# Clean up
$dbh->disconnect;

# Return OK
print CGI::header('text/plain');
print "OK\n";

sub parse_query_string() {
	my %result = ();
	foreach (split /&/, $ENV{'QUERY_STRING'}) {
		my ($key, $value) = split /=/;
		$result{$key} = $value;
	}
	return %result;
}

sub uts_to_rfc3339($) {
	my $uts = shift;
	return strftime("%Y-%m-%dT%H:%M:%SZ",gmtime($uts));
}

sub run_command($) {
	# calls die() if anything gets written to stderr, or if the command has syntax errors.
	# Output to stdout will be logged at debug level.
	# Returns concatendated stdout from the child process.
	my $cmd = shift;
	local *CATCHOUT = IO::File->new_tmpfile;
	local *CATCHERR = IO::File->new_tmpfile;
	my $pid = open3(gensym, ">&CATCHOUT", ">&CATCHERR", $cmd);
	waitpid($pid, 0);
	seek $_, 0, 0 for \*CATCHOUT, \*CATCHERR;
	my $stdout = '';
	my $stderr = '';
	while( <CATCHOUT> ) { $stdout .= $_; }
	while( <CATCHERR> ) { $stderr .= $_; }
	close CATCHOUT;
	close CATCHERR;
	# trim stdout and stderr
	$stdout =~ s/^[\s]+|[\s]+$//g;
	$stderr =~ s/^[\s]+|[\s]+$//g;
	if ($stderr ne '') { die "$cmd\n$stderr"; }
	if ($stdout ne '') { $logger->debug("$cmd\n$stdout"); }
	return $stdout;
}
