+#! /usr/bin/perl
+
+# 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/>.
+#
+# Copyright (C) 2016 - 2020 Raphaël Gertz <acme@rapsys.eu>
+
+# Best practice
+use strict;
+use warnings;
+
+# Load debug
+#BEGIN {
+# # Allow use of print Dumper($this);
+# use Data::Dumper;
+# # Prepend current directory in include array
+# # XXX: this will load ./Acme.pm instead of an other version from system tree
+# unshift @INC, '.';
+#}
+
+# Add acl support to file tests
+use filetest qw(access);
+
+# Load dependancies
+use Carp qw(carp confess);
+use File::Copy qw(copy);
+use File::stat qw(stat);
+use File::Slurp qw(read_file write_file);
+use File::Spec qw(splitpath curdir);
+use JSON qw(decode_json);
+use Net::DNS qw();
+use Net::Domain::TLD qw(tld_exists);
+use Tie::IxHash;
+use Acme;
+
+# Load POSIX
+use POSIX qw(EXIT_SUCCESS EXIT_FAILURE);
+
+# Init verbose
+my $verbose = 0;
+
+# Init debian
+my $debian = undef;
+
+# Init action
+my $action = undef;
+
+# Init config
+my $config = undef;
+#XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
+tie(%{$config}, 'Tie::IxHash');
+
+# Init content
+my $content = undef;
+
+# Init config file name
+my $configFilename = Acme::CONFIG;
+
+# Init domains
+my @domains = ();
+
+# Process verbose
+@ARGV = map { if ($_ eq '-v' or $_ eq '--verbose') { $verbose = 1; (); } else { $_; } } @ARGV;
+
+# Process debian
+@ARGV = map { if ($_ eq '-d' or $_ eq '--debian') { $debian = 1; (); } else { $_; } } @ARGV;
+
+# Process action
+unless(defined $ARGV[0] and $ARGV[0] =~ /^(cert|cron|conf)$/) {
+ print "Usage: $0 (cert|cron|conf) [-(v|-verbose)] [-(c|-config)[=/etc/acme/config]] [example.com] [...]\n";
+ exit EXIT_FAILURE;
+} else {
+ # Save action
+ $action = $ARGV[0];
+ # Remove it from args
+ splice(@ARGV, 0, 1);
+}
+
+# Process config and args
+for (my $i = 0; $i <= $#ARGV; $i++) {
+ # Match config args
+ if ($ARGV[$i] =~ /^(?:(\-c|\-\-config)(?:=(.+))?)$/) {
+ # Extract -c=$2 or --config=$2 syntax
+ if (defined($2)) {
+ $configFilename = $2;
+ splice(@ARGV, $i, 1);
+ $i--;
+ # Extract -c $ARGV[$i+1] or --config $ARGV[$i+1] writable status
+ } elsif (defined($ARGV[$i+1])) {
+ $configFilename = $ARGV[$i+1];
+ splice(@ARGV, $i, 2);
+ $i--;
+ # Check if cert or cron action
+ } elsif ($action eq 'cert' or $action eq 'cron') {
+ print "Usage: $0 $action [-(c|-config)[=/etc/acme/config]] [example.com] [...]\n";
+ exit EXIT_FAILURE;
+ }
+
+ # Check if file don't exists
+ if (defined($configFilename) and ! -f $configFilename) {
+ # Extract config directory and filename
+ my ($vol, $dir, $file) = File::Spec->splitpath($configFilename);
+
+ # Check dir
+ unless ($dir) {
+ # Set as current dir if empty
+ $dir = File::Spec->curdir();
+ }
+
+ # Verify that directory exists
+ unless (-d $dir) {
+ confess('Config directory '.$dir.' must exists: '.$!);
+ }
+
+ # Check that directory is writable
+ unless (-w $dir) {
+ confess('Config directory '.$dir.' must be writable: '.$!);
+ }
+ }
+ }
+}
+
+# Check if conf action
+if ($action eq 'conf') {
+ # Configure json
+ my $js = JSON->new->utf8->pretty(1)->space_before(0)->filter_json_object(
+ sub {
+ # Get source hash ref
+ my ($x) = @_;
+ # Init tied hash
+ #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
+ my $r = tie(my %r, 'Tie::IxHash');
+ # Ordered loop
+ map {
+ # Insert key if present
+ $r{$_} = $x->{$_} if (defined($x->{$_}));
+ #XXX: Hash keys not present in this array will be dropped
+ #XXX: Hash keys will be inserted in tied hash in this order
+ #} sort keys %{$x};
+ } (
+ # Root key order
+ 'thumbprint', 'term', 'pending', 'certificates',
+ # Domain key order
+ 'cert', 'key', 'account', 'mail', 'domain', 'domains', 'prod'
+ );
+ # Return the ordered hash
+ return \%r;
+ }
+ );
+
+ # Check we have specified domains
+ unless (scalar(@ARGV) > 0) {
+ print "Usage: $0 $action [-(v|-verbose)] [-(d|-debian)] [-(c|-config)[=/etc/acme/config]] example.com[=www.example.com[,ftp.example.com]] [...]\n";
+ exit EXIT_FAILURE;
+ }
+
+ # Load config
+ unless(
+ #XXX: use eval to workaround a fatal in decode_json
+ eval {
+ # Check file
+ (-f $configFilename) and
+ # Read it
+ ($content = read_file($configFilename)) and
+ # Decode it
+ ($config = $js->decode($content))
+ }
+ ) {
+ # Warn with verbose
+ carp('Config file '.$configFilename.' not readable or invalid: '.$!) if ($verbose);
+
+ # Create a default config
+ #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
+ tie(%{$config}, 'Tie::IxHash', 'thumbprint' => Acme::THUMBPRINT, 'term' => Acme::TERM, 'pending' => Acme::PENDING, 'certificates' => []);
+ } else {
+ # Fix root infos when missing
+ $config->{thumbprint} = Acme::THUMBPRINT unless(defined($config->{thumbprint}));
+ $config->{term} = Acme::TERM unless(defined($config->{term}));
+ $config->{pending} = Acme::PENDING unless(defined($config->{pending}));
+ $config->{certificates} = [] unless(defined($config->{certificates}) and ref($config->{certificates}) eq 'ARRAY');
+ }
+
+ # Iterate on each certificates entry
+ for (my $i = 0; $i <= $#{$config->{certificates}}; $i++) {
+ # Set certificate
+ my $certificate = ${$config->{certificates}}[$i];
+
+ # Drop the entry when missing domain key
+ unless (defined($certificate->{domain})) {
+ splice(@{$config->{certificates}}, $i, 1);
+ # Entry may be fixed
+ } else {
+ # Init replace
+ my $replace = undef;
+
+ # Tie replace
+ #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
+ tie(%{$replace}, 'Tie::IxHash', cert => Acme::RH_CERTS.'/'.$certificate->{domain}.Acme::RH_SUFFIX, key => Acme::RH_PRIVATE.'/'.$certificate->{domain}.Acme::RH_SUFFIX, account => Acme::ACCOUNT, mail => Acme::MAIL.'@'.$certificate->{domain}, 'domain' => $certificate->{domain}, 'domains' => [], prod => 0);
+ # Use debian path
+ if ($debian) {
+ $replace->{cert} = Acme::DEB_CERTS.'/'.$certificate->{domain}.Acme::DEB_CERTS_SUFFIX;
+ $replace->{key} = Acme::DEB_PRIVATE.'/'.$certificate->{domain}.Acme::DEB_PRIVATE_SUFFIX;
+ }
+
+ # Fix cert entry
+ $replace->{cert} = $certificate->{cert} if (defined($certificate->{cert}));
+
+ # Fix key entry
+ $replace->{key} = $certificate->{key} if (defined($certificate->{key}));
+
+ # Fix account entry
+ $replace->{account} = $certificate->{account} if (defined($certificate->{account}));
+
+ # Fix mail entry
+ $replace->{mail} = $certificate->{mail} if (defined($certificate->{mail}));
+
+ # Fix domains entry
+ $replace->{domains} = $certificate->{domains} if (defined($certificate->{domains}) and ref($certificate->{domains}) eq 'ARRAY');
+
+ # Fix prod entry
+ $replace->{prod} = $certificate->{prod} if (defined($certificate->{prod}));
+
+ # Replace certificate
+ ${$config->{certificates}}[$i] = $replace;
+ }
+ }
+
+ # Check that domains are present in config
+ map {
+ # Extract domain and domains
+ my ($domain, $domains) = split(/=/, $_);
+
+ # Transform domains
+ my @domains = defined($domains) ? map { $_ ? $_ : (); } split(/,/, $domains) : ();
+
+ # Check that domain
+ map {
+ my $tld;
+
+ # Extract tld
+ unless (($tld) = $_ =~ m/\.(\w+)$/) {
+ confess('Extract '.$_.' tld failed');
+ }
+
+ # Check if tld exists
+ unless(Net::Domain::TLD::tld_exists($tld)) {
+ confess('Extracted '.$_.' tld '.$tld.' do not exists');
+ }
+
+ # Search a record
+ my $a = Net::DNS::Resolver->new->search($_, 'A', 'IN');
+
+ # Search aaaa record
+ my $aaaa = Net::DNS::Resolver->new->search($_, 'AAAA', 'IN');
+
+ # Trigger error for unresolvable domain
+ unless (
+ # Check if either has a A or AAAA record
+ scalar map {
+ ($_->type eq 'A' or $_->type eq 'AAAA') ? 1 : ();
+ }
+ # Merge both answer
+ (
+ (defined $a and defined $a->answer) ? $a->answer : (),
+ (defined $aaaa and defined $aaaa->answer) ? $aaaa->answer : ()
+ )
+ ) {
+ confess('Resolve '.$_.' to an A or AAAA record failed');
+ }
+ } ($domain, @domains);
+
+ # Insert domain when missing
+ unless (scalar map { $_->{domain} eq $domain ? 1 : (); } @{$config->{certificates}}) {
+ # Init certificate
+ my $certificate = undef;
+
+ # Tie certificate
+ #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
+ tie(%{$certificate}, 'Tie::IxHash', cert => undef, key => undef, account => Acme::ACCOUNT, mail => Acme::MAIL.'@'.$domain, 'domain' => $domain, 'domains' => [], prod => 0);
+
+ # Use debian path
+ if ($debian) {
+ $certificate->{cert} = Acme::DEB_CERTS.'/'.$domain.Acme::DEB_CERTS_SUFFIX;
+ $certificate->{key} = Acme::DEB_PRIVATE.'/'.$domain.Acme::DEB_PRIVATE_SUFFIX;
+ # Use redhat path
+ } else {
+ $certificate->{cert} = Acme::RH_CERTS.'/'.$domain.Acme::RH_SUFFIX;
+ $certificate->{key} = Acme::RH_PRIVATE.'/'.$domain.Acme::RH_SUFFIX;
+ }
+
+ # Add domains
+ map {
+ # Set subdomain
+ my $subdomain = $_;
+
+ # Check if already present
+ unless (scalar map { $_ eq $subdomain ? 1 : (); } @{$certificate->{domains}}) {
+ # Add when not already present
+ ${$certificate->{domains}}[scalar @{$certificate->{domains}}] = $_;
+ }
+ } @domains;
+
+ # Append certificate
+ ${$config->{certificates}}[scalar @{$config->{certificates}}] = $certificate;
+ # Update domains when present
+ } else {
+ # Loop on all certificate
+ map {
+ # Check that we are on the right domain
+ if ($_->{domain} eq $domain) {
+ # Init certificate
+ my $certificate = $_;
+
+ # Reset domains
+ @{$certificate->{domains}} = ();
+
+ # Add domains
+ map {
+ # Set subdomain
+ my $subdomain = $_;
+
+ # Check if already present
+ unless (scalar map { $_ eq $subdomain ? 1 : (); } @{$certificate->{domains}}) {
+ # Add when not already present
+ ${$certificate->{domains}}[scalar @{$certificate->{domains}}] = $_;
+ }
+ } @domains;
+ }
+ } @{$config->{certificates}};
+ }
+ } @ARGV;
+
+ # Extract config directory and filename
+ my ($vol, $dir, $file) = File::Spec->splitpath($configFilename);
+
+ # Check dir
+ unless ($dir) {
+ # Set as current dir if empty
+ $dir = File::Spec->curdir();
+ }
+
+ # Backup old config if possible
+ if (-w $dir and -f $configFilename) {
+ my ($dt, $suffix) = undef;
+
+ # Extract datetime suffix
+ $suffix = ($dt = DateTime->from_epoch(epoch => stat($configFilename)->mtime))->ymd('').$dt->hms('');
+
+ # Rename old config
+ unless(copy($configFilename, $configFilename.'.'.$suffix)) {
+ carp('Copy '.$configFilename.' to '.$configFilename.'.'.$suffix.' failed: '.$!);
+ }
+ # Check that directory is writable
+ } elsif (! -w $dir and -f $configFilename) {
+ confess('Config directory '.$dir.' must be writable: '.$!);
+ }
+
+ # Encode config in json
+ #XXX: emulate a tab indent file by replacing 3 space indent with tab
+ ($content = $js->encode($config)) =~ s/(\G|^)\s{3}/\t/gm;
+
+ # Write to file
+ write_file($configFilename, $content);
+
+ # Exit with success
+ exit EXIT_FAILURE;
+# Check if cert or cron action
+} elsif ($action eq 'cert' or $action eq 'cron') {
+ # Validate config
+ unless (
+ #XXX: use eval to workaround a fatal in decode_json
+ eval {
+ # Check file
+ (-f $configFilename) and
+ # Read it
+ ($content = read_file($configFilename)) and
+ # Decode it
+ ($config = decode_json($content)) and
+ # Check certificates presence
+ defined($config->{certificates}) and
+ # Check certificates type
+ ref($config->{certificates}) eq 'ARRAY' and
+ # Check thumbprint presence
+ defined($config->{thumbprint}) and
+ # Check term presence
+ defined($config->{term}) and
+ # Check pending presence
+ defined($config->{pending}) and
+ # Check certificates array
+ ! scalar map {
+ unless(
+ defined($_->{cert}) and
+ defined($_->{key}) and
+ defined($_->{account}) and
+ defined($_->{mail}) and
+ defined($_->{domain}) and
+ defined($_->{domains}) and ref($_->{domains}) eq 'ARRAY' and
+ defined($_->{prod})
+ ) {
+ 1;
+ } else {
+ ();
+ }
+ } @{$config->{certificates}}
+ }
+ ) {
+ confess('Config file '.$configFilename.' not readable or invalid: '.$!);
+ }
+# Unknown action
+} else {
+ #TODO: implement the new action
+ confess('Unknown '.$action.' action');
+}
+
+# Deal with specified domains
+if (scalar(@ARGV) > 0) {
+ # Check that domains are present in config
+ foreach my $domain (@ARGV) {
+ my $found = undef;
+ foreach my $certificate (@{$config->{certificates}}) {
+ if ($certificate->{domain} eq $domain) {
+ push(@domains, $certificate);
+ $found = 1;
+ }
+ }
+ unless($found) {
+ print 'Domain '.$domain.' not found in config file '.$configFilename."\n";
+ exit EXIT_FAILURE;
+ }
+ }
+# Without it
+} else {
+ # Populate domains array with available ones
+ foreach my $certificate (@{$config->{certificates}}) {
+ push(@domains, $certificate);
+ }
+}
+
+# Show conf usage
+if (scalar(@domains) < 1) {
+ print "Usage: $0 conf [-(v|-verbose)] [-(d|-debian)] [-(c|-config)[=/etc/acme/config]] example.com[=www.example.com[,ftp.example.com]] [...]\n";
+ exit EXIT_FAILURE;
+}
+
+# Deal with each domain
+foreach my $domain (@domains) {
+ # Skip certificate, in cron action, issued within the last 60 days
+ if ($action eq 'cron' and -f $domain->{cert} and stat($domain->{cert})->mtime >= (time() - 60*24*3600)) {
+ carp('Domain '.$domain->{domain}.' certificate '.$domain->{cert}.' skipped') if ($verbose);
+ next;
+ }
+ # Create new object
+ my $acme = Acme->new($verbose, $domain, {thumbprint => $config->{thumbprint}, pending => $config->{pending}, term => $config->{term}});
+
+ # Prepare environement
+ $acme->prepare();
+
+ # Generate required keys
+ $acme->genKeys();
+
+ # Directory
+ $acme->directory();
+
+ # Nonce
+ $acme->nonce();
+
+ # Account
+ $acme->account();
+
+ # Order
+ $acme->order();
+
+ # Generate csr
+ $acme->genCsr();
+
+ # Issue
+ $acme->issue();
+}
+
+# Exit with success
+exit EXIT_SUCCESS;
Rapsys Git / acme / commitdiff