path: root/lacme-accountd

#!/usr/bin/perl -T

#----------------------------------------------------------------------
# ACME client written with process isolation and minimal privileges in mind
# (account key manager)
# 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
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

use v5.14.2;
use strict;
use warnings;

our $VERSION = '0.3';
my $PROTOCOL_VERSION = 1;
my $NAME = 'lacme-accountd';

use Errno 'EINTR';
use File::Basename 'dirname';
use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
use MIME::Base64 qw/decode_base64url encode_base64url/;
use Socket qw/PF_UNIX SOCK_STREAM SHUT_RDWR/;

use Config::Tiny ();
use JSON ();

# Clean up PATH
$ENV{PATH} = join ':', qw{/usr/bin /bin};
delete @ENV{qw/IFS CDPATH ENV BASH_ENV/};

my ($SOCKNAME, $S, %OPTS);
$SIG{$_} = sub() { exit } foreach qw/INT TERM/; # run the END block upon SIGINT/SIGTERM


#############################################################################
# Parse and validate configuration
#
sub usage(;$$) {
    my $rv = shift // 0;
    if ($rv) {
        my $msg = shift;
        print STDERR $msg."\n" if defined $msg;
        print STDERR "Try '$NAME --help' or consult the manpage for more information.\n";
    }
    else {
        print STDERR "Usage: $NAME [--config=FILE] [--privkey=ARG] [--socket=PATH] [--quiet]\n"
                    ."Consult the manpage for more information.\n";
    }
    exit $rv;
}
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;
}
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 = 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 (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 {
        print STDERR "Ignoring missing configuration file at default location $conffile\n" if $OPTS{debug};
    }

    $OPTS{quiet} = 0 if $OPTS{debug};
    error("'privkey' is not specified") unless defined $OPTS{privkey};
};


#############################################################################
# Build the JSON Web Key (RFC 7517) from the account key's public parameters,
# and determine the signing method $SIGN.
#
my ($JWK, $SIGN);
if ($OPTS{privkey} =~ /\A(file|gpg):(\p{Print}+)\z/) {
    my ($method, $filename) = ($1, spec_expand($2));
    my ($fh, @command);
    if ($method eq 'file') {
        # 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 panic("fork: $!");
    }
    else {
        panic(); # impossible
    }

    my $str = do {local $/ = undef; <$fh>};
    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;

    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 };
    $SIGN = sub($) { $rsa->sign($_[0]) };
}
else {
    error("unsupported method: $OPTS{privkey}");
}
my $JWK_STR = JSON::->new->encode($JWK);


#############################################################################
# Create the server UNIX socket and bind(2) against it.
# NOTE: We don't use the abstract namespace so we can rely on the file
# permissions to keep other users out.  (Also, OpenSSH 7.1 doesn't seem
# to support the abstract namespace.)  The downside is that we have to
# delete the file manually.
#
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 = dirname($sockname);
    my @stat = stat($dirname) or error("stat($dirname): $!");
    error("Insecure permissions on $dirname") if ($stat[2] & 0022) != 0;

    my $umask = umask(0177) // panic("umask: $!");

    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 panic("listen: $!");

    umask($umask) // panic("umask: $!");
};


#############################################################################
# For each new connection, send the protocol version and the account key's
# public parameters, then sign whatever comes in
#
sub conn($$;$) {
    my ($in, $out, $id) = @_;
    $out->printflush( "$PROTOCOL_VERSION OK", "\r\n", $JWK_STR, "\r\n" ) or warn "print: $!";

    # sign whatever comes in
    while (defined (my $data = $in->getline())) {
        $data =~ s/\r\n\z// or panic();

        my ($protected, $payload) = split(/\./, $data, 2);
        unless (defined $protected and $protected =~ /\A[A-Za-z0-9\-_]+\z/) {
            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
            info("[$id] >>> Error: Malformed payload data, refusing to sign!");
            last;
        }

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

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
            panic("accept: $!");
        };
        logmsg(noquiet => "[$count] >>> Accepted new connection");
        conn($conn, $conn, $count);
        logmsg(noquiet => "[$count] >>> Connection terminated");
        $conn->close() or warn "close: $!";
    }
}


#############################################################################
#
END {
    if (defined $SOCKNAME and -S $SOCKNAME) {
        logmsg(debug => "Unlinking $SOCKNAME");
        unlink $SOCKNAME or info("Error: unlink($SOCKNAME): $!");
    }
    if (defined $S) {
        logmsg(noquiet => "Shutting down and closing lacme Account Key Manager");
        shutdown($S, SHUT_RDWR) or info("Error: shutdown: $!");
        close $S or info("Error: close: $!");
    }
}