File Coverage

blib/lib/Net/ACME2/HTTP.pm
Criterion Covered Total %
statement 74 93 79.5
branch 12 24 50.0
condition 4 9 44.4
subroutine 19 20 95.0
pod 0 6 0.0
total 109 152 71.7


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 2     2   11 use strict;
  2         3  
  2         44  
19 2     2   7 use warnings;
  2         4  
  2         32  
20              
21 2     2   562 use JSON ();
  2         10082  
  2         38  
22              
23 2     2   644 use Net::ACME2::Error ();
  2         3  
  2         31  
24 2     2   353 use Net::ACME2::HTTP_Tiny ();
  2         5  
  2         29  
25 2     2   692 use Net::ACME2::HTTP::Response ();
  2         5  
  2         38  
26 2     2   15 use Net::ACME2::X ();
  2         3  
  2         43  
27              
28 2     2   8 use constant _CONTENT_TYPE => 'application/jose+json';
  2         2  
  2         2054  
29              
30             #accessed from tests
31             our $_NONCE_HEADER = 'replay-nonce';
32              
33             #Used in testing
34             our $verify_SSL = 1;
35              
36             #NB: “key” isn’t needed if we’re just doing GETs.
37             sub new {
38 7     7 0 778767 my ( $class, %opts ) = @_;
39              
40 7 50       36 die Net::ACME2::X->create('Generic', 'need “key”!') if !$opts{'key'};
41              
42 7         59 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 7         43 _key_id => $opts{'key_id'},
48             }, $class;
49              
50 7         29 return bless $self, $class;
51             }
52              
53             sub set_key_id {
54 12     12 0 32 my ($self, $key_id) = @_;
55              
56 12         26 $self->{'_key_id'} = $key_id;
57              
58 12         27 return $self;
59             }
60              
61             sub set_new_nonce_url {
62 30     30 0 47 my ($self, $url) = @_;
63              
64 30         70 $self->{'_nonce_url'} = $url;
65              
66 30         46 return $self;
67             }
68              
69             #GETs submit no data and thus are not signed.
70             sub get {
71 6     6 0 15 my ( $self, $url ) = @_;
72              
73 6         22 return $self->_request( 'GET', $url );
74             }
75              
76             # ACME spec 6.2: for all requests not signed using an existing account,
77             # e.g., newAccount
78             sub post_full_jwt {
79 12     12 0 20 my $self = shift;
80              
81 12         37 return $self->_post( 'create_full_jws', @_ );
82             }
83              
84             # ACME spec 6.2: for all requests signed using an existing account
85             sub post_key_id {
86 0     0 0 0 my $self = shift;
87              
88 0         0 return $self->_post(
89             'create_key_id_jws',
90             @_,
91             );
92             }
93              
94             #----------------------------------------------------------------------
95              
96             #POSTs are signed.
97             sub _post {
98 12     12   32 my ( $self, $jwt_method, $url, $data, $opts_hr ) = @_;
99              
100             # Shouldn’t be needed because the constructor requires “key”,
101             # but just in case.
102 12 50       38 die "Constructor needed “key” to do POST! ($url)" if !$self->{'_acme_key'};
103              
104 12         46 my $jws = $self->_create_jwt( $jwt_method, $url, $data );
105              
106 12         69 local $opts_hr->{'headers'}{'Content-Type'} = 'application/jose+json';
107              
108 12   33     116 return $self->_request_and_set_last_nonce(
109             'POST',
110             $url,
111             {
112             content => $jws,
113             headers => {
114             'content-type' => _CONTENT_TYPE,
115             },
116             },
117             $opts_hr || (),
118             );
119             }
120              
121             sub _ua_request {
122 24     24   60 my ( $self, $type, @args ) = @_;
123              
124 24         132 return $self->{'_ua'}->request( $type, @args );
125             }
126              
127             #overridden in tests
128             sub _request {
129 24     24   74 my ( $self, $type, @args ) = @_;
130              
131 24         30 my $resp;
132              
133             #cf. eval_bug.readme
134 24         50 my $eval_err = $@;
135              
136 24         36 eval { $resp = $self->_ua_request( $type, @args ); };
  24         67  
137              
138             # Check ref() first to avoid potentially running overload.pm’s
139             # stringification.
140 24 50 33     115 if (ref($@) || $@) {
141 0         0 my $exc = $@;
142              
143 0 0       0 if ( eval { $exc->isa('Net::ACME2::X::HTTP::Protocol') } ) {
  0         0  
144 0         0 my $_nonce_header_lc = $_NONCE_HEADER;
145 0         0 $_nonce_header_lc =~ tr;
146              
147 0         0 my $nonce = $exc->get('headers')->{$_nonce_header_lc};
148 0 0       0 $self->{'_last_nonce'} = $nonce if $nonce;
149              
150             #If the exception is able to be made into a Net::ACME2::Error,
151             #then do so to get a nicer error message.
152 0         0 my $acme_error = eval {
153             Net::ACME2::Error->new(
154 0         0 %{ JSON::decode_json( $exc->get('content') ) },
  0         0  
155             );
156             };
157              
158 0 0       0 if ($acme_error) {
159 0         0 die Net::ACME2::X->create(
160             'ACME',
161             {
162             http => $exc,
163             acme => $acme_error,
164             },
165             );
166             }
167             }
168              
169 0         0 $@ = $exc;
170 0         0 die;
171             }
172              
173 24         47 $@ = $eval_err;
174              
175 24         89 return Net::ACME2::HTTP::Response->new($resp);
176             }
177              
178             sub _request_and_set_last_nonce {
179 18     18   59 my ( $self, $type, $url, @args ) = @_;
180              
181 18         62 my $resp = $self->_request( $type, $url, @args );
182              
183             #NB: ACME’s replay protection works thus:
184             # - each server response includes a nonce
185             # - each request must include ONE of the nonces that have been sent
186             # - once used, a nonce can’t be reused
187             #
188             #This is subtly different from what was originally in mind (i.e., that
189             #each request must use the most recently sent nonce). It implies that GETs
190             #do not need to send nonces, though each GET will *receive* a nonce that
191             #may be used.
192 18 50       883 $self->{'_last_nonce'} = $resp->header($_NONCE_HEADER) or do {
193 0         0 die Net::ACME2::X->create('Generic', "Received no $_NONCE_HEADER from $url!");
194             };
195              
196 18         350 return $resp;
197             }
198              
199             sub _get_first_nonce {
200 6     6   12 my ($self) = @_;
201              
202 6 50       16 my $url = $self->{'_nonce_url'} or do {
203              
204             # Shouldn’t happen unless there’s an errant refactor.
205 0         0 die Net::ACME2::X->create('Set newNonce URL first!');
206             };
207              
208 6         22 $self->_request_and_set_last_nonce( 'HEAD', $url );
209              
210 6         51 return;
211             }
212              
213             sub _create_jwt {
214 12     12   32 my ( $self, $jwt_method, $url, $data ) = @_;
215              
216 12 100       47 $self->_get_first_nonce() if !$self->{'_last_nonce'};
217              
218 12   66     41 $self->{'_jwt_maker'} ||= do {
219 6         8 my $class;
220              
221 6 100       72 if ($self->{'_acme_key'}->isa('Crypt::Perl::RSA::PrivateKey')) {
    50          
222 2         4 $class = 'Net::ACME2::JWTMaker::RSA';
223             }
224             elsif ($self->{'_acme_key'}->isa('Crypt::Perl::ECDSA::PrivateKey')) {
225 4         10 $class = 'Net::ACME2::JWTMaker::ECC';
226             }
227             else {
228              
229             # As of this writing, Crypt::Perl only does RSA and ECDSA keys.
230             # If we get here, it’s possible that Crypt::Perl now supports
231             # an additional key type that this library doesn’t recognize.
232 0         0 die Net::ACME2::X->create('Generic', "Unrecognized key type: $self->{'_acme_key'}");
233             }
234              
235 6 100       61 if (!$class->can('new')) {
236 2         13 require Module::Load;
237 2         10 Module::Load::load($class);
238             }
239              
240             $class->new(
241 6         55 key => $self->{'_acme_key'},
242             );
243             };
244              
245             return $self->{'_jwt_maker'}->$jwt_method(
246             key_id => $self->{'_key_id'},
247             payload => $data,
248             extra_headers => {
249 12         96 nonce => $self->{'_last_nonce'},
250             url => $url,
251             },
252             );
253             }
254              
255             1;