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