File Coverage

blib/lib/Net/ACME/HTTP.pm
Criterion Covered Total %
statement 75 76 98.6
branch 12 18 66.6
condition 3 6 50.0
subroutine 16 16 100.0
pod 0 3 0.0
total 106 119 89.0


line stmt bran cond sub pod time code
1             package Net::ACME::HTTP;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Net::ACME::HTTP - transport logic for C.
8              
9             =head1 SYNOPSIS
10              
11             my $resp = Net::ACME::HTTP->new()->get('https://url/to/endpoint');
12              
13             my $http_authn = Net::ACME::HTTP->new( key => $account_key );
14              
15             my $post_resp = $http_authn->post(
16             'https://url/to/endpoint',
17             { foo => 4 }, #i.e., the payload to send
18             %opts, #cf. HTTP::Tiny::request
19             );
20              
21             =head1 DESCRIPTION
22              
23             This module handles communication with an ACME server at the HTTP level.
24             It handles the wrapping of POSTs in JWSes (JSON Wed Signatures).
25              
26             Failure responses prompt exceptions. This includes cases like HTTP 409
27             from “new-reg”, which maybe isn’t an B case so much as just
28             something to accommodate.
29              
30             =cut
31              
32 7     7   209839 use strict;
  7         9  
  7         147  
33 7     7   19 use warnings;
  7         14  
  7         118  
34              
35 7     7   2261 use JSON ();
  7         26932  
  7         105  
36              
37 7     7   2181 use Net::ACME::Crypt ();
  7         14  
  7         110  
38 7     7   2010 use Net::ACME::Error ();
  7         11  
  7         103  
39 7     7   2183 use Net::ACME::HTTP_Tiny ();
  7         15  
  7         142  
40 7     7   2242 use Net::ACME::HTTP::Response ();
  7         10  
  7         113  
41 7     7   2153 use Net::ACME::Utils ();
  7         10  
  7         96  
42 7     7   70 use Net::ACME::X ();
  7         7  
  7         3540  
43              
44             #accessed from tests
45             our $_NONCE_HEADER = 'replay-nonce';
46              
47             #Used in testing
48             our $verify_SSL = 1;
49              
50             #NB: “key” isn’t needed if we’re just doing GETs.
51             sub new {
52 12     12 0 1041 my ( $class, %opts ) = @_;
53              
54 12         66 my $ua = Net::ACME::HTTP_Tiny->new( verify_SSL => $verify_SSL );
55              
56             my $self = bless {
57             _ua => $ua,
58 12   66     82 _acme_key => $opts{'key'} && Net::ACME::Crypt::parse_key($opts{'key'}),
59             }, $class;
60              
61 12         750656 return bless $self, $class;
62             }
63              
64             #GETs submit no data and thus are not signed.
65             sub get {
66 8     8 0 428 my ( $self, $url ) = @_;
67              
68 8         30 return $self->_request_and_set_last_nonce( 'get', $url );
69             }
70              
71             #POSTs are signed.
72             sub post {
73 9     9 0 478079 my ( $self, $url, $data, $opts_hr ) = @_;
74              
75 9 50       38 die "Constructor needed “key” to do POST! ($url)" if !$self->{'_acme_key'};
76              
77 9         181 my $jws = $self->_create_jws( JSON->new()->allow_nonref()->encode($data) );
78              
79 8   33     202 return $self->_request_and_set_last_nonce(
80             'post',
81             $url,
82             { content => $jws },
83             $opts_hr || (),
84             );
85             }
86              
87             #----------------------------------------------------------------------
88              
89             sub _ua_request {
90 13     13   23 my ( $self, $type, @args ) = @_;
91              
92 13         73 return $self->{'_ua'}->request( $type, @args );
93             }
94              
95             #overridden in tests
96             sub _request {
97 16     16   29 my ( $self, $type, @args ) = @_;
98              
99 16         18 my $resp;
100              
101             #cf. eval_bug.readme
102 16         30 my $eval_err = $@;
103              
104 16         21 eval { $resp = $self->_ua_request( $type, @args ); };
  16         40  
105              
106 16 100       243 if ($@) {
107 3         3 my $exc = $@;
108              
109 3 100       5 if ( eval { $exc->isa('Net::ACME::X::HTTP::Protocol') } ) {
  3         21  
110 2         5 my $_nonce_header_lc = $_NONCE_HEADER;
111 2         4 $_nonce_header_lc =~ tr;
112              
113 2         9 my $nonce = $exc->get('headers')->{$_nonce_header_lc};
114 2 50       8 $self->{'_last_nonce'} = $nonce if $nonce;
115              
116             #If the exception is able to be made into a Net::ACME::Error,
117             #then do so to get a nicer error message.
118 2         2 my $acme_error = eval {
119             Net::ACME::Error->new(
120 2         3 %{ JSON::decode_json( $exc->get('content') ) },
  2         4  
121             );
122             };
123              
124 2         5 my $detail;
125 2 50       8 if ($acme_error) {
126 2         12 $detail = $acme_error->detail();
127 2         9 my $desc = $acme_error->description();
128 2 50       5 if ($desc) {
129 2         9 $detail = sprintf "%s (%s)", $detail, $desc;
130             }
131             }
132             else {
133 0         0 $detail = $exc->get('content');
134             }
135              
136             die Net::ACME::X::create(
137             'Protocol',
138             {
139 2 50       2 ( map { $_ => $exc->get($_) } qw( url status reason headers ) ),
  8         14  
140             type => $acme_error ? $acme_error->type() : '(unknown type)',
141             detail => $detail,
142             }
143             );
144             }
145              
146 1         1 $@ = $exc;
147 1         9 die;
148             }
149              
150 13         20 $@ = $eval_err;
151              
152 13         125 return Net::ACME::HTTP::Response->new($resp);
153             }
154              
155             sub _request_and_set_last_nonce {
156 16     16   34 my ( $self, $type, @args ) = @_;
157              
158 16         49 my $resp = $self->_request( $type, @args );
159              
160             #NB: ACME’s replay protection works thus:
161             # - each server response includes a nonce
162             # - each request must include ONE of the nonces that have been sent
163             # - once used, a nonce can’t be reused
164             #
165             #This is subtly different from what was originally in mind (i.e., that
166             #each request must use the most recently sent nonce). It implies that GETs
167             #do not need to send nonces, though each GET will *receive* a nonce that
168             #may be used.
169 13 50       632 if ( my $nonce = $resp->header($_NONCE_HEADER) ) {
170 13         130 $self->{'_last_nonce'} = $nonce;
171             }
172              
173 13         74 return $resp;
174             }
175              
176             sub _create_jws {
177 9     9   19 my ( $self, $msg ) = @_;
178              
179 9 100       34 die "Need a nonce before JWS can be created!" if !$self->{'_last_nonce'};
180              
181             return Net::ACME::Crypt::create_jwt(
182             key => $self->{'_acme_key'},
183             extra_headers => {
184             nonce => $self->{'_last_nonce'},
185 8         57 jwk => $self->{'_acme_key'}->get_struct_for_public_jwk(),
186             },
187             payload => $msg,
188             );
189             }
190              
191             1;