richter 00/11/09 05:58:39
Modified: . epmain.c test.pl
Embperl Session.pm
Log:
Sessionmanagement
Revision Changes Path
1.84 +3 -0 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- epmain.c 2000/11/09 08:03:14 1.83
+++ epmain.c 2000/11/09 13:58:37 1.84
@@ -2595,6 +2595,9 @@
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.79 +34 -12 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -r1.78 -r1.79
--- test.pl 2000/11/09 08:03:15 1.78
+++ test.pl 2000/11/09 13:58:37 1.79
@@ -306,63 +306,80 @@
},
'mdatsess.htm' => {
'offline' => 0,
- 'query_info' => 'cnt=0',
+ 'query_info' => 'cnt=0',
+ 'cookie' => 'expectno',
},
'setsess.htm' => {
'offline' => 0,
'query_info' => 'a=1',
+ 'cookie' => 'expectnew',
},
'mdatsess.htm' => {
'offline' => 0,
'query_info' => 'cnt=1',
+ 'cookie' => 'expectno',
},
'getnosess.htm' => {
'offline' => 0,
'query_info' => 'nocookie=2',
+ 'cookie' => 'expectnew,nocookie',
},
'mdatsess.htm' => {
'offline' => 0,
'query_info' => 'cnt=2',
+ 'cookie' => 'expectno',
},
'getsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectno',
},
'mdatsess.htm' => {
'offline' => 0,
'query_info' => 'cnt=3',
+ 'cookie' => 'expectno',
},
'execgetsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectno',
},
'registry/reggetsess.htm' => {
'modperl' => 1,
'cgi' => 0,
+ 'cookie' => 'expectno',
},
'getsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectno',
},
'delwrsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectnew',
},
'getsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectno',
},
'delsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectno',
},
'getdelsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectno',
},
'clearsess.htm' => {
'offline' => 0,
+ 'cookie' => 'expectno',
},
'setbadsess.htm' => {
'offline' => 0,
- 'query_info' => 'val=2&cookie=/etc/passwd',
+ 'query_info' => 'val=2',
+ 'cookie' => 'expectnew,cookie=/etc/passwd',
},
'setunknownsess.htm' => {
'offline' => 0,
- 'query_info' => 'val=3&cookie=1234567890abcdefABCDEF',
+ 'query_info' => 'val=3',
+ 'cookie' => 'expectnew,cookie=1234567890abcdefABCDEF',
},
'EmbperlObject/epopage1.htm' => {
'offline' => 0,
@@ -735,10 +752,11 @@
sub REQ
{
- my ($loc, $file, $query, $ofile, $content, $upload) = @_ ;
+ my ($loc, $file, $query, $ofile, $content, $upload, $cookieaction) = @_ ;
eval 'require LWP::UserAgent' ;
+ $cookieaction |= '' ;
if ($@)
{
@@ -757,21 +775,22 @@
my $ua = new LWP::UserAgent; # create a useragent to test
my($request,$response,$url);
- my $cookiesend ;
+ my $sendcookie = '' ;
if (!$upload)
{
$url = new URI::URL("http://$host:$port/$loc/$file?$query");
$request = new HTTP::Request($content?'POST':'GET', $url);
- if ($query =~ /cookie=(.*?)$/)
+ if ($cookieaction =~ /cookie=(.*?)$/)
{
$request -> header ('Cookie' => $1) ;
- $cookiesend = $1 ;
+ $sendcookie = $1 ;
}
- else
+ elsif ($cookie && !($cookieaction =~ /nocookie/))
{
- $request -> header ('Cookie' => $cookie) if ($cookie && !($query =~
/nocookie/)) ;
+ $request -> header ('Cookie' => $cookie) ;
+ $sendcookie = $cookie ;
}
$request -> content ($content) if ($content) ;
@@ -801,9 +820,12 @@
my $c = $response -> header ('Set-Cookie') || '' ;
$cookie = $c if (!$cookie && ($c =~ /EMBPERL_UID/)) ;
$cookie = undef if (($c =~ /EMBPERL_UID=;/)) ;
- #print "Got Cookie $cookie\n" ;
- print "Expected new cookie: Send $sendcookie, Got: $cookie\n" if ($sendcookie
&& $sendcookie eq $cookie) ;
+ $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 () ;
@@ -1585,7 +1607,7 @@
}
else
{
- $m = REQ ("$loc$locver", $file, $test -> {query_info}, $outfile,
$content, $upload) ;
+ $m = REQ ("$loc$locver", $file, $test -> {query_info}, $outfile,
$content, $upload, $test -> {cookie}) ;
}
$t_req += HTML::Embperl::Clock () - $t1 ;
1.7 +7 -1 embperl/Embperl/Session.pm
Index: Session.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Session.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- Session.pm 2000/11/09 08:03:15 1.6
+++ Session.pm 2000/11/09 13:58:39 1.7
@@ -239,6 +239,8 @@
my $session_id = $self->{data}->{_session_id} ;
+ $self->{initial_session_id} = $session_id ;
+
$self->populate;
if (defined $session_id && $session_id)
@@ -289,6 +291,8 @@
$self->save;
}
+ #warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};"
;
+
return $self;
}
@@ -375,6 +379,7 @@
{
my $self = shift;
+ $self->{initial_session_id} = undef ;
if (!$self -> {'status'})
{
$self->{data} = {} ;
@@ -401,7 +406,8 @@
my $self = shift;
$self->{'status'} = 0 ;
- $self->{data}->{_session_id} = shift ;
+ $self->{data}->{_session_id} = $self->{initial_session_id} = shift ;
+
}
sub getid {
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
