Line # Revision Author
1 194 ahitrov package session::Keeper;
2
3 use strict;
4 use warnings 'all';
5 use base qw(Contenido::Keeper);
6
7 use Apache::Cookie;
8 use Apache::Session::File;
9 use Apache::Session::Postgres;
10 253 ahitrov use Apache::Session::Memcached;
11 194 ahitrov use Contenido::Globals;
12 use Data::Dumper;
13
14
15 sub logon {
16 my $self = shift;
17 my %opts = @_;
18
19 return if !($opts{login} || $opts{email}) && !$opts{passwd};
20
21 my $res;
22 my @plugins = split (/[\ |\t]+/, $state->{plugins});
23 if ( grep { $_ eq 'users' } @plugins ) {
24 #### ����������� ����� ������ users
25 #########################################
26 $res = $keeper->{users}->login (
27 $opts{login} ? (login => $opts{login}) : (),
28 $opts{email} ? (email => lc($opts{email})) : (),
29 passwd => $opts{passwd},
30 );
31 return unless $res;
32 } else {
33 #### ����������� ���� ��������
34
35
36
37 }
38 if ( ref $res ) {
39 my %data = (
40 id => $res->id,
41 name => $res->name,
42 email => $res->email,
43 login => $res->login,
44 status => $res->status,
45 ltime => time,
46 );
47 $self->store_value ( %data );
48 }
49 return $self->get_session();
50 }
51
52
53 sub logoff {
54 my $self = shift;
55 243 ahitrov my %opts = @_;
56
57 194 ahitrov my $sid = _get_session_id ();
58 my $session = _get_session_object ( $sid );
59 return unless ref $session;
60
61 my $session_id = $session->{_session_id};
62 if (!$sid || $sid ne $session_id) {
63 warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
64 _store_session_id ($session_id)
65 } else {
66 243 ahitrov if ( exists $opts{clear} ) {
67 my @clear = qw( id email login name nick type status ltime );
68 push @clear, @{ $opts{clear} } if exists $opts{clear} && ref $opts{clear} eq 'ARRAY' && @{ $opts{clear} };
69 foreach my $key ( @clear ) {
70 delete $session->{$key};
71 }
72 } else {
73 foreach my $key ( keys %$session ) {
74 next if $key eq '_session_id';
75 next if $key eq '_timestamp';
76 delete $session->{$key};
77 }
78 }
79 194 ahitrov }
80 untie %$session;
81 return 1;
82 }
83
84
85 sub get_value {
86
87 my ($self, $name) = @_;
88 my $sid = _get_session_id ();
89 my $session = _get_session_object ( $sid );
90 return unless ref $session;
91
92 my $session_id = $session->{_session_id};
93 my $value = $session->{$name};
94 if (!$sid || $sid ne $session_id) {
95 warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
96 _store_session_id ($session_id);
97 }
98 untie %$session;
99 return $value;
100 }
101
102
103 sub store_value {
104
105 my ($self, %opts) = @_;
106 my $sid = _get_session_id ();
107 my $session = _get_session_object ( $sid );
108 return unless ref $session;
109
110 foreach my $key ( keys %opts ) {
111 $session->{$key} = $opts{$key};
112 }
113
114 my $session_id = $session->{_session_id};
115 if (!$sid || $sid ne $session_id) {
116 warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
117 _store_session_id ($session_id);
118 }
119 untie %$session;
120 return 1;
121 }
122
123
124 sub delete_key {
125
126 my ($self, $key) = @_;
127 return unless $key;
128
129 my $sid = _get_session_id ();
130 my $session = _get_session_object ( $sid );
131 return unless ref $session;
132
133 my $session_id = $session->{_session_id};
134 if (!$sid || $sid ne $session_id) {
135 warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
136 _store_session_id ($session_id);
137 } else {
138 delete $session->{$key} if exists $session->{$key};
139 }
140 untie %$session;
141 return 1;
142 }
143
144
145 sub get_session {
146
147 my $self = shift;
148
149 my $sid = _get_session_id () || '';
150 my $session = _get_session_object ($sid);
151 return unless ref $session;
152
153 my $session_id = $session->{_session_id};
154 my %ret = %$session;
155 if (!$sid || $sid ne $session_id) {
156 warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
157 _store_session_id ($session_id);
158 }
159 untie %$session;
160
161 return \%ret;
162 }
163
164
165 ## ���������� �������
166 ######################################################################################
167 sub _store_session_id {
168
169 my $sid = shift;
170 return unless $sid;
171 my $cookie = Apache::Cookie->new ($request->r(),
172 -domain => $state->{session}->domain,
173 -name => $state->{session}->cookie,
174 -expires=> $state->{session}->expires,
175 -value => $sid,
176 -path => '/',
177 );
178 $cookie->bake();
179
180 }
181
182
183 sub _get_session_id {
184
185 my %cookies = Apache::Cookie->fetch;
186 warn Dumper(\%cookies) if $DEBUG;
187 my $cookie = $cookies{$state->{session}->cookie};
188
189 # ����������� SID �� ����
190 my $sid = $cookie->value() || '' if $cookie;
191 warn "\nSession_id = $sid\n" if $DEBUG;
192
193 return $sid;
194 }
195
196
197 sub _get_session_object {
198
199 my $sid = shift;
200
201 my %session;
202 my $now = time;
203 if ( $state->{session}->storage eq 'POSTGRES' ) {
204 eval {
205 tie %session, 'Apache::Session::Postgres', $sid, {
206 Handle => $keeper->SQL,
207 };
208 };
209 253 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
210 eval {
211 tie %session, 'Apache::Session::Memcached', $sid, {
212 Handler => $keeper->{session}->MEMD,
213 Expiration => $state->{session}->{lifetime},
214 # Servers => $state->{session}->memcached_servers,
215 # NoRehash => 1,
216 # Readonly => 0,
217 # Debug => $DEBUG,
218 # CompressThreshold => 10_000
219 };
220 };
221 194 ahitrov } else {
222 eval {
223 tie %session, 'Apache::Session::File', $sid, {
224 253 ahitrov Directory => $state->{session}->session_dir,
225 194 ahitrov };
226 };
227 }
228 if ($@) {
229 warn "Session data is not accessible: $@";
230 undef $sid;
231 } elsif ( $state->{session}->lifetime ) {
232 unless ( exists $session{_timestamp} ) {
233 $session{_timestamp} = $now;
234 } elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) {
235 undef $sid;
236 } elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) {
237 $session{_timestamp} = $now;
238 }
239 }
240 unless ( $sid ) {
241 if ( $state->{session}->storage eq 'POSTGRES' ) {
242 eval {
243 tie %session, 'Apache::Session::Postgres', undef, {
244 Handle => $keeper->SQL,
245 };
246 };
247 253 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
248 eval {
249 tie %session, 'Apache::Session::Memcached', undef, {
250 Handler => $keeper->{session}->MEMD,
251 Expiration => $state->{session}->{lifetime},
252 # Servers => $state->{session}->memcached_servers,
253 # NoRehash => 1,
254 # Readonly => 0,
255 # Debug => $DEBUG,
256 # CompressThreshold => 10_000
257 };
258 };
259 194 ahitrov } else {
260 eval {
261 tie %session, 'Apache::Session::File', undef, {
262 Directory => $state->session->session_dir,
263 };
264 };
265 }
266 $session{_timestamp} = $now;
267 }
268
269 return \%session;
270 }
271
272
273 sub _drop_session_object {
274
275 my (%session) = @_;
276
277 untie %session;
278
279 }
280
281 1;