Line # Revision Author
1 197 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 use Contenido::Globals;
11 use Data::Dumper;
12
13
14 sub logon {
15 my $self = shift;
16 my %opts = @_;
17
18 return if !($opts{login} || $opts{email}) && !$opts{passwd};
19
20 my $res;
21 my @plugins = split (/[\ |\t]+/, $state->{plugins});
22 if ( grep { $_ eq 'users' } @plugins ) {
23 #### Авторизация через плагин users
24 #########################################
25 $res = $keeper->{users}->login (
26 $opts{login} ? (login => $opts{login}) : (),
27 $opts{email} ? (email => lc($opts{email})) : (),
28 passwd => $opts{passwd},
29 );
30 return unless $res;
31 } else {
32 #### Авторизация иным способом
33
34
35
36 }
37 if ( ref $res ) {
38 my %data = (
39 id => $res->id,
40 name => $res->name,
41 345 ahitrov email => ref $res->email ? $res->email->name : $res->email,
42 197 ahitrov login => $res->login,
43 status => $res->status,
44 ltime => time,
45 );
46 244 ahitrov my ($type_prop) = grep { $_->{attr} eq 'type' } $res->structure;
47 $data{type} = $res->type if $type_prop;
48 197 ahitrov $self->store_value ( %data );
49 }
50 return $self->get_session();
51 }
52
53
54 sub logoff {
55 my $self = shift;
56 263 ahitrov my (%opts) = @_;
57 197 ahitrov
58 my $sid = _get_session_id ();
59 my $session = _get_session_object ( $sid );
60 return unless ref $session;
61
62 my $session_id = $session->{_session_id};
63 if (!$sid || $sid ne $session_id) {
64 warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
65 263 ahitrov _store_session_id ($session_id, %opts)
66 197 ahitrov } else {
67 240 ahitrov if ( exists $opts{clear} ) {
68 my @clear = qw( id email login name nick type status ltime );
69 push @clear, @{ $opts{clear} } if exists $opts{clear} && ref $opts{clear} eq 'ARRAY' && @{ $opts{clear} };
70 foreach my $key ( @clear ) {
71 delete $session->{$key};
72 }
73 } else {
74 foreach my $key ( keys %$session ) {
75 next if $key eq '_session_id';
76 next if $key eq '_timestamp';
77 delete $session->{$key};
78 }
79 }
80 197 ahitrov }
81 untie %$session;
82 return 1;
83 }
84
85
86 244 ahitrov sub autologon {
87 my $self = shift;
88 my %opts = @_;
89
90 my $profile = delete $opts{profile};
91 if ( ref $profile ) {
92 my %data = (
93 id => $profile->id,
94 name => $profile->name,
95 344 ahitrov email => ref $profile->email ? $profile->email->name : $profile->email,
96 244 ahitrov login => $profile->login,
97 status => $profile->status,
98 ltime => time,
99 );
100 my ($type_prop) = grep { $_->{attr} eq 'type' } $profile->structure;
101 $data{type} = $profile->type if $type_prop;
102 254 ahitrov my ($ava_prop) = grep { $_->{attr} eq 'avatar' } $profile->structure;
103 if ( $ava_prop ) {
104 my $avatar = $profile->get_image('avatar');
105 $data{avatar} = $avatar->{mini}{filename} if ref $avatar && exists $avatar->{filename};
106 }
107 244 ahitrov $self->store_value ( %data );
108 return $self->get_session();
109 }
110 return undef;
111 }
112
113
114 197 ahitrov sub get_value {
115
116 263 ahitrov my ($self, $name, %opts) = @_;
117 my $sid = delete $opts{_session_id} || _get_session_id ();
118 197 ahitrov my $session = _get_session_object ( $sid );
119 return unless ref $session;
120
121 my $session_id = $session->{_session_id};
122 my $value = $session->{$name};
123 if (!$sid || $sid ne $session_id) {
124 warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
125 263 ahitrov _store_session_id ($session_id, %opts);
126 197 ahitrov }
127 untie %$session;
128 return $value;
129 }
130
131
132 sub store_value {
133
134 my ($self, %opts) = @_;
135 263 ahitrov my $domain = delete $opts{domain};
136 my $sid = delete $opts{_session_id} || _get_session_id ();
137 197 ahitrov my $session = _get_session_object ( $sid );
138 return unless ref $session;
139
140 foreach my $key ( keys %opts ) {
141 $session->{$key} = $opts{$key};
142 }
143
144 my $session_id = $session->{_session_id};
145 if (!$sid || $sid ne $session_id) {
146 warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
147 263 ahitrov _store_session_id ($session_id, domain => $domain);
148 197 ahitrov }
149 untie %$session;
150 return 1;
151 }
152
153
154 sub delete_key {
155
156 263 ahitrov my ($self, $key, %opts) = @_;
157 197 ahitrov return unless $key;
158
159 263 ahitrov my $sid = delete $opts{_session_id} || _get_session_id ();
160 197 ahitrov my $session = _get_session_object ( $sid );
161 return unless ref $session;
162
163 my $session_id = $session->{_session_id};
164 if (!$sid || $sid ne $session_id) {
165 warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
166 263 ahitrov _store_session_id ($session_id, %opts);
167 197 ahitrov } else {
168 delete $session->{$key} if exists $session->{$key};
169 }
170 untie %$session;
171 return 1;
172 }
173
174
175 sub get_session {
176
177 my $self = shift;
178 263 ahitrov my (%opts) = @_;
179 197 ahitrov
180 my $sid = _get_session_id () || '';
181 my $session = _get_session_object ($sid);
182 return unless ref $session;
183
184 my $session_id = $session->{_session_id};
185 my %ret = %$session;
186 if (!$sid || $sid ne $session_id) {
187 warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
188 263 ahitrov _store_session_id ($session_id, %opts);
189 197 ahitrov }
190 untie %$session;
191
192 272 ahitrov my $session_object = session::Session->new( %ret );
193 return $session_object;
194 197 ahitrov }
195
196
197 ## Внутренние функции
198 ######################################################################################
199 sub _store_session_id {
200
201 my $sid = shift;
202 263 ahitrov my (%opts) = @_;
203 197 ahitrov return unless $sid;
204 my $cookie = Apache::Cookie->new ($request->r(),
205 263 ahitrov -domain => $opts{domain} || $state->{session}->domain,
206 197 ahitrov -name => $state->{session}->cookie,
207 -expires=> $state->{session}->expires,
208 -value => $sid,
209 -path => '/',
210 806 ahitrov -secure => 1,
211 197 ahitrov );
212 $cookie->bake();
213
214 }
215
216
217 sub _get_session_id {
218
219 263 ahitrov my $keyname = shift || $state->{session}->cookie;
220
221 197 ahitrov my %cookies = Apache::Cookie->fetch;
222 warn Dumper(\%cookies) if $DEBUG;
223 263 ahitrov my $cookie = $cookies{$keyname};
224 197 ahitrov
225 # Вытаскиваем SID из куки
226 my $sid = $cookie->value() || '' if $cookie;
227 warn "\nSession_id = $sid\n" if $DEBUG;
228
229 return $sid;
230 }
231
232
233 sub _get_session_object {
234
235 my $sid = shift;
236
237 my %session;
238 my $now = time;
239 if ( $state->{session}->storage eq 'POSTGRES' ) {
240 eval {
241 tie %session, 'Apache::Session::Postgres', $sid, {
242 Handle => $keeper->SQL,
243 };
244 };
245 254 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
246 eval {
247 tie %session, 'Apache::Session::Memcached', $sid, {
248 Handler => $keeper->{session}->MEMD,
249 Expiration => $state->{session}->{lifetime},
250 };
251 };
252 197 ahitrov } else {
253 eval {
254 tie %session, 'Apache::Session::File', $sid, {
255 254 ahitrov Directory => $state->{session}->session_dir,
256 197 ahitrov };
257 };
258 }
259 if ($@) {
260 warn "Session data is not accessible: $@";
261 undef $sid;
262 263 ahitrov } else {
263 $sid = $session{_session_id};
264 if ( $state->{session}->lifetime ) {
265 unless ( exists $session{_timestamp} ) {
266 $session{_timestamp} = $now;
267 } elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) {
268 undef $sid;
269 } elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) {
270 $session{_timestamp} = $now;
271 }
272 197 ahitrov }
273 }
274 unless ( $sid ) {
275 if ( $state->{session}->storage eq 'POSTGRES' ) {
276 eval {
277 tie %session, 'Apache::Session::Postgres', undef, {
278 Handle => $keeper->SQL,
279 };
280 };
281 254 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
282 eval {
283 tie %session, 'Apache::Session::Memcached', undef, {
284 Handler => $keeper->{session}->MEMD,
285 Expiration => $state->{session}->{lifetime},
286 };
287 };
288 197 ahitrov } else {
289 eval {
290 tie %session, 'Apache::Session::File', undef, {
291 254 ahitrov Directory => $state->{session}->session_dir,
292 197 ahitrov };
293 };
294 }
295 $session{_timestamp} = $now;
296 }
297
298 return \%session;
299 }
300
301
302 sub _drop_session_object {
303
304 my (%session) = @_;
305
306 untie %session;
307
308 }
309
310 272 ahitrov sub _get_hash_from_profile {
311 my $profile = shift;
312 680 ahitrov if ( ref $profile eq 'session::Keeper' ) {
313 $profile = shift;
314 }
315 272 ahitrov return unless ref $profile;
316
317 my %data = (
318 id => $profile->id,
319 name => $profile->name,
320 344 ahitrov email => ref $profile->email ? $profile->email->name : $profile->email,
321 272 ahitrov login => $profile->login,
322 status => $profile->status,
323 ltime => time,
324 );
325 408 ahitrov if ( $profile->can('name_full') ) {
326 $data{name_full} = $profile->name_full;
327 }
328 if ( $profile->can('name_part') ) {
329 $data{name_part} = $profile->name_part;
330 }
331 272 ahitrov my ($type_prop) = grep { $_->{attr} eq 'type' } $profile->structure;
332 $data{type} = $profile->type if $type_prop;
333 my ($ava_prop) = grep { $_->{attr} eq 'avatar' } $profile->structure;
334 if ( $ava_prop ) {
335 my $avatar = $profile->get_image('avatar');
336 $data{avatar} = $avatar->{mini}{filename} if ref $avatar && exists $avatar->{filename};
337 }
338
339 return %data;
340 }
341
342 197 ahitrov 1;