line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
################################################################################### |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Apache::SessionX - Copyright (c) 1999-2001 Gerald Richter / ecos gmbh |
4
|
|
|
|
|
|
|
# Copyright(c) 1998, 1999 Jeffrey William Baker (jeffrey@kathyandjeffrey.net) |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public |
7
|
|
|
|
|
|
|
# License or the Artistic License, as specified in the Perl README file. |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR |
10
|
|
|
|
|
|
|
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED |
11
|
|
|
|
|
|
|
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# $Id: SessionX.pm,v 1.4 2001/12/04 13:33:39 richter Exp $ |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
################################################################################### |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
package Apache::SessionX ; |
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
1
|
|
659
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
21
|
1
|
|
|
1
|
|
5
|
use vars qw(@ISA $VERSION); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
92
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
$VERSION = '2.01'; |
24
|
|
|
|
|
|
|
@ISA = qw(Apache::Session); |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
1
|
|
880
|
use Apache::Session; |
|
1
|
|
|
|
|
1835
|
|
|
1
|
|
|
|
|
31
|
|
27
|
1
|
|
|
1
|
|
767
|
use Apache::SessionX::Config ; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
43
|
|
28
|
|
|
|
|
|
|
|
29
|
1
|
|
|
1
|
|
6
|
use constant NEW => Apache::Session::NEW () ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
95
|
|
30
|
1
|
|
|
1
|
|
5
|
use constant MODIFIED => Apache::Session::MODIFIED () ; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
45
|
|
31
|
1
|
|
|
1
|
|
4
|
use constant DELETED => Apache::Session::DELETED () ; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
35
|
|
32
|
1
|
|
|
1
|
|
5
|
use constant SYNCED => Apache::Session::SYNCED () ; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2913
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub TIEHASH { |
36
|
2
|
|
|
2
|
|
552
|
my $class = shift; |
37
|
|
|
|
|
|
|
|
38
|
2
|
|
|
|
|
4
|
my $session_id = shift; |
39
|
2
|
|
50
|
|
|
6
|
my $args = shift || {}; |
40
|
|
|
|
|
|
|
|
41
|
2
|
50
|
|
|
|
9
|
if(ref $args ne "HASH") |
42
|
|
|
|
|
|
|
{ |
43
|
0
|
|
|
|
|
0
|
die "Additional arguments should be in the form of a hash reference"; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
2
|
|
33
|
|
|
6
|
my $config = $args -> {config} || $Apache::SessionX::Config::default; |
47
|
2
|
|
|
|
|
14
|
foreach my $cfg (keys (%{$Apache::SessionX::Config::param{$config}})) |
|
2
|
|
|
|
|
10
|
|
48
|
|
|
|
|
|
|
{ |
49
|
14
|
50
|
|
|
|
42
|
$args -> {$cfg} = $Apache::SessionX::Config::param{$config} -> {$cfg} if (!exists $args -> {$cfg}) ; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
2
|
|
|
|
|
26
|
my $self = |
53
|
|
|
|
|
|
|
{ |
54
|
|
|
|
|
|
|
args => $args, |
55
|
|
|
|
|
|
|
data => { _session_id => $session_id }, |
56
|
|
|
|
|
|
|
initial_session_id => $session_id, |
57
|
|
|
|
|
|
|
lock => 0, |
58
|
|
|
|
|
|
|
lock_manager => undef, |
59
|
|
|
|
|
|
|
object_store => undef, |
60
|
|
|
|
|
|
|
status => 0, |
61
|
|
|
|
|
|
|
serialized => undef, |
62
|
|
|
|
|
|
|
idfrom => $args -> {idfrom}, |
63
|
|
|
|
|
|
|
newid => $args -> {newid}, |
64
|
|
|
|
|
|
|
}; |
65
|
|
|
|
|
|
|
|
66
|
2
|
|
|
|
|
6
|
bless $self, $class; |
67
|
|
|
|
|
|
|
|
68
|
2
|
|
|
|
|
7
|
$self -> require_modules ($args) ; |
69
|
|
|
|
|
|
|
|
70
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$args -> {'lazy'}) ; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
0
|
return $self ; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub require_modules |
78
|
|
|
|
|
|
|
{ |
79
|
2
|
|
|
2
|
0
|
5
|
my $self = shift ; |
80
|
2
|
|
|
|
|
3
|
my $args = shift ; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# check object_store and lock_manager classes (Apache::Session 1.00) |
83
|
|
|
|
|
|
|
|
84
|
2
|
|
|
|
|
3
|
foreach my $mod ('Store', 'Lock', 'Generate', 'Serialize') |
85
|
|
|
|
|
|
|
{ |
86
|
2
|
50
|
|
|
|
10
|
if ($args -> {$mod}) |
87
|
|
|
|
|
|
|
{ |
88
|
2
|
50
|
|
|
|
20
|
if (!($args -> {$mod} =~ /::/)) |
89
|
|
|
|
|
|
|
{ |
90
|
2
|
|
|
|
|
7
|
my $modname = "Apache::SessionX::$mod\:\:$args->{$mod}" ; |
91
|
2
|
|
|
|
|
183
|
eval "require $modname" ; |
92
|
2
|
50
|
|
|
|
12
|
if ($@) |
93
|
|
|
|
|
|
|
{ |
94
|
2
|
|
|
|
|
3
|
$@ = '' ; |
95
|
2
|
|
|
|
|
5
|
$modname = "Apache::Session::$mod\:\:$args->{$mod}" ; |
96
|
2
|
|
|
|
|
100
|
eval "require $modname" ; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
2
|
50
|
|
|
|
1093
|
die "Cannot require $modname ($@)" if ($@) ; |
100
|
0
|
|
|
|
|
0
|
$args->{$mod} = $modname ; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
else |
103
|
|
|
|
|
|
|
{ |
104
|
0
|
|
|
|
|
0
|
my $modname = $args->{$mod} ; |
105
|
0
|
|
|
|
|
0
|
eval "require $modname" ; |
106
|
0
|
0
|
|
|
|
0
|
die "Cannot require $modname" if ($@) ; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub init |
117
|
|
|
|
|
|
|
{ |
118
|
0
|
|
|
0
|
0
|
0
|
my $self = shift ; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
#If a session ID was passed in, this is an old hash. |
121
|
|
|
|
|
|
|
#If not, it is a fresh one. |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
0
|
$self->populate; |
124
|
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
0
|
my $session_id = $self->{data}->{_session_id} ; |
126
|
|
|
|
|
|
|
|
127
|
0
|
0
|
0
|
|
|
0
|
if (!$session_id && $self -> {idfrom}) |
128
|
|
|
|
|
|
|
{ |
129
|
0
|
|
|
|
|
0
|
$session_id = $self->{data}->{_session_id} = &{$self->{generate}}($self, $self -> {idfrom}) ; |
|
0
|
|
|
|
|
0
|
|
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
0
|
|
|
0
|
$self->{initial_session_id} ||= $session_id ; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
|
135
|
0
|
0
|
0
|
|
|
0
|
if (defined $session_id && $session_id) |
136
|
|
|
|
|
|
|
{ |
137
|
|
|
|
|
|
|
#check the session ID for remote exploitation attempts |
138
|
|
|
|
|
|
|
#this will die() on suspicious session IDs. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
#eval { &{$self->{validate}}($self); } ; |
141
|
0
|
|
|
|
|
0
|
&{$self->{validate}}($self); |
|
0
|
|
|
|
|
0
|
|
142
|
|
|
|
|
|
|
#if (!$@) |
143
|
|
|
|
|
|
|
{ # session id is ok |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
0
|
$self->{status} &= ($self->{status} ^ NEW); |
|
0
|
|
|
|
|
0
|
|
146
|
|
|
|
|
|
|
|
147
|
0
|
0
|
|
|
|
0
|
if ($self -> {'args'}{'create_unknown'}) |
148
|
|
|
|
|
|
|
{ |
149
|
0
|
|
|
|
|
0
|
eval { $self -> restore } ; |
|
0
|
|
|
|
|
0
|
|
150
|
|
|
|
|
|
|
#warn "Try to load session: $@" if ($@) ; |
151
|
0
|
|
|
|
|
0
|
$@ = "" ; |
152
|
0
|
|
|
|
|
0
|
$session_id = $self->{data}->{_session_id} ; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
else |
155
|
|
|
|
|
|
|
{ |
156
|
0
|
|
|
|
|
0
|
$self->restore; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
0
|
$@ = '' ; |
162
|
|
|
|
|
|
|
|
163
|
0
|
0
|
|
|
|
0
|
if (!($self->{status} & SYNCED)) |
164
|
|
|
|
|
|
|
{ |
165
|
0
|
|
|
|
|
0
|
$self->{status} |= NEW(); |
166
|
0
|
0
|
0
|
|
|
0
|
if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'}) |
167
|
|
|
|
|
|
|
{ |
168
|
0
|
0
|
|
|
|
0
|
if (exists ($self->{generate})) |
169
|
|
|
|
|
|
|
{ # Apache::Session >= 1.50 |
170
|
0
|
|
|
|
|
0
|
$self->{data}->{_session_id} = &{$self->{generate}}($self) ; |
|
0
|
|
|
|
|
0
|
|
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
else |
173
|
|
|
|
|
|
|
{ |
174
|
0
|
|
|
|
|
0
|
$self->{data}->{_session_id} = $self -> generate_id() ; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
0
|
|
|
|
|
0
|
$self->save; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
else |
180
|
|
|
|
|
|
|
{ |
181
|
0
|
|
|
|
|
0
|
$self -> {newidpending} = $self -> {newid} ; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
#warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};" ; |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
0
|
return $self; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub FETCH { |
195
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
196
|
0
|
|
|
|
|
0
|
my $key = shift; |
197
|
|
|
|
|
|
|
|
198
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$self -> {'status'}) ; |
199
|
|
|
|
|
|
|
|
200
|
0
|
|
|
|
|
0
|
return $self->{data}->{$key}; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub STORE { |
204
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
205
|
0
|
|
|
|
|
0
|
my $key = shift; |
206
|
0
|
|
|
|
|
0
|
my $value = shift; |
207
|
|
|
|
|
|
|
|
208
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$self -> {'status'}) ; |
209
|
|
|
|
|
|
|
|
210
|
0
|
|
|
|
|
0
|
$self->{data}->{$key} = $value; |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
0
|
$self->{status} |= MODIFIED; |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
|
|
0
|
return $self->{data}->{$key}; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub DELETE { |
218
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
219
|
0
|
|
|
|
|
0
|
my $key = shift; |
220
|
|
|
|
|
|
|
|
221
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$self -> {'status'}) ; |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
0
|
$self->{status} |= MODIFIED; |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
0
|
delete $self->{data}->{$key}; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub CLEAR { |
229
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
230
|
|
|
|
|
|
|
|
231
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$self -> {'status'}) ; |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
0
|
$self->{status} |= MODIFIED; |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
0
|
$self->{data} = {}; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub EXISTS { |
239
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
240
|
0
|
|
|
|
|
0
|
my $key = shift; |
241
|
|
|
|
|
|
|
|
242
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$self -> {'status'}) ; |
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
0
|
return exists $self->{data}->{$key}; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub FIRSTKEY { |
248
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
249
|
|
|
|
|
|
|
|
250
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$self -> {'status'}) ; |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
0
|
my $reset = keys %{$self->{data}}; |
|
0
|
|
|
|
|
0
|
|
253
|
0
|
|
|
|
|
0
|
return each %{$self->{data}}; |
|
0
|
|
|
|
|
0
|
|
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub NEXTKEY { |
257
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
258
|
|
|
|
|
|
|
|
259
|
0
|
0
|
|
|
|
0
|
$self -> init if (!$self -> {'status'}) ; |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
0
|
return each %{$self->{data}}; |
|
0
|
|
|
|
|
0
|
|
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub DESTROY { |
265
|
2
|
|
|
2
|
|
25
|
my $self = shift; |
266
|
|
|
|
|
|
|
|
267
|
2
|
50
|
|
|
|
17
|
$self->save if ($self -> {'status'}) ; |
268
|
|
|
|
|
|
|
# destroy store object to make sure all data is written and everything |
269
|
|
|
|
|
|
|
# is closed before we release the locks |
270
|
2
|
|
|
|
|
6
|
$self->{object_store} = undef ; |
271
|
2
|
|
|
|
|
13
|
$self->release_all_locks; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub cleanup |
275
|
|
|
|
|
|
|
{ |
276
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
$self->{initial_session_id} = undef ; |
279
|
0
|
0
|
|
|
|
|
if ($self -> {'status'}) |
280
|
|
|
|
|
|
|
{ |
281
|
0
|
|
|
|
|
|
$self->save; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
# { |
284
|
|
|
|
|
|
|
# local $SIG{__WARN__} = 'IGNORE' ; |
285
|
|
|
|
|
|
|
# local $SIG{__DIE__} = 'IGNORE' ; |
286
|
|
|
|
|
|
|
# eval { $self -> {object_store} -> close } ; # Try to close file storage |
287
|
|
|
|
|
|
|
# $@ = "" ; |
288
|
|
|
|
|
|
|
# } |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# destroy store object to make sure all data is written and everything |
291
|
|
|
|
|
|
|
# is closed before we release the locks |
292
|
0
|
|
|
|
|
|
$self->{object_store} = undef ; |
293
|
0
|
|
|
|
|
|
$self->release_all_locks; |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
$self->{'status'} = 0 ; |
296
|
0
|
|
|
|
|
|
$self->{data} = {} ; |
297
|
0
|
|
|
|
|
|
$self->{serialized} = undef ; |
298
|
|
|
|
|
|
|
# destroy lock object to make sure all locks are really released |
299
|
0
|
|
|
|
|
|
$self->{lock_manager} = undef ; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
sub setid { |
304
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
$self->{'status'} = 0 ; |
307
|
0
|
|
|
|
|
|
$self->{data}->{_session_id} = $self->{initial_session_id} = shift ; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub setidfrom { |
311
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
312
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
|
$self->{'status'} = 0 ; |
314
|
0
|
|
|
|
|
|
$self->{data}->{_session_id} = $self->{initial_session_id} = undef ; |
315
|
0
|
|
|
|
|
|
$self->{idfrom} = shift ; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
sub getid { |
319
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
|
return $self->{data}->{_session_id} ; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub getids { |
325
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
326
|
0
|
|
|
|
|
|
my $init = shift; |
327
|
|
|
|
|
|
|
|
328
|
0
|
0
|
0
|
|
|
|
$self -> init if ($init && !$self -> {'status'}) ; |
329
|
|
|
|
|
|
|
|
330
|
0
|
0
|
0
|
|
|
|
if ($self -> {newidpending} && $self->{status}) |
331
|
|
|
|
|
|
|
{ |
332
|
0
|
|
|
|
|
|
$self->{data}->{_session_id} = &{$self->{generate}}($self) ; |
|
0
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
$self -> {newidpending} = 0 ; |
334
|
0
|
|
|
|
|
|
$self->{status} |= NEW ; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
0
|
|
|
|
|
|
return ($self->{initial_session_id}, $self->{data}->{_session_id}, $self->{status} & MODIFIED) ; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub delete { |
341
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
342
|
|
|
|
|
|
|
|
343
|
0
|
0
|
|
|
|
|
return if ($self->{status} & NEW); |
344
|
|
|
|
|
|
|
|
345
|
0
|
|
|
|
|
|
$self->{initial_session_id} = "!DELETE" ; |
346
|
|
|
|
|
|
|
|
347
|
0
|
0
|
|
|
|
|
$self -> init if (!$self -> {'status'}) ; |
348
|
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
|
$self->{status} |= DELETED; |
350
|
0
|
|
|
|
|
|
$self->save; |
351
|
0
|
|
|
|
|
|
$self->{data} = {} ; # Throw away the data |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub restore { |
357
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
358
|
|
|
|
|
|
|
|
359
|
0
|
0
|
|
|
|
|
return if ($self->{status} & SYNCED); |
360
|
0
|
0
|
|
|
|
|
return if ($self->{status} & NEW); |
361
|
|
|
|
|
|
|
|
362
|
0
|
0
|
0
|
|
|
|
if (exists $self -> {'args'}->{Transaction} && $self -> {'args'}->{Transaction}) |
363
|
|
|
|
|
|
|
{ |
364
|
0
|
|
|
|
|
|
$self->acquire_write_lock; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
else |
367
|
|
|
|
|
|
|
{ |
368
|
0
|
|
|
|
|
|
$self->acquire_read_lock; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
0
|
|
|
|
|
|
$self->{object_store}->materialize($self); |
372
|
0
|
|
|
|
|
|
&{$self->{unserialize}}($self); |
|
0
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
|
374
|
0
|
|
|
|
|
|
$self->{status} &= ($self->{status} ^ MODIFIED); |
375
|
0
|
|
|
|
|
|
$self->{status} |= SYNCED |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub save { |
380
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
return unless ( |
383
|
0
|
0
|
0
|
|
|
|
$self->{status} & MODIFIED || |
|
|
|
0
|
|
|
|
|
384
|
|
|
|
|
|
|
$self->{status} & NEW || |
385
|
|
|
|
|
|
|
$self->{status} & DELETED |
386
|
|
|
|
|
|
|
); |
387
|
|
|
|
|
|
|
|
388
|
0
|
0
|
|
|
|
|
if ($self -> {newidpending}) |
389
|
|
|
|
|
|
|
{ |
390
|
0
|
|
|
|
|
|
$self->{data}->{_session_id} = &{$self->{generate}}($self) ; |
|
0
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
|
$self -> {newidpending} = 0 ; |
392
|
0
|
|
|
|
|
|
$self->{status} |= NEW ; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
|
$self->acquire_write_lock; |
396
|
|
|
|
|
|
|
|
397
|
0
|
0
|
|
|
|
|
if ($self->{status} & DELETED) { |
398
|
0
|
|
|
|
|
|
$self->{object_store}->remove($self); |
399
|
0
|
|
|
|
|
|
$self->{status} |= SYNCED; |
400
|
0
|
|
|
|
|
|
$self->{status} &= ($self->{status} ^ MODIFIED); |
401
|
0
|
|
|
|
|
|
$self->{status} &= ($self->{status} ^ DELETED); |
402
|
0
|
|
|
|
|
|
return; |
403
|
|
|
|
|
|
|
} |
404
|
0
|
0
|
|
|
|
|
if ($self->{status} & NEW) { |
405
|
0
|
|
|
|
|
|
&{$self->{serialize}}($self); |
|
0
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
|
$self->{object_store}->insert($self); |
407
|
0
|
|
|
|
|
|
$self->{status} &= ($self->{status} ^ NEW); |
408
|
0
|
|
|
|
|
|
$self->{status} |= SYNCED; |
409
|
0
|
|
|
|
|
|
$self->{status} &= ($self->{status} ^ MODIFIED); |
410
|
0
|
|
|
|
|
|
return; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
0
|
0
|
|
|
|
|
if ($self->{status} & MODIFIED) { |
414
|
0
|
|
|
|
|
|
&{$self->{serialize}}($self); |
|
0
|
|
|
|
|
|
|
415
|
0
|
|
|
|
|
|
$self->{object_store}->update($self); |
416
|
0
|
|
|
|
|
|
$self->{status} &= ($self->{status} ^ MODIFIED); |
417
|
0
|
|
|
|
|
|
$self->{status} |= SYNCED; |
418
|
0
|
|
|
|
|
|
return; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
# For Apache::Session 1.00 |
426
|
|
|
|
|
|
|
# |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub get_object_store { |
429
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
430
|
|
|
|
|
|
|
|
431
|
0
|
|
|
|
|
|
return new {$self -> {'args'}{'object_store'}} $self; |
|
0
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub get_lock_manager { |
435
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
436
|
|
|
|
|
|
|
|
437
|
0
|
|
|
|
|
|
return new {$self -> {'args'}{'lock_manager'}} $self; |
|
0
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
# |
441
|
|
|
|
|
|
|
# Default validate for Apache::Session < 1.53 |
442
|
|
|
|
|
|
|
# |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub validate { |
445
|
|
|
|
|
|
|
#This routine checks to ensure that the session ID is in the form |
446
|
|
|
|
|
|
|
#we expect. This must be called before we start diddling around |
447
|
|
|
|
|
|
|
#in the database or the disk. |
448
|
|
|
|
|
|
|
|
449
|
0
|
|
|
0
|
0
|
|
my $session = shift; |
450
|
|
|
|
|
|
|
|
451
|
0
|
0
|
|
|
|
|
if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) { |
452
|
0
|
|
|
|
|
|
die 'Invalid session id' ; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# |
457
|
|
|
|
|
|
|
# For Apache::Session >= 1.50 |
458
|
|
|
|
|
|
|
# |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub populate |
461
|
|
|
|
|
|
|
{ |
462
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
463
|
|
|
|
|
|
|
|
464
|
0
|
|
|
|
|
|
my $store = $self->{args}->{Store}; |
465
|
0
|
|
|
|
|
|
my $lock = $self->{args}->{Lock}; |
466
|
0
|
0
|
|
|
|
|
if (!$self->{populated}) |
467
|
|
|
|
|
|
|
{ |
468
|
0
|
|
|
|
|
|
my $gen = $self->{args}->{Generate}; |
469
|
0
|
|
|
|
|
|
my $ser = $self->{args}->{Serialize}; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
|
472
|
0
|
0
|
|
|
|
|
$self->{object_store} = new $store $self if ($store) ; |
473
|
0
|
0
|
|
|
|
|
$self->{lock_manager} = new $lock $self if ($lock); |
474
|
0
|
0
|
|
|
|
|
$self->{generate} = \&{$gen . '::generate'} if ($gen); |
|
0
|
|
|
|
|
|
|
475
|
0
|
0
|
0
|
|
|
|
$self->{'validate'} = \&{$gen . '::validate'} if ($gen && defined (&{$gen . '::validate'})); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
476
|
0
|
0
|
|
|
|
|
$self->{serialize} = \&{$ser . '::serialize'} if ($ser); |
|
0
|
|
|
|
|
|
|
477
|
0
|
0
|
|
|
|
|
$self->{unserialize} = \&{$ser . '::unserialize'} if ($ser) ; |
|
0
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
|
479
|
0
|
0
|
|
|
|
|
if (!defined ($self->{'validate'})) |
480
|
|
|
|
|
|
|
{ |
481
|
0
|
|
|
|
|
|
$self->{'validate'} = \&validate ; |
482
|
|
|
|
|
|
|
} |
483
|
0
|
|
|
|
|
|
$self->{populated} = 1 ; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
else |
486
|
|
|
|
|
|
|
{ # recreate only store & lock classes as far as necessary |
487
|
0
|
0
|
0
|
|
|
|
$self->{object_store} ||= new $store $self if ($store) ; |
488
|
0
|
0
|
0
|
|
|
|
$self->{lock_manager} ||= new $lock $self if ($lock); |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
0
|
|
|
|
|
|
return $self; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
1 ; |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
__END__ |