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

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 "%" ? "%"
        : die "Error: \"$str\" has unknown specifier %$1\n";
        die "Error: undefined expansion %$1 in \"$str\"\n" 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 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;
    } 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};
};


#############################################################################
# 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 die "Error: Can't open $filename: $!\n";
    }
    elsif ($method eq 'gpg') {
        @command = split /\s+/, ($OPTS{gpg} // 'gpg --quiet');
        open $fh, '-|', @command, qw/-o - --decrypt --/, $filename or die "fork: $!";
    }
    else {
        die; # impossible
    }

    my $str = do {local $/ = undef; <$fh>};
    close $fh or die $! ?
        "close: $!" :
        "Error: $command[0] exited with value ".($? >> 8)."\n";

    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();
    $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 {
    die "Error: unsupported method: $OPTS{privkey}\n";
}
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 : die "Invalid socket name\n"; # untaint $sockname

    # 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 $umask = umask(0177) // die "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: $!";

    ($SOCKNAME, $S) = ($sockname, $sock);
    listen($S, 1) or die "listen: $!";

    umask($umask) // die "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 die;

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

        print STDERR "[$id] >>> Incoming signature request for ",
            "base64url(", decode_base64url($protected), ") . ",
            "base64url(", decode_base64url($payload), ")"
            unless $OPTS{quiet};

        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
            die "accept: $!";
        };
        print STDERR "[$count] >>> Accepted new connection\n" unless $OPTS{quiet};
        conn($conn, $conn, $count);
        print STDERR "[$count] >>> Connection terminated\n" unless $OPTS{quiet};
        $conn->close() or warn "close: $!";
    }
}


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