davidw 02/01/19 08:11:52
Modified: . ChangeLog
src TclWeb.h TclWebapache.c TclWebcgi.c make.tcl
Log:
* src/TclWebapache.c: Added individual functions for CGI variable
access. Much simpler than trying to devise a data structure to
pass them around with.
Revision Changes Path
1.21 +4 -0 tcl-rivet/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /home/cvs/tcl-rivet/ChangeLog,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- ChangeLog 19 Jan 2002 12:39:12 -0000 1.20
+++ ChangeLog 19 Jan 2002 16:11:52 -0000 1.21
@@ -1,5 +1,9 @@
2002-01-19 David N. Welton <[EMAIL PROTECTED]>
+ * src/TclWebapache.c: Added individual functions for CGI variable
+ access. Much simpler than trying to devise a data structure to
+ pass them around with.
+
* src/rivetCore.c (Rivet_LoadEnv): Roll back authorization
information command.
1.3 +2 -10 tcl-rivet/src/TclWeb.h
Index: TclWeb.h
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWeb.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- TclWeb.h 18 Jan 2002 20:07:18 -0000 1.2
+++ TclWeb.h 19 Jan 2002 16:11:52 -0000 1.3
@@ -3,7 +3,6 @@
* Common API layer.
*/
-
/*
*-----------------------------------------------------------------------------
*
@@ -64,23 +63,16 @@
*-----------------------------------------------------------------------------
*/
-int TclWeb_Cookie(Tcl_Obj *list, TclWebRequest *req);
-
-int TclWeb_GetCookie(Tcl_Obj *list, TclWebRequest *req);
-int TclWeb_GetCGIVars(Tcl_Obj *list, TclWebRequest *req);
+int TclWeb_GetCookieVars(Tcl_Obj *cookievar, TclWebRequest *req);
-int TclWeb_GetEnvVars(Tcl_HashTable *envs, TclWebRequest *req);
+int TclWeb_GetEnvVars(Tcl_Obj *envs, TclWebRequest *req);
/* upload stuff goes here */
int TclWeb_Escape(char *out, char *in, int len, void *var);
int TclWeb_UnEscape(char *out, char *in, int len, void *var);
-
-int TclWeb_Base64Encode(char *out, char *in, int len, TclWebRequest *req);
-
-int TclWeb_Base64Decode(char *out, char *in, int len, TclWebRequest *req);
int TclWeb_EscapeShellCommand(char *out, char *in, TclWebRequest *req);
1.3 +228 -75 tcl-rivet/src/TclWebapache.c
Index: TclWebapache.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWebapache.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- TclWebapache.c 18 Jan 2002 20:07:18 -0000 1.2
+++ TclWebapache.c 19 Jan 2002 16:11:52 -0000 1.3
@@ -7,30 +7,37 @@
* operations.
*/
-/* $Id: TclWebapache.c,v 1.2 2002/01/18 20:07:18 davidw Exp $ */
+/* $Id: TclWebapache.c,v 1.3 2002/01/19 16:11:52 davidw Exp $ */
#include <tcl.h>
-#include "TclWeb.h"
-typedef struct _TclWebRequest {
+#include "apache_request.h"
+#include "apache_cookie.h"
+#include "mod_rivet.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)
{
- req = Tcl_Alloc(sizeof(TclWebRequest));
+ req = (TclWebRequest *)Tcl_Alloc(sizeof(TclWebRequest));
req->req = (request_rec *)arg;
- req->apacherequest = ApacheRequest_new(r);
+ req->apachereq = ApacheRequest_new(req->req);
return TCL_OK;
}
int
TclWeb_SendHeaders(TclWebRequest *req)
{
- ap_send_header(req->req);
+ ap_send_http_header(req->req);
return TCL_OK;
}
@@ -48,22 +55,186 @@
return TCL_OK;
}
+
+int
+TclWeb_GetVar(Tcl_Obj *result, char *varname, TclWebRequest *req)
+{
+ int i;
+ array_header *parmsarray = ap_table_elts(req->apachereq->parms);
+ table_entry *parms = (table_entry *)parmsarray->elts;
+
+ result = NULL;
+
+ /* 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)))
+ {
+ /* 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, TCLWEBPOOL);
+ Tcl_IncrRefCount(result);
+ } else {
+ Tcl_Obj *tmpobjv[2];
+ tmpobjv[0] = result;
+ tmpobjv[1] = STRING_TO_UTF_TO_OBJ(parms[i].val, TCLWEBPOOL);
+ result = Tcl_ConcatObj(2, tmpobjv);
+ }
+ }
+ }
+
+ if (result == NULL)
+ {
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
+ }
+
+ return TCL_OK;
+}
+
+int
+TclWeb_GetVarAsList(Tcl_Obj *result, char *varname, TclWebRequest *req)
+{
+ int i;
+ array_header *parmsarray = ap_table_elts(req->apachereq->parms);
+ table_entry *parms = (table_entry *)parmsarray->elts;
+
+ /* 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 (result == NULL)
+ {
+ result = Tcl_NewObj();
+ Tcl_IncrRefCount(result);
+ }
+ Tcl_ListObjAppendElement(req->interp, result,
+ STRING_TO_UTF_TO_OBJ(parms[i].val,
TCLWEBPOOL));
+ }
+ }
+
+ if (result == NULL)
+ {
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
+ }
+ return TCL_OK;
+}
+
+int
+TclWeb_GetAllVars(Tcl_Obj *result, TclWebRequest *req)
+{
+ int i;
+ 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));
+ Tcl_ListObjAppendElement(req->interp, result,
+ STRING_TO_UTF_TO_OBJ(parms[i].val,
TCLWEBPOOL));
+ }
+
+ if (result == NULL)
+ {
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
+ }
+
+ return TCL_OK;
+}
+
+int
+TclWeb_GetVarNames(Tcl_Obj *result, TclWebRequest *req)
+{
+ int i;
+ 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));
+ }
+
+ if (result == NULL)
+ {
+ result = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(result);
+ }
+
+ return TCL_OK;
+}
+
int
-TclWeb_GetCGIVars(Tcl_Obj *list, TclWebRequest *req)
+TclWeb_VarExists(char *varname, TclWebRequest *req)
{
-
+ int i;
+ array_header *parmsarray = ap_table_elts(req->apachereq->parms);
+ table_entry *parms = (table_entry *)parmsarray->elts;
+
+ /* 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)))
+ {
+ return TCL_OK;
+ }
+ }
+ return TCL_ERROR;
+}
+
+int
+TclWeb_VarNumber(Tcl_Obj *result, TclWebRequest *req)
+{
+ array_header *parmsarray = ap_table_elts(req->apachereq->parms);
+
+ result = Tcl_NewIntObj(parmsarray->nelts);
+ Tcl_IncrRefCount(result);
+ return TCL_OK;
}
int
-TclWeb_GetEnvVars(Tcl_HashTable *envs, TclWebRequest *req)
+TclWeb_GetCookieVars(Tcl_Obj *cookievar, TclWebRequest *req)
+{
+ int i;
+ ApacheCookieJar *cookies = ApacheCookie_parse(req->req, 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(req->interp, cookievar,
+ Tcl_NewStringObj(name, -1),
+ Tcl_NewStringObj(value, -1), 0);
+ }
+ }
+
+ return TCL_OK;
+}
+
+int
+TclWeb_GetEnvVars(Tcl_Obj *envvar, TclWebRequest *req)
{
char *timefmt = DEFAULT_TIME_FORMAT;
#ifndef WIN32
struct passwd *pw;
#endif /* ndef WIN32 */
char *t;
- char *authorization = NULL;
-
time_t date;
int i;
@@ -72,7 +243,6 @@
table_entry *hdrs;
array_header *env_arr;
table_entry *env;
- Tcl_HashEntry *entry;
date = req->req->request_time;
/* ensure that the system area which holds the cgi variables is empty */
@@ -88,77 +258,48 @@
env_arr = ap_table_elts(req->req->subprocess_env);
env = (table_entry *) env_arr->elts;
- if (envs == NULL)
- {
- Tcl_InitHashTable(envs, TCL_STRING_KEYS);
- }
-
-
- /* Get the user/pass info for Basic authentication */
- (const char*)authorization =
- ap_table_get(req->req->headers_in, "Authorization");
- if (authorization
- && !strcasecmp(ap_getword_nc(POOL, &authorization, ' '), "Basic"))
- {
- char *tmp;
- char *user;
- char *pass;
-
- tmp = ap_pbase64decode(POOL, authorization);
- user = ap_getword_nulls_nc(POOL, &tmp, ':');
- pass = tmp;
- Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::request::USER", -1),
- Tcl_NewStringObj("user", -1),
- STRING_TO_UTF_TO_OBJ(user, POOL),
- 0);
- Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::request::USER", -1),
- Tcl_NewStringObj("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,
+ Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DATE_LOCAL", -1),
+ STRING_TO_UTF_TO_OBJ(ap_ht_time(TCLWEBPOOL,
+ date, timefmt, 0), TCLWEBPOOL), 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);
+ 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), POOL), 0);
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_URI", -1),
- STRING_TO_UTF_TO_OBJ(req->req->uri, POOL), 0);
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_PATH_INFO",
-1),
- STRING_TO_UTF_TO_OBJ(req->req->path_info, POOL), 0);
+ timefmt, 0), TCLWEBPOOL), 0);
+ Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DOCUMENT_URI", -1),
+ STRING_TO_UTF_TO_OBJ(req->req->uri, TCLWEBPOOL), 0);
+ Tcl_ObjSetVar2(req->interp, envvar,
Tcl_NewStringObj("DOCUMENT_PATH_INFO", -1),
+ STRING_TO_UTF_TO_OBJ(req->req->path_info, TCLWEBPOOL), 0);
#ifndef WIN32
pw = getpwuid(req->req->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);
+ Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("USER_NAME", -1),
+ STRING_TO_UTF_TO_OBJ(ap_pstrdup(TCLWEBPOOL, pw->pw_name),
TCLWEBPOOL), 0);
else
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("USER_NAME", -1),
+ Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("USER_NAME", -1),
STRING_TO_UTF_TO_OBJ(
- ap_psprintf(POOL, "user#%lu",
- (unsigned long)req->req->finfo.st_uid), POOL), 0);
+ ap_psprintf(TCLWEBPOOL, "user#%lu",
+ (unsigned long)req->req->finfo.st_uid), TCLWEBPOOL),
0);
#endif
if ((t = strrchr(req->req->filename, '/')))
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_NAME", -1),
- STRING_TO_UTF_TO_OBJ(++t, POOL), 0);
+ Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DOCUMENT_NAME",
-1),
+ STRING_TO_UTF_TO_OBJ(++t, TCLWEBPOOL), 0);
else
- Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_NAME", -1),
- STRING_TO_UTF_TO_OBJ(req->req->uri, POOL), 0);
+ Tcl_ObjSetVar2(req->interp, envvar, Tcl_NewStringObj("DOCUMENT_NAME",
-1),
+ STRING_TO_UTF_TO_OBJ(req->req->uri, TCLWEBPOOL), 0);
if (req->req->args)
{
- char *arg_copy = ap_pstrdup(POOL, req->req->args);
+ char *arg_copy = ap_pstrdup(TCLWEBPOOL, req->req->args);
ap_unescape_url(arg_copy);
- Tcl_ObjSetVar2(interp, ArrayObj,
+ Tcl_ObjSetVar2(req->interp, envvar,
Tcl_NewStringObj("QUERY_STRING_UNESCAPED", -1),
- STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(POOL, arg_copy), POOL), 0);
+ STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(TCLWEBPOOL, arg_copy),
TCLWEBPOOL), 0);
}
/* ---------------------------- */
@@ -169,9 +310,9 @@
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);
+ Tcl_ObjSetVar2(req->interp, envvar,
+ STRING_TO_UTF_TO_OBJ(hdrs[i].key, TCLWEBPOOL),
+ STRING_TO_UTF_TO_OBJ(hdrs[i].val, TCLWEBPOOL), 0);
}
}
@@ -180,8 +321,8 @@
{
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);
+ Tcl_ObjSetVar2(req->interp, envvar, STRING_TO_UTF_TO_OBJ(env[i].key,
TCLWEBPOOL),
+ STRING_TO_UTF_TO_OBJ(env[i].val, TCLWEBPOOL), 0);
}
/* cleanup system cgi variables */
@@ -191,14 +332,26 @@
}
int
-TclWeb_Base64Encode(char *out, char *in, int len, TclWebRequest *req);
+TclWeb_Base64Encode(char *out, char *in, TclWebRequest *req)
+{
+ out = ap_pbase64encode(TCLWEBPOOL, in);
+ return TCL_OK;
+}
int
-TclWeb_Base64Decode(char *out, char *in, int len, TclWebRequest *req);
+TclWeb_Base64Decode(char *out, char *in, TclWebRequest *req)
+{
+ out = ap_pbase64decode(TCLWEBPOOL, in);
+ return TCL_OK;
+}
int
-TclWeb_EscapeShellCommand(char *out, char *in, TclWebRequest *req);
+TclWeb_EscapeShellCommand(char *out, char *in, TclWebRequest *req)
+{
+ out = ap_escape_shell_cmd(TCLWEBPOOL, in);
+ return TCL_OK;
+}
/* output/write/flush? */
-/* error (log) ? */
+/* error (log) ? send to stderr. */
1.3 +2 -2 tcl-rivet/src/TclWebcgi.c
Index: TclWebcgi.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWebcgi.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- TclWebcgi.c 18 Jan 2002 20:07:18 -0000 1.2
+++ TclWebcgi.c 19 Jan 2002 16:11:52 -0000 1.3
@@ -6,7 +6,7 @@
* TclWeb.h. Low-level implementations are provided in this file.
*/
-/* $Id: TclWebcgi.c,v 1.2 2002/01/18 20:07:18 davidw Exp $ */
+/* $Id: TclWebcgi.c,v 1.3 2002/01/19 16:11:52 davidw Exp $ */
#include <tcl.h>
#include "TclWeb.h"
@@ -56,4 +56,4 @@
/* output/write/flush? */
-/* error (log) ? */
+/* error (log) ? send to stderr with some information. */
1.12 +11 -2 tcl-rivet/src/make.tcl
Index: make.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/src/make.tcl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- make.tcl 18 Jan 2002 19:08:53 -0000 1.11
+++ make.tcl 19 Jan 2002 16:11:52 -0000 1.12
@@ -2,7 +2,7 @@
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
-# $Id: make.tcl,v 1.11 2002/01/18 19:08:53 davidw Exp $
+# $Id: make.tcl,v 1.12 2002/01/19 16:11:52 davidw Exp $
# this file actually runs things, making use of the aardvark build
# system.
@@ -95,6 +95,11 @@
command {$COMPILE mod_rivet.c}
}
+AddNode TclWebapache.o {
+ depends "TclWebapache.c mod_rivet.h apache_request.h"
+ command {$COMPILE TclWebapache.c}
+}
+
AddNode librivet.a {
depends $LIB_OBJECTS
command {$TCL_STLIB_LD $LIB_STLIB $LIB_OBJECTS}
@@ -116,7 +121,11 @@
}
AddNode all {
- depends shared
+ depends module
+}
+
+AddNode module {
+ depends "TclWebapache.o shared"
}
AddNode shared {
