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