use Digest ();
use overload ();
use Object::Signature ();
+use Carp;
-our $VERSION = "0.05";
+our $VERSION = '0.20';
my @session_data_accessors; # used in delete_session
BEGIN {
_sessionid
_session
_session_expires
+ _extended_session_expires
_session_data_sig
_flash
_flash_keep_keys
_flash_key_hashes
+ _tried_loading_session_id
+ _tried_loading_session_data
+ _tried_loading_session_expires
+ _tried_loading_flash_data
/
);
}
%$cfg = (
expires => 7200,
- verify_address => 1,
+ verify_address => 0,
%$cfg,
);
my $c = shift;
if ( $c->config->{session}{flash_to_stash}
- and $c->_sessionid
+ and $c->sessionid
and my $flash_data = $c->flash )
{
@{ $c->stash }{ keys %$flash_data } = values %$flash_data;
$c->NEXT::prepare_action(@_);
}
+sub finalize_headers {
+ my $c = shift;
+
+ # fix cookie before we send headers
+ $c->_save_session_expires;
+
+ return $c->NEXT::finalize_headers(@_);
+}
+
sub finalize {
my $c = shift;
+ my $ret = $c->NEXT::finalize(@_);
+
+ # then finish the rest
+ $c->finalize_session;
+ return $ret;
+}
+
+sub finalize_session {
+ my $c = shift;
+ $c->NEXT::finalize_session;
+
+ $c->_save_session_id;
$c->_save_session;
$c->_save_flash;
- $c->NEXT::finalize(@_);
+ $c->_clear_session_instance_data;
}
-sub _save_session {
+sub _save_session_id {
my $c = shift;
- if ( my $sid = $c->_sessionid ) {
+ # we already called set when allocating
+ # no need to tell the state plugins anything new
+}
- # all sessions are extended at the end of the request
- my $now = time;
+sub _save_session_expires {
+ my $c = shift;
- if ( my $expires = $c->session_expires ) {
- $c->store_session_data( "expires:$sid" => $expires );
- }
+ if ( defined($c->_session_expires) ) {
+ my $expires = $c->session_expires; # force extension
- if ( my $session_data = $c->_session ) {
+ my $sid = $c->sessionid;
+ $c->store_session_data( "expires:$sid" => $expires );
+ }
+}
- no warnings 'uninitialized';
- if ( Object::Signature::signature($session_data) ne
- $c->_session_data_sig )
- {
- $session_data->{__updated} = $now;
- $c->store_session_data( "session:$sid" => $session_data );
- }
+sub _save_session {
+ my $c = shift;
+
+ if ( my $session_data = $c->_session ) {
+
+ no warnings 'uninitialized';
+ if ( Object::Signature::signature($session_data) ne
+ $c->_session_data_sig )
+ {
+ $session_data->{__updated} = time();
+ my $sid = $c->sessionid;
+ $c->store_session_data( "session:$sid" => $session_data );
}
}
}
sub _save_flash {
my $c = shift;
- if ( my $sid = $c->_sessionid ) {
- if ( my $flash_data = $c->_flash ) {
+ if ( my $flash_data = $c->_flash ) {
- my $hashes = $c->_flash_key_hashes || {};
- my $keep = $c->_flash_keep_keys || {};
- foreach my $key ( keys %$hashes ) {
- if ( !exists $keep->{$key} and Object::Signature::signature( \$flash_data->{$key} ) eq $hashes->{$key} ) {
- delete $flash_data->{$key};
- }
+ my $hashes = $c->_flash_key_hashes || {};
+ my $keep = $c->_flash_keep_keys || {};
+ foreach my $key ( keys %$hashes ) {
+ if ( !exists $keep->{$key} and Object::Signature::signature( \$flash_data->{$key} ) eq $hashes->{$key} ) {
+ delete $flash_data->{$key};
}
+ }
+
+ my $sid = $c->sessionid;
- if (%$flash_data) {
- $c->store_session_data( "flash:$sid", $flash_data );
- }
- else {
- $c->delete_session_data("flash:$sid");
- }
+ if (%$flash_data) {
+ $c->store_session_data( "flash:$sid", $flash_data );
+ }
+ else {
+ $c->delete_session_data("flash:$sid");
+ }
+ }
+}
+
+sub _load_session_expires {
+ my $c = shift;
+ return $c->_session_expires if $c->_tried_loading_session_expires;
+ $c->_tried_loading_session_expires(1);
+
+ if ( my $sid = $c->sessionid ) {
+ my $expires = $c->get_session_data("expires:$sid") || 0;
+
+ if ( $expires >= time() ) {
+ $c->_session_expires( $expires );
+ return $expires;
+ } else {
+ $c->delete_session( "session expired" );
+ return 0;
}
}
+
+ return;
}
sub _load_session {
my $c = shift;
+ return $c->_session if $c->_tried_loading_session_data;
+ $c->_tried_loading_session_data(1);
- if ( my $sid = $c->_sessionid ) {
- if ( $c->session_expires ) { # > 0
+ if ( my $sid = $c->sessionid ) {
+ if ( $c->_load_session_expires ) { # > 0
my $session_data = $c->get_session_data("session:$sid") || return;
$c->_session($session_data);
$c->log->warn(
"Deleting session $sid due to address mismatch ("
. $session_data->{__address} . " != "
- . $c->request->address . ")" . Carp::longmess,
+ . $c->request->address . ")"
);
$c->delete_session("address mismatch");
return;
sub _load_flash {
my $c = shift;
+ return $c->_flash if $c->_tried_loading_flash_data;
+ $c->_tried_loading_flash_data(1);
- if ( my $sid = $c->_sessionid ) {
+ if ( my $sid = $c->sessionid ) {
if ( my $flash_data = $c->_flash
|| $c->_flash( $c->get_session_data("flash:$sid") ) )
{
$c->_flash_key_hashes({ map { $_ => Object::Signature::signature( \$flash_data->{$_} ) } keys %$flash_data });
+
return $flash_data;
}
}
- return undef;
+ return;
}
sub _expire_session_keys {
my $now = time;
- my $expiry = ( $data || $c->_session || {} )->{__expire_keys} || {};
- foreach my $key ( grep { $expiry->{$_} < $now } keys %$expiry ) {
+ my $expire_times = ( $data || $c->_session || {} )->{__expire_keys} || {};
+ foreach my $key ( grep { $expire_times->{$_} < $now } keys %$expire_times ) {
delete $c->_session->{$key};
- delete $expiry->{$key};
+ delete $expire_times->{$key};
}
}
+sub _clear_session_instance_data {
+ my $c = shift;
+ $c->$_(undef) for @session_data_accessors;
+ $c->NEXT::_clear_session_instance_data; # allow other plugins to hook in on this
+}
+
sub delete_session {
my ( $c, $msg ) = @_;
+ $c->log->debug("Deleting session" . ( defined($msg) ? "($msg)" : '(no reason given)') ) if $c->debug;
+
# delete the session data
- my $sid = $c->_sessionid || return;
- $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
+ if ( my $sid = $c->sessionid ) {
+ $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
+ $c->delete_session_id($sid);
+ }
# reset the values in the context object
# see the BEGIN block
- $c->$_(undef) for @session_data_accessors;
+ $c->_clear_session_instance_data;
$c->_session_delete_reason($msg);
}
sub session_delete_reason {
my $c = shift;
- $c->_load_session
- if ( $c->_sessionid && !$c->_session ); # must verify session data
+ $c->session_is_valid; # check that it was loaded
$c->_session_delete_reason(@_);
}
sub session_expires {
- my ( $c, $should_create ) = @_;
+ my $c = shift;
- $c->_session_expires || do {
- if ( my $sid = $c->_sessionid ) {
- my $now = time;
+ if ( defined( my $expires = $c->_extended_session_expires ) ) {
+ return $expires;
+ } elsif ( defined( $expires = $c->_load_session_expires ) ) {
+ return $c->extend_session_expires( $expires );
+ } else {
+ return 0;
+ }
+}
- if ( !$should_create ) {
- if ( ( $c->get_session_data("expires:$sid") || 0 ) < $now ) {
+sub extend_session_expires {
+ my ( $c, $expires ) = @_;
+ $c->_extended_session_expires( my $updated = $c->calculate_extended_session_expires( $expires ) );
+ $c->extend_session_id( $c->sessionid, $updated );
+ return $updated;
+}
- # session expired
- $c->log->debug("Deleting session $sid (expired)")
- if $c->debug;
- $c->delete_session("session expired");
- return 0;
- }
- }
+sub calculate_initial_session_expires {
+ my $c = shift;
+ return ( time() + $c->config->{session}{expires} );
+}
- return $c->_session_expires(
- $now + $c->config->{session}{expires} );
- }
- };
+sub calculate_extended_session_expires {
+ my ( $c, $prev ) = @_;
+ $c->calculate_initial_session_expires;
+}
+
+sub reset_session_expires {
+ my ( $c, $sid ) = @_;
+
+ my $exp = $c->calculate_initial_session_expires;
+ $c->_session_expires( $exp );
+ $c->_extended_session_expires( $exp );
+ $exp;
}
sub sessionid {
my $c = shift;
+
+ return $c->_sessionid || $c->_load_sessionid;
+}
- if (@_) {
- if($c->_sessionid()) {
- $c->log->warn('Session ID already set, ignoring.');
- return $c->_sessionid();
- }
- if ( $c->validate_session_id( my $sid = shift ) ) {
+sub _load_sessionid {
+ my $c = shift;
+ return if $c->_tried_loading_session_id;
+ $c->_tried_loading_session_id(1);
+
+ if ( defined( my $sid = $c->get_session_id ) ) {
+ if ( $c->validate_session_id($sid) ) {
+ # temporarily set the inner key, so that validation will work
$c->_sessionid($sid);
- return unless defined wantarray;
- }
- else {
+ return $sid;
+ } else {
my $err = "Tried to set invalid session ID '$sid'";
$c->log->error($err);
Catalyst::Exception->throw($err);
}
}
- $c->_load_session
- if ( $c->_sessionid && !$c->_session ); # must verify session data
+ return;
+}
- return $c->_sessionid;
+sub session_is_valid {
+ my $c = shift;
+
+ # force a check for expiry, but also __address, etc
+ if ( $c->_load_session ) {
+ return 1;
+ } else {
+ return;
+ }
}
sub validate_session_id {
my $c = shift;
$c->_session || $c->_load_session || do {
- $c->create_session_id;
-
+ $c->create_session_id_if_needed;
$c->initialize_session_data;
};
}
(@{$href}{@keys}) = ((undef) x @keys);
}
-sub flash {
+sub _flash_data {
my $c = shift;
$c->_flash || $c->_load_flash || do {
- $c->create_session_id;
+ $c->create_session_id_if_needed;
$c->_flash( {} );
- }
+ };
+}
+
+sub _set_flash {
+ my $c = shift;
+ if (@_) {
+ my $items = @_ > 1 ? {@_} : $_[0];
+ croak('flash takes a hash or hashref') unless ref $items;
+ @{ $c->_flash }{ keys %$items } = values %$items;
+ }
+}
+
+sub flash {
+ my $c = shift;
+ $c->_flash_data;
+ $c->_set_flash(@_);
+ return $c->_flash;
+}
+
+sub clear_flash {
+ my $c = shift;
+
+ #$c->delete_session_data("flash:" . $c->sessionid); # should this be in here? or delayed till finalization?
+ $c->_flash_key_hashes({});
+ $c->_flash_keep_keys({});
+ $c->_flash({});
}
sub session_expire_key {
return $digest->hexdigest;
}
+sub create_session_id_if_needed {
+ my $c = shift;
+ $c->create_session_id unless $c->sessionid;
+}
+
sub create_session_id {
my $c = shift;
+
+ my $sid = $c->generate_session_id;
- if ( !$c->_sessionid ) {
- my $sid = $c->generate_session_id;
+ $c->log->debug(qq/Created session "$sid"/) if $c->debug;
- $c->log->debug(qq/Created session "$sid"/) if $c->debug;
+ $c->_sessionid($sid);
+ $c->reset_session_expires;
+ $c->set_session_id($sid);
- $c->sessionid($sid);
- $c->session_expires(1);
- }
+ return $sid;
}
my $counter;
);
}
+
+sub get_session_id { shift->NEXT::get_session_id(@_) }
+sub set_session_id { shift->NEXT::set_session_id(@_) }
+sub delete_session_id { shift->NEXT::delete_session_id(@_) }
+sub extend_session_id { shift->NEXT::extend_session_id(@_) }
+
__PACKAGE__;
__END__
=head1 NAME
-Catalyst::Plugin::Session - Generic Session plugin - ties together server side
-storage and client side state required to maintain session data.
+Catalyst::Plugin::Session - Generic Session plugin - ties together server side storage and client side state required to maintain session data.
=head1 SYNOPSIS
Session::State::Cookie
/;
- # you can replace Store::FastMmap with Store::File - both have sensible
- # default configurations (see their docs for details)
+ # you can replace Store::FastMmap with Store::File - both have sensible
+ # default configurations (see their docs for details)
- # more complicated backends are available for other scenarios (DBI storage,
- # etc)
+ # more complicated backends are available for other scenarios (DBI storage,
+ # etc)
# after you've loaded the plugins you can save session data
This plugin links the two pieces together.
-=head1 RECCOMENDED BACKENDS
+=head1 RECOMENDED BACKENDS
=over 4
}
}
+=item clear_flash
+
+Zap all the keys in the flash regardless of their current state.
+
=item keep_flash @keys
-If you wawnt to keep a flash key for the next request too, even if it hasn't
+If you want to keep a flash key for the next request too, even if it hasn't
changed, call C<keep_flash> and pass in the keys as arguments.
+=item delete_session REASON
+
+This method is used to invalidate a session. It takes an optional parameter
+which will be saved in C<session_delete_reason> if provided.
+
=item session_delete_reason
This accessor contains a string with the reason a session was deleted. Possible
parameter is on - then it will copy the contents of the flash to the stash at
prepare time.
-=item finalize
+=item finalize_headers
-This method is extended and will extend the expiry time, as well as persist the
-session data if a session exists.
+This method is extended and will extend the expiry time before sending
+the response.
-=item delete_session REASON
+=item finalize
-This method is used to invalidate a session. It takes an optional parameter
-which will be saved in C<session_delete_reason> if provided.
+This method is extended and will call finalize_session after the other
+finalizes run. Here we persist the session data if a session exists.
=item initialize_session_data
=over 4
-=item *
-
-A counter
-
-=item *
-
-The current time
-
-=item *
-
-One value from C<rand>.
+=item * A counter
-=item *
+=item * The current time
-The stringified value of a newly allocated hash reference
+=item * One value from C<rand>.
-=item *
+=item * The stringified value of a newly allocated hash reference
-The stringified value of the Catalyst context object
+=item * The stringified value of the Catalyst context object
=back
Also have a look at L<Crypt::Random> and the various openssl bindings - these
modules provide APIs for cryptographically secure random data.
+=item finalize_session
+
+Clean up the session during C<finalize>.
+
+This clears the various accessors after saving to the store.
+
=item dump_these
See L<Catalyst/dump_these> - ammends the session data structure to the list of
dumped objects if session ID is defined.
+
+=item calculate_extended_session_expires
+
+=item calculate_initial_session_expires
+
+=item create_session_id_if_needed
+
+=item delete_session_id
+
+=item extend_session_expires
+
+=item extend_session_id
+
+=item get_session_id
+
+=item reset_session_expires
+
+=item session_is_valid
+
+=item set_session_id
+
=back
=head1 USING SESSIONS DURING PREPARE
C<prepare_action> L<Catalyst::Plugin::Session> will actually load the data from
the store.
- sub prepare_action {
- my $c = shift;
+ sub prepare_action {
+ my $c = shift;
- # don't touch $c->session yet!
+ # don't touch $c->session yet!
- $c->NEXT::prepare_action( @_ );
+ $c->NEXT::prepare_action( @_ );
- $c->session; # this is OK
- $c->sessionid; # this is also OK
- }
+ $c->session; # this is OK
+ $c->sessionid; # this is also OK
+ }
=head1 CONFIGURATION
When true, C<<$c->request->address>> will be checked at prepare time. If it is
not the same as the address that initiated the session, the session is deleted.
+Defaults to false.
+
=item flash_to_stash
This option makes it easier to have actions behave the same whether they were
=head1 AUTHORS
-=over 4
-
-=item Andy Grundman
+Andy Grundman
-=item Christian Hansen
+Christian Hansen
-=item Yuval Kogman, C<nothingmuch@woobling.org> (current maintainer)
+Yuval Kogman, C<nothingmuch@woobling.org> (current maintainer)
-=item Sebastian Riedel
-
-=back
+Sebastian Riedel
And countless other contributers from #catalyst. Thanks guys!
=head1 COPYRIGHT & LICENSE
- Copyright (c) 2005 the aforementioned authors. All rights
- reserved. This program is free software; you can redistribute
- it and/or modify it under the same terms as Perl itself.
+ Copyright (c) 2005 the aforementioned authors. All rights
+ reserved. This program is free software; you can redistribute
+ it and/or modify it under the same terms as Perl itself.
=cut
projects / catagits/Catalyst-Plugin-Session.git / blobdiff