lacme-accountd: new setting 'logfile' to log signature requests.

Prefixed with a timestamp.

1 files changed, 69 insertions, 41 deletions

diff --git a/lacme-accountd b/lacme-accountd
index 0adfe38..c8c6d5e 100755
--- a/lacme-accountd
+++ b/lacme-accountd
@@ -63,6 +63,30 @@ sub usage(;$$) {
 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);
+    die(@msg, "\n");
+}
+sub panic(@) {
+    my @loc = caller;
+    my @msg = (@_, " at line $loc[2] in $loc[1]");
+    info(@msg);
+    die(@msg, "\n");
+}
+
 sub env_fallback($$) {
     my $v = $ENV{ shift() };
     return (defined $v and $v ne "") ? $v : shift;
@@ -80,8 +104,8 @@ sub spec_expand($) {
         : $1 eq "t" ? ($< == 0 ? "@@runstatedir@@" : $ENV{XDG_RUNTIME_DIR})
         : $1 eq "T" ? env_fallback(TMPDIR => "/tmp")
         : $1 eq "%" ? "%"
-        : die "Error: \"$str\" has unknown specifier %$1\n";
-        die "Error: undefined expansion %$1 in \"$str\"\n" unless defined $x;
+        : error("\"$str\" has unknown specifier %$1");
+        error("undefined expansion %$1 in \"$str\"") unless defined $x;
         $x;
     #ge;
     return $str;
@@ -92,11 +116,16 @@ do {
 
     if (defined $OPTS{config} or -e $conffile) {
         print STDERR "Using configuration file: $conffile\n" if $OPTS{debug};
-        my $h = Config::Tiny::->read($conffile) or die Config::Tiny::->errstr()."\n";
+        my $h = Config::Tiny::->read($conffile) or error(Config::Tiny::->errstr());
         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;
+        if (defined (my $logfile = $h2->{logfile})) {
+            $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: $!";
+        }
+        error("Invalid section(s): ".join(', ', keys %$h)) if %$h;
+        my %h = map { $_ => delete $h2->{$_} } qw/privkey gpg socket logfile 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 {
@@ -104,7 +133,7 @@ do {
     }
 
     $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};
 };
 
 
@@ -118,27 +147,27 @@ if ($OPTS{privkey} =~ /\A(file|gpg):(\p{Print}+)\z/) {
     my ($fh, @command);
     if ($method eq 'file') {
         # generate with `openssl genpkey -algorithm RSA`
-        open $fh, '<', $filename or die "Error: Can't open $filename: $!\n";
+        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 $! ?
-        "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';
@@ -149,7 +178,7 @@ if ($OPTS{privkey} =~ /\A(file|gpg):(\p{Print}+)\z/) {
     $SIGN = sub($) { $rsa->sign($_[0]) };
 }
 else {
-    die "Error: unsupported method: $OPTS{privkey}\n";
+    error("unsupported method: $OPTS{privkey}");
 }
 my $JWK_STR = JSON::->new->encode($JWK);
 
@@ -163,24 +192,24 @@ my $JWK_STR = JSON::->new->encode($JWK);
 #
 unless (defined $OPTS{stdio}) {
     my $sockname = spec_expand($OPTS{socket} // '%t/S.lacme');
-    $sockname = $sockname =~ /\A(\p{Print}+)\z/ ? $1 : die "Invalid socket name\n"; # untaint $sockname
+    $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 = dirname($sockname);
-    my @stat = stat($dirname) or die "stat($dirname): $!\n";
-    die "Error: insecure permissions on $dirname\n" if ($stat[2] & 0022) != 0;
+    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: $!");
 };
 
 
@@ -194,23 +223,22 @@ sub conn($$;$) {
 
     # sign whatever comes in
     while (defined (my $data = $in->getline())) {
-        $data =~ s/\r\n\z// or die;
+        $data =~ s/\r\n\z// or panic();
 
         my ($protected, $payload) = split(/\./, $data, 2);
         unless (defined $protected and $protected =~ /\A[A-Za-z0-9\-_]+\z/) {
-            print STDERR "[$id] >>> Error: Malformed protected data, refusing to sign!\n";
+            info("[$id] >>> Error: Malformed protected data, refusing to sign!");
             last;
         }
         unless (defined $payload and $payload =~ /\A[A-Za-z0-9\-_]*\z/) {
             # payload can be empty, for instance for POST-as-GET
-            print STDERR "[$id] >>> Error: Malformed payload data, refusing to sign!\n";
+            info("[$id] >>> Error: Malformed payload data, refusing to sign!");
             last;
         }
 
-        print STDERR "[$id] >>> Incoming signature request for ",
-            "base64url(", decode_base64url($protected), ") . ",
-            "base64url(", decode_base64url($payload), ")"
-            unless $OPTS{quiet};
+        logmsg(noquiet => "[$id] >>> Incoming signature request for ",
+               "base64url(", decode_base64url($protected), ") . ",
+               "base64url(", decode_base64url($payload), ")");
 
         my $sig = $SIGN->($data);
         $out->printflush( encode_base64url($sig), "\r\n" ) or warn "print: $!";
@@ -224,11 +252,11 @@ if (defined $OPTS{stdio}) {
     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};
+        logmsg(noquiet => "[$count] >>> Accepted new connection");
         conn($conn, $conn, $count);
-        print STDERR "[$count] >>> Connection terminated\n" unless $OPTS{quiet};
+        logmsg(noquiet => "[$count] >>> Connection terminated");
         $conn->close() or warn "close: $!";
     }
 }
@@ -238,12 +266,12 @@ if (defined $OPTS{stdio}) {
 #
 END {
     if (defined $SOCKNAME and -S $SOCKNAME) {
-        print STDERR "Unlinking $SOCKNAME\n" if $OPTS{debug};
-        unlink $SOCKNAME or print STDERR "Couldn'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 "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: $!");
     }
 }