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