line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::Middleware::Session::Cookie; |
2
|
1
|
|
|
1
|
|
22176
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
3
|
1
|
|
|
1
|
|
4
|
use parent qw(Plack::Middleware::Session); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
|
|
3
|
use Plack::Util::Accessor qw(secret session_key domain expires path secure httponly |
6
|
1
|
|
|
1
|
|
57
|
serializer deserializer); |
|
1
|
|
|
|
|
1
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
58
|
use Digest::HMAC_SHA1; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
39
|
|
9
|
1
|
|
|
1
|
|
406
|
use MIME::Base64 (); |
|
1
|
|
|
|
|
541
|
|
|
1
|
|
|
|
|
19
|
|
10
|
1
|
|
|
1
|
|
546
|
use Storable (); |
|
1
|
|
|
|
|
2547
|
|
|
1
|
|
|
|
|
23
|
|
11
|
1
|
|
|
1
|
|
494
|
use Time::HiRes; |
|
1
|
|
|
|
|
1133
|
|
|
1
|
|
|
|
|
4
|
|
12
|
1
|
|
|
1
|
|
93
|
use Plack::Util; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
20
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
432
|
use Plack::Session::State::Cookie; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
462
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub prepare_app { |
17
|
1
|
|
|
1
|
1
|
61
|
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
|
|
|
|
105
|
$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
|
|
|
|
22
|
unless $self->deserializer; |
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
22
|
$self->state( Plack::Session::State::Cookie->new ); |
31
|
1
|
|
|
|
|
6
|
for my $attr (qw(session_key path domain expires secure httponly)) { |
32
|
6
|
|
|
|
|
51
|
$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__ |