summaryrefslogtreecommitdiffstats
path: root/emergencyd.pl
blob: a0d5aa9812a6387444e1746423d72ba06f09f494 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
#! /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.
#
# * SHEL: this command takes a mandatory numeric argument, which is
#   interpreted as a TCP port number on the computer at the source of
#   the datagram; the server tries to connect to that port and spawn a
#   shell attached to it (beware, though: this shell will have no
#   terminal).

# *** 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 Fcntl;
use Errno qw(EINPROGRESS);
use IO::Poll;
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 $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, 0
    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, pack_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;
}
$SIG{CLD} = "IGNORE";  # F*ck archaic unices where this produces zombies.

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

sub cmd_shel {
    my $port = shift or die [ "!BAD", "Missing argument to SHEL" ];
    die [ "!BAD", "Invalid port number (SHEL command) $port" ]
	unless $port =~ /^\d+$/;
    socket my $socket, PF_INET6, SOCK_STREAM, 0
	or die "Can't create socket: $!";
    my $flags;
    $flags = fcntl ($socket, F_GETFL, 0);
    fcntl ($socket, F_SETFL, $flags|O_NONBLOCK) if defined($flags);
    my $sender = shift;
    my (undef, undef, $saddr, $scopeid) = unpack_sockaddr_in6_all $sender;
    my $target = pack_sockaddr_in6_all($port, 0, $saddr, $scopeid);
    unless ( connect $socket, $target) {
	# This is so GROSS!  :-(((
	die "Can't connect to port $port: $!" unless $! == EINPROGRESS;
	my $poll = new IO::Poll;
	$poll->mask($socket, POLLOUT);
	my $ev = $poll->poll(15);
	die "Failed to poll: $!" unless defined($ev);
	die "Timed out connecting to port $port" unless $ev == 1;
	my $err = getsockopt $socket, SOL_SOCKET, SO_ERROR;
	die "Failed to retrieve socket error: $!" unless defined($err);
	$err = unpack("I",$err);
	if ( $err ) {
	    $! = $err;
	    die "Can't connect to port $port: $!";
	}
    }
    my $v = fork;
    die "Can't fork: $!" unless defined($v);
    if ( $v ) {
	close $socket;
	return [ "DONE", $v ];
    } else {
	fcntl ($socket, F_SETFL, $flags&~O_NONBLOCK) if defined($flags);
	open STDIN, "<&", $socket;
	open STDOUT, ">&", $socket;
	open STDERR, ">&", $socket;
	exec "/bin/sh" or print STDERR "exec failed: $!";
	exit -1;
    }
}

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,
    "SHEL" => \&cmd_shel,
  );

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, $sender);
    };
    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;