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 254 ahitrov use Apache::Session::Memcached;
11 197 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 244 ahitrov my ($type_prop) = grep { $_->{attr} eq 'type' } $res->structure;
48 $data{type} = $res->type if $type_prop;
49 197 ahitrov $self->store_value ( %data );
50 }
51 return $self->get_session();
52 }
53
54
55 sub logoff {
56 my $self = shift;
57 263 ahitrov my (%opts) = @_;
58 197 ahitrov
59 my $sid = _get_session_id ();
60 my $session = _get_session_object ( $sid );
61 return unless ref $session;
62
63 my $session_id = $session->{_session_id};
64 if (!$sid || $sid ne $session_id) {
65 warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
66 263 ahitrov _store_session_id ($session_id, %opts)
67 197 ahitrov } else {
68 240 ahitrov if ( exists $opts{clear} ) {
69 my @clear = qw( id email login name nick type status ltime );
70 push @clear, @{ $opts{clear} } if exists $opts{clear} && ref $opts{clear} eq 'ARRAY' && @{ $opts{clear} };
71 foreach my $key ( @clear ) {
72 delete $session->{$key};
73 }
74 } else {
75 foreach my $key ( keys %$session ) {
76 next if $key eq '_session_id';
77 next if $key eq '_timestamp';
78 delete $session->{$key};
79 }
80 }
81 197 ahitrov }
82 untie %$session;
83 return 1;
84 }
85
86
87 244 ahitrov sub autologon {
88 my $self = shift;
89 my %opts = @_;
90
91 my $profile = delete $opts{profile};
92 if ( ref $profile ) {
93 my %data = (
94 id => $profile->id,
95 name => $profile->name,
96 email => $profile->email,
97 login => $profile->login,
98 status => $profile->status,
99 ltime => time,
100 );
101 my ($type_prop) = grep { $_->{attr} eq 'type' } $profile->structure;
102 $data{type} = $profile->type if $type_prop;
103 254 ahitrov my ($ava_prop) = grep { $_->{attr} eq 'avatar' } $profile->structure;
104 if ( $ava_prop ) {
105 my $avatar = $profile->get_image('avatar');
106 $data{avatar} = $avatar->{mini}{filename} if ref $avatar && exists $avatar->{filename};
107 }
108 244 ahitrov $self->store_value ( %data );
109 return $self->get_session();
110 }
111 return undef;
112 }
113
114
115 197 ahitrov sub get_value {
116
117 263 ahitrov my ($self, $name, %opts) = @_;
118 my $sid = delete $opts{_session_id} || _get_session_id ();
119 197 ahitrov my $session = _get_session_object ( $sid );
120 return unless ref $session;
121
122 my $session_id = $session->{_session_id};
123 my $value = $session->{$name};
124 if (!$sid || $sid ne $session_id) {
125 warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
126 263 ahitrov _store_session_id ($session_id, %opts);
127 197 ahitrov }
128 untie %$session;
129 return $value;
130 }
131
132
133 sub store_value {
134
135 my ($self, %opts) = @_;
136 263 ahitrov my $domain = delete $opts{domain};
137 my $sid = delete $opts{_session_id} || _get_session_id ();
138 197 ahitrov my $session = _get_session_object ( $sid );
139 return unless ref $session;
140
141 foreach my $key ( keys %opts ) {
142 $session->{$key} = $opts{$key};
143 }
144
145 my $session_id = $session->{_session_id};
146 if (!$sid || $sid ne $session_id) {
147 warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
148 263 ahitrov _store_session_id ($session_id, domain => $domain);
149 197 ahitrov }
150 untie %$session;
151 return 1;
152 }
153
154
155 sub delete_key {
156
157 263 ahitrov my ($self, $key, %opts) = @_;
158 197 ahitrov return unless $key;
159
160 263 ahitrov my $sid = delete $opts{_session_id} || _get_session_id ();
161 197 ahitrov my $session = _get_session_object ( $sid );
162 return unless ref $session;
163
164 my $session_id = $session->{_session_id};
165 if (!$sid || $sid ne $session_id) {
166 warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
167 263 ahitrov _store_session_id ($session_id, %opts);
168 197 ahitrov } else {
169 delete $session->{$key} if exists $session->{$key};
170 }
171 untie %$session;
172 return 1;
173 }
174
175
176 sub get_session {
177
178 my $self = shift;
179 263 ahitrov my (%opts) = @_;
180 197 ahitrov
181 my $sid = _get_session_id () || '';
182 my $session = _get_session_object ($sid);
183 return unless ref $session;
184
185 my $session_id = $session->{_session_id};
186 my %ret = %$session;
187 if (!$sid || $sid ne $session_id) {
188 warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
189 263 ahitrov _store_session_id ($session_id, %opts);
190 197 ahitrov }
191 untie %$session;
192
193 return \%ret;
194 }
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 );
211 $cookie->bake();
212
213 }
214
215
216 sub _get_session_id {
217
218 263 ahitrov my $keyname = shift || $state->{session}->cookie;
219
220 197 ahitrov my %cookies = Apache::Cookie->fetch;
221 warn Dumper(\%cookies) if $DEBUG;
222 263 ahitrov my $cookie = $cookies{$keyname};
223 197 ahitrov
224 # Вытаскиваем SID из куки
225 my $sid = $cookie->value() || '' if $cookie;
226 warn "\nSession_id = $sid\n" if $DEBUG;
227
228 return $sid;
229 }
230
231
232 sub _get_session_object {
233
234 my $sid = shift;
235
236 my %session;
237 my $now = time;
238 if ( $state->{session}->storage eq 'POSTGRES' ) {
239 eval {
240 tie %session, 'Apache::Session::Postgres', $sid, {
241 Handle => $keeper->SQL,
242 };
243 };
244 254 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
245 eval {
246 tie %session, 'Apache::Session::Memcached', $sid, {
247 Handler => $keeper->{session}->MEMD,
248 Expiration => $state->{session}->{lifetime},
249 };
250 };
251 197 ahitrov } else {
252 eval {
253 tie %session, 'Apache::Session::File', $sid, {
254 254 ahitrov Directory => $state->{session}->session_dir,
255 197 ahitrov };
256 };
257 }
258 if ($@) {
259 warn "Session data is not accessible: $@";
260 undef $sid;
261 263 ahitrov } else {
262 $sid = $session{_session_id};
263 if ( $state->{session}->lifetime ) {
264 unless ( exists $session{_timestamp} ) {
265 $session{_timestamp} = $now;
266 } elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) {
267 undef $sid;
268 } elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) {
269 $session{_timestamp} = $now;
270 }
271 197 ahitrov }
272 }
273 unless ( $sid ) {
274 if ( $state->{session}->storage eq 'POSTGRES' ) {
275 eval {
276 tie %session, 'Apache::Session::Postgres', undef, {
277 Handle => $keeper->SQL,
278 };
279 };
280 254 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
281 eval {
282 tie %session, 'Apache::Session::Memcached', undef, {
283 Handler => $keeper->{session}->MEMD,
284 Expiration => $state->{session}->{lifetime},
285 };
286 };
287 197 ahitrov } else {
288 eval {
289 tie %session, 'Apache::Session::File', undef, {
290 254 ahitrov Directory => $state->{session}->session_dir,
291 197 ahitrov };
292 };
293 }
294 $session{_timestamp} = $now;
295 }
296
297 return \%session;
298 }
299
300
301 sub _drop_session_object {
302
303 my (%session) = @_;
304
305 untie %session;
306
307 }
308
309 1;