richter 01/08/13 03:53:45
Modified: . Embperl.pm epcmd.c epmain.c test.pl
Embperl Mail.pm
test/cmp execgetsess.htm getsess.htm setsess.htm
test/conf httpd.conf.src
test/html getsess.htm setsess.htm
Added: test/cmp getnourlsess.htm geturlsess.htm seturlsess.htm
test/html/sidurl getnourlsess.htm geturlsess.htm
seturlsess.htm
Log:
-
Revision Changes Path
1.168 +3 -7 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.167
retrieving revision 1.168
diff -u -r1.167 -r1.168
--- Embperl.pm 2001/08/12 19:13:29 1.167
+++ Embperl.pm 2001/08/13 10:53:44 1.168
@@ -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.167 2001/08/12 19:13:29 richter Exp $
+# $Id: Embperl.pm,v 1.168 2001/08/13 10:53:44 richter Exp $
#
###################################################################################
@@ -681,7 +681,9 @@
$$req{'filesmatch'} = $ENV{EMBPERL_FILESMATCH} if (exists
($ENV{EMBPERL_FILESMATCH})) ;
$$req{'decline'} = $ENV{EMBPERL_DECLINE} if (exists
($ENV{EMBPERL_DECLINE})) ;
$$req{'debug'} = $ENV{EMBPERL_DEBUG} || 0 ;
+ $$req{'debug'} = oct($$req{'debug'}) if ($$req{'debug'} =~ /^0/) ;
$$req{'options'} = $ENV{EMBPERL_OPTIONS} || 0 ;
+ $$req{'options'} = oct($$req{'options'}) if ($$req{'options'} =~ /^0/) ;
$$req{'log'} = $ENV{EMBPERL_LOG} || $DefaultLog ;
$$req{'path'} = $ENV{EMBPERL_PATH} || '' ;
@@ -731,12 +733,6 @@
{ $req_rec = $$req{'req_rec'} }
elsif (exists $INC{'Apache.pm'})
{ $req_rec = Apache->request }
-
- if (exists $$req{'debug'})
- { $$req{'debug'} = oct($$req{'debug'}) if ($$req{'debug'} =~ /^0/) ; }
- if (exists $$req{'options'})
- { $$req{'options'} = oct($$req{'options'}) if ($$req{'options'} =~ /^0/) ; }
-
if (defined ($$req{'virtlog'}) && $$req{'virtlog'} eq $$req{'uri'})
{
1.45 +64 -10 embperl/epcmd.c
Index: epcmd.c
===================================================================
RCS file: /home/cvs/embperl/epcmd.c,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- epcmd.c 2001/08/10 14:06:42 1.44
+++ epcmd.c 2001/08/13 10:53:44 1.45
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcmd.c,v 1.44 2001/08/10 14:06:42 richter Exp $
+# $Id: epcmd.c,v 1.45 2001/08/13 10:53:44 richter Exp $
#
###################################################################################*/
@@ -82,8 +82,12 @@
/*in*/ const char * sArg) ;
static int HtmlIMG (/*i/o*/ register req * r,
/*in*/ const char * sArg) ;
+static int HtmlASRC (/*i/o*/ register req * r,
+ /*in*/ const char * sArg) ;
static int HtmlForm (/*i/o*/ register req * r,
/*in*/ const char * sArg) ;
+static int HtmlEndform (/*i/o*/ register req * r,
+ /*in*/ const char * sArg) ;
static int HtmlMeta (/*i/o*/ register req * r,
/*in*/ const char * sArg) ;
@@ -94,6 +98,7 @@
/* cmdname function push pop type scan save no
disable bHtml */
{ "/dir", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnDir ,
optDisableTableScan, 1 } ,
{ "/dl", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnDl ,
optDisableTableScan, 1 } ,
+ { "/form", HtmlEndform, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
{ "/menu", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnMenu ,
optDisableTableScan, 1 } ,
{ "/ol", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnOl ,
optDisableTableScan, 1 } ,
{ "/select", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnSelect ,
optDisableSelectScan, 1 } ,
@@ -108,20 +113,20 @@
{ "do", CmdDo, 1, 0, cmdDo, 0, 0, cnNop , 0
, 0 } ,
{ "else", CmdElse, 0, 0, cmdIf, 0, 0, cnNop , 0
, 0 } ,
{ "elsif", CmdElsif, 0, 0, cmdIf, 0, 0, cnNop , 0
, 0 } ,
- { "embed", HtmlIMG, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
+ { "embed", HtmlASRC, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
{ "endforeach", CmdEndforeach, 0, 1, cmdForeach, 0, 0, cnNop , 0
, 0 } ,
{ "endif", CmdEndif, 0, 1, (enum tCmdType)(cmdIf | cmdEndif), 0,
0, cnNop , 0, 0 } ,
{ "endsub", CmdEndsub, 0, 1, cmdSub, 0, 0, cnNop , 0
, 0 } ,
{ "endwhile", CmdEndwhile, 0, 1, cmdWhile, 0, 0, cnNop , 0
, 0 } ,
{ "foreach", CmdForeach, 1, 0, cmdForeach, 0, 1, cnNop , 0
, 0 } ,
{ "form", HtmlForm, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
- { "frame", HtmlIMG, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
+ { "frame", HtmlASRC, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
{ "hidden", CmdHidden, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 0 } ,
{ "if", CmdIf, 1, 0, (enum tCmdType)(cmdIf | cmdEndif), 0,
0, cnNop , 0, 0 } ,
- { "iframe", HtmlIMG, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
+ { "iframe", HtmlASRC, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
{ "img", HtmlIMG, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
{ "input", HtmlInput, 0, 0, cmdNorm, 1, 0, cnNop ,
optDisableInputScan, 1 } ,
- { "layer", HtmlIMG, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
+ { "layer", HtmlASRC, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
{ "menu", HtmlTable, 1, 0, cmdTable, 1, 0, cnMenu ,
optDisableTableScan, 1 } ,
{ "meta", HtmlMeta, 0, 0, cmdNorm, 1, 0, cnNop ,
optDisableMetaScan , 1 } ,
{ "ol", HtmlTable, 1, 0, cmdTable, 1, 0, cnOl ,
optDisableTableScan, 1 } ,
@@ -1064,7 +1069,8 @@
static int URLEscape (/*i/o*/ register req * r,
/*in*/ const char * sArg,
- /*in*/ const char * sAttrName)
+ /*in*/ const char * sAttrName,
+ /*in*/ int bAppendSessionID)
{
int rc ;
char * pArgBuf = NULL ;
@@ -1128,7 +1134,7 @@
oputs (r, pArgBuf) ;
- if (r -> sSessionID)
+ if (bAppendSessionID && r -> sSessionID)
{
if (strchr(pArgBuf, '?'))
{
@@ -1205,7 +1211,7 @@
{
EPENTRY (HtmlA) ;
- return URLEscape (r, sArg, "HREF") ;
+ return URLEscape (r, sArg, "HREF", 1) ;
}
/* ---------------------------------------------------------------------------- */
@@ -1220,10 +1226,25 @@
{
EPENTRY (HtmlIMG) ;
- return URLEscape (r, sArg, "SRC") ;
+ return URLEscape (r, sArg, "SRC", 0) ;
}
+/* ---------------------------------------------------------------------------- */
+/* */
+/* tag with SRC attribute... */
+/* */
+/* ---------------------------------------------------------------------------- */
+
+static int HtmlASRC (/*i/o*/ register req * r,
+ /*in*/ const char * sArg)
+ {
+ EPENTRY (HtmlASRC) ;
+
+ return URLEscape (r, sArg, "SRC", 1) ;
+ }
+
+
/* ---------------------------------------------------------------------------- */
/* */
/* Form tag ... */
@@ -1236,7 +1257,40 @@
{
EPENTRY (HtmlForm) ;
- return URLEscape (r, sArg, "ACTION") ;
+ return URLEscape (r, sArg, "ACTION", 0) ;
+ }
+
+/* ---------------------------------------------------------------------------- */
+/* */
+/* /Form tag ... */
+/* */
+/* ---------------------------------------------------------------------------- */
+
+
+static int HtmlEndform (/*i/o*/ register req * r,
+ /*in*/ const char * sArg)
+ {
+ char * sid = r -> sSessionID ;
+
+ EPENTRY (HtmlFormEnd) ;
+
+
+ if (sid)
+ {
+ char * val = strchr (sid, '=') ;
+ if (val)
+ {
+ oputs(r, "<input type=\"hidden\" name=\"") ;
+ owrite(r, sid, val - sid) ;
+ val++ ;
+ oputs(r, "\" value=\"") ;
+ oputs (r, val) ;
+ oputs(r, "\">") ;
+ }
+ }
+
+
+ return ok ;
}
1.112 +31 -22 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.111
retrieving revision 1.112
diff -u -r1.111 -r1.112
--- epmain.c 2001/08/12 12:19:32 1.111
+++ epmain.c 2001/08/13 10:53:44 1.112
@@ -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.111 2001/08/12 12:19:32 richter Exp $
+# $Id: epmain.c,v 1.112 2001/08/13 10:53:44 richter Exp $
#
###################################################################################*/
@@ -479,32 +479,41 @@
if (nKey > 0 && (nVal > 0 || (r -> bOptions & optAllFormData)))
{
- if (pVal > pKey)
- pVal[-1] = '\0' ;
+ char * sid = r -> pConf -> sCookieName ;
+ if (sid)
+ { /* remove session id */
+ if (strncmp (pKey, sid, nKey) != 0)
+ sid = NULL ;
+ }
+
+ if (sid == NULL)
+ { /* field is not the session id */
+ if (pVal > pKey)
+ pVal[-1] = '\0' ;
- if ((ppSV = hv_fetch (r -> pFormHash, pKey, nKey, 0)))
- { /* Field exists already -> append separator and field
value */
- sv_catpvn (*ppSV, &r -> pConf -> cMultFieldSep, 1) ;
- sv_catpvn (*ppSV, pVal, nVal) ;
- }
- else
- { /* New Field -> store it */
- pSVV = newSVpv (pVal, nVal) ;
- if (hv_store (r -> pFormHash, pKey, nKey, pSVV, 0) == NULL)
- {
- _free (r, pMem) ;
- return rcHashError ;
- }
+ if ((ppSV = hv_fetch (r -> pFormHash, pKey, nKey, 0)))
+ { /* Field exists already -> append separator and field
value */
+ sv_catpvn (*ppSV, &r -> pConf -> cMultFieldSep, 1) ;
+ sv_catpvn (*ppSV, pVal, nVal) ;
+ }
+ else
+ { /* New Field -> store it */
+ pSVV = newSVpv (pVal, nVal) ;
+ if (hv_store (r -> pFormHash, pKey, nKey, pSVV, 0) == NULL)
+ {
+ _free (r, pMem) ;
+ return rcHashError ;
+ }
- pSVK = newSVpv (pKey, nKey) ;
+ pSVK = newSVpv (pKey, nKey) ;
- av_push (r -> pFormArray, pSVK) ;
- }
+ av_push (r -> pFormArray, pSVK) ;
+ }
- if (r -> bDebug & dbgForm)
- lprintf (r, "[%d]FORM: %s=%s\n", r -> nPid, pKey, pVal) ;
-
+ if (r -> bDebug & dbgForm)
+ lprintf (r, "[%d]FORM: %s=%s\n", r -> nPid, pKey, pVal) ;
+ }
}
pKey = pVal = p ;
nKey = nVal = 0 ;
1.110 +66 -4 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -r1.109 -r1.110
--- test.pl 2001/06/03 18:15:45 1.109
+++ test.pl 2001/08/13 10:53:44 1.110
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.109 2001/06/03 18:15:45 richter Exp $
+# $Id: test.pl,v 1.110 2001/08/13 10:53:44 richter Exp $
#
###################################################################################
@@ -500,6 +500,42 @@
'query_info' => 'val=3',
'cookie' => 'expectnew,cookie=1234567890abcdefABCDEF',
},
+ 'uidurl/seturlsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'a=1',
+ 'cookie' => 'expectnew,url',
+ 'aliasdir' => 1,
+ },
+ 'uidurl/getnourlsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'nocookie=2',
+ 'cookie' => 'nocookie,nosave,url',
+ 'aliasdir' => 1,
+ },
+ 'uidurl/geturlsess.htm' => {
+ 'offline' => 0,
+ 'cookie' => 'expectsame,url',
+ 'query_info' => 'foo=1',
+ 'aliasdir' => 1,
+ },
+ 'suidurl/seturlsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'a=1',
+ 'cookie' => 'expectnew,url,nocookie',
+ 'aliasdir' => 1,
+ },
+ 'suidurl/getnourlsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'nocookie=2',
+ 'cookie' => 'nocookie,nosave,url',
+ 'aliasdir' => 1,
+ },
+ 'suidurl/geturlsess.htm' => {
+ 'offline' => 0,
+ 'cookie' => 'url',
+ 'query_info' => 'foo=1',
+ 'aliasdir' => 1,
+ },
'EmbperlObject/epopage1.htm' => {
'offline' => 0,
'repeat' => 2,
@@ -1008,13 +1044,27 @@
{
$url = new URI::URL("http://$host:$port/$loc/$file?$query";);
+ if ($cookie && ($cookieaction =~ /url/) && !($cookieaction =~ /nocookie/) )
+ {
+ if ($url =~ /\?/)
+ {
+ $url .= "&$cookie" ;
+ }
+ else
+ {
+ $url .= "?$cookie" ;
+ }
+ $sendcookie = $cookie ;
+ }
+
+
$request = new HTTP::Request($content?'POST':'GET', $url);
if ($cookieaction =~ /cookie=(.*?)$/)
{
$request -> header ('Cookie' => $1) ;
$sendcookie = $1 ;
}
- elsif ($cookie && !($cookieaction =~ /nocookie/))
+ elsif ($cookie && !($cookieaction =~ /nocookie/) && !($cookieaction =~
/url/))
{
$request -> header ('Cookie' => $cookie) ;
$sendcookie = $cookie ;
@@ -1044,7 +1094,16 @@
print FH $response -> content ;
close FH ;
- my $c = $response -> header ('Set-Cookie') || '' ;
+ my $c ;
+ if ($cookieaction =~ /url/)
+ {
+ $response -> content =~ /(EMBPERL_UID=.*?)\"/ ;
+ $c = $1 || '' ;
+ }
+ else
+ {
+ $c = $response -> header ('Set-Cookie') || '' ;
+ }
$cookie = $c if (($c =~ /EMBPERL_UID/) && !($cookieaction =~ /nosave/)) ;
$cookie = undef if (($c =~ /EMBPERL_UID=;/) && !($cookieaction =~ /nosave/)) ;
@@ -1892,6 +1951,9 @@
if (($loc ne '' && $err == 0 && $loopcnt == 0 && !$opt_nostart) || $opt_start
|| $opt_startinter)
{
+
+ system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if (!$EPWIN32 &&
$opt_start) ;
+
#### Configure httpd conf file
$EPDEBUG = $defaultdebug ;
@@ -2075,7 +2137,7 @@
$upload = "f1=abc1\r\n&f2=1234567890&f3=" . 'X' x 8192 ;
}
- if (!$EPWIN32 && $loc eq $embploc && !($file =~ /notfound\.htm/))
+ if (!$EPWIN32 && !$test -> {aliasdir} && $loc eq $embploc && !($file =~
/notfound\.htm/))
{
print "ERROR: Missing read permission for file $inpath/$file\n" if
(!-r $page) ;
local $> = $httpduid ;
1.32 +12 -10 embperl/Embperl/Mail.pm
Index: Mail.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Mail.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- Mail.pm 2001/02/13 05:39:40 1.31
+++ Mail.pm 2001/08/13 10:53:45 1.32
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Mail.pm,v 1.31 2001/02/13 05:39:40 richter Exp $
+# $Id: Mail.pm,v 1.32 2001/08/13 10:53:45 richter Exp $
#
###################################################################################
@@ -32,7 +32,7 @@
@ISA = qw(HTML::Embperl);
-$VERSION = '1.3.1';
+$VERSION = '1.3.4';
@@ -108,20 +108,22 @@
$smtp -> to (@$to, @$cc, @$bcc) ;
$smtp->data() or die "smtp data failed" ;
- $smtp->datasend("Reply-To: $req->{'reply-to'}\n") or die "smtp data failed"
if ($req->{'reply-to'}) ;
- $smtp->datasend("From: $from\n") if ($from) ;
- $smtp->datasend("To: " . join (', ', @$to) . "\n") or die "smtp datasend
failed" ;
- $smtp->datasend("Cc: " . join (', ', @$cc) . "\n") or die "smtp datasend
failed" if ($req -> {'cc'}) ;
- $smtp->datasend("Subject: $req->{subject}\n") or die "smtp datasend failed"
;
+ $smtp->datasend("Reply-To: $req->{'reply-to'}\r\n") or die "smtp data
failed" if ($req->{'reply-to'}) ;
+ $smtp->datasend("From: $from\r\n") if ($from) ;
+ $smtp->datasend("To: " . join (', ', @$to) . "�r\n") or die "smtp datasend
failed" ;
+ $smtp->datasend("Cc: " . join (', ', @$cc) . "\r\n") or die "smtp datasend
failed" if ($req -> {'cc'}) ;
+ $smtp->datasend("Subject: $req->{subject}\r\n") or die "smtp datasend
failed" ;
if (ref ($headers) eq 'ARRAY')
{
foreach (@$headers)
{
- $smtp->datasend("$_\n") or die "smtp datasend failed" ;
+ $smtp->datasend("$_\r\n") or die "smtp datasend failed" ;
}
}
- $smtp->datasend("\n") or die "smtp datasend failed" ;
- $smtp->datasend($data) or die "smtp datasend failed" ;
+ $smtp->datasend("\r\n") or die "smtp datasend failed" ;
+ # make sure we have correct \r\n line endings
+ $data =~ s/((?<!\r)\n)|(\r(?!\n))/\r\n/g ;
+ $smtp->datasend($data) or die "smtp datasend failed" ;
$smtp->quit or die "smtp quit failed" ;
} ;
1.4 +12 -0 embperl/test/cmp/execgetsess.htm
Index: execgetsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/execgetsess.htm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- execgetsess.htm 1999/10/05 06:02:05 1.3
+++ execgetsess.htm 2001/08/13 10:53:45 1.4
@@ -53,6 +53,12 @@
^- <td>.*?<\/td><td>HASH.*?<\/td>
^- <\/tr>
^- <\/table>
+ <a href="cont.htm">continue</a>
+ <a href="cont.htm?q=1">continue</a>
+ <a href="cont.htm?q=1&b=2">continue</a>
+ <form action="cont.htm">
+ </form>
+
</body>
</html>
@@ -119,6 +125,12 @@
^- <td>.*?<\/td><td>HASH.*?<\/td>
^- <\/tr>
^- <\/table>
+ <a href="cont.htm">continue</a>
+ <a href="cont.htm?q=1">continue</a>
+ <a href="cont.htm?q=1&b=2">continue</a>
+ <form action="cont.htm">
+ </form>
+
</body>
</html>
1.5 +6 -0 embperl/test/cmp/getsess.htm
Index: getsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/getsess.htm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- getsess.htm 2000/09/11 09:53:34 1.4
+++ getsess.htm 2001/08/13 10:53:45 1.5
@@ -45,6 +45,12 @@
^- <td>.*?<\/td><td>HASH.*?<\/td>
^- </tr>
^- </table>
+ <a href="cont.htm">continue</a>
+ <a href="cont.htm?q=1">continue</a>
+ <a href="cont.htm?q=1&b=2">continue</a>
+ <form action="cont.htm">
+ </form>
+
</body>
</html>
1.4 +6 -0 embperl/test/cmp/setsess.htm
Index: setsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/setsess.htm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- setsess.htm 1999/10/05 06:02:20 1.3
+++ setsess.htm 2001/08/13 10:53:45 1.4
@@ -29,6 +29,12 @@
^- <td>.*?<\/td><td>HASH.*?<\/td>
^- </tr>
^- </table>
+ <a href="cont.htm">continue</a>
+ <a href="cont.htm?q=1">continue</a>
+ <a href="cont.htm?q=1&b=2">continue</a>
+ <form action="cont.htm">
+ </form>
+
</body>
</html>
1.1 embperl/test/cmp/getnourlsess.htm
Index: getnourlsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
fdat:<br>
<table>
<tr>
<td>nocookie</td><td>2</td>
</tr>
</table>
udat:<br>
<table></table>
ok (num=1)<p>
sessions:
<table></table>
</body>
</html>
1.1 embperl/test/cmp/geturlsess.htm
Index: geturlsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
fdat:<br>
<table>
<tr>
<td>foo</td><td>1</td>
</tr>
</table>
udat:<br>
<table>
<tr>
<td>a</td><td>1</td>
</tr>
</table>
ok (num=1)<p>
$mdat{cnt} = -- <br>
$udat{cnt} = -- <br>
sessions:
<table></table>
^ <a href=\"cont\.htm\?EMBPERL_UID=[a-f0-9]*?:[a-f0-9]+\">continue</a>
^ <a href=\"cont.htm\?q=1&EMBPERL_UID=[a-f0-9]*?:[a-f0-9]+\">continue</a>
^ <a href=\"cont.htm\?q=1&b=2&EMBPERL_UID=[a-f0-9]*?:[a-f0-9]+\">continue</a>
<form action="cont.htm">
^ <input type=\"hidden\" name=\"EMBPERL_UID\"
value=\"[a-f0-9]*?:[a-f0-9]+\"></form>
</body>
</html>
1.1 embperl/test/cmp/seturlsess.htm
Index: seturlsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
fdat:<br>
<table>
<tr>
<td>a</td><td>1</td>
</tr>
</table>
udat:<br>
<table></table>
ok (num=1)<p>
sessions:
<table></table>
^ <a href=\"cont\.htm\?EMBPERL_UID=[a-f0-9]*?:[a-f0-9]+\">continue</a>
^ <a href=\"cont.htm\?q=1&EMBPERL_UID=[a-f0-9]*?:[a-f0-9]+\">continue</a>
^ <a href=\"cont.htm\?q=1&b=2&EMBPERL_UID=[a-f0-9]*?:[a-f0-9]+\">continue</a>
<form action="cont.htm">
^ <input type=\"hidden\" name=\"EMBPERL_UID\"
value=\"[a-f0-9]*?:[a-f0-9]+\"></form>
</body>
</html>
1.42 +19 -1 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- httpd.conf.src 2001/08/10 19:33:06 1.41
+++ httpd.conf.src 2001/08/13 10:53:45 1.42
@@ -118,6 +118,8 @@
AddType text/html .htm
AddType text/html .xhtm
+Alias /embperl/uidurl/ \"$EPPATH/test/html/sidurl/\"
+Alias /embperl/suidurl/ \"$EPPATH/test/html/sidurl/\"
Alias /embperl/sub/ \"$EPPATH/test/html/\"
Alias /embperl/ \"$EPPATH/test/html/\"
Alias /embperl2/ \"$EPPATH/test/html2/\"
@@ -429,13 +431,29 @@
if ($EPSESSIONVERSION)
{
print OFH <<EOD ;
+
+
<Location /embperl/sidurl>
SetHandler perl-script
PerlHandler HTML::Embperl
Options ExecCGI
-#PerlSetEnv EMBPERL_OPTIONS 0x7000000
PerlSetEnv EMBPERL_OPTIONS 0x6000000
</Location>
+
+<Location /embperl/uidurl>
+SetHandler perl-script
+PerlHandler HTML::Embperl
+Options ExecCGI
+PerlSetEnv EMBPERL_OPTIONS 0x5000000
+</Location>
+
+<Location /embperl/suidurl>
+SetHandler perl-script
+PerlHandler HTML::Embperl
+Options ExecCGI
+PerlSetEnv EMBPERL_OPTIONS 0x7000000
+</Location>
+
EOD
}
1.9 +6 -0 embperl/test/html/getsess.htm
Index: getsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/getsess.htm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- getsess.htm 2001/03/27 12:27:53 1.8
+++ getsess.htm 2001/08/13 10:53:45 1.9
@@ -68,5 +68,11 @@
</tr>
</table>
+ <a href="cont.htm">continue</a>
+ <a href="cont.htm?q=1">continue</a>
+ <a href="cont.htm?q=1&b=2">continue</a>
+ <form action="cont.htm">
+ </form>
+
</body>
</html>
1.10 +7 -0 embperl/test/html/setsess.htm
Index: setsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/setsess.htm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- setsess.htm 1999/11/04 05:30:28 1.9
+++ setsess.htm 2001/08/13 10:53:45 1.10
@@ -47,5 +47,12 @@
<td>[+ $ks[$row] +]</td><td>[+ $s -> {$ks[$row] || ''} +]</td>
</tr>
</table>
+
+ <a href="cont.htm">continue</a>
+ <a href="cont.htm?q=1">continue</a>
+ <a href="cont.htm?q=1&b=2">continue</a>
+ <form action="cont.htm">
+ </form>
+
</body>
</html>
1.1 embperl/test/html/sidurl/getnourlsess.htm
Index: getnourlsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
fdat:<br>
[- @ks = sort keys %fdat -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $fdat{$ks[$row] || ''} +]</td>
</tr>
</table>
udat:<br>
[- $off = 0 ; $off-- if ($HTML::Embperl::SessionMgnt == 2 && !defined (tied
(%udat) -> getid)) ; -]
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 +
$off ; -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $udat{$ks[$row] || ''} +]</td>
</tr>
</table>
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
[-
while (($k, $v) = each (%fdat))
{
$udat{$k} = $fdat{$k} ;
}
-]
[- $s = $Apache::Session::Win32::sessions ||
$Apache::Session::MemoryStore::store -]
[- @ks = sort keys %$s -]
sessions:
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $s -> {$ks[$row] || ''} +]</td>
</tr>
</table>
</body>
</html>
1.1 embperl/test/html/sidurl/geturlsess.htm
Index: geturlsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
[#
[- $s = $Apache::Session::Win32::sessions ||
$Apache::Session::MemoryStore::store -]
[- @ks = sort keys %$s -]
sessions:
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $sh = $s -> {$ks[$row] || ''}
+]</td><td>[$if ref($sh) eq 'HASH' $][+ do { my @tmp = map { "$_ = $sh->{$_}" } keys
(%$sh) ; join (', ', @tmp) } +][$endif$]</td>
</tr>
</table>
tied (%mdat) [+ $m = tied (%mdat) +] <br>
ref [+ ref ($m) +] <br>
content [+ do { my @tmp = map { "$_ = $mdat{$_}" } keys (%mdat) ;
join (', ', @tmp) } +] <br>
tied (%udat) [+ $u = tied (%udat) +] <br>
ref [+ ref ($u) +] <br>
content [+ do { my @tmp = map { "$_ = $udat{$_}" } keys (%udat) ;
join (', ', @tmp) } +] <br>
a=[+ scalar (do {$udat{'a'}}) +][+ $aa +]
#]
fdat:<br>
[- @ks = sort keys %fdat -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $fdat{$ks[$row] || ''} +]</td>
</tr>
</table>
udat:<br>
[- $off = 0 ; $off-- if ($HTML::Embperl::SessionMgnt == 2 && !defined (tied
(%udat) -> getid)) ; -]
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 +
$off ; -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $udat{$ks[$row] || ''} +]</td>
</tr>
</table>
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
[-
while (($k, $v) = each (%fdat))
{
$udat{$k} = $fdat{$k} ;
}
-]
$mdat{cnt} = -[+ $mdat{cnt} +]- <br>
$udat{cnt} = -[+ $udat{cnt} +]- <br>
[- $s = $Apache::Session::Win32::sessions ||
$Apache::Session::MemoryStore::store -]
[- @ks = sort keys %$s -]
sessions:
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $sh = $s -> {$ks[$row] || ''}
+]</td><td>[$if ref($sh) eq 'HASH' $][+ do { my @tmp = map { "$_ = $sh->{$_}" } keys
(%$sh) ; join (', ', @tmp) } +][$endif$]</td>
</tr>
</table>
<a href="cont.htm">continue</a>
<a href="cont.htm?q=1">continue</a>
<a href="cont.htm?q=1&b=2">continue</a>
<form action="cont.htm">
</form>
</body>
</html>
1.1 embperl/test/html/sidurl/seturlsess.htm
Index: seturlsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
fdat:<br>
[- @ks = sort keys %fdat -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $fdat{$ks[$row] || ''} +]</td>
</tr>
</table>
udat:<br>
[- $off = 0 ; $off-- if ($HTML::Embperl::SessionMgnt == 2 && !defined (tied
(%udat) -> getid)) ; -]
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 +
$off -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $udat{$ks[$row] || ''} +]</td>
</tr>
</table>
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
[-
while (($k, $v) = each (%fdat))
{
$udat{$k} = $fdat{$k} ;
}
-]
[- $s = $Apache::Session::MemoryStore::store ||
$Apache::Session::Win32::sessions -]
[- @ks = sort keys %$s -]
sessions:
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $s -> {$ks[$row] || ''} +]</td>
</tr>
</table>
<a href="cont.htm">continue</a>
<a href="cont.htm?q=1">continue</a>
<a href="cont.htm?q=1&b=2">continue</a>
<form action="cont.htm">
</form>
</body>
</html>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
