This queue is for tickets about the CGI-Session CPAN distribution.

Report information
The Basics
Id:
21808
Status:
resolved
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
fenlisesi [...] gmail.com
Cc:
AdminCc:

BugTracker
Severity:
Wishlist
Broken in:
4.14
Fixed in:
(no value)



Subject: notabug: some work on the constructor load()
In the attached patch, I suggest some refactoring and cleanup to load(), the (sub)constructor for calls to new() as a class method. I also put in some questions/discussion points. Those are marked with the META: tag. The patch is against 4-14. It passes all the non-skipped tests that come with the 4-14 distribution on my machine, but please examine it closely anyway, as nobody reviewed it. Cheers, $CGI::Session::VERSION = '4.14'; This is perl, v5.8.8 built for i686-linux-thread-multi Linux version 2.6.11.4-21.14-default (geeko@buildhost) (gcc version 3.3.5 20050117 (prerelease) (SUSE Linux)) #1 Thu Aug 24 09:51:41 UTC 2006
Subject: CGI-Session-load-4.14.patch
--- Session-original.pm 2006-06-11 15:13:35.000000000 +0300 +++ Session-edited.pm 2006-10-02 04:58:58.000000000 +0300 @@ -591,148 +591,222 @@ =cut -# pass a true value as the fourth parameter if you want to skip the changing of access time +# Pass a true value as the fourth parameter if you want to skip the +# changing of access time sub load { - my $class = shift; - return $class->set_error( "called as instance method") if ref $class; - return $class->set_error( "invalid number of arguments") if @_ > 4; + my ($class, @args) = @_; + # Class method only + if (ref $class) { + return $class->set_error("called as instance method"); + } + if (@args > 4) { + # META: "Too many arguments" could be a better msg + return $class->set_error("invalid number of arguments"); + } my $self = bless { - _DATA => { - _SESSION_ID => undef, - _SESSION_CTIME => undef, - _SESSION_ATIME => undef, - _SESSION_REMOTE_ADDR => $ENV{REMOTE_ADDR} || "", + _STATUS => 0, # status of the session object + _CLAIMED_ID => undef, # id _claimed_ by client + _QUERY => undef, # query object + _DSN => {}, # parsed DSN params + _OBJECTS => {}, # keeps necessary objects + _DRIVER_ARGS => {}, # arguments to be passed to driver + _DATA => { # session data + _SESSION_ID => undef, + _SESSION_CTIME => undef, + _SESSION_ATIME => undef, + _SESSION_REMOTE_ADDR => $ENV{REMOTE_ADDR} || q(), # - # Following two attributes may not exist in every single session, and declaring - # them now will force these to get serialized into database, wasting space. But they - # are here to remind the coder of their purpose + # Following two attributes may not exist in every single + # session, and declaring them now will force these to get + # serialized into database, wasting space. But they are + # here to remind the coder of their purpose # -# _SESSION_ETIME => undef, -# _SESSION_EXPIRE_LIST => {} - }, # session data - _DSN => {}, # parsed DSN params - _OBJECTS => {}, # keeps necessary objects - _DRIVER_ARGS=> {}, # arguments to be passed to driver - _CLAIMED_ID => undef, # id **claimed** by client - _STATUS => 0, # status of the session object - _QUERY => undef # query object + # _SESSION_ETIME => undef, + # _SESSION_EXPIRE_LIST => {} + }, }, $class; + # META: Remove this line, or drop a line here on why it remains #$self->{_DATA}->{_SESSION_CTIME} = $self->{_DATA}->{_SESSION_ATIME} = time(); - my ($dsn,$query_or_sid,$dsn_args,$update_atime); - # load($query||$sid) - if ( @_ == 1 ) { - $self->_set_query_or_sid($_[0]); - } - # Two or more args passed: - # load($dsn, $query||$sid) - elsif ( @_ > 1 ) { - ($dsn, $query_or_sid, $dsn_args,$update_atime) = @_; - return $class->set_error( "invalid number of arguments") unless ! defined $update_atime || $update_atime =~ /^0$/; - if ( defined $dsn ) { # <-- to avoid 'Uninitialized value...' warnings - $self->{_DSN} = $self->parse_dsn($dsn); + my ($dsn, $query_or_sid, $dsn_args, $update_atime); + if (@args == 1) { + # load( $query||$sid ) + $self->_set_query_or_sid( $args[0] ); + } + elsif (@args > 1) { + # Two or more args passed: load($dsn, $query||$sid) + ($dsn, $query_or_sid, $dsn_args, $update_atime) = @args; + + if (defined $update_atime and $update_atime ne '0') { + # + # META: I do not understand this bit (I have just + # converted the double-negation and changed the !~ /^0$/ + # to ne '0'), but what this condition says does not seem + # to match the comment at the top of this sub. This says: + # if you have a fourth arg, then that arg has to be the + # string '0' -- it could be nothing else. + # + return $class->set_error( "invalid number of arguments"); } - $self->_set_query_or_sid($query_or_sid); + if (defined $dsn) { # avoid 'Uninitialized value...' warnings + $self->{_DSN} = $self->parse_dsn( $dsn ); + } + else { + # META: What do we do if $dsn is undef? + } + $self->_set_query_or_sid( $query_or_sid ); # load($dsn, $query, \%dsn_args); - $self->{_DRIVER_ARGS} = $dsn_args if defined $dsn_args; - } - # setting defaults, since above arguments might be 'undef' - $self->{_DSN}->{driver} ||= "file"; - $self->{_DSN}->{serializer} ||= "default"; - $self->{_DSN}->{id} ||= "md5"; - - # Checking and loading driver, serializer and id-generators - # Is this untainting reasonable here? - for ( - "CGI::Session::Driver::" . ($self->{_DSN}->{driver} =~ /(.*)/)[0], - "CGI::Session::Serialize::" . ($self->{_DSN}->{serializer} =~ /(.*)/)[0], - "CGI::Session::ID::" . ($self->{_DSN}->{id} =~ /(.*)/)[0], - ) { - eval "require $_"; - if ($@ ) { - return $self->set_error("couldn't load $_: " . $@); - } - } + $self->_load_pluggables(); - if (not $self->{_CLAIMED_ID} ) { + # META: Is '0' not an acceptable _CLAIMED_ID? Should we test for + # definedness rather than truth? + if (not $self->{_CLAIMED_ID}) { my $query = $self->query(); eval { - $self->{_CLAIMED_ID} = $query->cookie( $self->name ) || $query->param( $self->name ); + $self->{_CLAIMED_ID} + = $query->cookie( $self->name ) || $query->param( $self->name ); }; - if ( my $errmsg = $@ ) { - return $class->set_error( "query object $query does not support cookie() and param() methods: " . $errmsg ); + if (my $errmsg = $@) { + return $class->set_error( + "query object $query does not support" + . "cookie() and param() methods: " + . $errmsg + ); } } # No session is being requested. Just return an empty session + # META: Is '0' not an acceptable _CLAIMED_ID? Should we test for + # definedness rather than truth? return $self unless $self->{_CLAIMED_ID}; # Attempting to load the session my $driver = $self->_driver(); my $raw_data = $driver->retrieve( $self->{_CLAIMED_ID} ); - unless ( defined $raw_data ) { - return $self->set_error( "load(): couldn't retrieve data: " . $driver->errstr ); + unless (defined $raw_data) { + return $self->set_error( + "load(): couldn't retrieve data: " + . $driver->errstr + ); } # Requested session couldn't be retrieved return $self unless $raw_data; my $serializer = $self->_serializer(); - $self->{_DATA} = $serializer->thaw($raw_data); - unless ( defined $self->{_DATA} ) { + my $data = $serializer->thaw( $raw_data ); + unless (defined $data) { #die $raw_data . "\n"; - return $self->set_error( "load(): couldn't thaw() data using $serializer:" . - $serializer->errstr ); + return $self->set_error( + "load(): couldn't thaw() using $serializer:" + . $serializer->errstr ); + } + unless (defined( $data ) + && ref( $data ) + && ref( $data ) eq 'HASH' + && defined( $data->{_SESSION_ID} ) ) + { + return $self->set_error( + "Invalid data structure returned from thaw()" + ); + } + $self->{_DATA} = $data; + + # Check if previous session ip matches current ip + if ($CGI::Session::IP_MATCH) { + unless ($self->_ip_matches()) { + $self->_set_status( STATUS_DELETED ); + $self->flush(); + return $self; + } } - unless (defined($self->{_DATA}) && ref ($self->{_DATA}) && (ref $self->{_DATA} eq 'HASH') && - defined($self->{_DATA}->{_SESSION_ID}) ) { - return $self->set_error( "Invalid data structure returned from thaw()" ); - } - - # checking if previous session ip matches current ip - if($CGI::Session::IP_MATCH) { - unless($self->_ip_matches) { - $self->_set_status( STATUS_DELETED ); - $self->flush; - return $self; - } - } - - # checking for expiration ticker - if ( $self->{_DATA}->{_SESSION_ETIME} ) { - if ( ($self->{_DATA}->{_SESSION_ATIME} + $self->{_DATA}->{_SESSION_ETIME}) <= time() ) { - $self->_set_status( STATUS_EXPIRED ); # <-- so client can detect expired sessions - $self->_set_status( STATUS_DELETED ); # <-- session should be removed from database - $self->flush(); # <-- flush() will do the actual removal! + + # Check for expiration ticker + if ($data->{_SESSION_ETIME}) { + if ($data->{_SESSION_ATIME} + $data->{_SESSION_ETIME} <= time()) { + + # So client can detect expired sessions + $self->_set_status( STATUS_EXPIRED ); + + # Session should be removed from database + $self->_set_status( STATUS_DELETED ); + + # flush() will do the actual removal! + $self->flush(); + return $self; } } - # checking expiration tickers of individuals parameters, if any: + # Check expiration tickers of individuals parameters, if any: my @expired_params = (); - while (my ($param, $max_exp_interval) = each %{ $self->{_DATA}->{_SESSION_EXPIRE_LIST} } ) { - if ( ($self->{_DATA}->{_SESSION_ATIME} + $max_exp_interval) <= time() ) { - push @expired_params, $param; + my $expire_list = $data->{_SESSION_EXPIRE_LIST}; + if (defined $expire_list) { + while (my ($param, $max_exp_interval) = each %$expire_list ) { + if ($data->{_SESSION_ATIME} + $max_exp_interval <= time()) { + push @expired_params, $param; + } } + $self->clear(\@expired_params) if @expired_params; } - $self->clear(\@expired_params) if @expired_params; - # We update the atime by default, but if this (otherwise undocoumented) # parameter is explicitly set to false, we'll turn the behavior off - if ( ! defined $update_atime ) { - $self->{_DATA}->{_SESSION_ATIME} = time(); # <-- updating access time - $self->_set_status( STATUS_MODIFIED ); # <-- access time modified above + if (! defined $update_atime) { + $data->{_SESSION_ATIME} = time(); # Update access time + $self->_set_status( STATUS_MODIFIED ); # Access time modified above } - return $self; } +sub _load_pluggables { + my ($self) = @_; + + my %default_for + = ( + driver => "file", + serializer => "default", + id => "md5", + ); + my %subdir_for + = ( + driver => "Driver", + serializer => "Serialize", + id => "ID", + ); + my $dsn = $self->{_DSN}; + foreach my $plug (qw(driver serializer id)) { + my $mod_name = $dsn->{ $plug }; + if (not defined $mod_name) { + $mod_name = $default_for{ $plug }; + } + if ($mod_name =~ /^(\w+)$/) { + + # Looks good. Put it into the dsn hash + $dsn->{ $plug } = $mod_name = $1; + + # Put together the actual module name to load + my $prefix = join '::', (__PACKAGE__, $subdir_for{ $plug }, q{}); + $mod_name = $prefix . $mod_name; + + ## See if we can load load it + eval "require $mod_name"; + if ($@) { + my $msg = $@; + return $self->set_error("couldn't load $mod_name: " . $msg); + } + } + else { + # do something here about bad name for a pluggable + } + } + return; +} # set the input as a query object or session ID, depending on what it looks like. sub _set_query_or_sid {
Subject: Re: [rt.cpan.org #21808] notabug: some work on the constructor load()
Date: Tue, 10 Oct 2006 23:15:23 -0500
To: bug-CGI-Session@rt.cpan.org
From: Mark Stosberg <mark@summersault.com>
In general I like this patch and will accept it. However, it does not apply cleanly to the current version, which has several changes since the last release. Would you mind checking a copy through subversion, as documented in the POD, and making sure the changes work with the latest version? I did incorporate answers to your META questions manually.
Show quoted text
> # META: Is '0' not an acceptable _CLAIMED_ID? Should we test for > # definedness rather than truth?
Yes. Changes.
Show quoted text
> # META: "Too many arguments" could be a better msg
Agreed. Changed.
Show quoted text
> # META: Remove this line, or drop a line here on why it remains
Removed. I also liked your refactor to create _load_pluggables, but I didn't manually merge that in though. Mark -- http://mark.stosberg.com/
From: fenlisesi@gmail.com
Mark, I tried to use the Web interface to svn, but i got: Error running this command: svnlook youngest '/var/svn/CGI-Session' __aLi__ On Tue Oct 10 23:15:36 2006, mark@summersault.com wrote:
Show quoted text
> > In general I like this patch and will accept it. However, it does not > apply cleanly to the current version, which has several changes since > the last release. Would you mind checking a copy through subversion, as > documented in the POD, and making sure the changes work with the latest > version? > > I did incorporate answers to your META questions manually. >
> > # META: Is '0' not an acceptable _CLAIMED_ID? Should we test for > > # definedness rather than truth?
> > Yes. Changes. >
> > # META: "Too many arguments" could be a better msg
> > Agreed. Changed. >
> > # META: Remove this line, or drop a line here on why it remains
> > Removed. > > I also liked your refactor to create _load_pluggables, but I didn't > manually merge that in though. > > Mark >
CC: perl@cromedome.net
Subject: Re: [rt.cpan.org #21808] web gui for svn not working
Date: Sun, 22 Oct 2006 16:34:45 -0500
To: bug-CGI-Session@rt.cpan.org
From: Mark Stosberg <mark@summersault.com>
Ali ISIK via RT wrote:
Show quoted text
> Queue: CGI-Session > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=21808 > > > Mark, > > I tried to use the Web interface to svn, but i got: > > Error running this command: svnlook youngest '/var/svn/CGI-Session'
Ali, I'm sorry about that. I'm cc'ing the person to who manages that for us. Perhaps he can help. However, you could still be able to do an svn checkout of it: svn co svn://svn.cromedome.net/ ( I hope I got the address right! ) Thanks for your continued interest in this project. Mark -- http://mark.stosberg.com/
From: fenlisesi@gmail.com
The attached patch is against the current svn. Cheers. On Sun Oct 22 16:37:02 2006, mark@summersault.com wrote:
Show quoted text
> Ali ISIK via RT wrote:
> > Queue: CGI-Session > > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=21808 > > > > > Mark, > > > > I tried to use the Web interface to svn, but i got: > > > > Error running this command: svnlook youngest '/var/svn/CGI-Session'
> > Ali, > > I'm sorry about that. I'm cc'ing the person to who manages that for us. > Perhaps he can help. > > However, you could still be able to do an svn checkout of it: > > svn co svn://svn.cromedome.net/ > > ( I hope I got the address right! ) > > Thanks for your continued interest in this project. > > Mark >
--- Session-original.pm 2006-11-04 20:45:10.000000000 +0200 +++ Session-edited.pm 2006-11-05 00:50:08.000000000 +0200 @@ -672,23 +672,7 @@ sub load { } - # setting defaults, since above arguments might be 'undef' - $self->{_DSN}->{driver} ||= "file"; - $self->{_DSN}->{serializer} ||= "default"; - $self->{_DSN}->{id} ||= "md5"; - - # Checking and loading driver, serializer and id-generators - # Is this untainting reasonable here? - for ( - "CGI::Session::Driver::" . ($self->{_DSN}->{driver} =~ /(.*)/)[0], - "CGI::Session::Serialize::" . ($self->{_DSN}->{serializer} =~ /(.*)/)[0], - "CGI::Session::ID::" . ($self->{_DSN}->{id} =~ /(.*)/)[0], - ) { - eval "require $_"; - if ($@ ) { - return $self->set_error("couldn't load $_: " . $@); - } - } + $self->_load_pluggables(); if (not defined $self->{_CLAIMED_ID}) { my $query = $self->query(); @@ -773,6 +757,48 @@ sub _set_query_or_sid { } +sub _load_pluggables { + my ($self) = @_; + + my %DEFAULT_FOR = ( + driver => "file", + serializer => "default", + id => "md5", + ); + my %SUBDIR_FOR = ( + driver => "Driver", + serializer => "Serialize", + id => "ID", + ); + my $dsn = $self->{_DSN}; + foreach my $plug qw(driver serializer id) { + my $mod_name = $dsn->{ $plug }; + if (not defined $mod_name) { + $mod_name = $DEFAULT_FOR{ $plug }; + } + if ($mod_name =~ /^(\w+)$/) { + + # Looks good. Put it into the dsn hash + $dsn->{ $plug } = $mod_name = $1; + + # Put together the actual module name to load + my $prefix = join '::', (__PACKAGE__, $SUBDIR_FOR{ $plug }, q{}); + $mod_name = $prefix . $mod_name; + + ## See if we can load load it + eval "require $mod_name"; + if ($@) { + my $msg = $@; + return $self->set_error("couldn't load $mod_name: " . $msg); + } + } + else { + # do something here about bad name for a pluggable + } + } + return; +} + =pod =head2 id()
Subject: Re: [rt.cpan.org #21808] notabug: some work on the constructor load()
Date: Mon, 06 Nov 2006 13:13:02 -0500
To: bug-CGI-Session@rt.cpan.org
From: Mark Stosberg <mark@summersault.com>
Ali ISIK via RT wrote:
Show quoted text
> Queue: CGI-Session > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=21808 > > > The attached patch is against the current svn. Cheers.
Applied cleanly and passed tests (with load.t update). Committed. Thanks. Mark


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.