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