richter 00/11/09 12:25:24
Modified: . Changes.pod Embperl.pm epmain.c test.pl
Embperl Session.pm
test/cmp delrdsess.htm delsess.htm delwrsess.htm
getemptysess.htm
Log:
- Added validaten for session cookie. If Apache::Session 1.53+ is installed
it uses the validate method from Apache::Session::Generate::xxx. If a invalid
session id is found a new one is generated. Spotted by Angus Lees.
- If a not existing session id is received, Embperl generates now a new one.
- Enhancements of Cookie resending logic. To make sure cookies are send when
neccessary, but not more often. (Handles now write to session data, after
a delete in the same request correctly).
- Added more tests for Sessionhandling.
Revision Changes Path
1.139 +8 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.138
retrieving revision 1.139
diff -u -r1.138 -r1.139
--- Changes.pod 2000/11/08 07:49:06 1.138
+++ Changes.pod 2000/11/09 20:25:21 1.139
@@ -23,6 +23,14 @@
for doing the proof reading.
- removed dbgDisableCache to avoid problems with this "feature" that isn't
working
anymore for a long time.
+ - Added validaten for session cookie. If Apache::Session 1.53+ is installed
+ it uses the validate method from Apache::Session::Generate::xxx. If a invalid
+ session id is found a new one is generated. Spotted by Angus Lees.
+ - If a not existing session id is received, Embperl generates now a new one.
+ - Enhancements of Cookie resending logic. To make sure cookies are send when
+ neccessary, but not more often. (Handles now write to session data, after
+ a delete in the same request correctly).
+ - Added more tests for Sessionhandling.
=head1 1.3b6 (BETA) 18. Oct 2000
1.127 +23 -23 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -r1.126 -r1.127
--- Embperl.pm 2000/11/09 20:10:19 1.126
+++ Embperl.pm 2000/11/09 20:25:22 1.127
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.126 2000/11/09 20:10:19 richter Exp $
+# $Id: Embperl.pm,v 1.127 2000/11/09 20:25:22 richter Exp $
#
###################################################################################
@@ -405,7 +405,7 @@
eval "require $session_handler" ;
die $@ if ($@) ;
- tie %mdat, $session_handler, undef, \%sargs ;
+ tie %mdat, $session_handler, undef, \%sargs ;
tie %udat, $session_handler, undef, {%sargs, recreate_id => 1} ;
$SessionMgnt = 2 ;
warn "[$$]SES: Embperl Session management enabled ($ver)\n" if
($ENV{MOD_PERL}) ;
@@ -1686,16 +1686,16 @@
my $r = shift || HTML::Embperl::CurrReq () ;
my $disabledelete = shift ;
- my $udat = tied (%HTML::Embperl::udat) ;
- if (!$disabledelete) # Delete session data
- {
- $udat -> delete ;
- }
- else
- {
- $udat-> {data} = {} ; # for make test only
+ my $udat = tied (%HTML::Embperl::udat) ;
+ if (!$disabledelete) # Delete session data
+ {
+ $udat -> delete ;
}
- $udat->{status} = 0;
+ else
+ {
+ $udat-> {data} = {} ; # for make test only
+ }
+ $udat->{status} = 0;
}
@@ -1764,19 +1764,19 @@
if ($HTML::Embperl::SessionMgnt)
{
- my $udat = tied (%HTML::Embperl::udat) ;
- my $id = $udat -> getid ;
- my $initialid = $udat -> getinitialid ;
-
- my $name = $ENV{EMBPERL_COOKIE_NAME} || 'EMBPERL_UID' ;
- my $domain = "; domain=$ENV{EMBPERL_COOKIE_DOMAIN}" if (exists
($ENV{EMBPERL_COOKIE_DOMAIN})) ;
- my $path = "; path=$ENV{EMBPERL_COOKIE_PATH}" if (exists
($ENV{EMBPERL_COOKIE_PATH})) ;
- my $expires = "; expires=$ENV{EMBPERL_COOKIE_EXPIRES}" if (exists
($ENV{EMBPERL_COOKIE_EXPIRES})) ;
- $expires = "; expires=Thu, 1-Jan-1970 00:00:01 GMT" if ($id && !$initialid)
;
-
- if ($id || $initialid)
+ my $udat = tied (%HTML::Embperl::udat) ;
+ my $id = $udat -> getid ;
+ my $initialid = $udat -> getinitialid ;
+
+ my $name = $ENV{EMBPERL_COOKIE_NAME} || 'EMBPERL_UID' ;
+ my $domain = "; domain=$ENV{EMBPERL_COOKIE_DOMAIN}" if (exists
($ENV{EMBPERL_COOKIE_DOMAIN})) ;
+ my $path = "; path=$ENV{EMBPERL_COOKIE_PATH}" if (exists
($ENV{EMBPERL_COOKIE_PATH})) ;
+ my $expires = "; expires=$ENV{EMBPERL_COOKIE_EXPIRES}" if (exists
($ENV{EMBPERL_COOKIE_EXPIRES})) ;
+ $expires = "; expires=Thu, 1-Jan-1970 00:00:01 GMT" if ($id && !$initialid)
;
+
+ if ($id || $initialid)
{
- Apache -> request -> header_out ("Set-Cookie" =>
"$name=$id$domain$path$expires") ;
+ Apache -> request -> header_out ("Set-Cookie" =>
"$name=$id$domain$path$expires") ;
}
}
}
1.85 +37 -37 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- epmain.c 2000/11/09 13:58:37 1.84
+++ epmain.c 2000/11/09 20:25:22 1.85
@@ -2556,48 +2556,48 @@
SV ** ppSVID ;
SV * pSVID = NULL ;
MAGIC * pMG ;
- char * pUID = NULL ;
+ char * pUID = NULL ;
char * pInitialUID = NULL ;
- STRLEN ulen = 0 ;
+ STRLEN ulen = 0 ;
STRLEN ilen = 0 ;
if (r -> nSessionMgnt)
{
- SV * pUserHashObj = NULL ;
- if ((pMG = mg_find((SV *)r -> pUserHash,'P')))
- {
- dSP; /* initialize stack pointer
*/
- int n ;
- pUserHashObj = pMG -> mg_obj ;
-
- PUSHMARK(sp); /* remember the stack pointer
*/
- XPUSHs(pUserHashObj) ; /* push pointer to obeject */
- PUTBACK;
- n = perl_call_method ("getinitialid", 0) ; /* call the function
*/
- SPAGAIN;
- if (n > 0)
- {
- pSVID = POPs;
- pInitialUID = SvPV (pSVID, ilen) ;
- }
- PUTBACK;
-
- PUSHMARK(sp); /* remember the stack pointer
*/
- XPUSHs(pUserHashObj) ; /* push pointer to obeject */
- PUTBACK;
- n = perl_call_method ("getid", 0) ; /* call the function
*/
- SPAGAIN;
- if (n > 0)
- {
- pSVID = POPs;
- pUID = SvPV (pSVID, ulen) ;
- }
- PUTBACK;
- }
-
- if (r -> bDebug & dbgSession)
- lprintf (r, "[%d]SES: Received Cookie ID: %s New Cookie ID:
%s\n", r -> nPid, pInitialUID, pUID) ;
-
+ SV * pUserHashObj = NULL ;
+ if ((pMG = mg_find((SV *)r -> pUserHash,'P')))
+ {
+ dSP; /* initialize stack pointer */
+ int n ;
+ pUserHashObj = pMG -> mg_obj ;
+
+ PUSHMARK(sp); /* remember the stack pointer */
+ XPUSHs(pUserHashObj) ; /* push pointer to obeject */
+ PUTBACK;
+ n = perl_call_method ("getinitialid", 0) ; /* call the function
*/
+ SPAGAIN;
+ if (n > 0)
+ {
+ pSVID = POPs;
+ pInitialUID = SvPV (pSVID, ilen) ;
+ }
+ PUTBACK;
+
+ PUSHMARK(sp); /* remember the stack pointer */
+ XPUSHs(pUserHashObj) ; /* push pointer to obeject */
+ PUTBACK;
+ n = perl_call_method ("getid", 0) ; /* call the function
*/
+ SPAGAIN;
+ if (n > 0)
+ {
+ pSVID = POPs;
+ pUID = SvPV (pSVID, ulen) ;
+ }
+ PUTBACK;
+ }
+
+ if (r -> bDebug & dbgSession)
+ lprintf (r, "[%d]SES: Received Cookie ID: %s New Cookie ID:
%s\n", r -> nPid, pInitialUID, pUID) ;
+
if (ilen > 0 && ulen == 0)
{ /* delete cookie */
pCookie = newSVpvf ("%s=; expires=Thu, 1-Jan-1970 00:00:01
GMT%s%s%s%s", r -> pConf -> sCookieName,
1.81 +61 -61 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -r1.80 -r1.81
--- test.pl 2000/11/09 20:10:19 1.80
+++ test.pl 2000/11/09 20:25:22 1.81
@@ -306,94 +306,94 @@
},
'mdatsess.htm' => {
'offline' => 0,
- 'query_info' => 'cnt=0',
+ 'query_info' => 'cnt=0',
'cookie' => 'expectno',
},
'setsess.htm' => {
'offline' => 0,
'query_info' => 'a=1',
- 'cookie' => 'expectnew',
+ 'cookie' => 'expectnew',
},
'mdatsess.htm' => {
'offline' => 0,
'query_info' => 'cnt=1',
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'getnosess.htm' => {
'offline' => 0,
'query_info' => 'nocookie=2',
- 'cookie' => 'expectnew,nocookie,nosave',
+ 'cookie' => 'expectnew,nocookie,nosave',
},
'mdatsess.htm' => {
'offline' => 0,
'query_info' => 'cnt=2',
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'getsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'mdatsess.htm' => {
'offline' => 0,
'query_info' => 'cnt=3',
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'execgetsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'registry/reggetsess.htm' => {
'modperl' => 1,
'cgi' => 0,
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'getsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
- 'delwrsess.htm' => {
- 'offline' => 0,
- 'cookie' => 'expectnew',
- },
- 'getbsess.htm' => {
- 'offline' => 0,
- 'cookie' => 'expectno',
- },
- 'delrdsess.htm' => {
- 'offline' => 0,
- 'cookie' => 'expectnew',
- },
- 'getemptysess.htm' => {
- 'offline' => 0,
- 'cookie' => 'expectno',
- },
- 'setsess.htm' => {
- 'offline' => 0,
- 'query_info' => 'a=1',
- 'cookie' => 'expectnew',
- },
+ 'delwrsess.htm' => {
+ 'offline' => 0,
+ 'cookie' => 'expectnew',
+ },
+ 'getbsess.htm' => {
+ 'offline' => 0,
+ 'cookie' => 'expectno',
+ },
+ 'delrdsess.htm' => {
+ 'offline' => 0,
+ 'cookie' => 'expectnew',
+ },
+ 'getemptysess.htm' => {
+ 'offline' => 0,
+ 'cookie' => 'expectno',
+ },
+ 'setsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'a=1',
+ 'cookie' => 'expectnew',
+ },
'delsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'getdelsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectno',
+ 'cookie' => 'expectno',
},
'clearsess.htm' => {
+ 'offline' => 0,
+ 'cookie' => 'expectno',
+ },
+ 'setbadsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectno',
+ 'query_info' => 'val=2',
+ 'cookie' => 'expectnew,cookie=/etc/passwd',
},
- 'setbadsess.htm' => {
- 'offline' => 0,
- 'query_info' => 'val=2',
- 'cookie' => 'expectnew,cookie=/etc/passwd',
- },
- 'setunknownsess.htm' => {
- 'offline' => 0,
- 'query_info' => 'val=3',
- 'cookie' => 'expectnew,cookie=1234567890abcdefABCDEF',
- },
+ 'setunknownsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'val=3',
+ 'cookie' => 'expectnew,cookie=1234567890abcdefABCDEF',
+ },
'EmbperlObject/epopage1.htm' => {
'offline' => 0,
'cgi' => 0,
@@ -769,7 +769,7 @@
eval 'require LWP::UserAgent' ;
- $cookieaction |= '' ;
+ $cookieaction |= '' ;
if ($@)
{
@@ -795,16 +795,16 @@
$url = new URI::URL("http://$host:$port/$loc/$file?$query");
$request = new HTTP::Request($content?'POST':'GET', $url);
- if ($cookieaction =~ /cookie=(.*?)$/)
- {
- $request -> header ('Cookie' => $1) ;
- $sendcookie = $1 ;
- }
- elsif ($cookie && !($cookieaction =~ /nocookie/))
- {
- $request -> header ('Cookie' => $cookie) ;
- $sendcookie = $cookie ;
- }
+ if ($cookieaction =~ /cookie=(.*?)$/)
+ {
+ $request -> header ('Cookie' => $1) ;
+ $sendcookie = $1 ;
+ }
+ elsif ($cookie && !($cookieaction =~ /nocookie/))
+ {
+ $request -> header ('Cookie' => $cookie) ;
+ $sendcookie = $cookie ;
+ }
$request -> content ($content) if ($content) ;
}
@@ -834,12 +834,12 @@
$cookie = $c if (($c =~ /EMBPERL_UID/) && !($cookieaction =~ /nosave/)) ;
$cookie = undef if (($c =~ /EMBPERL_UID=;/) && !($cookieaction =~ /nosave/)) ;
- $sendcookie ||= '' ;
- print "\nSend: $sendcookie, Got: " , ($c||''), "\n" ;
- print "\nExpected new cookie: Send: $sendcookie, Got: " , ($c||''), "\n" if
(($cookieaction =~ /expectnew/) && $sendcookie eq $c) ;
- print "\nExpected same cookie: Send: $sendcookie, Got: " , ($c||''), "\n" if
(($cookieaction =~ /expectsame/) && $sendcookie ne $c) ;
- print "\nExpected no cookie: Send: $sendcookie, Got: " , ($c||''), "\n" if
(($cookieaction =~ /expectno/) && $c) ;
-
+ $sendcookie ||= '' ;
+ print "\nSend: $sendcookie, Got: " , ($c||''), "\n" ;
+ print "\nExpected new cookie: Send: $sendcookie, Got: " , ($c||''), "\n" if
(($cookieaction =~ /expectnew/) && $sendcookie eq $c) ;
+ print "\nExpected same cookie: Send: $sendcookie, Got: " , ($c||''), "\n" if
(($cookieaction =~ /expectsame/) && $sendcookie ne $c) ;
+ print "\nExpected no cookie: Send: $sendcookie, Got: " , ($c||''), "\n" if
(($cookieaction =~ /expectno/) && $c) ;
+
#print $response -> headers -> as_string () ;
return $response -> message if (!$response->is_success) ;
1.8 +53 -53 embperl/Embperl/Session.pm
Index: Session.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Session.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Session.pm 2000/11/09 13:58:39 1.7
+++ Session.pm 2000/11/09 20:25:23 1.8
@@ -32,14 +32,14 @@
=item create_unknown
Setting this to one causes Apache::Session to create a new session
-with the given id (or a new id, depending on C<recreate_id>)
+with the given id (or a new id, depending on C<recreate_id>)
when the specified session id does not exists. Otherwise it will die.
-=item recreate_id
-
-Setting this to one causes Apache::Session to create a new session id
-when the specified session id does not exists.
-
+=item recreate_id
+
+Setting this to one causes Apache::Session to create a new session id
+when the specified session id does not exists.
+
=item object_store
Specify the class for the object store. (The Apache::Session:: prefix is
@@ -154,7 +154,7 @@
my $self =
{
args => $args,
- data => { _session_id => $session_id },
+ data => { _session_id => $session_id },
initial_session_id => $session_id,
lock => 0,
lock_manager => undef,
@@ -238,19 +238,19 @@
#If not, it is a fresh one.
my $session_id = $self->{data}->{_session_id} ;
+
+ $self->{initial_session_id} = $session_id ;
- $self->{initial_session_id} = $session_id ;
-
$self->populate;
if (defined $session_id && $session_id)
{
- #check the session ID for remote exploitation attempts
- #this will die() on suspicious session IDs.
-
- eval { &{$self->{validate}}($self); } ;
- if (!$@)
- { # session id is ok
+ #check the session ID for remote exploitation attempts
+ #this will die() on suspicious session IDs.
+
+ eval { &{$self->{validate}}($self); } ;
+ if (!$@)
+ { # session id is ok
if (exists $self -> {'args'}->{Transaction} && $self ->
{'args'}->{Transaction})
{
$self->acquire_write_lock;
@@ -270,14 +270,14 @@
$self->restore;
}
}
- }
+ }
+
+ $@ = '' ;
- $@ = '' ;
-
if (!($self->{status} & SYNCED))
{
$self->{status} |= NEW();
- if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'})
+ if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'})
{
if (exists ($self->{generate}))
{ # Apache::Session >= 1.50
@@ -291,8 +291,8 @@
$self->save;
}
- #warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};"
;
-
+ #warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};" ;
+
return $self;
}
@@ -379,7 +379,7 @@
{
my $self = shift;
- $self->{initial_session_id} = undef ;
+ $self->{initial_session_id} = undef ;
if (!$self -> {'status'})
{
$self->{data} = {} ;
@@ -407,7 +407,7 @@
$self->{'status'} = 0 ;
$self->{data}->{_session_id} = $self->{initial_session_id} = shift ;
-
+
}
sub getid {
@@ -415,13 +415,13 @@
return $self->{data}->{_session_id} || $self->{'ID'} ;
}
+
+sub getinitialid {
+ my $self = shift;
+
+ return $self->{initial_session_id} ;
+}
-sub getinitialid {
- my $self = shift;
-
- return $self->{initial_session_id} ;
-}
-
sub delete {
my $self = shift;
@@ -430,7 +430,7 @@
$self -> init if (!$self -> {'status'}) ;
$self->{status} |= DELETED;
- $self->save;
+ $self->save;
$self->{data} = {} ; # Throw away the data
}
@@ -450,22 +450,22 @@
return new {$self -> {'args'}{'lock_manager'}} $self;
}
+
+#
+# Default validate for Apache::Session < 1.53
+#
+
+sub validate {
+ #This routine checks to ensure that the session ID is in the form
+ #we expect. This must be called before we start diddling around
+ #in the database or the disk.
-#
-# Default validate for Apache::Session < 1.53
-#
-
-sub validate {
- #This routine checks to ensure that the session ID is in the form
- #we expect. This must be called before we start diddling around
- #in the database or the disk.
-
- my $session = shift;
-
- if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) {
- die;
- }
-}
+ my $session = shift;
+
+ if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) {
+ die;
+ }
+}
#
# For Apache::Session >= 1.50
@@ -483,16 +483,16 @@
$self->{object_store} = new $store $self if ($store) ;
$self->{lock_manager} = new $lock $self if ($lock);
- $self->{generate} = \&{$gen . '::generate'} if ($gen);
- $self->{validate} = \&{$gen . '::validate'} if ($gen && defined (&{$gen .
'::validate'}));
+ $self->{generate} = \&{$gen . '::generate'} if ($gen);
+ $self->{validate} = \&{$gen . '::validate'} if ($gen && defined (&{$gen .
'::validate'}));
$self->{serialize} = \&{$ser . '::serialize'} if ($ser);
$self->{unserialize} = \&{$ser . '::unserialize'} if ($ser) ;
-
- if (!defined ($self->{validate}))
- {
- $self->{validate} = \&validate ;
- }
-
+
+ if (!defined ($self->{validate}))
+ {
+ $self->{validate} = \&validate ;
+ }
+
return $self;
}
1.2 +1 -1 embperl/test/cmp/delrdsess.htm
Index: delrdsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/delrdsess.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- delrdsess.htm 2000/11/09 20:18:16 1.1
+++ delrdsess.htm 2000/11/09 20:25:24 1.2
@@ -25,4 +25,4 @@
</body>
</html>
-
+
1.4 +1 -1 embperl/test/cmp/delsess.htm
Index: delsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/delsess.htm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- delsess.htm 2000/11/09 08:03:15 1.3
+++ delsess.htm 2000/11/09 20:25:24 1.4
@@ -20,4 +20,4 @@
</body>
</html>
-
+
1.3 +1 -1 embperl/test/cmp/delwrsess.htm
Index: delwrsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/delwrsess.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- delwrsess.htm 2000/11/09 20:10:24 1.2
+++ delwrsess.htm 2000/11/09 20:25:24 1.3
@@ -34,4 +34,4 @@
</body>
</html>
-
+
1.2 +1 -1 embperl/test/cmp/getemptysess.htm
Index: getemptysess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/getemptysess.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- getemptysess.htm 2000/11/09 20:18:16 1.1
+++ getemptysess.htm 2000/11/09 20:25:24 1.2
@@ -19,4 +19,4 @@
<table></table>
</body>
</html>
-
+
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
