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