line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Azure::Authorization::SAS; |
2
|
2
|
|
|
2
|
|
23347
|
use 5.008001; |
|
2
|
|
|
|
|
6
|
|
3
|
2
|
|
|
2
|
|
7
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
38
|
|
4
|
2
|
|
|
2
|
|
18
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
145
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = "0.02"; |
7
|
|
|
|
|
|
|
our $DEFAULT_TOKEN_EXPIRE = 3600; |
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
14
|
use Carp; |
|
2
|
|
|
|
|
11
|
|
|
2
|
|
|
|
|
157
|
|
10
|
2
|
|
|
2
|
|
1118
|
use URI; |
|
2
|
|
|
|
|
10428
|
|
|
2
|
|
|
|
|
81
|
|
11
|
2
|
|
|
2
|
|
14
|
use URI::Escape 'uri_escape'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
125
|
|
12
|
2
|
|
|
2
|
|
1174
|
use Digest::SHA 'hmac_sha256'; |
|
2
|
|
|
|
|
5882
|
|
|
2
|
|
|
|
|
151
|
|
13
|
2
|
|
|
2
|
|
1310
|
use MIME::Base64 'encode_base64'; |
|
2
|
|
|
|
|
1168
|
|
|
2
|
|
|
|
|
128
|
|
14
|
2
|
|
|
2
|
|
986
|
use String::CamelCase 'decamelize'; |
|
2
|
|
|
|
|
904
|
|
|
2
|
|
|
|
|
134
|
|
15
|
|
|
|
|
|
|
use Class::Accessor::Lite ( |
16
|
2
|
|
|
|
|
17
|
new => 0, |
17
|
|
|
|
|
|
|
ro => [qw[ |
18
|
|
|
|
|
|
|
connection_string |
19
|
|
|
|
|
|
|
endpoint |
20
|
|
|
|
|
|
|
shared_access_key_name |
21
|
|
|
|
|
|
|
shared_access_key |
22
|
|
|
|
|
|
|
expire |
23
|
|
|
|
|
|
|
]], |
24
|
2
|
|
|
2
|
|
1252
|
); |
|
2
|
|
|
|
|
2280
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub new { |
27
|
2
|
|
|
2
|
1
|
3328
|
my ($class, %param) = @_; |
28
|
2
|
100
|
|
|
|
30
|
croak 'connection_string is required' if !defined $param{connection_string}; |
29
|
1
|
|
33
|
|
|
7
|
$param{expire} ||= $DEFAULT_TOKEN_EXPIRE; |
30
|
1
|
|
|
|
|
7
|
%param = (%param, $class->_parse_connection_string($param{connection_string})); |
31
|
1
|
|
|
|
|
35
|
bless {%param}, $class; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub _parse_connection_string { |
35
|
1
|
|
|
1
|
|
3
|
my ($class, $string) = @_; |
36
|
1
|
|
|
|
|
7
|
my %parsed = (map {split '=', $_, 2} split(';', $string)); |
|
4
|
|
|
|
|
11
|
|
37
|
1
|
|
|
|
|
4
|
( map {(decamelize($_) => $parsed{$_})} keys %parsed ); |
|
4
|
|
|
|
|
89
|
|
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub token { |
41
|
2
|
|
|
2
|
1
|
3258
|
my ($self, $url) = @_; |
42
|
2
|
100
|
|
|
|
26
|
croak 'An url for token is required' if !defined $url; |
43
|
1
|
|
|
|
|
9
|
my $uri = URI->new($url); |
44
|
1
|
|
|
|
|
7912
|
my $target_uri = lc(uri_escape(lc(sprintf("%s://%s%s", $uri->scheme, $uri->host, $uri->path)))); |
45
|
1
|
|
|
|
|
199
|
my $expire_time = time + $self->expire; |
46
|
1
|
|
|
|
|
21
|
my $to_sign = "$target_uri\n$expire_time"; |
47
|
1
|
|
|
|
|
4
|
my $signature = encode_base64(hmac_sha256($to_sign, $self->shared_access_key)); |
48
|
1
|
|
|
|
|
50
|
chomp $signature; |
49
|
1
|
|
|
|
|
4
|
sprintf 'SharedAccessSignature sr=%s&sig=%s&se=%s&skn=%s', $target_uri, uri_escape($signature), $expire_time, $self->shared_access_key_name; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
1; |
53
|
|
|
|
|
|
|
__END__ |