You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@tcl.apache.org by mx...@apache.org on 2021/10/25 16:48:43 UTC

[tcl-rivet] 02/03: merging latest commit in trunk, including environment variable internals revision, Session package cache table having larger 'data' columns

This is an automated email from the ASF dual-hosted git repository.

mxmanghi pushed a commit to branch quattuor
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git

commit 29047a56369e7607528b56941c16618f98a2c1b6
Author: Massimo Manghi <ma...@gmail.com>
AuthorDate: Mon Oct 25 18:47:19 2021 +0200

    merging latest commit in trunk, including environment variable internals revision, Session package cache table having larger 'data' columns
---
 ChangeLog                                        |  15 +
 doc/xml/commands.xml                             | 123 ++++----
 rivet/packages/session/session-class.tcl         |   3 +-
 rivet/packages/session/session-create-mysql.sql  |   6 +-
 rivet/packages/session/session-create-oracle.sql |  12 +-
 rivet/packages/session/session-create-sqlite.sql |   6 +-
 src/mod_rivet_ng/TclWebapache.c                  | 363 +++++++++++++++--------
 src/mod_rivet_ng/mod_rivet_generator.c           |   2 +-
 src/mod_rivet_ng/rivetCore.c                     |   8 +-
 src/mod_rivet_ng/rivet_types.h                   |   2 +-
 src/rivet.h                                      |   1 +
 tests/apachetest/template.conf.1.tcl             |   2 +-
 tests/env.rvt                                    |  22 +-
 tests/env.test                                   |  45 ++-
 tests/rivet.test                                 |  19 +-
 15 files changed, 420 insertions(+), 209 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 132cf24..e431eea 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2021-10-25 Massimo Manghi <mx...@apache.org>
+	* src/mod_rivet_ng/Tclwebapache.c: extended comments
+	* src/rivet.h: new macro MINSTRLEN
+
+2021-10-20 Massimo Manghi <mx...@apache.org>
+	* src/mod_rivet_ng/Tclwebapache.c: new environment variable handling. 
+	  Command ::rivet::env doesn't necessarily trigger the whole enviroment load
+	  into request_rec, it tries to resolve a variable incrementally. Need
+	  to recommend the usage of ::rivet::env instead of ::rivet::load_env
+	* tests/env.rvt: adding new tests to environment variable resolution
+
+2021-09-06 Massimo Manghi <mx...@apache.org>
+	* rivet/packages/session/session-create-*.sql: making cache fields larger
+	* rivet/packages/session/session-create-*.sql: making cache fields larger
+
 2021-04-13 Massimo Manghi <mx...@apache.org>
     * src/mod_rivet_ng/rivetInspect.c: add server current loglevel. Removed
     unneeded ref count management in the server array construction
diff --git a/doc/xml/commands.xml b/doc/xml/commands.xml
index 0b95309..d3104fe 100644
--- a/doc/xml/commands.xml
+++ b/doc/xml/commands.xml
@@ -460,61 +460,63 @@
 	</refentry>
 
 	<refentry id="debug">
-	    <refnamediv>
-		<refname>debug</refname>
-		<refpurpose>
-		    A command to print strings, arrays
-		    and the values of variables as specified by the arguments.
-		</refpurpose>
-	    </refnamediv>
-	    <refsynopsisdiv>
-		<cmdsynopsis>
-		    <command>::rivet::debug</command>
-		    <arg choice="plain">-subst</arg><arg>&lt;on|off&gt;</arg>
-		    <arg choice="plain">-separator</arg><arg>&lt;string&gt;</arg>
-		    <arg choice="plain">-option</arg><arg><replaceable>&lt;value&gt;</replaceable></arg>
-		    <arg choice="plain">-option</arg><arg><replaceable>&lt;value&gt;</replaceable></arg>
-		    <arg choice="plain">...</arg>
-		</cmdsynopsis>
-	    </refsynopsisdiv>	
+	   <refnamediv>
+			<refname>debug</refname>
+			<refpurpose>
+			    A command to print strings, arrays
+			    and the values of variables as specified by the arguments.
+			</refpurpose>
+	   </refnamediv>
+	   <refsynopsisdiv>
+			<cmdsynopsis>
+			    <command>::rivet::debug</command>
+			    <arg choice="plain">-subst</arg><arg>&lt;on|off&gt;</arg>
+			    <arg choice="plain">-separator</arg><arg>&lt;string&gt;</arg>
+			    <arg choice="plain">-option</arg><arg><replaceable>&lt;value&gt;</replaceable></arg>
+			    <arg choice="plain">-option</arg><arg><replaceable>&lt;value&gt;</replaceable></arg>
+			    <arg choice="plain">...</arg>
+			</cmdsynopsis>
+	   </refsynopsisdiv>	
 	
-	    <refsect1>
-		<title>Description</title>
-		<para>
-		    A command to make debugging more convenient print strings, arrays
-		    and the values of variables as specified by the arguments.
-		</para>
-		<para>
-		    Also allows the setting of an array called debug which will pick up
-		    options for all debug commands.
-		</para>
-	    </refsect1>
+	   <refsect1>
+			<title>Description</title>
+			<para>
+			    A command to make debugging more convenient print strings, arrays
+			    and the values of variables as specified by the arguments.
+			</para>
+			<para>
+			    Also allows the setting of an array called debug which will pick up
+			    options for all debug commands.
+			</para>
+	   </refsect1>
 	</refentry>
 
-
 	<refentry id="env">
-	    <refnamediv>
-		<refname>env</refname> 
-		<refpurpose>
-		    Loads a single "environmental variable" into a Tcl variable.
-		</refpurpose>
-	    </refnamediv>
+	   <refnamediv>
+			<refname>env</refname> 
+			<refpurpose>
+			    Returns the value a single "environmental variable".
+			</refpurpose>
+	   </refnamediv>
 
-	    <refsynopsisdiv>
-		<cmdsynopsis>
-		    <command>::rivet::env</command>
-		    <arg><replaceable>varName</replaceable></arg>
-		</cmdsynopsis>
-	    </refsynopsisdiv>
+	   <refsynopsisdiv>
+			<cmdsynopsis>
+			    <command>::rivet::env</command>
+			    <arg><replaceable>environment_variable_name</replaceable></arg>
+			</cmdsynopsis>
+	   </refsynopsisdiv>
 
-	    <refsect1>
-		<title>Description</title>
-		<para>
-		    If it is only necessary to load one environmental variable,
-		    this command may be used to avoid the overhead of loading
-		    and storing the entire array.
-		</para>
-	    </refsect1>
+	   <refsect1>
+			<title>Description</title>
+			<para>
+			    If just one environmental variable is needed <command>::rivet::env</command>
+			    returns the variable value or an empty string if the environment
+			    variable name in the argument is not defined.
+			    This command has some performance advantages with respect to
+			    <command>::rivet::load_env</command> since it avoids the
+			    loading of the whole set of environment and header variables.
+			</para>
+	   </refsect1>
 	</refentry>
 
 	<refentry id="escape_sgml_chars">
@@ -530,19 +532,16 @@
 		</cmdsynopsis>
 	    </refsynopsisdiv>
 
-	    <refsect1>
-		<title>Description</title>
-		<para>
-		    Scans through each character in the specified string looking
-		    for any special (with respect to SGML, and hence HTML) characters
-		    from the specified string, and returns the result.  
-		    For example, the right angle bracket is escaped to the corrected
-            ampersand gt symbol.
-		</para>
-		<!--note> 
-		    You must require the <command>rivetlib</command> package in order to gain access to this command
-		</note -->
-	    </refsect1>
+	   <refsect1>
+			<title>Description</title>
+			<para>
+			    Scans through each character in the specified string looking
+			    for any special (with respect to SGML, and hence HTML) characters
+			    from the specified string, and returns the result.  
+			    For example, the right angle bracket is escaped to the corrected
+	          ampersand gt symbol.
+			</para>
+	   </refsect1>
 	</refentry>
 
 	<refentry id="escape_shell_command">
diff --git a/rivet/packages/session/session-class.tcl b/rivet/packages/session/session-class.tcl
index abc62fa..28fb3e1 100644
--- a/rivet/packages/session/session-class.tcl
+++ b/rivet/packages/session/session-class.tcl
@@ -1,7 +1,6 @@
 #
 # Session - Itcl object for web session management for Rivet
 #
-# $Id$
 #
 
 # Copyright 2004 The Apache Software Foundation
@@ -476,7 +475,7 @@ package require Itcl
     }
 
     #
-    # is_new_sesion - return a 1 if it's a new session, else a zero if there
+    # is_new_session - return a 1 if it's a new session, else a zero if there
     # were one or more prior pages creating and/or using this session ID
     #
     method is_new_session {} {
diff --git a/rivet/packages/session/session-create-mysql.sql b/rivet/packages/session/session-create-mysql.sql
index 0e79087..93fae67 100644
--- a/rivet/packages/session/session-create-mysql.sql
+++ b/rivet/packages/session/session-create-mysql.sql
@@ -18,9 +18,9 @@ create table rivet_session (
 DROP TABLE IF EXISTS `rivet_session_cache`;
 create table rivet_session_cache(
     session_id      varchar(128)    default NULL,
-    package_        varchar(64)     default NULL,
-    key_            varchar(128)    default NULL,
-    data            varchar(255)    default NULL,
+    package_        varchar(128)    default NULL,
+    key_            varchar(256)    default NULL,
+    data            varchar(4096)   default NULL,
 
     UNIQUE KEY riv_sess_cache_ix( session_id, package_, key_ ),
     KEY rivet_session_cache_idx (session_id),
diff --git a/rivet/packages/session/session-create-oracle.sql b/rivet/packages/session/session-create-oracle.sql
index ad4b0d9..4d5b1b1 100644
--- a/rivet/packages/session/session-create-oracle.sql
+++ b/rivet/packages/session/session-create-oracle.sql
@@ -4,10 +4,10 @@
 --  Arnulf 
 --
 CREATE TABLE rivet_session
-    (ip_address                     VARCHAR2(23) DEFAULT NULL,
+    (ip_address                    VARCHAR2(23) DEFAULT NULL,
     session_start_time             DATE DEFAULT NULL,
     session_update_time            DATE DEFAULT NULL,
-    session_id                     VARCHAR2(50) NOT NULL
+    session_id                     VARCHAR2(64) NOT NULL
     )
 /
 
@@ -16,10 +16,10 @@ ALTER TABLE rivet_session ADD PRIMARY KEY (session_id)
 /
 
 CREATE TABLE rivet_session_cache
-    (session_id                     VARCHAR2(50) DEFAULT NULL,
-    package_                       VARCHAR2(100) DEFAULT NULL,
-    key_                           VARCHAR2(50) DEFAULT NULL,
-    data                           VARCHAR2(255) DEFAULT NULL
+    (session_id                    VARCHAR2(128) DEFAULT NULL,
+    package_                       VARCHAR2(128) DEFAULT NULL,
+    key_                           VARCHAR2(256) DEFAULT NULL,
+    data                           VARCHAR2(4096) DEFAULT NULL
   )
 /
 
diff --git a/rivet/packages/session/session-create-sqlite.sql b/rivet/packages/session/session-create-sqlite.sql
index 36b1a3d..868cbce 100644
--- a/rivet/packages/session/session-create-sqlite.sql
+++ b/rivet/packages/session/session-create-sqlite.sql
@@ -7,9 +7,9 @@ CREATE TABLE rivet_session (
 );
 CREATE TABLE rivet_session_cache (
     session_id      varchar(128)    default NULL PRIMARY KEY ON CONFLICT FAIL,
-    package_        varchar(64)     default NULL,
-    key_            varchar(128)    default NULL,
-    data            varchar(255)    default NULL,
+    package_        varchar(128)     default NULL,
+    key_            varchar(256)    default NULL,
+    data            varchar(4096)    default NULL,
 
 --  KEY rivet_session_cache_idx (session_id),
     CONSTRAINT session_cleanup FOREIGN KEY (session_id) REFERENCES rivet_session(session_id) ON DELETE CASCADE
diff --git a/src/mod_rivet_ng/TclWebapache.c b/src/mod_rivet_ng/TclWebapache.c
index 9d573ee..fba67b7 100644
--- a/src/mod_rivet_ng/TclWebapache.c
+++ b/src/mod_rivet_ng/TclWebapache.c
@@ -41,15 +41,29 @@
 
 extern module rivet_module;
 extern mod_rivet_globals* module_globals;
-#define TCLWEBPOOL req->req->pool
 
-#define BUFSZ 4096
+/* It's kind of an overkill: we define macros for handling the
+ * flags that control the handling of the three environment variables
+ * classes (common, CGI and include variables). */
+
+#define ENV_COMMON_VARS_M    1
+#define ENV_CGI_VARS_M       2
+#define ENV_VARS_M           4
+#define ENV_VARS_RESET(env)  env = 0;
+#define ENV_COMMON_VARS(env) env |= ENV_COMMON_VARS_M;
+#define ENV_CGI_VARS(env)    env |= ENV_CGI_VARS_M;
+#define ENV_VARS(env)        env |= ENV_VARS_M;
+
+#define ENV_IS_LOADED(env)          (env == (ENV_COMMON_VARS_M | ENV_CGI_VARS_M | ENV_VARS_M))
+#define ENV_COMMON_VARS_LOADED(env) (env & ENV_COMMON_VARS_M) != 0
+#define ENV_CGI_VARS_LOADED(env)    (env & ENV_CGI_VARS_M) != 0
+#define ENV_VARS_LOADED(env)        (env & ENV_VARS_M) != 0
 
 /* This is used below to determine what part of the parmsarray to parse. */
 
-#define PARMSARRAY_COORDINATES i = 0; j = parmsarray->nelts; \
-if (source == VAR_SRC_QUERYSTRING) { j = req->apachereq->nargs; } \
-else if (source == VAR_SRC_POST) { i = req->apachereq->nargs; }
+#define PARMSARRAY_COORDINATES(i,j,parray,nargs) i = 0; j = parray->nelts; \
+if (source == VAR_SRC_QUERYSTRING) { j = nargs; } \
+else if (source == VAR_SRC_POST) { i = nargs; }
 
 /* 
  * -- TclWeb_NewRequestObject
@@ -67,13 +81,12 @@ TclWeb_NewRequestObject (apr_pool_t *p)
     req->apachereq          = ApacheRequest_new(p);
     req->headers_printed    = 0;
     req->headers_set        = 0;
-    req->environment_set    = 0;
+    ENV_VARS_RESET(req->environment_set)
     req->charset            = NULL;  /* we will test against NULL to check if a charset *
                                       * was specified in the conf                       */
     return req;
 }
 
-
 /*
  * -- TclWeb_InitRequest
  *
@@ -101,16 +114,18 @@ TclWeb_InitRequest(rivet_thread_private* private, Tcl_Interp *interp)
     req->apachereq          = ApacheRequest_init(req->apachereq,r);
     req->headers_printed    = 0;
     req->headers_set        = 0;
-    req->environment_set    = 0;
+    ENV_VARS_RESET(req->environment_set)
     req->charset            = NULL;
 
     /*
      * if strlen(req->content_type) > strlen([RIVET|TCL]_FILE_CTYPE)
-     * a charset parameters might be there 
+     * a charset parameters might be in the configuration like
+     *
+     * AddType 'application/x-httpd-rivet;charset=utf-8' rvt
      */
 
     if (((private->ctype==RIVET_TEMPLATE) && (content_type_len > strlen(RIVET_TEMPLATE_CTYPE))) || \
-         ((private->ctype==RIVET_TCLFILE) && (content_type_len > strlen(RIVET_TCLFILE_CTYPE)))) {
+        ((private->ctype==RIVET_TCLFILE) && (content_type_len > strlen(RIVET_TCLFILE_CTYPE)))) {
         
         char* charset;
 
@@ -156,8 +171,6 @@ TclWeb_SetHeaderType(char *header, TclWebRequest *req)
     if (req->headers_set)
         return TCL_ERROR;
 
-//    req->req->content_type = (char *) apr_pstrdup(req->req->pool, header);
-
     ap_set_content_type(req->req,apr_pstrdup(req->req->pool, header));
     req->headers_set = 1;
     return TCL_OK;
@@ -187,7 +200,6 @@ TclWeb_PrintHeaders(TclWebRequest *req)
      */
     
     TclWeb_SendHeaders(req);
-    /* ap_send_http_header(req->req); */
 
     req->headers_printed = 1;
     return TCL_OK;
@@ -207,7 +219,7 @@ TclWeb_PrintError(CONST84 char *errstr, int htmlflag, TclWebRequest *req)
     {
         if (htmlflag != 1)
         {
-            ap_rputs(ap_escape_html(TCLWEBPOOL, errstr), req->req);
+            ap_rputs(ap_escape_html(req->req->pool,errstr),req->req);
         } else {
             ap_rputs(errstr, req->req);
         }
@@ -270,65 +282,66 @@ INLINE int
 TclWeb_MakeURL(Tcl_Obj *result, char *filename, TclWebRequest *req)
 {
     Tcl_SetStringObj(result,
-                ap_construct_url(TCLWEBPOOL,filename,req->req),-1);
+                ap_construct_url(req->req->pool,filename,req->req),-1);
     return TCL_OK;
 }
 
 int
 TclWeb_GetVar(Tcl_Obj *result, char *varname, int source, TclWebRequest *req)
 {
-    int i, j;
-    apr_array_header_t *parmsarray = (apr_array_header_t *)
-        apr_table_elts(req->apachereq->parms);
-    apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
+    int i,j;
+    apr_array_header_t *parmsarray = (apr_array_header_t *)apr_table_elts(req->apachereq->parms);
+    apr_table_entry_t  *parms = (apr_table_entry_t *)parmsarray->elts;
     int flag = 0;
 
-    PARMSARRAY_COORDINATES;
+    PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
 
     /* This isn't real efficient - move to hash table later on... */
     while (i < j)
     {
         char *parmkey = TclWeb_StringToUtf(parms[i].key, req);
-        if (!strncmp(varname, parmkey,
+        if (!strncmp(varname,parmkey,
                     strlen(varname) < strlen(parmkey) ?
                     strlen(parmkey) : strlen(varname)))
         {
+
             /* The following makes sure that we get one string,
                with no sub lists. */
+
             if (flag == 0)
             {
+
                 flag = 1;
-                Tcl_SetStringObj(result,
-                        TclWeb_StringToUtf(parms[i].val, req), -1);
+                Tcl_SetStringObj (result,TclWeb_StringToUtf(parms[i].val,req),-1);
+
             } else {
+
                 Tcl_Obj *tmpobj;
                 Tcl_Obj *tmpobjv[2];
                 tmpobjv[0] = result;
-                tmpobjv[1] = TclWeb_StringToUtfToObj(parms[i].val, req);
-                tmpobj = Tcl_ConcatObj(2, tmpobjv);
-                Tcl_SetStringObj(result, Tcl_GetString(tmpobj), -1);
+                tmpobjv[1] = TclWeb_StringToUtfToObj (parms[i].val,req);
+                tmpobj = Tcl_ConcatObj (2,tmpobjv);
+                Tcl_SetStringObj (result,Tcl_GetString(tmpobj),-1);
+
             }
+
         }
         i++;
     }
 
-    if (result->length == 0)
-    {
-	    return TCL_ERROR;
-    }
+    if (result->length == 0) { return TCL_ERROR; }
 
     return TCL_OK;
 }
 
 int
-TclWeb_GetVarAsList(Tcl_Obj *result, char *varname, int source, TclWebRequest *req)
-{
+TclWeb_GetVarAsList(Tcl_Obj *result, char *varname, int source, TclWebRequest *req) {
     int i, j;
     apr_array_header_t *parmsarray = (apr_array_header_t *)
         apr_table_elts(req->apachereq->parms);
     apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
 
-    PARMSARRAY_COORDINATES;
+    PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
 
     /* This isn't real efficient - move to hash table later on. */
     while (i < j)
@@ -359,20 +372,20 @@ TclWeb_GetAllVars(Tcl_Obj *result, int source, TclWebRequest *req)
         apr_table_elts(req->apachereq->parms);
     apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
 
-    PARMSARRAY_COORDINATES;
+    PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
 
     while (i < j)
     {
-	Tcl_ListObjAppendElement(req->interp, result,
-				 TclWeb_StringToUtfToObj(parms[i].key, req));
-	Tcl_ListObjAppendElement(req->interp, result,
-				 TclWeb_StringToUtfToObj(parms[i].val, req));
-	i++;
+        Tcl_ListObjAppendElement(req->interp,result,
+                     TclWeb_StringToUtfToObj(parms[i].key,req));
+        Tcl_ListObjAppendElement(req->interp,result,
+                     TclWeb_StringToUtfToObj(parms[i].val,req));
+        i++;
     }
 
     if (result == NULL)
     {
-	return TCL_ERROR;
+	    return TCL_ERROR;
     }
     return TCL_OK;
 }
@@ -385,18 +398,18 @@ TclWeb_GetVarNames(Tcl_Obj *result, int source, TclWebRequest *req)
         apr_table_elts(req->apachereq->parms);
     apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
 
-    PARMSARRAY_COORDINATES;
+    PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
 
     while (i < j)
     {
-	Tcl_ListObjAppendElement(req->interp, result,
-				 TclWeb_StringToUtfToObj(parms[i].key, req));
-	i++;
+        Tcl_ListObjAppendElement(req->interp, result,
+                     TclWeb_StringToUtfToObj(parms[i].key, req));
+        i++;
     }
 
     if (result == NULL)
     {
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
 
     return TCL_OK;
@@ -410,7 +423,7 @@ TclWeb_VarExists(Tcl_Obj *result, char *varname, int source, TclWebRequest *req)
         apr_table_elts(req->apachereq->parms);
     apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
 
-    PARMSARRAY_COORDINATES;
+    PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
 
     /* This isn't real efficient - move to hash table later on. */
     while (i < j)
@@ -445,79 +458,181 @@ TclWeb_VarNumber(Tcl_Obj *result, int source, TclWebRequest *req)
     return TCL_OK;
 }
 
+/* These 2 array must be aligned and a one-to-one correspondence preserved 
+ * The enum include_vars_idx must be terminated by 'invalid_env_var'
+ */
+
+static const char* include_env_vars[] =
+{
+    "DATE_LOCAL","DATE_GMT","LAST_MODIFIED","DOCUMENT_URI","DOCUMENT_PATH_INFO","DOCUMENT_NAME",
+    "QUERY_STRING_UNESCAPED","USER_NAME","RIVET_CACHE_FREE","RIVET_CACHE_SIZE",
+    NULL
+};
+enum include_vars_idx {
+    date_local=0,date_gmt,last_modified,document_uri,document_path_info,document_name,
+    query_string_unescaped,user_name,rivet_cache_free,rivet_cache_size,
+    invalid_env_var
+};
+
+static char*
+TclWeb_SelectEnvIncludeVar (rivet_thread_private* private,int idx)
+{
+    switch (idx)
+    {
+        case date_local: 
+        {
+            apr_pool_t* pool = private->req->req->pool;
+            apr_time_t date = private->req->req->request_time;
+
+            return ap_ht_time(pool,date,DEFAULT_TIME_FORMAT,0); 
+        }
+        case date_gmt:
+        {
+            apr_pool_t* pool = private->req->req->pool;
+            apr_time_t date = private->req->req->request_time;
+
+            return ap_ht_time(pool,date,DEFAULT_TIME_FORMAT,1);
+        }
+        case last_modified:
+        {
+            apr_pool_t* pool = private->req->req->pool;
+
+            return ap_ht_time(pool,private->req->req->finfo.mtime,DEFAULT_TIME_FORMAT,1);
+        }
+        case document_uri:
+        {
+            return private->req->req->uri;
+        }
+        case document_path_info:
+        {
+            return private->req->req->path_info;
+        }
+        case document_name:
+        {
+            char *t;
+
+            if ((t = strrchr(private->req->req->filename,'/'))) {
+                return ++t;
+            } else {
+                return private->req->req->uri;
+            }
+        }
+        case query_string_unescaped:
+        {
+            if (private->req->req->args) {
+                apr_pool_t* pool = private->req->req->pool;
+                char *arg_copy = (char*) apr_pstrdup(pool,private->req->req->args);
+
+                ap_unescape_url(arg_copy);
+                return ap_escape_shell_cmd(pool,arg_copy);
+            } else {
+                return NULL;
+            }
+
+        }
+        case user_name:
+        {
+#ifndef WIN32
+            struct passwd *pw = (struct passwd *) getpwuid(private->req->req->finfo.user);
+            if (pw) {
+                //apr_table_set( table, "USER_NAME",
+                //        apr_pstrdup( pool, pw->pw_name ) );
+                return pw->pw_name;
+            } else {
+                apr_pool_t* pool = private->req->req->pool;
+                return (char*) apr_psprintf(pool,"user#%lu",(unsigned long)private->req->req->finfo.user);
+            }
+#else
+            return NULL;
+#endif
+        }
+        case rivet_cache_free:
+        {
+            apr_pool_t* pool = private->req->req->pool;
+            return (char*) apr_psprintf (pool, "%d",(RIVET_PEEK_INTERP(private,private->running_conf))->cache_free);
+        }
+        case rivet_cache_size:
+        {
+            apr_pool_t* pool = private->req->req->pool;
+            return (char*) apr_psprintf (pool, "%d",(RIVET_PEEK_INTERP(private,private->running_conf))->cache_size);
+        }
+    }
+    return NULL;
+}
+
 /*
- * Load the Apache environment and CGI variables into the request.  If we
- * have already done so, we don't need to do it again.
+ * -- TclWeb_InitEnvVars
+ * 
+ * Load the CGI and environment variables into the request_rec environment structure
+ * Variables belong to 3 cathegories 
+ *
+ *   + common variables (ap_add_common_vars)
+ *   + CGI variables (ad_cgi_vars)
+ *   + a miscellaneous set of variables 
+ *     listed in the array include_env_vars
+ *
+ * Each cathegory is controlled by flags in order to reduce the overhead of getting them
+ * into request_rec in case previous call to ::rivet::env could have already forced them
+ * into request_rec
  */
+
 static void
 TclWeb_InitEnvVars (rivet_thread_private* private)
 {
-    //rivet_server_conf *rsc;
-    char *timefmt = DEFAULT_TIME_FORMAT;
-    char *t;
-    apr_time_t date;
-#ifndef WIN32
-    struct passwd *pw;
-#endif /* ndef WIN32 */
-    TclWebRequest *req;
-    apr_table_t *table;  
+    TclWebRequest *req = private->req;
+    apr_table_t   *table;  
+    int            idx;
 
-    req = private->req;
-    table = req->req->subprocess_env;
-    date = req->req->request_time;
-
-    if( req->environment_set ) return;
+    if (ENV_IS_LOADED(req->environment_set)) return;
 
-    //rsc = RIVET_SERVER_CONF( req->req->server->module_config );
+    table = req->req->subprocess_env;
 
     /* Retrieve cgi variables. */
-    ap_add_cgi_vars( req->req );
-    ap_add_common_vars( req->req );
-
-    /* These were the "include vars"  */
-
-    apr_table_set( table, "DATE_LOCAL",
-            ap_ht_time( TCLWEBPOOL, date, timefmt, 0 ) );
-    apr_table_set( table, "DATE_GMT",
-            ap_ht_time( TCLWEBPOOL, date, timefmt, 1 ) );
-    apr_table_set( table, "LAST_MODIFIED",
-            ap_ht_time( TCLWEBPOOL, req->req->finfo.mtime, timefmt, 1 ) );
-    apr_table_set( table, "DOCUMENT_URI", req->req->uri );
-    apr_table_set( table, "DOCUMENT_PATH_INFO", req->req->path_info );
-
-    if ((t = strrchr(req->req->filename, '/'))) {
-        apr_table_set( table, "DOCUMENT_NAME", ++t );
-    } else {
-        apr_table_set( table, "DOCUMENT_NAME", req->req->uri );
+    if (!ENV_CGI_VARS_LOADED(req->environment_set))
+    {
+        ap_add_cgi_vars(req->req);
+        ENV_CGI_VARS(req->environment_set);
     }
-
-    if( req->req->args ) {
-        char *arg_copy = (char*) apr_pstrdup(TCLWEBPOOL, req->req->args);
-        ap_unescape_url(arg_copy);
-        apr_table_set( table, "QUERY_STRING_UNESCAPED",
-                ap_escape_shell_cmd( TCLWEBPOOL, arg_copy ) );
+    if (!ENV_COMMON_VARS_LOADED(req->environment_set))
+    {
+        ap_add_common_vars(req->req);
+        ENV_COMMON_VARS(req->environment_set)
     }
 
-#ifndef WIN32
-    pw = (struct passwd *) getpwuid(req->req->finfo.user);
-    if( pw ) {
-        //apr_table_set( table, "USER_NAME",
-        //        apr_pstrdup( TCLWEBPOOL, pw->pw_name ) );
-    } else {
-        apr_table_set( table, "USER_NAME",
-                (char*) apr_psprintf( TCLWEBPOOL, "user#%lu",
-                    (unsigned long)req->req->finfo.user ) );
+    /* Loading into 'table' the include vars */
+
+    /* actually this is not necessary. ENV_VARS is modified only here therefore
+     * if it's set this function has been called already
+     * and it should have returned at the beginning of the execution. I keep
+     * it for clarity and uniformity with the CGI variables and in case
+     * the incremental environment control is extended
+     */
+
+    if (!ENV_VARS_LOADED(req->environment_set))
+    {
+        for (idx = 0;idx < invalid_env_var;idx++)
+        {
+            apr_table_set(table,include_env_vars[idx],TclWeb_SelectEnvIncludeVar(private,idx));
+        }
+        ENV_VARS(req->environment_set)
     }
-#endif
 
-    /* Here we create some variables with Rivet internal information. */
+}
 
-    apr_table_set (table, "RIVET_CACHE_FREE",
-            (char*) apr_psprintf (TCLWEBPOOL, "%d",(RIVET_PEEK_INTERP(private,private->running_conf))->cache_free));
-    apr_table_set (table, "RIVET_CACHE_SIZE",
-            (char*) apr_psprintf (TCLWEBPOOL, "%d",(RIVET_PEEK_INTERP(private,private->running_conf))->cache_size));
+static char*
+TclWeb_GetEnvIncludeVar (rivet_thread_private* private,char* key)
+{
+    int idx;
 
-    req->environment_set = 1;
+    for (idx = 0;idx < invalid_env_var; idx++)
+    {
+        const char* include_var_p = include_env_vars[idx];
+        if (strncmp(key,include_var_p,strlen(key) < strlen(include_var_p) ? strlen(key) : strlen(include_var_p)) == 0)
+        {
+            return TclWeb_SelectEnvIncludeVar(private,idx);
+        }
+    }
+    return NULL;
 }
 
 int
@@ -610,21 +725,21 @@ TclWeb_GetHeaderVars(Tcl_Obj *headersvar,rivet_thread_private* private)
 INLINE int
 TclWeb_Base64Encode(char *out, char *in, TclWebRequest *req)
 {
-    out = ap_pbase64encode(TCLWEBPOOL, in);
+    out = ap_pbase64encode(req->req->pool, in);
     return TCL_OK;
 }
 
 INLINE int
 TclWeb_Base64Decode(char *out, char *in, TclWebRequest *req)
 {
-    out = ap_pbase64decode(TCLWEBPOOL, in);
+    out = ap_pbase64decode(req->req->pool, in);
     return TCL_OK;
 }
 
 INLINE int
 TclWeb_EscapeShellCommand(char *out, char *in, TclWebRequest *req)
 {
-    out = ap_escape_shell_cmd(TCLWEBPOOL, in);
+    out = ap_escape_shell_cmd(req->req->pool, in);
     return TCL_OK;
 }
 
@@ -639,7 +754,7 @@ char *TclWeb_StringToUtf(char *in, TclWebRequest *req)
     Tcl_DString dstr;
     Tcl_DStringInit(&dstr);
     Tcl_ExternalToUtfDString(NULL, in, (signed)strlen(in), &dstr);
-    tmp = (char*) apr_pstrdup(TCLWEBPOOL, Tcl_DStringValue(&dstr));
+    tmp = (char*) apr_pstrdup(req->req->pool, Tcl_DStringValue(&dstr));
     Tcl_DStringFree(&dstr);
     return tmp;
 }
@@ -679,7 +794,7 @@ int TclWeb_UploadChannel(char *varname, TclWebRequest *req)
         }
         Tcl_RegisterChannel(req->interp,chan);
 
-        result = Tcl_NewObj();        
+        result = Tcl_NewObj();
         Tcl_SetStringObj(result, Tcl_GetChannelName(chan), -1);
         Tcl_SetObjResult(req->interp, result);
         
@@ -801,23 +916,37 @@ char *
 TclWeb_GetEnvVar(rivet_thread_private* private,char *key)
 {
     char *val;
-    TclWebRequest *req;
-
-    req = private->req;
-    TclWeb_InitEnvVars(private);
+    TclWebRequest *req = private->req;
 
     /* Check to see if it's a header variable first. */
-    val = (char *)apr_table_get( req->req->headers_in, key );
+    val = (char *)apr_table_get (req->req->headers_in,key);
+    if (val) { return val; }
+
+    /* We incrementally prepare subprocess_env */
+    /* CGI common vars first */
 
-    if( !val ) {
-        val = (char *)apr_table_get( req->req->subprocess_env, key );
+    if (!ENV_COMMON_VARS_LOADED(req->environment_set))
+    {
+        ap_add_common_vars(req->req);
+        ENV_COMMON_VARS(req->environment_set)
     }
+    val = (char *)apr_table_get(req->req->subprocess_env,key);
+    if (val) { return val; }
 
-    return val;
+    /* CGI HTTP 1.1 vars */
+
+    if (!ENV_CGI_VARS_LOADED(req->environment_set))
+    {
+        ap_add_cgi_vars(req->req);
+        ENV_CGI_VARS(req->environment_set)
+    }
+    val = (char *)apr_table_get(req->req->subprocess_env,key);
+    if (val) { return val; }
+    return TclWeb_GetEnvIncludeVar(private,key);
 }
 
 char *
-TclWeb_GetVirtualFile( TclWebRequest *req, char *virtualname )
+TclWeb_GetVirtualFile(TclWebRequest *req, char *virtualname)
 {
     request_rec *apreq;
     char *filename = NULL;
diff --git a/src/mod_rivet_ng/mod_rivet_generator.c b/src/mod_rivet_ng/mod_rivet_generator.c
index 9ec8469..65d0f11 100644
--- a/src/mod_rivet_ng/mod_rivet_generator.c
+++ b/src/mod_rivet_ng/mod_rivet_generator.c
@@ -174,7 +174,7 @@ Rivet_SendContent(rivet_thread_private *private,request_rec* r)
                 scripts = Rivet_RunningScripts (private->pool,scripts,newconfig);
 
                 apr_hash_set (interp_obj->per_dir_scripts,rdc->path,strlen(rdc->path),scripts);
-               
+
                 private->running = scripts;
             }
         }
diff --git a/src/mod_rivet_ng/rivetCore.c b/src/mod_rivet_ng/rivetCore.c
index 3c115b1..3ed9d21 100644
--- a/src/mod_rivet_ng/rivetCore.c
+++ b/src/mod_rivet_ng/rivetCore.c
@@ -670,9 +670,9 @@ TCL_CMD_HEADER ( Rivet_Var )
                          "|number|all)");
         return TCL_ERROR;
     }
-    cmd = Tcl_GetString(objv[0]);
+    cmd     = Tcl_GetString(objv[0]);
     command = Tcl_GetString(objv[1]);
-    result = Tcl_NewObj();
+    result  = Tcl_NewObj();
 
     /* determine if var_qs, var_post or var was called */
 
@@ -1417,9 +1417,9 @@ TCL_CMD_HEADER( Rivet_EnvCmd )
         return TCL_ERROR;
     }
 
-    key = Tcl_GetStringFromObj( objv[1], NULL );
+    key = Tcl_GetStringFromObj (objv[1],NULL);
 
-    val = TclWeb_GetEnvVar( private, key );
+    val = TclWeb_GetEnvVar (private,key);
 
     Tcl_SetObjResult(interp, Tcl_NewStringObj( val, -1 ) );
     return TCL_OK;
diff --git a/src/mod_rivet_ng/rivet_types.h b/src/mod_rivet_ng/rivet_types.h
index 04e060b..4f4fd23 100644
--- a/src/mod_rivet_ng/rivet_types.h
+++ b/src/mod_rivet_ng/rivet_types.h
@@ -87,7 +87,7 @@ typedef struct TclWebRequest {
     int             headers_printed;	/* has the header been printed yet? */
     int             headers_set;		/* has the header been set yet? */
     int             content_sent;
-    int             environment_set;	/* have we setup the environment variables? */
+    unsigned int    environment_set;	/* have we setup the environment variables? */
     char*           charset;
 } TclWebRequest;
 
diff --git a/src/rivet.h b/src/rivet.h
index c01d9f9..f3213b1 100644
--- a/src/rivet.h
+++ b/src/rivet.h
@@ -33,6 +33,7 @@ typedef int rivet_req_ctype;
 #define TCL_STORAGE_CLASS DLLEXPORT
 #endif /* BUILD_rivet */
 
+#define MINSTRLEN(s1,s2) strlen(s1) < strlen(s2) ? strlen(s1) : strlen(s2)
 #define STREQU(s1,s2)  (s1[0] == s2[0] && strcmp(s1, s2) == 0)
 #define STRNEQU(s1,s2) (s1[0] == s2[0] && strncmp(s1, s2, strlen(s2)) == 0)
 #define RIVET_NS                "::rivet"
diff --git a/tests/apachetest/template.conf.1.tcl b/tests/apachetest/template.conf.1.tcl
index 5b96c92..b63cacc 100644
--- a/tests/apachetest/template.conf.1.tcl
+++ b/tests/apachetest/template.conf.1.tcl
@@ -1,4 +1,4 @@
-# \$Id\$
+
 # Minimal config file for testing
 
 # Parsed by makeconf.tcl
diff --git a/tests/env.rvt b/tests/env.rvt
index d039ce0..fe45389 100644
--- a/tests/env.rvt
+++ b/tests/env.rvt
@@ -1,7 +1,25 @@
 <?
 
-::rivet::load_env
+if {[::rivet::var_qs exists protocol]} {
 
-puts "env(DOCUMENT_NAME) = $env(DOCUMENT_NAME)\n"
+    puts [::rivet::env SERVER_PROTOCOL]
 
+} else {
+
+    set load_env_f [::rivet::var get load_env 0]
+
+    if {[string is true $load_env_f]} {
+
+        # test env-1.1
+
+        ::rivet::load_env
+        puts "env(DOCUMENT_NAME) = $env(DOCUMENT_NAME)\n"
+    } else {
+
+        # test env-1.2
+
+        set doc_name [::rivet::env DOCUMENT_NAME]
+        puts "env(DOCUMENT_NAME) = $doc_name\n"
+    }
+} 
 ?>
diff --git a/tests/env.test b/tests/env.test
index 05de770..155836c 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -1,9 +1,44 @@
-# $Id$
+#
+# testing how the environment variables resolution 
+# is handled by mod_rivet
+#
 
-set testfilename1 env.rvt
+set rvttestfilename env.rvt
 
 ::tcltest::test env-1.1 {Environment variable} {
-    set page [ ::http::geturl "${urlbase}$testfilename1" ]
-    regexp -line "^env\\(DOCUMENT_NAME\\) = $testfilename1\$" [ ::http::data $page ] match
+    set page [ ::http::geturl "${urlbase}$rvttestfilename?load_env=true" ]
+    regexp -line "^env\\(DOCUMENT_NAME\\) = $rvttestfilename\$" [::http::data $page] match
     set match
-} "env(DOCUMENT_NAME) = $testfilename1"
+} "env(DOCUMENT_NAME) = $rvttestfilename"
+
+::tcltest::test env-1.2 {Environment variable} {
+    set page [ ::http::geturl "${urlbase}$rvttestfilename?load_env=false" ]
+    regexp -line "^env\\(DOCUMENT_NAME\\) = $rvttestfilename\$" [::http::data $page] match
+    set match
+} "env(DOCUMENT_NAME) = $rvttestfilename"
+
+::tcltest::test env-1.2.1 {CGI Environment variable double translation} {
+    set page1 [ ::http::geturl "${urlbase}$rvttestfilename?protocol=1"]
+    set match1 [string trim [::http::data $page1]]
+    set page2 [ ::http::geturl "${urlbase}$rvttestfilename?protocol=1"]
+    set match2 [string trim [::http::data $page2]]
+    #puts "proto: $match1 $match2"
+    expr [string match $match1 $match2]
+} "1"
+
+set envmethod env_methods.tcl
+set env_vars [list "DATE_LOCAL" "DATE_GMT" "LAST_MODIFIED" "DOCUMENT_URI" "DOCUMENT_PATH_INFO" "DOCUMENT_NAME"  \
+                   "QUERY_STRING_UNESCAPED" "RIVET_CACHE_FREE" "RIVET_CACHE_SIZE" "HTTP_ACCEPT" "HTTP_HOST" \
+                   "QUERY_STRING" "SCRIPT_FILENAME" "SERVER_NAME" "SERVER_PORT" "SERVER_PROTOCOL"]
+
+puts "comparing ::rivet::env and ::rivet::load_env for variable resolution"
+foreach v $env_vars {
+    puts -nonewline "$v "
+    ::tcltest::test env-1.3 {Environment variable methods} {
+        set page [::http::geturl "${urlbase}$envmethod?envvar=$v"]
+        ::http::data $page
+    } "$v: OK"
+}
+puts ""
+
+
diff --git a/tests/rivet.test b/tests/rivet.test
index fade49a..6ed3950 100755
--- a/tests/rivet.test
+++ b/tests/rivet.test
@@ -2,6 +2,23 @@
 # the next line restarts using tclsh \
     exec tclsh "$0" "$@"
 
+#   Licensed to the Apache Software Foundation (ASF) under one
+#   or more contributor license agreements.  See the NOTICE file
+#   distributed with this work for additional information
+#   regarding copyright ownership.  The ASF licenses this file
+#   to you under the Apache License, Version 2.0 (the
+#   "License"); you may not use this file except in compliance
+#   with the License.  You may obtain a copy of the License at
+
+#     http://www.apache.org/licenses/LICENSE-2.0
+
+#   Unless required by applicable law or agreed to in writing,
+#   software distributed under the License is distributed on an
+#   "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+#   KIND, either express or implied.  See the License for the
+#   specific language governing permissions and limitations
+#   under the License.
+
 # Rivet test suite, by David N. Welton <da...@apache.org>
 
 # See README file for more information.
@@ -27,8 +44,6 @@ set testgroup1 1
 set testgroup2 1
 set testgroup3 1
 
-#lappend TestList failtest.test
-
 # Run all tests against one server process.
 
 if { $testgroup1 } {

---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@tcl.apache.org
For additional commands, e-mail: commits-help@tcl.apache.org