File Coverage

blib/lib/Net/Amazon/Signature/V4.pm
Criterion Covered Total %
statement 109 122 89.3
branch 25 32 78.1
condition 10 15 66.6
subroutine 16 17 94.1
pod 2 2 100.0
total 162 188 86.1


line stmt bran cond sub pod time code
1             package Net::Amazon::Signature::V4;
2              
3 2     2   68713 use strict;
  2         11  
  2         58  
4 2     2   10 use warnings;
  2         4  
  2         66  
5 2     2   1063 use sort 'stable';
  2         1190  
  2         11  
6              
7 2     2   1099 use Digest::SHA qw/sha256_hex hmac_sha256 hmac_sha256_hex/;
  2         6125  
  2         162  
8 2     2   1139 use Time::Piece ();
  2         23754  
  2         59  
9 2     2   2761 use URI::Escape;
  2         2989  
  2         3671  
10              
11             our $ALGORITHM = 'AWS4-HMAC-SHA256';
12              
13             =head1 NAME
14              
15             Net::Amazon::Signature::V4 - Implements the Amazon Web Services signature version 4, AWS4-HMAC-SHA256
16              
17             =head1 VERSION
18              
19             Version 0.20
20              
21             =cut
22              
23             our $VERSION = '0.20';
24              
25              
26             =head1 SYNOPSIS
27              
28             use Net::Amazon::Signature::V4;
29              
30             my $sig = Net::Amazon::Signature::V4->new( $access_key_id, $secret, $endpoint, $service );
31             my $req = HTTP::Request->parse( $request_string );
32             my $signed_req = $sig->sign( $req );
33             ...
34              
35             =head1 DESCRIPTION
36              
37             This module signs an HTTP::Request to Amazon Web Services by appending an Authorization header. Amazon Web Services signature version 4, AWS4-HMAC-SHA256, is used.
38              
39             The primary purpose of this module is to be used by Net::Amazon::Glacier.
40              
41             =head1 METHODS
42              
43             =head2 new
44              
45             my $sig = Net::Amazon::Signature::V4->new( $access_key_id, $secret, $endpoint, $service );
46             my $sig = Net::Amazon::Signature::V4->new({
47             access_key_id => $access_key_id,
48             secret => $secret,
49             endpoint => $endpoint,
50             service => $service,
51             });
52              
53             Constructs the signature object, which is used to sign requests.
54              
55             Note that the access key ID is an alphanumeric string, not your account ID. The endpoint could be "eu-west-1", and the service could be "glacier".
56              
57             Since version 0.20, parameters can be passed in a hashref. The keys C, C, C, and C are required.
58             C, if passed, will be applied to each signed request as the C header.
59              
60             =cut
61              
62             sub new {
63 1     1 1 897 my $class = shift;
64 1         3 my $self = {};
65 1 50 33     7 if (@_ == 1 and ref $_[0] eq 'HASH') {
66 0         0 @$self{keys %{$_[0]}} = values %{$_[0]};
  0         0  
  0         0  
67             } else {
68 1         5 @$self{qw(access_key_id secret endpoint service)} = @_;
69             }
70             # The URI should not be double escaped for the S3 service
71 1 50       6 $self->{no_escape_uri} = ( lc($self->{service}) eq 's3' ) ? 1 : 0;
72 1         3 bless $self, $class;
73 1         3 return $self;
74             }
75              
76             =head2 sign
77              
78             my $signed_request = $sig->sign( $request );
79              
80             Signs a request with your credentials by appending the Authorization header. $request should be an HTTP::Request. The signed request is returned.
81              
82             =cut
83              
84             sub sign {
85 0     0 1 0 my ( $self, $request ) = @_;
86 0         0 my $authz = $self->_authorization( $request );
87 0         0 $request->header( Authorization => $authz );
88 0         0 return $request;
89             }
90              
91             # _headers_to_sign:
92             # Return the sorted lower case headers as required by the generation of canonical headers
93              
94             sub _headers_to_sign {
95 124     124   182 my $req = shift;
96              
97 124         281 return sort { $a cmp $b } map { lc } $req->headers->header_field_names;
  616         1112  
  524         5441  
98             }
99              
100             # _canonical_request:
101             # Construct the canonical request string from an HTTP::Request.
102              
103             sub _canonical_request {
104 93     93   46766 my ( $self, $req ) = @_;
105              
106 93         593 my $creq_method = $req->method;
107              
108 93 100       1061 my ( $creq_canonical_uri, $creq_canonical_query_string ) =
109             ( $req->uri =~ m@([^?]*)\?(.*)$@ )
110             ? ( $1, $2 )
111             : ( $req->uri, '' );
112 93         1864 $creq_canonical_uri =~ s@^https?://[^/]*/?@/@;
113 93         432 $creq_canonical_uri = $self->_simplify_uri( $creq_canonical_uri );
114 93         247 $creq_canonical_query_string = _sort_query_string( $creq_canonical_query_string );
115              
116             # Ensure Host header is present as its required
117 93 50       253 if (!$req->header('host')) {
118 0         0 $req->header('Host' => $req->uri->host);
119             }
120 93         4278 my $creq_payload_hash = $req->header('x-amz-content-sha256');
121 93 100       4258 if (!$creq_payload_hash) {
122 31         92 $creq_payload_hash = sha256_hex($req->content);
123             # X-Amz-Content-Sha256 must be specified now
124 31         629 $req->header('X-Amz-Content-Sha256' => $creq_payload_hash);
125             }
126              
127             # There's a bug in AMS4 which causes requests without x-amz-date set to be rejected
128             # so we always add one if its not present.
129 93         1812 my $amz_date = $req->header('x-amz-date');
130 93 100       3974 if (!$amz_date) {
131 31         86 $req->header('X-Amz-Date' => _req_timepiece($req)->strftime('%Y%m%dT%H%M%SZ'));
132             }
133 93 50 33     5738 if (defined $self->{security_token} and !defined $req->header('X-Amz-Security-Token')) {
134 0         0 $req->header('X-Amz-Security-Token' => $self->{security_token});
135             }
136 93         194 my @sorted_headers = _headers_to_sign( $req );
137             my $creq_canonical_headers = join '',
138             map {
139 93         241 sprintf "%s:%s\x0a",
140             lc,
141 393         1146 join ',', sort {$a cmp $b } _trim_whitespace($req->header($_) )
  24         66  
142             }
143             @sorted_headers;
144 93         219 my $creq_signed_headers = join ';', map {lc} @sorted_headers;
  393         767  
145 93         334 my $creq = join "\x0a",
146             $creq_method, $creq_canonical_uri, $creq_canonical_query_string,
147             $creq_canonical_headers, $creq_signed_headers, $creq_payload_hash;
148 93         296 return $creq;
149             }
150              
151             # _string_to_sign
152             # Construct the string to sign.
153              
154             sub _string_to_sign {
155 62     62   21203 my ( $self, $req ) = @_;
156 62         131 my $dt = _req_timepiece( $req );
157 62         3426 my $creq = $self->_canonical_request($req);
158 62         208 my $sts_request_date = $dt->strftime( '%Y%m%dT%H%M%SZ' );
159 62         2544 my $sts_credential_scope = join '/', $dt->strftime('%Y%m%d'), $self->{endpoint}, $self->{service}, 'aws4_request';
160 62         2143 my $sts_creq_hash = sha256_hex( $creq );
161              
162 62         192 my $sts = join "\x0a", $ALGORITHM, $sts_request_date, $sts_credential_scope, $sts_creq_hash;
163 62         218 return $sts;
164             }
165              
166             # _authorization
167             # Construct the authorization string
168              
169             sub _authorization {
170 31     31   21025 my ( $self, $req ) = @_;
171              
172 31         79 my $dt = _req_timepiece( $req );
173 31         1904 my $sts = $self->_string_to_sign( $req );
174 31         83 my $k_date = hmac_sha256( $dt->strftime('%Y%m%d'), 'AWS4' . $self->{secret} );
175 31         1217 my $k_region = hmac_sha256( $self->{endpoint}, $k_date );
176 31         237 my $k_service = hmac_sha256( $self->{service}, $k_region );
177 31         221 my $k_signing = hmac_sha256( 'aws4_request', $k_service );
178              
179 31         279 my $authz_signature = hmac_sha256_hex( $sts, $k_signing );
180 31         87 my $authz_credential = join '/', $self->{access_key_id}, $dt->strftime('%Y%m%d'), $self->{endpoint}, $self->{service}, 'aws4_request';
181 31         831 my $authz_signed_headers = join ';', _headers_to_sign( $req );
182              
183 31         126 my $authz = "$ALGORITHM Credential=$authz_credential,SignedHeaders=$authz_signed_headers,Signature=$authz_signature";
184 31         110 return $authz;
185              
186             }
187              
188             =head1 AUTHOR
189              
190             Tim Nordenfur, C<< >>
191              
192             Maintained by Dan Book, C<< >>
193              
194             =cut
195              
196             sub _simplify_uri {
197 93     93   143 my $self = shift;
198 93         153 my $orig_uri = shift;
199 93         217 my @parts = split /\//, $orig_uri;
200 93         471 my @simple_parts = ();
201 93         204 for my $part ( @parts ) {
202 78 100 100     492 if ( $part eq '' || $part eq '.' ) {
    100          
203             } elsif ( $part eq '..' ) {
204 9         16 pop @simple_parts;
205             } else {
206 33 50       69 if ( $self->{no_escape_uri} ) {
207 0         0 push @simple_parts, $part;
208             }
209             else {
210 33         79 push @simple_parts, uri_escape($part);
211             }
212             }
213             }
214 93         545 my $simple_uri = '/' . join '/', @simple_parts;
215 93 100 100     345 $simple_uri .= '/' if $orig_uri =~ m@/$@ && $simple_uri !~ m@/$@;
216 93         695 return $simple_uri;
217             }
218             sub _sort_query_string {
219 93 100   93   227 return '' unless $_[0];
220 30         49 my @params;
221 30         78 for my $param ( split /&/, $_[0] ) {
222             my ( $key, $value ) =
223 42         103 map { tr/+/ /; uri_escape( uri_unescape( $_ ) ) } # escape all non-unreserved chars
  78         805  
  78         174  
224             split /=/, $param;
225 42 100       1008 push @params, [$key, (defined $value ? $value : '')];
226             }
227             return join '&',
228 42         154 map { join '=', @$_ }
229 30 50       89 sort { ( $a->[0] cmp $b->[0] ) || ( $a->[1] cmp $b->[1] ) }
  12         50  
230             @params;
231             }
232             sub _trim_whitespace {
233 393     393   15420 return map { my $str = $_; $str =~ s/^\s*//; $str =~ s/\s*$//; $str } @_;
  408         621  
  408         1633  
  408         2533  
  408         2322  
234             }
235             sub _str_to_timepiece {
236 124     124   228 my $date = shift;
237 124 100       650 if ( $date =~ m/^\d{8}T\d{6}Z$/ ) {
238             # assume basic ISO 8601, as demanded by AWS
239 93         415 return Time::Piece->strptime($date, '%Y%m%dT%H%M%SZ');
240             } else {
241             # assume the format given in the AWS4 test suite
242 31         155 $date =~ s/^.{5}//; # remove weekday, as Amazon's test suite contains internally inconsistent dates
243 31         171 return Time::Piece->strptime($date, '%d %b %Y %H:%M:%S %Z');
244             }
245             }
246             sub _req_timepiece {
247 124     124   225 my $req = shift;
248 124         345 my $x_date = $req->header('X-Amz-Date');
249 124   66     5547 my $date = $x_date || $req->header('Date');
250 124 50       1453 if (!$date) {
251             # No date set by the caller so set one up
252 0         0 my $piece = Time::Piece::gmtime;
253 0         0 $req->date($piece->epoch);
254 0         0 return $piece
255             }
256 124         252 return _str_to_timepiece($date);
257             }
258              
259             =head1 BUGS
260              
261             Please report any bugs or feature requests to C, or through
262             the web interface at L. I will be notified, and then you'll
263             automatically be notified of progress on your bug as I make changes.
264              
265              
266              
267              
268             =head1 SUPPORT
269              
270             You can find documentation for this module with the perldoc command.
271              
272             perldoc Net::Amazon::Signature::V4
273              
274              
275             You can also look for information at:
276              
277             =over 4
278              
279             =item * RT: CPAN's request tracker (report bugs here)
280              
281             L
282              
283             =item * Source on GitHub
284              
285             L
286              
287             =item * Search CPAN
288              
289             L
290              
291             =back
292              
293             =head1 LICENSE AND COPYRIGHT
294              
295             This software is copyright (c) 2012 by Tim Nordenfur.
296              
297             This is free software; you can redistribute it and/or modify it under
298             the same terms as the Perl 5 programming language system itself.
299              
300              
301             =cut
302              
303             1; # End of Net::Amazon::Signature::V4