File Coverage

blib/lib/Net/ACME2/HTTP.pm
Criterion Covered Total %
statement 82 117 70.0
branch 13 32 40.6
condition 3 6 50.0
subroutine 19 22 86.3
pod 0 7 0.0
total 117 184 63.5


line stmt bran cond sub pod time code
1             package Net::ACME2::HTTP;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Net::ACME2::HTTP - transport logic for C.
8              
9             =head1 DESCRIPTION
10              
11             This module handles communication with an ACME server at the HTTP level.
12             It wraps POSTs in JWSes (JSON Web Signatures) as needed.
13              
14             There should be no reason to interact with this class in production.
15              
16             =cut
17              
18 3     3   20 use strict;
  3         5  
  3         81  
19 3     3   15 use warnings;
  3         4  
  3         69  
20              
21 3     3   580 use JSON ();
  3         10375  
  3         59  
22              
23 3     3   1160 use Net::ACME2::Error ();
  3         6  
  3         55  
24 3     3   413 use Net::ACME2::HTTP_Tiny ();
  3         6  
  3         46  
25 3     3   1173 use Net::ACME2::HTTP::Response ();
  3         7  
  3         51  
26 3     3   16 use Net::ACME2::X ();
  3         5  
  3         50  
27              
28 3     3   12 use constant _CONTENT_TYPE => 'application/jose+json';
  3         4  
  3         3731  
29              
30             my $_MAX_RETRIES = 5;
31              
32             #accessed from tests
33             our $_NONCE_HEADER = 'replay-nonce';
34              
35             #Used in testing
36             our $verify_SSL = 1;
37              
38             #NB: “key” isn’t needed if we’re just doing GETs.
39             sub new {
40 19     19 0 98 my ( $class, %opts ) = @_;
41              
42 19         125 my $ua = Net::ACME2::HTTP_Tiny->new( verify_SSL => $verify_SSL );
43              
44             my $self = bless {
45             _ua => $ua,
46             _acme_key => $opts{'key'},
47 19         109 _key_id => $opts{'key_id'},
48              
49             _retries_left => $_MAX_RETRIES,
50             }, $class;
51              
52 19         81 return bless $self, $class;
53             }
54              
55             sub timeout {
56 0     0 0 0 my $self = shift;
57              
58 0         0 return $self->{'_ua'}->timeout(@_);
59             }
60              
61             sub set_key_id {
62 24     24 0 69 my ($self, $key_id) = @_;
63              
64 24         64 $self->{'_key_id'} = $key_id;
65              
66 24         45 return $self;
67             }
68              
69             sub set_new_nonce_url {
70 66     66 0 116 my ($self, $url) = @_;
71              
72 66         118 $self->{'_nonce_url'} = $url;
73              
74 66         103 return $self;
75             }
76              
77             #GETs submit no data and thus are not signed.
78             sub get {
79 18     18 0 39 my ( $self, $url ) = @_;
80              
81 18         60 return $self->_request( 'GET', $url );
82             }
83              
84             # ACME spec 6.2: for all requests not signed using an existing account,
85             # e.g., newAccount
86             sub post_full_jwt {
87 24     24 0 56 my $self = shift;
88              
89 24         83 return $self->_post( 'create_full_jws', @_ );
90             }
91              
92             # ACME spec 6.2: for all requests signed using an existing account
93             sub post_key_id {
94 0     0 0 0 my $self = shift;
95              
96 0         0 return $self->_post(
97             'create_key_id_jws',
98             @_,
99             );
100             }
101              
102             #----------------------------------------------------------------------
103              
104             #POSTs are signed.
105             sub _post {
106 24     24   76 my ( $self, $jwt_method, $url, $data, $opts_hr ) = @_;
107              
108             # Needed now that the constructor allows instantiation
109             # without “key”.
110 24 50       86 die "Constructor needed “key” to do POST! ($url)" if !$self->{'_acme_key'};
111              
112 24         98 my $jws = $self->_create_jwt( $jwt_method, $url, $data );
113              
114 24         145 local $opts_hr->{'headers'}{'Content-Type'} = 'application/jose+json';
115              
116 24         59 my $pre_err = $@;
117              
118 24         43 my $resp = eval {
119 24   33     237 $self->_request_and_set_last_nonce(
120             'POST',
121             $url,
122             {
123             content => $jws,
124             headers => {
125             'content-type' => _CONTENT_TYPE,
126             },
127             },
128             $opts_hr || (),
129             );
130             };
131              
132 24         96 my $err;
133              
134 24 50       114 if (!defined $resp) {
135 0         0 $err = $@;
136              
137 0 0       0 if ( eval { $err->get('acme')->type() =~ m<:badNonce\z> } ) {
  0         0  
138 0 0       0 if (!$self->{'_retries_left'}) {
    0          
139 0         0 warn( "$url: Received “badNonce” error, and no retries left!\n" );
140             }
141             elsif ($self->{'_last_nonce'}) {
142              
143             # This scenario seems worth a warn() because even if the
144             # retry succeeds, something probably went awry somewhere.
145              
146 0         0 warn( "$url: Received “badNonce” error! Retrying ($self->{'_retries_left'} left) …\n" );
147              
148 0         0 local $self->{'_retries_left'} = $self->{'_retries_left'} - 1;
149              
150             # NB: The success of this depends on our having recorded
151             # the Replay-Nonce from the last response.
152 0         0 $resp = $self->_post(@_[ 1 .. $#_ ]);
153             }
154             else {
155 0         0 warn( "$url: Received “badNonce” without a Replay-Nonce! (Server violates RFC 8555/6.5!) Cannot retry …" );
156             }
157             }
158             }
159              
160 24 50       90 if (!defined $resp) {
161 0         0 $@ = $err;
162 0         0 die;
163             }
164              
165 24         61 $@ = $pre_err;
166              
167 24         212 return $resp;
168             }
169              
170             sub _ua_request {
171 54     54   141 my ( $self, $type, @args ) = @_;
172              
173 54         293 return $self->{'_ua'}->request( $type, @args );
174             }
175              
176             sub _consume_nonce_in_headers {
177 0     0   0 my ($self, $headers_hr) = @_;
178              
179 0         0 my $_nonce_header_lc = $_NONCE_HEADER;
180 0         0 $_nonce_header_lc =~ tr;
181              
182 0         0 my $nonce = $headers_hr->{$_nonce_header_lc};
183              
184 0 0       0 $self->{'_last_nonce'} = $nonce if $nonce;
185              
186 0         0 return;
187             }
188              
189             #overridden in tests
190             sub _request {
191 54     54   151 my ( $self, $type, @args ) = @_;
192              
193 54         88 my $resp;
194              
195             #cf. eval_bug.readme
196 54         92 my $eval_err = $@;
197              
198 54 50       82 eval { $resp = $self->_ua_request( $type, @args ); 1 } or do {
  54         176  
  54         163  
199 0         0 my $exc = $@;
200              
201 0 0       0 if ( eval { $exc->isa('Net::ACME2::X::HTTP::Protocol') } ) {
  0         0  
202              
203 0         0 $self->_consume_nonce_in_headers( $exc->get('headers') );
204              
205             #If the exception is able to be made into a Net::ACME2::Error,
206             #then do so to get a nicer error message.
207 0         0 my $acme_error = eval {
208             Net::ACME2::Error->new(
209 0         0 %{ JSON::decode_json( $exc->get('content') ) },
  0         0  
210             );
211             };
212              
213 0 0       0 if ($acme_error) {
214 0         0 die Net::ACME2::X->create(
215             'ACME',
216             {
217             http => $exc,
218             acme => $acme_error,
219             },
220             );
221             }
222             }
223              
224 0         0 $@ = $exc;
225 0         0 die;
226             };
227              
228 54         112 $@ = $eval_err;
229              
230 54         213 return Net::ACME2::HTTP::Response->new($resp);
231             }
232              
233             sub _request_and_set_last_nonce {
234 36     36   128 my ( $self, $type, $url, @args ) = @_;
235              
236 36         124 my $resp = $self->_request( $type, $url, @args );
237              
238             #NB: ACME’s replay protection works thus:
239             # - each server response includes a nonce
240             # - each request must include ONE of the nonces that have been sent
241             # - once used, a nonce can’t be reused
242             #
243             #This is subtly different from what was originally in mind (i.e., that
244             #each request must use the most recently sent nonce). It implies that GETs
245             #do not need to send nonces, though each GET will *receive* a nonce that
246             #may be used.
247 36 50       2026 $self->{'_last_nonce'} = $resp->header($_NONCE_HEADER) or do {
248 0         0 die Net::ACME2::X->create('Generic', "Received no $_NONCE_HEADER from $url!");
249             };
250              
251 36         551 return $resp;
252             }
253              
254             sub _get_first_nonce {
255 12     12   29 my ($self) = @_;
256              
257 12 50       40 my $url = $self->{'_nonce_url'} or do {
258              
259             # Shouldn’t happen unless there’s an errant refactor.
260 0         0 die Net::ACME2::X->create('Generic', 'Set newNonce URL first!');
261             };
262              
263 12         39 $self->_request_and_set_last_nonce( 'HEAD', $url );
264              
265 12         116 return;
266             }
267              
268             sub _create_jwt {
269 24     24   69 my ( $self, $jwt_method, $url, $data ) = @_;
270              
271 24   66     94 $self->{'_jwt_maker'} ||= do {
272 12         18 my $class;
273              
274 12         64 my $key_type = $self->{'_acme_key'}->get_type();
275              
276 12 100       51 if ($key_type eq 'rsa') {
    50          
277 4         7 $class = 'Net::ACME2::JWTMaker::RSA';
278             }
279             elsif ($key_type eq 'ecdsa') {
280 8         15 $class = 'Net::ACME2::JWTMaker::ECC';
281             }
282             else {
283              
284             # As of this writing, Crypt::Perl only does RSA and ECDSA keys.
285             # If we get here, it’s possible that Crypt::Perl now supports
286             # an additional key type that this library doesn’t recognize.
287 0         0 die Net::ACME2::X->create('Generic', "Unrecognized key type: “$key_type”");
288             }
289              
290 12 100       127 if (!$class->can('new')) {
291 4         27 require Module::Runtime;
292 4         18 Module::Runtime::use_module($class);
293             }
294              
295             $class->new(
296 12         99 key => $self->{'_acme_key'},
297             );
298             };
299              
300 24 100       110 $self->_get_first_nonce() if !$self->{'_last_nonce'};
301              
302             # Ideally we’d wait until we’ve confirmed that this JWT reached the
303             # server to delete the local nonce, but at this point a failure to
304             # reach the server seems pretty edge-case-y. Even if that happens,
305             # we’ll just request another nonce next time, so no big deal.
306 24         59 my $nonce = delete $self->{'_last_nonce'};
307              
308             # For testing badNonce retry:
309             # $nonce = reverse($nonce) if $self->{'_retries_left'};
310             # $nonce = reverse($nonce);
311              
312             return $self->{'_jwt_maker'}->$jwt_method(
313 24         189 key_id => $self->{'_key_id'},
314             payload => $data,
315             extra_headers => {
316             nonce => $nonce,
317             url => $url,
318             },
319             );
320             }
321              
322             1;