You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by da...@apache.org on 2002/03/14 22:17:23 UTC
cvs commit: tcl-rivet/src TclWeb.h TclWebapache.c
damonc 02/03/14 13:17:22
Modified: . ChangeLog TODO
rivet/rivet-tcl debug.tcl load_cookies.tcl tclIndex
src TclWeb.h TclWebapache.c
Added: rivet/rivet-tcl cookie.tcl import_keyvalue_pairs.tcl
Removed: rivet/rivet-tcl make_cookie.tcl
Log:
* src/TclWebapache.c
Added a routine to setup the environment variables and mark
that they have been set. This will save us from having to
reload them all the time. Once they're loaded, they don't
load again.
* rivet/rivet-tcl/cookie.tcl
Added a new 'cookie' command for setting and getting cookies.
* rivet/rivet-tcl/import_keyvalue_pairs.tcl
Added a command to import keyvalue pairs from arguments.
* rivet/rivet-tcl/load_cookies.tcl
Made load_cookies use the env command to get the one variable
it needs instead of load_env, which gets a bunch it doesn't
need.
* rivet/rivet-tcl/debug.tcl
Made debug use the env and import_keyvalue_pairs commands.
Revision Changes Path
1.45 +22 -0 tcl-rivet/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /home/cvs/tcl-rivet/ChangeLog,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- ChangeLog 14 Mar 2002 07:02:43 -0000 1.44
+++ ChangeLog 14 Mar 2002 21:17:22 -0000 1.45
@@ -1,3 +1,25 @@
+2002-03-14 Damon J. Courtney <da...@unreality.com>
+
+ * src/TclWebapache.c
+ Added a routine to setup the environment variables and mark
+ that they have been set. This will save us from having to
+ reload them all the time. Once they're loaded, they don't
+ load again.
+
+ * rivet/rivet-tcl/cookie.tcl
+ Added a new 'cookie' command for setting and getting cookies.
+
+ * rivet/rivet-tcl/import_keyvalue_pairs.tcl
+ Added a command to import keyvalue pairs from arguments.
+
+ * rivet/rivet-tcl/load_cookies.tcl
+ Made load_cookies use the env command to get the one variable
+ it needs instead of load_env, which gets a bunch it doesn't
+ need.
+
+ * rivet/rivet-tcl/debug.tcl
+ Made debug use the env and import_keyvalue_pairs commands.
+
2002-03-13 Damon J. Courtney <da...@unreality.com>
* src/mod_rivet.c
1.8 +0 -2 tcl-rivet/TODO
Index: TODO
===================================================================
RCS file: /home/cvs/tcl-rivet/TODO,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- TODO 11 Mar 2002 00:31:10 -0000 1.7
+++ TODO 14 Mar 2002 21:17:22 -0000 1.8
@@ -4,8 +4,6 @@
TODO
====
-* Add a command in Tcl that will return a file relative to the document root.
-
* Write commands after like 'open' and such in the request namespace
that keep track of open file pointers and close them in the cleanup.
1.3 +5 -27 tcl-rivet/rivet/rivet-tcl/debug.tcl
Index: debug.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/rivet/rivet-tcl/debug.tcl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- debug.tcl 24 Jan 2002 16:05:07 -0000 1.2
+++ debug.tcl 14 Mar 2002 21:17:22 -0000 1.3
@@ -24,8 +24,8 @@
## We want to save the REMOTE_ADDR for any subsequent calls to debug.
if {![info exists ::RivetUserConf(REMOTE_ADDR)]} {
- load_env
- set ::RivetUserConf(REMOTE_ADDR) $env(REMOTE_ADDR)
+ set REMOTE_ADDR [env REMOTE_ADDR]
+ set ::RivetUserConf(REMOTE_ADDR) $REMOTE_ADDR
}
@@ -44,29 +44,7 @@
set data(separator) $::RivetUserConf(DebugSeparator)
}
- set looking 0
- set endit 0
- foreach arg $args {
- if $endit {
- lappend list $arg
- continue
- }
- if $looking {
- set data($varName) $arg
- set looking 0
- continue
- }
- if {[string index $arg 0] == "-"} {
- if {$arg == "--"} {
- set endit 1
- continue
- }
- set varName [string range $arg 1 end]
- set looking 1
- continue
- }
- lappend list $arg
- }
+ import_keyvalue_pairs data $args
if {[info exists data(ip)]} {
set can_see 0
@@ -80,12 +58,12 @@
}
if {[string tolower $data(subst)] != "on"} {
- html [join $list]
+ html [join $data(args)]
return
}
set lastWasArray 0
- foreach varName $list {
+ foreach varName $data(args) {
upvar $varName var
if {[array exists var]} {
parray $varName
1.2 +2 -3 tcl-rivet/rivet/rivet-tcl/load_cookies.tcl
Index: load_cookies.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/rivet/rivet-tcl/load_cookies.tcl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- load_cookies.tcl 11 Mar 2002 00:31:10 -0000 1.1
+++ load_cookies.tcl 14 Mar 2002 21:17:22 -0000 1.2
@@ -1,10 +1,9 @@
proc load_cookies {{arrayName cookies}} {
upvar 1 $arrayName cookies
- load_env
- if {![info exists env(HTTP_COOKIE)]} { return }
+ set HTTP_COOKIES [env HTTP_COOKIES]
- foreach pair [split $env(HTTP_COOKIE) ";"] {
+ foreach pair [split $HTTP_COOKIE ";"] {
set pair [split [string trim $pair] "="]
set key [lindex $pair 0]
set value [lindex $pair 1]
1.7 +8 -7 tcl-rivet/rivet/rivet-tcl/tclIndex
Index: tclIndex
===================================================================
RCS file: /home/cvs/tcl-rivet/rivet/rivet-tcl/tclIndex,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- tclIndex 11 Mar 2002 22:54:42 -0000 1.6
+++ tclIndex 14 Mar 2002 21:17:22 -0000 1.7
@@ -6,17 +6,18 @@
# element name is the name of a command and the value is
# a script that loads the command.
-set auto_index(load_response) [list source [file join $dir load_response.tcl]]
-set auto_index(parray) [list source [file join $dir parray.tcl]]
+set auto_index(debug) [list source [file join $dir debug.tcl]]
+set auto_index(lassign) [list source [file join $dir lassign.tcl]]
set auto_index(html) [list source [file join $dir html.tcl]]
set auto_index(incr0) [list source [file join $dir incr0.tcl]]
+set auto_index(load_response) [list source [file join $dir load_response.tcl]]
+set auto_index(parray) [list source [file join $dir parray.tcl]]
set auto_index(read_file) [list source [file join $dir read_file.tcl]]
set auto_index(wrap) [list source [file join $dir wrap.tcl]]
set auto_index(wrapline) [list source [file join $dir wrap.tcl]]
-set auto_index(debug) [list source [file join $dir debug.tcl]]
set auto_index(lempty) [list source [file join $dir lempty.tcl]]
-set auto_index(lassign) [list source [file join $dir lassign.tcl]]
set auto_index(load_cookies) [list source [file join $dir load_cookies.tcl]]
-set auto_index(clock_to_rfc850_gmt) [list source [file join $dir make_cookie.tcl]]
-set auto_index(make_cookie_attributes) [list source [file join $dir make_cookie.tcl]]
-set auto_index(make_cookie) [list source [file join $dir make_cookie.tcl]]
+set auto_index(clock_to_rfc850_gmt) [list source [file join $dir cookie.tcl]]
+set auto_index(make_cookie_attributes) [list source [file join $dir cookie.tcl]]
+set auto_index(cookie) [list source [file join $dir cookie.tcl]]
+set auto_index(import_keyvalue_pairs) [list source [file join $dir import_keyvalue_pairs.tcl]]
1.1 tcl-rivet/rivet/rivet-tcl/cookie.tcl
Index: cookie.tcl
===================================================================
##
## Convert an integer-seconds-since-1970 click value to RFC850 format,
## with the additional requirement that it be GMT only.
##
proc clock_to_rfc850_gmt {seconds} {
return [clock format $seconds -format "%a, %d-%b-%y %T GMT" -gmt 1]
}
proc make_cookie_attributes {paramsArray} {
upvar 1 $paramsArray params
set cookieParams ""
set expiresIn 0
foreach {time num} [list days 86400 hours 3600 minutes 60] {
if [info exists params($time)] {
incr expiresIn [expr $params($time) * $num]
}
}
if {$expiresIn != 0} {
set secs [expr [clock seconds] + $expiresIn]
append cookieParams "; expires=[clock_to_rfc850_gmt $secs]"
}
if [info exists params(path)] {
append cookieParams "; path=$params(path)"
}
if [info exists params(domain)] {
append cookieParams "; domain=$params(domain)"
}
if {[info exists params(secure)] && $params(secure) == 1} {
append cookieParams "; secure"
}
return $cookieParams
}
## cookie [set|get] cookieName ?cookieValue? [-days expireInDays]
## [-hours expireInHours] [-minutes expireInMinutes]
## [-path uriPathCookieAppliesTo]
## [-secure 1|0]
##
proc cookie {cmd name args} {
set badchars "\[ \t;\]"
switch -- $cmd {
"set" {
set value [lindex $args 0]
set args [lrange $args 1 end]
import_keyvalue_pairs params $args
if {[regexp $badchars $name]} {
return -code error \
"name may not contain semicolons, spaces, or tabs"
}
if {[regexp $badchars $value]} {
return -code error \
"value may not contain semicolons, spaces, or tabs"
}
set cookieKey "Set-cookie"
set cookieValue "$name=$value"
append cookieValue [make_cookie_attributes params]
headers set $cookieKey $cookieValue
}
"get" {
::request::global RivetCookies
if {![array exists RivetCookies]} { load_cookies RivetCookies }
if {![info exists RivetCookies($name)]} { return }
return $RivetCookies($name)
}
}
}
1.1 tcl-rivet/rivet/rivet-tcl/import_keyvalue_pairs.tcl
Index: import_keyvalue_pairs.tcl
===================================================================
proc import_keyvalue_pairs {arrayName argsList} {
upvar 1 $arrayName data
if {[string index $argsList 0] != "-"} {
set data(args) $argsList
return
}
set endit 0
set looking 0
set data(args) ""
foreach arg $argsList {
if {$endit} {
lappend data(args) $arg
} elseif {$looking} {
set data($varName) $arg
set looking 0
} elseif {[string index $arg 0] == "-"} {
if {$arg == "--"} {
set endit 1
continue
}
if {$arg == "-args"} {
return -code error "-args is a reserved value."
}
set varName [string range $arg 1 end]
set looking 1
} else {
lappend data(args) $arg
}
}
}
1.12 +4 -3 tcl-rivet/src/TclWeb.h
Index: TclWeb.h
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWeb.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- TclWeb.h 12 Mar 2002 06:51:57 -0000 1.11
+++ TclWeb.h 14 Mar 2002 21:17:22 -0000 1.12
@@ -5,7 +5,7 @@
* Common API layer.
*/
-/* $Id: TclWeb.h,v 1.11 2002/03/12 06:51:57 damonc Exp $ */
+/* $Id: TclWeb.h,v 1.12 2002/03/14 21:17:22 damonc Exp $ */
/* Error wrappers */
#define ER1 "<hr><p><code><pre>\n"
@@ -19,9 +19,10 @@
request_rec *req;
ApacheRequest *apachereq;
ApacheUpload *upload;
- int headers_printed; /* has the header been printed yet? */
- int headers_set; /* has the header been set yet? */
+ 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? */
} TclWebRequest;
/*
1.19 +23 -13 tcl-rivet/src/TclWebapache.c
Index: TclWebapache.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWebapache.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- TclWebapache.c 14 Mar 2002 00:18:59 -0000 1.18
+++ TclWebapache.c 14 Mar 2002 21:17:22 -0000 1.19
@@ -7,7 +7,7 @@
* operations.
*/
-/* $Id: TclWebapache.c,v 1.18 2002/03/14 00:18:59 damonc Exp $ */
+/* $Id: TclWebapache.c,v 1.19 2002/03/14 21:17:22 damonc Exp $ */
#include <tcl.h>
@@ -32,6 +32,7 @@
req->apachereq = ApacheRequest_new(r);
req->headers_printed = 0;
req->headers_set = 0;
+ req->environment_set = 0;
return TCL_OK;
}
@@ -285,6 +286,25 @@
return TCL_OK;
}
+/*
+ * Load the Apache environment and CGI variables into the request. If we
+ * have already done so, we don't need to do it again.
+ */
+static void
+TclWeb_InitEnvVars( TclWebRequest *req )
+{
+ if( req->environment_set ) return;
+
+ /* Ensure that the system area which holds the cgi variables is empty. */
+ ap_clear_table(req->req->subprocess_env);
+
+ /* Retrieve cgi variables. */
+ ap_add_cgi_vars(req->req);
+ ap_add_common_vars(req->req);
+
+ req->environment_set = 1;
+}
+
int
TclWeb_GetEnvVars(Tcl_Obj *envvar, TclWebRequest *req)
{
@@ -303,12 +323,8 @@
rivet_server_conf *rsc = NULL;
date = req->req->request_time;
- /* ensure that the system area which holds the cgi variables is empty */
- ap_clear_table(req->req->subprocess_env);
- /* retrieve cgi variables */
- ap_add_cgi_vars(req->req);
- ap_add_common_vars(req->req);
+ TclWeb_InitEnvVars( req );
hdrs_arr = ap_table_elts(req->req->headers_in);
hdrs = (table_entry *) hdrs_arr->elts;
@@ -581,13 +597,7 @@
(const char *)val = ap_table_get( req->req->headers_in, key );
if( !val ) {
- /* Ensure that the system area which holds the cgi variables is empty */
- ap_clear_table( req->req->subprocess_env );
-
- /* Retrieve cgi variables */
- ap_add_cgi_vars( req->req );
- ap_add_common_vars( req->req );
-
+ TclWeb_InitEnvVars( req );
(const char *)val = ap_table_get( req->req->subprocess_env, key );
}
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-dev-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-dev-help@tcl.apache.org