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