#!/usr/bin/perl -w

# 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/>.

use strict;
use warnings;
use vars qw($server_url);

use IO::File;
use IO::Socket::SSL;
use IO::Socket::INET6;
use Net::DNS;
use Archive::Tar;
use HTTP::Request::Common;
use Sys::Hostname;
use Sys::Syslog qw(:standard :macros);
use Fcntl ':flock';
use File::Path qw(remove_tree mkpath);
use File::Basename;
use Getopt::Long qw(:config no_ignore_case);

sub http_get($$$);
sub http_post($$$$);
sub test_without_client_cert();
sub readconfig($);
sub printlog($);
sub shortencmd($);
sub reverse_dns_lookup($$);
sub parse_certificate_response($);
sub createPKCS8();
sub getpassword();
sub sign_with_cfengine_key();
sub extract_cmd($);

# Options with default values
my %defaultopt = (
	'config'    => '/etc/nivlheim/client.conf:/usr/local/etc/nivlheim/client.conf', # configuration file
	'ca_file'   => '/var/nivlheim/nivlheimca.crt'
				 . ':/etc/ssl/certs/ca-certificates.crt:/etc/ssl/certs/ca-bundle.crt'
				 . ':/etc/pki/tls/certs/ca-bundle.crt:/usr/local/etc/ssl/cert.pem',
	'cert_file' => '/var/nivlheim/my.crt',
	'key_file'  => '/var/nivlheim/my.key',
	'debug'     => 0,  # debugging / verbose output
	'help'      => 0,  # display help output
	'version'   => 0,  # plugin version info
	'sleeprandom' => 0,
	'minperiod' => 0,
	'nocfe' => 0,
	'max_redirects' => 3
	);

# Version information
my $NAME    = 'nivlheim_client';
my $AUTHOR  = 'Øyvind Hagberg';
my $CONTACT = 'oyvind.hagberg@usit.uio.no';
my $RIGHTS  = 'USIT/IT-DRIFT/GD/GID, University of Oslo, Norway';
my $VERSION = '2.7.9-2021W08'; # Will be replaced during package building

# Usage text
my $USAGE = <<"END_USAGE";
Usage: $NAME [OPTION]...
END_USAGE

# Help text
my $HELP = <<'END_HELP';

OPTIONS:
   -c, --config    Specify configuration file
   --ssl-ca        SSL CA file
   --ssl-cert      SSL CERT file
   --ssl-key       SSL key file
   -d, --debug     Debug output, reports everything
   -h, --help      Display this help text
   -V, --version   Display version info
END_HELP

# Version and license text
my $LICENSE = <<"END_LICENSE";
$NAME $VERSION
Copyright (C) 2015 $RIGHTS
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.

Written by $AUTHOR <$CONTACT>
END_LICENSE

# Get options
my %opt;
GetOptions('c|config=s' => \$opt{config},
	   'ssl-ca=s'       => \$opt{ca_file},
	   'ssl-cert=s'     => \$opt{cert_file},
	   'ssl-key=s'      => \$opt{key_file},
	   'sleeprandom=i'  => \$opt{sleeprandom},
	   'minperiod=i'    => \$opt{minperiod},
	   'd|debug'        => \$opt{debug},
	   'h|help'         => \$opt{help},
	   'V|version'      => \$opt{version},
	   'nocfe'          => \$opt{nocfe},
	   'max-redirects'  => \$opt{max_redirects}
	  ) or do { print $USAGE; exit 1 };

# If user requested help
if ($opt{help}) {
	print $USAGE, $HELP;
	exit 0;
}

# If user requested version info
if ($opt{version}) {
	print $LICENSE;
	exit 0;
}

# minimum period between successful runs
my @stat = stat "/var/run/nivlheim_client_last_run";
if ($opt{minperiod}) {
	if ($#stat>=0) {
		my $seconds_since_last_time = time()-$stat[9];
		if ($seconds_since_last_time < $opt{minperiod}) {
			print "Only $seconds_since_last_time seconds since last ".
				"successful report. Skipping this time.\n" if ($opt{debug});
			exit 64
		}
	}
}

# If another instance of this script is already running, exit.
# Implemented this way because we don't want the package to depend on EPEL,
# and unfortunately all the Perl modules for checking PID are there.
open SELF, "< $0" or exit;
unless ( flock SELF, LOCK_EX | LOCK_NB ) {
	# Another instance is running
	exit;
}

# sleep if cmdline parameter says so, and there has been at least one successful run earlier
if ($opt{sleeprandom} && $#stat>=0) {
	print "sleeping...\n" if ($opt{debug});
	sleep int(rand($opt{sleeprandom}));
}

# Log to stdout or syslog depending on whether we have a TTY
if (!-t STDOUT) {
	# There's no TTY. Open syslog
	openlog('nivlheim', '', Sys::Syslog::LOG_DAEMON);
}

# tempdir
my $tempdir = "/tmp/nivlheim$$";
mkdir($tempdir);

END {
	if (!-t STDOUT) {
		closelog();
	}
	if (defined($tempdir)) {
		print "Cleanup\n" if ($opt{debug});
		remove_tree($tempdir);
	}
}

# Read the config file
$opt{config} ||= $defaultopt{config};
my $configfile;
foreach my $possible_config_file (split(':', $opt{config})) {
	if (-f $possible_config_file) {
		$configfile = $possible_config_file;
		last;
	}
}
if (!$configfile) {
	printlog "Unable to locate configuration file\n";
	exit 1;
}
my %config = readconfig($configfile);
if (!%config) {
	printlog "Unable to read configuration file $configfile\n";
	exit 1;
}

# Set certain options from the config file if they aren't already set.
if (!defined($opt{ca_file}) || $opt{ca_file} eq '') {
	$opt{ca_file} = $config{'settings'}{'server_ssl_ca'};
}

# Use default options if nothing else is specified.
foreach (keys %defaultopt) {
	if ((!defined $opt{$_}) || $opt{$_} eq '') {
		$opt{$_} = $defaultopt{$_};
	}
}

# Verify that we have a server url. It must have trailing slash.
if (!defined($config{'settings'}) || !defined($config{'settings'}{'server'})) {
	print "The config file $configfile must have a section [settings] "
		 ."that contains a \"server\" option "
		 ."with the hostname or ip address of the server.\n";
	exit 1;
}
$server_url = 'https://' . $config{'settings'}{'server'} . '/cgi-bin/';

# Show options in effect
if ($opt{debug}) {
	print "Effective settings:\n";
	foreach (sort keys %opt) {
		print "\t$_ = $opt{$_}\n";
	}
}

# Verify that the CA certificate file is readable.
my $real_ca_file = '';
foreach my $possible_ca_file (split(':', $opt{ca_file})) {
	if (-r $possible_ca_file) {
		$real_ca_file = $possible_ca_file;
		last;
	}
}
if (!-r $real_ca_file) {
	printlog "Unable to read a CA file (any of $opt{ca_file}), check the config.";
	exit 1;
}
if ($opt{debug}) {
	print "Using CA file $real_ca_file\n";
}

# Verify access to the certificate files and directory
my $have_cert = (-f $opt{cert_file} && -f $opt{key_file});
if ($have_cert) {
	if (-f $opt{cert_file} && ! -w $opt{cert_file}) {
		printlog "Must have write access to $opt{cert_file}.";
		exit 1;
	}
	if (-f $opt{key_file} && ! -w $opt{key_file}) {
		printlog "Must have write access to $opt{key_file}.";
		exit 1;
	}
} else {
	# Verify that the directory exists
	my $dirname = dirname($opt{cert_file});
	if (!-d $dirname) {
		mkpath($dirname, {error => \my $err});
		if (!-d $dirname) { printlog "The path $dirname doesn't exist, and I am unable to create it.\n"; exit 1; }
	}
	if (!-w $dirname) {
		printlog "The path $dirname is not writable, I can't save my certificate files.\n"; exit 1;
	}
}

# Verify that it is possible to write 16kB to the location where certificates are stored
my $fn = dirname($opt{cert_file})."/temp";
open(my $F2, ">$fn") || die "Unable to open $fn for writing";
unlink($fn);
print $F2 "a" x 16384 || die "Unable to write to $fn";
close($F2);

# Is there a client certificate present? Test if it works
my $cert_works = 0;
if ($have_cert) {
	eval {
		# this function will call die() if the certificate fails
		$_ = http_get($server_url . 'secure/ping', 1, 0);
		$cert_works = defined($_);
	};
}

if (!$have_cert || !$cert_works) {
	# Test if we can establish any contact with the server at all
	printlog "No valid client cert. Checking basic SSL connectivity...\n" if ($opt{debug});
	my $anyContact = 0;
	eval {
		if (test_without_client_cert()) {
			$anyContact = 1;
		}
	};
	if (!$anyContact) {
		printlog $@ if $@;
		printlog "Unable to connect to the server $config{settings}{server}, giving up.\n";
		exit 1;
	}
}

if (!$have_cert) {
	eval {
		printlog "Requesting a certificate..\n";
		my %postdata = (
			'hostname' => hostname,
		);
		unless ($opt{'nocfe'}) {
			# Try to use the local CFEngine key to sign something that the server can verify
			my ($cfengine_key_md5,$signature) = sign_with_cfengine_key();
			if ($opt{'debug'}) {
				printf "CFEngine key md5 digest: %s\nCFEngine signature: %d chars base64\n",
					$cfengine_key_md5, length($signature);
			}
			$postdata{'cfe_key_md5'} = $cfengine_key_md5;
			$postdata{'sign_b64'} = $signature;
		}
		my $response = http_post($server_url . "reqcert", \%postdata, 0, 0);
		my ($cert, $key) = parse_certificate_response($response);
		if (defined($cert) && defined($key)) {
			printlog "Received a certificate.\n";
			open(my $F, ">$opt{cert_file}") or die "Unable to write to cert file $opt{cert_file}";
			print $F "$cert\n";
			close($F);
			open($F, ">$opt{key_file}") or die "Unable to write to key file $opt{key_file}";
			print $F "$key\n";
			close($F);
			chmod(0600, $opt{key_file});
			createPKCS8();
			printlog "Received and stored a new certificate.\n";
		}
		else {
			printlog "Did not receive any certificate.\n";
			exit 1;
		}
	};
	if ($@) {
		printlog $@;
		exit 1;
	}
}
elsif ($have_cert && !$cert_works) {
	eval {
		printlog "Trying to renew the certificate.\n";
		my $cert = undef;
		my $key = undef;
		# Request a new certificate on the grounds that we already have an old one
		my $response = http_get($server_url . 'secure/renewcert', 1, 0);
		($cert, $key) = parse_certificate_response($response);
		if (defined($cert) && defined($key)) {
			printlog "Successfully renewed the certificate.\n";
		} else {
			printlog "Wasn't able to renew the certificate. Requesting a new one instead...\n";
			my $response = http_get($server_url . "reqcert?hostname=".hostname, 0, 0);
			($cert, $key) = parse_certificate_response($response);
		}
		# Did it work?
		if (defined($cert) && defined($key)) {
			printlog "Successfully renewed the certificate.\n";
			open(my $F, ">$opt{cert_file}") or die "Unable to write to cert file $opt{cert_file}";
			print $F "$cert\n";
			close($F);
			open($F, ">$opt{key_file}") or die "Unable to write to key file $opt{key_file}";
			print $F "$key\n";
			close($F);
			chmod(0600, $opt{key_file});
			createPKCS8();
			printlog "Received and stored a new certificate.\n";
		}
		else {
			printlog "Did not receive any certificate.\n";
			exit 1;
		}
	};
	if ($@) {
		printlog $@;
		exit 1;
	}
}

createPKCS8() unless (-f "/var/nivlheim/pkcs8.key");

# Determine which files to send
my @filelist = keys %{$config{'files'}};

# Make sure essential files are on the list
my @essentials = (
"/etc/redhat-release",
"/etc/debian_version",
"/etc/lsb-release",
"/usr/lib/os.release.d/os-release-workstation",
"/usr/lib/os.release.d/os-release-server",
"/usr/lib/os.release.d/os-release-cloud"
);
foreach my $e (@essentials) {
	if (!grep {$e eq $_} @filelist) {
		push @filelist, $e;
	}
}

# Create tar archive
my $tar = Archive::Tar->new();

# Add all the files
for my $filename (@filelist) {
	# if I am unable to read a file, skip it
	next if (!-r $filename);
	# Read files manually, because we want to follow symlinks, not store them as symlinks in the tar file.
	# Must use IO::File to handle zero-size "special" files like /proc/*
	my $fh = IO::File->new;
	if ($fh->open($filename)) {
		binmode($fh);
		my $data = do { local $/; <$fh>; };
		close($fh);
		# Every file in the archive should be below the top directory "files/".
		$tar->add_data("files$filename", $data);
	}
}

# Get the list of commands
my @cmdlist = keys %{$config{'commands'}};

# Make sure essential commands are on the list
@essentials = (
	"/bin/uname -a",
	"/usr/bin/dpkg-query -l",
	"/usr/bin/sw_vers",
	"/usr/sbin/dmidecode -t system",
	"/usr/sbin/system_profiler SPHardwareDataType"
);
foreach my $e (@essentials) {
	if (!grep {$e eq $_} @cmdlist) {
		push @cmdlist, $e;
	}
}

# Run all the commands, collect the output and store it
foreach my $cmd (@cmdlist) {
	# if it got parsed erroneously and is split on /=/, re-assemble it
	if (defined($config{'commands'}{$cmd})) {
		$cmd .= '=' . $config{'commands'}{$cmd};
	}
	# remove trailing whitespace
	$cmd =~ s/\s+$//;
	# extract just the command itself and check if it exists and is executable
	my $actual_cmd = extract_cmd($cmd);
	if ($actual_cmd && -x $actual_cmd) {
		# run
		if (open(my $F, "$cmd 2>&1 |")) {
			my $cmdresult = join('',<$F>);
			close($F);
			# the command should be the first line of the output file
			$cmdresult = $cmd . "\n" . $cmdresult;
			# generate a file name
			my $cmdfname = "commands/" . shortencmd($cmd);
			# add the file to the tar file
			$tar->add_data($cmdfname, $cmdresult);
		}
	}
}

# Run all the aliased commands
my @aliaslist = keys %{$config{'commandalias'}};
foreach my $alias (@aliaslist) {
	my $cmd = $config{'commandalias'}{$alias};
	# remove trailing whitespace
	$cmd =~ s/\s+$//;
	# extract just the command itself and check if it exists and is executable
	my $actual_cmd = extract_cmd($cmd);
	if ($actual_cmd && -x $actual_cmd) {
		# run the command
		if (open(my $F, "$cmd 2>&1 |")) {
			my $cmdresult = join('',<$F>);
			close($F);
			# the command should be the first line of the output file
			$cmdresult = $alias . "\n" . $cmdresult;
			# generate a file name
			my $saveAs = "commands/" . shortencmd($alias);
			# add the file to the tar file
			$tar->add_data($saveAs, $cmdresult);
		}
	}
}

# Compress and save the tar file
my $tarfile = "$tempdir/archive.tgz";
unlink($tarfile); # In case it already exists
$tar->write($tarfile, Archive::Tar::COMPRESS_GZIP());
print "Wrote archive file\n" if ($opt{debug});

# Create a signature for the tar file
my $signaturefile = "$tarfile.sign";
unlink($signaturefile); # In case it already exists
#system("openssl dgst -sha256 -sign $opt{key_file} -out $signaturefile $tarfile");
# support for certificate files that have a password,
# generated by older versions of the server software
open(my $F, "| openssl dgst -sha256 -sign $opt{key_file} -passin stdin -out $signaturefile $tarfile");
print $F getpassword();
close($F);
print "Signed the archive file\n" if ($opt{debug});

# nonce
my $nonce = 0;
my $noncefile = "/var/nivlheim/nonce";
if (-r $noncefile) {
	open(my $F, $noncefile);
	$nonce = <$F>;
	chomp $nonce;
	close($F);
}

# POST all of it
my %postdata = (
	'hostname' => hostname,
	'archive' => [$tarfile],
	'signature' => [$signaturefile],
	'version' => $VERSION,
	'nonce' => $nonce
);
eval {
	my $result = http_post($server_url . 'secure/post', \%postdata, 1, 0);
	if ($result =~ /OK/) {
		# touch a file
		my $file = "/var/run/nivlheim_client_last_run";
		if (!-e $file) { my $F; open($F, ">$file"); close($F); }
		utime(undef,undef,$file);
		# make sure that file is readable for everyone
		chmod 0644, $file;
	}
	if ($result =~ /nonce=(\d+)/) {
		# save the new nonce, it shall be used next time
		open(my $F, ">$noncefile");
		print $F $1;
		close($F);
		chmod 0600, $noncefile;
	}
};
printlog $@ if ($@);

#---------------- end --------------

# Establish an SSL connection to the server.
sub ssl_connect($$$) {
	my ($hostname, $port, $use_client_cert) = @_;

	if (!-r $opt{cert_file} || !-r $opt{key_file}) { $use_client_cert = 0; }

	my $verify_mode = IO::Socket::SSL::SSL_VERIFY_PEER();
	if ($hostname eq 'localhost') {
		$verify_mode = IO::Socket::SSL::SSL_VERIFY_NONE();
	}
	if ($opt{debug}) {
		print "hostname=$hostname port=$port use_client_cert=$use_client_cert\n";
		#$IO::Socket::SSL::DEBUG = 3;
	}

	# Resolve all possible addresses for the specified hostname.
	# Try IPv4 addresses first, then IPv6.  It is quite common for
	# mobile clients to have an IPv6 address configured even though
	# they do not in fact have a working IPv6 uplink.
	my @addrlist = ();
	if ($hostname eq 'localhost') {
		push @addrlist, '127.0.0.1';
	}
	elsif ($hostname =~ m#([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})#) {
		# IPv4-address
		push @addrlist, $hostname;
	}
	else {
		my $dnsresolver = Net::DNS::Resolver->new;
		my $dnsresponse = $dnsresolver->query($hostname, 'CNAME');
		if ($dnsresponse) {
			foreach my $rr ($dnsresponse->answer) {
				if ($rr->type eq 'CNAME') {
					$hostname = $rr->cname;
					last;
				}
			}
		}
		$dnsresponse = $dnsresolver->query($hostname, 'A');
		if ($dnsresponse) {
			foreach my $rr ($dnsresponse->answer) {
				push @addrlist, $rr->address;
			}
		}
		$dnsresponse = $dnsresolver->query($hostname, 'AAAA');
		if ($dnsresponse) {
			foreach my $rr ($dnsresponse->answer) {
				push @addrlist, $rr->address;
			}
		}
	}

	foreach my $ip (@addrlist) {
		warn("Trying $ip\n") if $opt{debug};
		if (my $socket = IO::Socket::INET6->new(
				PeerAddr => $ip, PeerPort => $port, Proto => 'tcp')) {
			warn("Connected to $ip\n") if $opt{debug};
			# We have a connection - try to start SSL
			if (my $ssl = IO::Socket::SSL->new_from_fd(
					$socket->fileno(),
					SSL_verify_mode => $verify_mode,
					SSL_verifycn_scheme => 'http',
					SSL_verifycn_name => $hostname,
					SSL_ca_file     => $real_ca_file,
					SSL_ca_path     => '',
					SSL_use_cert    => $use_client_cert ? 1 : 0,
					SSL_key_file    => $use_client_cert ? $opt{key_file} : '',
					SSL_cert_file   => $use_client_cert ? $opt{cert_file} : '',
					SSL_passwd_cb   => \&getpassword,
					))
			{
				# Success
				warn("SSL connection established\n")
					if $opt{debug};
				return $ssl;
			}
			else {
				# Negotiation failed
				warn("Could not establish SSL connection: $! $@\n");
			}
			$socket->close();
		}
	}
}

# The password for the private rsa key. Only here for compatibility with
# a legacy version of the software, later the keys will be passwordless.
sub getpassword() { return "passord123"; }

sub split_url($) {
	my $url = shift;
	# FQDN
	if ($url =~ m#(https?)://([a-z0-9]+\.[a-z0-9]+\.[a-z]{2,3})(:(\d+))?(/.*)#) {
		my $proto = $1;
		my $host = $2;
		my $port = $4;
		my $path = $5;
		if (!defined($port)) {
			if ($proto eq 'http') { $port = 80; }
			elsif ($proto eq 'https') { $port = 443; }
			else { return (); }
		}
		return ($proto,$host,$port,$path);
	}
	# IPv4-address
	elsif ($url =~ m#(https?)://([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})(:(\d+))?(/.*)#) {
		my $proto = $1;
		my $host = $2;
		my $port = $4;
		my $path = $5;
		if (!defined($port)) {
			if ($proto eq 'http') { $port = 80; }
			elsif ($proto eq 'https') { $port = 443; }
			else { return (); }
		}
		return ($proto,$host,$port,$path);
	}
	# localhost
	elsif ($url =~ m#(https?)://localhost(:(\d+))?(/.*)#) {
		my $proto = $1;
		my $host = 'localhost';
		my $port = $3;
		my $path = $4;
		if (!defined($port)) {
			if ($proto eq 'http') { $port = 80; }
			elsif ($proto eq 'https') { $port = 443; }
			else { return (); }
		}
		return ($proto,$host,$port,$path);
	}
	else { return (); }
}

sub test_without_client_cert() {
	# Just test the SSL connection
	my $url = $server_url;
	my ($proto, $host, $port) = split_url($url);
	if (!defined($host)) { die "Invalid url: $url\n"; }
	my $ssl = ssl_connect($host, $port, 0);
	if (!$ssl) {
		return 0;
	}
	$ssl->close(SSL_ctx_free => 1);
	return 1;
}

sub http_get($$$) {
	# Yes, it would have been nice to use LWP for this,
	# but I see no way of using my own function for
	# opening an SSL connection that way.

	my $url = shift;
	print "GET $url\n" if ($opt{'debug'});
	my $use_client_cert = shift;
	my $num_redirects = shift;
	if (!defined($use_client_cert)) { $use_client_cert = 1; }

	my ($proto, $host, $port, $path) = split_url($url);
	if (!defined($proto)) {
		die "Invalid url: $url\n";
	}
	if ($proto eq 'http') {
		die "http (without ssl) is not supported.";
	}

	my $ssl = ssl_connect($host, $port, $use_client_cert);
	if (!$ssl) {
		printlog("SSL connection failed: $url");
		return undef;
	}

	print $ssl "GET $path HTTP/1.0\r\n"
		."Host: $host:$port\r\n"
		."User-Agent: NivlheimClient/$VERSION\r\n"
		."Accept: text/html,text/plain,application/xml\r\n"
		."Connection: close\r\n\r\n";
	my $headers = '';
	my $result = '';
	my $httpstatus = <$ssl>;
	while (<$ssl>) {
		last if (/^\r?\n$/);
		print if $opt{debug};
		$headers .= $_;
	}
	while (<$ssl>) {
		$result .= $_;
	}
	$ssl->close(SSL_ctx_free => 1);
	if ($httpstatus =~ m#^HTTP/1.1 [45]\d\d#) {
		printlog("$url: $httpstatus");
		return undef;
	} elsif ($httpstatus =~ m#^HTTP/1.1 30[1278]#) {
		if ($num_redirects <= $opt{max_redirects}) {
			$num_redirects++;
			$headers =~ m#Location:\s+(.*?)[\r\n]+#;
			my $redirect_url = $1;
			$result = http_get($redirect_url, 0, $num_redirects);
		} else {
			printlog("$url: too many redirects");
			return undef;
		}
	}
	return $result;
}

sub http_post($$$$) {
	# Yes, it would have been nice to use LWP for this,
	# but I see no way of using my own function for
	# opening an SSL connection that way.

	my ($url, $postdataref, $use_client_cert, $num_redirects) = @_;
	print "POST $url\n" if ($opt{'debug'});
	if (!defined($use_client_cert)) { $use_client_cert = 1; }
	my ($proto, $host, $port, $path) = split_url($url);
	if (!defined($proto)) {
		die "Invalid url: $url\n";
	}
	if ($proto eq 'http') {
		die "http (without ssl) is not supported.";
	}

	my $ssl = ssl_connect($host, $port, $use_client_cert);
	if (!$ssl) {
		die "SSL connection failed: $url\n";
	}

	my $request = POST $path,
		'Host' => "$host:$port",
		'User-Agent' => 'NivlheimClient/'.$VERSION,
		'Accept' => 'text/html,text/plain,application/xml',
		'Connection' => 'close',
		'Content-Type' => 'form-data',
		'Content' => $postdataref;

	my $req = $request->as_string;
	$req =~ s/^POST (.*)$/POST $1 HTTP\/1.0/m;

	# Convert the line endings to two-byte CR LF
	my ($headers, $rest) = split /\n\n/, $req, 2;
	$headers =~ s/\n/\r\n/gs;
	$req = $headers . "\r\n\r\n" . $rest;

	# Send the request
	print $ssl $req;

	$headers = '';
	my $result = '';
	my $httpstatus = <$ssl>;
	while (<$ssl>) {
		last if (/^\r?\n$/);
		print if $opt{debug};
		$headers .= $_;
	}
	while (<$ssl>) {
		$result .= $_;
	}
	$ssl->close(SSL_ctx_free => 1);
	if ($httpstatus =~ m#^HTTP/1.1 [45]\d\d#) {
		die "$url: $httpstatus";
	} elsif ($httpstatus =~ m#^HTTP/1.1 30[1278]#) {
		if ($num_redirects <= $opt{max_redirects}) {
			$num_redirects++;
			$headers =~ m#Location:\s+(.*?)[\r\n]+#;
			my $redirect_url = $1;
			$result = http_post($redirect_url, $postdataref, 0, $num_redirects);
		} else {
			die "$url: too many redirects";
		}
	}
	return $result;
}

# Neither Config::Tiny nor Config::IniFiles worked properly
sub readconfig($) {
	my $filename = shift;
	my $F;
	if (!open($F, $filename)) {
		printlog("Unable to open $filename");
		return;
	}
	my $section = "default";
	my %config = ();
	while (<$F>) {
		# remove trailing cr/lf
		chomp;
		# skip empty lines
		next if (/^\s*$/);
		# skip lines starting with a semicolon or a hash
		next if (/^\s*[;#]/);
		# parse stuff
		if (/\[(.*)\]/) {
			$section = $1;
		}
		elsif (/^([a-zA-Z][a-zA-Z0-9_]*)\s*=(.*)$/) {
			my $key = $1;
			my $value = $2;
			$config{$section}{$key} = $value;
		}
		else {
			$config{$section}{$_} = undef;
		}
	}
	close($F);
	# If the config file was readable but empty, store a value in the hash
	# to distinguish it from the case where the config file is unreadable.
	if (!%config) { $config{empty} = 1; }
	return %config;
}

sub printlog($) {
	my $msg = shift;
	chomp $msg;
	if (-t STDOUT || $opt{'debug'}) {
		print $msg . "\n";
	}
	else {
		syslog(Sys::Syslog::LOG_INFO, $msg);
	}
}

# create a shortened version of a command line, usable as a file name
sub shortencmd($) {
	my $orig = shift;
	$orig =~ s#\S+/##;
	my $s = "";
	my $i = 0;
	while (length($s) < 30 && $i < length($orig)) {
		my $c = substr($orig, $i++, 1);
		if ($c =~ /[a-zA-Z0-9-]/) {
			$s .= $c;
		}
		else {
			$s .= '_';
		}
	}
	# make sure it doesn't look like a hex string, this is necessary
	# because of backward compatibility on the server side.
	if ($s =~ /^[a-fA-F0-9]+$/) {
		$s .= '_';
	}
	return $s;
}

sub reverse_dns_lookup($$) {
	my $a = shift;
	my $resolver = shift;
	my $packet = $resolver->query($a, 'PTR');
	if ($packet) {
		foreach my $rr ($packet->answer) {
			next unless $rr->type eq 'PTR';
			return $rr->ptrdname;
		}
	}
	return "";
}

sub parse_certificate_response($) {
	my $response = shift;
	return undef unless defined($response);
	my ($cert, $key);
	if ($response =~ /(-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----)/s) {
		$cert = $1;
	}
	if ($response =~ /(-----BEGIN RSA PRIVATE KEY-----.*-----END RSA PRIVATE KEY-----)/s) {
		$key = $1;
	}
	if (!defined($cert) || !defined($key)) {
		printlog "Unable to parse certificate response:\n--------\n$response\n--------\n";
	}
	return ($cert, $key);
}

sub createPKCS8() {
	#system("openssl pkcs8 -topk8 -inform PEM -outform PEM -nocrypt -in /var/nivlheim/my.key -out /var/nivlheim/pkcs8.key");
	# support for certificate files that have a password,
	# generated by older versions of the server software
	open(my $F, "| openssl pkcs8 -topk8 -inform PEM -outform PEM -nocrypt -passin stdin -in /var/nivlheim/my.key -out /var/nivlheim/pkcs8.key");
	print $F getpassword();
	close($F);
	chmod(0600, "/var/nivlheim/pkcs8.key");
}

sub sign_with_cfengine_key() {
	my $md5_digest;
	if (-x '/var/cfengine/bin/cf-key' && 
		`/var/cfengine/bin/cf-key -p /var/cfengine/ppkeys/localhost.pub` =~ /MD5=([a-f0-9]{32})/) {
		$md5_digest = $1;
	} else {
		# For the sake of integration testing, to make it work on a VM without cf-key installed,
		# return a test string if I'm unable to compute a normal md5 digest.
		$md5_digest = '01234567890123456789012345678932';
	}
	my $contentfile = "/tmp/nivlheim_cfe_sign.txt";
	my $sigfile = "$contentfile.sha256";
	my $sig_base64;
	eval {
		unlink($sigfile,$contentfile);
		open(my $F, ">$contentfile") or die;
		print $F "nivlheim"; # should we use a challenge-response instead?
		close($F);
		die unless -r "/var/cfengine/ppkeys/localhost.priv";
		open($F, "| openssl dgst -sha256 -sign /var/cfengine/ppkeys/localhost.priv -passin stdin -out $sigfile $contentfile") or die;
		print $F "Cfengine passphrase";
		close($F);
		open($F,"openssl base64 -in $sigfile |") or die;
		local $/; $/='';
		$sig_base64 = <$F>;
		close($F);
	};
	if ($@) {
		unlink($sigfile,$contentfile);
		return '','';
	} else {
		unlink($sigfile,$contentfile);
		return $md5_digest, $sig_base64;
	}
}

sub extract_cmd($) {
	# handles command lines of the format [envvar=val] command [arg1] [arg2] ..
	my $cmd_line = shift;
	my @cmd_parts = split(' ', $cmd_line);
	for (my $i=0;$i<=$#cmd_parts;$i++) {
		if ($cmd_parts[$i] !~ m/=/) {
			return $cmd_parts[$i];
		}
	}
	return 0;
}
