perl-embperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From rich...@apache.org
Subject cvs commit: embperl/test/html/registry reggetsess.htm
Date Sun, 27 Feb 2005 20:05:48 GMT
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: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org


Mime
View raw message