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

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