#! /usr/bin/perl
use strict;
use feature 'state';
use Protocol::ACME;
use Protocol::ACME::Challenge::LocalFile;
use Crypt::Format;
use Crypt::OpenSSL::PKCS10 qw(:const);
use Crypt::OpenSSL::RSA;
use Crypt::OpenSSL::X509;
use File::Basename;
use File::Path qw(make_path);
use DateTime::Format::Strptime;
use WWW::Curl::Easy;
use Pod::Usage;
use Pod::Man;
use Getopt::Long qw(:config gnu_getopt no_ignore_case);
use POSIX qw(strftime time floor);
use Data::Dumper;

our $VERSION = '0.90';

=head1 NAME

acmeman - manages ACME certificates

=head1 SYNOPSIS

B<acmeman>
[B<-Fdn>]
[B<-D> I<N>]
[B<-f> I<FILE>]    
[B<-l> B<slackware>|B<debian>|B<rh>]
[B<--config-file=>I<FILE>]
[B<--debug>]
[B<--dry-run>]
[B<--force>]
[B<--layout=>B<slackware>|B<debian>|B<rh>]
[B<--time-delta=>I<N>]
[I<DOMAIN>...]
    
B<acmeman> B<--setup> | B<-s>
[B<-Fdn>]
[B<-f> I<FILE>]    
[B<-l> B<slackware>|B<debian>|B<rh>]
[B<--config-file=>I<FILE>]
[B<--debug>]
[B<--dry-run>]
[B<--force>]
[B<--layout=>B<slackware>|B<debian>|B<rh>]
[I<DIR>]

B<acmeman>
[B<-h>]
[B<--help>]
[B<--usage>]
    
=head1 DESCRIPTION

A tool for automatic creation and renewal of ACME (LetsEncrypt) SSL
certificates.  It assumes that HTTP is served by Apache server, version
2.4 or later (although only minor changes are necessary to make it work
with version 2.2).  Three most popular layouts of Apache configuration
files are supported: Debian, Slackware, and Red Hat.  A special
directory should be configured for receiving ACME challenges.

The package provides two Apache macros: for serving ACME challenges and
declaring SSL virtual hosts.    
    
B<Acmeman> should be started periodically, as a cronjob.  Upon startup,
it scans Apache configuration for virtual hosts using ACME certificates,
checks their expiration times, and renews those of the certificates that
are nearing their expiration times within a predefined number of seconds
(24 hours by default).

=head2 Setup    

To set up the necessary infrastructure, run B<acmeman --setup>.  It will
create the configuration file B<httpd-letsencrypt.conf>, defining two
macros for SSL-enabled sites (B<mod_macro> is needed).  Finally, it will
create the directory B</var/www/acme>, which will be used for receiving
and serving ACME challenges.  If another directory is preferred, it can
be specified as an argument to B<acmeman --setup>.

The tool will try to determine the layout of the Apache configuration
files and place the created file accordingly, so that it will be included
into the main configuration file.  It will print the name of the created
file at the end of the run.  You are advised to ensure that the file is
included and that the module B<mod_macro> is loaded prior to it.  You
may also wish to revise B<httpd-letsencrypt.conf> and edit the paths to
SSL files configured there.  By default, the directory F</etc/acme/I<DOMAIN>>
will be created for each domain name needing SSL, and two files will be placed
there: F<cert.pem>, containing the leaf and intermediate certificates for that
domain, and F<privkey.pem>, containing the private key for that domain.    

If the program is unable to determine the Apache configuration layout, you can
declare it using the B<--layout> option.  It takes a single argument, one of:
B<debian>, B<slackware>, or B<rh> (all lower case).  Alternatively, you can
specify the location of the main Apache configuration file, using the
B<--config-file> option.

The program will refuse to overwrite existing files B<httpd-letsencrypt.conf>,
unless given the B<--force> (B<-F>) option.

=head2 Configuring SSL
    
To declare that a virtual host needs SSL certificate, add the following
line to the Apache B<VirtualHost> block serving plain HTTP for that host:

    Use LetsEncryptChallenge

This will instruct B<acmeman> to request a certificate for that virtual
host.  The hostname declared with the B<ServerName> statement will be used
as the B<CN> for the certificate, and any names declared via B<ServerAlias>
statements will form the list of alternative names (obviously, wildcards are
not allowed).

If such a certificate doesn't exist, it will be requested and created when
B<acmeman> is run.

To use the created certificate, create a new B<VirtualHost> block that
contains the following statement:    

Use LetsEncryptServer I<DOMAIN>

where I<DOMAIN> is the name used in the B<ServerName> statement of the plain
HTTP configuration.  Copy the B<ServerAlias> statements (if any), and add the
rest of configuration statements.  Note, that you need not use the B<ServerName>
statement, as it will be included when the B<LetsEncryptServer> macro is
expanded.

Example:

    <VirtualHost *:80>
        ServerName example.org
        ServerAlias www.example.com
        Use LetsEncryptChallenge
        ...
    </VirtualHost>

    <VirtualHost *:443>
        Use LetsEncryptServer example.org
        ServerAlias www.example.com
        ...
    </VirtualHost>
        
=head1 OPTIONS

=over 4
    
=item B<-h>

Prints a short usage summary.
    
=item B<--help>

Prints detailed user manual.    

=item B<--usage>

Outputs a terse reminder of the command line syntax along with a
list of available options.

=item B<-D>, B<--tile-delta=>I<N>

Sets the time window before the actual expiration time, when the certificate
becomes eligible for renewal.  I<N> is time in seconds.  The default
value is 86400, which means that B<acmeman> will attempt to renew any
certificate that expires within 24 hours.     
    
=item B<-F>, B<--force>

Force renewal of certificates, no matter their expire date.  With B<--setup>,
force installing the B<httpd-letsencrypt.conf> file even if it already
exists.    
    
=item B<-d>, B<--debug>

Increase debugging level.  Multiple options accumulate.
    
=item B<-f>, B<--config-file=>I<FILE>

Read I<FILE> as main Apache configuration file.
    
=item B<-l>, B<--layout=>I<NAME>

Defines Apache configuration file layout.  Valid values for I<NAME> are:
B<slackware>, B<debian>, and B<rh> (for Red Hat).
    
=item B<-n>, B<--dry-run>

With B<--setup>, don't actually write anything, just print what would
have been done.  Otherwise, use LetsEncrypt staging server, instead of
production.    
    
=item B<-s>, B<--setup>

Set up the B<acmeman> infrastructure files.
    
=back
    
=head1 AUTHOR

Sergey Poznyakoff <gray@gnu.org>    
    
=cut    

my $progname = basename($0);
my $progdescr = "manages ACME certificates";
my $debug;
my $dry_run;
my $acme_host = 'acme-staging.api.letsencrypt.org';
my %acme_endpoint = (prod => 'acme-v01.api.letsencrypt.org',  
                     staging => 'acme-staging.api.letsencrypt.org');
my $letsencrypt_root_cert_url =
    'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem';
my $time_delta = 86400;
my $force = 0;
my %select;               # Hash of selected domain names 

# Variables read from the Apache configuration files
my $server_root;
my $www_root;             # Root directory for ACME challenges
my @virthost;             # List of virtual hosts using ACME certificates  
my $filename_arg;         # Name of the formal argument to the LetsEncrypServer
my %filename_pattern;     # File name pattern.
                          # Valid keys are: cert, key and chain.

my $account_key;
my $challenge;

use constant {
    EX_OK           => 0,
    EX_USAGE        => 64,
    EX_DATAERR      => 65,
    EX_NOINPUT      => 66,
    EX_SOFTWARE     => 70,
    EX_OSFILE       => 72,
    EX_CANTCREAT    => 73,
    EX_NOPERM       => 77,
    EX_CONFIG       => 78
};

sub error {
    my $msg = shift;
    local %_ = @_;
    print STDERR "$progname: " if defined($progname);
    print STDERR "$_{prefix}: " if defined($_{prefix});
        print STDERR "$msg\n"
}

sub debug {
    my $l = shift;
    error(join(' ',@_), prefix => 'DEBUG') if $debug >= $l;
}

sub abend {
    my $code = shift;
    print STDERR "$progname: " if defined($progname);
    print STDERR "@_\n";
    exit $code;
}

sub make_filename {
    my ($type, $arg) = @_;
    abend(EX_SOFTWARE, "no $type in \%filename_pattern")
	unless exists $filename_pattern{$type};
    my $res = $filename_pattern{$type};
    $res =~ s{$filename_arg}{$arg}g;
    return $res;
}

sub prep_dir {
    my $dir = dirname(shift);
    if (! -d $dir) {
	debug(2, "creating directory $dir");
	my @created = make_path("$dir", { error => \my $err } );
	if (@$err) {
	    for my $diag (@$err) {
		my ($file, $message) = %$diag;
		if ($file eq '') {
		    error($message);
		} else {
		    error("problem unlinking $file: $message");
		}
	    }
	    exit(EX_CANTCREAT);
	}
    }
}


sub debug_to_loglevel {
    my @lev = ('err', 'info', 'debug');
    return $lev[$debug > $#lev ? $#lev : $debug];
}

sub make_csr {
    my $cn = shift;
    my $req = Crypt::OpenSSL::PKCS10->new(2048);
    $req->set_subject("/CN=$cn");
    $req->add_ext(Crypt::OpenSSL::PKCS10::NID_subject_alt_name,
		  join(',', map { "DNS:$_" } @_));
    $req->add_ext_final();
    $req->sign();
    if (exists($filename_pattern{key})) {
	my $filename = make_filename('key', $cn);
	debug(2, "writing $filename");
	prep_dir($filename);
	my $u = umask(077);
	$req->write_pem_pk($filename);
	umask($u);
    }
    return $req->get_pem_req();
}

sub save_crt {
    my $type = shift;
    my $domain = shift;

    my $filename = make_filename($type, $domain);
    debug(2, "writing $filename");
    prep_dir($filename);
    open(my $fd, '>', $filename);

    foreach my $der (@_) {
	my $pem = Crypt::Format::der2pem($der, 'CERTIFICATE');
	print $fd $pem;
	print $fd "\n";
    }
    close $fd;
}

sub domain_cert_expires {
    my $domain = shift;
    my $crt = make_filename('cert', $domain);
    if (-f $crt) {
	my $x509 = Crypt::OpenSSL::X509->new_from_file($crt);
	my $expiry = $x509->notAfter();

	my $strp = DateTime::Format::Strptime->new(
	    pattern => '%b %d %H:%M:%S %Y %Z',
	    time_zone => 'GMT'
	);
	my $ts = $strp->parse_datetime($expiry)->epoch;
	my $now = time();
	if ($now < $ts) {
	    my $hours = floor(($ts - $now) / 3600);
	    my $in;
	    if ($hours > 24) {
		my $days = floor($hours / 24);
		$in = "in $days days";
	    } elsif ($hours == 24) {
		$in = "in one day";
	    } else {
		$in = "today";
	    }
	    debug(1, "$crt expires on $expiry, $in");
	    if ($now + $time_delta < $ts) {
		debug(1, "$crt expires on $expiry, $in");
		return 0;
	    } else {
		debug(1, "will renew $crt (expires on $expiry, $in)");
	    }
	} else {
	    debug(1, "will renew $crt");
	}
    }
    return 1;
}

sub register_domain_certificate {
    my $domain = shift;
    debug(1, "CN=$domain, alternatives=@_");

    my $acme = Protocol::ACME->new(
    	host => $acme_host,
    	account_key => {
    	    buffer => $account_key->get_private_key_string(),
    	    format => 'PEM' },
    	loglevel => debug_to_loglevel()
    );

    eval {
	$acme->directory();
	$acme->register();
	$acme->accept_tos();

        foreach my $name ($domain, @_) {
   	    $acme->authz($name);
  	    $acme->handle_challenge($challenge);
	    $acme->check_challenge();
	    $acme->cleanup_challenge($challenge);
        }
	my $csr = make_csr($domain, @_);
        my $cert = $acme->sign({ format => 'PEM', buffer => $csr });
        my $chain = $acme->chain();
        if (exists($filename_pattern{chain})) {
            save_crt('cert', $domain, $cert);
	    save_crt('chain', $domain, $chain);
        } else {
            save_crt('cert', $domain, $cert, $chain);
        }
    };
    if ($@) {
    	if (UNIVERSAL::isa($@, 'Protocol::ACME::Exception')) {
    	    error("$domain: can't renew certificate: $@->{status}");
            if (exists($@->{error})) {
    	        error("$domain: $@->{error}{status} $@->{error}{detail}");
    	    } else {
    	        error("$domain: $@->{detail} $@->{type}");
            } 
    	} else {
            error("$domain: failed to renew certificate");
            print STDERR Dumper([$@]) if $debug;
    	}
    }
}

sub dequote {
    my ($arg) = @_;
    $arg =~ s{^"(.*?)"$}{$1};
    return $arg;
}

sub uniq {
    my %h;
    map {
	if (exists($h{$_})) {
	    ()
	} else {
	    $h{$_} = 1;
	    $_
        }
    } @_; 
}

sub examine_http_config {
    my ($file) = @_;

    use constant {
	STATE_INITIAL         => 0, # Initial state
	STATE_VIRTUAL_HOST    => 1, # In VirtualHost block 
	STATE_USE_CHALLENGE   => 2, # Ditto, but challenge macro was used
	STATE_MACRO_CHALLENGE => 3, # In LetsEncryptChallenge macro
	STATE_MACRO_SERVER    => 4
    };

    state $state = STATE_INITIAL;
    
    debug(2, "reading apache configuration file \"$file\"");
    if (open(my $fd, '<', $file)) {
	my $server_name;
	my @server_aliases;
	my $line;

	while (<$fd>) {
	    ++$line;
	    chomp;
	    s/^\s+//;
	    next if /^(#.*)?$/;
	    if (/^include(optional)?\s+(.+?)\s*$/i) {
		debug(2, "$file:$line: state $state: Include$1 $2");
		http_include(dequote($2), $1 ne '');
		next;
	    }

	    if ($state == STATE_INITIAL) {
		if (/^<VirtualHost/i) {
		    $state = STATE_VIRTUAL_HOST;
		    $server_name = undef;
		    @server_aliases = ();
		} elsif (/^ServerRoot\s+(.+)/i) {
		    $server_root = dequote($1);
		} elsif (/^<(?:(?i)Macro)\s+LetsEncryptChallenge/) {
		    $state = STATE_MACRO_CHALLENGE;
		} elsif (/^<(?:(?i)Macro)\s+LetsEncryptServer\s+(.+?)\s*>/) {
		    $state = STATE_MACRO_SERVER;
		    $filename_arg = $1;
		    $filename_arg =~ s{\$}{\\\$};
		}
	    } elsif ($state == STATE_VIRTUAL_HOST
		     || $state == STATE_USE_CHALLENGE) {
		if (m{</VirtualHost}i) {
		    unshift @server_aliases, $server_name
			if defined $server_name;
		    if ($state == STATE_USE_CHALLENGE
			&& @server_aliases
			&& (!%select || exists($select{$server_name}))) {
			my @names = uniq(@server_aliases);
			debug(1, "$file:$line: will handle @names");
			push @virthost, \@names;
		    }
		    $state = STATE_INITIAL;
		} elsif (/^(?:(?i)Use)\s+LetsEncryptChallenge/) {
		    $state = STATE_USE_CHALLENGE;
		# } elsif (/^Use\s+LetsEncryptSSL\s+(\S+)/i) {
		#     debug(1, "$file: $1");
		#     push @virthost, [ $1 ];
		} elsif (/^(?:(?i)ServerName)\s+(\S+)/) {
		    $server_name = dequote($1);
		} elsif (/^(?:(?i)ServerAlias)\s+(.+)\s*$/) {
		    push @server_aliases,
		         map { /^\*\./ ? () : dequote($_) } split /\s+/, $1;
		}
	    } elsif ($state == STATE_MACRO_CHALLENGE) {
		if (m{^</macro}i) {
		    $state = STATE_INITIAL;
		} elsif (m{^(?:(?i)Alias)\s+/.well-known/acme-challenge\s+(.+)}) {
		    my $dir = dequote($1);
		    $dir =~ s{/.well-known/acme-challenge$}{};
		    $www_root = $dir;
		    debug(1, "ACME challenge root dir: $www_root");
		}
	    } elsif ($state == STATE_MACRO_SERVER) {
		if (m{^</macro}i) {
		    $state = STATE_INITIAL;
		} elsif (/(?:(?i)SSLCertificate((?:Key)|(?:Chain))?File)\s+(.+)/) {
		    $filename_pattern{lc($1 ? $1 : 'cert')} = $2;
		}
	    }
	}
	close $fd;
    } else {
	error("can't open file \"$file\": $!");
	return 0;
    }
    return 1;	
}

sub http_include {
    my ($pattern, $optional) = @_;
    $pattern = "$server_root/$pattern" unless $pattern =~ m{^/};
    $pattern =~ s{/*$}{};
    $pattern .= '/*' if -d $pattern;
    foreach my $file (glob $pattern) {
	if ($optional && ! -e $file) {
	    debug(1, "optional include file \"$file\" doesn't exist");
	    next;
	}
	examine_http_config($file);
    }
}
# ##
my $apache_layout;

sub incdir {
    if (exists($apache_layout->{incdir})) {
	if (ref($apache_layout->{incdir}) eq 'CODE') {
	    return &{$apache_layout->{incdir}};
	} else {
	    return $apache_layout->{incdir};
	}
    }
    return dirname($apache_layout->{config});
}

sub get_root_cert {
    my $name = shift;
    prep_dir($name);

    debug(1, "downloading $letsencrypt_root_cert_url to \"$name\"");
    open(my $fd, '>', $name)
	or abend(EX_CANTCREAT, "can't open \"$name\" for writing: $!");
    my $curl = WWW::Curl::Easy->new;
    $curl->setopt(CURLOPT_HEADER,0);
    $curl->setopt(CURLOPT_URL, $letsencrypt_root_cert_url);
    $curl->setopt(CURLOPT_WRITEDATA, $fd);
    my $rc = $curl->perform;
    my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE);
    if ($rc) {
	error("error downloading certificate from $letsencrypt_root_cert_url");
	error($curl->errbuf);
	abend(EX_NOINPUT, $curl->strerror($rc));
    } elsif ($response_code != 200) {
	error("error downloading certificate from $letsencrypt_root_cert_url");
	abend(EX_NOINPUT, "unexpected response code: $response_code");
    }
    close $fd;
}
	
sub initial_setup {
    if (defined($www_root)) {
	error("acmeman macros seem to be already installed");
	abend(EX_NOPERM, "use --force to continue") unless $force;
    }
    if ($#ARGV == -1) {
	$www_root = '/var/www/acme';
    } elsif ($#ARGV == 0) {
	$www_root = $ARGV[0];
    } else {
	abend(EX_USAGE, "too many arguments in setup mode");
    }
    my $filename = incdir() . "/httpd-letsencrypt.conf";
    if (-e $filename) {
	error("the file \"$filename\" already exists");
	abend(EX_NOPERM, "use --force to continue") unless $force;
    }
    debug(1, "writing $filename");
    unless ($dry_run) {
	prep_dir($filename);
	open(my $fd, '>', $filename)
	    or abend(EX_CANTCREAT, "can't open \"$filename\" for writing: $!");
	print $fd <<EOT;
<Macro LetsEncryptChallenge>
    Alias /.well-known/acme-challenge $www_root/.well-known/acme-challenge
    <Directory $www_root/.well-known/acme-challenge>
        Options None
        Require all granted
    </Directory>
</Macro>

<Macro LetsEncryptServer \$domain>
    ServerName \$domain
    SSLEngine on
    SSLProtocol all -SSLv2 -SSLv3
    SSLHonorCipherOrder on
    SSLCipherSuite EECDH+AES128:RSA+AES128:EECDH+AES256:RSA+AES256:EECDH+3DES:RSA+3DES:EECDH+RC4:RSA+RC4:!MD5
    SSLCertificateFile /etc/ssl/acme/\$domain/cert.pem
    SSLCertificateKeyFile /etc/ssl/acme/\$domain/privkey.pem
    SSLCACertificateFile /etc/ssl/acme/lets-encrypt-x3-cross-signed.pem
</Macro>
EOT
;
	close $fd;
	
	get_root_cert('/etc/ssl/acme/lets-encrypt-x3-cross-signed.pem');

	if (exists($apache_layout->{post_setup})) {
	    &{$apache_layout->{post_setup}}($filename);
	}
    }
    error("created file \"$filename\"", prefix => 'NOTE');
    error("please, enable mod_macro and make sure your Apache configuration includes this file", prefix => 'NOTE');
    exit(EX_OK);
}

my %apache_layout_tab = (
    slackware => { config => '/etc/httpd/httpd.conf',
		   incdir => '/etc/httpd/extra'
    },
    debian =>    { config  => '/etc/apache2/apache2.conf',
		   incdir  => sub {
		               for my $dir ('/etc/apache2/conf-available',
					    '/etc/apache2/conf.d') {
				   return $dir if -d $dir;
			       }
			       warn 'none of the expected configuration directories found; falling back to /etc/apache2';
			       return '/etc/apache2';
		              },
		   post_setup => sub {
		                   my ($filename) = @_;
				   my $dir = dirname($filename);
				   my $name = basename($filename);
		                   if ($dir eq '/etc/apache2/conf-available') {
				       chdir('/etc/apache2/conf-enabled');
				       symlink "../conf-available/$name", $name;
				   }
		   }
    },
    rh =>        { config => '/etc/httpd/conf/httpd.conf',
		   incdir => '/etc/httpd/conf.d'
    }
);

my $setup;

GetOptions("h" => sub {
                    pod2usage(-message => "$progname: $progdescr",
                              -exitstatus => EX_OK);
           },
           "help" => sub {
                    pod2usage(-exitstatus => EX_OK, -verbose => 2);
           },
           "usage" => sub {
                    pod2usage(-exitstatus => EX_OK, -verbose => 0);
           },
           "debug|d+" => \$debug,
           "dry-run|n" => \$dry_run,
           "force|F" => \$force,
           "time-delta|D=n" => \$time_delta,
	   "layout|l=s" => sub {
	       my ($opt, $arg) = @_;
	       abend(EX_USAGE, "unknown layout: $arg")
		   unless exists $apache_layout_tab{$arg};
	       $apache_layout = $apache_layout_tab{$arg};
	   },
	   "setup|s" => \$setup,
	   "config-file|f=s" => sub {
	       $apache_layout = { config => $_[1] }
	   }
) or exit(EX_USAGE);

if ($dry_run) {
    ++$debug;
    $acme_host = $acme_endpoint{staging};
} else {
    $acme_host = $acme_endpoint{prod};
}

unless (defined($apache_layout)) {
    while (my ($name, $layout) = each %apache_layout_tab) {
	if (-f $layout->{config}) {
	    debug(1, "assuming Apache layout \"$name\"");
	    $apache_layout = $layout;
	    last;
	}
    }
}

unless (defined($apache_layout)) {
    abend(EX_OSFILE, "no suitable apache configuration file found");
}

$server_root = dirname($apache_layout->{config});

if ($setup) {
    examine_http_config($apache_layout->{config}) or exit(EX_OSFILE);
    initial_setup
} else {
    @select{@ARGV} = (1) x @ARGV;
    examine_http_config($apache_layout->{config}) or exit(EX_OSFILE);
}
debug(1, "nothing to do") unless @virthost;

# Check challenge root directory
if (defined($www_root)) {
    prep_dir("$www_root/file");
} else {
    abend(EX_CONFIG, "ACME challenge root directory not defined");
}
# Check filename patterns
abend(EX_CONFIG, "filename patterns not defined")
    unless (defined($filename_arg) && defined($filename_pattern{cert}));

$account_key = Crypt::OpenSSL::RSA->generate_key(2048);
$challenge = Protocol::ACME::Challenge::LocalFile->new({www_root => $www_root});

foreach my $vhost (@virthost) {
    if ($force || domain_cert_expires(${$vhost}[0])) {
	register_domain_certificate(@$vhost);
    }
}