package session::Keeper; use strict; use warnings 'all'; use base qw(Contenido::Keeper); use Apache::Cookie; use Apache::Session::File; use Apache::Session::Postgres; use Contenido::Globals; use Data::Dumper; sub logon { my $self = shift; my %opts = @_; return if !($opts{login} || $opts{email}) && !$opts{passwd}; my $res; my @plugins = split (/[\ |\t]+/, $state->{plugins}); if ( grep { $_ eq 'users' } @plugins ) { #### Авторизация через плагин users ######################################### $res = $keeper->{users}->login ( $opts{login} ? (login => $opts{login}) : (), $opts{email} ? (email => lc($opts{email})) : (), passwd => $opts{passwd}, ); return unless $res; } else { #### Авторизация иным способом } if ( ref $res ) { my %data = ( id => $res->id, name => $res->name, email => $res->email, login => $res->login, status => $res->status, ltime => time, ); $self->store_value ( %data ); } return $self->get_session(); } sub logoff { my $self = shift; my %opts = @_; my $sid = _get_session_id (); my $session = _get_session_object ( $sid ); return unless ref $session; my $session_id = $session->{_session_id}; if (!$sid || $sid ne $session_id) { warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG; _store_session_id ($session_id) } else { if ( exists $opts{clear} ) { my @clear = qw( id email login name nick type status ltime ); push @clear, @{ $opts{clear} } if exists $opts{clear} && ref $opts{clear} eq 'ARRAY' && @{ $opts{clear} }; foreach my $key ( @clear ) { delete $session->{$key}; } } else { foreach my $key ( keys %$session ) { next if $key eq '_session_id'; next if $key eq '_timestamp'; delete $session->{$key}; } } } untie %$session; return 1; } sub get_value { my ($self, $name) = @_; my $sid = _get_session_id (); my $session = _get_session_object ( $sid ); return unless ref $session; my $session_id = $session->{_session_id}; my $value = $session->{$name}; if (!$sid || $sid ne $session_id) { warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG; _store_session_id ($session_id); } untie %$session; return $value; } sub store_value { my ($self, %opts) = @_; my $sid = _get_session_id (); my $session = _get_session_object ( $sid ); return unless ref $session; foreach my $key ( keys %opts ) { $session->{$key} = $opts{$key}; } my $session_id = $session->{_session_id}; if (!$sid || $sid ne $session_id) { warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG; _store_session_id ($session_id); } untie %$session; return 1; } sub delete_key { my ($self, $key) = @_; return unless $key; my $sid = _get_session_id (); my $session = _get_session_object ( $sid ); return unless ref $session; my $session_id = $session->{_session_id}; if (!$sid || $sid ne $session_id) { warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG; _store_session_id ($session_id); } else { delete $session->{$key} if exists $session->{$key}; } untie %$session; return 1; } sub get_session { my $self = shift; my $sid = _get_session_id () || ''; my $session = _get_session_object ($sid); return unless ref $session; my $session_id = $session->{_session_id}; my %ret = %$session; if (!$sid || $sid ne $session_id) { warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG; _store_session_id ($session_id); } untie %$session; return \%ret; } ## Внутренние функции ###################################################################################### sub _store_session_id { my $sid = shift; return unless $sid; my $cookie = Apache::Cookie->new ($request->r(), -domain => $state->{session}->domain, -name => $state->{session}->cookie, -expires=> $state->{session}->expires, -value => $sid, -path => '/', ); $cookie->bake(); } sub _get_session_id { my %cookies = Apache::Cookie->fetch; warn Dumper(\%cookies) if $DEBUG; my $cookie = $cookies{$state->{session}->cookie}; # Вытаскиваем SID из куки my $sid = $cookie->value() || '' if $cookie; warn "\nSession_id = $sid\n" if $DEBUG; return $sid; } sub _get_session_object { my $sid = shift; my %session; my $now = time; if ( $state->{session}->storage eq 'POSTGRES' ) { eval { tie %session, 'Apache::Session::Postgres', $sid, { Handle => $keeper->SQL, }; }; } else { eval { tie %session, 'Apache::Session::File', $sid, { Directory => $state->session->session_dir, }; }; } if ($@) { warn "Session data is not accessible: $@"; undef $sid; } elsif ( $state->{session}->lifetime ) { unless ( exists $session{_timestamp} ) { $session{_timestamp} = $now; } elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) { undef $sid; } elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) { $session{_timestamp} = $now; } } unless ( $sid ) { if ( $state->{session}->storage eq 'POSTGRES' ) { eval { tie %session, 'Apache::Session::Postgres', undef, { Handle => $keeper->SQL, }; }; } else { eval { tie %session, 'Apache::Session::File', undef, { Directory => $state->session->session_dir, }; }; } $session{_timestamp} = $now; } return \%session; } sub _drop_session_object { my (%session) = @_; untie %session; } 1;