#! /usr/local/bin/perl -w

# The Emergency Daemon - wait for simple emergency commands and execute them

# David A. Madore <URL: http://www.madore.org/~david/ > - Public Domain

# *** The emergency daemon protocol ***
#
# Commands are sent through UDP datagrams, normally addressed to port
# 911.  Commands consist of three parts separated or terminated by '|'
# or \n (but \r\n is also accepted).  First part is the command
# proper.  Second is a UTC timestamp in yyyy-mm-ddThh:mm:ssZ format
# (here 'T' and 'Z' are literal 'T' and 'Z').  Third is the
# HMAC-SHA256, in hexadecimal, of command|timestamp (separated by '|',
# even if they were separated differently in the input, and not
# terminated by anything), with a HMAC key shared by client and
# server.
#
# The server response consists of one or more lines terminated by \n.
# If the command is PING, the server responds PONG.  If the command is
# DATE, the server responds DATE followed by the current time and the
# timestamp of the last authenticated command.  Apart from PING and
# DATE, all other commands are authenticated: if the HMAC does not
# match what it should be, the server responds !MAC.  If the timestamp
# does not match the current date +/- 30 seconds, the server responds
# !DAT; it also does so if the timestamp is not (strictly) greater
# than the timestamp of the last request.
#
# The NOOP command does nothing (but must still be authenticated): the
# server responds NOOP.  The DPID command returns the daemon's PID:
# the server responds DPID and then the PID itself (on a separate
# line).  The DIE! command causes the daemon to respond BYE! and then
# quit.  The RKEY command causes the daemon to reread its key file:
# the server responds either DONE or !ERR in case of error, in which
# case the next line in the response is a human-readable error line.
# The SYRQ command is followed by whitespace and then by data to be
# written to /proc/sysrq-trigger: the server responds either DONE or
# !ERR in case of error, in which case the next line in the response
# is a human-readable error line.

# *** The emergency daemon itself ***
#
# The daemon understands three options:
#
# -p <number> indicates which port it should bind to.  The daemon
# binds to the IPv6 unspecified address with the IPV6_V6ONLY option
# set to 0, thus listening on both IPv6 and IPv4 families.
#
# -k <filename> specifies the keyfile to use.  This file contains one
# or more keys, one per line, which will all be equally valid when
# computing the MAC.
#
# -f requests that the daemon ignore HUP and INT signals, and fork
# once it has successfully set up its listening socket: the father
# then prints its child's PID and exits successfully.

use strict;
use warnings;
use Digest::SHA qw(hmac_sha256_hex);
use Socket;
use Socket6;
use POSIX ();
use Getopt::Std;

use constant {
    DEFAULT_PORT => 911
};

my %opts;

getopts("k:p:f", \%opts);

my @authorized_keys;

my $keyfilename = $opts{k};
die "No key file specified (use -k option)" unless defined($keyfilename);
sub readkeys {
    open my $keyfile, "<", $keyfilename
	or die "Cannot open key file $opts{k}: $!";
    @authorized_keys = ();
    while (<$keyfile>) {
	chomp;
	push @authorized_keys, $_;
    }
    close $keyfile;
}
readkeys;

my $proto = getprotobyname("udp") or die "Can't resolve udp protocol: $!";
my $port;
if ( defined($opts{p}) ) {
    $port = $opts{p};
    $port =~ /^(\d+)$/ or die "Invalid port number (-p option) $port";
} else {
    $port = DEFAULT_PORT;
}

my $socket;
socket $socket, PF_INET6, SOCK_DGRAM, $proto or die "Can't create socket: $!";
if ( defined(*IPV6_V6ONLY{CODE}) ) {
    setsockopt $socket, IPPROTO_IPV6, IPV6_V6ONLY, 0 or die "Can't set IPV6_V6ONLY option to 0: $!";
}
bind $socket, sockaddr_in6($port, in6addr_any) or die "Can't bind socket: $!";

if ( $opts{f} ) {
    $SIG{HUP} = "IGNORE";
    $SIG{INT} = "IGNORE";
    my $childpid = fork;
    die "Can't fork: $!" unless defined($childpid);
    if ( $childpid ) {
	print "$childpid\n";
	exit 0;
    }
}

sub curtime {
    my $fiddle = shift;  $fiddle = 0 unless defined($fiddle);
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time+$fiddle);
    return sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ",$year+1900,$mon+1,$mday,$hour,$min,$sec);
}

my $mintime = "0";

PACKET:
while (1) {
    my $buf;
    my $sender = recv($socket, $buf, 16384, 0);
    my @lines = split /\015*\012|\|/s, $buf;
    my $command = $lines[0];  $command = "" unless defined($command);
    my $timestamp = $lines[1];  $timestamp = "" unless defined($timestamp);
    my $maccheck = $lines[2];  $maccheck = "" unless defined($maccheck);
    next PACKET if $command eq "";
    if ( $command eq "PING" ) {
	send $socket, "PONG\n", 0, $sender;
    } elsif ( $command eq "DATE" ) {
	send $socket, ("DATE\n".curtime."\n".$mintime."\n"), 0, $sender;
    } else {
	my $validate = "$command|$timestamp";
	my $macchecked = 0;
	foreach my $key ( @authorized_keys ) {
	    if ( $maccheck eq hmac_sha256_hex($validate, $key) ) {
		$macchecked = 1;
	    }
	}
	unless ( $macchecked ) {
	    send $socket, "!MAC\n", 0, $sender;
	    next PACKET;
	}
	my $datechecked = ($timestamp ge curtime(-30))
	    && ($timestamp le curtime(30))
	    && ($timestamp gt $mintime);
	unless ( $datechecked ) {
	    send $socket, "!DAT\n", 0, $sender;
	    next PACKET;
	}
	$mintime = $timestamp;
	if ( $command eq "NOOP" ) {
	    send $socket, "NOOP\n", 0, $sender;
	} elsif ( $command eq "DPID" ) {
	    my $pid = POSIX::getpid;
	    send $socket, "DPID\n$pid\n", 0, $sender;
	} elsif ( $command eq "DIE!" ) {
	    send $socket, "BYE!\n", 0, $sender;
	    exit 0;
	} elsif ( $command eq "RKEY" ) {
	    my $resp = "DONE\n";
	    eval { readkeys };
	    if ( $@ ) {
		$resp = "!ERR\n$@";
	    }
	    send $socket, $resp, 0, $sender;
	} elsif ( $command =~ /^SYRQ\s+(.*)$/ ) {
	    my $s = $1;
	    my $resp = "DONE\n";
	    eval {
		open my $sysrq_trigger, ">", "/proc/sysrq-trigger" or die "Couldn't open /proc/sysrq-trigger for writing: $!";
		print $sysrq_trigger $s or die "Couldn't write to /proc/sysrq-trigger: $!";
		close $sysrq_trigger;
	    };
	    if ( $@ ) {
		$resp = "!ERR\n$@";
	    }
	    send $socket, $resp, 0, $sender;
	} else {
	    send $socket, "!UNK\n", 0, $sender;
	}
    }
}