]> Raphaƫl G. Git Repositories - acme/blob - acme.pm
e44c341336f6d4da045796dac8c69d50fccce6b4
[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 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]