line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
2
|
|
|
2
|
|
131531
|
use strict; use warnings; |
|
2
|
|
|
2
|
|
15
|
|
|
2
|
|
|
|
|
48
|
|
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
88
|
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package URI::Signature::Tiny; |
4
|
|
|
|
|
|
|
our $VERSION = '1.005'; |
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
837
|
use Digest::SHA (); |
|
2
|
|
|
|
|
4961
|
|
|
2
|
|
|
|
|
49
|
|
7
|
2
|
|
|
2
|
|
11
|
use Carp (); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
24
|
|
8
|
2
|
|
|
2
|
|
7
|
use Scalar::Util (); |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
927
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my @defaults = ( |
11
|
|
|
|
|
|
|
sort_params => 1, |
12
|
|
|
|
|
|
|
recode_base64 => 1, |
13
|
|
|
|
|
|
|
after_sign => sub { Carp::croak( 'No after_sign callback specified' ) }, |
14
|
|
|
|
|
|
|
before_verify => sub { Carp::croak( 'No before_verify callback specified' ) }, |
15
|
|
|
|
|
|
|
function => \&Digest::SHA::hmac_sha256_base64, |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new { |
19
|
26
|
|
|
26
|
1
|
3687
|
my $class = shift; |
20
|
26
|
|
|
|
|
93
|
my $self = bless { @defaults, @_ }, $class; |
21
|
26
|
100
|
|
|
|
203
|
Carp::croak( "Missing secret for $class" ) unless defined $self->{'secret'}; |
22
|
25
|
|
|
|
|
95
|
$self; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub signature { |
26
|
23
|
|
|
23
|
1
|
7517
|
my ( $self, $uri ) = ( shift, @_ ); |
27
|
|
|
|
|
|
|
|
28
|
23
|
100
|
|
|
|
170
|
Carp::croak( 'Cannot compute the signature of an undefined value' ) unless defined $uri; |
29
|
|
|
|
|
|
|
|
30
|
21
|
100
|
|
|
|
89
|
$uri = $uri->isa( 'URI::WithBase' ) ? $uri->abs->as_string : $uri->as_string |
|
|
100
|
|
|
|
|
|
31
|
|
|
|
|
|
|
if Scalar::Util::blessed( $uri ); |
32
|
|
|
|
|
|
|
|
33
|
21
|
100
|
|
|
|
590
|
$uri =~ m[ \A [^?#]* \? ]xgc and $uri =~ s[ \G ([^#]+) ]{ |
34
|
9
|
|
|
|
|
35
|
my @qp = split /[&;]/, "$1"; |
35
|
9
|
100
|
|
|
|
46
|
join ';', $self->{'sort_params'} ? sort @qp : @qp; |
36
|
|
|
|
|
|
|
}xe; |
37
|
|
|
|
|
|
|
|
38
|
21
|
|
|
|
|
173
|
my $sig = $self->{'function'}->( $uri, $self->{'secret'} ); |
39
|
|
|
|
|
|
|
|
40
|
21
|
100
|
66
|
|
|
101
|
$sig =~ s/=+\z//, $sig =~ y{+/}{-_} if defined $sig and $self->{'recode_base64'}; |
41
|
|
|
|
|
|
|
|
42
|
21
|
|
|
|
|
77
|
$sig; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub sign { |
46
|
3
|
|
|
3
|
1
|
6594
|
my ( $self, $uri ) = ( shift, @_ ); |
47
|
3
|
|
|
|
|
8
|
$self->{'after_sign'}->( $uri, $self->signature( $uri ) ); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub verify { |
51
|
4
|
|
|
4
|
1
|
162
|
my $self = shift; |
52
|
4
|
|
|
|
|
14
|
my ( $uri, $sig ) = $self->{'before_verify'}->( @_ ); |
53
|
3
|
100
|
|
|
|
143
|
if ( defined $sig ) { |
54
|
2
|
|
|
|
|
6
|
my $computed = $self->signature( $uri ); |
55
|
2
|
50
|
|
|
|
30
|
defined $computed and $computed eq $sig; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
1; |