#!/usr/bin/perl -T

#----------------------------------------------------------------------
# ACME client written with process isolation and minimal privileges in mind
# (account key manager)
# Copyright © 2016-2017 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 <http://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 Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
use List::Util 'first';
use MIME::Base64 '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 conn-fd=i quiet|q debug help|h/);
usage(0) if $OPTS{help};

do {
    my $conffile = $OPTS{config} // first { -f $_ }
        ( "./$NAME.conf"
        , ($ENV{XDG_CONFIG_HOME} // "$ENV{HOME}/.config")."/lacme/$NAME.conf"
        , "/etc/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;

    $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,$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";
    }
    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 $! ?
        "Can't 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";
}
$JWK = 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.
#
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

    # 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 $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 $conn = shift;
    my $count = shift;
    $conn->printflush( "$PROTOCOL_VERSION OK", "\r\n", $JWK, "\r\n" );

    # 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};
        my $sig = $SIGN->($data);
        $conn->printflush( encode_base64url($sig), "\r\n" );
    }
}

if (defined $OPTS{'conn-fd'}) {
    conn($S, $$);
} 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, $count);
        print STDERR "[$count] >>> Connection terminated\n" unless $OPTS{quiet};
        close $conn or warn "Can't close: $!";
    }
}


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