richter 2005/02/27 12:05:48
Modified: . Changes.pod Embperl.pm Embperl.pod Embperl.xs
README.v2 epinit.c test.pl
test/cmp reggetsess.htm
test/html/registry reggetsess.htm
Log:
- Reimplemented SetupSession, CleanupSession and SetSessionCookie
which can be used to access Embperl session data from outside,
for example from mod_perl Authentication handler.
Revision Changes Path
1.263 +3 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.262
retrieving revision 1.263
diff -u -r1.262 -r1.263
--- Changes.pod 25 Feb 2005 08:42:00 -0000 1.262
+++ Changes.pod 27 Feb 2005 20:05:47 -0000 1.263
@@ -23,6 +23,9 @@
trouble with overloaded output function.
- Fixed segfault which occured sometimes randomly after compile
of Embperl page source.
+ - Reimplemented SetupSession, CleanupSession and SetSessionCookie
+ which can be used to access Embperl session data from outside,
+ for example from mod_perl Authentication handler.
=head1 2.0rc2 21. November 2004
1.197 +67 -4 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.196
retrieving revision 1.197
diff -u -r1.196 -r1.197
--- Embperl.pm 14 Feb 2005 18:49:04 -0000 1.196
+++ Embperl.pm 27 Feb 2005 20:05:47 -0000 1.197
@@ -256,9 +256,40 @@
sub SetupSession
{
- die "SetupSession Not implemented yet in 2.0" ;
+ my ($req_rec, $uid, $sid, $appparam) = @_ ;
+
+ my ($rc, $thread, $app) = Embperl::InitAppForRequest ($req_rec,
$appparam) ;
+
+ my $cookie_name = $app -> config -> cookie_name ;
+ my $debug = $appparam?$appparam -> {debug} &
Embperl::Constant::dbgSession:0 ;
+ if (!$uid)
+ {
+ my $cookie_val = $ENV{HTTP_COOKIE} ||
($req_rec?$req_rec->header_in('Cookie'):undef) ;
+
+ if ((defined ($cookie_val) && ($cookie_val =~
/$cookie_name=(.*?)(\;|\s|$)/)) || ($ENV{QUERY_STRING} =~
/$cookie_name=.*?:(.*?)(\;|\s|&|$)/) || $ENV{EMBPERL_UID} )
+ {
+ $uid = $1 ;
+ print Embperl::LOG "[$$]SES: Received user session id $1\n" if
($debug) ;
+ }
+
+ }
+
+ if (!$sid)
+ {
+ if (($ENV{QUERY_STRING} =~ /${cookie_name}=(.*?)(\;|\s|&|:|$)/))
+ {
+ $sid = $1 ;
+ print Embperl::LOG "[$$]SES: Received state session id $1\n" if
($debug) ;
+ }
+ }
+
+ $app -> user_session -> setid ($uid) if ($uid) ;
+ $app -> state_session -> setid ($sid) if ($sid) ;
+
+ return wantarray?($app -> udat, $app -> mdat, $app -> sdat):$app -> udat
;
}
+
#######################################################################################
sub GetSession
@@ -313,7 +344,15 @@
sub CleanupSession
{
- die "CleanupSession Not implemented yet in 2.0" ;
+ my ($req_rec, $appparam) = @_ ;
+
+ my ($rc, $thread, $app) = Embperl::InitAppForRequest ($req_rec,
$appparam) ;
+
+ foreach my $obj ($app -> user_session, $app -> state_session, $app ->
app_session)
+ {
+ $obj -> cleanup if ($obj) ;
+ }
+
}
@@ -322,7 +361,31 @@
sub SetSessionCookie
{
- die "SetSessionCookie Not implemented yet in 2.0" ;
+ my ($req_rec, $appparam) = @_ ;
+
+ my ($rc, $thread, $app) = Embperl::InitAppForRequest ($req_rec,
$appparam) ;
+ my $udat = $app -> user_session ;
+ $req_rec ||= Apache -> request ;
+
+ if ($udat && $req_rec)
+ {
+ my ($initialid, $id, $modified) = $udat -> getids ;
+
+ my $name = $app -> config -> cookie_name ;
+ my $domain = $app -> config -> cookie_domain ;
+ my $path = $app -> config -> cookie_path ;
+ my $expires = $app -> config -> cookie_expires ;
+ my $secure = $app -> config -> cookie_secure ;
+ my $domainstr = $domain?"; domain=$domain":'';
+ my $pathstr = $path ?"; path=$path":'';
+ my $expiresstr = $expires?"; expires=$expires":'' ;
+ my $securestr = $secure?"; secure":'' ;
+
+ if ($id || $initialid)
+ {
+ $req_rec -> header_out ("Set-Cookie" =>
"$name=$id$domainstr$pathstr$expiresstr$securestr") ;
+ }
+ }
}
1.87 +67 -16 embperl/Embperl.pod
Index: Embperl.pod
===================================================================
RCS file: /home/cvs/embperl/Embperl.pod,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -r1.86 -r1.87
--- Embperl.pod 11 Feb 2005 14:52:09 -0000 1.86
+++ Embperl.pod 27 Feb 2005 20:05:47 -0000 1.87
@@ -1018,9 +1018,8 @@
=head2 Functions/Methods for session handling
-=head2 Embperl::Req::SetupSession ($req_rec, $Inputfile) [1.3b6+]
+=head2 Embperl::Req::SetupSession ($req_rec, $uid, $sid, $app_param)
[1.3b6+]
-B<NOT YET IMPLEMENTED IN 2.0>
This can be used from a script that will later call
L<Embperl::Execute|Execute> to
preset the session so it's available to the calling script.
@@ -1031,15 +1030,30 @@
Apache request record when running under mod_perl, C<undef> otherwise.
-=item $Inputfile
+=item $uid
+
+Session ID of the user session. If not given it is taken from the session
cookie or
+out of the query_string.
+
+=item $sid
+
+Session ID of the state session. If not given it is taken
+out of the query_string.
+
+=item $app_param
+
+SetupSession tries to figure out the correct Application object for this
+request, in case this is not possible you can pass parameters for the
+Application object as a hash ref. To pass the name of the application object
+to use, try to pass:
+
+ { appname => 'myappname' }
-Name of file that will be later processed by Embperl. It is used to setup
L<%mdat>. If you
-don't pass the C<$Inputfile>, C<%mdat> is not setup.
=back
Returns a reference to L<%udat> or, if call in an array context, a reference
to L<%udat>
-and L<%mdat>. See also C<CleanupSession>.
+L<%mdat> and L<%sdat>. See also C<CleanupSession>.
=head2 Embperl::Req::GetSession / $r -> GetSession [1.3b6+]
@@ -1048,14 +1062,30 @@
where the session management is already setup. If called as a method C<$r>
must be
a Embperl::Req object, which is passed as first parameter to every Embperl
page in @_ .
-=head2 Embperl::Req::CleanupSession / $r -> CleanupSession [1.3b6+]
-
-B<NOT YET IMPLEMENTED IN 2.0>
+=head2 Embperl::Req::CleanupSession ($req_rec, $app_param) [1.3b6+]
Must be called at the end of a script by scripts that use C<SetupSession>,
but do not call L<Embperl::Execute|Execute>.
-If called as a method C<$r> must be
-a Embperl::Req object, which is passed as first parameter to every Embperl
page in @_ .
+
+=over 4
+
+=item $req_rec
+
+Apache request record when running under mod_perl, C<undef> otherwise.
+
+=item $app_param
+
+CleanupSession tries to figure out the correct Application object for this
+request, in case this is not possible you can pass parameters for the
+Application object as a hash ref. To pass the name of the application object
+to use, try to pass:
+
+ { appname => 'myappname' }
+
+
+=back
+
+
=head2 Embperl::Req::DeleteSession / $r -> DeleteSession [1.3b6+]
@@ -1069,15 +1099,36 @@
If called as a method C<$r> must be
a Embperl::Req object, which is passed as first parameter to every Embperl
page in @_ .
-=head2 Embperl::Req::SetSessionCookie / $r -> SetSessionCookie [1.3b7+]
+=head2 Embperl::Req::SetSessionCookie ($req_rec, $app_param) [1.3b7+]
-B<NOT YET IMPLEMENTED IN 2.0>
Must be called by scripts that use C<SetupSession>,
but do not call L<Embperl::Execute|Execute>. This is neccessary to set the
cookie
-for the session id, in case a new session is created, which is normaly done
by
-L<Embperl::Execute|Execute>. If called as a method C<$r> must be
-a Embperl::Req object, which is passed as first parameter to every Embperl
page in @_ .
+for the user session id, in case a new session is created, which is normaly
done by
+L<Embperl::Execute|Execute>.
+
+SetSessionCookie does only set the cookie for the user session and it works
only
+when running under mod_perl. It does B<not> set session id if no cookies are
used.
+Also it does not care about the state session.
+
+=over 4
+
+=item $req_rec
+
+Apache request record when running under mod_perl, C<undef> otherwise.
+
+=item $app_param
+
+SetupSessionCookie tries to figure out the correct Application object for
this
+request, in case this is not possible you can pass parameters for the
+Application object as a hash ref. To pass the name of the application object
+to use, try to pass:
+
+ { appname => 'myappname' }
+
+
+=back
+
=head1 Recipes
1.58 +16 -0 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- Embperl.xs 16 Aug 2004 07:36:13 -0000 1.57
+++ Embperl.xs 27 Feb 2005 20:05:47 -0000 1.58
@@ -70,6 +70,22 @@
#endif
+int
+embperl_InitAppForRequest(pApacheReqSV, pPerlParam)
+ SV * pApacheReqSV
+ SV * pPerlParam
+PREINIT:
+ Embperl__App pApp;
+ Embperl__Thread pThread;
+ tApacheDirConfig * pApacheCfg = NULL ;
+PPCODE:
+ RETVAL = embperl_InitAppForRequest(aTHX_ pApacheReqSV, pPerlParam,
&pThread, &pApp, &pApacheCfg);
+ XSprePUSH ;
+ EXTEND(SP, 2) ;
+ PUSHs(epxs_IV_2obj(RETVAL)) ;
+ PUSHs(epxs_Embperl__Thread_2obj(pThread)) ;
+ PUSHs(epxs_Embperl__App_2obj(pApp)) ;
+
MODULE = Embperl::Req PACKAGE = Embperl::Req PREFIX = embperl_
1.7 +2 -1 embperl/README.v2
Index: README.v2
===================================================================
RCS file: /home/cvs/embperl/README.v2,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- README.v2 11 Feb 2005 14:52:09 -0000 1.6
+++ README.v2 27 Feb 2005 20:05:47 -0000 1.7
@@ -200,6 +200,7 @@
- errors can be mailed to an administrator
+- Parameters of SetupSession, CleanupSession and SetSessionCookie have
changed.
Embperl 1.x compatibility flag
1.25 +71 -8 embperl/epinit.c
Index: epinit.c
===================================================================
RCS file: /home/cvs/embperl/epinit.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- epinit.c 31 Oct 2004 14:36:15 -0000 1.24
+++ epinit.c 27 Feb 2005 20:05:47 -0000 1.25
@@ -2063,19 +2063,22 @@
+
+
+
/*---------------------------------------------------------------------------
* embperl_InitRequest
*/
/*!
*
* \_en
-* Initialize all necessary data structures to start a request like thread,
-* application and request object
+* Initialize the Thread and Application object and if available return the
+* Apache configuration data
* \endif
*
* \_de
-* Initialisiert alle n?tigen Datenstrukturen um den Request zu starten, wie
-* Thread-, Applikcation und Request-Objekt.
+* Initialisiert das Thread und Application Objekt und leifert, soweit
vorhanden,
+* die Apache Konfiguration
* \endif
*
* ------------------------------------------------------------------------ */
@@ -2083,17 +2086,18 @@
-int embperl_InitRequest (/*in*/ pTHX_
+int embperl_InitAppForRequest (/*in*/ pTHX_
/*in*/ SV * pApacheReqSV,
/*in*/ SV * pPerlParam,
- /*out*/tReq * * ppReq)
+ /*out*/tThreadData * * ppThread,
+ /*out*/tApp * * ppApp,
+ /*out*/tApacheDirConfig * * ppApacheCfg)
{
int rc ;
tThreadData * pThread ;
tApp * pApp ;
- tReq * r ;
tApacheDirConfig * pApacheCfg = NULL ;
@@ -2121,6 +2125,65 @@
return rc ;
}
+
+ *ppThread = pThread ;
+ *ppApp = pApp ;
+ *ppApacheCfg = pApacheCfg ;
+
+ return ok ;
+ }
+
+
+/*---------------------------------------------------------------------------
+* embperl_InitRequest
+*/
+/*!
+*
+* \_en
+* Initialize all necessary data structures to start a request like thread,
+* application and request object
+* \endif
+*
+* \_de
+* Initialisiert alle n?tigen Datenstrukturen um den Request zu starten, wie
+* Thread-, Applikcation und Request-Objekt.
+* \endif
+*
+* ------------------------------------------------------------------------ */
+
+
+
+
+int embperl_InitRequest (/*in*/ pTHX_
+ /*in*/ SV * pApacheReqSV,
+ /*in*/ SV * pPerlParam,
+ /*out*/tReq * * ppReq)
+
+
+ {
+ int rc ;
+ tThreadData * pThread ;
+ tApp * pApp ;
+ tReq * r ;
+ tApacheDirConfig * pApacheCfg = NULL ;
+
+
+
+
+ /* get our thread & Application object */
+
+ if ((rc = embperl_InitAppForRequest (aTHX_
+ pApacheReqSV,
+ pPerlParam,
+ &pThread,
+ &pApp,
+ &pApacheCfg)) != ok)
+ {
+ LogError (NULL, rc) ;
+ return rc ;
+ }
+
+
/* and setup the request object */
if ((rc = embperl_SetupRequest (aTHX_ pApacheReqSV, pApp, pApacheCfg,
pPerlParam, &r)) != ok)
{
1.151 +1 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.150
retrieving revision 1.151
diff -u -r1.150 -r1.151
--- test.pl 15 Jan 2005 20:17:27 -0000 1.150
+++ test.pl 27 Feb 2005 20:05:47 -0000 1.151
@@ -606,7 +606,6 @@
'modperl' => 1,
'cgi' => 0,
'cookie' => 'expectno',
- 'version' => 1,
},
'getsess.htm' => {
'offline' => 0,
1.3 +2 -3 embperl/test/cmp/reggetsess.htm
Index: reggetsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/reggetsess.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- reggetsess.htm 11 Sep 2000 09:53:34 -0000 1.2
+++ reggetsess.htm 27 Feb 2005 20:05:48 -0000 1.3
@@ -1,4 +1,3 @@
-<HTML><TITLE>Test for HTML::Embperl::Req::SetupSession</TITLE><BODY>
+<HTML><TITLE>Test for Embperl::Req::SetupSession</TITLE><BODY>
a = 1 <BR>
-<P>Here is some text inside of Execute</P>
-</BODY></HTML>
+<P>Here is some text inside of Execute</P></BODY></HTML>
1.5 +2 -1 embperl/test/html/registry/reggetsess.htm
Index: reggetsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/registry/reggetsess.htm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- reggetsess.htm 22 Oct 2002 05:29:12 -0000 1.4
+++ reggetsess.htm 27 Feb 2005 20:05:48 -0000 1.5
@@ -18,7 +18,8 @@
my $session = Embperl::Req::SetupSession ($r) ;
-$off = 0 ; $off-- if ($Embperl::SessionMgnt == 2 && !defined (tied
(%$session) -> getid)) ;
+$off = 0 ;
+#$off-- if ($Embperl::SessionMgnt == 2 && !defined (tied (%$session) ->
getid)) ;
@ks = grep (!/^_/, sort (keys %$session)) ; $num = keys (%$session) - $#ks -
1 + $off ;
foreach (@ks)
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
