Raphaël G. Git Repositories - acme/blob - acme

   1 #! /usr/bin/perl
   2
   3 # This program is free software: you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation, either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15 #
  16 # Copyright (C) 2016 - 2020 Raphaël Gertz <acme@rapsys.eu>
  17
  18 # Best practice
  19 use strict;
  20 use warnings;
  21
  22 # Load debug
  23 #BEGIN {
  24 #       # Allow use of print Dumper($this);
  25 #       use Data::Dumper;
  26 #       # Prepend current directory in include array
  27 #       # XXX: this will load ./Acme.pm instead of an other version from system tree
  28 #       unshift @INC, '.';
  29 #}
  30
  31 # Add acl support to file tests
  32 use filetest qw(access);
  33
  34 # Load dependancies
  35 use Carp qw(carp confess);
  36 use File::Copy qw(copy);
  37 use File::stat qw(stat);
  38 use File::Slurp qw(read_file write_file);
  39 use File::Spec qw(splitpath curdir);
  40 use JSON qw(decode_json);
  41 use Net::DNS qw();
  42 use Net::Domain::TLD qw(tld_exists);
  43 use Tie::IxHash;
  44 use Acme;
  45
  46 # Load POSIX
  47 use POSIX qw(EXIT_SUCCESS EXIT_FAILURE);
  48
  49 # Init verbose
  50 my $verbose = 0;
  51
  52 # Init debian
  53 my $debian = undef;
  54
  55 # Init action
  56 my $action = undef;
  57
  58 # Init config
  59 my $config = undef;
  60 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
  61 tie(%{$config}, 'Tie::IxHash');
  62
  63 # Init content
  64 my $content = undef;
  65
  66 # Init config file name
  67 my $configFilename = Acme::CONFIG;
  68
  69 # Init domains
  70 my @domains = ();
  71
  72 # Process verbose
  73 @ARGV = map { if ($_ eq '-v' or $_ eq '--verbose') { $verbose = 1; (); } else { $_; } } @ARGV;
  74
  75 # Process debian
  76 @ARGV = map { if ($_ eq '-d' or $_ eq '--debian') { $debian = 1; (); } else { $_; } } @ARGV;
  77
  78 # Process action
  79 unless(defined $ARGV[0] and $ARGV[0] =~ /^(cert|cron|conf)$/) {
  80         print "Usage: $0 (cert|cron|conf) [-(v|-verbose)] [-(c|-config)[=/etc/acme/config]] [example.com] [...]\n";
  81         exit EXIT_FAILURE;
  82 } else {
  83         # Save action
  84         $action = $ARGV[0];
  85         # Remove it from args
  86         splice(@ARGV, 0, 1);
  87 }
  88
  89 # Process config and args
  90 for (my $i = 0; $i <= $#ARGV; $i++) {
  91         # Match config args
  92         if ($ARGV[$i] =~ /^(?:(\-c|\-\-config)(?:=(.+))?)$/) {
  93                 # Extract -c=$2 or --config=$2 syntax
  94                 if (defined($2)) {
  95                         $configFilename = $2;
  96                         splice(@ARGV, $i, 1);
  97                         $i--;
  98                 # Extract -c $ARGV[$i+1] or --config $ARGV[$i+1] writable status
  99                 } elsif (defined($ARGV[$i+1])) {
 100                         $configFilename = $ARGV[$i+1];
 101                         splice(@ARGV, $i, 2);
 102                         $i--;
 103                 # Check if cert or cron action
 104                 } elsif ($action eq 'cert' or $action eq 'cron') {
 105                         print "Usage: $0 $action [-(c|-config)[=/etc/acme/config]] [example.com] [...]\n";
 106                         exit EXIT_FAILURE;
 107                 }
 108
 109                 # Check if file don't exists
 110                 if (defined($configFilename) and ! -f $configFilename) {
 111                         # Extract config directory and filename
 112                         my ($vol, $dir, $file) = File::Spec->splitpath($configFilename);
 113
 114                         # Check dir
 115                         unless ($dir) {
 116                                 # Set as current dir if empty
 117                                 $dir = File::Spec->curdir();
 118                         }
 119
 120                         # Verify that directory exists
 121                         unless (-d $dir) {
 122                                 confess('Config directory '.$dir.' must exists: '.$!);
 123                         }
 124
 125                         # Check that directory is writable
 126                         unless (-w $dir) {
 127                                 confess('Config directory '.$dir.' must be writable: '.$!);
 128                         }
 129                 }
 130         }
 131 }
 132
 133 # Check if conf action
 134 if ($action eq 'conf') {
 135         # Configure json
 136         my $js = JSON->new->utf8->pretty(1)->space_before(0)->filter_json_object(
 137                 sub {
 138                         # Get source hash ref
 139                         my ($x) = @_;
 140                         # Init tied hash
 141                         #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 142                         my $r = tie(my %r, 'Tie::IxHash');
 143                         # Ordered loop
 144                         map {
 145                                 # Insert key if present
 146                                 $r{$_} = $x->{$_} if (defined($x->{$_}));
 147                         #XXX: Hash keys not present in this array will be dropped
 148                         #XXX: Hash keys will be inserted in tied hash in this order
 149                         #} sort keys %{$x};
 150                         } (
 151                                 # Root key order
 152                                 'thumbprint', 'term', 'pending', 'certificates',
 153                                 # Domain key order
 154                                 'cert', 'key', 'account', 'mail', 'domain', 'domains', 'prod'
 155                         );
 156                         # Return the ordered hash
 157                         return \%r;
 158                 }
 159         );
 160
 161         # Check we have specified domains
 162         unless (scalar(@ARGV) > 0) {
 163                 print "Usage: $0 $action [-(v|-verbose)] [-(d|-debian)] [-(c|-config)[=/etc/acme/config]] example.com[=www.example.com[,ftp.example.com]] [...]\n";
 164                 exit EXIT_FAILURE;
 165         }
 166
 167         # Load config
 168         unless(
 169                 #XXX: use eval to workaround a fatal in decode_json
 170                 eval {
 171                         # Check file
 172                         (-f $configFilename) and
 173                         # Read it
 174                         ($content = read_file($configFilename)) and
 175                         # Decode it
 176                         ($config = $js->decode($content))
 177                 }
 178         ) {
 179                 # Warn with verbose
 180                 carp('Config file '.$configFilename.' not readable or invalid: '.$!) if ($verbose);
 181
 182                 # Create a default config
 183                 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 184                 tie(%{$config}, 'Tie::IxHash', 'thumbprint' => Acme::THUMBPRINT, 'term' => Acme::TERM, 'pending' => Acme::PENDING, 'certificates' => []);
 185         } else {
 186                 # Fix root infos when missing
 187                 $config->{thumbprint} = Acme::THUMBPRINT unless(defined($config->{thumbprint}));
 188                 $config->{term} = Acme::TERM unless(defined($config->{term}));
 189                 $config->{pending} = Acme::PENDING unless(defined($config->{pending}));
 190                 $config->{certificates} = [] unless(defined($config->{certificates}) and ref($config->{certificates}) eq 'ARRAY');
 191         }
 192
 193         # Iterate on each certificates entry
 194         for (my $i = 0; $i <= $#{$config->{certificates}}; $i++) {
 195                 # Set certificate
 196                 my $certificate = ${$config->{certificates}}[$i];
 197
 198                 # Drop the entry when missing domain key
 199                 unless (defined($certificate->{domain})) {
 200                         splice(@{$config->{certificates}}, $i, 1);
 201                 # Entry may be fixed
 202                 } else {
 203                         # Init replace
 204                         my $replace = undef;
 205
 206                         # Tie replace
 207                         #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 208                         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);
 209                         # Use debian path
 210                         if ($debian) {
 211                                 $replace->{cert} = Acme::DEB_CERTS.'/'.$certificate->{domain}.Acme::DEB_CERTS_SUFFIX;
 212                                 $replace->{key} = Acme::DEB_PRIVATE.'/'.$certificate->{domain}.Acme::DEB_PRIVATE_SUFFIX;
 213                         }
 214
 215                         # Fix cert entry
 216                         $replace->{cert} = $certificate->{cert} if (defined($certificate->{cert}));
 217
 218                         # Fix key entry
 219                         $replace->{key} = $certificate->{key} if (defined($certificate->{key}));
 220
 221                         # Fix account entry
 222                         $replace->{account} = $certificate->{account} if (defined($certificate->{account}));
 223
 224                         # Fix mail entry
 225                         $replace->{mail} = $certificate->{mail} if (defined($certificate->{mail}));
 226
 227                         # Fix domains entry
 228                         $replace->{domains} = $certificate->{domains} if (defined($certificate->{domains}) and ref($certificate->{domains}) eq 'ARRAY');
 229
 230                         # Fix prod entry
 231                         $replace->{prod} = $certificate->{prod} if (defined($certificate->{prod}));
 232
 233                         # Replace certificate
 234                         ${$config->{certificates}}[$i] = $replace;
 235                 }
 236         }
 237
 238         # Check that domains are present in config
 239         map {
 240                 # Extract domain and domains
 241                 my ($domain, $domains) = split(/=/, $_);
 242
 243                 # Transform domains
 244                 my @domains = defined($domains) ? map { $_ ? $_ : (); } split(/,/, $domains) : ();
 245
 246                 # Check that domain
 247                 map {
 248                         my $tld;
 249
 250                         # Extract tld
 251                         unless (($tld) = $_ =~ m/\.(\w+)$/) {
 252                                 confess('Extract '.$_.' tld failed');
 253                         }
 254
 255                         # Check if tld exists
 256                         unless(Net::Domain::TLD::tld_exists($tld)) {
 257                                 confess('Extracted '.$_.' tld '.$tld.' do not exists');
 258                         }
 259
 260                         # Search a record
 261                         my $a = Net::DNS::Resolver->new->search($_, 'A', 'IN');
 262
 263                         # Search aaaa record
 264                         my $aaaa = Net::DNS::Resolver->new->search($_, 'AAAA', 'IN');
 265
 266                         # Trigger error for unresolvable domain
 267                         unless (
 268                                 # Check if either has a A or AAAA record
 269                                 scalar map {
 270                                         ($_->type eq 'A' or $_->type eq 'AAAA') ? 1 : ();
 271                                 }
 272                                 # Merge both answer
 273                                 (
 274                                         (defined $a and defined $a->answer) ? $a->answer : (),
 275                                         (defined $aaaa and defined $aaaa->answer) ? $aaaa->answer : ()
 276                                 )
 277                         ) {
 278                                 confess('Resolve '.$_.' to an A or AAAA record failed');
 279                         }
 280                 } ($domain, @domains);
 281
 282                 # Insert domain when missing
 283                 unless (scalar map { $_->{domain} eq $domain ? 1 : (); } @{$config->{certificates}}) {
 284                         # Init certificate
 285                         my $certificate = undef;
 286
 287                         # Tie certificate
 288                         #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 289                         tie(%{$certificate}, 'Tie::IxHash', cert => undef, key => undef, account => Acme::ACCOUNT, mail => Acme::MAIL.'@'.$domain, 'domain' => $domain, 'domains' => [], prod => 0);
 290
 291                         # Use debian path
 292                         if ($debian) {
 293                                 $certificate->{cert} = Acme::DEB_CERTS.'/'.$domain.Acme::DEB_CERTS_SUFFIX;
 294                                 $certificate->{key} = Acme::DEB_PRIVATE.'/'.$domain.Acme::DEB_PRIVATE_SUFFIX;
 295                         # Use redhat path
 296                         } else {
 297                                 $certificate->{cert} = Acme::RH_CERTS.'/'.$domain.Acme::RH_SUFFIX;
 298                                 $certificate->{key} = Acme::RH_PRIVATE.'/'.$domain.Acme::RH_SUFFIX;
 299                         }
 300
 301                         # Add domains
 302                         map {
 303                                 # Set subdomain
 304                                 my $subdomain = $_;
 305
 306                                 # Check if already present
 307                                 unless (scalar map { $_ eq $subdomain ? 1 : (); } @{$certificate->{domains}}) {
 308                                         # Add when not already present
 309                                         ${$certificate->{domains}}[scalar @{$certificate->{domains}}] = $_;
 310                                 }
 311                         } @domains;
 312
 313                         # Append certificate
 314                         ${$config->{certificates}}[scalar @{$config->{certificates}}] = $certificate;
 315                 # Update domains when present
 316                 } else {
 317                         # Loop on all certificate
 318                         map {
 319                                 # Check that we are on the right domain
 320                                 if ($_->{domain} eq $domain) {
 321                                         # Init certificate
 322                                         my $certificate = $_;
 323
 324                                         # Reset domains
 325                                         @{$certificate->{domains}} = ();
 326
 327                                         # Add domains
 328                                         map {
 329                                                 # Set subdomain
 330                                                 my $subdomain = $_;
 331
 332                                                 # Check if already present
 333                                                 unless (scalar map { $_ eq $subdomain ? 1 : (); } @{$certificate->{domains}}) {
 334                                                         # Add when not already present
 335                                                         ${$certificate->{domains}}[scalar @{$certificate->{domains}}] = $_;
 336                                                 }
 337                                         } @domains;
 338                                 }
 339                         } @{$config->{certificates}};
 340                 }
 341         } @ARGV;
 342
 343         # Extract config directory and filename
 344         my ($vol, $dir, $file) = File::Spec->splitpath($configFilename);
 345
 346         # Check dir
 347         unless ($dir) {
 348                 # Set as current dir if empty
 349                 $dir = File::Spec->curdir();
 350         }
 351
 352         # Backup old config if possible
 353         if (-w $dir and -f $configFilename) {
 354                 my ($dt, $suffix) = undef;
 355
 356                 # Extract datetime suffix
 357                 $suffix = ($dt = DateTime->from_epoch(epoch => stat($configFilename)->mtime))->ymd('').$dt->hms('');
 358
 359                 # Rename old config
 360                 unless(copy($configFilename, $configFilename.'.'.$suffix)) {
 361                         carp('Copy '.$configFilename.' to '.$configFilename.'.'.$suffix.' failed: '.$!);
 362                 }
 363         # Check that directory is writable
 364         } elsif (! -w $dir and -f $configFilename) {
 365                 confess('Config directory '.$dir.' must be writable: '.$!);
 366         }
 367
 368         # Encode config in json
 369         #XXX: emulate a tab indent file by replacing 3 space indent with tab
 370         ($content = $js->encode($config)) =~ s/(\G|^)\s{3}/\t/gm;
 371
 372         # Write to file
 373         write_file($configFilename, $content);
 374
 375         # Exit with success
 376         exit EXIT_FAILURE;
 377 # Check if cert or cron action
 378 } elsif ($action eq 'cert' or $action eq 'cron') {
 379         # Validate config
 380         unless (
 381                 #XXX: use eval to workaround a fatal in decode_json
 382                 eval {
 383                         # Check file
 384                         (-f $configFilename) and
 385                         # Read it
 386                         ($content = read_file($configFilename)) and
 387                         # Decode it
 388                         ($config = decode_json($content)) and
 389                         # Check certificates presence
 390                         defined($config->{certificates}) and
 391                         # Check certificates type
 392                         ref($config->{certificates}) eq 'ARRAY' and
 393                         # Check thumbprint presence
 394                         defined($config->{thumbprint}) and
 395                         # Check term presence
 396                         defined($config->{term}) and
 397                         # Check pending presence
 398                         defined($config->{pending}) and
 399                         # Check certificates array
 400                         ! scalar map {
 401                                 unless(
 402                                         defined($_->{cert}) and
 403                                         defined($_->{key}) and
 404                                         defined($_->{account}) and
 405                                         defined($_->{mail}) and
 406                                         defined($_->{domain}) and
 407                                         defined($_->{domains}) and ref($_->{domains}) eq 'ARRAY' and
 408                                         defined($_->{prod})
 409                                 ) {
 410                                         1;
 411                                 } else {
 412                                         ();
 413                                 }
 414                         } @{$config->{certificates}}
 415                 }
 416         ) {
 417                 confess('Config file '.$configFilename.' not readable or invalid: '.$!);
 418         }
 419 # Unknown action
 420 } else {
 421         #TODO: implement the new action
 422         confess('Unknown '.$action.' action');
 423 }
 424
 425 # Deal with specified domains
 426 if (scalar(@ARGV) > 0) {
 427         # Check that domains are present in config
 428         foreach my $domain (@ARGV) {
 429                 my $found = undef;
 430                 foreach my $certificate (@{$config->{certificates}}) {
 431                         if ($certificate->{domain} eq $domain) {
 432                                 push(@domains, $certificate);
 433                                 $found = 1;
 434                         }
 435                 }
 436                 unless($found) {
 437                         print 'Domain '.$domain.' not found in config file '.$configFilename."\n";
 438                         exit EXIT_FAILURE;
 439                 }
 440         }
 441 # Without it
 442 } else {
 443         # Populate domains array with available ones
 444         foreach my $certificate (@{$config->{certificates}}) {
 445                 push(@domains, $certificate);
 446         }
 447 }
 448
 449 # Show conf usage
 450 if (scalar(@domains) < 1) {
 451         print "Usage: $0 conf [-(v|-verbose)] [-(d|-debian)] [-(c|-config)[=/etc/acme/config]] example.com[=www.example.com[,ftp.example.com]] [...]\n";
 452         exit EXIT_FAILURE;
 453 }
 454
 455 # Deal with each domain
 456 foreach my $domain (@domains) {
 457         # Skip certificate, in cron action, issued within the last 60 days
 458         if ($action eq 'cron' and -f $domain->{cert} and stat($domain->{cert})->mtime >= (time() - 60*24*3600)) {
 459                 carp('Domain '.$domain->{domain}.' certificate '.$domain->{cert}.' skipped') if ($verbose);
 460                 next;
 461         }
 462         # Create new object
 463         my $acme = Acme->new($verbose, $domain, {thumbprint => $config->{thumbprint}, pending => $config->{pending}, term => $config->{term}});
 464
 465         # Prepare environement
 466         $acme->prepare();
 467
 468         # Generate required keys
 469         $acme->genKeys();
 470
 471         # Directory
 472         $acme->directory();
 473
 474         # Nonce
 475         $acme->nonce();
 476
 477         # Account
 478         $acme->account();
 479
 480         # Order
 481         $acme->order();
 482
 483         # Generate csr
 484         $acme->genCsr();
 485
 486         # Issue
 487         $acme->issue();
 488 }
 489
 490 # Exit with success
 491 exit EXIT_SUCCESS;