davidw 02/01/21 17:27:57
Modified: . ChangeLog
src TclWeb.h TclWebapache.c make.tcl mod_rivet.c
mod_rivet.h rivetCore.c rivetCrypt.c rivetList.c
Log:
* src/rivetList.c (Rivet_LassignArrayObjCmd): Use -1 instead of NULL
when doing NewStringObj.
* src/rivetCrypt.c: Added header file.
* src/make.tcl: Added slightly nicer apxs handling.
* src/mod_rivet.c: Moved StringToUtf to TclWeb.
* src/mod_rivet.h: Removed StringToUtf macro.
* src/TclWebapache.c: Lots of bug fixes and corrections.
* src/rivetCore.c (Rivet_LoadEnv): Switched to TclWeb API.
(Rivet_LoadCookies): Switched to TclWeb API. (Rivet_Var): Switched
to TclWeb API.
Revision Changes Path
1.23 +19 -0 tcl-rivet/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /home/cvs/tcl-rivet/ChangeLog,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- ChangeLog 19 Jan 2002 23:27:01 -0000 1.22
+++ ChangeLog 22 Jan 2002 01:27:56 -0000 1.23
@@ -1,3 +1,22 @@
+2002-01-22 David N. Welton <[EMAIL PROTECTED]>
+
+ * src/rivetList.c (Rivet_LassignArrayObjCmd): Use -1 instead of
+ NULL when doing NewStringObj.
+
+ * src/rivetCrypt.c: Added header file.
+
+ * src/make.tcl: Added slightly nicer apxs handling.
+
+ * src/mod_rivet.c: Moved StringToUtf to TclWeb.
+
+ * src/mod_rivet.h: Removed StringToUtf macro.
+
+ * src/TclWebapache.c: Lots of bug fixes and corrections.
+
+ * src/rivetCore.c (Rivet_LoadEnv): Switched to TclWeb API.
+ (Rivet_LoadCookies): Switched to TclWeb API.
+ (Rivet_Var): Switched to TclWeb API.
+
2002-01-19 Damon J. Courtney <[EMAIL PROTECTED]>
* src/rivetCore.c
1.4 +29 -10 tcl-rivet/src/TclWeb.h
Index: TclWeb.h
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWeb.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- TclWeb.h 19 Jan 2002 16:11:52 -0000 1.3
+++ TclWeb.h 22 Jan 2002 01:27:56 -0000 1.4
@@ -1,8 +1,20 @@
+#ifndef TCLWEB_H
+#define TCLWEB_H
/*
* TclWeb.c --
* Common API layer.
*/
+/* $Id: TclWeb.h,v 1.4 2002/01/22 01:27:56 davidw Exp $ */
+
+#define DEFAULT_TIME_FORMAT "%A, %d-%b-%Y %H:%M:%S %Z"
+
+typedef struct TclWebRequest {
+ Tcl_Interp *interp;
+ request_rec *req;
+ ApacheRequest *apachereq;
+} TclWebRequest;
+
/*
*-----------------------------------------------------------------------------
*
@@ -12,7 +24,7 @@
*-----------------------------------------------------------------------------
*/
-int TclWeb_InitRequest(TclWebRequest *req, void *arg);
+int TclWeb_InitRequest(TclWebRequest *req, Tcl_Interp *interp, void *arg);
/*
@@ -53,20 +65,21 @@
int TclWeb_SetStatus(int status, TclWebRequest *req);
+int TclWeb_GetVar(Tcl_Obj *result, char *varname, TclWebRequest *req);
-/*
-
*-----------------------------------------------------------------------------
- *
- * TclWeb_Cookie --
- * Make cookie.
- *
-
*-----------------------------------------------------------------------------
- */
+int TclWeb_GetVarAsList(Tcl_Obj *result, char *varname, TclWebRequest *req);
+
+int TclWeb_VarExists(Tcl_Obj *result, char *varname, TclWebRequest *req);
+
+int TclWeb_VarNumber(Tcl_Obj *result, TclWebRequest *req);
+
+int TclWeb_GetVarNames(Tcl_Obj *result, TclWebRequest *req);
+int TclWeb_GetAllVars(Tcl_Obj *result, TclWebRequest *req);
int TclWeb_GetCookieVars(Tcl_Obj *cookievar, TclWebRequest *req);
-int TclWeb_GetEnvVars(Tcl_Obj *envs, TclWebRequest *req);
+int TclWeb_GetEnvVars(Tcl_Obj *envvar, TclWebRequest *req);
/* upload stuff goes here */
@@ -76,6 +89,12 @@
int TclWeb_EscapeShellCommand(char *out, char *in, TclWebRequest *req);
+char *TclWeb_StringToUtf(char *in, TclWebRequest *req);
+
+Tcl_Obj * TclWeb_StringToUtfToObj(char *in, TclWebRequest *req);
+
/* output/write/flush? */
/* error (log) ? */
+
+#endif /* TCLWEB_H */
1.4 +81 -71 tcl-rivet/src/TclWebapache.c
Index: TclWebapache.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWebapache.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- TclWebapache.c 19 Jan 2002 16:11:52 -0000 1.3
+++ TclWebapache.c 22 Jan 2002 01:27:56 -0000 1.4
@@ -7,30 +7,25 @@
* operations.
*/
-/* $Id: TclWebapache.c,v 1.3 2002/01/19 16:11:52 davidw Exp $ */
+/* $Id: TclWebapache.c,v 1.4 2002/01/22 01:27:56 davidw Exp $ */
#include <tcl.h>
#include "apache_request.h"
#include "apache_cookie.h"
-#include "mod_rivet.h"
+#include "TclWeb.h"
#define TCLWEBPOOL req->req->pool
-typedef struct TclWebRequest {
- Tcl_Interp *interp;
- request_rec *req;
- ApacheRequest *apachereq;
-} TclWebRequest;
-
-#include "TclWeb.h"
-
int
-TclWeb_InitRequest(TclWebRequest *req, void *arg)
+TclWeb_InitRequest(TclWebRequest *req, Tcl_Interp *interp, void *arg)
{
- req = (TclWebRequest *)Tcl_Alloc(sizeof(TclWebRequest));
- req->req = (request_rec *)arg;
- req->apachereq = ApacheRequest_new(req->req);
+ request_rec *r;
+
+ r = (request_rec *)arg;
+ req->interp = interp;
+ req->req = r;
+ req->apachereq = ApacheRequest_new(r);
return TCL_OK;
}
@@ -62,34 +57,37 @@
int i;
array_header *parmsarray = ap_table_elts(req->apachereq->parms);
table_entry *parms = (table_entry *)parmsarray->elts;
-
- result = NULL;
+ int flag = 0;
/* This isn't real efficient - move to hash table later
on... */
for (i = 0; i < parmsarray->nelts; ++i)
{
- if (!strncmp(varname, Rivet_StringToUtf(parms[i].key, TCLWEBPOOL),
strlen(varname)))
+ if (!strncmp(varname, TclWeb_StringToUtf(parms[i].key, req),
+ strlen(varname)))
{
/* The following makes sure that we get one string,
with no sub lists. */
- if (result == NULL)
+ if (flag == 0)
{
- result = STRING_TO_UTF_TO_OBJ(parms[i].val, TCLWEBPOOL);
+ flag = 1;
+ Tcl_SetStringObj(result,
+ TclWeb_StringToUtf(parms[i].val, req), -1);
Tcl_IncrRefCount(result);
} else {
+ Tcl_Obj *tmpobj;
Tcl_Obj *tmpobjv[2];
tmpobjv[0] = result;
- tmpobjv[1] = STRING_TO_UTF_TO_OBJ(parms[i].val, TCLWEBPOOL);
- result = Tcl_ConcatObj(2, tmpobjv);
+ tmpobjv[1] = TclWeb_StringToUtfToObj(parms[i].val, req);
+ tmpobj = Tcl_ConcatObj(2, tmpobjv);
+ Tcl_SetStringObj(result, Tcl_GetString(tmpobj), -1);
}
}
}
if (result == NULL)
{
- result = Tcl_NewStringObj("", -1);
- Tcl_IncrRefCount(result);
+ return TCL_ERROR;
}
return TCL_OK;
@@ -105,22 +103,17 @@
/* This isn't real efficient - move to hash table later on. */
for (i = 0; i < parmsarray->nelts; ++i)
{
- if (!strncmp(varname, Rivet_StringToUtf(parms[i].key, TCLWEBPOOL),
strlen(varname)))
+
+ if (!strncmp(varname, TclWeb_StringToUtf(parms[i].key, req),
strlen(varname)))
{
- if (result == NULL)
- {
- result = Tcl_NewObj();
- Tcl_IncrRefCount(result);
- }
Tcl_ListObjAppendElement(req->interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].val,
TCLWEBPOOL));
+ TclWeb_StringToUtfToObj(parms[i].val,
req));
}
}
if (result == NULL)
{
- result = Tcl_NewStringObj("", -1);
- Tcl_IncrRefCount(result);
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -132,22 +125,18 @@
array_header *parmsarray = ap_table_elts(req->apachereq->parms);
table_entry *parms = (table_entry *)parmsarray->elts;
- result = Tcl_NewObj();
- Tcl_IncrRefCount(result);
for (i = 0; i < parmsarray->nelts; ++i)
{
Tcl_ListObjAppendElement(req->interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].key,
TCLWEBPOOL));
+ TclWeb_StringToUtfToObj(parms[i].key, req));
Tcl_ListObjAppendElement(req->interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].val,
TCLWEBPOOL));
+ TclWeb_StringToUtfToObj(parms[i].val, req));
}
if (result == NULL)
{
- result = Tcl_NewStringObj("", -1);
- Tcl_IncrRefCount(result);
+ return TCL_ERROR;
}
-
return TCL_OK;
}
@@ -158,28 +147,22 @@
array_header *parmsarray = ap_table_elts(req->apachereq->parms);
table_entry *parms = (table_entry *)parmsarray->elts;
- result = Tcl_NewObj();
- Tcl_IncrRefCount(result);
-
- result = Tcl_NewObj();
- Tcl_IncrRefCount(result);
for (i = 0; i < parmsarray->nelts; ++i)
{
Tcl_ListObjAppendElement(req->interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].key,
TCLWEBPOOL));
+ TclWeb_StringToUtfToObj(parms[i].key, req));
}
if (result == NULL)
{
- result = Tcl_NewStringObj("", -1);
- Tcl_IncrRefCount(result);
+ return TCL_ERROR;
}
return TCL_OK;
}
int
-TclWeb_VarExists(char *varname, TclWebRequest *req)
+TclWeb_VarExists(Tcl_Obj *result, char *varname, TclWebRequest *req)
{
int i;
array_header *parmsarray = ap_table_elts(req->apachereq->parms);
@@ -188,12 +171,16 @@
/* This isn't real efficient - move to hash table later on. */
for (i = 0; i < parmsarray->nelts; ++i)
{
- if (!strncmp(varname, Rivet_StringToUtf(parms[i].key, TCLWEBPOOL),
strlen(varname)))
+ if (!strncmp(varname, TclWeb_StringToUtf(parms[i].key, req),
strlen(varname)))
{
+ Tcl_SetIntObj(result, 1);
+ Tcl_IncrRefCount(result);
return TCL_OK;
}
}
- return TCL_ERROR;
+ Tcl_SetIntObj(result, 0);
+ Tcl_IncrRefCount(result);
+ return TCL_OK;
}
int
@@ -201,7 +188,7 @@
{
array_header *parmsarray = ap_table_elts(req->apachereq->parms);
- result = Tcl_NewIntObj(parmsarray->nelts);
+ Tcl_SetIntObj(result, parmsarray->nelts);
Tcl_IncrRefCount(result);
return TCL_OK;
}
@@ -236,7 +223,6 @@
#endif /* ndef WIN32 */
char *t;
time_t date;
-
int i;
array_header *hdrs_arr;
@@ -260,38 +246,39 @@
/* These were the "include vars" */
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DATE_LOCAL", -1),
- STRING_TO_UTF_TO_OBJ(ap_ht_time(TCLWEBPOOL,
- date, timefmt, 0), TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(ap_ht_time(TCLWEBPOOL, date,
timefmt, 0), req), 0);
+
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DATE_GMT", -1),
- STRING_TO_UTF_TO_OBJ(ap_ht_time(TCLWEBPOOL,
- date, timefmt, 1), TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(ap_ht_time(TCLWEBPOOL, date,
timefmt, 1), req), 0);
+
+
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("LAST_MODIFIED",
-1),
- STRING_TO_UTF_TO_OBJ(ap_ht_time(TCLWEBPOOL,
- req->req->finfo.st_mtime,
- timefmt, 0), TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(ap_ht_time(TCLWEBPOOL,
+ req->req->finfo.st_mtime,
+ timefmt, 1), req), 0);
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DOCUMENT_URI", -1),
- STRING_TO_UTF_TO_OBJ(req->req->uri, TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(req->req->uri, req), 0);
Tcl_ObjSetVar2(req->interp, envvar,
Tcl_NewStringObj("DOCUMENT_PATH_INFO", -1),
- STRING_TO_UTF_TO_OBJ(req->req->path_info, TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(req->req->path_info, req), 0);
#ifndef WIN32
pw = getpwuid(req->req->finfo.st_uid);
if (pw)
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("USER_NAME", -1),
- STRING_TO_UTF_TO_OBJ(ap_pstrdup(TCLWEBPOOL, pw->pw_name),
TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(ap_pstrdup(TCLWEBPOOL, pw->pw_name),
req), 0);
else
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("USER_NAME", -1),
- STRING_TO_UTF_TO_OBJ(
+ TclWeb_StringToUtfToObj(
ap_psprintf(TCLWEBPOOL, "user#%lu",
- (unsigned long)req->req->finfo.st_uid), TCLWEBPOOL),
0);
+ (unsigned long)req->req->finfo.st_uid), req), 0);
#endif
if ((t = strrchr(req->req->filename, '/')))
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DOCUMENT_NAME",
-1),
- STRING_TO_UTF_TO_OBJ(++t, TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(++t, req), 0);
else
Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DOCUMENT_NAME",
-1),
- STRING_TO_UTF_TO_OBJ(req->req->uri, TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(req->req->uri, req), 0);
if (req->req->args)
{
@@ -299,7 +286,7 @@
ap_unescape_url(arg_copy);
Tcl_ObjSetVar2(req->interp, envvar,
Tcl_NewStringObj("QUERY_STRING_UNESCAPED", -1),
- STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(TCLWEBPOOL, arg_copy),
TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(ap_escape_shell_cmd(TCLWEBPOOL, arg_copy),
req), 0);
}
/* ---------------------------- */
@@ -311,8 +298,8 @@
continue;
else {
Tcl_ObjSetVar2(req->interp, envvar,
- STRING_TO_UTF_TO_OBJ(hdrs[i].key, TCLWEBPOOL),
- STRING_TO_UTF_TO_OBJ(hdrs[i].val, TCLWEBPOOL), 0);
+ TclWeb_StringToUtfToObj(hdrs[i].key, req),
+ TclWeb_StringToUtfToObj(hdrs[i].val, req), 0);
}
}
@@ -321,8 +308,8 @@
{
if (!env[i].key)
continue;
- Tcl_ObjSetVar2(req->interp, envvar, STRING_TO_UTF_TO_OBJ(env[i].key,
TCLWEBPOOL),
- STRING_TO_UTF_TO_OBJ(env[i].val, TCLWEBPOOL), 0);
+ Tcl_ObjSetVar2(req->interp, envvar, TclWeb_StringToUtfToObj(env[i].key,
req),
+ TclWeb_StringToUtfToObj(env[i].val, req), 0);
}
/* cleanup system cgi variables */
@@ -350,6 +337,29 @@
{
out = ap_escape_shell_cmd(TCLWEBPOOL, in);
return TCL_OK;
+}
+
+/* Functions to convert strings to UTF encoding */
+
+/* These API's are a bit different, because it's so much more
+ * practical. */
+
+char *TclWeb_StringToUtf(char *in, TclWebRequest *req)
+{
+ char *tmp;
+ Tcl_DString dstr;
+ Tcl_DStringInit(&dstr);
+ Tcl_ExternalToUtfDString(NULL, in, (signed)strlen(in), &dstr);
+
+ tmp = ap_pstrdup(TCLWEBPOOL, Tcl_DStringValue(&dstr));
+ Tcl_DStringFree(&dstr);
+ return tmp;
+}
+
+Tcl_Obj *
+TclWeb_StringToUtfToObj(char *in, TclWebRequest *req)
+{
+ return Tcl_NewStringObj(TclWeb_StringToUtf(in, req), -1);
}
/* output/write/flush? */
1.14 +22 -7 tcl-rivet/src/make.tcl
Index: make.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/src/make.tcl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- make.tcl 19 Jan 2002 23:27:01 -0000 1.13
+++ make.tcl 22 Jan 2002 01:27:56 -0000 1.14
@@ -2,7 +2,7 @@
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
-# $Id: make.tcl,v 1.13 2002/01/19 23:27:01 damonc Exp $
+# $Id: make.tcl,v 1.14 2002/01/22 01:27:56 davidw Exp $
# this file actually runs things, making use of the aardvark build
# system.
@@ -16,15 +16,30 @@
# add variables
-set APXS "/usr/local/apache/bin/apxs"
+if { [file executable "/usr/local/apache/bin/apxs"] == 1 } {
+ set APXS "/usr/local/apache/bin/apxs"
+} else {
+ # edit here
+ set APXS "apxs"
+}
+
+if { [catch {
+ set INCLUDEDIR [exec $APXS -q INCLUDEDIR]
+ set LIBEXECDIR [exec $APXS -q LIBEXECDIR]
+ set PREFIX [exec $APXS -q PREFIX]
+} err] != 0 } {
+ puts stderr $err
+ puts stderr "You need to edit 'make.tcl' to supply the location of
Apache's apxs tool"
+ exit 1
+}
-set INC "-I[exec $APXS -q INCLUDEDIR] -I$TCL_PREFIX/include"
+set INC "-I$INCLUDEDIR -I$TCL_PREFIX/include"
set COMPILE "$TCL_CC $TCL_CFLAGS_DEBUG $TCL_CFLAGS_OPTIMIZE
$TCL_CFLAGS_WARNING $TCL_SHLIB_CFLAGS $INC $TCL_EXTRA_CFLAGS -c"
set MOD_STLIB mod_rivet.a
set MOD_SHLIB mod_rivet[info sharedlibextension]
-set MOD_OBJECTS "apache_cookie.o apache_multipart_buffer.o apache_request.o
channel.o parser.o rivetCore.o mod_rivet.o"
+set MOD_OBJECTS "apache_cookie.o apache_multipart_buffer.o apache_request.o
channel.o parser.o rivetCore.o mod_rivet.o TclWebapache.o"
set LIB_STLIB librivet.a
set LIB_SHLIB librivet[info sharedlibextension]
@@ -125,7 +140,7 @@
}
AddNode module {
- depends "TclWebapache.o shared"
+ depends "shared"
}
AddNode shared {
@@ -153,8 +168,8 @@
AddNode install {
depends "$MOD_SHLIB $LIB_SHLIB"
- tclcommand "file copy -force $MOD_SHLIB [exec $APXS -q LIBEXECDIR]"
- tclcommand "file copy -force ../rivet [exec $APXS -q PREFIX]"
+ tclcommand "file copy -force $MOD_SHLIB $LIBEXECDIR"
+ tclcommand "file copy -force ../rivet $PREFIX"
tclcommand "file copy -force $LIB_SHLIB ../rivet/packages/rivet"
}
1.24 +8 -22 tcl-rivet/src/mod_rivet.c
Index: mod_rivet.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/mod_rivet.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- mod_rivet.c 19 Jan 2002 23:27:01 -0000 1.23
+++ mod_rivet.c 22 Jan 2002 01:27:56 -0000 1.24
@@ -55,7 +55,7 @@
* originally written at the National Center for Supercomputing Applications,
* University of Illinois, Urbana-Champaign. */
-/* $Id: mod_rivet.c,v 1.23 2002/01/19 23:27:01 damonc Exp $ */
+/* $Id: mod_rivet.c,v 1.24 2002/01/22 01:27:56 davidw Exp $ */
/* mod_rivet.c by David Welton <[EMAIL PROTECTED]>
* and Damon Courtney <[EMAIL PROTECTED]>
@@ -156,20 +156,6 @@
return 0;
}
-/* Function to convert strings to UTF encoding */
-char *
-Rivet_StringToUtf(char *input, ap_pool *pool)
-{
- char *temp;
- Tcl_DString dstr;
- Tcl_DStringInit(&dstr);
- Tcl_ExternalToUtfDString(NULL, input, (signed)strlen(input), &dstr);
-
- temp = ap_pstrdup(pool, Tcl_DStringValue(&dstr));
- Tcl_DStringFree(&dstr);
- return temp;
-}
-
/* Function to be used should we desire to upload files to a variable */
#if 0
@@ -483,6 +469,7 @@
rsc = Rivet_GetConf(r);
globals = ap_pcalloc(r->pool, sizeof(rivet_interp_globals));
globals->r = r;
+ globals->req = (TclWebRequest *)ap_pcalloc(r->pool,
sizeof(TclWebRequest));
interp = rsc->server_interp;
Tcl_SetAssocData(interp, "rivet", NULL, globals);
@@ -528,20 +515,19 @@
/* Apache Request stuff */
- globals->req = ApacheRequest_new(r);
-
- ApacheRequest_set_post_max(globals->req, rsc->upload_max);
- ApacheRequest_set_temp_dir(globals->req, rsc->upload_dir);
+ TclWeb_InitRequest(globals->req, interp, r);
+ ApacheRequest_set_post_max(globals->req->apachereq, rsc->upload_max);
+ ApacheRequest_set_temp_dir(globals->req->apachereq, rsc->upload_dir);
#if 0
if (upload_files_to_var)
{
- globals->req->hook_data = interp;
- globals->req->upload_hook = Rivet_UploadHook;
+ globals->req->apachereq->hook_data = interp;
+ globals->req->apachereq->upload_hook = Rivet_UploadHook;
}
#endif
- if ((errstatus = ApacheRequest___parse(globals->req)) != OK)
+ if ((errstatus = ApacheRequest___parse(globals->req->apachereq)) != OK)
return errstatus;
Rivet_ParseExecFile(r, rsc, r->filename, 1);
1.13 +2 -5 tcl-rivet/src/mod_rivet.h
Index: mod_rivet.h
===================================================================
RCS file: /home/cvs/tcl-rivet/src/mod_rivet.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- mod_rivet.h 9 Jan 2002 21:42:44 -0000 1.12
+++ mod_rivet.h 22 Jan 2002 01:27:56 -0000 1.13
@@ -3,6 +3,7 @@
#include <tcl.h>
#include "apache_request.h"
+#include "TclWeb.h"
/* init.tcl file relative to the server root directory */
#define RIVET_DIR "rivet"
@@ -76,18 +77,14 @@
typedef struct {
request_rec *r; /* request rec */
- ApacheRequest *req; /* libapreq request */
+ TclWebRequest *req; /* TclWeb API request */
} rivet_interp_globals;
int Rivet_ParseExecFile(request_rec *r, rivet_server_conf *rsc, char
*filename, int toplevel);
int Rivet_SetHeaderType(request_rec *, char *);
int Rivet_PrintHeaders(request_rec *);
int Rivet_PrintError(request_rec *, int, char *);
-char *Rivet_StringToUtf(char *input, ap_pool *pool);
rivet_server_conf *Rivet_GetConf(request_rec *r);
-
-/* Macro to Tcl Objectify StringToUtf stuff */
-#define STRING_TO_UTF_TO_OBJ(string, pool)
Tcl_NewStringObj(Rivet_StringToUtf(string, pool), -1)
#define RIVET_SERVER_CONF(module) (rivet_server_conf
*)ap_get_module_config(module, &rivet_module)
1.7 +29 -234 tcl-rivet/src/rivetCore.c
Index: rivetCore.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivetCore.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- rivetCore.c 19 Jan 2002 23:27:01 -0000 1.6
+++ rivetCore.c 22 Jan 2002 01:27:56 -0000 1.7
@@ -2,7 +2,7 @@
* rivetCore.c - Core commands which are compiled into mod_rivet itself.
*/
-/* $Id: rivetCore.c,v 1.6 2002/01/19 23:27:01 damonc Exp $ */
+/* $Id: rivetCore.c,v 1.7 2002/01/22 01:27:56 davidw Exp $ */
#include "httpd.h"
#include "http_config.h"
@@ -21,6 +21,7 @@
#include "apache_cookie.h"
#include "mod_rivet.h"
#include "rivet.h"
+#include "TclWeb.h"
#define BUFSZ 4096
@@ -273,24 +274,8 @@
int objc,
Tcl_Obj *CONST objv[])
{
- char *timefmt = DEFAULT_TIME_FORMAT;
- char *auth = NULL;
-#ifndef WIN32
- struct passwd *pw;
-#endif /* ndef WIN32 */
- char *t;
-
- time_t date;
-
- int i;
-
- rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
-
- array_header *hdrs_arr;
- table_entry *hdrs;
- array_header *env_arr;
- table_entry *env;
Tcl_Obj *ArrayObj;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
if( objc > 2 ) {
Tcl_WrongNumArgs( interp, 1, objv, "?arrayName?" );
@@ -304,112 +289,8 @@
}
Tcl_IncrRefCount( ArrayObj );
- date = globals->r->request_time;
- /* ensure that the system area which holds the cgi variables is empty */
- ap_clear_table(globals->r->subprocess_env);
-
- /* retrieve cgi variables */
- ap_add_cgi_vars(globals->r);
- ap_add_common_vars(globals->r);
-
- hdrs_arr = ap_table_elts(globals->r->headers_in);
- hdrs = (table_entry *) hdrs_arr->elts;
-
- env_arr = ap_table_elts(globals->r->subprocess_env);
- env = (table_entry *) env_arr->elts;
-
- /* Get the user/pass info for Basic authentication */
- (const char*)auth = ap_table_get(globals->r->headers_in,
"Authorization");
- if ( auth && STREQU(ap_getword_nc(POOL, &auth, ' '), "Basic") )
- {
- char *tmp;
- char *user;
- char *pass;
-
- tmp = ap_pbase64decode(POOL, auth);
- user = ap_getword_nulls_nc(POOL, &tmp, ':');
- pass = tmp;
- Tcl_ObjSetVar2(interp, ArrayObj,
- Tcl_NewStringObj("HTTP_USER", -1),
- STRING_TO_UTF_TO_OBJ(user, POOL),
- 0);
- Tcl_ObjSetVar2(interp, ArrayObj,
- Tcl_NewStringObj("HTTP_PASS", -1),
- STRING_TO_UTF_TO_OBJ(pass, POOL),
- 0);
- }
-
- /* These were the "include vars" */
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DATE_LOCAL", -1),
- STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL,
- date, timefmt, 0), POOL), 0);
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DATE_GMT", -1),
- STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL,
- date, timefmt, 1), POOL), 0);
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("LAST_MODIFIED", -1),
- STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL,
- globals->r->finfo.st_mtime,
- timefmt, 0), POOL), 0);
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_URI", -1),
- STRING_TO_UTF_TO_OBJ(globals->r->uri, POOL), 0);
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_PATH_INFO",
-1),
- STRING_TO_UTF_TO_OBJ(globals->r->path_info, POOL), 0);
-
-#ifndef WIN32
- pw = getpwuid(globals->r->finfo.st_uid);
- if (pw)
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("USER_NAME", -1),
- STRING_TO_UTF_TO_OBJ(ap_pstrdup(POOL, pw->pw_name), POOL), 0);
- else
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("USER_NAME", -1),
- STRING_TO_UTF_TO_OBJ(
- ap_psprintf(POOL, "user#%lu",
- (unsigned long)globals->r->finfo.st_uid), POOL), 0);
-#endif
-
- if ((t = strrchr(globals->r->filename, '/')))
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_NAME", -1),
- STRING_TO_UTF_TO_OBJ(++t, POOL), 0);
- else
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_NAME", -1),
- STRING_TO_UTF_TO_OBJ(globals->r->uri, POOL), 0);
-
- if (globals->r->args)
- {
- char *arg_copy = ap_pstrdup(POOL, globals->r->args);
- ap_unescape_url(arg_copy);
- Tcl_ObjSetVar2(interp, ArrayObj,
- Tcl_NewStringObj("QUERY_STRING_UNESCAPED", -1),
- STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(POOL, arg_copy), POOL), 0);
- }
-
- /* ---------------------------- */
-
- /* transfer client request headers to TCL request namespace */
- for (i = 0; i < hdrs_arr->nelts; ++i)
- {
- if (!hdrs[i].key)
- continue;
- else {
- Tcl_ObjSetVar2(interp, ArrayObj,
- STRING_TO_UTF_TO_OBJ(hdrs[i].key, POOL),
- STRING_TO_UTF_TO_OBJ(hdrs[i].val, POOL), 0);
- }
- }
- /* transfer apache internal cgi variables to TCL request namespace */
- for (i = 0; i < env_arr->nelts; ++i)
- {
- if (!env[i].key)
- continue;
- Tcl_ObjSetVar2(interp, ArrayObj, STRING_TO_UTF_TO_OBJ(env[i].key, POOL),
- STRING_TO_UTF_TO_OBJ(env[i].val, POOL), 0);
- }
-
- /* cleanup system cgi variables */
- ap_clear_table(globals->r->subprocess_env);
-
- return TCL_OK;
+ return TclWeb_GetEnvVars(ArrayObj, globals->req);
}
static int
@@ -419,9 +300,8 @@
int objc,
Tcl_Obj *CONST objv[])
{
- rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
- int i;
Tcl_Obj *ArrayObj;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
if( objc > 2 ) {
Tcl_WrongNumArgs( interp, 1, objv, "?arrayName?" );
@@ -434,24 +314,7 @@
ArrayObj = Tcl_NewStringObj( COOKIES_ARRAY_NAME, -1 );
}
- do { /* I do this because I want some 'local' variables */
- ApacheCookieJar *cookies = ApacheCookie_parse(globals->r, NULL);
-
- for (i = 0; i < ApacheCookieJarItems(cookies); i++) {
- ApacheCookie *c = ApacheCookieJarFetch(cookies, i);
- int j;
- for (j = 0; j < ApacheCookieItems(c); j++) {
- char *name = c->name;
- char *value = ApacheCookieFetch(c, j);
- Tcl_ObjSetVar2(interp, ArrayObj,
- Tcl_NewStringObj(name, -1),
- Tcl_NewStringObj(value, -1), 0);
- }
-
- }
- } while (0);
-
- return TCL_OK;
+ return TclWeb_GetCookieVars(ArrayObj, globals->req);
}
/* Tcl command to return a particular variable. */
@@ -472,11 +335,8 @@
Tcl_Obj *CONST objv[])
{
char *command;
- int i;
Tcl_Obj *result = NULL;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
- array_header *parmsarray = ap_table_elts(globals->req->parms);
- table_entry *parms = (table_entry *)parmsarray->elts;
if (objc < 2 || objc > 3)
{
@@ -486,6 +346,7 @@
return TCL_ERROR;
}
command = Tcl_GetString(objv[1]);
+ result = Tcl_NewObj();
if (!strcmp(command, "get"))
{
@@ -497,31 +358,11 @@
}
key = Tcl_GetStringFromObj(objv[2], NULL);
- /* This isn't real efficient - move to hash table later
- on... */
- for (i = 0; i < parmsarray->nelts; ++i)
+ if (TclWeb_GetVar(result, key, globals->req) != TCL_OK)
{
- if (!strncmp(key, Rivet_StringToUtf(parms[i].key, POOL),
strlen(key)))
- {
- /* The following makes sure that we get one string,
- with no sub lists. */
- if (result == NULL)
- {
- result = STRING_TO_UTF_TO_OBJ(parms[i].val, POOL);
- Tcl_IncrRefCount(result);
- } else {
- Tcl_Obj *tmpobjv[2];
- tmpobjv[0] = result;
- tmpobjv[1] = STRING_TO_UTF_TO_OBJ(parms[i].val, POOL);
- result = Tcl_ConcatObj(2, tmpobjv);
- }
- }
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
}
-
- if (result == NULL)
- Tcl_AppendResult(interp, "", NULL);
- else
- Tcl_SetObjResult(interp, result);
} else if(!strcmp(command, "exists")) {
char *key;
if (objc != 3)
@@ -531,21 +372,7 @@
}
key = Tcl_GetString(objv[2]);
- /* This isn't real efficient - move to hash table later on. */
- for (i = 0; i < parmsarray->nelts; ++i)
- {
- if (!strncmp(key, Rivet_StringToUtf(parms[i].key, POOL),
strlen(key)))
- {
- result = Tcl_NewIntObj(1);
- Tcl_IncrRefCount(result);
- }
- }
-
- if (result == NULL)
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
- else
- Tcl_SetObjResult(interp, result);
-
+ TclWeb_VarExists(result, key, globals->req);
} else if(!strcmp(command, "list")) {
char *key;
if (objc != 3)
@@ -555,44 +382,23 @@
}
key = Tcl_GetStringFromObj(objv[2], NULL);
- /* This isn't real efficient - move to hash table later on. */
- for (i = 0; i < parmsarray->nelts; ++i)
+ if (TclWeb_GetVarAsList(result, key, globals->req) != TCL_OK)
{
- if (!strncmp(key, Rivet_StringToUtf(parms[i].key, POOL),
strlen(key)))
- {
- if (result == NULL)
- {
- result = Tcl_NewObj();
- Tcl_IncrRefCount(result);
- }
- Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].val, POOL));
- }
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
}
-
- if (result == NULL)
- Tcl_AppendResult(interp, "", NULL);
- else
- Tcl_SetObjResult(interp, result);
} else if(!strcmp(command, "names")) {
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- result = Tcl_NewObj();
- Tcl_IncrRefCount(result);
- for (i = 0; i < parmsarray->nelts; ++i)
+
+ if (TclWeb_GetVarNames(result, globals->req) != TCL_OK)
{
- Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].key, POOL));
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
}
-
- if (result == NULL)
- Tcl_AppendResult(interp, "", NULL);
- else
- Tcl_SetObjResult(interp, result);
-
} else if(!strcmp(command, "number")) {
if (objc != 2)
{
@@ -600,37 +406,25 @@
return TCL_ERROR;
}
- result = Tcl_NewIntObj(parmsarray->nelts);
- Tcl_IncrRefCount(result);
- Tcl_SetObjResult(interp, result);
+ TclWeb_VarNumber(result, globals->req);
} else if(!strcmp(command, "all")) {
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- result = Tcl_NewObj();
- Tcl_IncrRefCount(result);
- for (i = 0; i < parmsarray->nelts; ++i)
+ if (TclWeb_GetAllVars(result, globals->req) != TCL_OK)
{
- Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].key, POOL));
- Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].val, POOL));
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
}
-
- if (result == NULL)
- Tcl_AppendResult(interp, "", NULL);
- else
- Tcl_SetObjResult(interp, result);
-
-
} else {
/* bad command */
Tcl_AddErrorInfo(interp, "bad option: must be one of "
"'get, list, names, number, all'");
return TCL_ERROR;
}
+ Tcl_SetObjResult(interp, result);
return TCL_OK;
}
@@ -688,7 +482,7 @@
return TCL_ERROR;
}
varname = Tcl_GetString(objv[2]);
- upload = ApacheUpload_find(globals->req->upload, varname);
+ upload = ApacheUpload_find(globals->req->apachereq->upload, varname);
if (upload != NULL) /* make sure we have an upload */
{
Tcl_Channel chan;
@@ -785,7 +579,7 @@
varname = Tcl_GetString(objv[2]);
infotype = Tcl_GetString(objv[3]);
- upload = ApacheUpload_find(globals->req->upload, varname);
+ upload = ApacheUpload_find(globals->req->apachereq->upload, varname);
if (upload != NULL)
{
if (!strcmp(infotype, "exists"))
@@ -802,7 +596,8 @@
Tcl_SetStringObj(result, "", -1);
} else if (!strcmp(infotype, "filename")) {
Tcl_SetStringObj(result,
- Rivet_StringToUtf(upload->filename, POOL), -1);
+ TclWeb_StringToUtf(upload->filename,
+ globals->req), -1);
} else {
Tcl_AddErrorInfo(interp,"unknown upload info command, should "
"be exists|size|type|filename");
@@ -817,11 +612,11 @@
}
}
} else if (!strcmp(command, "names")) {
- upload = ApacheRequest_upload(globals->req);
+ upload = ApacheRequest_upload(globals->req->apachereq);
while (upload)
{
Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(upload->name, POOL));
+ TclWeb_StringToUtfToObj(upload->name,
globals->req));
upload = upload->next;
}
} else {
1.2 +2 -1 tcl-rivet/src/rivetCrypt.c
Index: rivetCrypt.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivetCrypt.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- rivetCrypt.c 11 Jan 2002 06:47:48 -0000 1.1
+++ rivetCrypt.c 22 Jan 2002 01:27:56 -0000 1.2
@@ -5,6 +5,7 @@
#include <tcl.h>
#include "rivet.h"
#include <unistd.h>
+#include <crypt.h>
#define MODE_DECRYPT 0
#define MODE_ENCRYPT 1
@@ -107,7 +108,7 @@
key = Tcl_GetStringFromObj( objv[1], NULL );
salt = Tcl_GetStringFromObj( objv[2], NULL );
- resultBuffer = crypt( key, salt );
+ resultBuffer = crypt((const char *)key, (const char *)salt);
if( resultBuffer == NULL ) {
Tcl_AppendResult (interp,
1.3 +1 -1 tcl-rivet/src/rivetList.c
Index: rivetList.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivetList.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- rivetList.c 11 Jan 2002 06:47:48 -0000 1.2
+++ rivetList.c 22 Jan 2002 01:27:56 -0000 1.3
@@ -470,7 +470,7 @@
for (idx = 3, listIdx = 0; idx < objc; idx++, listIdx++) {
varValue = (listIdx < listObjc) ?
- listObjv[listIdx] : Tcl_NewStringObj( "", NULL );
+ listObjv[listIdx] : Tcl_NewStringObj("", -1);
if( Tcl_ObjSetVar2( interp, objv[2], objv[idx],
varValue, TCL_LEAVE_ERR_MSG ) == NULL ) {
