| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Plack::Middleware::Session::Cookie; |
|
2
|
1
|
|
|
1
|
|
38986
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
46
|
|
|
3
|
1
|
|
|
1
|
|
7
|
use parent qw(Plack::Middleware::Session); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
|
|
6
|
use Plack::Util::Accessor qw(secret session_key domain expires path secure httponly |
|
6
|
1
|
|
|
1
|
|
81
|
serializer deserializer); |
|
|
1
|
|
|
|
|
3
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
117
|
use Digest::HMAC_SHA1; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
78
|
|
|
9
|
1
|
|
|
1
|
|
916
|
use MIME::Base64 (); |
|
|
1
|
|
|
|
|
927
|
|
|
|
1
|
|
|
|
|
33
|
|
|
10
|
1
|
|
|
1
|
|
998
|
use Storable (); |
|
|
1
|
|
|
|
|
4449
|
|
|
|
1
|
|
|
|
|
41
|
|
|
11
|
1
|
|
|
1
|
|
904
|
use Time::HiRes; |
|
|
1
|
|
|
|
|
1860
|
|
|
|
1
|
|
|
|
|
7
|
|
|
12
|
1
|
|
|
1
|
|
156
|
use Plack::Util; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
30
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
654
|
use Plack::Session::State::Cookie; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
567
|
|
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub prepare_app { |
|
17
|
1
|
|
|
1
|
1
|
60
|
my $self = shift; |
|
18
|
|
|
|
|
|
|
|
|
19
|
1
|
50
|
|
|
|
5
|
die "Plack::Session::Middleware::Cookie requires setting 'secret' option." |
|
20
|
|
|
|
|
|
|
unless $self->secret; |
|
21
|
|
|
|
|
|
|
|
|
22
|
1
|
50
|
|
|
|
104
|
$self->session_key("plack_session") unless $self->session_key; |
|
23
|
|
|
|
|
|
|
|
|
24
|
0
|
|
|
0
|
|
0
|
$self->serializer(sub {MIME::Base64::encode(Storable::nfreeze($_[0]), '' )}) |
|
25
|
1
|
50
|
|
|
|
12
|
unless $self->serializer; |
|
26
|
|
|
|
|
|
|
|
|
27
|
0
|
|
|
0
|
|
0
|
$self->deserializer(sub {Storable::thaw(MIME::Base64::decode($_[0]))}) |
|
28
|
1
|
50
|
|
|
|
26
|
unless $self->deserializer; |
|
29
|
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
22
|
$self->state( Plack::Session::State::Cookie->new ); |
|
31
|
1
|
|
|
|
|
14
|
for my $attr (qw(session_key path domain expires secure httponly)) { |
|
32
|
6
|
|
|
|
|
54
|
$self->state->$attr($self->$attr); |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub _compare { |
|
37
|
0
|
|
|
0
|
|
|
my($s1, $s2) = @_; |
|
38
|
|
|
|
|
|
|
|
|
39
|
0
|
0
|
|
|
|
|
return if length $s1 != length $s2; |
|
40
|
0
|
|
|
|
|
|
my $r = 0; |
|
41
|
0
|
|
|
|
|
|
for my $i (0..length($s1) - 1) { |
|
42
|
0
|
|
|
|
|
|
$r |= ord(substr $s1, $i) ^ ord(substr $s2, $i); |
|
43
|
|
|
|
|
|
|
} |
|
44
|
|
|
|
|
|
|
|
|
45
|
0
|
|
|
|
|
|
return $r == 0; |
|
46
|
|
|
|
|
|
|
} |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub get_session { |
|
49
|
0
|
|
|
0
|
0
|
|
my($self, $request) = @_; |
|
50
|
|
|
|
|
|
|
|
|
51
|
0
|
0
|
|
|
|
|
my $cookie = $self->state->get_session_id($request) or return; |
|
52
|
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
|
my($time, $b64, $sig) = split /:/, $cookie, 3; |
|
54
|
0
|
0
|
|
|
|
|
_compare($self->sig($b64), $sig) or return; |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# NOTE: do something with $time? |
|
57
|
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
my $session = $self->deserializer->($b64); |
|
59
|
0
|
|
|
|
|
|
return ($self->generate_id, $session); |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub generate_id { |
|
63
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
64
|
0
|
|
|
|
|
|
return scalar Time::HiRes::gettimeofday; |
|
65
|
|
|
|
|
|
|
} |
|
66
|
|
|
|
|
|
|
|
|
67
|
0
|
|
|
0
|
0
|
|
sub commit { } |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub change_id { |
|
70
|
0
|
|
|
0
|
1
|
|
my($self, $env) = @_; |
|
71
|
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
my $options = $env->{'psgix.session.options'}; |
|
73
|
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
$options->{id} = $self->generate_id($env); |
|
75
|
|
|
|
|
|
|
} |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub expire_session { |
|
78
|
0
|
|
|
0
|
0
|
|
my($self, $id, $res, $env) = @_; |
|
79
|
0
|
|
|
|
|
|
$self->state->expire_session_id($id, $res, $env->{'psgix.session.options'}); |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub save_state { |
|
83
|
0
|
|
|
0
|
0
|
|
my($self, $id, $res, $env) = @_; |
|
84
|
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
my $cookie = $self->_serialize($id, $env->{'psgix.session'}); |
|
86
|
0
|
|
|
|
|
|
$self->state->finalize($cookie, $res, $env->{'psgix.session.options'}); |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _serialize { |
|
90
|
0
|
|
|
0
|
|
|
my($self, $id, $session) = @_; |
|
91
|
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
|
my $b64 = $self->serializer->($session); |
|
93
|
0
|
|
|
|
|
|
join ":", $id, $b64, $self->sig($b64); |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub sig { |
|
97
|
0
|
|
|
0
|
0
|
|
my($self, $b64) = @_; |
|
98
|
0
|
0
|
|
|
|
|
return '.' unless $self->secret; |
|
99
|
0
|
|
|
|
|
|
Digest::HMAC_SHA1::hmac_sha1_hex($b64, $self->secret); |
|
100
|
|
|
|
|
|
|
} |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
1; |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
__END__ |