#! /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 line
# 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 command line consists of a four-letter command,
# followed by an optional argument separated by whitespace.  The
# server response consists of one or more lines each terminated by \n;
# the first is a four-character response similar in form to the
# request.  If the server cannot make sense of the request, it
# responds !BAD.
#
# Apart from PING and DATE, all 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 authenticated
# request.  If the command is unknown, the server responds !UNK.  In
# case of error, the server responds !ERR (normally followed by a more
# human-readable error message on the next line).
#
# The following commands are understood:
#
# * PING: the server responds PONG (this command is unauthenticated).
#
# * DATE: the server responds DATE, followed by two date lines, the
#   first being the current date, and the second being the timestamp
#   of the last authenticated command.  (This command is
#   unauthenticated.)
#
# * NOOP: the server responds NOOP (this command is authenticated, and
#   is intended to serve as a manner to check authentication).
#
# * DPID: the server responds DPID followed by its PID on a separate
#   line.
#
# * RKEY: the server rereads its key file and responds with DONE.
#
# * LOGM: this command takes a mandatory argument; the server logs the
#   message to syslog and responds with DONE.  The message can be
#   preceded by a priority to use (as in the LOG_* macros: WARNING,
#   DEBUG, etc.) followed by whitespace; otherwise, NOTICE is taken as
#   default.
#
# * SYRQ: this command takes a mandatory argument; the server writes
#   this argument to /proc/sysrq-trigger and responds with DONE.

# *** 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 key file 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 Sys::Syslog qw(:standard :macros);
use Getopt::Std;

use constant {
    DEFAULT_PORT => 911,
    SYSLOG_IDENT => "emergencyd.pl"
};

my %opts;

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

my @authorized_keys;

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

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;
}

socket my $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: $!";

openlog(SYSLOG_IDENT, "ndelay,pid", LOG_DAEMON);

if ( $opts{f} ) {
    chdir("/");
    open STDIN, "/dev/null";
    $SIG{HUP} = "IGNORE";
    $SIG{INT} = "IGNORE";
    my $childpid = fork;
    die "Can't fork: $!" unless defined($childpid);
    if ( $childpid ) {
	print "$childpid\n";
	exit 0;
    }
    close STDOUT;
    close STDERR;
    POSIX::setsid;
}

sub curtime {
    my $fiddle = shift // 0;
    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);
}

sub check_mac {
    my $cmdline = shift;
    my $timestamp = shift;
    my $mac_check = shift; 
    my $validate = "$cmdline|$timestamp";
    my $mac_checked = 0;
    foreach my $key ( @authorized_keys ) {
	if ( $mac_check eq hmac_sha256_hex($validate, $key) ) {
	    return 1;
	}
    }
    return 0;
}

my $mintime = "0";

my $running = 1;

sub check_and_update_timestamp {
    my $timestamp = shift;
    if ( ($timestamp ge curtime(-30)) && ($timestamp le curtime(30))
	 && ($timestamp gt $mintime) ) {
	$mintime = $timestamp;
	return 1;
    }
    return 0;
}

sub cmd_ping {
    return "PONG\n";
}

sub cmd_date {
    return [ "DATE", curtime, $mintime ];
}

sub cmd_noop {
    return "NOOP\n";
}

sub cmd_dpid {
    return [ "DPID" , $$ ];
}

sub cmd_die {
    $running = 0;
    return "BYE!\n";
}

sub cmd_rkey {
    read_keys;
    return "DONE\n";
}

sub cmd_logm {
    my $s = shift or die [ "!BAD", "Missing argument to LOGM" ];
    my $priority = LOG_NOTICE;
    my %priorities = ("EMERG"=>LOG_EMERG, "ALERT"=>LOG_ALERT,
		      "CRIT"=>LOG_CRIT, "ERR"=>LOG_ERR,
		      "WARNING"=>LOG_WARNING, "NOTICE"=>LOG_NOTICE,
		      "INFO"=>LOG_INFO, "DEBUG"=>LOG_DEBUG);
    if ( $s =~ /^([A-Z0-9]*)\s+(.*)/ && exists($priorities{$1}) ) {
	$priority = $priorities{$1};
	$s = $2;
    }
    syslog $priority, $s;
    return "DONE\n";
}

sub cmd_syrq {
    my $s = shift or die [ "!BAD", "Missing argument to SYRQ" ];
    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;
    return "DONE\n";
}

my %dispatch = (
    "PING" => \&cmd_ping,
    "DATE" => \&cmd_date,
    "NOOP" => \&cmd_noop,
    "DPID" => \&cmd_dpid,
    "DIE!" => \&cmd_die,
    "RKEY" => \&cmd_rkey,
    "LOGM" => \&cmd_logm,
    "SYRQ" => \&cmd_syrq,
  );

PACKET:
while ( $running ) {
    my $buf;
    my $sender = recv($socket, $buf, 16384, 0);
    die "Failed to receive packet: $!" unless defined($sender);
    my @lines = split /\015*\012|\|/s, $buf;
    my $cmdline = $lines[0] // "";
    my $timestamp = $lines[1] // "";
    my $mac_check = $lines[2] // "";
    next PACKET if $cmdline eq "";
    my $resp = undef;
    eval {
	my ($command, $arg) = $cmdline =~ /^([A-Z0-9\!]{4})(?:\s+(.*))?$/
	    or die "!BAD\n";
	unless ( $command eq "PING" || $command eq "DATE" ) {
	    check_mac $cmdline, $timestamp, $mac_check
		or die "!MAC\n";
	    check_and_update_timestamp $timestamp
		or die "!DAT\n";
	}
	my $sub = $dispatch{$command};
	die "!UNK\n" unless defined($sub);
	$resp = &{$sub}($arg);
    };
    if ( $@ ) {
	$resp = $@;
	if ( ref($resp) eq "" && $resp !~ /^\!/ ) {
	    $resp = "!ERR\n" . $resp;
	}
    }
    if ( defined($resp) ) {
	$resp = join("\n", @{$resp}) . "\n" if ref($resp) eq "ARRAY";
	send $socket, $resp, 0, $sender;
    }
}
exit 0;