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/09 09:03:16 UTC
cvs commit: embperl/test/html delwrsess.htm setbadsess.htm setunknownsess.htm delsess.htm
richter 00/11/09 00:03:16
Modified: . Embperl.pm epmain.c test.pl
Embperl Session.pm
test/cmp delsess.htm
test/html delsess.htm
Added: test/cmp delwrsess.htm
test/html delwrsess.htm setbadsess.htm setunknownsess.htm
Log:
Session Managenet enhanements
Revision Changes Path
1.125 +28 -39 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.124
retrieving revision 1.125
diff -u -r1.124 -r1.125
--- Embperl.pm 2000/11/08 07:49:07 1.124
+++ Embperl.pm 2000/11/09 08:03:14 1.125
@@ -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.124 2000/11/08 07:49:07 richter Exp $
+# $Id: Embperl.pm,v 1.125 2000/11/09 08:03:14 richter Exp $
#
###################################################################################
@@ -405,8 +405,8 @@
eval "require $session_handler" ;
die $@ if ($@) ;
- tie %udat, $session_handler, undef, \%sargs ;
- 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}) ;
}
@@ -425,32 +425,9 @@
}
}
-#######################################################################################
-
-#no strict ;
-
-sub _eval_ ($)
- {
- my $result = eval "package $evalpackage ; $_[0] " ;
- if ($@ ne '')
- { logevalerr ($@) ; }
- return $result ;
- }
-#use strict ;
-
#######################################################################################
-sub _evalsub_ ($)
- {
- my $result = eval "package $evalpackage ; sub { $_[0] } " ;
- if ($@ ne '')
- { logevalerr ($@) ; }
- return $result ;
- }
-
-#######################################################################################
-
sub Warn
{
local $^W = 0 ;
@@ -1647,8 +1624,6 @@
{
$sessid = $1 ;
print HTML::Embperl::LOG "[$$]SES: Received session cookie $1\n" if ($HTML::Embperl::dbgSession) ;
-
- $r -> SessionMgnt (0) if ($r) ; # do not resend cookie
}
if ($HTML::Embperl::SessionMgnt == 1)
@@ -1711,8 +1686,14 @@
my $r = shift || HTML::Embperl::CurrReq () ;
my $disabledelete = shift ;
- tied(%HTML::Embperl::udat) -> delete if (!$disabledelete) ; # Delete session data
- $r -> SessionMgnt (-1) ; # resend cookie without value
+ if (!$disabledelete) # Delete session data
+ {
+ tied(%HTML::Embperl::udat) -> delete ;
+ }
+ else
+ {
+ tied (%HTML::Embperl::udat) -> setid (undef) ; # for make test only
+ }
}
@@ -1723,7 +1704,7 @@
{
my $r = shift || HTML::Embperl::CurrReq () ;
- $r -> SessionMgnt ($HTML::Embperl::SessionMgnt) ; # resend cookie
+ $r -> SessionMgnt ($HTML::Embperl::SessionMgnt | 4) ; # resend cookie
}
#######################################################################################
@@ -1739,7 +1720,7 @@
my $udat = tied(%HTML::Embperl::udat) ;
my $mdat = tied(%HTML::Embperl::mdat) ;
- if ($HTML::Embperl::SessionMgnt == 1)
+ if ($HTML::Embperl::SessionMgnt & 1)
{
if ($udat->{'DIRTY'})
{
@@ -1779,14 +1760,22 @@
my $r = shift ;
$r = undef if (!(ref ($r) =~ /^HTML::Embperl/));
- if ($HTML::Embperl::SessionMgnt && (!defined ($r) || $r -> SessionMgnt))
+ if ($HTML::Embperl::SessionMgnt)
{
- 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})) ;
-
- Apache -> request -> header_out ("Set-Cookie" => "$name=" . (tied (%HTML::Embperl::udat) -> getid). "$domain$path$expires") ;
+ 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") ;
+ }
}
}
1.83 +38 -33 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -r1.82 -r1.83
--- epmain.c 2000/11/08 07:49:09 1.82
+++ epmain.c 2000/11/09 08:03:14 1.83
@@ -2556,12 +2556,46 @@
SV ** ppSVID ;
SV * pSVID = NULL ;
MAGIC * pMG ;
- char * pUID = NULL ;
- STRLEN ulen = 0 ;
+ char * pUID = NULL ;
+ char * pInitialUID = NULL ;
+ STRLEN ulen = 0 ;
+ STRLEN ilen = 0 ;
if (r -> nSessionMgnt)
{
- if (r -> nSessionMgnt == -1)
+ 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 (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,
r -> pConf -> sCookieDomain[0]?"; domain=":"" , r -> pConf -> sCookieDomain,
@@ -2570,36 +2604,7 @@
if (r -> bDebug & dbgSession)
lprintf (r, "[%d]SES: Delete Cookie -> %s\n", r -> nPid, SvPV(pCookie, ldummy)) ;
}
- else if (r -> nSessionMgnt == 2)
- {
- if ((pMG = mg_find((SV *)r -> pUserHash,'P')))
- {
- dSP; /* initialize stack pointer */
- SV * pUserHashObj = pMG -> mg_obj ;
- int n ;
-
-
- 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;
- }
- }
- else
- {
- ppSVID = hv_fetch (r -> pUserHash, sUIDName, sizeof (sUIDName) - 1, 0) ;
- if (ppSVID && *ppSVID)
- pUID = SvPV (*ppSVID, ulen) ;
- }
-
- if (ulen > 0)
+ else if (ulen > 0 && ilen == 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.78 +27 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- test.pl 2000/11/07 19:05:05 1.77
+++ test.pl 2000/11/09 08:03:15 1.78
@@ -341,6 +341,12 @@
'getsess.htm' => {
'offline' => 0,
},
+ 'delwrsess.htm' => {
+ 'offline' => 0,
+ },
+ 'getsess.htm' => {
+ 'offline' => 0,
+ },
'delsess.htm' => {
'offline' => 0,
},
@@ -350,6 +356,14 @@
'clearsess.htm' => {
'offline' => 0,
},
+ 'setbadsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'val=2&cookie=/etc/passwd',
+ },
+ 'setunknownsess.htm' => {
+ 'offline' => 0,
+ 'query_info' => 'val=3&cookie=1234567890abcdefABCDEF',
+ },
'EmbperlObject/epopage1.htm' => {
'offline' => 0,
'cgi' => 0,
@@ -743,14 +757,22 @@
my $ua = new LWP::UserAgent; # create a useragent to test
my($request,$response,$url);
+ my $cookiesend ;
-
if (!$upload)
{
$url = new URI::URL("http://$host:$port/$loc/$file?$query");
$request = new HTTP::Request($content?'POST':'GET', $url);
- $request -> header ('Cookie' => $cookie) if ($cookie && !($query =~ /nocookie/)) ;
+ if ($query =~ /cookie=(.*?)$/)
+ {
+ $request -> header ('Cookie' => $1) ;
+ $cookiesend = $1 ;
+ }
+ else
+ {
+ $request -> header ('Cookie' => $cookie) if ($cookie && !($query =~ /nocookie/)) ;
+ }
$request -> content ($content) if ($content) ;
}
@@ -781,6 +803,8 @@
$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) ;
+
#print $response -> headers -> as_string () ;
return $response -> message if (!$response->is_success) ;
@@ -927,6 +951,7 @@
{ $opt_modperl = $opt_cgi = $opt_offline = $opt_execute = 1 }
else
{ $opt_offline = $opt_execute = 1 }
+ $opt_ep1 = 1 ;
}
1.6 +67 -23 embperl/Embperl/Session.pm
Index: Session.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Session.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Session.pm 2000/11/07 11:28:27 1.5
+++ Session.pm 2000/11/09 08:03:15 1.6
@@ -32,8 +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>)
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 object_store
Specify the class for the object store. (The Apache::Session:: prefix is
@@ -148,7 +154,8 @@
my $self =
{
args => $args,
- data => { _session_id => $session_id },
+ data => { _session_id => $session_id },
+ initial_session_id => $session_id,
lock => 0,
lock_manager => undef,
object_store => undef,
@@ -236,30 +243,39 @@
if (defined $session_id && $session_id)
{
- if (exists $self -> {'args'}->{Transaction} && $self -> {'args'}->{Transaction})
- {
- $self->acquire_write_lock;
- }
+ #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;
+ }
- $self->{status} &= ($self->{status} ^ NEW);
+ $self->{status} &= ($self->{status} ^ NEW);
- if ($self -> {'args'}{'create_unknown'})
- {
- eval { $self -> restore } ;
- #warn "Try to load session: $@" if ($@) ;
- $@ = "" ;
- $session_id = $self->{data}->{_session_id} ;
- }
- else
- {
- $self->restore;
- }
- }
+ if ($self -> {'args'}{'create_unknown'})
+ {
+ eval { $self -> restore } ;
+ #warn "Try to load session: $@" if ($@) ;
+ $@ = "" ;
+ $session_id = $self->{data}->{_session_id} ;
+ }
+ else
+ {
+ $self->restore;
+ }
+ }
+ }
+ $@ = '' ;
+
if (!($self->{status} & SYNCED))
{
$self->{status} |= NEW();
- if (!$self->{data}->{_session_id})
+ if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'})
{
if (exists ($self->{generate}))
{ # Apache::Session >= 1.50
@@ -391,9 +407,15 @@
sub getid {
my $self = shift;
- return $self->{data}->{_session_id} ;
+ return $self->{data}->{_session_id} || $self->{'ID'} ;
}
+sub getinitialid {
+ my $self = shift;
+
+ return $self->{initial_session_id} ;
+}
+
sub delete {
my $self = shift;
@@ -402,7 +424,8 @@
$self -> init if (!$self -> {'status'}) ;
$self->{status} |= DELETED;
- $self->save;
+ $self->save;
+ $self->{data} = {} ; # Throw away the data
}
@@ -422,6 +445,21 @@
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.
+
+ my $session = shift;
+
+ if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) {
+ die;
+ }
+}
#
# For Apache::Session >= 1.50
@@ -439,10 +477,16 @@
$self->{object_store} = new $store $self if ($store) ;
$self->{lock_manager} = new $lock $self if ($lock);
- $self->{generate} = \&{$gen . '::generate'} if ($gen);
+ $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 ;
+ }
+
return $self;
}
1.3 +3 -12 embperl/test/cmp/delsess.htm
Index: delsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/delsess.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- delsess.htm 2000/09/11 09:53:33 1.2
+++ delsess.htm 2000/11/09 08:03:15 1.3
@@ -13,20 +13,11 @@
</tr>
</table>
-^ ok \(num=\d+\)<p>
+ ok (num=1)<p>
$mdat{cnt} = -- <br>
$udat{cnt} = -- <br>
- udat after:<br>
- <table>
- <tr>
- <td>a</td><td>1</td>
- </tr>
- </table>
-
-^ ok \(num=\d+\)<p>
-
-</body>
+ </body>
</html>
-
+
1.1 embperl/test/cmp/delwrsess.htm
Index: delwrsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Delete Session Data</title>
</head>
<body>
udat before:<br>
<table>
<tr>
<td>a</td><td>1</td>
</tr>
</table>
ok (num=1)<p>
$mdat{cnt} = -- <br>
$udat{cnt} = -- <br>
udat after:<br>
<table>
<tr>
<td>a</td><td>1</td>
</tr>
</table>
ok (num=1)<p>
</body>
</html>
1.3 +0 -11 embperl/test/html/delsess.htm
Index: delsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/delsess.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- delsess.htm 2000/09/11 09:53:36 1.2
+++ delsess.htm 2000/11/09 08:03:16 1.3
@@ -22,16 +22,5 @@
[- HTML::Embperl::Req::DeleteSession (undef, 1) ; -]
- udat after:<br>
- [- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 ; -]
-
- <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>
-
</body>
</html>
1.1 embperl/test/html/delwrsess.htm
Index: delwrsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Delete Session Data</title>
</head>
<body>
udat before:<br>
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 ; -]
<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>
$mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
$udat{cnt} = -[+ $udat{cnt} ; +]- <br>
[- HTML::Embperl::Req::DeleteSession (undef, 1) ; -]
udat after:<br>
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 ; -]
<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>
</body>
</html>
1.1 embperl/test/html/setbadsess.htm
Index: setbadsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data (with bad cookie)</title>
</head>
<body>
[-
while (($k, $v) = each (%fdat))
{
$udat{$k} = $fdat{$k} ;
}
-]
[+ $udat{_session_id} +]
</body>
</html>
1.1 embperl/test/html/setunknownsess.htm
Index: setunknownsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data (unknown cookie)</title>
</head>
<body>
[-
while (($k, $v) = each (%fdat))
{
$udat{$k} = $fdat{$k} ;
}
-]
[+ $udat{_session_id} +]
</body>
</html>