richter 01/07/18 00:27:51
Modified: . CVS.pod Changes.pod Embperl.pm Makefile.PL TODO
epdat.h epmain.c
Log:
New session handling using Apache::SessionX
Revision Changes Path
1.8 +8 -8 embperl/CVS.pod
Index: CVS.pod
===================================================================
RCS file: /home/cvs/embperl/CVS.pod,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- CVS.pod 2000/11/08 07:49:06 1.7
+++ CVS.pod 2001/07/18 07:27:50 1.8
@@ -3,8 +3,8 @@
=head2 INTRO
-The Embperl development tree lives on the same machine as
-perl.apache.org. This tree contains the latest Embperl bug fixes and
+The Embperl development tree lives on the machine
+cvs.apache.org. This tree contains the latest Embperl bug fixes and
developments that have not made it to CPAN yet. Welcome to the
bleeding edge.
@@ -44,7 +44,7 @@
*default tag=.
# comment out the above if you want the raw CVS files
- *default host=perl.apache.org
+ *default host=cvs.apache.org
*default prefix=/path/on/this/machine/to/install/
# an existing subdir under which embperl will appear ^^^
@@ -64,11 +64,11 @@
To checkout a fresh copy from anoncvs use
-cvs -d ":pserver:[EMAIL PROTECTED]:/home/cvspublic" login
+cvs -d ":pserver:[EMAIL PROTECTED]:/home/cvspublic" login
with the password "anoncvs".
-cvs -d ":pserver:[EMAIL PROTECTED]:/home/cvspublic" co embperl
+cvs -d ":pserver:[EMAIL PROTECTED]:/home/cvspublic" co embperl
=head2 web-access
@@ -80,16 +80,16 @@
A snapshot is rolled off the Embperl tree every 6 hours and placed
here:
-http://perl.apache.org/from-cvs/embperl/
+http:/cvs.apache.org/snapshots/embperl/
A snapshot of the Apache development tree is also rolled every 6 hours
and placed here:
-http://dev.apache.org/from-cvs/
+http:/cvs.apache.org/snapshots/apache-1.3/
and mod_perl can be found here
-http://perl.apache.org/from-cvs/modperl/
+http:/cvs.apache.org/snapshots/embperl/modperl/
=head2 MAILING LIST
1.177 +1 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.176
retrieving revision 1.177
diff -u -r1.176 -r1.177
--- Changes.pod 2001/07/09 05:58:25 1.176
+++ Changes.pod 2001/07/18 07:27:50 1.177
@@ -13,6 +13,7 @@
with POSTed data reported by Lukas Zapletal.
- Display correct Apache module name in Makefile.PL when
requesting path for Apache module. Patch from James Lee.
+ - New session handling using Apache::SessionX
=head1 1.3.3 (RELEASE) 6. Juni 2001
1.162 +52 -88 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.161
retrieving revision 1.162
diff -u -r1.161 -r1.162
--- Embperl.pm 2001/06/15 06:28:17 1.161
+++ Embperl.pm 2001/07/18 07:27:50 1.162
@@ -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.161 2001/06/15 06:28:17 richter Exp $
+# $Id: Embperl.pm,v 1.162 2001/07/18 07:27:50 richter Exp $
#
###################################################################################
@@ -238,7 +238,7 @@
optRedirectStdout optUndefToEmptyValue
optNoHiddenEmptyValue optAllowZeroFilesize
optKeepSrcInMemory optKeepSpaces
optOpenLogEarly optNoUncloseWarn
} ;
- @AliasHash = qw{fdat udat mdat idat http_headers_out fsplitdat} ;
+ @AliasHash = qw{fdat udat mdat sdat idat http_headers_out fsplitdat} ;
@AliasArray = qw{ffld} ;
} ;
@@ -367,12 +367,22 @@
use Text::ParseWords ;
$SessionMgnt = 0 ;
+
+{
+my %sargs = (
+ lazy => 1,
+ create_unknown => 1,
+ ) ;
+my $session_handler = $ENV{EMBPERL_SESSION_HANDLER_CLASS} || 'Apache::SessionX' ;
+my $ver ;
+
if (defined ($ENV{EMBPERL_SESSION_CLASSES}))
{ # Apache::Session 1.xx
my ($os, $lm, $ser, $gen) = split /\s*,\s*|\s+/, $ENV{EMBPERL_SESSION_CLASSES} ;
if (!$os || !$lm)
{
warn "[$$]SES: EMBPERL_SESSION_CLASSES must be set properly (is
$ENV{EMBPERL_SESSION_CLASSES})" ;
+ $session_handler = 'no' ;
}
else
{
@@ -385,18 +395,11 @@
foreach (@arglist)
{
/^(.*?)\s*=\s*(.*?)$/ ;
- push @args, $1 ;
- push @args, $2 ;
+ $sargs{$1} = $2 ;
}
}
-
- my %sargs = (
- @args,
- lazy => 1,
- create_unknown => 1,
- ) ;
+
- my $ver ;
if ($Apache::Session::VERSION =~ /^1\.0\d$/)
{
$sargs{object_store} = $os ;
@@ -413,31 +416,31 @@
$ver = '>= 1.50' ;
$DefaultIDLength = 32 ;
}
+ }
+ }
+
+if (defined ($ENV{EMBPERL_SESSION_CONFIG}))
+ {
+ $sargs{config} = $ENV{EMBPERL_SESSION_CONFIG} ;
+ }
- my $session_handler = $ENV{EMBPERL_SESSION_HANDLER_CLASS} ||
'HTML::Embperl::Session' ;
- eval "require $session_handler" ;
- die $@ if ($@) ;
-
- 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}) ;
- }
- }
-elsif (exists $INC{'Apache/Session.pm'})
- {
- if ($Apache::Session::VERSION =~ /^0\.17/)
- {
- # Apache::Session = 0.17
- ##$SessionMgnt = 1 ;
- ##tie %udat, 'Apache::Session', $ENV{EMBPERL_SESSION_CLASS} || 'Win32',
- ## undef, {not_lazy=>0, autocommit=>0,
lifetime=>&Apache::Session::LIFETIME} ;
- ##tie %mdat, 'Apache::Session', $ENV{EMBPERL_SESSION_CLASS} || 'Win32',
- ## undef, {not_lazy=>0, autocommit=>0,
lifetime=>&Apache::Session::LIFETIME} ;
- warn "[$$]SES: Apache::Session 0.17 not supported by Embperl Session
management anymore\n" ;
- $SessionMgnt = 0 ;
+if ($session_handler ne 'no')
+ {
+ eval "require $session_handler" ;
+ if ($@)
+ {
+ warn $@ ;
+ }
+ else
+ {
+ tie %mdat, $session_handler, undef, {%sargs, Transaction => 1} ;
+ tie %udat, $session_handler, undef, {%sargs, recreate_id => 1} ;
+ tie %sdat, $session_handler, undef, {%sargs, recreate_id => 1, newid => 1} ;
+ $SessionMgnt = 2 ;
+ warn "[$$]SES: Embperl Session management enabled ($ver)\n" if
($ENV{MOD_PERL}) ;
}
}
+}
#######################################################################################
@@ -1666,6 +1669,7 @@
{
my $udat = tied(%HTML::Embperl::udat) ;
my $mdat = tied(%HTML::Embperl::mdat) ;
+ my $sdat = tied(%HTML::Embperl::sdat) ;
my $sessid ;
my $cookie_name = $r?$r -> CookieName:$ENV{EMBPERL_COOKIE_NAME} ||
'EMBPERL_UID' ;
my $cookie_val = $ENV{HTTP_COOKIE} ||
($req_rec?$req_rec->header_in('Cookie'):undef) ;
@@ -1673,35 +1677,26 @@
if (defined ($cookie_val) && ($cookie_val =~ /$cookie_name=(.*?)(\;|\s|$)/))
{
$sessid = $1 ;
- print HTML::Embperl::LOG "[$$]SES: Received session cookie $1\n" if
($HTML::Embperl::dbgSession) ;
+ print HTML::Embperl::LOG "[$$]SES: Received user session cookie $1\n" if
($HTML::Embperl::dbgSession) ;
}
- if ($HTML::Embperl::SessionMgnt == 1)
- {
- if (!$udat -> {ID})
- {
- $udat -> {ID} = $sessid ;
- $udat -> {DIRTY} = 0 ;
- }
+ $udat -> setid ($sessid) if (!$udat -> getid) ;
+ $mdat -> setidfrom ($Inputfile) if ($Inputfile && !$mdat -> getid) ;
- if ($Inputfile && !$mdat -> {ID})
- {
- $mdat -> {ID} = substr(MD5 -> hexhash ($Inputfile), 0,
&Apache::Session::ID_LENGTH );
- $mdat -> {DIRTY} = 0 ;
- }
- }
- else
+ if (defined ($cookie_val) && ($cookie_val =~ /${cookie_name}s=(.*?)(\;|\s|$)/))
{
- $udat -> setid ($sessid) if (!$udat -> getid) ;
- $mdat -> setid (substr(MD5 -> hexhash ($Inputfile), 0, $mdat -> {args} ->
{IDLength} || $HTML::Embperl::DefaultIDLength)) if ($Inputfile && !$mdat -> getid)
- }
+ $sessid = $1 ;
+ print HTML::Embperl::LOG "[$$]SES: Received status session cookie $1\n"
if ($HTML::Embperl::dbgSession) ;
+ }
+
+ $sdat -> setid ($sessid) if (!$sdat -> getid) ;
}
else
{
return undef ; # No session Management
}
- return wantarray?(\%HTML::Embperl::udat,
\%HTML::Embperl::mdat):\%HTML::Embperl::udat ;
+ return wantarray?(\%HTML::Embperl::udat, \%HTML::Embperl::mdat,
\%HTML::Embperl::sdat):\%HTML::Embperl::udat ;
}
#######################################################################################
@@ -1713,14 +1708,7 @@
{
my $udat = tied(%HTML::Embperl::udat) ;
- if ($HTML::Embperl::SessionMgnt == 1)
- {
- return wantarray?(\%HTML::Embperl::udat,
\%HTML::Embperl::mdat):\%HTML::Embperl::udat ;
- }
- else
- {
- return wantarray?(\%HTML::Embperl::udat,
\%HTML::Embperl::mdat):\%HTML::Embperl::udat ;
- }
+ return wantarray?(\%HTML::Embperl::udat, \%HTML::Embperl::mdat,
\%HTML::Embperl::sdat):\%HTML::Embperl::udat ;
}
else
{
@@ -1772,35 +1760,11 @@
{
my $udat = tied(%HTML::Embperl::udat) ;
my $mdat = tied(%HTML::Embperl::mdat) ;
-
- if ($HTML::Embperl::SessionMgnt & 1)
- {
- if ($udat->{'DIRTY'})
- {
- print HTML::Embperl::LOG "[$$]SES: Store session data of
\%HTML::Embperl::udat id=$udat->{ID}\n" if ($HTML::Embperl::dbgSession) ;
- $udat->{'DATA'}->store ;
- }
- else
- {
- print HTML::Embperl::LOG "[$$]SES: session data not dirty, do not
store \%HTML::Embperl::udat\n" if ($HTML::Embperl::dbgSession) ;
- }
+ my $sdat = tied(%HTML::Embperl::sdat) ;
- $udat->{'DATA'} = undef ;
- $udat -> {ID} = undef ;
- if ($mdat->{'DIRTY'})
- {
- print HTML::Embperl::LOG "[$$]SES: Store session data of
\%HTML::Embperl::mdat id=$mdat->{ID}\n" if ($HTML::Embperl::dbgSession) ;
- $mdat->{'DATA'}->store ;
- }
-
- $mdat->{'DATA'} = undef ;
- $mdat -> {ID} = undef ;
- }
- else
- {
- $udat -> cleanup ;
- $mdat -> cleanup ;
- }
+ $udat -> cleanup ;
+ $mdat -> cleanup ;
+ $sdat -> cleanup ;
}
}
1.51 +4 -0 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- Makefile.PL 2001/07/09 05:58:25 1.50
+++ Makefile.PL 2001/07/18 07:27:50 1.51
@@ -853,6 +853,7 @@
}
}
+ $SessXVer = CheckModule ("Apache::SessionX", "-> Disable tests for persistent
data storage") || '' if ($SessVer) ;
$SessVer ||= 0 ;
if (($FSVer = CheckModule ("File::Spec", "-> Required for EmbperlObject, make
test will fail whithout File::Spec")) < 0.8)
@@ -882,6 +883,7 @@
print FH "\$EPSTARTUP='" . cnvpath($EPSTARTUP) . "';\n" ;
print FH "\$EPAPACHEVERSION='$EPAPACHEVERSION[0]';\n" ;
print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
+ print FH "\$EPSESSIONXVERSION='$SessXVer';\n" ;
print FH "\$EP2='$EP2';\n" ;
print FH "\$EPMODPERLVERSION='$MPVer';\n" ;
if ($win32)
@@ -910,6 +912,7 @@
$SessVer = 0 ;
}
+ $SessXVer = CheckModule ("Apache::SessionX", "-> Disable tests for persistent
data storage") || '' if ($SessVer) ;
$SessVer ||= 0 ;
### write out test configuration file ###
@@ -921,6 +924,7 @@
print FH "\$EPHTTPD='' ;\n" ;
print FH "\$EPWIN32='$win32' ;\n" ;
print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
+ print FH "\$EPSESSIONXVERSION='$SessXVer';\n" ;
print FH "\$EPSSLDISABLE='$EPSSLDISABLE' ;\n" ;
print FH "\$EP2='$EP2';\n" ;
close FH ;
1.108 +2 -0 embperl/TODO
Index: TODO
===================================================================
RCS file: /home/cvs/embperl/TODO,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -r1.107 -r1.108
--- TODO 2001/03/27 04:26:42 1.107
+++ TODO 2001/07/18 07:27:50 1.108
@@ -68,6 +68,8 @@
- patch for multiple headers [Maxwell Krohn 15.3.01]
+- Save/restore globals before Execute [Gavin Carr 10.7.01]
+
Test
----
- test FORBIDDEN
1.32 +3 -2 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- epdat.h 2001/05/29 06:28:10 1.31
+++ epdat.h 2001/07/18 07:27:50 1.32
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdat.h,v 1.31 2001/05/29 06:28:10 richter Exp $
+# $Id: epdat.h,v 1.32 2001/07/18 07:27:50 richter Exp $
#
###################################################################################*/
@@ -518,7 +518,8 @@
HV * pFormSplitHash ; /* Formular data split up at \t */
HV * pInputHash ; /* Data of input fields */
AV * pFormArray ; /* Fieldnames */
- HV * pUserHash ; /* User data */
+ HV * pUserHash ; /* Session User data */
+ HV * pStatusHash ;/* Session Status data */
HV * pModHash ; /* Module data */
HV * pHeaderHash ;/* http headers */
#ifdef EP2
1.108 +104 -60 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -r1.107 -r1.108
--- epmain.c 2001/07/09 05:58:25 1.107
+++ epmain.c 2001/07/18 07:27:50 1.108
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epmain.c,v 1.107 2001/07/09 05:58:25 richter Exp $
+# $Id: epmain.c,v 1.108 2001/07/18 07:27:50 richter Exp $
#
###################################################################################*/
@@ -29,6 +29,7 @@
static char sEnvHashName [] = "ENV" ;
static char sFormHashName [] = "HTML::Embperl::fdat" ;
static char sUserHashName [] = "HTML::Embperl::udat" ;
+static char sStatusHashName [] = "HTML::Embperl::sdat" ;
static char sModHashName [] = "HTML::Embperl::mdat" ;
static char sFormSplitHashName [] = "HTML::Embperl::fsplitdat" ;
static char sFormArrayName [] = "HTML::Embperl::ffld" ;
@@ -1452,6 +1453,12 @@
return 1 ;
}
+ if ((r -> pStatusHash = perl_get_hv (sStatusHashName, TRUE)) == NULL)
+ {
+ LogError (r, rcHashError) ;
+ return 1 ;
+ }
+
if ((r -> pModHash = perl_get_hv (sModHashName, TRUE)) == NULL)
{
LogError (r, rcHashError) ;
@@ -2571,6 +2578,86 @@
/* ---------------------------------------------------------------------------- */
/* */
+/* Create Session cookie */
+/* */
+/* ---------------------------------------------------------------------------- */
+
+
+static SV * CreateSessionCookie (/*i/o*/ register req * r,
+ /*in*/ HV * pSessionHash,
+ /*in*/ char type)
+
+ {
+ SV ** ppSVID ;
+ SV * pSVID = NULL ;
+ MAGIC * pMG ;
+ char * pUID = NULL ;
+ char * pInitialUID = NULL ;
+ STRLEN ulen = 0 ;
+ STRLEN ilen = 0 ;
+ IV bModified ;
+ SV * pCookie = NULL ;
+ STRLEN ldummy ;
+
+ if (r -> nSessionMgnt)
+ {
+ SV * pUserHashObj = NULL ;
+ if ((pMG = mg_find((SV *)pSessionHash,'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 ("getids", G_ARRAY) ; /* call the function
*/
+ SPAGAIN;
+ if (n > 2)
+ {
+ int savewarn = dowarn ;
+ dowarn = 0 ; /* no warnings here */
+ bModified = POPi ;
+ pSVID = POPs;
+ pUID = SvPV (pSVID, ulen) ;
+ pSVID = POPs;
+ pInitialUID = SvPV (pSVID, ilen) ;
+ dowarn = savewarn ;
+ }
+ PUTBACK;
+ }
+
+ if (r -> bDebug & dbgSession)
+ lprintf (r, "[%d]SES: Received Cookie ID: %s New Cookie ID: %s %s data
is%s modified\n", r -> nPid, pInitialUID, pUID, type == 's'?"Status":"User",
bModified?"":" NOT") ;
+
+ if (ilen > 0 && (ulen == 0 || (!bModified && strcmp ("!DELETE", pInitialUID)
== 0)))
+ { /* delete cookie */
+ pCookie = newSVpvf ("%s%s=; expires=Thu, 1-Jan-1970 00:00:01 GMT%s%s%s%s",
r -> pConf -> sCookieName, type == 's'?"s":"",
+ r -> pConf -> sCookieDomain[0]?"; domain=":"" , r -> pConf ->
sCookieDomain,
+ r -> pConf -> sCookiePath[0]?"; path=":"" , r -> pConf ->
sCookiePath) ;
+
+ if (r -> bDebug & dbgSession)
+ lprintf (r, "[%d]SES: Delete Cookie -> %s\n", r -> nPid,
SvPV(pCookie, ldummy)) ;
+ }
+ else if (ulen > 0 &&
+ ((bModified && (ilen == 0 || strcmp (pInitialUID, pUID) !=0)) ||
+ (r -> nSessionMgnt & 4)))
+ {
+ pCookie = newSVpvf ("%s%s=%s%s%s%s%s%s%s", r -> pConf -> sCookieName,
type == 's'?"s":"", pUID,
+ r -> pConf -> sCookieDomain[0]?"; domain=":"" , r -> pConf ->
sCookieDomain,
+ r -> pConf -> sCookiePath[0]?"; path=":"" , r -> pConf ->
sCookiePath,
+ r -> pConf -> sCookieExpires[0]?"; expires=":"", r -> pConf ->
sCookieExpires) ;
+ if (r -> bDebug & dbgSession)
+ lprintf (r, "[%d]SES: Send Cookie -> %s\n", r -> nPid, SvPV(pCookie,
ldummy)) ;
+
+ }
+ }
+ return pCookie ;
+ }
+
+
+/* ---------------------------------------------------------------------------- */
+/* */
/* End the output stream */
/* */
/* ---------------------------------------------------------------------------- */
@@ -2585,6 +2672,7 @@
SV * pOut = NULL ;
int bOutToMem = SvROK (pOutData) ;
SV * pCookie = NULL ;
+ SV * pCookie2 = NULL ;
int bError = 0 ;
STRLEN ldummy ;
@@ -2640,66 +2728,9 @@
{ /* --- send http headers if not alreay done --- */
if (!r -> bAppendToMainReq)
{
- SV ** ppSVID ;
- SV * pSVID = NULL ;
- MAGIC * pMG ;
- char * pUID = NULL ;
- char * pInitialUID = NULL ;
- STRLEN ulen = 0 ;
- STRLEN ilen = 0 ;
- IV bModified ;
-
- 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 ("getids", G_ARRAY) ; /* call the function
*/
- SPAGAIN;
- if (n > 2)
- {
- bModified = POPi ;
- pSVID = POPs;
- pUID = SvPV (pSVID, ulen) ;
- pSVID = POPs;
- pInitialUID = SvPV (pSVID, ilen) ;
- }
- PUTBACK;
- }
+ pCookie = CreateSessionCookie (r, r -> pUserHash, 'u') ;
+ pCookie2 = CreateSessionCookie (r, r -> pStatusHash, 's') ;
- if (r -> bDebug & dbgSession)
- 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 || (!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,
- r -> pConf -> sCookiePath[0]?"; path=":"" , r ->
pConf -> sCookiePath) ;
-
- if (r -> bDebug & dbgSession)
- lprintf (r, "[%d]SES: Delete Cookie -> %s\n", r -> nPid,
SvPV(pCookie, ldummy)) ;
- }
- 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,
- r -> pConf -> sCookiePath[0]?"; path=":"" , r ->
pConf -> sCookiePath,
- r -> pConf -> sCookieExpires[0]?"; expires=":"", r ->
pConf -> sCookieExpires) ;
- if (r -> bDebug & dbgSession)
- lprintf (r, "[%d]SES: Send Cookie -> %s\n", r -> nPid,
SvPV(pCookie, ldummy)) ;
-
- }
- }
-
#ifdef APACHE
if (r -> pApacheReq)
{
@@ -2785,6 +2816,11 @@
table_add(r -> pApacheReq->headers_out, sSetCookie, pstrdup(r ->
pApacheReq->pool, SvPV(pCookie, ldummy))) ;
SvREFCNT_dec (pCookie) ;
}
+ if (pCookie2)
+ {
+ table_add(r -> pApacheReq->headers_out, sSetCookie, pstrdup(r ->
pApacheReq->pool, SvPV(pCookie2, ldummy))) ;
+ SvREFCNT_dec (pCookie2) ;
+ }
#ifdef EP2
if (r -> bEP1Compat) /* Embperl 2 currently cannot calc Content
Length */
#endif
@@ -2881,6 +2917,14 @@
oputs (r, SvPV(pCookie, na)) ;
oputs (r, "\n") ;
SvREFCNT_dec (pCookie) ;
+ }
+ if (pCookie2)
+ {
+ oputs (r, sSetCookie) ;
+ oputs (r, ": ") ;
+ oputs (r, SvPV(pCookie2, na)) ;
+ oputs (r, "\n") ;
+ SvREFCNT_dec (pCookie2) ;
}
oputs (r, "\n") ;
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
