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 # Fix use of acl
  26 use filetest qw(access);
  27
  28 # Symbol export
  29 use Exporter;
  30 our @ISA = qw(Exporter);
  31 our @EXPORT_OK = qw(VERSION);
  32
  33 # Load dependancies
  34 use Carp qw(carp confess);
  35 use Date::Parse qw(str2time);
  36 use Digest::SHA qw(sha256_base64);
  37 use Email::Valid;
  38 use File::Copy qw(copy);
  39 use File::Path qw(make_path);
  40 use File::Slurp qw(read_file write_file);
  41 use File::Temp; # qw( :seekable );
  42 use IPC::System::Simple qw(capturex);
  43 use JSON qw(from_json to_json);
  44 use LWP;
  45 use MIME::Base64 qw(encode_base64url encode_base64);
  46 use Net::Domain::TLD;
  47 use POSIX qw(EXIT_FAILURE);
  48 use Tie::IxHash;
  49
  50 # Debug
  51 use Data::Dumper;
  52
  53 # Documentation links
  54 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
  55 #XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt
  56 #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js
  57
  58 # Set constants
  59 use constant {
  60         # Request certificate file name
  61         REQUEST_CSR => 'request.der',
  62
  63         # rsa
  64         KEY_TYPE => 'rsa',
  65
  66         # 2048|4096
  67         KEY_SIZE => 4096,
  68
  69         # Acme infos
  70         ACME_CERT => 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem',
  71         ACME_DIR => 'https://acme-staging.api.letsencrypt.org/directory',
  72         ACME_PROD_DIR => 'https://acme-v01.api.letsencrypt.org/directory',
  73
  74         # Version
  75         VERSION => 'v0.8',
  76 };
  77
  78 # User agent object
  79 our $ua;
  80
  81 # Strerr backup
  82 our $_stderr;
  83
  84 # JSON Web Key (JWK)
  85 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
  86 #our %jwk = (
  87 #       pubkey => undef,
  88 #       jwk => {
  89 #               alg => 'RS256',
  90 #               jwk => {
  91 #                       # Exponent
  92 #                       e => undef,
  93 #                       # Key type
  94 #                       kty => uc(KEY_TYPE),
  95 #                       # Modulus
  96 #                       n => undef
  97 #               }
  98 #       },
  99 #       thumbprint => undef
 100 #);
 101 tie(our %jwk, 'Tie::IxHash', pubkey => undef, jwk => undef, thumbprint => undef);
 102 tie(%{$jwk{jwk}}, 'Tie::IxHash', alg => 'RS256', jwk => undef);
 103 #XXX: strict ordering only really needed here for thumbprint sha256 digest
 104 tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => undef);
 105
 106 # Constructor
 107 sub new {
 108         # Extract params
 109         my ($class, $debug, $domain, $config) = @_;
 110
 111         # Create self hash
 112         my $self = {};
 113
 114         # Link self to package
 115         bless($self, $class);
 116
 117         # Save debug
 118         $self->{debug} = $debug;
 119
 120         # Save domain
 121         $self->{domain} = $domain;
 122
 123         # Save config
 124         $self->{config} = $config;
 125
 126         # Save domains
 127         @{$self->{domains}} = ($domain->{domain}, @{$domain->{domains}});
 128
 129         # Add extra check to mail validity
 130         #XXX: mxcheck fail if there is only a A record on the domain
 131         my $ev = Email::Valid->new(-fqdn => 1, -tldcheck => 1, -mxcheck => 1);
 132
 133         # Show error if check fail
 134         if (! defined $ev->address($self->{domain}{mail})) {
 135                 map { carp 'failed check: '.$_ if ($self->{debug}) } $ev->details();
 136                 confess 'Email::Valid->address failed';
 137         }
 138
 139         # Save mail
 140         $self->{mail} = $self->{domain}{mail};
 141
 142         # Create resolver
 143         my $res = new Net::DNS::Resolver();
 144
 145         # Check domains
 146         map {
 147                 my $tld;
 148
 149                 # Extract tld
 150                 unless (($tld) = $_ =~ m/\.(\w+)$/) {
 151                         confess $_.'\'s tld extraction failed';
 152                 }
 153
 154                 # Check if tld exists
 155                 unless(Net::Domain::TLD::tld_exists($tld)) {
 156                         confess $tld.' tld from '.$_.' don\'t exists';
 157                 }
 158
 159                 # Check if we get dns answer
 160                 #XXX: only search A type because letsencrypt don't support ipv6 (AAAA) yet
 161                 unless(my $rep = $res->search($_, 'A')) {
 162                         confess 'search A record for '.$_.' failed';
 163                 } else {
 164                         unless (scalar map { $_->type eq 'A' ? 1 : (); } $rep->answer) {
 165                                 confess 'search recursively A record for '.$_.' failed';
 166                         }
 167                 }
 168         } @{$self->{domains}};
 169
 170         # Return class reference
 171         return $self;
 172 }
 173
 174 # Prepare environement
 175 sub prepare {
 176         my ($self) = @_;
 177
 178         # Extract cert directory and filename
 179         my ($certFile, $certDir) = File::Spec->splitpath($self->{domain}{cert});
 180
 181         # Extract key directory and filename
 182         my ($keyFile, $keyDir) = File::Spec->splitpath($self->{domain}{key});
 183
 184         # Extract account directory and filename
 185         my ($accountFile, $accountDir) = File::Spec->splitpath($self->{domain}{account});
 186
 187         # Create all paths
 188         {
 189                 make_path($certDir, $keyDir, $accountDir, $self->{config}{pending}.'/'.$self->{mail}.'.'.($self->{domain}{prod} ? 'prod' : 'staging'), {error => \my $err});
 190                 if (@$err) {
 191                         map {
 192                                 my ($file, $msg) = %$_;
 193                                 carp ($file eq '' ? '' : $file.': ').$msg if ($self->{debug});
 194                         } @$err;
 195                         confess 'make_path failed';
 196                 }
 197         }
 198
 199         # Create user agent
 200         $ua = LWP::UserAgent->new;
 201         $ua->agent(__PACKAGE__.'/'.VERSION);
 202
 203         # Check that certificate is writable
 204         unless (-w $certDir || -w $self->{domain}{cert}) {
 205                 confess('Directory '.$certDir.' or file '.$self->{domain}{cert}.' must be writable: '.$!);
 206         }
 207
 208         # Check that key is writable
 209         unless (-r $self->{domain}{key} || -w $keyDir) {
 210                 confess('File '.$self->{domain}{key}.' must be readable or directory '.$keyDir.' must be writable: '.$!);
 211         }
 212
 213         # Check that account is writable
 214         unless (-r $self->{domain}{account} || -w $accountDir) {
 215                 confess('File '.$self->{domain}{account}.' must be readable or directory '.$accountDir.' must be writable: '.$!);
 216         }
 217
 218         # Backup old certificate if possible
 219         if (-w $certDir && -f $self->{domain}{cert}) {
 220                 my ($dt, $suffix) = undef;
 221
 222                 # Extract datetime suffix
 223                 $suffix = ($dt = DateTime->from_epoch(epoch => stat($self->{domain}{cert})->mtime))->ymd('').$dt->hms('');
 224
 225                 # Rename old certificate
 226                 unless(copy($self->{domain}{cert}, $self->{domain}{cert}.'.'.$suffix)) {
 227                         carp('Copy '.$self->{domain}{cert}.' to '.$self->{domain}{cert}.'.'.$suffix.' failed: '.$!);
 228                 }
 229         }
 230 }
 231
 232 # Drop stderr
 233 sub _dropStdErr {
 234         # Save stderr
 235         open($_stderr, '>&STDERR') or die $!;
 236         # Close it
 237         close(STDERR) or die $!;
 238         # Send to /dev/null
 239         open(STDERR, '>', '/dev/null') or die $!;
 240 }
 241
 242 # Restore stderr
 243 sub _restoreStdErr {
 244         # Close stderr
 245         close(STDERR);
 246         # Open it back
 247         open(STDERR, '>&', $_stderr) or die $!;
 248 }
 249
 250 # Generate required keys
 251 sub genKeys {
 252         my ($self) = @_;
 253
 254         # Generate account and server key if required
 255         map {
 256                 # Check key existence
 257                 if (! -f $_) {
 258                         # Drop stderr
 259                         _dropStdErr();
 260                         # Generate key
 261                         #XXX: we drop stderr here because openssl can't be quiet on this command
 262                         capturex('openssl', ('genrsa', '-out', $_, KEY_SIZE));
 263                         # Restore stderr
 264                         _restoreStdErr();
 265                 }
 266         } ($self->{domain}{account}, $self->{domain}{key});
 267
 268         # Extract modulus and publicExponent jwk
 269         #XXX: same here we tie to keep ordering
 270         tie(%{$self->{account}}, 'Tie::IxHash', %jwk);
 271         map {
 272                 if (/^Modulus=([0-9A-F]+)$/) {
 273                         # Extract to binary from hex and convert to base64 url
 274                         $self->{account}{jwk}{jwk}{n} = encode_base64url(pack("H*", $1) =~ s/^\0+//r);
 275                 } elsif (/^publicExponent:\s([0-9]+)\s\(0x[0-1]+\)$/) {
 276                         # Extract to binary from int, trim leading zeros and convert to base64 url
 277                         chomp ($self->{account}{jwk}{jwk}{e} = encode_base64url(pack("N", $1) =~ s/^\0+//r));
 278                 }
 279         } capturex('openssl', ('rsa', '-text', '-in', $self->{domain}{account}, '-noout', '-modulus'));
 280
 281         # Drop stderr
 282         _dropStdErr();
 283         # Extract account public key
 284         $self->{account}{pubkey} = join('', map { chomp; $_; } capturex('openssl', ('rsa', '-in', $self->{domain}{account}, '-pubout')));
 285         # Restore stderr
 286         _restoreStdErr();
 287
 288         # Store thumbprint
 289         #XXX: convert base64 to base64 url
 290         $self->{account}{thumbprint} = (sha256_base64(to_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r;
 291 }
 292
 293 # Generate certificate request
 294 sub genCsr {
 295         my ($self) = @_;
 296
 297         # Openssl config template
 298         my $oct = File::Temp->new();
 299
 300         # Save data start position
 301         my $pos = tell DATA;
 302
 303         # Load template from data
 304         map { s/__EMAIL_ADDRESS__/$self->{mail}/; s/__COMMON_NAME__/$self->{domains}[0]/; print $oct $_; } <DATA>;
 305
 306         # Reseek data
 307         seek(DATA, $pos, 0);
 308
 309         # Append domain names
 310         my $i = 1;
 311         map { print $oct 'DNS.'.$i++.' = '.$_."\n"; } @{$self->{domains}};
 312
 313         # Generate csr
 314         capturex('openssl', ('req', '-new', '-outform', 'DER', '-key', $self->{domain}{key}, '-config', $oct->filename, '-out', $self->{config}{pending}.'/'.$self->{mail}.'.'.($self->{domain}{prod} ? 'prod' : 'staging').'/'.REQUEST_CSR));
 315
 316         # Close oct
 317         close($oct);
 318 }
 319
 320 # Directory call
 321 sub directory {
 322         my ($self) = @_;
 323
 324         # Set time
 325         my $time = time;
 326
 327         # Set directory
 328         my $dir = $self->{prod} ? ACME_PROD_DIR : ACME_DIR;
 329
 330         # Create a request
 331         my $req = HTTP::Request->new(GET => $dir.'?'.$time);
 332
 333         # Get request
 334         my $res = $ua->request($req);
 335
 336         # Handle error
 337         unless ($res->is_success) {
 338                 confess 'GET '.$dir.'?'.$time.' failed: '.$res->status_line;
 339         }
 340
 341         # Save nonce
 342         $self->{nonce} = $res->headers->{'replay-nonce'};
 343
 344         # Merge uris in self content
 345         %$self = (%$self, %{from_json($res->content)});
 346 }
 347
 348 # Post request
 349 sub _post {
 350         my ($self, $uri, $payload) = @_;
 351
 352         # Protected field
 353         my $protected = encode_base64url(to_json({nonce => $self->{nonce}}));
 354
 355         # Payload field
 356         $payload = encode_base64url(to_json($payload));
 357
 358         # Sign temp file
 359         my $stf = File::Temp->new();
 360
 361         # Append protect.payload to stf
 362         print $stf $protected.'.'.$payload;
 363
 364         # Close stf
 365         close($stf);
 366
 367         # Generate digest of stf
 368         my $signature = encode_base64url(join('', capturex('openssl', ('dgst', '-sha256', '-binary', '-sign', $self->{domain}{account}, $stf->filename))) =~ s/^\0+//r);
 369
 370         # Create a request
 371         my $req = HTTP::Request->new(POST => $uri);
 372
 373         # Set new-reg request content
 374         $req->content(to_json({
 375                 header => $self->{account}{jwk},
 376                 protected => $protected,
 377                 payload => $payload,
 378                 signature => $signature
 379         }));
 380
 381         # Post request
 382         my $res = $ua->request($req);
 383
 384         # Save nonce
 385         if (defined $res->headers->{'replay-nonce'}) {
 386                 $self->{nonce} = $res->headers->{'replay-nonce'};
 387         }
 388
 389         # Return res object
 390         return $res;
 391 }
 392
 393 # Resolve dns and check content
 394 #XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example
 395 sub _dnsCheck {
 396         my ($self, $domain, $token) = @_;
 397
 398         # Generate signature from content
 399         my $signature = ((sha256_base64($token.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r;
 400
 401         # Fix domain
 402         $domain = '_acme-challenge.'.$domain.'.';
 403
 404         # Create resolver
 405         my $res = new Net::DNS::Resolver();
 406
 407         # Check if we get dns answer
 408         unless(my $rep = $res->search($domain, 'TXT')) {
 409                 carp 'TXT record search for '.$domain.' failed' if ($self->{debug});
 410                 return;
 411         } else {
 412                 unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) {
 413                         carp 'TXT record recursive search for '.$domain.' failed' if ($self->{debug});
 414                         return;
 415                 }
 416         }
 417
 418         return 1;
 419 }
 420
 421 # Get uri and check content
 422 sub _httpCheck {
 423         my ($self, $domain, $token) = @_;
 424
 425         # Create a request
 426         my $req = HTTP::Request->new(GET => 'http://'.$domain.'/.well-known/acme-challenge/'.$token);
 427
 428         # Check if thumbprint is writeable
 429         if (-w $self->{config}{thumbprint}) {
 430                 # Try to write thumbprint
 431                 write_file($self->{config}{thumbprint}, $self->{account}{thumbprint});
 432         }
 433
 434         # Get request
 435         my $res = $ua->request($req);
 436
 437         # Handle error
 438         unless ($res->is_success) {
 439                 carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{debug});
 440                 return;
 441         }
 442
 443         # Handle invalid content
 444         unless($res->content =~ /^$token.$self->{account}{thumbprint}\s*$/) {
 445                 carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' content match failed: /^'.$token.'.'.$self->{account}{thumbprint}.'\s*$/ !~ '.$res->content if ($self->{debug});
 446                 return;
 447         }
 448
 449         # Return success
 450         return 1;
 451 }
 452
 453 # Register account
 454 #XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3
 455 sub register {
 456         my ($self) = @_;
 457
 458         # Post new-reg request
 459         #XXX: contact array may contain a tel:+33612345678 for example
 460         my $res = $self->_post($self->{'new-reg'}, {resource => 'new-reg', contact => ['mailto:'.$self->{mail}], agreement => $self->{term}});
 461
 462         # Handle error
 463         unless ($res->is_success || $res->code eq 409) {
 464                 confess 'POST '.$self->{'new-reg'}.' failed: '.$res->status_line;
 465         }
 466
 467         # Update mail informations
 468         if ($res->code eq 409) {
 469                 # Save registration uri
 470                 $self->{'reg'} = $res->headers->{location};
 471
 472                 # Post reg request
 473                 #XXX: contact array may contain a tel:+33612345678 for example
 474                 $res = $self->_post($self->{'reg'}, {resource => 'reg', contact => ['mailto:'.$self->{mail}]});
 475
 476                 # Handle error
 477                 unless ($res->is_success) {
 478                         confess 'POST '.$self->{'reg'}.' failed: '.$res->status_line;
 479                 }
 480         }
 481 }
 482
 483 # Authorize domains
 484 sub authorize {
 485         my ($self) = @_;
 486
 487         # Create challenges hash
 488         %{$self->{challenges}} = ();
 489
 490         # Pending list
 491         my @pending = ();
 492
 493         # Create or load auth request for each domain
 494         map {
 495                 # Init content
 496                 my $content = undef;
 497
 498                 # Init file
 499                 my $file = $self->{config}{pending}.'/'.$self->{mail}.'.'.($self->{domain}{prod} ? 'prod' : 'staging').'/'.$_;
 500
 501                 # Load auth request content or post a new one
 502                 #TODO: add more check on cache file ???
 503                 if (
 504                         #XXX: use eval to workaround a fatal in from_json
 505                         ! defined eval {
 506                                 # Check that file exists
 507                                 -f $file &&
 508                                 # Read it
 509                                 ($content = read_file($file)) &&
 510                                 # Decode it
 511                                 ($content = from_json($content))
 512                         # Check expiration
 513                         } || (str2time($content->{expires}) <= time()+3600)
 514                 ) {
 515                         # Post new-authz request
 516                         my $res = $self->_post($self->{'new-authz'}, {resource => 'new-authz', identifier => {type => 'dns', value => $_}, existing => 'accept'});
 517
 518                         # Handle error
 519                         unless ($res->is_success) {
 520                                 confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
 521                         }
 522
 523                         # Decode content
 524                         $content = from_json($res->content);
 525
 526                         # Check domain
 527                         unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) {
 528                                 confess 'domain matching '.$content->{identifier}{value}.' for '.$_.' failed: '.$res->status_line;
 529                         }
 530
 531                         # Check status
 532                         unless ($content->{status} eq 'valid' or $content->{status} eq 'pending') {
 533                                 confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
 534                         }
 535
 536                         # Write to file
 537                         write_file($file, to_json($content));
 538                 }
 539
 540                 # Add challenge
 541                 %{$self->{challenges}{$_}} = (
 542                         status => $content->{status},
 543                         expires => $content->{expires},
 544                         polls => []
 545                 );
 546
 547                 # Save pending data
 548                 if ($content->{status} eq 'pending') {
 549                         # Extract validation data
 550                         foreach my $challenge (@{$content->{challenges}}) {
 551                                 # One test already validated this auth request
 552                                 if ($self->{challenges}{$_}{status} eq 'valid') {
 553                                         next;
 554                                 } elsif ($challenge->{status} eq 'valid') {
 555                                         $self->{challenges}{$_}{status} = $challenge->{status};
 556                                         next;
 557                                 } elsif ($challenge->{status} eq 'pending') {
 558                                         # Handle check
 559                                         if (
 560                                                 ($challenge->{type} =~ /^http-01$/ and $self->_httpCheck($_, $challenge->{token})) or
 561                                                 ($challenge->{type} =~ /^dns-01$/ and $self->_dnsCheck($_, $challenge->{token}))
 562                                         ) {
 563                                                 # Post challenge request
 564                                                 my $res = $self->_post($challenge->{uri}, {resource => 'challenge', keyAuthorization => $challenge->{token}.'.'.$self->{account}{thumbprint}});
 565
 566                                                 # Handle error
 567                                                 unless ($res->is_success) {
 568                                                         confess 'POST '.$challenge->{uri}.' failed: '.$res->status_line;
 569                                                 }
 570
 571                                                 # Extract content
 572                                                 my $content = from_json($res->content);
 573
 574                                                 # Save if valid
 575                                                 if ($content->{status} eq 'valid') {
 576                                                         $self->{challenges}{$_}{status} = $content->{status};
 577                                                 # Check is still polling
 578                                                 } elsif ($content->{status} eq 'pending') {
 579                                                         # Add to poll list for later use
 580                                                         push(@{$self->{challenges}{$_}{polls}}, {
 581                                                                 type => (split(/-/, $challenge->{type}))[0],
 582                                                                 status => $content->{status},
 583                                                                 poll => $content->{uri}
 584                                                         });
 585                                                 }
 586                                         }
 587                                 }
 588                         }
 589                         # Check if check is challenge still in pending and no polls
 590                         if ($self->{challenges}{$_}{status} eq 'pending' && scalar @{$self->{challenges}{$_}{polls}} == 0) {
 591                                 # Loop on all remaining challenges
 592                                 foreach my $challenge (@{$content->{challenges}}) {
 593                                         # Display help for http-01 check
 594                                         if ($challenge->{type} eq 'http-01') {
 595                                                 print STDERR 'Create URI http://'.$_.'/.well-known/acme-challenge/'.$challenge->{token}.' with content '.$challenge->{token}.'.'.$self->{account}{thumbprint}."\n";
 596                                         # Display help for dns-01 check
 597                                         } elsif ($challenge->{type} eq 'dns-01') {
 598                                                 print STDERR 'Create TXT record _acme-challenge.'.$_.'. with value '.(((sha256_base64($challenge->{token}.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r)."\n";
 599                                         }
 600                                 }
 601                         }
 602                 }
 603         } @{$self->{domains}};
 604
 605         # Init max run
 606         my $remaining = 10;
 607
 608         # Poll pending
 609         while (--$remaining >= 0 and scalar map { $_->{status} eq 'valid' ? 1 : (); } values %{$self->{challenges}}) {
 610                 # Sleep
 611                 sleep(1);
 612                 # Poll remaining pending
 613                 map {
 614                         # Init domain
 615                         my $domain = $_;
 616
 617                         # Poll remaining polls
 618                         map {
 619                                 # Create a request
 620                                 my $req = HTTP::Request->new(GET => $_->{poll});
 621
 622                                 # Get request
 623                                 my $res = $ua->request($req);
 624
 625                                 # Handle error
 626                                 unless ($res->is_success) {
 627                                         carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug});
 628                                 }
 629
 630                                 # Extract content
 631                                 my $content = from_json($res->content);
 632
 633                                 # Save status
 634                                 if ($content->{status} ne 'pending') {
 635                                         $self->{challenges}{$domain}{status} = $content->{status};
 636                                 }
 637                         } @{$self->{challenges}{$_}{polls}};
 638                 } map { $self->{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{challenges}};
 639         }
 640
 641         # Check if thumbprint is writeable
 642         if (-w $self->{config}{thumbprint}) {
 643                 # Try to write thumbprint
 644                 write_file($self->{config}{thumbprint}, '');
 645         }
 646
 647         # Stop here with remaining chanllenge
 648         if (scalar map { ! defined $_->{status} or $_->{status} ne 'valid' ? 1 : (); } values %{$self->{challenges}}) {
 649                 # Deactivate all activated domains
 650                 #XXX: not implemented by letsencrypt
 651                 #map {
 652                 #       # Post deactivation request
 653                 #       my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'authz', status => 'deactivated'});
 654                 #       # Handle error
 655                 #       unless ($res->is_success) {
 656                 #               confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line;
 657                 #       }
 658                 #} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
 659
 660                 # Stop here as a domain of csr list failed authorization
 661                 if ($self->{debug}) {
 662                         my @domains = map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}};
 663                         confess 'Fix the challenge'.(scalar @domains > 1?'s':'').' for domain'.(scalar @domains > 1?'s':'').': '.join(', ', @domains);
 664                 } else {
 665                         exit EXIT_FAILURE;
 666                 }
 667         }
 668 }
 669
 670 # Issue certificate
 671 sub issue {
 672         my ($self) = @_;
 673
 674         # Open csr file
 675         open(my $fh, '<', $self->{config}{pending}.'/'.$self->{mail}.'.'.($self->{domain}{prod} ? 'prod' : 'staging').'/'.REQUEST_CSR) or die $!;
 676
 677         # Load csr
 678         my $csr = encode_base64url(join('', <$fh>) =~ s/^\0+//r);
 679
 680         # Close csr file
 681         close($fh) or die $!;
 682
 683         # Post certificate request
 684         my $res = $self->_post($self->{'new-cert'}, {resource => 'new-cert', csr => $csr});
 685
 686         # Handle error
 687         unless ($res->is_success) {
 688                 confess 'POST '.$self->{'new-cert'}.' failed: '.$res->status_line;
 689         }
 690
 691         # Open crt file
 692         open($fh, '>', $self->{domain}{cert}) or die $!;
 693
 694         # Convert to pem
 695         print $fh '-----BEGIN CERTIFICATE-----'."\n".encode_base64($res->content).'-----END CERTIFICATE-----'."\n";
 696
 697         # Create a request
 698         my $req = HTTP::Request->new(GET => ACME_CERT);
 699
 700         # Get request
 701         $res = $ua->request($req);
 702
 703         # Handle error
 704         unless ($res->is_success) {
 705                 carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug});
 706         }
 707
 708         # Append content
 709         print $fh $res->content;
 710
 711         # Close file
 712         close($fh) or die $!;
 713
 714         # Print success
 715         carp 'Success, pem certificate in '.$self->{domain}{cert} if ($self->{debug});
 716 }
 717
 718 1;
 719
 720 __DATA__
 721 #
 722 # OpenSSL configuration file.
 723 # This is mostly being used for generation of certificate requests.
 724 #
 725
 726 [ req ]
 727 default_bits            = 2048
 728 default_md              = sha256
 729 prompt                  = no
 730 distinguished_name      = req_distinguished_name
 731 # The extentions to add to the self signed cert
 732 x509_extensions = v3_ca
 733 # The extensions to add to a certificate request
 734 req_extensions = v3_req
 735
 736 # This sets a mask for permitted string types. There are several options.
 737 # utf8only: only UTF8Strings (PKIX recommendation after 2004).
 738 # WARNING: ancient versions of Netscape crash on BMPStrings or UTF8Strings.
 739 string_mask = utf8only
 740
 741 [ req_distinguished_name ]
 742 countryName                     = US
 743 stateOrProvinceName             = State or Province Name
 744 localityName                    = Locality Name
 745 organizationName                = Organization Name
 746 organizationalUnitName          = Organizational Unit Name
 747 commonName                      = __COMMON_NAME__
 748 emailAddress                    = __EMAIL_ADDRESS__
 749
 750 [ v3_req ]
 751 basicConstraints = CA:false
 752 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
 753 subjectAltName = email:move
 754 subjectAltName = @alt_names
 755
 756 [ v3_ca ]
 757 subjectKeyIdentifier = hash
 758 authorityKeyIdentifier = keyid:always,issuer
 759 basicConstraints = CA:true
 760
 761 [alt_names]