Merge tag 'v0.8.0' into debian/latest

Release version 0.8.0

1 files changed, 147 insertions, 73 deletions

diff --git a/lacme-accountd b/lacme-accountd
index af64168..0f5deb2 100755
--- a/lacme-accountd
+++ b/lacme-accountd
@@ -3,7 +3,7 @@
 #----------------------------------------------------------------------
 # ACME client written with process isolation and minimal privileges in mind
 # (account key manager)
-# Copyright © 2016-2017 Guilhem Moulin <guilhem@fripost.org>
+# Copyright © 2015-2021 Guilhem Moulin <guilhem@fripost.org>
 #
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -23,14 +23,15 @@ use v5.14.2;
 use strict;
 use warnings;
 
-our $VERSION = '0.3';
+our $VERSION = '0.8.0';
 my $PROTOCOL_VERSION = 1;
 my $NAME = 'lacme-accountd';
 
+use Digest::SHA 'sha256';
 use Errno 'EINTR';
+use File::Basename 'dirname';
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
-use List::Util 'first';
-use MIME::Base64 'encode_base64url';
+use MIME::Base64 qw/decode_base64url encode_base64url/;
 use Socket qw/PF_UNIX SOCK_STREAM SHUT_RDWR/;
 
 use Config::Tiny ();
@@ -60,28 +61,80 @@ sub usage(;$$) {
     }
     exit $rv;
 }
-usage(1) unless GetOptions(\%OPTS, qw/config=s privkey=s socket=s conn-fd=i quiet|q debug help|h/);
+usage(1) unless GetOptions(\%OPTS, qw/config=s privkey=s socket=s stdio quiet|q debug help|h/);
 usage(0) if $OPTS{help};
 
+my $LOG;
+sub logmsg($@) {
+    my $lvl = shift // "all";
+    if (defined $LOG) {
+        my $now = localtime;
+        $LOG->printflush("[", $now, "] ", @_, "\n") or warn "print: $!";
+    }
+    unless (($lvl eq "debug" and !$OPTS{debug}) or ($lvl eq "noquiet" and $OPTS{quiet})) {
+        print STDERR @_, "\n" or warn "print: $!";
+    }
+}
+sub info(@) { logmsg(all => @_); }
+sub error(@) {
+    my @msg = ("Error: ", @_);
+    info(@msg);
+    exit 255;
+}
+sub panic(@) {
+    my @loc = caller;
+    my @msg = (@_, " at line $loc[2] in $loc[1]");
+    info(@msg);
+    exit 255;
+}
+
+sub env_fallback($$) {
+    my $v = $ENV{ shift() };
+    return (defined $v and $v ne "") ? $v : shift;
+}
+sub spec_expand($) {
+    my $str = shift;
+    $str =~ s#%(.)# my $x =
+          $1 eq "C" ? ($< == 0 ? "@@localstatedir@@/cache" : env_fallback(XDG_CACHE_HOME => "$ENV{HOME}/.cache"))
+        : $1 eq "E" ? ($< == 0 ? "@@sysconfdir@@" : env_fallback(XDG_CONFIG_HOME => "$ENV{HOME}/.config"))
+        : $1 eq "g" ? (getgrgid((split /\s/,$()[0]))[0]
+        : $1 eq "G" ? $( =~ s/\s.*//r
+        : $1 eq "h" ? (getpwuid($<))[7]
+        : $1 eq "u" ? (getpwuid($<))[0]
+        : $1 eq "U" ? $<
+        : $1 eq "t" ? ($< == 0 ? "@@runstatedir@@" : $ENV{XDG_RUNTIME_DIR})
+        : $1 eq "T" ? env_fallback(TMPDIR => "/tmp")
+        : $1 eq "%" ? "%"
+        : error("\"$str\" has unknown specifier %$1");
+        error("Undefined expansion %$1 in \"$str\"") unless defined $x;
+        $x;
+    #ge;
+    return $str;
+}
+
 do {
-    my $conffile = $OPTS{config} // first { -f $_ }
-        ( "./$NAME.conf"
-        , ($ENV{XDG_CONFIG_HOME} // "$ENV{HOME}/.config")."/lacme/$NAME.conf"
-        , "@@sysconfdir@@/lacme/$NAME.conf"
-        );
-    die "Error: Can't find configuration file\n" unless defined $conffile;
-    print STDERR "Using configuration file: $conffile\n" if $OPTS{debug};
-
-    my $h = Config::Tiny::->read($conffile) or die Config::Tiny::->errstr()."\n";
-    my $h2 = delete $h->{_} // {};
-    die "Invalid section(s): ".join(', ', keys %$h)."\n" if %$h;
-    my %h = map { $_ => delete $h2->{$_} } qw/privkey gpg socket quiet/;
-    die "Unknown option(s): ".join(', ', keys %$h2)."\n" if %$h2;
-    $h{quiet} = lc $h{quiet} eq 'yes' ? 1 : 0 if defined $h{quiet};
-    $OPTS{$_} //= $h{$_} foreach grep {defined $h{$_}} keys %h;
+    my $conffile = spec_expand($OPTS{config} // "%E/lacme/$NAME.conf");
+
+    if (defined $OPTS{config} or -e $conffile) {
+        print STDERR "Using configuration file: $conffile\n" if $OPTS{debug};
+        my $h = Config::Tiny::->read($conffile) or error(Config::Tiny::->errstr());
+        my $h2 = delete $h->{_} // {};
+        if ((my $logfile = $h2->{logfile} // "") ne "") {
+            $logfile = spec_expand($logfile);
+            die "Invalid log file name\n" unless $logfile =~ /\A(\p{Print}+)\z/; # untaint
+            open $LOG, ">>", $1 or die "Can't open $1: $!"; # open ASAP (before config validation)
+        }
+        error("Invalid section(s): ".join(', ', keys %$h)) if %$h;
+        my %h = map { $_ => delete $h2->{$_} } qw/privkey gpg socket logfile keyid quiet/;
+        error("Unknown option(s): ".join(', ', keys %$h2)) if %$h2;
+        $h{quiet} = lc $h{quiet} eq 'yes' ? 1 : 0 if defined $h{quiet};
+        $OPTS{$_} //= $h{$_} foreach grep {defined $h{$_}} keys %h;
+    } else {
+        print STDERR "Ignoring missing configuration file at default location $conffile\n" if $OPTS{debug};
+    }
 
     $OPTS{quiet} = 0 if $OPTS{debug};
-    die "Error: 'privkey' is not specified\n" unless defined $OPTS{privkey};
+    error("'privkey' is not specified") unless defined $OPTS{privkey};
 };
 
 
@@ -89,46 +142,57 @@ do {
 # Build the JSON Web Key (RFC 7517) from the account key's public parameters,
 # and determine the signing method $SIGN.
 #
-my ($JWK, $SIGN);
+my ($EXTRA_GREETING_STR, $JWK_STR, $SIGN);
 if ($OPTS{privkey} =~ /\A(file|gpg):(\p{Print}+)\z/) {
-    my ($method, $filename) = ($1,$2);
+    my ($method, $filename) = ($1, spec_expand($2));
     my ($fh, @command);
     if ($method eq 'file') {
-        # generate with `openssl genrsa 4096 | install --mode=0600 /dev/stdin /tmp/privkey`
-        open $fh, '<', $filename or die "Error: Can't open $filename: $!\n";
+        # generate with `openssl genpkey -algorithm RSA`
+        open $fh, '<', $filename or error("Can't open $filename: $!");
     }
     elsif ($method eq 'gpg') {
         @command = split /\s+/, ($OPTS{gpg} // 'gpg --quiet');
-        open $fh, '-|', @command, qw/-o - --decrypt --/, $filename or die "fork: $!";
+        open $fh, '-|', @command, qw/-o - --decrypt --/, $filename or panic("fork: $!");
     }
     else {
-        die; # impossible
+        panic(); # impossible
     }
 
     my $str = do {local $/ = undef; <$fh>};
-    close $fh or die $! ?
-        "Can't close: $!" :
-        "Error: $command[0] exited with value ".($? >> 8)."\n";
+    close $fh or ($! or !@command) ?
+        panic("close: $!") :
+        error("$command[0] exited with value ".($? >> 8));
 
     require 'Crypt/OpenSSL/RSA.pm';
     my $rsa = Crypt::OpenSSL::RSA->new_private_key($str);
     undef $str;
 
-    die "Error: $filename: Not a private key\n" unless $rsa->is_private();
-    die "Error: $filename: Invalid key\n"       unless $rsa->check_key();
+    error("$filename: Not a private key") unless $rsa->is_private();
+    error("$filename: Invalid key")       unless $rsa->check_key();
     $rsa->use_sha256_hash();
 
     require 'Crypt/OpenSSL/Bignum.pm';
     my ($n, $e) = $rsa->get_key_parameters(); # don't include private params!
     $_ = encode_base64url($_->to_bin()) foreach ($n, $e);
 
-    $JWK = { kty => 'RSA', n => $n, e => $e };
+    my %extra_greeting;
+    my %jwk = ( kty => 'RSA', n => $n, e => $e );
+    $extra_greeting{alg} = 'RS256'; # SHA256withRSA (RFC 7518 sec. A.1)
     $SIGN = sub($) { $rsa->sign($_[0]) };
+
+    # use of SHA-256 digest in the thumbprint is hardcoded, see RFC 8555 sec. 8.1
+    $JWK_STR = JSON::->new->utf8->canonical->encode(\%jwk);
+    $extra_greeting{"jwk-thumbprint"} = encode_base64url(sha256($JWK_STR));
+
+    if ((my $kid = $OPTS{keyid} // "") ne "") {
+        $extra_greeting{kid} = $kid;
+        $JWK_STR = "{}";
+    }
+    $EXTRA_GREETING_STR = JSON::->new->encode(\%extra_greeting);
 }
 else {
-    die "Error: unsupported method: $OPTS{privkey}\n";
+    error("Unsupported method: $OPTS{privkey}");
 }
-$JWK = JSON::->new->encode($JWK);
 
 
 #############################################################################
@@ -138,31 +202,26 @@ $JWK = JSON::->new->encode($JWK);
 # to support the abstract namespace.)  The downside is that we have to
 # delete the file manually.
 #
-if (defined $OPTS{'conn-fd'}) {
-    die "Invalid file descriptor" unless $OPTS{'conn-fd'} =~ /\A(\d+)\z/;
-    # untaint and fdopen(3) our end of the socket pair
-    open ($S, '+<&=', $1+0) or die "fdopen $1: $!";
-} else {
-    my $sockname = $OPTS{socket} // (defined $ENV{XDG_RUNTIME_DIR} ? "$ENV{XDG_RUNTIME_DIR}/S.lacme" : undef);
-    die "Missing socket option\n" unless defined $sockname;
-    $sockname = $sockname =~ /\A(\p{Print}+)\z/ ? $1 : die "Invalid socket name\n"; # untaint $sockname
+unless (defined $OPTS{stdio}) {
+    my $sockname = spec_expand($OPTS{socket} // '%t/S.lacme');
+    $sockname = $sockname =~ /\A(\p{Print}+)\z/ ? $1 : error("Invalid socket name"); # untaint
 
     # ensure we're the only user with write access to the parent dir
-    my $dirname = $sockname =~ s/[^\/]+$//r;
-    my @stat = stat($dirname) or die "Can't stat $dirname: $!";
-    die "Error: insecure permissions on $dirname\n" if ($stat[2] & 0022) != 0;
+    my $dirname = dirname($sockname);
+    my @stat = stat($dirname) or error("stat($dirname): $!");
+    error("Insecure permissions on $dirname") if ($stat[2] & 0022) != 0;
 
-    my $umask = umask(0177) // die "umask: $!";
+    my $umask = umask(0177) // panic("umask: $!");
 
-    print STDERR "Starting lacme Account Key Manager at $sockname\n" unless $OPTS{quiet};
-    socket(my $sock, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
-    my $sockaddr = Socket::sockaddr_un($sockname) // die;
-    bind($sock, $sockaddr) or die "bind: $!";
+    logmsg(noquiet => "Starting lacme Account Key Manager at $sockname");
+    socket(my $sock, PF_UNIX, SOCK_STREAM, 0) or panic("socket: $!");
+    my $sockaddr = Socket::sockaddr_un($sockname) // panic();
+    bind($sock, $sockaddr) or panic("bind: $!");
 
     ($SOCKNAME, $S) = ($sockname, $sock);
-    listen($S, 1) or die "listen: $!";
+    listen($S, 1) or panic("listen: $!");
 
-    umask($umask) // die "umask: $!";
+    umask($umask) // panic("umask: $!");
 };
 
 
@@ -170,33 +229,48 @@ if (defined $OPTS{'conn-fd'}) {
 # For each new connection, send the protocol version and the account key's
 # public parameters, then sign whatever comes in
 #
-sub conn($;$) {
-    my $conn = shift;
-    my $count = shift;
-    $conn->printflush( "$PROTOCOL_VERSION OK", "\r\n", $JWK, "\r\n" );
+sub conn($$$) {
+    my ($in, $out, $id) = @_;
+    $out->printflush( "$PROTOCOL_VERSION OK ", $EXTRA_GREETING_STR, "\r\n",
+        $JWK_STR, "\r\n" ) or warn "print: $!";
 
     # sign whatever comes in
-    while (defined (my $data = $conn->getline())) {
-        $data =~ s/\r\n\z// or die;
-        print STDERR "[$count] >>> Issuing SHA-256 signature for: $data\n" unless $OPTS{quiet};
+    while (defined (my $data = $in->getline())) {
+        $data =~ s/\r\n\z// or panic();
+
+        my ($header, $payload) = split(/\./, $data, 2);
+        unless (defined $header and $header =~ /\A[A-Za-z0-9\-_]+\z/) {
+            info("[$id] >>> Error: Refusing to sign request: Malformed protected header");
+            last;
+        }
+        unless (defined $payload and $payload =~ /\A[A-Za-z0-9\-_]*\z/) {
+            # POST-as-GET yields an empty payload
+            info("[$id] >>> Error: Refusing to sign request: Malformed payload");
+            last;
+        }
+
+        logmsg(noquiet => "[$id] >>> OK signing request: ",
+               "header=base64url(", decode_base64url($header), "); ",
+               "playload=base64url(", decode_base64url($payload), ")");
+
         my $sig = $SIGN->($data);
-        $conn->printflush( encode_base64url($sig), "\r\n" );
+        $out->printflush( encode_base64url($sig), "\r\n" ) or warn "print: $!";
     }
 }
 
-if (defined $OPTS{'conn-fd'}) {
-    conn($S, $$);
+if (defined $OPTS{stdio}) {
+    conn(\*STDIN, \*STDOUT, $$);
 } else {
     $SIG{PIPE} = 'IGNORE'; # ignore broken pipes
     for (my $count = 0;; $count++) {
         accept(my $conn, $S) or do {
             next if $! == EINTR; # try again if accept(2) was interrupted by a signal
-            die "accept: $!";
+            panic("accept: $!");
         };
-        print STDERR "[$count] >>> Accepted new connection\n" unless $OPTS{quiet};
-        conn($conn, $count);
-        print STDERR "[$count] >>> Connection terminated\n" unless $OPTS{quiet};
-        close $conn or warn "Can't close: $!";
+        logmsg(noquiet => "[$count] >>> Accepted new connection");
+        conn($conn, $conn, $count);
+        logmsg(noquiet => "[$count] >>> Connection terminated");
+        $conn->close() or warn "close: $!";
     }
 }
 
@@ -205,12 +279,12 @@ if (defined $OPTS{'conn-fd'}) {
 #
 END {
     if (defined $SOCKNAME and -S $SOCKNAME) {
-        print STDERR "Unlinking $SOCKNAME\n" if $OPTS{debug};
-        unlink $SOCKNAME or print STDERR "Can't unlink $SOCKNAME: $!\n";
+        logmsg(debug => "Unlinking $SOCKNAME");
+        unlink $SOCKNAME or info("Error: unlink($SOCKNAME): $!");
     }
     if (defined $S) {
-        print STDERR "Shutting down and closing lacme Account Key Manager\n" unless $OPTS{quiet};
-        shutdown($S, SHUT_RDWR) or warn "shutdown: $!";
-        close $S or print STDERR "Can't close: $!\n";
+        logmsg(noquiet => "Shutting down and closing lacme Account Key Manager");
+        shutdown($S, SHUT_RDWR) or info("Error: shutdown: $!");
+        close $S or info("Error: close: $!");
     }
 }