line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Amazon::S3::Signature::V4Implementation; |
2
|
|
|
|
|
|
|
# ABSTRACT: Implements the Amazon Web Services signature version 4, AWS4-HMAC-SHA256 (copy of Net::Amazon::Signature::V4) |
3
|
|
|
|
|
|
|
$Net::Amazon::S3::Signature::V4Implementation::VERSION = '0.98'; |
4
|
|
|
|
|
|
|
|
5
|
96
|
|
|
96
|
|
813
|
use strict; |
|
96
|
|
|
|
|
274
|
|
|
96
|
|
|
|
|
3470
|
|
6
|
96
|
|
|
96
|
|
612
|
use warnings; |
|
96
|
|
|
|
|
242
|
|
|
96
|
|
|
|
|
3093
|
|
7
|
96
|
|
|
96
|
|
54866
|
use sort 'stable'; |
|
96
|
|
|
|
|
61866
|
|
|
96
|
|
|
|
|
674
|
|
8
|
|
|
|
|
|
|
|
9
|
96
|
|
|
96
|
|
5371
|
use Digest::SHA qw/sha256_hex hmac_sha256 hmac_sha256_hex/; |
|
96
|
|
|
|
|
275
|
|
|
96
|
|
|
|
|
7035
|
|
10
|
96
|
|
|
96
|
|
55668
|
use Time::Piece (); |
|
96
|
|
|
|
|
723824
|
|
|
96
|
|
|
|
|
3100
|
|
11
|
96
|
|
|
96
|
|
1015
|
use URI::Escape; |
|
96
|
|
|
|
|
374
|
|
|
96
|
|
|
|
|
6698
|
|
12
|
96
|
|
|
96
|
|
732
|
use URI; |
|
96
|
|
|
|
|
252
|
|
|
96
|
|
|
|
|
2165
|
|
13
|
96
|
|
|
96
|
|
547
|
use URI::QueryParam; |
|
96
|
|
|
|
|
248
|
|
|
96
|
|
|
|
|
242625
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $ALGORITHM = 'AWS4-HMAC-SHA256'; |
16
|
|
|
|
|
|
|
our $MAX_EXPIRES = 604800; # Max, 7 days |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $X_AMZ_ALGORITHM = 'X-Amz-Algorithm'; |
19
|
|
|
|
|
|
|
our $X_AMZ_CONTENT_SHA256 = 'X-Amz-Content-Sha256'; |
20
|
|
|
|
|
|
|
our $X_AMZ_CREDENTIAL = 'X-Amz-Credential'; |
21
|
|
|
|
|
|
|
our $X_AMZ_DATE = 'X-Amz-Date'; |
22
|
|
|
|
|
|
|
our $X_AMZ_EXPIRES = 'X-Amz-Expires'; |
23
|
|
|
|
|
|
|
our $X_AMZ_SIGNEDHEADERS = 'X-Amz-SignedHeaders'; |
24
|
|
|
|
|
|
|
our $X_AMZ_SIGNATURE = 'X-Amz-Signature'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub new { |
29
|
7
|
|
|
7
|
0
|
32
|
my $class = shift; |
30
|
7
|
|
|
|
|
25
|
my ( $access_key_id, $secret, $endpoint, $service ) = @_; |
31
|
7
|
|
|
|
|
44
|
my $self = { |
32
|
|
|
|
|
|
|
access_key_id => $access_key_id, |
33
|
|
|
|
|
|
|
secret => $secret, |
34
|
|
|
|
|
|
|
endpoint => $endpoint, |
35
|
|
|
|
|
|
|
service => $service, |
36
|
|
|
|
|
|
|
}; |
37
|
7
|
|
|
|
|
17
|
bless $self, $class; |
38
|
7
|
|
|
|
|
27
|
return $self; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub sign { |
43
|
1
|
|
|
1
|
1
|
4
|
my ( $self, $request ) = @_; |
44
|
|
|
|
|
|
|
|
45
|
1
|
|
|
|
|
212
|
$request = $self->_augment_request( $request ); |
46
|
|
|
|
|
|
|
|
47
|
1
|
|
|
|
|
5
|
my $authz = $self->_authorization( $request ); |
48
|
1
|
|
|
|
|
6
|
$request->header( Authorization => $authz ); |
49
|
1
|
|
|
|
|
75
|
return $request; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub sign_uri { |
54
|
6
|
|
|
6
|
1
|
160
|
my ( $self, $uri, $expires_in, $for_method ) = @_; |
55
|
|
|
|
|
|
|
|
56
|
6
|
|
|
|
|
21
|
my $request = $self->_augment_uri( $uri, $expires_in, $for_method ); |
57
|
|
|
|
|
|
|
|
58
|
6
|
|
|
|
|
24
|
my $signature = $self->_signature( $request ); |
59
|
|
|
|
|
|
|
|
60
|
6
|
|
|
|
|
24
|
$uri = $request->uri; |
61
|
6
|
|
|
|
|
55
|
my $query = $uri->query; |
62
|
6
|
|
|
|
|
91
|
$uri->query( undef ); |
63
|
6
|
|
|
|
|
116
|
$uri = $uri . '?' . $self->_sort_query_string( $query ); |
64
|
6
|
|
|
|
|
27
|
$uri .= "&$X_AMZ_SIGNATURE=$signature"; |
65
|
|
|
|
|
|
|
|
66
|
6
|
|
|
|
|
94
|
return $uri; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# _headers_to_sign: |
70
|
|
|
|
|
|
|
# Return the sorted lower case headers as required by the generation of canonical headers |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub _headers_to_sign { |
73
|
15
|
|
|
15
|
|
29
|
my $req = shift; |
74
|
|
|
|
|
|
|
|
75
|
15
|
100
|
|
|
|
182
|
my @headers_to_sign = $req->uri->query_param( $X_AMZ_SIGNEDHEADERS ) |
76
|
|
|
|
|
|
|
? $req->uri->query_param( $X_AMZ_SIGNEDHEADERS ) |
77
|
|
|
|
|
|
|
: $req->headers->header_field_names |
78
|
|
|
|
|
|
|
; |
79
|
|
|
|
|
|
|
|
80
|
15
|
|
|
|
|
3962
|
return sort { $a cmp $b } map { lc } @headers_to_sign |
|
33
|
|
|
|
|
56
|
|
|
33
|
|
|
|
|
91
|
|
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# _augment_request: |
84
|
|
|
|
|
|
|
# Append mandatory header fields |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub _augment_request { |
87
|
1
|
|
|
1
|
|
5
|
my ( $self, $request ) = @_; |
88
|
|
|
|
|
|
|
|
89
|
1
|
50
|
|
|
|
6
|
$request->header($X_AMZ_DATE => $self->_format_amz_date( $self->_req_timepiece($request) )) |
90
|
|
|
|
|
|
|
unless $request->header($X_AMZ_DATE); |
91
|
|
|
|
|
|
|
|
92
|
1
|
50
|
|
|
|
113
|
$request->header($X_AMZ_CONTENT_SHA256 => sha256_hex($request->content)) |
93
|
|
|
|
|
|
|
unless $request->header($X_AMZ_CONTENT_SHA256); |
94
|
|
|
|
|
|
|
|
95
|
1
|
|
|
|
|
186
|
return $request; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# _augment_uri: |
99
|
|
|
|
|
|
|
# Append mandatory uri parameters |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub _augment_uri { |
102
|
6
|
|
|
6
|
|
17
|
my ($self, $uri, $expires_in, $method) = @_; |
103
|
|
|
|
|
|
|
|
104
|
6
|
|
50
|
|
|
28
|
my $request = HTTP::Request->new( $method || GET => $uri ); |
105
|
|
|
|
|
|
|
|
106
|
6
|
50
|
|
|
|
461
|
$request->uri->query_param( $X_AMZ_DATE => $self->_format_amz_date( $self->_now ) ) |
107
|
|
|
|
|
|
|
unless $request->uri->query_param( $X_AMZ_DATE ); |
108
|
|
|
|
|
|
|
|
109
|
6
|
50
|
|
|
|
1180
|
$request->uri->query_param( $X_AMZ_ALGORITHM => $ALGORITHM ) |
110
|
|
|
|
|
|
|
unless $request->uri->query_param( $X_AMZ_ALGORITHM ); |
111
|
|
|
|
|
|
|
|
112
|
6
|
50
|
|
|
|
1305
|
$request->uri->query_param( $X_AMZ_CREDENTIAL => $self->_credential( $request ) ) |
113
|
|
|
|
|
|
|
unless $request->uri->query_param( $X_AMZ_CREDENTIAL ); |
114
|
|
|
|
|
|
|
|
115
|
6
|
50
|
33
|
|
|
1425
|
$request->uri->query_param( $X_AMZ_EXPIRES => $expires_in || $MAX_EXPIRES ) |
116
|
|
|
|
|
|
|
unless $request->uri->query_param( $X_AMZ_EXPIRES ); |
117
|
6
|
50
|
|
|
|
2355
|
$request->uri->query_param( $X_AMZ_EXPIRES => $MAX_EXPIRES ) |
118
|
|
|
|
|
|
|
if $request->uri->query_param( $X_AMZ_EXPIRES ) > $MAX_EXPIRES; |
119
|
|
|
|
|
|
|
|
120
|
6
|
|
|
|
|
781
|
$request->uri->query_param( $X_AMZ_SIGNEDHEADERS => 'host' ); |
121
|
|
|
|
|
|
|
|
122
|
6
|
|
|
|
|
1802
|
return $request; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# _canonical_request: |
126
|
|
|
|
|
|
|
# Construct the canonical request string from an HTTP::Request. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub _canonical_request { |
129
|
7
|
|
|
7
|
|
29
|
my ( $self, $req ) = @_; |
130
|
|
|
|
|
|
|
|
131
|
7
|
|
|
|
|
25
|
my $creq_method = $req->method; |
132
|
|
|
|
|
|
|
|
133
|
7
|
100
|
|
|
|
114
|
my ( $creq_canonical_uri, $creq_canonical_query_string ) = |
134
|
|
|
|
|
|
|
( $req->uri =~ m@([^?]*)\?(.*)$@ ) |
135
|
|
|
|
|
|
|
? ( $1, $2 ) |
136
|
|
|
|
|
|
|
: ( $req->uri, '' ); |
137
|
7
|
|
|
|
|
182
|
$creq_canonical_uri =~ s@^https?://[^/]*/?@/@; |
138
|
7
|
|
|
|
|
41
|
$creq_canonical_uri = _simplify_uri( $creq_canonical_uri ); |
139
|
7
|
|
|
|
|
24
|
$creq_canonical_query_string = $self->_sort_query_string( $creq_canonical_query_string ); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# Ensure Host header is present as its required |
142
|
7
|
50
|
|
|
|
60
|
if (!$req->header('host')) { |
143
|
7
|
100
|
|
|
|
375
|
my $host = $req->uri->_port |
144
|
|
|
|
|
|
|
? $req->uri->host_port |
145
|
|
|
|
|
|
|
: $req->uri->host |
146
|
|
|
|
|
|
|
; |
147
|
7
|
|
|
|
|
491
|
$req->header('Host' => $host); |
148
|
|
|
|
|
|
|
} |
149
|
7
|
|
100
|
|
|
392
|
my $creq_payload_hash = $req->header($X_AMZ_CONTENT_SHA256) |
150
|
|
|
|
|
|
|
# Signed uri doesn't have content |
151
|
|
|
|
|
|
|
|| 'UNSIGNED-PAYLOAD'; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# There's a bug in AMS4 which causes requests without x-amz-date set to be rejected |
154
|
|
|
|
|
|
|
# so we always add one if its not present. |
155
|
7
|
|
|
|
|
386
|
my $amz_date = $req->header($X_AMZ_DATE); |
156
|
7
|
|
|
|
|
312
|
my @sorted_headers = _headers_to_sign( $req ); |
157
|
|
|
|
|
|
|
my $creq_canonical_headers = join '', |
158
|
|
|
|
|
|
|
map { |
159
|
7
|
|
|
|
|
20
|
sprintf "%s:%s\x0a", |
160
|
|
|
|
|
|
|
lc, |
161
|
13
|
|
|
|
|
46
|
join ',', sort {$a cmp $b } _trim_whitespace($req->header($_) ) |
|
0
|
|
|
|
|
0
|
|
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
@sorted_headers; |
164
|
7
|
|
|
|
|
26
|
my $creq_signed_headers = $self->_signed_headers( $req ); |
165
|
7
|
|
|
|
|
27
|
my $creq = join "\x0a", |
166
|
|
|
|
|
|
|
$creq_method, $creq_canonical_uri, $creq_canonical_query_string, |
167
|
|
|
|
|
|
|
$creq_canonical_headers, $creq_signed_headers, $creq_payload_hash; |
168
|
|
|
|
|
|
|
|
169
|
7
|
|
|
|
|
27
|
return $creq; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# _string_to_sign |
173
|
|
|
|
|
|
|
# Construct the string to sign. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub _string_to_sign { |
176
|
7
|
|
|
7
|
|
25
|
my ( $self, $req ) = @_; |
177
|
7
|
|
|
|
|
22
|
my $dt = $self->_req_timepiece( $req ); |
178
|
7
|
|
|
|
|
408
|
my $creq = $self->_canonical_request($req); |
179
|
7
|
|
|
|
|
23
|
my $sts_request_date = $self->_format_amz_date( $dt ); |
180
|
7
|
|
|
|
|
287
|
my $sts_credential_scope = join '/', $dt->strftime('%Y%m%d'), $self->{endpoint}, $self->{service}, 'aws4_request'; |
181
|
7
|
|
|
|
|
326
|
my $sts_creq_hash = sha256_hex( $creq ); |
182
|
|
|
|
|
|
|
|
183
|
7
|
|
|
|
|
30
|
my $sts = join "\x0a", $ALGORITHM, $sts_request_date, $sts_credential_scope, $sts_creq_hash; |
184
|
7
|
|
|
|
|
37
|
return $sts; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# _authorization |
188
|
|
|
|
|
|
|
# Construct the authorization string |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub _signature { |
191
|
7
|
|
|
7
|
|
18
|
my ( $self, $req ) = @_; |
192
|
|
|
|
|
|
|
|
193
|
7
|
|
|
|
|
22
|
my $dt = $self->_req_timepiece( $req ); |
194
|
7
|
|
|
|
|
546
|
my $sts = $self->_string_to_sign( $req ); |
195
|
7
|
|
|
|
|
25
|
my $k_date = hmac_sha256( $dt->strftime('%Y%m%d'), 'AWS4' . $self->{secret} ); |
196
|
7
|
|
|
|
|
322
|
my $k_region = hmac_sha256( $self->{endpoint}, $k_date ); |
197
|
7
|
|
|
|
|
58
|
my $k_service = hmac_sha256( $self->{service}, $k_region ); |
198
|
7
|
|
|
|
|
90
|
my $k_signing = hmac_sha256( 'aws4_request', $k_service ); |
199
|
|
|
|
|
|
|
|
200
|
7
|
|
|
|
|
71
|
my $authz_signature = hmac_sha256_hex( $sts, $k_signing ); |
201
|
7
|
|
|
|
|
25
|
return $authz_signature; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub _credential { |
205
|
7
|
|
|
7
|
|
589
|
my ( $self, $req ) = @_; |
206
|
|
|
|
|
|
|
|
207
|
7
|
|
|
|
|
22
|
my $dt = $self->_req_timepiece( $req ); |
208
|
|
|
|
|
|
|
|
209
|
7
|
|
|
|
|
539
|
my $authz_credential = join '/', $self->{access_key_id}, $dt->strftime('%Y%m%d'), $self->{endpoint}, $self->{service}, 'aws4_request'; |
210
|
7
|
|
|
|
|
300
|
return $authz_credential; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub _signed_headers { |
214
|
8
|
|
|
8
|
|
56
|
my ( $self, $req ) = @_; |
215
|
|
|
|
|
|
|
|
216
|
8
|
|
|
|
|
23
|
my $authz_signed_headers = join ';', _headers_to_sign( $req ); |
217
|
8
|
|
|
|
|
28
|
return $authz_signed_headers; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub _authorization { |
221
|
1
|
|
|
1
|
|
3
|
my ( $self, $req ) = @_; |
222
|
|
|
|
|
|
|
|
223
|
1
|
|
|
|
|
6
|
my $authz_signature = $self->_signature( $req ); |
224
|
1
|
|
|
|
|
5
|
my $authz_credential = $self->_credential( $req ); |
225
|
1
|
|
|
|
|
4
|
my $authz_signed_headers = $self->_signed_headers( $req ); |
226
|
|
|
|
|
|
|
|
227
|
1
|
|
|
|
|
6
|
my $authz = "$ALGORITHM Credential=$authz_credential,SignedHeaders=$authz_signed_headers,Signature=$authz_signature"; |
228
|
1
|
|
|
|
|
4
|
return $authz; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub _simplify_uri { |
233
|
7
|
|
|
7
|
|
25
|
my $orig_uri = shift; |
234
|
7
|
|
|
|
|
44
|
my @parts = split /\//, $orig_uri; |
235
|
7
|
|
|
|
|
18
|
my @simple_parts = (); |
236
|
7
|
|
|
|
|
26
|
for my $part ( @parts ) { |
237
|
18
|
100
|
66
|
|
|
88
|
if ( ! length $part || $part eq '.' ) { |
|
|
50
|
|
|
|
|
|
238
|
|
|
|
|
|
|
} elsif ( $part eq '..' ) { |
239
|
0
|
|
|
|
|
0
|
pop @simple_parts; |
240
|
|
|
|
|
|
|
} else { |
241
|
12
|
|
|
|
|
30
|
push @simple_parts, $part; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
} |
244
|
7
|
|
|
|
|
26
|
my $simple_uri = '/' . join '/', @simple_parts; |
245
|
7
|
50
|
66
|
|
|
39
|
$simple_uri .= '/' if $orig_uri =~ m@/$@ && $simple_uri !~ m@/$@; |
246
|
7
|
|
|
|
|
24
|
return $simple_uri; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
sub _sort_query_string { |
249
|
13
|
|
|
13
|
|
57
|
my $self = shift; |
250
|
13
|
100
|
|
|
|
34
|
return '' unless $_[0]; |
251
|
12
|
|
|
|
|
20
|
my @params; |
252
|
12
|
|
|
|
|
46
|
for my $param ( split /&/, $_[0] ) { |
253
|
|
|
|
|
|
|
my ( $key, $value ) = |
254
|
60
|
|
|
|
|
162
|
map { tr/+/ /; uri_escape( uri_unescape( $_ ) ) } # escape all non-unreserved chars |
|
120
|
|
|
|
|
1498
|
|
|
120
|
|
|
|
|
245
|
|
255
|
|
|
|
|
|
|
split /=/, $param; |
256
|
60
|
50
|
|
|
|
1444
|
push @params, [$key, (defined $value ? $value : '')]; |
257
|
|
|
|
|
|
|
#push @params, [$key, $value]; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
return join '&', |
260
|
60
|
|
|
|
|
228
|
map { join '=', grep defined, @$_ } |
261
|
12
|
50
|
|
|
|
68
|
sort { ( $a->[0] cmp $b->[0] ) || ( $a->[1] cmp $b->[1] ) } |
|
108
|
|
|
|
|
263
|
|
262
|
|
|
|
|
|
|
@params; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
sub _trim_whitespace { |
265
|
13
|
|
|
13
|
|
558
|
return map { my $str = $_; $str =~ s/^\s*//; $str =~ s/\s*$//; $str } @_; |
|
13
|
|
|
|
|
25
|
|
|
13
|
|
|
|
|
64
|
|
|
13
|
|
|
|
|
83
|
|
|
13
|
|
|
|
|
91
|
|
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
sub _str_to_timepiece { |
268
|
21
|
|
|
21
|
|
42
|
my $date = shift; |
269
|
21
|
50
|
|
|
|
114
|
if ( $date =~ m/^\d{8}T\d{6}Z$/ ) { |
270
|
|
|
|
|
|
|
# assume basic ISO 8601, as demanded by AWS |
271
|
21
|
|
|
|
|
88
|
return Time::Piece->strptime($date, '%Y%m%dT%H%M%SZ'); |
272
|
|
|
|
|
|
|
} else { |
273
|
|
|
|
|
|
|
# assume the format given in the AWS4 test suite |
274
|
0
|
|
|
|
|
0
|
$date =~ s/^.{5}//; # remove weekday, as Amazon's test suite contains internally inconsistent dates |
275
|
0
|
|
|
|
|
0
|
return Time::Piece->strptime($date, '%d %b %Y %H:%M:%S %Z'); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub _format_amz_date { |
280
|
14
|
|
|
14
|
|
505
|
my ($self, $dt) = @_; |
281
|
|
|
|
|
|
|
|
282
|
14
|
|
|
|
|
54
|
$dt->strftime('%Y%m%dT%H%M%SZ'); |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
sub _now { |
286
|
7
|
|
|
7
|
|
354
|
return scalar Time::Piece->gmtime; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub _req_timepiece { |
290
|
22
|
|
|
22
|
|
118
|
my ($self, $req) = @_; |
291
|
22
|
|
100
|
|
|
89
|
my $x_date = $req->header($X_AMZ_DATE) || $req->uri->query_param($X_AMZ_DATE); |
292
|
22
|
|
66
|
|
|
3587
|
my $date = $x_date || $req->header('Date'); |
293
|
22
|
100
|
|
|
|
98
|
if (!$date) { |
294
|
|
|
|
|
|
|
# No date set by the caller so set one up |
295
|
1
|
|
|
|
|
6
|
my $piece = $self->_now; |
296
|
1
|
|
|
|
|
115
|
$req->date($piece->epoch); |
297
|
1
|
|
|
|
|
208
|
return $piece |
298
|
|
|
|
|
|
|
} |
299
|
21
|
|
|
|
|
73
|
return _str_to_timepiece($date); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
1; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
__END__ |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=pod |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=encoding UTF-8 |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=head1 NAME |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
Net::Amazon::S3::Signature::V4Implementation - Implements the Amazon Web Services signature version 4, AWS4-HMAC-SHA256 (copy of Net::Amazon::Signature::V4) |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head1 VERSION |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
version 0.98 |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=head1 DESCRIPTION |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
This package clones L<Net::Amazon::Signature::V4> 0.19 adding support for |
321
|
|
|
|
|
|
|
signing URIs (GET request) |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
Until https://github.com/Grinnz/Net-Amazon-Signature-V4/pull/5 will be merged |
324
|
|
|
|
|
|
|
we have to maintain our clone. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head1 Net::Amazon::Signature::S4 AUTHORS |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
Tim Nordenfur, C<< <tim at gurka.se> >> |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
Maintained by Dan Book, C<< <dbook at cpan.org> >> |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=head2 sign( $request ) |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
Signs a request with your credentials by appending the Authorization header. $request should be an HTTP::Request. The signed request is returned. |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=head2 sign_uri( $uri, $expires_in?, $for_method? ) |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
Signs an uri with your credentials by appending the Authorization query parameters. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
C<< $expires_in >> integer value in range 1..604800 (1 second .. 7 days). |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
C<< $expires_in >> default value is its maximum: 604800 |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
C<< $for_method >> HTTP method this uri should be signed for, default C<GET> |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
The signed uri is returned. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head1 AUTHOR |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Branislav Zahradník <barney@cpan.org> |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
This software is copyright (c) 2021 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover, Branislav Zahradník. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
357
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=cut |