#!/usr/bin/perl
# This file is part of Nivlheim.
#
# Nivlheim 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 3 of the License, or
# (at your option) any later version.
#
# Nivlheim 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 Nivlheim.  If not, see <http://www.gnu.org/licenses/>.


#****************************************************************************************
#	This script is a part of Nivlheim.
#   It takes no parameters. It creates a client certificate,
#   signs it with the Nivlheim CA Certificate, and returns it.
#   It only issues certificates to clients that have been
#   manually approved.
#   The first request will put a client on the waiting list.
#   The list can be managed through the admin website.
#****************************************************************************************

use strict;
use warnings;
use File::Copy;
use Net::DNS;
use Net::CIDR;
use Net::IP qw(:PROC);
use Log::Log4perl;
use MIME::Base64;
use Proc::PID::File;
use DBI;
use Crypt::OpenSSL::X509;
use CGI;
use Nivlheim::Database;

sub forwardConfirmReverseDNS($);

# Config
my $confdir = "/var/www/nivlheim";
my $opensslconf = "/etc/nivlheim/openssl_ca.conf";
Log::Log4perl->init("$confdir/log4perl.conf");
my $logger = Log::Log4perl->get_logger("reqcert");

# Verify method
if ($ENV{'REQUEST_METHOD'} !~ /(GET|POST)/) {
	print "Status: 405\r\n\r\n";
	exit 1;
}

# Parse parameters
my $cgi = CGI->new;

# Connect to database
my $dbh = Nivlheim::Database->connect_to_db();

# 1. If the client supplied a CFEngine key digest and signature, verify it
my $trusted_by_cfengine = 0;
if ($cgi->param('cfe_key_md5') && $cgi->param('sign_b64') &&
	$cgi->param('cfe_key_md5') =~ /^([a-f0-9]{32})$/) {
	my $md5 = $1;

	# grab directory from /etc/nivlheim/server.conf
	my $cfengine_key_dir = '/var/cfengine/ppkeys';
	if (open(my $F, "/etc/nivlheim/server.conf")) {
		while (<$F>) {
			if (/CFEngineKeyDir\s*=\s*(\S+)/i) {
				$cfengine_key_dir = $1;
			}
		}
		close($F);
	}

	my $pubkeyfile = "$cfengine_key_dir/root-MD5=$md5.pub";
	my $convertedkeyfile = "/tmp/pubkey_$md5.pub";
	my $sigfile = "/tmp/content_$md5.txt.sign";
	my $contentfile = "/tmp/content_$md5.txt";

	# The public key file from CFEngine isn't in the format we need,
	# so we must convert it.
	$logger->debug("Converting CFEngine key from RSA format: $pubkeyfile");
	system("openssl rsa -in $pubkeyfile -RSAPublicKey_in > $convertedkeyfile");
	open(my $F, $convertedkeyfile);
	$logger->debug("First line: ".<$F>);
	close($F);
	
	open($F,">$sigfile");
	binmode $F;
	my $base64 = $cgi->param('sign_b64');
	$base64 =~ s/[\r\n]//g;
	print $F decode_base64($base64);
	close($F);

	open($F,">$contentfile");
	print $F "nivlheim";
	close($F);

	my $result = `openssl dgst -sha256 -verify $convertedkeyfile -signature $sigfile $contentfile 2>&1`;
	unlink($convertedkeyfile, $sigfile, $contentfile);
	$logger->debug("Verify signature: ".$result);
	if ($result =~ /Verified OK/) { $trusted_by_cfengine = 1; }
}

# 2. Check to see if this ip address qualifies for automatic naming.
my $hostname;
my $ipaddr = $ENV{'REMOTE_ADDR'};
my @row = $dbh->selectrow_array("SELECT count(*) FROM ipranges "
	."WHERE ? <<= iprange", undef, ($ipaddr));
if ((@row && $row[0]>0) || $trusted_by_cfengine) {
	# Determine what to put as "common name" in the new certificate,
	# i.e. the hostname of the machine.
	# This is just a qualified guess for now, it doesn't have to be correct.
	# If it is wrong, a new certificate will be issued later with the correct value.
	$hostname = forwardConfirmReverseDNS($ipaddr) || $cgi->param('hostname');
	if (!defined($hostname) || $hostname eq "") {
		print "Status: 400\r\nContent-Type: text/plain\r\n\r\n";
		print "Missing parameter: hostname\n";
		$logger->warn("Missing parameter: hostname");
		$dbh->disconnect;
		exit 1;
	}
} else {
	# Check if this client has been approved, and if not,
	# add them to the waiting list.
	my @row = $dbh->selectrow_array(
		"SELECT ipaddr, hostname, approved FROM waiting_for_approval WHERE ipaddr=?",
		undef, ($ipaddr));
	if (!@row) {
		$logger->debug("The host $ipaddr has not been pre-approved");
		$hostname = $cgi->param('hostname');
		if (!defined($hostname) || $hostname eq "") {
			print "Status: 400\r\nContent-Type: text/plain\r\n\r\n";
			print "Missing required parameter: hostname\n";
			$logger->warn("Missing required parameter: hostname");
			$dbh->disconnect;
			exit 1;
		}
		$logger->debug("$ipaddr says its hostname is \"" . $cgi->param('hostname') . "\"");
		my $dnsresult = forwardConfirmReverseDNS($ipaddr);
		if (defined($dnsresult)) {
			$hostname = $dnsresult;
			$logger->debug("DNS lookup says $ipaddr is $hostname");
		} else {
			$logger->debug("DNS lookup is inconclusive.");
		}
		$logger->info("Adding $hostname to the waiting for approval list.");
		$dbh->do("INSERT INTO waiting_for_approval(ipaddr, hostname, received) "
			."VALUES(?,?,now());", undef, ($ipaddr,$hostname));
		print "Content-Type: text/plain\r\n\r\nYou have been added to the waiting list.\n";
		$dbh->disconnect;
		exit;
	}
	if (!$row[2]) {
		# Not approved yet
		$logger->debug("The host ".$row[1]." / $ipaddr is already on the waiting list.");
		print "Content-Type: text/plain\r\n\r\nYou are on the waiting list, be patient.\n";
		$dbh->disconnect;
		exit;
	}
	# The client has been approved.
	$hostname = $row[1];
}

# HTTP Header
print "Content-Type: text/plain\r\n\r\n";

# There is a race condition with openssl, so until that is solved
# there can be only one instance of this script running at any time.
if (Proc::PID::File->running({"dir" => "/tmp", "name" => "reqcert"})) {
	print "Too busy, please try again later.\n";
	$logger->debug("Too busy, let's hope they try again later.");
	exit;
}

# Temporary files
my $id = int(rand()*100000000); # only used during the execution of this script
my $keyfile = "/tmp/user$id.key";
my $csrfile = "/tmp/user$id.csr";
my $crtfile = "/tmp/user$id.crt";
my $p12file = "/tmp/user$id.p12";

eval {
	# Generate client key
	my $cmd = "openssl genrsa -out $keyfile 4096 2>/dev/null";

	(system($cmd) == 0 and -f $keyfile) or die "Key generation failed: $?";
	print "Key OK.\n";

	# Generate client certificate request
	$cmd = "openssl req -new -key $keyfile -out $csrfile -config $opensslconf";
	(system($cmd) == 0 and -f $csrfile) or die "Certificate request failed: $?";
	print "Certificate request OK.\n";

	# find the id of the new certificate
	open(F, "$confdir/db/serial") or die "Could not read db/serial";
	$id = <F>; chomp $id;  # 6-sifret sertifikat-id fra openssl
	close(F);
	print "The new id is $id\n";

	# Sign the certificate request with the CA certificate. This will generate crt- and pem-files.
	# openssl will store the pem-file in the certs directory (see openssl_ca.conf)
	$cmd = "openssl ca -batch -in $csrfile -cert $confdir/CA/nivlheimca.crt"
		." -keyfile $confdir/CA/nivlheimca.key"
		." -subj '/C=NO/ST=Norway/O=UiO/OU=USIT/CN=$hostname'"
		." -out $crtfile -config $opensslconf 2>/var/log/nivlheim/sign.log";
	if (!(system($cmd) == 0 and -f $crtfile)) {
		$logger->debug($cmd);
		die "Signing failed: $?";
	}
	print "Signing OK.\n";

	# Clean up the generated pem file; don't need it
	unlink("$confdir/certs/$id.pem");

	# Keep the certificate in the database
	my $cert;
	{
		open(my $F, $crtfile);
		binmode($F);
		local $/ = undef;
		$cert = <$F>;
		close($F);
	}
	my $x509 = Crypt::OpenSSL::X509->new_from_string($cert);
	my $new_fingerprint = $x509->fingerprint_sha1();
	$new_fingerprint =~ s/://g;
	my $sth = $dbh->prepare("INSERT INTO certificates(issued,fingerprint,"
		."commonname,cert,trusted_by_cfengine) VALUES(now(),?,?,?,?)");
	$sth->execute(($new_fingerprint, $hostname, $cert, $trusted_by_cfengine));
	$sth->finish;
	# Separate UPDATE statement because it needs the auto-incremented id value from INSERT
	$dbh->do("UPDATE certificates SET first=".
		"(SELECT certid FROM certificates WHERE fingerprint=?) ".
		"WHERE fingerprint=?", undef, ($new_fingerprint, $new_fingerprint));

	# Generate a P12 file
	$cmd = "openssl pkcs12 -export -out $p12file -inkey $keyfile -in $crtfile "
		. "-CAfile $confdir/CA/nivlheimca.crt -password pass:";
	if (!(system($cmd) == 0 and -f $p12file)) {
		$logger->debug($cmd);
		die "P12 failed: $?";
	}

	# Display the generated certificate and key
	open(F, $crtfile) or die "Can't read crt file";
	while (<F>) { last if (/--BEGIN CERTIFICATE--/) };
	print; print while (<F>);
	close(F);
	open(F, $keyfile) or die "Can't read key file";
	print while (<F>);
	close(F);

	# Display the P12-file, base64-encoded
	open(F, $p12file);
	my $p12bytes;
	my $len = read(F, $p12bytes, 100000);
	close(F);
	print "-----BEGIN P12-----\n" . encode_base64($p12bytes, "\n") . "-----END P12-----\n";

	$logger->info("Created new cert with id $id for $hostname");
};
if ($@) {
	$logger->error("Failed to create new cert for $hostname: $@");
	print "Failed to create new certificate for $hostname:\n$@\n";
}

# Clean up temp files
unlink($keyfile) if (-f $keyfile);
unlink($csrfile) if (-f $csrfile);
unlink($crtfile) if (-f $crtfile);
unlink($p12file) if (-f $p12file);

$dbh->disconnect;

############ subroutines

sub expand_ip($) {
	my $ip =  shift;
	if (Net::IP::ip_is_ipv6($ip)) {
		return Net::IP::ip_expand_address($ip, 6);
	}
	else {
		return Net::IP::ip_expand_address($ip, 4);
	}
}

sub forwardConfirmReverseDNS($) {
	# http://en.wikipedia.org/wiki/Forward-confirmed_reverse_DNS
	my $ip = shift;
	$ip = expand_ip($ip);
	my $dns = Net::DNS::Resolver->new;
	my $packet = $dns->query($ip, 'PTR');
	if ($packet) {
		foreach my $rr ($packet->answer) {
			next unless $rr->type eq 'PTR';
			# Fant et hostnavn, slå opp dette tilbake
			my $hostname = $rr->ptrdname;
			my @answers = ();
			my $packet2 = $dns->query($hostname, 'A');
			if ($packet2) { push @answers, $packet2->answer; }
			$packet2 = $dns->query($hostname, 'AAAA');
			if ($packet2) { push @answers, $packet2->answer; }
			for my $rr2 (@answers) {
				next unless ($rr2->type eq 'A' || $rr2->type eq 'AAAA');
				my $ip2 = expand_ip($rr2->address);
				if ($ip eq $ip2) {
					return $hostname;
				}
			}
		}
	}
	return;
}