You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@locus.apache.org on 2000/11/10 09:07:08 UTC
cvs commit: embperl/test/html getemptysess.htm
richter 00/11/10 00:07:07
Modified: . Embperl.pm epmain.c test.pl
Embperl Session.pm
Added: test/cmp setbadsess.htm setunknownsess.htm
Removed: test/cmp getemptysess.htm
test/html getemptysess.htm
Log:
Session tests works now, more session enhancements
Revision Changes Path
1.128 +2 -1 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.127
retrieving revision 1.128
diff -u -r1.127 -r1.128
--- Embperl.pm 2000/11/09 20:25:22 1.127
+++ Embperl.pm 2000/11/10 08:07:06 1.128
@@ -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.127 2000/11/09 20:25:22 richter Exp $
+# $Id: Embperl.pm,v 1.128 2000/11/10 08:07:06 richter Exp $
#
###################################################################################
@@ -1694,6 +1694,7 @@
else
{
$udat-> {data} = {} ; # for make test only
+ $udat->{initial_session_id} = "!DELETE" ;
}
$udat->{status} = 0;
}
1.86 +11 -17 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -r1.85 -r1.86
--- epmain.c 2000/11/09 20:25:22 1.85
+++ epmain.c 2000/11/10 08:07:06 1.86
@@ -2560,6 +2560,7 @@
char * pInitialUID = NULL ;
STRLEN ulen = 0 ;
STRLEN ilen = 0 ;
+ IV bModified ;
if (r -> nSessionMgnt)
{
@@ -2573,32 +2574,23 @@
PUSHMARK(sp); /* remember the stack pointer */
XPUSHs(pUserHashObj) ; /* push pointer to obeject */
PUTBACK;
- n = perl_call_method ("getinitialid", 0) ; /* call the function */
+ n = perl_call_method ("getids", G_ARRAY) ; /* call the function */
SPAGAIN;
- if (n > 0)
+ if (n > 2)
{
+ bModified = POPi ;
+ pSVID = POPs;
+ pUID = SvPV (pSVID, ulen) ;
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) ;
+ lprintf (r, "[%d]SES: Received Cookie ID: %s New Cookie ID: %s Session data is%s modified\n", r -> nPid, pInitialUID, pUID, bModified?"":" NOT") ;
- if (ilen > 0 && ulen == 0)
+ if (ilen > 0 && (ulen == 0 || (!bModified && strcmp ("!DELETE", pInitialUID) == 0)))
{ /* delete cookie */
pCookie = newSVpvf ("%s=; expires=Thu, 1-Jan-1970 00:00:01 GMT%s%s%s%s", r -> pConf -> sCookieName,
r -> pConf -> sCookieDomain[0]?"; domain=":"" , r -> pConf -> sCookieDomain,
@@ -2607,7 +2599,9 @@
if (r -> bDebug & dbgSession)
lprintf (r, "[%d]SES: Delete Cookie -> %s\n", r -> nPid, SvPV(pCookie, ldummy)) ;
}
- else if (ulen > 0 && ilen == 0 || (r -> nSessionMgnt & 4))
+ else if (ulen > 0 &&
+ ((bModified && (ilen == 0 || strcmp (pInitialUID, pUID) !=0)) ||
+ (r -> nSessionMgnt & 4)))
{
pCookie = newSVpvf ("%s=%s%s%s%s%s%s%s", r -> pConf -> sCookieName, pUID,
r -> pConf -> sCookieDomain[0]?"; domain=":"" , r -> pConf -> sCookieDomain,
1.82 +12 -10 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -r1.81 -r1.82
--- test.pl 2000/11/09 20:25:22 1.81
+++ test.pl 2000/11/10 08:07:06 1.82
@@ -361,9 +361,9 @@
},
'delrdsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectnew',
+ 'cookie' => 'expectexpire',
},
- 'getemptysess.htm' => {
+ 'getdelsess.htm' => {
'offline' => 0,
'cookie' => 'expectno',
},
@@ -374,7 +374,7 @@
},
'delsess.htm' => {
'offline' => 0,
- 'cookie' => 'expectno',
+ 'cookie' => 'expectexpire',
},
'getdelsess.htm' => {
'offline' => 0,
@@ -465,7 +465,7 @@
$opt_offline $opt_ep1 $opt_cgi $opt_modperl $opt_execute $opt_nokill $opt_loop
$opt_multchild $opt_memcheck $opt_exitonmem $opt_exitonsv $opt_config $opt_nostart $opt_uniquefn
$opt_quite $opt_ignoreerror $opt_tests $opt_blib $opt_help $opt_dbgbreak $opt_finderr
- $opt_ddd $opt_gdb $opt_ab $opt_start $opt_kill) ;
+ $opt_ddd $opt_gdb $opt_ab $opt_start $opt_kill $opt_showcookie) ;
{
local $^W = 0 ;
@@ -540,7 +540,7 @@
$ret = GetOptions ("offline|o", "ep1|1", "cgi|c", "modperl|httpd|h", "execute|e", "nokill|r", "loop|l:i",
"multchild|m", "memcheck|v", "exitonmem|g", "exitonsv", "config|f=s", "nostart|x", "uniquefn|u",
"quite|q", "ignoreerror|i", "tests|t", "blib|b", "help", "dbgbreak", "finderr",
- "ddd", "gdb", "ab:s", "start", "kill") ;
+ "ddd", "gdb", "ab:s", "start", "kill", "showcookie") ;
$opt_help = 1 if ($ret == 0) ;
@@ -607,7 +607,8 @@
print "--gdb start apache under gdb\n" ;
print "--ab <numreq> run test thru ApacheBench\n" ;
print "--start start apache only\n" ;
- print "--kill kill apache only\n" ;
+ print "--kill kill apache only\n" ;
+ print "--showcookie shows sent and received cookies\n" ;
print "\n\n" ;
print "path\t$EPPATH\n" ;
print "httpd\t" . ($EPHTTPD || '') . "\n" ;
@@ -835,10 +836,11 @@
$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) ;
+ print "\nSent: $sendcookie, Got: " , ($c||''), "\n" if ($opt_showcookie) ;
+ print "\nExpected new cookie: Sent: $sendcookie, Got: " , ($c||''), "\n" if (($cookieaction =~ /expectnew/) && ($sendcookie eq $c || !$c)) ;
+ print "\nExpected same cookie: Sent: $sendcookie, Got: " , ($c||''), "\n" if (($cookieaction =~ /expectsame/) && ($sendcookie ne $c || !$c)) ;
+ print "\nExpected no cookie: Sent: $sendcookie, Got: " , ($c||''), "\n" if (($cookieaction =~ /expectno/) && $c) ;
+ print "\nExpected expire cookie: Sent: $sendcookie, Got: " , ($c||''), "\n" if (($cookieaction =~ /expectexpire/) && !($c =~ /^EMBPERL_UID=; expires=/)) ;
#print $response -> headers -> as_string () ;
1.9 +5 -3 embperl/Embperl/Session.pm
Index: Session.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Session.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- Session.pm 2000/11/09 20:25:23 1.8
+++ Session.pm 2000/11/10 08:07:07 1.9
@@ -239,7 +239,7 @@
my $session_id = $self->{data}->{_session_id} ;
- $self->{initial_session_id} = $session_id ;
+ $self->{initial_session_id} ||= $session_id ;
$self->populate;
@@ -416,10 +416,10 @@
return $self->{data}->{_session_id} || $self->{'ID'} ;
}
-sub getinitialid {
+sub getids {
my $self = shift;
- return $self->{initial_session_id} ;
+ return ($self->{initial_session_id}, $self->{data}->{_session_id} || $self->{'ID'}, $self->{status} & MODIFIED) ;
}
sub delete {
@@ -427,6 +427,8 @@
return if ($self->{status} & NEW);
+ $self->{initial_session_id} = "!DELETE" ;
+
$self -> init if (!$self -> {'status'}) ;
$self->{status} |= DELETED;
1.1 embperl/test/cmp/setbadsess.htm
Index: setbadsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data (with bad cookie)</title>
</head>
<body>
^\s+[a-fA-F0-9]+$
</body>
</html>
1.1 embperl/test/cmp/setunknownsess.htm
Index: setunknownsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data (unknown cookie)</title>
</head>
<body>
^\s+[a-fA-F0-9]+$
</body>
</html>