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

   1 # This file is part of Acmepl
   2 #
   3 # Acmepl is 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 - 2017 Raphaël Gertz <acme@rapsys.eu>
  17
  18 # Acme package
  19 package Acme;
  20
  21 # Best practice
  22 use strict;
  23 use warnings;
  24
  25 # Add acl support to file tests
  26 use filetest qw(access);
  27
  28 # Symbol export
  29 use Exporter;
  30 our @ISA = qw(Exporter);
  31 our @EXPORT_OK = qw(ACCOUNT CONFIG MAIL PENDING TERM THUMBPRINT VERSION);
  32
  33 # Load dependancies
  34 use Carp qw(carp confess);
  35 use Date::Parse qw(str2time);
  36 use DateTime;
  37 use Digest::SHA qw(sha256_base64);
  38 use Email::Valid;
  39 use File::Copy qw(copy);
  40 use File::Path qw(make_path);
  41 use File::Slurp qw(read_file write_file);
  42 use File::Spec qw(splitpath);
  43 use File::stat qw(stat);
  44 use File::Temp; # qw( :seekable );
  45 use IPC::System::Simple qw(capturex);
  46 use JSON qw(from_json to_json);
  47 use LWP;
  48 use MIME::Base64 qw(encode_base64url encode_base64);
  49 use Net::DNS qw();
  50 use Net::Domain::TLD qw(tld_exists);
  51 use POSIX qw(EXIT_FAILURE);
  52 use Tie::IxHash;
  53
  54 # Load debug
  55 #use Data::Dumper;
  56
  57 # Documentation links
  58 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
  59 #XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt
  60 #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js
  61
  62 # Set constants
  63 use constant {
  64         # Config infos
  65         ACCOUNT => '/etc/acme/account.pem',
  66         CONFIG => '/etc/acme/config',
  67         PENDING => '/tmp/acme',
  68         THUMBPRINT => '/etc/acme/thumbprint',
  69         TERM => 'https://letsencrypt.org/documents/LE-SA-v1.2-November-15-2017.pdf',
  70         MAIL => 'webmaster',
  71
  72         # Certificate info
  73         CSR_SUFFIX => '.der',
  74
  75         # Redhat infos
  76         RH_CERTS => '/etc/pki/tls/certs',
  77         RH_PRIVATE => '/etc/pki/tls/private',
  78         RH_SUFFIX => '.pem',
  79
  80         # Debian infos
  81         DEB_CERTS => '/etc/ssl/certs',
  82         DEB_PRIVATE => '/etc/ssl/private',
  83         DEB_CERTS_SUFFIX => '.crt',
  84         DEB_PRIVATE_SUFFIX => '.key',
  85
  86         # Dns infos
  87         DNS_PREFIX => '_acme-challenge.',
  88         DNS_SUFFIX => '.',
  89
  90         # Key infos
  91         KEY_TYPE => 'rsa',
  92         KEY_SIZE => 4096,
  93
  94         # Acme infos
  95         #ACME_CERT => 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem',
  96         ACME_DIR => 'https://acme-staging-v02.api.letsencrypt.org/directory',
  97         ACME_PROD_DIR => 'https://acme-v02.api.letsencrypt.org/directory',
  98
  99         # Version
 100         VERSION => '2.0.0',
 101
 102         # Timeout
 103         TIMEOUT => 300
 104 };
 105
 106 # User agent object
 107 our $ua;
 108
 109 # Strerr backup
 110 our $_stderr;
 111
 112 # JSON Web Key (JWK)
 113 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 114 #our %jwk = (
 115 #       pubkey => undef,
 116 #       jwk => {
 117 #               alg => 'RS256',
 118 #               jwk => {
 119 #                       # Exponent
 120 #                       e => undef,
 121 #                       # Key type
 122 #                       kty => uc(KEY_TYPE),
 123 #                       # Modulus
 124 #                       n => undef
 125 #               }
 126 #       },
 127 #       thumbprint => undef
 128 #);
 129 tie(our %jwk, 'Tie::IxHash', pubkey => undef, jwk => undef, thumbprint => undef);
 130 tie(%{$jwk{jwk}}, 'Tie::IxHash', alg => 'RS256', jwk => undef);
 131 #XXX: strict ordering only really needed here for thumbprint sha256 digest
 132 tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => undef);
 133
 134 # Constructor
 135 sub new {
 136         # Extract params
 137         my ($class, $verbose, $domain, $config) = @_;
 138
 139         # Create self hash
 140         my $self = {};
 141
 142         # Link self to package
 143         bless($self, $class);
 144
 145         # Save verbose
 146         $self->{verbose} = $verbose;
 147
 148         # Save domain
 149         $self->{domain} = $domain;
 150
 151         # Save config
 152         $self->{config} = $config;
 153
 154         # Save domains
 155         my @domains = ($domain->{domain}, @{$domain->{domains}});
 156
 157         # Show error if check fail
 158         unless (defined $self->{domain}{mail}) {
 159                 confess('Missing mail');
 160         }
 161
 162         # Transform mail in an array
 163         unless (ref($self->{domain}{mail}) eq 'ARRAY') {
 164                 $self->{domain}{mail} = [ $self->{domain}{mail} ];
 165         }
 166
 167         # Add extra check to mail validity
 168         #XXX: mxcheck fail if there is only a A record on the domain
 169         my $ev = Email::Valid->new(-fqdn => 1, -tldcheck => 1, -mxcheck => 1);
 170
 171         # Loop on each mail
 172         map {
 173                 # Checke address
 174                 if (! defined $ev->address($_)) {
 175                         map { carp 'failed check: '.$_ if ($self->{verbose}) } $ev->details();
 176                         confess('Validate '.$_.' mail address failed');
 177                 }
 178         } @{$self->{domain}{mail}};
 179
 180         # Check domains
 181         map {
 182                 my $tld;
 183
 184                 # Extract tld
 185                 unless (($tld) = $_ =~ m/\.(\w+)$/) {
 186                         confess('Extract '.$_.' tld failed');
 187                 }
 188
 189                 # Check if tld exists
 190                 unless(Net::Domain::TLD::tld_exists($tld)) {
 191                         confess('Extracted '.$_.' tld '.$tld.' do not exists');
 192                 }
 193
 194                 # Search a record
 195                 my $a = Net::DNS::Resolver->new->search($_, 'A', 'IN');
 196
 197                 # Search aaaa record
 198                 my $aaaa = Net::DNS::Resolver->new->search($_, 'AAAA', 'IN');
 199
 200                 # Trigger error for unresolvable domain
 201                 unless (
 202                         # Check if either has a A or AAAA record
 203                         scalar map {
 204                                 ($_->type eq 'A' or $_->type eq 'AAAA') ? 1 : ();
 205                         }
 206                         # Merge both answer
 207                         (
 208                                 (defined $a and defined $a->answer) ? $a->answer : (),
 209                                 (defined $aaaa and defined $aaaa->answer) ? $aaaa->answer : ()
 210                         )
 211                 ) {
 212                         confess('Resolve '.$_.' to an A or AAAA record failed');
 213                 }
 214         } @domains;
 215
 216         # Return class reference
 217         return $self;
 218 }
 219
 220 # Prepare environement
 221 sub prepare {
 222         my ($self) = @_;
 223
 224         # Extract cert directory and filename
 225         my ($certFile, $certDir) = File::Spec->splitpath($self->{domain}{cert});
 226
 227         # Extract key directory and filename
 228         my ($keyFile, $keyDir) = File::Spec->splitpath($self->{domain}{key});
 229
 230         # Extract account directory and filename
 231         my ($accountFile, $accountDir) = File::Spec->splitpath($self->{domain}{account});
 232
 233         # Create all paths
 234         {
 235                 make_path($certDir, $keyDir, $accountDir, $self->{config}{pending}, {error => \my $err});
 236                 if (@$err) {
 237                         map {
 238                                 my ($file, $msg) = %{$_};
 239                                 carp 'Mkdir '.($file ? $file.' ' : '').'failed: '.$msg if ($self->{verbose});
 240                         } @$err;
 241                         confess('Make path failed');
 242                 }
 243         }
 244
 245         # Create user agent
 246         $ua = LWP::UserAgent->new;
 247         $ua->agent(__PACKAGE__.'/'.VERSION);
 248
 249         # Check that certificate is writable
 250         unless (-w $certDir || -w $self->{domain}{cert}) {
 251                 confess('Directory '.$certDir.' or file '.$self->{domain}{cert}.' must be writable: '.$!);
 252         }
 253
 254         # Check that key is readable or parent directory is writable
 255         unless (-r $self->{domain}{key} || -w $keyDir) {
 256                 confess('File '.$self->{domain}{key}.' must be readable or directory '.$keyDir.' must be writable: '.$!);
 257         }
 258
 259         # Check that account key is readable or parent directory is writable
 260         unless (-r $self->{domain}{account} || -w $accountDir) {
 261                 confess('File '.$self->{domain}{account}.' must be readable or directory '.$accountDir.' must be writable: '.$!);
 262         }
 263
 264         # Backup old certificate if possible
 265         if (-w $certDir && -f $self->{domain}{cert}) {
 266                 my ($dt, $suffix) = undef;
 267
 268                 # Extract datetime suffix
 269                 $suffix = ($dt = DateTime->from_epoch(epoch => stat($self->{domain}{cert})->mtime))->ymd('').$dt->hms('');
 270
 271                 # Rename old certificate
 272                 unless(copy($self->{domain}{cert}, $self->{domain}{cert}.'.'.$suffix)) {
 273                         carp('Copy '.$self->{domain}{cert}.' to '.$self->{domain}{cert}.'.'.$suffix.' failed: '.$!);
 274                 }
 275         }
 276 }
 277
 278 # Drop stderr
 279 sub _dropStdErr {
 280         # Save stderr
 281         open($_stderr, '>&STDERR') or die $!;
 282         # Close it
 283         close(STDERR) or die $!;
 284         # Send to /dev/null
 285         open(STDERR, '>', '/dev/null') or die $!;
 286 }
 287
 288 # Restore stderr
 289 sub _restoreStdErr {
 290         # Close stderr
 291         close(STDERR);
 292         # Open it back
 293         open(STDERR, '>&', $_stderr) or die $!;
 294 }
 295
 296 # Generate required keys
 297 sub genKeys {
 298         my ($self) = @_;
 299
 300         # Generate account and server key if required
 301         map {
 302                 # Check key existence
 303                 if (! -f $_) {
 304                         # Drop stderr
 305                         _dropStdErr();
 306                         # Generate key
 307                         #XXX: we drop stderr here because openssl can't be quiet on this command
 308                         capturex('openssl', ('genrsa', '-out', $_, KEY_SIZE));
 309                         # Restore stderr
 310                         _restoreStdErr();
 311                 }
 312         } ($self->{domain}{account}, $self->{domain}{key});
 313
 314         # Extract modulus and publicExponent jwk
 315         #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 316         tie(%{$self->{account}}, 'Tie::IxHash', %jwk);
 317         map {
 318                 if (/^Modulus=([0-9A-F]+)$/) {
 319                         # Extract to binary from hex and convert to base64 url
 320                         $self->{account}{jwk}{jwk}{n} = encode_base64url(pack("H*", $1) =~ s/^\0+//r);
 321                 } elsif (/^publicExponent:\s([0-9]+)\s\(0x[0-1]+\)$/) {
 322                         # Extract to binary from int, trim leading zeros and convert to base64 url
 323                         chomp ($self->{account}{jwk}{jwk}{e} = encode_base64url(pack("N", $1) =~ s/^\0+//r));
 324                 }
 325         } capturex('openssl', ('rsa', '-text', '-in', $self->{domain}{account}, '-noout', '-modulus'));
 326
 327         # Drop stderr
 328         _dropStdErr();
 329         # Extract account public key
 330         $self->{account}{pubkey} = join('', map { chomp; $_; } capturex('openssl', ('rsa', '-in', $self->{domain}{account}, '-pubout')));
 331         # Restore stderr
 332         _restoreStdErr();
 333
 334         # Store thumbprint
 335         #XXX: convert base64 to base64 url
 336         $self->{account}{thumbprint} = (sha256_base64(to_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r;
 337 }
 338
 339 # Directory call
 340 sub directory {
 341         my ($self) = @_;
 342
 343         # Set time
 344         my $time = time;
 345
 346         # Set directory
 347         my $dir = $self->{domain}{prod} ? ACME_PROD_DIR : ACME_DIR;
 348
 349         # Create a request
 350         my $req = HTTP::Request->new(GET => $dir.'?'.$time);
 351
 352         # Get request
 353         my $res = $ua->request($req);
 354
 355         # Handle error
 356         unless ($res->is_success) {
 357                 confess('GET '.$dir.'?'.$time.' failed: '.$res->status_line);
 358         }
 359
 360         # Init content
 361         my %content;
 362
 363         # Extract content
 364         unless (%content = %{from_json($res->content)}) {
 365                 confess('GET '.$dir.'?'.$time.' from_json failed: '.$res->status_line);
 366         }
 367
 368         # Merge uris in self content
 369         $self->{req}{dir} = $dir;
 370         $self->{req}{keyChange} = $content{keyChange};
 371         $self->{req}{newNonce} = $content{newNonce};
 372         $self->{req}{newAccount} = $content{newAccount};
 373         $self->{req}{revokeCert} = $content{revokeCert};
 374         $self->{req}{newOrder} = $content{newOrder};
 375
 376         # Check term
 377         unless ($self->{config}{term} eq $content{meta}{termsOfService}) {
 378                 confess('GET '.$dir.'?'.$time.' term: '.$content{meta}{termsOfService}.' differ from config: '.$self->{config}{term});
 379         }
 380 }
 381
 382 # Nonce call
 383 sub nonce {
 384         my ($self) = @_;
 385
 386         # Set time
 387         my $time = time;
 388
 389         # Create a request
 390         my $req = HTTP::Request->new(HEAD => $self->{req}{newNonce}.'?'.$time);
 391
 392         # Get request
 393         my $res = $ua->request($req);
 394
 395         # Handle error
 396         unless ($res->is_success) {
 397                 confess('HEAD '.$self->{req}{newNonce}.'?'.$time.' failed: '.$res->status_line);
 398         }
 399
 400         # Save nonce
 401         $self->{req}{nonce} = $res->headers->{'replay-nonce'};
 402 }
 403
 404 # Post request
 405 sub _post {
 406         my ($self, $uri, $payload) = @_;
 407
 408         # Init protected
 409         #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 410         #XXX: strict ordering only really needed here for thumbprint sha256 digest
 411         tie(my %protected, 'Tie::IxHash', alg => $self->{account}{jwk}{alg}, jwk => $self->{account}{jwk}{jwk}, nonce => $self->{req}{nonce}, url => $uri);
 412
 413         # We have a kid
 414         if (defined($self->{req}{kid})) {
 415                 # Replace jwk entry with it
 416                 #XXX: when kid is available all request with jwk are rejected by the api
 417                 %protected = (alg => $self->{account}{jwk}{alg}, kid => $self->{req}{kid}, nonce => $self->{req}{nonce}, url => $uri);
 418         }
 419
 420         # Encode protected
 421         my $protected = encode_base64url(to_json(\%protected));
 422
 423         # Encode payload
 424         $payload = encode_base64url(to_json($payload)) unless ($payload eq '');
 425
 426         # Sign temp file
 427         my $stf = File::Temp->new();
 428
 429         # Append protect.payload to stf
 430         print $stf $protected.'.'.$payload;
 431
 432         # Close stf
 433         close($stf);
 434
 435         # Generate digest of stf
 436         my $signature = encode_base64url(join('', capturex('openssl', ('dgst', '-sha256', '-binary', '-sign', $self->{domain}{account}, $stf->filename))) =~ s/^\0+//r);
 437
 438         # Create a request
 439         my $req = HTTP::Request->new(POST => $uri);
 440
 441         # Set request header
 442         $req->header('Content-Type' => 'application/jose+json');
 443
 444         # Set new-reg request content
 445         $req->content(to_json({
 446                 protected => $protected,
 447                 payload => $payload,
 448                 signature => $signature
 449         }));
 450
 451         # Post request
 452         my $res = $ua->request($req);
 453
 454         # Save nonce
 455         if (defined $res->headers->{'replay-nonce'}) {
 456                 $self->{req}{nonce} = $res->headers->{'replay-nonce'};
 457         }
 458
 459         # Return res object
 460         return $res;
 461 }
 462
 463 # Resolve dns and check content
 464 #XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example
 465 sub _dnsCheck {
 466         my ($self, $domain, $token) = @_;
 467
 468         # Generate signature from content
 469         my $signature = ((sha256_base64($token.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r;
 470
 471         # Search txt record
 472         my $txt = Net::DNS::Resolver->new->search(DNS_PREFIX.$domain.DNS_SUFFIX, 'TXT', 'IN');
 473
 474         # Check that we have a txt record
 475         unless (defined $txt and defined $txt->answer and scalar map { $_->type eq 'TXT' ? 1 : (); } $txt->answer) {
 476                 carp 'Resolve '.DNS_PREFIX.$domain.DNS_SUFFIX.' to a TXT record failed' if ($self->{verbose});
 477                 return;
 478         }
 479
 480         # Check that txt record data match signature
 481         unless (scalar map { ($_->type eq 'TXT' and $_->txtdata eq $signature) ? 1 : (); } $txt->answer) {
 482                 # Check verbose
 483                 if ($self->{verbose}) {
 484                         # Loop on each answer
 485                         map {
 486                                 # Check if we have a TXT record with different value
 487                                 if ($_->type eq 'TXT' and $_->txtdata ne $signature) {
 488                                         carp 'Resolved '.DNS_PREFIX.$domain.DNS_SUFFIX.' with "'.$_->txtdata.'" instead of "'.$signature.'"';
 489                                 }
 490                         } $txt->answer;
 491                 }
 492                 return;
 493         }
 494
 495         # Return success
 496         return 1;
 497 }
 498
 499 # Get uri and check content
 500 sub _httpCheck {
 501         my ($self, $domain, $token) = @_;
 502
 503         # Create a request
 504         my $req = HTTP::Request->new(GET => 'http://'.$domain.'/.well-known/acme-challenge/'.$token);
 505
 506         # Check if thumbprint is writeable
 507         if (-w $self->{config}{thumbprint}) {
 508                 # Try to write thumbprint
 509                 write_file($self->{config}{thumbprint}, $self->{account}{thumbprint});
 510         }
 511
 512         # Get request
 513         my $res = $ua->request($req);
 514
 515         # Handle error
 516         unless ($res->is_success) {
 517                 carp 'Fetch http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{verbose});
 518                 return;
 519         }
 520
 521         # Handle invalid content
 522         unless($res->content =~ /^$token.$self->{account}{thumbprint}\s*$/) {
 523                 carp 'Fetched http://'.$domain.'/.well-known/acme-challenge/'.$token.' with "'.$res->content.'" instead of "'.$token.'.'.$self->{account}{thumbprint}.'"' if ($self->{verbose});
 524                 return;
 525         }
 526
 527         # Return success
 528         return 1;
 529 }
 530
 531 # Register account
 532 #XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3
 533 sub account {
 534         my ($self) = @_;
 535
 536         # Init pending directory
 537         $self->{req}{pending} = $self->{config}{pending}.'/'.encode_base64url($self->{req}{dir}).'/'.encode_base64url(join(',', @{$self->{domain}{mail}}));
 538
 539         # Create pending directory
 540         {
 541                 make_path($self->{req}{pending}, {error => \my $err});
 542                 if (@$err) {
 543                         map {
 544                                 my ($file, $msg) = %{$_};
 545                                 carp 'Mkdir '.($file ? $file.' ' : '').'failed: '.$msg if ($self->{verbose});
 546                         } @$err;
 547                         confess('Make path failed');
 548                 }
 549         }
 550
 551         # Init file
 552         #XXX: we use this file to store the fetched account
 553         my $file = $self->{req}{pending}.'/'.(((sha256_base64(join(',', @{$self->{domain}{mail}}))) =~ s/=+\z//r) =~ tr[+/][-_]r);
 554
 555         # Init content
 556         my $content = undef;
 557
 558         # Load account content or post a new one
 559         if (
 560                 #XXX: use eval to workaround a fatal in from_json
 561                 ! defined eval {
 562                         # Check that file exists
 563                         -f $file &&
 564                         # Read it
 565                         ($content = read_file($file)) &&
 566                         # Decode it
 567                         ($content = from_json($content))
 568                 }
 569         ) {
 570                 # Init tied payload
 571                 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 572                 tie(my %payload, 'Tie::IxHash', termsOfServiceAgreed => JSON::true, contact => []);
 573
 574                 # Loop on mails
 575                 map {
 576                         # Append mail to payload
 577                         $payload{contact}[scalar @{$payload{contact}}] = 'mailto:'.$_;
 578                 } @{$self->{domain}{mail}};
 579
 580                 # Post newAccount request
 581                 # TODO: change contact field in config to contain directly the array [mailto:example@example.com,...] ???
 582                 #XXX: contact array may contain a tel:+33612345678 for example (supported ???)
 583                 my $res = $self->_post($self->{req}{'newAccount'}, \%payload);
 584
 585                 # Handle error
 586                 unless ($res->is_success) {
 587                         confess('POST '.$self->{req}{'newAccount'}.' failed: '.$res->status_line)
 588                 }
 589
 590                 # Store kid from header location
 591                 $content = {
 592                         'kid' => $res->headers->{location},
 593                 };
 594
 595                 # Write to file
 596                 write_file($file, to_json($content));
 597         }
 598
 599         # Set kid from content
 600         $self->{req}{kid} = $content->{kid};
 601
 602 }
 603
 604 # Authorize domains
 605 sub order {
 606         my ($self) = @_;
 607
 608         # Init file
 609         #XXX: we use this file to store the requested domains on our side
 610         #XXX: see bug https://github.com/letsencrypt/boulder/issues/3335 and https://community.letsencrypt.org/t/acmev2-orders-list/51662
 611         my $file = $self->{req}{pending}.'/'.(((sha256_base64(join(',', ($self->{domain}{domain}, @{$self->{domain}{domains}})))) =~ s/=+\z//r) =~ tr[+/][-_]r);
 612
 613         # Init content
 614         my $content = undef;
 615
 616         # Load account content or post a new one
 617         if (
 618                 #XXX: use eval to workaround a fatal in from_json
 619                 ! defined eval {
 620                         # Check that file exists
 621                         -f $file &&
 622                         # Read it
 623                         ($content = read_file($file)) &&
 624                         # Decode it
 625                         ($content = from_json($content))
 626                 # Check expiration
 627                 } || (str2time($content->{expires}) <= time()+3600)
 628         ) {
 629                 # Init tied payload
 630                 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 631                 #XXX: https://www.perlmonks.org/?node_id=1215976
 632                 #XXX: optional notBefore, notAfter, see https://ietf-wg-acme.github.io/acme/draft-ietf-acme-acme.html#applying-for-certificate-issuance
 633                 tie(my %payload, 'Tie::IxHash', identifiers => []);
 634
 635                 # Loop on domains
 636                 map {
 637                         # Tie in a stable hash and append to identifiers array
 638                         #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 639                         tie(%{$payload{identifiers}[scalar @{$payload{identifiers}}]}, 'Tie::IxHash', type => 'dns', value => $_);
 640                 } ($self->{domain}{domain}, @{$self->{domain}{domains}});
 641
 642                 # Post new order request
 643                 my $res = $self->_post($self->{req}{'newOrder'}, \%payload);
 644
 645                 # Handle error
 646                 unless ($res->is_success) {
 647                         confess('POST '.$self->{req}{'newOrder'}.' failed: '.$res->status_line);
 648                 }
 649
 650                 # Handle error
 651                 unless ($res->content) {
 652                         confess('POST '.$self->{req}{'newOrder'}.' empty content: '.$res->status_line);
 653                 }
 654
 655                 # Handle error
 656                 unless ($res->headers->{location}) {
 657                         confess('POST '.$self->{req}{'newOrder'}.' missing location: '.$res->status_line);
 658                 }
 659
 660                 # Extract content
 661                 $content = from_json($res->content);
 662
 663                 # Write to file
 664                 write_file($file, to_json($content));
 665         }
 666
 667         # Save the authorizations
 668         $self->{req}{authorizations} = [ keys %{{ map { $_ => undef } @{$content->{authorizations}} }} ];
 669
 670         # Save the finalize uri
 671         $self->{req}{finalize} = $content->{finalize};
 672
 673         # Create challenges hash
 674         %{$self->{req}{challenges}} = ();
 675
 676         # Extract authorizations
 677         map {
 678                 # Init uri
 679                 my $uri = $_;
 680
 681                 # Init content
 682                 my $content = undef;
 683
 684                 # Init file
 685                 #XXX: tmpdir.'/'.<orderuri>.'/'.<authuri>
 686                 my $file = $self->{req}{pending}.'/'.encode_base64url($uri);
 687
 688                 # Load auth request content or post a new one
 689                 #TODO: add more check on cache file ???
 690                 if (
 691                         #XXX: use eval to workaround a fatal in from_json
 692                         ! defined eval {
 693                                 # Check that file exists
 694                                 -f $file &&
 695                                 # Read it
 696                                 ($content = read_file($file)) &&
 697                                 # Decode it
 698                                 ($content = from_json($content))
 699                         # Check expiration
 700                         } || (str2time($content->{expires}) <= time()+3600)
 701                 ) {
 702                         # Post new-authz request
 703                         my $res = $self->_post($uri, '');
 704
 705                         # Handle error
 706                         unless ($res->is_success) {
 707                                 confess('POST '.$uri.' failed: '.$res->status_line);
 708                         }
 709
 710                         # Decode content
 711                         $content = from_json($res->content);
 712
 713                         # Check identifier
 714                         unless (
 715                                 defined $content->{identifier} and
 716                                 defined $content->{identifier}{type} and
 717                                 defined $content->{identifier}{value}
 718                         ) {
 719                                 confess('POST '.$uri.' missing identifier: '.$res->status_line);
 720                         } else {
 721                                 unless (
 722                                         $content->{identifier}{type} eq 'dns' and
 723                                         $content->{identifier}{value}
 724                                 ) {
 725                                         confess('POST '.$uri.' invalid identifier: '.$res->status_line);
 726                                 }
 727                         }
 728
 729                         # Check status
 730                         unless ($content->{status} eq 'valid' or $content->{status} eq 'pending') {
 731                                 confess('POST '.$uri.' for '.$content->{identifier}{value}.' failed: '.$res->status_line);
 732                         }
 733
 734                         # Write to file
 735                         write_file($file, to_json($content));
 736                 }
 737
 738                 # Add challenge
 739                 %{$self->{req}{challenges}{$content->{identifier}{value}}} = (
 740                         status => $content->{status},
 741                         expires => $content->{expires},
 742                         challenges => {},
 743                         polls => {}
 744                 );
 745
 746                 # Extract challenges
 747                 map {
 748                         # Save if valid
 749                         if ($_->{status} eq 'valid') {
 750                                 $self->{req}{challenges}{$content->{identifier}{value}}{status} = $_->{status};
 751                         # Check is still polling
 752                         } elsif ($content->{status} eq 'pending') {
 753                                 # Add to challenges list for later use
 754                                 $self->{req}{challenges}{$content->{identifier}{value}}{challenges}{$_->{type}} = {
 755                                         status => $_->{status},
 756                                         token => $_->{token},
 757                                         url => $_->{url}
 758                                 };
 759                         }
 760                 } @{$content->{challenges}};
 761
 762                 # Set identifier
 763                 my $identifier = $content->{identifier}{value};
 764
 765                 # Save pending data
 766                 if ($self->{req}{challenges}{$identifier}{status} eq 'pending') {
 767                         # Check challenges
 768                         map {
 769                                 # One test already validated this auth request
 770                                 unless($self->{req}{challenges}{$identifier}{status} eq 'valid') {
 771                                         # One challenge validated
 772                                         if ($self->{req}{challenges}{$identifier}{challenges}{$_}{status} eq 'valid') {
 773                                                 $self->{req}{challenges}{$identifier}{status} = $self->{req}{challenges}{$identifier}{challenges}{$_}{status};
 774                                         # This challenge is to be validated
 775                                         } elsif ($self->{req}{challenges}{$identifier}{challenges}{$_}{status} eq 'pending') {
 776                                                 #TODO: implement tls-alpn-01 challenge someday if possible
 777                                                 if (
 778                                                         ($_ eq 'http-01' and $self->_httpCheck($identifier, $self->{req}{challenges}{$identifier}{challenges}{$_}{token})) or
 779                                                         ($_ eq 'dns-01' and $self->_dnsCheck($identifier, $self->{req}{challenges}{$identifier}{challenges}{$_}{token}))
 780                                                 ) {
 781                                                         # Init file
 782                                                         #XXX: tmpdir.'/'.<orderuri>.'/'.<authuri>
 783                                                         my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url});
 784
 785                                                         # Reset content
 786                                                         $content = undef;
 787
 788                                                         # Load auth request content or post a new one
 789                                                         #TODO: add more check on cache file ???
 790                                                         if (
 791                                                                 #XXX: use eval to workaround a fatal in from_json
 792                                                                 ! defined eval {
 793                                                                         # Check that file exists
 794                                                                         -f $file &&
 795                                                                         # Read it
 796                                                                         ($content = read_file($file)) &&
 797                                                                         # Decode it
 798                                                                         ($content = from_json($content))
 799                                                                 #TODO: Check file modification time ? There is no expires field in json answer
 800                                                                 }# || (str2time($content->{expires}) <= time()+3600)
 801                                                         ) {
 802                                                                 # Post challenge request
 803                                                                 my $res = $self->_post(
 804                                                                         $self->{req}{challenges}{$identifier}{challenges}{$_}{url},
 805                                                                         {keyAuthorization => $self->{req}{challenges}{$identifier}{challenges}{$_}{token}.'.'.$self->{account}{thumbprint}}
 806                                                                 );
 807
 808                                                                 # Handle error
 809                                                                 unless ($res->is_success) {
 810                                                                         confess('POST '.$self->{req}{challenges}{$identifier}{challenges}{$_}{url}.' failed: '.$res->status_line);
 811                                                                 }
 812
 813                                                                 # Extract content
 814                                                                 $content = from_json($res->content);
 815
 816                                                                 # Write to file
 817                                                                 write_file($file, to_json($content));
 818                                                         }
 819
 820                                                         # Save if valid
 821                                                         if ($content->{status} eq 'valid') {
 822                                                                 $self->{req}{challenges}{$identifier}{status} = $content->{status};
 823                                                         # Check is still polling
 824                                                         } elsif ($content->{status} eq 'pending') {
 825                                                                 # Add to poll list for later use
 826                                                                 $self->{req}{challenges}{$identifier}{polls}{$content->{type}} = 1;
 827                                                         }
 828                                                 }
 829                                         }
 830                                 }
 831                         } keys %{$self->{req}{challenges}{$identifier}{challenges}};
 832
 833                         # Check if check is challenge still in pending and no polls
 834                         if ($self->{req}{challenges}{$identifier}{status} eq 'pending' && scalar keys %{$self->{req}{challenges}{$identifier}{polls}} == 0) {
 835                                 # Loop on all remaining challenges
 836                                 map {
 837                                         #TODO: implement tls-alpn-01 challenge someday if possible
 838                                         # Display help for http-01 check
 839                                         if ($_ eq 'http-01') {
 840                                                 print STDERR 'Require URI http://'.$identifier.'/.well-known/acme-challenge/'.$self->{req}{challenges}{$identifier}{challenges}{$_}{token}.' with "'.$self->{req}{challenges}{$identifier}{challenges}{$_}{token}.'.'.$self->{account}{thumbprint}.'"'."\n";
 841                                         # Display help for dns-01 check
 842                                         } elsif ($_ eq 'dns-01') {
 843                                                 print STDERR 'Require TXT record _acme-challenge.'.$identifier.'. with "'.(((sha256_base64($self->{req}{challenges}{$identifier}{challenges}{$_}{token}.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r).'"'."\n";
 844                                         }
 845                                 } keys %{$self->{req}{challenges}{$identifier}{challenges}};
 846                         }
 847                 }
 848         } @{$self->{req}{authorizations}};
 849
 850         # Init max run
 851         my $remaining = TIMEOUT;
 852
 853         # Poll pending
 854         while (--$remaining >= 0 and scalar map { ($_->{status} eq 'pending' and scalar keys %{$_->{polls}}) ? 1 : (); } values %{$self->{req}{challenges}}) {
 855                 # Sleep
 856                 sleep(1);
 857
 858                 # Poll remaining pending
 859                 map {
 860                         # Init identifier
 861                         my $identifier = $_;
 862
 863                         # Poll remaining polls
 864                         map {
 865                                 # Post challenge request
 866                                 #XXX: no cache here we force update
 867                                 my $res = $self->_post(
 868                                         $self->{req}{challenges}{$identifier}{challenges}{$_}{url},
 869                                         {keyAuthorization => $self->{req}{challenges}{$identifier}{challenges}{$_}{token}.'.'.$self->{account}{thumbprint}}
 870                                 );
 871
 872                                 # Handle error
 873                                 unless ($res->is_success) {
 874                                         confess('POST '.$self->{req}{challenges}{$identifier}{challenges}{$_}{url}.' failed: '.$res->status_line);
 875                                 }
 876
 877                                 # Extract content
 878                                 $content = from_json($res->content);
 879
 880                                 # Init file
 881                                 #XXX: tmpdir.'/'.<orderuri>.'/'.<authuri>
 882                                 my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url});
 883
 884                                 # Write to file
 885                                 write_file($file, to_json($content));
 886
 887                                 # Save status
 888                                 if ($content->{status} ne 'pending') {
 889                                         $self->{req}{challenges}{$identifier}{status} = $content->{status};
 890                                 }
 891                         } keys %{$self->{req}{challenges}{$identifier}{polls}};
 892                 } map { $self->{req}{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{req}{challenges}};
 893         }
 894
 895
 896         # Check if thumbprint is writeable
 897         if (-w $self->{config}{thumbprint}) {
 898                 # Try to write thumbprint
 899                 write_file($self->{config}{thumbprint}, '');
 900         }
 901
 902         # Stop here with remaining challenge
 903         if (scalar map { $_->{status} ne 'valid' ? 1 : (); } values %{$self->{req}{challenges}}) {
 904                 #TODO: Deactivate all activated domains ?
 905                 #XXX: see if implemented by letsencrypt ACMEv2
 906                 #map {
 907                 #       # Post deactivation request
 908                 #       my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'});
 909                 #       # Handle error
 910                 #       unless ($res->is_success) {
 911                 #               confess('POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line);
 912                 #       }
 913                 #} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
 914
 915                 # Stop here as a domain of csr list failed authorization
 916                 if ($self->{verbose}) {
 917                         my @domains = map { $self->{req}{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{req}{challenges}};
 918                         #my @domains = map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}};
 919                         carp 'Fix challenge'.(scalar @domains > 1?'s':'').' for: '.join(', ', @domains);
 920                 }
 921                 exit EXIT_FAILURE;
 922         }
 923 }
 924
 925 # Generate certificate request
 926 sub genCsr {
 927         my ($self) = @_;
 928
 929         # Init csr file
 930         #XXX: tmpdir.'/'.<orderuri>.'/'.<thumbprint>.':'.<mail>.':'.join(',', @domains).'.<prodstaging>.'.CSR_SUFFIX
 931         $self->{req}{csr} = $self->{req}{pending}.'/'.(((sha256_base64(join(',', ($self->{domain}{domain}, @{$self->{domain}{domains}})))) =~ s/=+\z//r) =~ tr[+/][-_]r).CSR_SUFFIX;
 932
 933         # Reuse certificate request file without domain/mail change
 934         if (! -f $self->{req}{csr}) {
 935                 # Openssl config template
 936                 my $oct = File::Temp->new(UNLINK => 0);
 937
 938                 # Save data start position
 939                 my $pos = tell DATA;
 940
 941                 # Init counter
 942                 my $i = 0;
 943
 944                 # Prepare mail
 945                 my $mail = join("\n", map { $i++.'.emailAddress'."\t\t\t".'= '.$_; } @{$self->{domain}{mail}});
 946
 947                 # Load template from data
 948                 map { s/__EMAIL_ADDRESS__/$mail/; s/__COMMON_NAME__/$self->{domain}{domain}/; print $oct $_; } <DATA>;
 949
 950                 # Reseek data
 951                 seek(DATA, $pos, 0);
 952
 953                 # Append domain names
 954                 $i = 0;
 955                 map { print $oct 'DNS.'.$i++.' = '.$_."\n"; } ($self->{domain}{domain}, @{$self->{domain}{domains}});
 956
 957                 # Generate csr
 958                 #XXX: read certificate request with: openssl req -inform DER -in $self->{req}{csr} -text
 959                 capturex('openssl', ('req', '-new', '-outform', 'DER', '-key', $self->{domain}{key}, '-config', $oct->filename, '-out', $self->{req}{csr}));
 960
 961                 # Close oct
 962                 close($oct);
 963         }
 964 }
 965
 966 # Issue certificate
 967 sub issue {
 968         my ($self) = @_;
 969
 970         # Open csr file
 971         open(my $fh, '<', $self->{req}{csr}) or die $!;
 972
 973         # Load csr
 974         my $csr = encode_base64url(join('', <$fh>) =~ s/^\0+//r);
 975
 976         # Close csr file
 977         close($fh) or die $!;
 978
 979         # Init file
 980         #XXX: tmpdir.'/'.<orderuri>.'/'.<finalizeuri>
 981         my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{finalize});
 982
 983         # Init content
 984         my $content = undef;
 985
 986         # Init res
 987         my $res = undef;
 988
 989         # Load auth request content or post a new one
 990         #TODO: add more check on cache file ???
 991         if (
 992                 #XXX: use eval to workaround a fatal in from_json
 993                 ! defined eval {
 994                         # Check that file exists
 995                         -f $file &&
 996                         # Read it
 997                         ($content = read_file($file)) &&
 998                         # Decode it
 999                         ($content = from_json($content))
1000                 # Check file modification time ? There is no expires field in json answer
1001                 } || (str2time($content->{expires}) <= time()+3600)
1002         ) {
1003                 # Post certificate request
1004                 $res = $self->_post($self->{req}{finalize}, {csr => $csr});
1005
1006                 # Handle error
1007                 unless ($res->is_success) {
1008                         confess('POST '.$self->{req}{finalize}.' failed: '.$res->status_line);
1009                 }
1010
1011                 # Extract content
1012                 $content = from_json($res->content);
1013
1014                 # Check status
1015                 unless (defined $content->{status} and $content->{status} eq 'valid') {
1016                         confess('POST '.$self->{req}{finalize}.' failed: invalid status: '.(defined $content->{status}?$content->{status}:'undefined'));
1017                 }
1018
1019                 # Check certificate
1020                 unless (defined $content->{certificate} and $content->{certificate}) {
1021                         confess('POST '.$self->{req}{finalize}.' failed: invalid certificate: '.(defined $content->{certificate}?$content->{certificate}:'undefined'));
1022                 }
1023
1024                 # Write to file
1025                 write_file($file, to_json($content));
1026         }
1027
1028         # Set certificate
1029         $self->{req}{certificate} = $content->{certificate};
1030
1031         # Set file
1032         #XXX: tmpdir.'/'.<orderuri>.'/'.<certificateuri>
1033         $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{certificate});
1034
1035         # Reset content
1036         $content = undef;
1037
1038         # Load auth request content or post a new one
1039         #TODO: add more check on cache file ???
1040         if (
1041                 #XXX: use eval to workaround a fatal in from_json
1042                 ! defined eval {
1043                         # Check that file exists
1044                         -f $file &&
1045                         # Read it
1046                         ($content = read_file($file))
1047                 # Check file modification time ? There is no expires field in json answer
1048                 #TODO: add a checck on modification time ???
1049                 }# || (str2time($content->{expires}) <= time()+3600)
1050         ) {
1051                 # Post certificate request
1052                 $res = $self->_post($self->{req}{certificate}, '');
1053
1054                 # Handle error
1055                 unless ($res->is_success) {
1056                         confess('POST '.$self->{req}{certificate}.' failed: '.$res->status_line);
1057                 }
1058
1059                 # Set content
1060                 $content = $res->content;
1061
1062                 # Remove multi-line jump
1063                 $content =~ s/\n\n/\n/;
1064
1065                 # Remove trailing line jump
1066                 chomp $content;
1067
1068                 # Write to file
1069                 write_file($file, $content);
1070         }
1071
1072         # Write to cert file
1073         write_file($self->{domain}{cert}, $content);
1074
1075         # Print success
1076         carp 'Saved '.$self->{domain}{cert}.' pem certificate' if ($self->{verbose});
1077 }
1078
1079 1;
1080
1081 __DATA__
1082 #
1083 # OpenSSL configuration file.
1084 # This is mostly being used for generation of certificate requests.
1085 #
1086
1087 [ req ]
1088 default_bits            = 2048
1089 default_md              = sha256
1090 prompt                  = no
1091 distinguished_name      = req_distinguished_name
1092 # The extentions to add to the self signed cert
1093 x509_extensions = v3_ca
1094 # The extensions to add to a certificate request
1095 req_extensions = v3_req
1096
1097 # This sets a mask for permitted string types. There are several options.
1098 # utf8only: only UTF8Strings (PKIX recommendation after 2004).
1099 # WARNING: ancient versions of Netscape crash on BMPStrings or UTF8Strings.
1100 string_mask = utf8only
1101
1102 [ req_distinguished_name ]
1103 countryName                     = US
1104 stateOrProvinceName             = State or Province Name
1105 localityName                    = Locality Name
1106 organizationName                = Organization Name
1107 organizationalUnitName          = Organizational Unit Name
1108 commonName                      = __COMMON_NAME__
1109 __EMAIL_ADDRESS__
1110
1111 [ v3_req ]
1112 basicConstraints = CA:false
1113 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
1114 subjectAltName = email:move
1115 subjectAltName = @alt_names
1116
1117 [ v3_ca ]
1118 subjectKeyIdentifier = hash
1119 authorityKeyIdentifier = keyid:always,issuer
1120 basicConstraints = CA:true
1121
1122 [alt_names]