File Coverage

blib/lib/Net/ACME2.pm
Criterion Covered Total %
statement 92 132 69.7
branch 17 32 53.1
condition 13 24 54.1
subroutine 23 33 69.7
pod 11 11 100.0
total 156 232 67.2


line stmt bran cond sub pod time code
1             package Net::ACME2;
2              
3 3     3   390 use strict;
  3         6  
  3         82  
4 3     3   13 use warnings;
  3         5  
  3         114  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             Net::ACME2 - Client logic for the ACME (Let's Encrypt) protocol
11              
12             X X X
13              
14             =head1 SYNOPSIS
15              
16             package SomeCA::ACME;
17              
18             use parent qw( Net::ACME2 );
19              
20             use constant {
21             DIRECTORY_PATH => '/acme-directory',
22             };
23              
24             # %opts are the parameters given to new().
25             sub HOST {
26             my ($class, %opts) = @_;
27              
28             # You can make this depend on the %opts if you want.
29             return 'acme.someca.net';
30             }
31              
32             package main;
33              
34             my $acme = SomeCA::ACME->new(
35             key => $account_key_pem_or_der,
36             key_id => undef,
37             );
38              
39             #for a new account
40             {
41             my $terms_url = $acme->get_terms_of_service();
42              
43             $acme->create_account(
44             termsOfServiceAgreed => 1,
45             );
46             }
47              
48             #Save $acme->key_id() somewhere so you can use it again.
49              
50             my $order = $acme->create_order(
51             identifiers => [
52             { type => 'dns', value => '*.example.com' },
53             ],
54             );
55              
56             my $authz = $acme->get_authorization( ($order->authorizations())[0] );
57              
58             my @challenges = $authz->challenges();
59              
60             # ... Pick a challenge, and satisfy it.
61              
62             $acme->accept_challenge($challenge);
63              
64             sleep 1 while 'valid' ne $acme->poll_authorization($authz);
65              
66             # ... Make a key and CSR for *.example.com
67              
68             $acme->finalize_order($order, $csr_pem_or_der);
69              
70             while ($order->status() ne 'valid') {
71             sleep 1;
72             $acme->poll_order($order);
73             }
74              
75             # ... and now fetch the certificate chain:
76              
77             my $pem_chain = $acme->get_certificate_chain($order);
78              
79             See F in the distribution for more fleshed-out examples.
80              
81             To use L, see
82             L.
83              
84             =head1 DESCRIPTION
85              
86             This library implements client logic for the
87             ACME (Automated Certificate Management Environment) protocol, as
88             standardized in L
89             and popularized by L.
90              
91             =head1 STATUS
92              
93             This is a production-grade implementation. While breaking changes at this
94             point are unlikely, please always check the changelog before upgrading to
95             a new version of this module.
96              
97             =head1 FEATURES
98              
99             =over
100              
101             =item * Support for both ECDSA and RSA encrytion.
102              
103             =item * Support for http-01, dns-01, and L challenges.
104              
105             =item * Comprehensive error handling with typed, L-based exceptions.
106              
107             =item * L errors.|https://tools.ietf.org/html/rfc8555#section-6.5>
108              
109             =item * This is a pure-Perl solution. Most of its dependencies are
110             either core modules or pure Perl themselves. XS is necessary to
111             communicate with the ACME server via TLS; however, most Perl installations
112             already include the necessary logic (i.e., L) for TLS.
113              
114             In short, Net::ACME2 will run anywhere that Perl can speak TLS, which is
115             I everywhere that Perl runs.
116              
117             =back
118              
119             =head1 ERROR HANDLING
120              
121             All thrown exceptions are instances of L.
122             Specific error classes aren’t yet defined.
123              
124             =head1 CRYPTOGRAPHY & SPEED
125              
126             L provides all cryptographic operations that this library
127             needs using pure Perl. While this satisfies this module’s intent to be
128             as pure-Perl as possible, there are a couple of significant drawbacks
129             to this approach: firstly, it’s slower than XS-based code, and secondly,
130             it loses the security benefits of the vetting that more widely-used
131             cryptography libraries receive.
132              
133             To address these problems, Net::ACME2 will, after parsing a key, look
134             for and prefer the following XS-based libraries for cryptography instead:
135              
136             =over
137              
138             =item * L (based on L)
139              
140             =item * L (based on L)
141              
142             =back
143              
144             If the above are unavailable to you, then you may be able to speed up
145             your L installation; see that module’s documentation
146             for more details.
147              
148             =cut
149              
150 3     3   14 use Crypt::Format;
  3         5  
  3         66  
151 3     3   410 use MIME::Base64 ();
  3         534  
  3         50  
152              
153 3     3   1148 use Net::ACME2::AccountKey;
  3         7  
  3         80  
154              
155 3     3   1227 use Net::ACME2::HTTP;
  3         7  
  3         83  
156 3     3   1137 use Net::ACME2::Order;
  3         7  
  3         80  
157 3     3   1168 use Net::ACME2::Authorization;
  3         6  
  3         122  
158              
159             our $VERSION = '0.35_01';
160              
161             use constant {
162 3         167 _HTTP_OK => 200,
163             _HTTP_CREATED => 201,
164 3     3   15 };
  3         6  
165              
166             # accessed from test
167 3         129 use constant newAccount_booleans => qw(
168             termsOfServiceAgreed
169             onlyReturnExisting
170 3     3   13 );
  3         6  
171              
172             # the list of methods that need a “jwk” in their JWS Protected Header
173             # (cf. section 6.2 of the spec)
174 3         4333 use constant FULL_JWT_METHODS => qw(
175             newAccount
176             revokeCert
177 3     3   16 );
  3         3  
178              
179             =head1 METHODS
180              
181             =head2 I->new( %OPTS )
182              
183             Instantiates an ACME2 object, which you’ll use for all
184             interactions with the ACME server. %OPTS is:
185              
186             =over
187              
188             =item * C - Required. The private key to associate with the ACME2
189             user. Anything that C can parse is acceptable.
190              
191             =item * C - Optional. As returned by C.
192             Saves a round-trip to the ACME2 server, so you should give this
193             if you have it.
194              
195             =item * C - Optional. A hash reference to use as the
196             directory contents. Saves a round-trip to the ACME2 server, but there’s
197             no built-in logic to determine when the cache goes invalid. Caveat
198             emptor.
199              
200             =back
201              
202             =cut
203              
204             sub new {
205 13     13 1 15053 my ( $class, %opts ) = @_;
206              
207 13 50       57 _die_generic('Need “key”!') if !$opts{'key'};
208              
209 13         82 return $class->_new_without_key_check(%opts);
210             }
211              
212             sub _new_without_key_check {
213 19     19   59 my ( $class, %opts ) = @_;
214              
215             my $self = {
216             _host => $class->HOST(%opts),
217             _key => $opts{'key'},
218             _key_id => $opts{'key_id'},
219 19         124 _directory => $opts{'directory'},
220             };
221              
222 19         47 bless $self, $class;
223              
224 19         89 $self->_set_http();
225              
226 19         97 return $self;
227             }
228              
229             #----------------------------------------------------------------------
230              
231             =head2 $id = I->key_id()
232              
233             Returns the object’s cached key ID, either as given at instantiation
234             or as fetched in C.
235              
236             =cut
237              
238             sub key_id {
239 24     24 1 21284 my ($self) = @_;
240              
241 24         88 return $self->{'_key_id'};
242             }
243              
244             #----------------------------------------------------------------------
245              
246             =head2 I->http_timeout( [$NEW] )
247              
248             A passthrough interface to the underlying L object’s
249             C method.
250              
251             =cut
252              
253             sub http_timeout {
254 0     0 1 0 my $self = shift;
255              
256 0         0 return $self->{'_http'}->timeout(@_);
257             }
258              
259             #----------------------------------------------------------------------
260              
261             =head2 $url = I->get_terms_of_service()
262              
263             Returns the URL for the terms of service. Callable as either
264             a class method or an instance method.
265              
266             =cut
267              
268             sub get_terms_of_service {
269 18     18 1 12046 my ($self) = @_;
270              
271             # We want to be able to call this as a class method.
272 18 100       63 if (!ref $self) {
273 6         24 $self = $self->_new_without_key_check();
274             }
275              
276 18         68 my $dir = $self->_get_directory();
277              
278             # Exceptions here indicate an ACME violation and should be
279             # practically nonexistent.
280 18 50       43 my $url = $dir->{'meta'} or _die_generic('No “meta” in directory!');
281 18 50       48 $url = $url->{'termsOfService'} or _die_generic('No “termsOfService” in directory metadata!');
282              
283 18         90 return $url;
284             }
285              
286             #----------------------------------------------------------------------
287              
288             =head2 $created_yn = I->create_account( %OPTS )
289              
290             Creates an account using the ACME2 object’s key and the passed
291             %OPTS, which are as described in the ACME2 spec (cf. C).
292             Boolean values may be given as simple Perl booleans.
293              
294             Returns 1 if the account is newly created
295             or 0 if the account already existed.
296              
297             NB: C is an alias for this method.
298              
299             =cut
300              
301             sub create_account {
302 24     24 1 11141 my ($self, %opts) = @_;
303              
304 24         85 for my $name (newAccount_booleans()) {
305 48 100       416 next if !exists $opts{$name};
306 12   33     91 ($opts{$name} &&= JSON::true()) ||= JSON::false();
      33        
307             }
308              
309 24         137 my $resp = $self->_post(
310             'newAccount',
311             \%opts,
312             );
313              
314 24         84 $self->{'_key_id'} = $resp->header('location');
315              
316 24         290 $self->{'_http'}->set_key_id( $self->{'_key_id'} );
317              
318 24 100       458 return 0 if $resp->status() == _HTTP_OK;
319              
320 12 50       245 $resp->die_because_unexpected() if $resp->status() != _HTTP_CREATED;
321              
322 12         118 my $struct = $resp->content_struct();
323              
324 12 50       152 if ($struct) {
325 12         39 for my $name (newAccount_booleans()) {
326 24 100       195 next if !exists $struct->{$name};
327 12   50     74 ($struct->{$name} &&= 1) ||= 0;
      50        
328             }
329             }
330              
331 12         56 return 1;
332             }
333              
334             #----------------------------------------------------------------------
335              
336             =head2 $order = I->create_order( %OPTS )
337              
338             Returns a L object. %OPTS is as described in the
339             ACME spec (cf. C). Boolean values may be given as simple
340             Perl booleans.
341              
342             NB: C is an alias for this method.
343              
344             =cut
345              
346             sub create_order {
347 0     0 1 0 my ($self, %opts) = @_;
348              
349 0         0 $self->_require_key_id(\%opts);
350              
351 0         0 my $resp = $self->_post( 'newOrder', \%opts );
352              
353 0 0       0 $resp->die_because_unexpected() if $resp->status() != _HTTP_CREATED;
354              
355             return Net::ACME2::Order->new(
356             id => $resp->header('location'),
357 0         0 %{ $resp->content_struct() },
  0         0  
358             );
359             }
360              
361             #----------------------------------------------------------------------
362              
363             =head2 $authz = I->get_authorization( $URL )
364              
365             Fetches the authorization’s information based on the given $URL
366             and returns a L object.
367              
368             The URL is as given by L’s C method.
369              
370             =cut
371              
372             sub get_authorization {
373 0     0 1 0 my ($self, $id) = @_;
374              
375 0         0 my $resp = $self->_post_as_get($id);
376              
377             return Net::ACME2::Authorization->new(
378             id => $id,
379 0         0 %{ $resp->content_struct() },
  0         0  
380             );
381             }
382              
383             #----------------------------------------------------------------------
384              
385             =head2 $str = I->make_key_authorization( $CHALLENGE )
386              
387             Accepts an instance of L (probably a subclass
388             thereof) and returns
389             a key authorization string suitable for handling the given $CHALLENGE.
390             See F in the distribution for example usage.
391              
392             If you’re using HTTP authorization and are on the same server as the
393             domains’ document roots, then look at the handler logic in
394             L for a potentially simpler way to
395             handle HTTP challenges.
396              
397             =cut
398              
399             sub make_key_authorization {
400 2     2 1 12 my ($self, $challenge_obj) = @_;
401              
402 2 50       9 _die_generic('Need a challenge object!') if !$challenge_obj;
403              
404 2         17 return $challenge_obj->token() . '.' . $self->_key_thumbprint();
405             }
406              
407             #----------------------------------------------------------------------
408              
409             =head2 I->accept_challenge( $CHALLENGE )
410              
411             Signal to the ACME server that the CHALLENGE is ready.
412              
413             =cut
414              
415             sub accept_challenge {
416 0     0 1 0 my ($self, $challenge_obj) = @_;
417              
418 0         0 $self->_post_url(
419             $challenge_obj->url(),
420             {
421             keyAuthorization => $self->make_key_authorization($challenge_obj),
422             },
423             );
424              
425 0         0 return;
426             }
427              
428             #----------------------------------------------------------------------
429              
430             =head2 $status = I->poll_authorization( $AUTHORIZATION )
431              
432             Accepts a L instance and polls the
433             ACME server for that authorization’s status. The $AUTHORIZATION
434             object is then updated with the results of the poll.
435              
436             As a courtesy, this returns the $AUTHORIZATION’s new C.
437              
438             =cut
439              
440             #This has to handle updates to the authz and challenge objects
441             *poll_authorization = *_poll_order_or_authz;
442              
443             #----------------------------------------------------------------------
444              
445             =head2 $status = I->finalize_order( $ORDER, $CSR )
446              
447             Finalizes an order and updates the $ORDER object with the returned
448             status. $CSR may be in either DER or PEM format.
449              
450             As a courtesy, this returns the $ORDER’s C. If this does
451             not equal C, then you should probably C
452             until it does.
453              
454             =cut
455              
456             sub finalize_order {
457 0     0 1 0 my ($self, $order_obj, $csr) = @_;
458              
459 0         0 my $csr_der;
460 0 0       0 if (index($csr, '-----') == 0) {
461 0         0 $csr_der = Crypt::Format::pem2der($csr);
462             }
463             else {
464 0         0 $csr_der = $csr;
465             }
466              
467 0         0 $csr = MIME::Base64::encode_base64url($csr_der);
468              
469 0         0 my $post = $self->_post_url(
470             $order_obj->finalize(),
471             {
472             csr => $csr,
473             },
474             );
475              
476 0         0 my $content = $post->content_struct();
477              
478 0         0 $order_obj->update($content);
479              
480 0         0 return $order_obj->status();
481             }
482              
483             #----------------------------------------------------------------------
484              
485             =head2 $status = I->poll_order( $ORDER )
486              
487             Like C but handles a
488             L object instead.
489              
490             =cut
491              
492             *poll_order = *_poll_order_or_authz;
493              
494             #----------------------------------------------------------------------
495              
496             =head2 $cert = I->get_certificate_chain( $ORDER )
497              
498             Fetches the $ORDER’s certificate chain and returns
499             it in the format implied by the
500             C MIME type. See the ACME
501             protocol specification for details about this format.
502              
503             =cut
504              
505             sub get_certificate_chain {
506 0     0 1 0 my ($self, $order) = @_;
507              
508 0         0 return $self->_post_as_get( $order->certificate() )->content();
509             }
510              
511             #----------------------------------------------------------------------
512              
513             sub _key_thumbprint {
514 2     2   6 my ($self) = @_;
515              
516 2   66     14 return $self->{'_key_thumbprint'} ||= $self->_key_obj()->get_jwk_thumbprint();
517             }
518              
519             sub _get_directory {
520 66     66   116 my ($self) = @_;
521              
522 66   66     177 $self->{'_directory'} ||= do {
523 18         58 my $dir_path = $self->DIRECTORY_PATH();
524 18         90 $self->{'_http'}->get("https://$self->{'_host'}$dir_path")->content_struct();
525             };
526              
527 66 50       409 my $new_nonce_url = $self->{'_directory'}{'newNonce'} or do {
528 0         0 _die_generic('Directory is missing “newNonce”.');
529             };
530              
531 66         463 $self->{'_http'}->set_new_nonce_url( $new_nonce_url );
532              
533 66         144 return $self->{'_directory'};
534             }
535              
536             sub _require_key_id {
537 0     0   0 my ($self, $opts_hr) = @_;
538              
539 0 0       0 $opts_hr->{'_key_id'} = $self->{'_key_id'} or do {
540 0         0 _die_generic('No key ID has been set. Either pass “key_id” to new(), or create_account().');
541             };
542              
543             return
544 0         0 }
545              
546             sub _poll_order_or_authz {
547 0     0   0 my ($self, $order_or_authz_obj) = @_;
548              
549 0         0 my $get = $self->_post_as_get( $order_or_authz_obj->id() );
550              
551 0         0 my $content = $get->content_struct();
552              
553 0         0 $order_or_authz_obj->update($content);
554              
555 0         0 return $order_or_authz_obj->status();
556             }
557              
558             sub _key_obj {
559 14     14   45 my ($self) = @_;
560              
561 14   66     124 return $self->{'_key_obj'} ||= Net::ACME2::AccountKey->new($self->{'_key'});
562             }
563              
564             sub _set_http {
565 19     19   48 my ($self) = @_;
566              
567             $self->{'_http'} = Net::ACME2::HTTP->new(
568             key => $self->{'_key'} && $self->_key_obj(),
569 19   66     126 key_id => $self->{'_key_id'},
570             );
571              
572 19         44 return;
573             }
574              
575             our $_POST_METHOD;
576              
577             sub _post {
578 24     24   63 my ( $self, $link_name, $data ) = @_;
579              
580 24         47 my $post_method;
581 24 50       73 $post_method = 'post_full_jwt' if grep { $link_name eq $_ } FULL_JWT_METHODS();
  48         167  
582              
583             # Since the $link_name will come from elsewhere in this module
584             # there really shouldn’t be an error here, but just in case.
585 24 50       75 my $url = $self->_get_directory()->{$link_name} or _die_generic("Unknown link name: “$link_name”");
586              
587 24         92 return $self->_post_url( $url, $data, $post_method );
588             }
589              
590             sub _post_as_get {
591 0     0   0 my ( $self, $url ) = @_;
592              
593 0         0 return $self->_post_url( $url, q<> );
594             }
595              
596             sub _post_url {
597 24     24   65 my ( $self, $url, $data, $opt_post_method ) = @_;
598              
599             #Do this in case we haven’t initialized the directory yet.
600             #Initializing the directory is necessary to get a nonce.
601 24         60 $self->_get_directory();
602              
603 24   50     60 my $post_method = $opt_post_method || 'post_key_id';
604              
605 24         91 return $self->{'_http'}->$post_method( $url, $data );
606             }
607              
608             sub _die_generic {
609 0     0     die Net::ACME2::X->create('Generic', @_);
610             }
611              
612             #legacy aliases
613             *create_new_account = *create_account;
614             *create_new_order = *create_order;
615              
616             1;
617              
618             =head1 TODO
619              
620             =over
621              
622             =item * Add pre-authorization support if there is ever a production
623             use for it.
624              
625             =item * Expose the Retry-After header via the module API.
626              
627             =item * There is currently no way to fetch an order or challenge’s
628             properties via URL. Prior to ACME’s adoption of “POST-as-GET” this was
629             doable via a plain GET to the URL, but that’s no longer possible.
630             If there’s a need, I’ll consider adding such logic to Net::ACME2.
631             (It’s trivial to add; I’d just like to keep things as
632             simple as possible.)
633              
634             =item * Add (more) tests.
635              
636             =back
637              
638             =head1 SEE ALSO
639              
640             L is another ACME client library.
641              
642             L provides this library’s default cryptography backend.
643             See this distribution’s F directory for sample usage
644             to generate keys and CSRs.
645              
646             L implements client logic for the variant of this
647             protocol that Let’s Encrypt first deployed.
648              
649             =cut