File Coverage

blib/lib/Mojo/ACME.pm
Criterion Covered Total %
statement 91 136 66.9
branch 18 34 52.9
condition 6 14 42.8
subroutine 19 30 63.3
pod 0 7 0.0
total 134 221 60.6


line stmt bran cond sub pod time code
1             package Mojo::ACME;
2              
3 1     1   536395 use Mojo::Base -base;
  1         3  
  1         8  
4              
5             our $VERSION = '0.13';
6             $VERSION = eval $VERSION;
7              
8 1     1   174 use Mojo::Collection 'c';
  1         3  
  1         67  
9 1     1   8 use Mojo::JSON qw/encode_json/;
  1         2  
  1         40  
10 1     1   5 use Mojo::URL;
  1         2  
  1         25  
11              
12 1     1   557 use Crypt::OpenSSL::PKCS10;
  1         786  
  1         54  
13 1     1   7 use MIME::Base64 qw/encode_base64url encode_base64 decode_base64/;
  1         2  
  1         55  
14 1     1   6 use Scalar::Util ();
  1         2  
  1         16  
15              
16 1     1   500 use Mojo::ACME::Key;
  1         2  
  1         31  
17 1     1   524 use Mojo::ACME::ChallengeServer;
  1         3  
  1         9  
18              
19             has account_key => sub { Mojo::ACME::Key->new(path => 'account.key') };
20             has ca => sub { die 'ca is required' };
21             has challenges => sub { {} };
22             #TODO use cert_key->key if it exists
23             has cert_key => sub { Mojo::ACME::Key->new };
24              
25             has secret => sub { die 'secret is required' };
26             has server => sub { Mojo::ACME::ChallengeServer->new(acme => shift)->start };
27             has server_url => 'http://127.0.0.1:5000';
28             has ua => sub {
29             my $self = shift;
30             Scalar::Util::weaken $self;
31             my $ua = Mojo::UserAgent->new;
32             $ua->on(start => sub {
33             my (undef, $tx) = @_;
34             $tx->on(finish => sub {
35             my $tx = shift;
36             return unless $self && $tx->success;
37             return unless my $nonce = $tx->res->headers->header('Replay-Nonce');
38             push @{$self->{nonces} ||= []}, $nonce;
39             });
40             });
41             return $ua;
42             };
43              
44             sub check_all_challenges {
45 0     0 0 0 my ($self, $cb) = (shift, pop);
46 0         0 my @pending = $self->pending_challenges->each;
47             Mojo::IOLoop->delay(
48             sub {
49 0     0   0 my $delay = shift;
50 0 0       0 $delay->pass unless @pending;
51 0         0 $self->check_challenge_status($_, $delay->begin) for @pending;
52             },
53             sub {
54 0     0   0 my $delay = shift;
55 0 0       0 if (my $err = c(@_)->first(sub{ ref })) { return $self->$cb($err) }
  0         0  
  0         0  
56 0 0       0 return $self->$cb(undef) unless $self->pending_challenges->size;
57 0         0 Mojo::IOLoop->timer(2 => $delay->begin);
58             },
59 0     0   0 sub { $self->check_all_challenges($cb) },
60 0         0 );
61             }
62              
63             sub check_challenge_status {
64 3     3 0 4638 my ($self, $token, $cb) = @_;
65 1     1   169 return Mojo::IOLoop->next_tick(sub{ $self->$cb({token => $token, message => 'unknown token'}) })
66 3 100       11 unless my $challenge = $self->challenges->{$token};
67             $self->ua->get($challenge->{uri} => sub {
68 2     2   762 my ($ua, $tx) = @_;
69 2         5 my $err;
70 2 100       7 if (my $res = $tx->success) {
71 1         27 $self->challenges->{$token} = $res->json;
72             } else {
73 1         21 $err = $tx->error;
74 1         15 $err->{token} = $token;
75             }
76 2         222 $self->$cb($err);
77 2         19 });
78             }
79              
80             sub get_cert {
81 2     2 0 8280 my ($self, @names) = @_;
82 2         10 my $csr = _pem_to_der($self->generate_csr(@names));
83 2         78 my $req = $self->signed_request({
84             resource => 'new-cert',
85             csr => encode_base64url($csr),
86             });
87 2         185 my $url = $self->ca->url('/acme/new-cert');
88 2         7 my $tx = $self->ua->post($url, $req);
89 2         824 _die_if_error($tx, 'Failed to get cert');
90 1         39 return _der_to_cert($tx->res->body);
91             }
92              
93             sub get_nonce {
94 3     3   15692 my $self = shift;
95 3   100     20 my $nonces = $self->{nonces} ||= [];
96 3 100       14 return shift @$nonces if @$nonces;
97              
98             # try to populate the nonce cache
99 2         10 my $url = $self->ca->url('/directory');
100 2         8 my $tx = $self->ua->head($url);
101 2 100       6082 return shift @$nonces if @$nonces;
102              
103             # use result directly otherwise
104             # if say the default ua has been replaced
105 1         7 _die_if_error($tx, 'Could not get nonce');
106 1         50 my $nonce = $tx->res->headers->header('Replay-Nonce');
107 1 50       26 return $nonce if $nonce;
108 0 0       0 die "Response did not contain a nonce\n" unless @$nonces;
109             }
110              
111             sub generate_csr {
112 1     1   25 my ($self, $primary, @alts) = @_;
113              
114 1         4 my $rsa = $self->cert_key->key_clone;
115 1         42 my $req = Crypt::OpenSSL::PKCS10->new_from_rsa($rsa);
116 1         57 $req->set_subject("/CN=$primary");
117 1 50       6 if (@alts) {
118 0         0 my $alt = join ',', map { "DNS:$_" } ($primary, @alts);
  0         0  
119 0         0 $req->add_ext(Crypt::OpenSSL::PKCS10::NID_subject_alt_name, $alt);
120             }
121 1         7 $req->add_ext_final;
122 1         15941 $req->sign;
123 1         72 return $req->get_pem_req;
124             }
125              
126             sub keyauth {
127 1     1 0 1999 my ($self, $token) = @_;
128 1         7 return $token . '.' . $self->account_key->thumbprint;
129             }
130              
131             sub new_authz {
132 0     0 0 0 my ($self, $value) = @_;
133 0         0 $self->server; #ensure initialized
134 0         0 my $url = $self->ca->url('/acme/new-authz');
135 0         0 my $req = $self->signed_request({
136             resource => 'new-authz',
137             identifier => {
138             type => 'dns',
139             value => $value,
140             },
141             });
142 0         0 my $tx = $self->ua->post($url, $req);
143 0         0 _die_if_error($tx, 'Error requesting challenges', 201);
144              
145 0   0     0 my $challenges = $tx->res->json('/challenges') || [];
146             die "No http challenge available\n"
147 0 0   0   0 unless my $challenge = c(@$challenges)->first(sub{ $_->{type} eq 'http-01' });
  0         0  
148              
149 0         0 my $token = $challenge->{token};
150 0         0 $self->challenges->{$token} = $challenge;
151              
152 0         0 my $trigger = $self->signed_request({
153             resource => 'challenge',
154             keyAuthorization => $self->keyauth($token),
155             });
156 0         0 $tx = $self->ua->post($challenge->{uri}, $trigger);
157 0         0 _die_if_error($tx, 'Error triggering challenge', 202);
158             }
159              
160             sub pending_challenges {
161 0     0 0 0 my $self = shift;
162 0         0 c(values %{ $self->challenges })
163 0     0   0 ->grep(sub{ $_->{status} eq 'pending' })
164 0     0   0 ->map(sub{ $_->{token} })
165 0         0 }
166              
167             sub register {
168 3     3 0 7922 my $self = shift;
169 3         13 my $url = $self->ca->url('/acme/new-reg');
170 3         15 my $req = $self->signed_request({
171             resource => 'new-reg',
172             agreement => $self->ca->agreement,
173             });
174 3         306 my $res = $self->ua->post($url, $req)->result;
175 3         1454 my $code = $res->code;
176 3 50       21 if ($code == 400) {
177 0         0 my $detail = $res->json('/detail');
178 0   0     0 die "$detail\n" || 'An error occurred';
179             }
180             return
181 3 100       31 $code == 201 ? 'Account Created' :
    100          
182             $code == 409 ? 'Account Exists' :
183             undef;
184             }
185              
186             sub signed_request {
187 1     1   25 my ($self, $payload) = @_;
188 1         14 $payload = encode_base64url(encode_json($payload));
189 1         98 my $key = $self->account_key;
190 1         9 my $jwk = $key->jwk;
191              
192 1         76 my $header = {
193             alg => 'RS256',
194             jwk => {%$jwk}, # clone the jwk for safety's sake
195             };
196              
197 1         3 my $protected = do {
198 1         8 local $header->{nonce} = $self->get_nonce;
199 1         32 encode_base64url(encode_json($header));
200             };
201              
202 1         175 my $sig = encode_base64url($key->sign("$protected.$payload"));
203 1         38 return encode_json {
204             header => $header,
205             payload => $payload,
206             protected => $protected,
207             signature => $sig,
208             };
209             }
210              
211             sub _die_if_error {
212 3     3   9 my ($tx, $msg, $code) = @_;
213 3 50 33     11 return if $tx->success && (!$code || $code == $tx->res->code);
      66        
214 1         21 my $error = $tx->error;
215 1 50       17 if ($error->{code}) { $msg .= " (code $error->{code})" }
  1         5  
216 1         4 $msg .= " $error->{message}";
217 1   50     5 my $json = $tx->res->json || {};
218 1 50       135 if (my $detail = $json->{detail}) { $msg .= " - $detail" }
  1         5  
219 1         8 die "$msg\n";
220             }
221              
222             sub _pem_to_der {
223 0     0     my $cert = shift;
224 0           $cert =~ s/^-{5}.*$//mg;
225 0           return decode_base64(Mojo::Util::trim($cert));
226             }
227              
228             sub _der_to_cert {
229 0     0     my $der = shift;
230 0           my $pem = encode_base64($der, '');
231 0           $pem =~ s!(.{1,64})!$1\n!g; # stolen from Convert::PEM
232 0           return sprintf "-----BEGIN CERTIFICATE-----\n%s-----END CERTIFICATE-----\n", $pem;
233             }
234              
235             1;
236              
237             =head1 NAME
238              
239             Mojo::ACME - Mojo-based ACME-protocol client
240              
241             =head1 SYNOPSIS
242              
243             # myapp.pl
244             use Mojolicious::Lite;
245             plugin 'ACME';
246             get '/' => {text => 'Hello World'};
247             app->start;
248              
249             # then on the command line, while the app is available on port 80
250             # NOTE! you should use -t when testing on following command
251              
252             # register an account key if necessary
253             $ ./myapp.pl acme account register
254             Writing account.key
255              
256             # generate your domain cert
257             $ ./myapp.pl acme cert generate mydomain.com
258             Writing myapp.key
259             Writing myapp.crt
260              
261             # install your cert and restart your server per server instructions
262              
263             =head1 DESCRIPTION
264              
265             L (also known as letsencrypt) is a service that provices free SSL certificates via an automated system.
266             The service uses (and indeed defines) a protocol called ACME to securely communicate authentication, verification, and certificate issuance.
267             If you aren't familiar with ACME or at least certificate issuance, you might want to see L first.
268             While many clients already exist, web framework plugins have the unique ability to handle the challenge response internally and therefore make for the easiest possible letsencrypt (or other ACME service) experience.
269              
270             =head1 DEVELOPMENT STATUS
271              
272             The plugin and command level apis should be fairly standardized; the author expects few changes to this level of the system.
273             That said, the lower level modules, like L are to be considered unstable and should not be relied upon.
274             Use of these classes directly is highly discouraged for the time being.
275              
276             =head1 ARCHITECTURE
277              
278             The system consists of three major component classes, the plugin L, the commands, and the lower level classes which they rely on.
279              
280             =head2 Plugin
281              
282             The plugin is the glue that holds the system together.
283             It adds the C command (and its subcommands) to your app's command system.
284             It also establishes a route which handles the challenge request from the ACME service.
285             During your certificate issuance, you must prove that you control the requested domain by serving specified content at a specific location.
286             This route makes that possible.
287              
288             The plugin itself reads configuration out of the application's L method.
289             This can be set directly in the application or loaded from a file via say L in the usual way.
290             It looks for a config key C containing a hash of configuration options.
291             Those options can be seen in the L documentation.
292              
293             The most important of these is C.
294             In order to know how to respond to the challenge request, your server will make a signed HTTP request to your ACME client which will be listening.
295             This url is used both as the listen value of the ACME client's built-in server, as well as the base of your server's request.
296             It is advised that you use a url which isn't publically available if possible, though the requests are HMAC signed in any event.
297              
298             =head2 Commands
299              
300             The system provides several commands, including those for creating and verifying an account, as well as certificate issuance (and soon, revoking).
301             The commands are made available simply by using the plugin in your application.
302             They are then available in the same manner as built-in commands
303              
304             $ ./myapp.pl acme ...
305              
306             While some options are sub-command specific, all sub-commands take a few options.
307             Important among those is the C<--ca> option and more conveniently the C<--test> (or C<-t>) flag.
308             Let's Encrypt has severe rate limiting for issuance of certicates on its production hosts.
309             Using the test flag uses the staging server which has greatly relaxed rate limits, though doesn't issue signed certs or create real accounts.
310             It does however use exactly the same process as the production service and issue valid (if not signed) certs.
311             The author highly recommends trying the process on the staging server first.
312              
313             =head2 Modules (Low Level Usage)
314              
315             As mentioned before, the author hopes to stabilize the low-level interface to be reusable/accessible, however for the time being that is not so and things WILL CHANGE UNEXPECTEDLY!
316              
317             =head1 SEE ALSO
318              
319             =over
320              
321             =item *
322              
323             L - L
324              
325             =item *
326              
327             Let's Encrypt - L
328              
329             =item *
330              
331             ACME Protocol - L
332              
333             =item *
334              
335             acme-tiny client from which I took a lot of inspiration/direction - L
336              
337             =back
338              
339              
340             =head1 SOURCE REPOSITORY
341              
342             L
343              
344             =head1 AUTHOR
345              
346             Joel Berger, Ejoel.a.berger@gmail.comE
347              
348             =head1 CONTRIBUTORS
349              
350             =over
351              
352             =item *
353              
354             Mario Domgoergen (mdom)
355              
356             =back
357              
358             =head1 COPYRIGHT AND LICENSE
359              
360             Copyright (C) 2016 by Joel Berger and L
361              
362             This library is free software; you can redistribute it and/or modify
363             it under the same terms as Perl itself.
364