diff options
Diffstat (limited to 'lacme')
| -rwxr-xr-x | lacme | 325 |
1 files changed, 201 insertions, 124 deletions
@@ -2,7 +2,7 @@ #---------------------------------------------------------------------- # ACME client written with process isolation and minimal privileges in mind -# Copyright © 2016-2017 Guilhem Moulin <guilhem@fripost.org> +# 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 @@ -22,14 +22,14 @@ use v5.14.2; use strict; use warnings; -our $VERSION = '0.3'; +our $VERSION = '0.8.0'; my $NAME = 'lacme'; use Errno 'EINTR'; -use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC SEEK_SET/; +use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC O_CREAT O_EXCL O_WRONLY SEEK_SET/; +use File::Basename 'dirname'; use File::Temp (); use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/; -use List::Util 'first'; use POSIX (); use Socket 1.95 qw/AF_UNIX AF_INET AF_INET6 PF_UNIX PF_INET PF_INET6 PF_UNSPEC INADDR_ANY IN6ADDR_ANY IPPROTO_IPV6 @@ -63,7 +63,11 @@ sub usage(;$$) { } exit $rv; } -usage(1) unless GetOptions(\%OPTS, qw/config=s config-certs=s@ socket=s register tos-agreed deactivate min-days=i quiet|q debug help|h/); +usage(1) unless GetOptions(\%OPTS, qw/config=s config-certs=s@ socket=s + register tos-agreed deactivate + min-days=i force + quiet|q + debug help|h/); usage(0) if $OPTS{help}; $COMMAND = shift(@ARGV) // usage(1, "Missing command"); @@ -71,14 +75,33 @@ $COMMAND = $COMMAND =~ /\A(account|newOrder|new-cert|revokeCert|revoke-cert)\z/ : usage(1, "Invalid command: $COMMAND"); # validate and untaint $COMMAND @ARGV = map { /\A(\p{Print}*)\z/ ? $1 : die } @ARGV; # untaint @ARGV +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; +} + sub set_FD_CLOEXEC($$); -my $CONFFILENAME = $OPTS{config} // first { -f $_ } - ( "./$NAME.conf" - , ($ENV{XDG_CONFIG_HOME} // "$ENV{HOME}/.config")."/lacme/$NAME.conf" - , "@@sysconfdir@@/lacme/$NAME.conf" - ); +my $CONFFILENAME = spec_expand($OPTS{config} // "%E/lacme/$NAME.conf"); do { - die "Error: Can't find configuration file\n" unless defined $CONFFILENAME; print STDERR "Using configuration file: $CONFFILENAME\n" if $OPTS{debug}; open $CONFFILE, '<', $CONFFILENAME or die "Can't open $CONFFILENAME: $!\n"; my $conf = do { local $/ = undef; <$CONFFILE> }; @@ -90,9 +113,9 @@ do { my $accountd = defined $OPTS{socket} ? 0 : exists $h->{accountd} ? 1 : 0; my %valid = ( client => { - socket => (defined $ENV{XDG_RUNTIME_DIR} ? "$ENV{XDG_RUNTIME_DIR}/S.lacme" : undef), - user => 'nobody', - group => 'nogroup', + socket => '%t/S.lacme', + user => '@@lacme_client_user@@', + group => '@@lacme_client_group@@', command => '@@libexecdir@@/lacme/client', # the rest is for the ACME client map {$_ => undef} qw/server timeout SSL_verify SSL_version SSL_cipher_list/ @@ -100,8 +123,8 @@ do { webserver => { listen => '@@runstatedir@@/lacme-www.socket', 'challenge-directory' => undef, - user => 'www-data', - group => 'www-data', + user => '@@lacme_www_user@@', + group => '@@lacme_www_group@@', command => '@@libexecdir@@/lacme/webserver', iptables => 'No' @@ -110,8 +133,8 @@ do { user => '', group => '', command => '@@bindir@@/lacme-accountd', - config => '@@sysconfdir@@/lacme/lacme-accountd.conf', - privkey => undef, + config => '', + privkey => '', quiet => 'Yes', } ); @@ -155,7 +178,8 @@ sub gen_csr(%) { ); $config->print("keyUsage = critical, $args{keyUsage}\n") if defined $args{keyUsage}; $config->print("subjectAltName = $args{subjectAltName}\n") if defined $args{subjectAltName}; - $config->close() or die "Can't close: $!"; + $config->print("tlsfeature = $args{tlsfeature}\n") if defined $args{tlsfeature}; + $config->close() or die "close: $!"; my @args = (qw/-new -batch -key/, $args{'certificate-key'}); push @args, "-$args{hash}" if defined $args{hash}; @@ -163,20 +187,20 @@ sub gen_csr(%) { open my $fh, '-|', qw/openssl req -outform DER/, @args or die "fork: $!"; my $csr = do { local $/ = undef; <$fh> }; - close $fh or $! ? die "Can't close: $!" : return; + close $fh or $! ? die "close: $!" : return; if ($OPTS{debug}) { # print out the CSR in text form pipe my $rd, my $wd or die "pipe: $!"; my $pid = fork // die "fork: $!"; unless ($pid) { - open STDIN, '<&', $rd or die "Can't dup: $!"; - open STDOUT, '>&', \*STDERR or die "Can't dup: $!"; + open STDIN, '<&', $rd or die "dup: $!"; + open STDOUT, '>&', \*STDERR or die "dup: $!"; exec qw/openssl req -noout -text -inform DER/ or die; } - $rd->close() or die "Can't close: $!"; + $rd->close() or die "close: $!"; $wd->print($csr); - $wd->close() or die "Can't close: $!"; + $wd->close() or die "close: $!"; waitpid $pid => 0; die $? if $? > 0; @@ -216,21 +240,28 @@ sub drop_privileges($$$) { # set effective and real gid; also set the list of supplementary gids to that single gid if ($group ne '') { - my $gid = getgrnam($group) // die "Can't getgrnam($group): $!"; + my $gid = getgrnam($group) // die "getgrnam($group): $!"; $) = "$gid $gid"; - die "Can't setgroups: $!" if $@; - POSIX::setgid($gid) or die "Can't setgid: $!"; + die "setgroups: $!" if $@; + POSIX::setgid($gid) or die "setgid: $!"; die "Couldn't setgid/setguid" unless $( eq "$gid $gid" and $) eq "$gid $gid"; # safety check } # set effective and real uid if ($user ne '') { - my $uid = getpwnam($user) // die "Can't getpwnam($user): $!"; - POSIX::setuid($uid) or die "Can't setuid: $!"; + my $uid = getpwnam($user) // die "getpwnam($user): $!"; + POSIX::setuid($uid) or die "setuid: $!"; die "Couldn't setuid/seteuid" unless $< == $uid and $> == $uid; # safety check } - chdir $dir or die "Can't chdir to $dir: $!"; + # sanitize environment + my $term = $ENV{TERM}; + my @ent = getpwuid($<) or die "getpwuid($<): $!"; + %ENV = ( USER => $ent[0], LOGNAME => $ent[0], HOME => $ent[7], SHELL => $ent[8] ); + $ENV{PATH} = $< == 0 ? "/usr/sbin:/usr/bin:/sbin:/bin" : "/usr/bin:/bin"; + $ENV{TERM} = $term if defined $term; # preserve $TERM + + chdir $dir or die "chdir($dir): $!"; } @@ -239,10 +270,10 @@ sub drop_privileges($$$) { # sub set_FD_CLOEXEC($$) { my ($fd, $set) = @_; - my $flags = fcntl($fd, F_GETFD, 0) or die "Can't fcntl F_GETFD: $!"; + my $flags = fcntl($fd, F_GETFD, 0) or die "fcntl F_GETFD: $!"; my $flags2 = $set ? ($flags | FD_CLOEXEC) : ($flags & ~FD_CLOEXEC); return if $flags == $flags2; - fcntl($fd, F_SETFD, $flags2) or die "Can't fcntl F_SETFD: $!"; + fcntl($fd, F_SETFD, $flags2) or die "fcntl F_SETFD: $!"; } @@ -252,15 +283,6 @@ sub set_FD_CLOEXEC($$) { # The temporary challenge directory is returned. # sub spawn_webserver() { - # create a temporary directory; give write access to the ACME client - # and read access to the webserver - my $tmpdir = File::Temp::->newdir(CLEANUP => 1, TMPDIR => 1) // die; - chmod 0755, $tmpdir or die "Can't chmod: $!"; - if ((my $username = $CONFIG->{client}->{user}) ne '') { - my $uid = getpwnam($username) // die "Can't getpwnam($username): $!"; - chown($uid, -1, $tmpdir) or die "Can't chown: $!"; - } - my $conf = $CONFIG->{webserver}; # parse and pack addresses to listen to @@ -280,19 +302,57 @@ sub spawn_webserver() { push @sockaddr, $sockaddr; } - # symlink the 'challenge-directory' configuration option to the - # temporary challenge directory (so an existing httpd can directly - # serve ACME challenge reponses). + # Use existing HTTPd to serve challenge files using 'challenge-directory' + # as document root if (defined (my $dir = $conf->{'challenge-directory'})) { + $dir = spec_expand($dir); print STDERR "[$$] Using existing webserver on $dir\n" if $OPTS{debug}; - symlink $tmpdir, $dir or die "Can't symlink $dir -> $tmpdir: $!"; - push @CLEANUP, sub() { - print STDERR "Unlinking $dir\n" if $OPTS{debug}; - unlink $dir or warn "Warning: Can't unlink $dir: $!"; + # lacme(8) doesn't have the list of challenge files to delete on + # cleanup -- instead, we unlink all files and fails at + # initialization stage when the challenge directory is not empty + + opendir my $dh, $dir or die "opendir($dir): $!\n"; + while (readdir $dh) { + die "Error: Refusing to use non-empty challenge directory $dir\n" + unless $_ eq '.' or $_ eq '..'; } + closedir $dh or die "closedir: $!"; + undef $dh; + + # use a "lock file" (NFS-friendly) to avoid concurrent usages + my $lockfile = ".$NAME.lock"; + sysopen(my $fh, "$dir/$lockfile", O_CREAT|O_EXCL|O_WRONLY, 0600) + or die "Can't create lockfile in challenge directory: $!"; + print $fh $$, "\n"; + close $fh or die "close: $!"; + undef $fh; + + push @CLEANUP, sub() { + if (opendir(my $dh, $dir)) { + my @files = grep { $_ ne '.' and $_ ne '..' and $_ ne $lockfile } readdir $dh; + closedir $dh or warn "closedir: $!"; + push @files, $lockfile; # unlink $lockfile last + foreach (@files) { + die unless /\A(.+)\z/; # untaint + unlink "$dir/$1" or warn "unlink($dir/$1): $!"; + } + } else { + warn "opendir($dir): $!\n"; + } + }; + return $dir; # ignore 'listen' and 'iptables' } - elsif (!@sockaddr) { - die "'challenge-directory' option of section [webserver] is required when 'listen' is empty\n"; + + die "'challenge-directory' option is required in section [webserver] when 'listen' is empty\n" + unless @sockaddr; + + # create a temporary directory; give write access to the ACME client + # and read access to the webserver + my $tmpdir = File::Temp::->newdir(CLEANUP => 1, TMPDIR => 1, TEMPLATE => "acme-challenge.XXXXXXXXXX") // die; + chmod 0755, $tmpdir or die "chmod: $!"; + if ((my $username = $CONFIG->{client}->{user}) ne '') { + my $uid = getpwnam($username) // die "getpwnam($username): $!"; + chown($uid, -1, $tmpdir) or die "chown: $!"; } # create socket(s) and spawn webserver(s) @@ -321,7 +381,7 @@ sub spawn_webserver() { bind($sock, $sockaddr) or die "Couldn't bind to $p: $!"; push @CLEANUP, sub() { print STDERR "Unlinking $path\n" if $OPTS{debug}; - unlink $path or warn "Warning: Can't unlink $path: $!"; + unlink $path or warn "Warning: Couldn't unlink $path: $!"; }; umask($umask) // die "umask: $!"; } @@ -335,20 +395,22 @@ sub spawn_webserver() { my $pid = fork() // "fork: $!"; unless ($pid) { drop_privileges($conf->{user}, $conf->{group}, $tmpdir); + open STDIN, '<', '/dev/null' or die "open(/dev/null): $!"; set_FD_CLOEXEC($sock, 0); - $ENV{DEBUG} = $OPTS{debug}; + $ENV{DEBUG} = $OPTS{debug} // 0; # use execve(2) rather than a Perl pseudo-process to ensure that # the child doesn't have access to the parent's memory - exec $conf->{command}, fileno($sock) or die; + my ($cmd, @args) = split(/\s+/, $conf->{command}) or die "Empty webserver command\n"; + exec { $cmd } $cmd, @args, fileno($sock) or die; } print STDERR "[$$] Forking ACME webserver bound to $p, child PID $pid\n" if $OPTS{debug}; set_FD_CLOEXEC($sock, 1); push @CLEANUP, sub() { print STDERR "[$$] Shutting down ACME webserver bound to $p\n" if $OPTS{debug}; - shutdown($sock, SHUT_RDWR) or warn "shutdown: $!"; kill 15 => $pid; waitpid $pid => 0; + shutdown($sock, SHUT_RDWR) or warn "shutdown: $!"; }; # on dual-stack ipv4/ipv6, we'll need to open the port for the @@ -396,8 +458,8 @@ sub iptables_save($@) { my $pid = fork() // die "fork: $!"; unless ($pid) { - open STDIN, '<', '/dev/null' or die "Can't open /dev/null: $!"; - open STDOUT, '>&', $iptables_tmp or die "Can't dup: $!"; + open STDIN, '<', '/dev/null' or die "open(/dev/null): $!"; + open STDOUT, '>&', $iptables_tmp or die "dup: $!"; $| = 1; # turn off buffering for STDOUT exec "/usr/sbin/$iptables_bin-save", "-c" or die; } @@ -408,14 +470,14 @@ sub iptables_save($@) { # handle and not from the file. XXX if there was a way in Perl to # use open(2) with the O_TMPFILE flag we would use that to avoid # creating a file to start with - seek($iptables_tmp, SEEK_SET, 0) or die "Can't seek: $!"; + seek($iptables_tmp, SEEK_SET, 0) or die "seek: $!"; push @CLEANUP, sub() { print STDERR "[$$] Restoring $iptables_bin\n" if $OPTS{debug}; my $pid = fork() // die "fork: $!"; unless ($pid) { - open STDIN, '<&', $iptables_tmp or die "Can't dup: $!"; - open STDOUT, '>', '/dev/null' or die "Can't open /dev/null: $!"; + open STDIN, '<&', $iptables_tmp or die "dup: $!"; + open STDOUT, '>', '/dev/null' or die "open(/dev/null): $!"; exec "/usr/sbin/$iptables_bin-restore", "-c" or die; } waitpid $pid => 0; @@ -459,21 +521,29 @@ sub acme_client($@) { my ($client, $cleanup); my $conf = $CONFIG->{client}; if (defined (my $accountd = $CONFIG->{accountd})) { + warn "Setting 'privkey' in lacme.conf's [accountd] section is deprecated and will become an error in a future release! " + ."Set it in lacme-accountd.conf instead.\n" if $accountd->{privkey} ne ''; + my $GPG_TTY = $ENV{GPG_TTY}; socketpair($client, my $s, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or die "socketpair: $!"; my $pid = fork() // "fork: $!"; unless ($pid) { drop_privileges($accountd->{user}, $accountd->{group}, '/'); - set_FD_CLOEXEC($s, 0); - $client->close() or die "Can't close: $!"; - my @cmd = ($accountd->{command}, '--conn-fd='.fileno($s)); - push @cmd, '--config='.$accountd->{config} if defined $accountd->{config}; - push @cmd, '--privkey='.$accountd->{privkey} if defined $accountd->{privkey}; - push @cmd, '--quiet' unless lc $accountd->{quiet} eq 'no'; - push @cmd, '--debug' if $OPTS{debug}; - exec { $cmd[0] } @cmd or die; + $client->close() or die "close: $!"; + open STDIN, '<&', $s or die "dup: $!"; + open STDOUT, '>&', $s or die "dup: $!"; + set_FD_CLOEXEC($s, 1); + $ENV{GPG_TTY} = $GPG_TTY if defined $GPG_TTY; + my ($cmd, @args) = split(/\s+/, $accountd->{command}) or die "Empty accountd command\n"; + $_ = spec_expand($_) foreach ($cmd, @args); # expand %-specifiers after privilege drop and whitespace split + push @args, '--stdio'; + push @args, '--config='.spec_expand($accountd->{config}) if $accountd->{config} ne ''; + push @args, '--privkey='.$accountd->{privkey} if $accountd->{privkey} ne ''; # XXX deprecated in 0.8.0 + push @args, '--quiet' unless lc $accountd->{quiet} eq 'no'; + push @args, '--debug' if $OPTS{debug}; + exec { $cmd } $cmd, @args or die; } print STDERR "[$$] Forking lacme-accountd, child PID $pid\n" if $OPTS{debug}; - $s->close() or die "Can't close: $!"; + $s->close() or die "close: $!"; $cleanup = sub() { print STDERR "[$$] Shutting down lacme-accountd\n" if $OPTS{debug}; shutdown($client, SHUT_RDWR) or warn "shutdown: $!"; @@ -483,17 +553,17 @@ sub acme_client($@) { } else { my @stat; - my $sockname = $OPTS{socket} // $conf->{socket} // die "Missing socket option\n"; + my $sockname = spec_expand($OPTS{socket} // $conf->{socket}); $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; - @stat = stat($dirname) or die "Can't stat $dirname: $!"; - die "Error: insecure permissions on $dirname\n" if ($stat[2] & 0022) != 0; + my $dirname = dirname($sockname); + @stat = stat($dirname) or die "Error: stat($dirname): $!\n"; + die "Error: Insecure permissions on $dirname\n" if ($stat[2] & 0022) != 0; # ensure we're the only user with read/write access to the socket - @stat = stat($sockname) or die "Can't stat $sockname: $! (Is lacme-accountd running?)\n"; - die "Error: insecure permissions on $sockname\n" if ($stat[2] & 0066) != 0; + @stat = stat($sockname) or die "Can't stat $sockname: $! (Is lacme-accountd running?)\n"; + die "Error: Insecure permissions on $sockname\n" if ($stat[2] & 0066) != 0; # connect(2) to the socket socket($client, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; @@ -506,14 +576,15 @@ sub acme_client($@) { # use execve(2) rather than a Perl pseudo-process to ensure that the # child doesn't have access to the parent's memory + my ($cmd, @args2) = split(/\s+/, $conf->{command}) or die "Empty client command\n"; my @fileno = map { fileno($_) =~ /^(\d+)$/ ? $1 : die } ($CONFFILE, $client); # untaint fileno set_FD_CLOEXEC($client, 1); my $rv = spawn({in => $args->{in}, out => $args->{out}, child => sub() { drop_privileges($conf->{user}, $conf->{group}, $args->{chdir} // '/'); set_FD_CLOEXEC($_, 0) foreach ($CONFFILE, $client); - seek($CONFFILE, SEEK_SET, 0) or die "Can't seek: $!"; - $ENV{DEBUG} = $OPTS{debug}; - }}, $conf->{command}, $COMMAND, @fileno, @args); + seek($CONFFILE, SEEK_SET, 0) or die "seek: $!"; + $ENV{DEBUG} = $OPTS{debug} // 0; + }}, $cmd, @args2, $COMMAND, @fileno, @args); if (defined $cleanup) { @CLEANUP = grep { $_ ne $cleanup } @CLEANUP; @@ -524,7 +595,7 @@ sub acme_client($@) { sub spawn($@) { my $args = shift; - my @exec = @_; + my ($cmd, @args) = @_; # create communication pipes if needed my ($in_rd, $in_wd, $out_rd, $out_wd); @@ -540,20 +611,20 @@ sub spawn($@) { # child $args->{child}->() if defined $args->{child}; if (defined $args->{in}) { - close $in_wd or die "Can't close: $!"; - open STDIN, '<&', $in_rd or die "Can't dup: $!"; + close $in_wd or die "close: $!"; + open STDIN, '<&', $in_rd or die "dup: $!"; } else { - open STDIN, '<', '/dev/null' or die "Can't open /dev/null: $!"; + open STDIN, '<', '/dev/null' or die "open(/dev/null): $!"; } if (!defined $args->{out}) { - open STDOUT, '>', '/dev/null' or die "Can't open /dev/null: $!"; + open STDOUT, '>', '/dev/null' or die "open(/dev/null): $!"; } elsif (ref $args->{out} ne 'GLOB') { - close $out_rd or die "Can't close: $!"; - open STDOUT, '>&', $out_wd or die "Can't dup: $!"; + close $out_rd or die "close: $!"; + open STDOUT, '>&', $out_wd or die "dup: $!"; } elsif (fileno(STDOUT) != fileno($args->{out})) { - open STDOUT, '>&', $args->{out} or die "Can't dup: $!"; + open STDOUT, '>&', $args->{out} or die "dup: $!"; } - exec { $exec[0] } @exec or die; + exec { $cmd } $cmd, @args or die; } push @CLEANUP, sub() { kill 15 => $pid; @@ -561,20 +632,20 @@ sub spawn($@) { }; # parent - print STDERR "[$$] Forking $exec[0], child PID $pid\n" if $OPTS{debug}; + print STDERR "[$$] Forking $cmd, child PID $pid\n" if $OPTS{debug}; if (defined $args->{in}) { - $in_rd->close() or die "Can't close: $!"; + $in_rd->close() or die "close: $!"; $in_wd->print($args->{in}); - $in_wd->close() or die "Can't close: $!"; + $in_wd->close() or die "close: $!"; } if (defined $args->{out} and ref $args->{out} ne 'GLOB') { - $out_wd->close() or die "Can't close: $!"; + $out_wd->close() or die "close: $!"; if (ref $args->{out} eq 'CODE') { $args->{out}->($out_rd); } elsif (ref $args->{out} eq 'SCALAR') { ${$args->{out}} = do { local $/ = undef; $out_rd->getline() }; } - $out_rd->close() or die "Can't close: $!"; + $out_rd->close() or die "close: $!"; } waitpid $pid => 0; pop @CLEANUP; @@ -599,31 +670,31 @@ sub install_cert($$;$) { chmod(0644 &~ $umask, $fh) or die "chmod: $!"; if ($leafonly) { # keep only the leaf certificate - pipe my $rd, my $wd or die "Can't pipe: $!"; - my $pid = fork // die "Can't fork: $!"; + pipe my $rd, my $wd or die "pipe: $!"; + my $pid = fork // die "fork: $!"; unless ($pid) { - open STDIN, '<&', $rd or die "Can't dup: $!"; - open STDOUT, '>&', $fh or die "Can't dup: $!"; + open STDIN, '<&', $rd or die "dup: $!"; + open STDOUT, '>&', $fh or die "dup: $!"; exec qw/openssl x509 -outform PEM/ or die; } - $rd->close() or die "Can't close: $!"; + $rd->close() or die "close: $!"; $wd->print($chain); - $wd->close() or die "Can't close: $!"; + $wd->close() or die "close: $!"; waitpid $pid => 0; die $? if $? > 0; } else { - $fh->print($chain) or die "Can't print: $!"; + $fh->print($chain) or die "print: $!"; } - $fh->close() or die "Can't close: $!"; + $fh->close() or die "close: $!"; }; my $path = $fh->filename(); if ($@) { print STDERR "Unlinking $path\n" if $OPTS{debug}; - unlink $path or warn "Can't unlink $path: $!"; + unlink $path or warn "unlink($path): $!"; die $@; } - rename($path, $filename) or die "Can't rename $path to $filename: $!"; + rename($path, $filename) or die "rename($path, $filename): $!"; } @@ -643,18 +714,20 @@ if ($COMMAND eq 'account') { # newOrder [SECTION ..] # elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { + $OPTS{'min-days'} = -1 if $OPTS{force}; $COMMAND = 'newOrder'; my $conffiles = defined $OPTS{'config-certs'} ? $OPTS{'config-certs'} : defined $CONFIG->{_}->{'config-certs'} ? [ split(/\s+/, $CONFIG->{_}->{'config-certs'}) ] : [ "$NAME-certs.conf", "$NAME-certs.conf.d/" ]; + $_ = spec_expand($_) foreach @$conffiles; my ($conf, %defaults); foreach my $conffile (@$conffiles) { - $conffile = ($CONFFILENAME =~ s#[^/]+\z##r).$conffile unless $conffile =~ /\A\//; + $conffile = dirname($CONFFILENAME) .'/'. $conffile unless $conffile =~ /\A\//; my @filenames; unless ($conffile =~ s#/\z## or -d $conffile) { @filenames = ($conffile); } else { - opendir my $dh, $conffile or die "Can't opendir $conffile: $!\n"; + opendir my $dh, $conffile or die "opendir($conffile): $!\n"; while (readdir $dh) { if (/\.conf\z/) { push @filenames, "$conffile/$_"; @@ -662,7 +735,7 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { warn "$conffile/$_ has unknown suffix, skipping\n"; } } - closedir $dh; + closedir $dh or die "closedir: $!"; } foreach my $filename (sort @filenames) { print STDERR "Reading $filename\n" if $OPTS{debug}; @@ -670,7 +743,7 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { my $def = delete $h->{_} // {}; $defaults{$_} = $def->{$_} foreach keys %$def; my @valid = qw/certificate certificate-chain certificate-key min-days CAfile - hash keyUsage subject subjectAltName chown chmod notify/; + hash keyUsage subject subjectAltName tlsfeature chown chmod notify/; foreach my $s (keys %$h) { $conf->{$s} = { map { $_ => delete $h->{$s}->{$_} } @valid }; die "Unknown option(s) in [$s]: ".join(', ', keys %{$h->{$s}})."\n" if %{$h->{$s}}; @@ -690,18 +763,18 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { if ($OPTS{debug}) { print STDERR "Configuration option for $s:\n"; - print " $_ = $conf->{$_}\n" foreach grep { defined $conf->{$_} } (sort keys %$conf); + print STDERR " $_ = $conf->{$_}\n" foreach grep { defined $conf->{$_} } (sort keys %$conf); } - my $certtype = first { defined $conf->{$_} } qw/certificate certificate-chain/; - unless (defined $certtype) { + my $cert = $conf->{'certificate-chain'} // $conf->{'certificate'}; + unless (defined $cert) { print STDERR "[$s] Warning: Missing 'certificate' and 'certificate-chain', skipping\n"; $rv = 1; next; } # skip certificates that expire at least $conf->{'min-days'} days in the future - if (-f $conf->{$certtype} and defined (my $t = x509_enddate($conf->{$certtype}))) { + if (-f $cert and defined (my $t = x509_enddate($cert))) { my $d = $OPTS{'min-days'} // $conf->{'min-days'} // 21; if ($d >= 0 and $t - time > $d*86400) { my $d = POSIX::strftime('%Y-%m-%d %H:%M:%S UTC', gmtime($t)); @@ -711,7 +784,7 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { } # generate the CSR - my $csr = gen_csr(map {$_ => $conf->{$_}} qw/certificate-key subject subjectAltName keyUsage hash/) // do { + my $csr = gen_csr(map {$_ => $conf->{$_}} qw/certificate-key keyUsage subject subjectAltName tlsfeature hash/) // do { print STDERR "[$s] Warning: Couldn't generate CSR, skipping\n"; $rv = 1; next; @@ -751,13 +824,17 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { next; }; - # verify certificate validity against the CA - $conf->{CAfile} //= '@@datadir@@/lacme/ca-certificates.crt'; - if ($conf->{CAfile} ne '' and spawn({in => $x509}, 'openssl', 'verify', '-CAfile', $conf->{CAfile}, - qw/-purpose sslserver -x509_strict/)) { - print STDERR "[$s] Error: Received invalid X.509 certificate from ACME server!\n"; - $rv = 1; - next; + # verify certificate validity against the CA bundle + if ((my $CAfile = $conf->{CAfile} // '@@datadir@@/lacme/ca-certificates.crt') ne '') { + my %args = (in => $x509); + $args{out} = \*STDERR if $OPTS{debug}; + my @options = ('-trusted', $CAfile, '-purpose', 'sslserver', '-x509_strict'); + push @options, '-show_chain' if $OPTS{debug}; + if (spawn(\%args, 'openssl', 'verify', @options)) { + print STDERR "[$s] Error: Received invalid X.509 certificate from ACME server!\n"; + $rv = 1; + next; + } } # install certificate @@ -772,16 +849,16 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { if (defined $conf->{chown}) { my ($user, $group) = split /:/, $conf->{chown}, 2; - my $uid = getpwnam($user) // die "Can't getpwnam($user): $!"; - my $gid = defined $group ? (getgrnam($group) // die "Can't getgrnam($group): $!") : -1; + my $uid = getpwnam($user) // die "getpwnam($user): $!"; + my $gid = defined $group ? (getgrnam($group) // die "getgrnam($group): $!") : -1; foreach (grep defined, @$conf{qw/certificate certificate-chain/}) { - chown($uid, $gid, $_) or die "Can't chown: $!"; + chown($uid, $gid, $_) or die "chown: $!"; } } if (defined $conf->{chmod}) { my $mode = oct($conf->{chmod}) // die; foreach (grep defined, @$conf{qw/certificate certificate-chain/}) { - chmod($mode, $_) or die "Can't chown: $!"; + chmod($mode, $_) or die "chown: $!"; } } @@ -790,7 +867,7 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') { or die "fork: $!"; print $fh $x509; close $fh or die $! ? - "Can't close: $!" : + "close: $!" : "Error: x509(1ssl) exited with value ".($? >> 8)."\n"; if (defined $conf->{notify}) { @@ -820,7 +897,7 @@ elsif ($COMMAND eq 'revokeCert' or $COMMAND eq 'revoke-cert') { open my $fh, '-|', qw/openssl x509 -outform DER -in/, $filename or die "fork: $!"; my $der = do { local $/ = undef; <$fh> }; close $fh or die $! ? - "Can't close: $!" : + "close: $!" : "Error: x509(1ssl) exited with value ".($? >> 8)."\n"; my @certopts = join ',', qw/no_header no_version no_pubkey no_sigdump no_extensions/; @@ -828,7 +905,7 @@ elsif ($COMMAND eq 'revokeCert' or $COMMAND eq 'revoke-cert') { or die "fork: $!"; print $fh2 $der; close $fh2 or die $! ? - "Can't close: $!" : + "close: $!" : "Error: x509(1ssl) exited with value ".($? >> 8)."\n"; if (acme_client({in => $der})) { |