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