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 <acmepl@rapsys.eu>
  17
  18 # Acme package
  19 package Acme;
  20
  21 # Best practice
  22 use strict;
  23 use warnings;
  24
  25 # Symbol export
  26 use Exporter;
  27 our @ISA = qw(Exporter);
  28 our @EXPORT_OK = qw(DS CERT_DIR KEY_DIR REQUEST_CSR ACCOUNT_KEY SERVER_KEY SERVER_CRT CONFIG);
  29
  30 # Load dependancies
  31 use Carp qw(carp confess);
  32 use Date::Parse qw(str2time);
  33 use Digest::SHA qw(sha256_base64);
  34 use Email::Valid;
  35 use File::Path qw(make_path);
  36 use File::Slurp qw(read_file write_file);
  37 use File::Temp; # qw( :seekable );
  38 use IPC::System::Simple qw(capturex);
  39 use JSON qw(from_json to_json);
  40 use LWP;
  41 use MIME::Base64 qw(encode_base64url encode_base64);
  42 use Net::Domain::TLD;
  43 use POSIX qw(EXIT_FAILURE);
  44 use Tie::IxHash;
  45
  46 # Documentation links
  47 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
  48 #XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt
  49 #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js
  50
  51 # Set constants
  52 use constant {
  53         # Directory separator
  54         DS => '/',
  55
  56         # Directory for certificates
  57         CERT_DIR => 'cert',
  58
  59         # Directory for keys
  60         KEY_DIR => 'key',
  61
  62         # Directory for pending cache
  63         PENDING_DIR => 'pending',
  64
  65         # Request certificate file name
  66         REQUEST_CSR => 'request.der',
  67
  68         # Account key file name
  69         ACCOUNT_KEY => 'account.pem',
  70
  71         # Server private key
  72         SERVER_KEY => 'server.pem',
  73
  74         # Server public certificate
  75         SERVER_CRT => 'server.crt',
  76
  77         # rsa
  78         KEY_TYPE => 'rsa',
  79
  80         # 2048|4096
  81         KEY_SIZE => 4096,
  82
  83         # Acme infos
  84         ACME_CERT => 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem',
  85         ACME_DIR => 'https://acme-staging.api.letsencrypt.org/directory',
  86         ACME_PROD_DIR => 'https://acme-v01.api.letsencrypt.org/directory',
  87         ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.1.1-August-1-2016.pdf',
  88
  89         # Version
  90         VERSION => 'v0.7',
  91
  92         # Config
  93         CONFIG => '/etc/acmepl/config'
  94 };
  95
  96 # User agent object
  97 our $ua;
  98
  99 # Strerr backup
 100 our $_stderr;
 101
 102 # JSON Web Key (JWK)
 103 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 104 #our %jwk = (
 105 #       pubkey => undef,
 106 #       jwk => {
 107 #               alg => 'RS256',
 108 #               jwk => {
 109 #                       # Exponent
 110 #                       e => undef,
 111 #                       # Key type
 112 #                       kty => uc(KEY_TYPE),
 113 #                       # Modulus
 114 #                       n => undef
 115 #               }
 116 #       },
 117 #       thumbprint => undef
 118 #);
 119 tie(our %jwk, 'Tie::IxHash', pubkey => undef, jwk => undef, thumbprint => undef);
 120 tie(%{$jwk{jwk}}, 'Tie::IxHash', alg => 'RS256', jwk => undef);
 121 #XXX: strict ordering only really needed here for thumbprint sha256 digest
 122 tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => undef);
 123
 124 # Constructor
 125 sub new {
 126         # Extract params
 127         my ($class, $mail, $debug, $prod, @domains) = @_;
 128
 129         # Create self hash
 130         my $self = {};
 131
 132         # Link self to package
 133         bless($self, $class);
 134
 135         # Save debug
 136         $self->{debug} = $debug;
 137
 138         # Save prod
 139         $self->{prod} = $prod;
 140
 141         # Add extra check to mail validity
 142         #XXX: mxcheck fail if there is only a A record on the domain
 143         my $ev = Email::Valid->new(-fqdn => 1, -tldcheck => 1, -mxcheck => 1);
 144
 145         # Show error if check fail
 146         if (! defined $ev->address($mail)) {
 147                 map { carp 'failed check: '.$_ if ($self->{debug}) } $ev->details();
 148                 confess 'Email::Valid->address failed';
 149         }
 150
 151         # Save mail
 152         $self->{mail} = $mail;
 153
 154         # Create resolver
 155         my $res = new Net::DNS::Resolver();
 156
 157         # Check domains
 158         map {
 159                 my $tld;
 160
 161                 # Extract tld
 162                 unless (($tld) = $_ =~ m/\.(\w+)$/) {
 163                         confess $_.'\'s tld extraction failed';
 164                 }
 165
 166                 # Check if tld exists
 167                 unless(Net::Domain::TLD::tld_exists($tld)) {
 168                         confess $tld.' tld from '.$_.' don\'t exists';
 169                 }
 170
 171                 # Check if we get dns answer
 172                 #XXX: only search A type because letsencrypt don't support ipv6 (AAAA) yet
 173                 unless(my $rep = $res->search($_, 'A')) {
 174                         confess 'search A record for '.$_.' failed';
 175                 } else {
 176                         unless (scalar map { $_->type eq 'A' ? 1 : (); } $rep->answer) {
 177                                 confess 'search recursively A record for '.$_.' failed';
 178                         }
 179                 }
 180         } @domains;
 181
 182         # Save domains
 183         @{$self->{domains}} = @domains;
 184
 185         # Return class reference
 186         return $self;
 187 }
 188
 189 # Prepare environement
 190 sub prepare {
 191         my ($self) = @_;
 192
 193         # Create all paths
 194         make_path(CERT_DIR, KEY_DIR, PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging'), {error => \my $err});
 195         if (@$err) {
 196                 map {
 197                         my ($file, $msg) = %$_;
 198                         carp ($file eq '' ? '' : $file.': ').$msg if ($self->{debug});
 199                 } @$err;
 200                 confess 'make_path failed';
 201         }
 202
 203         # Create user agent
 204         $ua = LWP::UserAgent->new;
 205         $ua->agent(__PACKAGE__.'/'.VERSION)
 206 }
 207
 208 # Drop stderr
 209 sub _dropStdErr {
 210         # Save stderr
 211         open($_stderr, '>&STDERR') or die $!;
 212         # Close it
 213         close(STDERR) or die $!;
 214         # Send to /dev/null
 215         open(STDERR, '>', '/dev/null') or die $!;
 216 }
 217
 218 # Restore stderr
 219 sub _restoreStdErr {
 220         # Close stderr
 221         close(STDERR);
 222         # Open it back
 223         open(STDERR, '>&', $_stderr) or die $!;
 224 }
 225
 226 # Generate required keys
 227 sub genKeys {
 228         my ($self) = @_;
 229
 230         # Generate account and server key if required
 231         map {
 232                 # Check key existence
 233                 if (! -f $_) {
 234                         # Drop stderr
 235                         _dropStdErr();
 236                         # Generate key
 237                         #XXX: we drop stderr here because openssl can't be quiet on this command
 238                         capturex('openssl', ('genrsa', '-out', $_, KEY_SIZE));
 239                         # Restore stderr
 240                         _restoreStdErr();
 241                 }
 242         } (KEY_DIR.DS.ACCOUNT_KEY, KEY_DIR.DS.SERVER_KEY);
 243
 244         # Extract modulus and publicExponent jwk
 245         #XXX: same here we tie to keep ordering
 246         tie(%{$self->{account}}, 'Tie::IxHash', %jwk);
 247         map {
 248                 if (/^Modulus=([0-9A-F]+)$/) {
 249                         # Extract to binary from hex and convert to base64 url
 250                         $self->{account}{jwk}{jwk}{n} = encode_base64url(pack("H*", $1) =~ s/^\0+//r);
 251                 } elsif (/^publicExponent:\s([0-9]+)\s\(0x[0-1]+\)$/) {
 252                         # Extract to binary from int, trim leading zeros and convert to base64 url
 253                         chomp ($self->{account}{jwk}{jwk}{e} = encode_base64url(pack("N", $1) =~ s/^\0+//r));
 254                 }
 255         } capturex('openssl', ('rsa', '-text', '-in', KEY_DIR.DS.ACCOUNT_KEY, '-noout', '-modulus'));
 256
 257         # Drop stderr
 258         _dropStdErr();
 259         # Extract account public key
 260         $self->{account}{pubkey} = join('', map { chomp; $_; } capturex('openssl', ('rsa', '-in', KEY_DIR.DS.ACCOUNT_KEY, '-pubout')));
 261         # Restore stderr
 262         _restoreStdErr();
 263
 264         # Store thumbprint
 265         #XXX: convert base64 to base64 url
 266         $self->{account}{thumbprint} = (sha256_base64(to_json($self->{account}{jwk}{jwk})) =~ s/=+\z//r) =~ tr[+/][-_]r;
 267 }
 268
 269 # Generate certificate request
 270 sub genCsr {
 271         my ($self) = @_;
 272
 273         # Openssl config template
 274         my $oct = File::Temp->new();
 275
 276         # Load template from data
 277         map { s/__EMAIL_ADDRESS__/$self->{mail}/; s/__COMMON_NAME__/$self->{domains}[0]/; print $oct $_; } <DATA>;
 278
 279         # Close data
 280         close(DATA);
 281
 282         # Append domain names
 283         my $i = 1;
 284         map { print $oct 'DNS.'.$i++.' = '.$_."\n"; } @{$self->{domains}};
 285
 286         # Generate csr
 287         capturex('openssl', ('req', '-new', '-outform', 'DER', '-key', KEY_DIR.DS.SERVER_KEY, '-config', $oct->filename, '-out', CERT_DIR.DS.REQUEST_CSR));
 288
 289         # Close oct
 290         close($oct);
 291 }
 292
 293 # Directory call
 294 sub directory {
 295         my ($self) = @_;
 296
 297         # Set time
 298         my $time = time;
 299
 300         # Set directory
 301         my $dir = $self->{prod} ? ACME_PROD_DIR : ACME_DIR;
 302
 303         # Create a request
 304         my $req = HTTP::Request->new(GET => $dir.'?'.$time);
 305
 306         # Get request
 307         my $res = $ua->request($req);
 308
 309         # Handle error
 310         unless ($res->is_success) {
 311                 confess 'GET '.$dir.'?'.$time.' failed: '.$res->status_line;
 312         }
 313
 314         # Save nonce
 315         $self->{nonce} = $res->headers->{'replay-nonce'};
 316
 317         # Merge uris in self content
 318         %$self = (%$self, %{from_json($res->content)});
 319 }
 320
 321 # Post request
 322 sub _post {
 323         my ($self, $uri, $payload) = @_;
 324
 325         # Protected field
 326         my $protected = encode_base64url(to_json({nonce => $self->{nonce}}));
 327
 328         # Payload field
 329         $payload = encode_base64url(to_json($payload));
 330
 331         # Sign temp file
 332         my $stf = File::Temp->new();
 333
 334         # Append protect.payload to stf
 335         print $stf $protected.'.'.$payload;
 336
 337         # Close stf
 338         close($stf);
 339
 340         # Generate digest of stf
 341         my $signature = encode_base64url(join('', capturex('openssl', ('dgst', '-sha256', '-binary', '-sign', KEY_DIR.DS.ACCOUNT_KEY, $stf->filename))) =~ s/^\0+//r);
 342
 343         # Create a request
 344         my $req = HTTP::Request->new(POST => $uri);
 345
 346         # Set new-reg request content
 347         $req->content(to_json({
 348                 header => $self->{account}{jwk},
 349                 protected => $protected,
 350                 payload => $payload,
 351                 signature => $signature
 352         }));
 353
 354         # Post request
 355         my $res = $ua->request($req);
 356
 357         # Save nonce
 358         if (defined $res->headers->{'replay-nonce'}) {
 359                 $self->{nonce} = $res->headers->{'replay-nonce'};
 360         }
 361
 362         # Return res object
 363         return $res;
 364 }
 365
 366 # Resolve dns and check content
 367 #XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example
 368 sub _dnsCheck {
 369         my ($self, $domain, $token) = @_;
 370
 371         # Generate signature from content
 372         my $signature = ((sha256_base64($token.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r;
 373
 374         # Fix domain
 375         $domain = '_acme-challenge.'.$domain.'.';
 376
 377         # Create resolver
 378         my $res = new Net::DNS::Resolver();
 379
 380         # Check if we get dns answer
 381         unless(my $rep = $res->search($domain, 'TXT')) {
 382                 carp 'TXT record search for '.$domain.' failed' if ($self->{debug});
 383                 return;
 384         } else {
 385                 unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) {
 386                         carp 'TXT record recursive search for '.$domain.' failed' if ($self->{debug});
 387                         return;
 388                 }
 389         }
 390
 391         return 1;
 392 }
 393
 394 # Get uri and check content
 395 sub _httpCheck {
 396         my ($self, $domain, $token) = @_;
 397
 398         # Create a request
 399         my $req = HTTP::Request->new(GET => 'http://'.$domain.'/.well-known/acme-challenge/'.$token);
 400
 401         # Load config if available
 402         my $config = undef;
 403         if (
 404                 #XXX: use eval to workaround a fatal in from_json
 405                 defined eval {
 406                         # Check that file exists
 407                         -f CONFIG &&
 408                         # Read it
 409                         ($config = read_file(CONFIG)) &&
 410                         # Decode it
 411                         ($config = from_json($config)) &&
 412                         # Check defined
 413                         $config->{thumbprint}
 414                 }
 415         ) {
 416                 # Try to write thumbprint
 417                 write_file($config->{thumbprint}, $self->{account}{thumbprint});
 418         }
 419
 420         # Get request
 421         my $res = $ua->request($req);
 422
 423         # Handle error
 424         unless ($res->is_success) {
 425                 carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{debug});
 426                 return;
 427         }
 428
 429         # Handle invalid content
 430         unless($res->content =~ /^$token.$self->{account}{thumbprint}\s*$/) {
 431                 carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' content match failed: /^'.$token.'.'.$self->{account}{thumbprint}.'\s*$/ !~ '.$res->content if ($self->{debug});
 432                 return;
 433         }
 434
 435         # Return success
 436         return 1;
 437 }
 438
 439 # Register account
 440 #XXX: see doc at https://ietf-wg-acme.github.io/acme/#rfc.section.6.3
 441 sub register {
 442         my ($self) = @_;
 443
 444         # Post new-reg request
 445         #XXX: contact array may contain a tel:+33612345678 for example
 446         my $res = $self->_post($self->{'new-reg'}, {resource => 'new-reg', contact => ['mailto:'.$self->{mail}], agreement => ACME_TERMS});
 447
 448         # Handle error
 449         unless ($res->is_success || $res->code eq 409) {
 450                 confess 'POST '.$self->{'new-reg'}.' failed: '.$res->status_line;
 451         }
 452
 453         # Update mail informations
 454         if ($res->code eq 409) {
 455                 # Save registration uri
 456                 $self->{'reg'} = $res->headers->{location};
 457
 458                 # Post reg request
 459                 #XXX: contact array may contain a tel:+33612345678 for example
 460                 $res = $self->_post($self->{'reg'}, {resource => 'reg', contact => ['mailto:'.$self->{mail}]});
 461
 462                 # Handle error
 463                 unless ($res->is_success) {
 464                         confess 'POST '.$self->{'reg'}.' failed: '.$res->status_line;
 465                 }
 466         }
 467 }
 468
 469 # Authorize domains
 470 sub authorize {
 471         my ($self) = @_;
 472
 473         # Create challenges hash
 474         %{$self->{challenges}} = ();
 475
 476         # Pending list
 477         my @pending = ();
 478
 479         # Create or load auth request for each domain
 480         map {
 481                 # Init content
 482                 my $content = undef;
 483
 484                 # Init file
 485                 my $file = PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging').'/'.$_;
 486
 487                 # Load auth request content or post a new one
 488                 #TODO: add more check on cache file ???
 489                 if (
 490                         #XXX: use eval to workaround a fatal in from_json
 491                         ! defined eval {
 492                                 # Check that file exists
 493                                 -f $file &&
 494                                 # Read it
 495                                 ($content = read_file($file)) &&
 496                                 # Decode it
 497                                 ($content = from_json($content))
 498                         # Check expiration
 499                         } || (str2time($content->{expires}) <= time()+3600)
 500                 ) {
 501                         # Post new-authz request
 502                         my $res = $self->_post($self->{'new-authz'}, {resource => 'new-authz', identifier => {type => 'dns', value => $_}, existing => 'accept'});
 503
 504                         # Handle error
 505                         unless ($res->is_success) {
 506                                 confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
 507                         }
 508
 509                         # Decode content
 510                         $content = from_json($res->content);
 511
 512                         # Check domain
 513                         unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) {
 514                                 confess 'domain matching '.$content->{identifier}{value}.' for '.$_.' failed: '.$res->status_line;
 515                         }
 516
 517                         # Check status
 518                         unless ($content->{status} eq 'valid' or $content->{status} eq 'pending') {
 519                                 confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
 520                         }
 521
 522                         # Write to file
 523                         write_file($file, to_json($content));
 524                 }
 525
 526                 # Add challenge
 527                 %{$self->{challenges}{$_}} = (
 528                         status => $content->{status},
 529                         expires => $content->{expires},
 530                         polls => []
 531                 );
 532
 533                 # Save pending data
 534                 if ($content->{status} eq 'pending') {
 535                         # Extract validation data
 536                         foreach my $challenge (@{$content->{challenges}}) {
 537                                 # One test already validated this auth request
 538                                 if ($self->{challenges}{$_}{status} eq 'valid') {
 539                                         next;
 540                                 } elsif ($challenge->{status} eq 'valid') {
 541                                         $self->{challenges}{$_}{status} = $challenge->{status};
 542                                         next;
 543                                 } elsif ($challenge->{status} eq 'pending') {
 544                                         # Handle check
 545                                         if (
 546                                                 ($challenge->{type} =~ /^http-01$/ and $self->_httpCheck($_, $challenge->{token})) or
 547                                                 ($challenge->{type} =~ /^dns-01$/ and $self->_dnsCheck($_, $challenge->{token}))
 548                                         ) {
 549                                                 # Post challenge request
 550                                                 my $res = $self->_post($challenge->{uri}, {resource => 'challenge', keyAuthorization => $challenge->{token}.'.'.$self->{account}{thumbprint}});
 551
 552                                                 # Handle error
 553                                                 unless ($res->is_success) {
 554                                                         confess 'POST '.$challenge->{uri}.' failed: '.$res->status_line;
 555                                                 }
 556
 557                                                 # Extract content
 558                                                 my $content = from_json($res->content);
 559
 560                                                 # Save if valid
 561                                                 if ($content->{status} eq 'valid') {
 562                                                         $self->{challenges}{$_}{status} = $content->{status};
 563                                                 # Check is still polling
 564                                                 } elsif ($content->{status} eq 'pending') {
 565                                                         # Add to poll list for later use
 566                                                         push(@{$self->{challenges}{$_}{polls}}, {
 567                                                                 type => (split(/-/, $challenge->{type}))[0],
 568                                                                 status => $content->{status},
 569                                                                 poll => $content->{uri}
 570                                                         });
 571                                                 }
 572                                         }
 573                                 }
 574                         }
 575                         # Check if check is challenge still in pending and no polls
 576                         if ($self->{challenges}{$_}{status} eq 'pending' && scalar @{$self->{challenges}{$_}{polls}} == 0) {
 577                                 # Loop on all remaining challenges
 578                                 foreach my $challenge (@{$content->{challenges}}) {
 579                                         # Display help for http-01 check
 580                                         if ($challenge->{type} eq 'http-01') {
 581                                                 print STDERR 'Create URI http://'.$_.'/.well-known/acme-challenge/'.$challenge->{token}.' with content '.$challenge->{token}.'.'.$self->{account}{thumbprint}."\n";
 582                                         # Display help for dns-01 check
 583                                         } elsif ($challenge->{type} eq 'dns-01') {
 584                                                 print STDERR 'Create TXT record _acme-challenge.'.$_.'. with value '.(((sha256_base64($challenge->{token}.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r)."\n";
 585                                         }
 586                                 }
 587                         }
 588                 }
 589         } @{$self->{domains}};
 590
 591         # Init max run
 592         my $remaining = 10;
 593
 594         # Poll pending
 595         while (--$remaining >= 0 and scalar map { $_->{status} eq 'valid' ? 1 : (); } values %{$self->{challenges}}) {
 596                 # Sleep
 597                 sleep(1);
 598                 # Poll remaining pending
 599                 map {
 600                         # Init domain
 601                         my $domain = $_;
 602
 603                         # Poll remaining polls
 604                         map {
 605                                 # Create a request
 606                                 my $req = HTTP::Request->new(GET => $_->{poll});
 607
 608                                 # Get request
 609                                 my $res = $ua->request($req);
 610
 611                                 # Handle error
 612                                 unless ($res->is_success) {
 613                                         carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug});
 614                                 }
 615
 616                                 # Extract content
 617                                 my $content = from_json($res->content);
 618
 619                                 # Save status
 620                                 if ($content->{status} ne 'pending') {
 621                                         $self->{challenges}{$domain}{status} = $content->{status};
 622                                 }
 623                         } @{$self->{challenges}{$_}{polls}};
 624                 } map { $self->{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{challenges}};
 625         }
 626
 627         # Load config if available
 628         my $config = undef;
 629         if (
 630                 #XXX: use eval to workaround a fatal in from_json
 631                 defined eval {
 632                         # Check that file exists
 633                         -f CONFIG &&
 634                         # Read it
 635                         ($config = read_file(CONFIG)) &&
 636                         # Decode it
 637                         ($config = from_json($config)) &&
 638                         # Check defined
 639                         $config->{thumbprint}
 640                 }
 641         ) {
 642                 # Try to write thumbprint
 643                 write_file($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, '<', CERT_DIR.DS.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, '>', CERT_DIR.DS.SERVER_CRT) 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 '.CERT_DIR.DS.SERVER_CRT 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]