diff options
Diffstat (limited to 'lacme-accountd')
| -rwxr-xr-x | lacme-accountd | 110 |
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: $!"); } } |