davidw 02/01/18 12:07:18
Modified: . ChangeLog
doc commands.html
src TclWeb.h TclWebapache.c TclWebcgi.c rivetCore.c
Log:
* src/rivetCore.c (Rivet_LoadAuth): New command to load authorization
information in its own array.
Revision Changes Path
1.19 +15 -0 tcl-rivet/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /home/cvs/tcl-rivet/ChangeLog,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- ChangeLog 12 Jan 2002 01:05:48 -0000 1.18
+++ ChangeLog 18 Jan 2002 20:07:18 -0000 1.19
@@ -1,3 +1,18 @@
+2002-01-18 David N. Welton <[EMAIL PROTECTED]>
+
+ * src/rivetCore.c (Rivet_LoadAuth): New command to load
+ authorization information in its own array.
+
+ * src/TclWebcgi.c: New file for stand-alone implementations of
+ common web API.
+
+ * src/TclWebapache.c: New file for apache-based implementations of
+ web API.
+
+ * src/TclWeb.c: Common code for TclWeb API.
+
+ * src/TclWeb.h: TclWeb web interaction API.
+
2002-01-11 Damon J. Courtney <[EMAIL PROTECTED]>
* src/make.tcl
1.7 +10 -1 tcl-rivet/doc/commands.html
Index: commands.html
===================================================================
RCS file: /home/cvs/tcl-rivet/doc/commands.html,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- commands.html 6 Jan 2002 19:27:01 -0000 1.6
+++ commands.html 18 Jan 2002 20:07:18 -0000 1.7
@@ -1,5 +1,5 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
- <!-- $Id: commands.html,v 1.6 2002/01/06 19:27:01 davidw Exp $ -->
+ <!-- $Id: commands.html,v 1.7 2002/01/18 20:07:18 davidw Exp $ -->
<html>
<head>
<title>Apache Rivet Tcl Commands</title>
@@ -83,11 +83,20 @@
<li>
<code><b>load_env <i>array_name</i></b></code><br> Load the
array of environment variables into the specified array name.
+ Uses array "<code>env</code>" by default.
+ </li>
+
+ <li>
+ <code><b>load_auth <i>array_name</i></b></code><br> Load the
+ authorization information ("<code>user</code>" and
+ "<code>pass</code>") into the specified array name. Uses
+ array "<code>auth</code>" by default.
</li>
<li>
<code><b>load_cookies <i>array_name</i></b></code><br> Load
the array of cookie variables into the specified array name.
+ Uses array "<code>cookies</code>" by default.
</li>
<li>
1.2 +1 -1 tcl-rivet/src/TclWeb.h
Index: TclWeb.h
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWeb.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TclWeb.h 18 Jan 2002 19:08:53 -0000 1.1
+++ TclWeb.h 18 Jan 2002 20:07:18 -0000 1.2
@@ -70,7 +70,7 @@
int TclWeb_GetCGIVars(Tcl_Obj *list, TclWebRequest *req);
-int TclWeb_GetEnvVars(Tcl_Obj *list, TclWebRequest *req);
+int TclWeb_GetEnvVars(Tcl_HashTable *envs, TclWebRequest *req);
/* upload stuff goes here */
1.2 +137 -3 tcl-rivet/src/TclWebapache.c
Index: TclWebapache.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWebapache.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TclWebapache.c 18 Jan 2002 19:08:53 -0000 1.1
+++ TclWebapache.c 18 Jan 2002 20:07:18 -0000 1.2
@@ -7,12 +7,13 @@
* operations.
*/
-/* $Id: TclWebapache.c,v 1.1 2002/01/18 19:08:53 davidw Exp $ */
+/* $Id: TclWebapache.c,v 1.2 2002/01/18 20:07:18 davidw Exp $ */
#include <tcl.h>
#include "TclWeb.h"
typedef struct _TclWebRequest {
+ Tcl_Interp *interp;
request_rec *req;
ApacheRequest *apachereq;
} TclWebRequest;
@@ -50,11 +51,144 @@
int
TclWeb_GetCGIVars(Tcl_Obj *list, TclWebRequest *req)
{
-
+
}
int
-TclWeb_GetEnvVars(Tcl_Obj *list, TclWebRequest *req);
+TclWeb_GetEnvVars(Tcl_HashTable *envs, 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;
+
+ array_header *hdrs_arr;
+ 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 */
+ ap_clear_table(req->req->subprocess_env);
+
+ /* retrieve cgi variables */
+ ap_add_cgi_vars(req->req);
+ ap_add_common_vars(req->req);
+
+ hdrs_arr = ap_table_elts(req->req->headers_in);
+ hdrs = (table_entry *) hdrs_arr->elts;
+
+ 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,
+ 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);
+
+#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);
+ else
+ Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("USER_NAME", -1),
+ STRING_TO_UTF_TO_OBJ(
+ ap_psprintf(POOL, "user#%lu",
+ (unsigned long)req->req->finfo.st_uid), POOL), 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);
+ else
+ Tcl_ObjSetVar2(interp, ArrayObj, Tcl_NewStringObj("DOCUMENT_NAME", -1),
+ STRING_TO_UTF_TO_OBJ(req->req->uri, POOL), 0);
+
+ if (req->req->args)
+ {
+ char *arg_copy = ap_pstrdup(POOL, req->req->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(req->req->subprocess_env);
+
+ return TCL_OK;
+}
int
TclWeb_Base64Encode(char *out, char *in, int len, TclWebRequest *req);
1.2 +2 -1 tcl-rivet/src/TclWebcgi.c
Index: TclWebcgi.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/TclWebcgi.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TclWebcgi.c 18 Jan 2002 19:08:53 -0000 1.1
+++ TclWebcgi.c 18 Jan 2002 20:07:18 -0000 1.2
@@ -6,12 +6,13 @@
* TclWeb.h. Low-level implementations are provided in this file.
*/
-/* $Id: TclWebcgi.c,v 1.1 2002/01/18 19:08:53 davidw Exp $ */
+/* $Id: TclWebcgi.c,v 1.2 2002/01/18 20:07:18 davidw Exp $ */
#include <tcl.h>
#include "TclWeb.h"
typedef struct _TclWebRequest {
+ Tcl_Interp *interp;
int header_sent;
Tcl_HashTable *headers;
int status;
1.4 +57 -24 tcl-rivet/src/rivetCore.c
Index: rivetCore.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivetCore.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- rivetCore.c 11 Jan 2002 06:47:48 -0000 1.3
+++ rivetCore.c 18 Jan 2002 20:07:18 -0000 1.4
@@ -22,6 +22,7 @@
#define BUFSZ 4096
#define ENV_ARRAY_NAME "env"
+#define AUTH_ARRAY_NAME "auth"
#define COOKIES_ARRAY_NAME "cookies"
extern module rivet_module;
@@ -258,6 +259,57 @@
return TCL_OK;
}
+/* Tcl command to get authorization information. */
+
+static int
+Rivet_LoadAuth(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ char *authorization = NULL;
+ Tcl_Obj *ArrayObj;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if( objc > 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "?arrayName?" );
+ return TCL_ERROR;
+ }
+
+ if( objc == 2 ) {
+ ArrayObj = objv[1];
+ } else {
+ ArrayObj = Tcl_NewStringObj( AUTH_ARRAY_NAME, -1 );
+ }
+ Tcl_IncrRefCount( ArrayObj );
+
+ /* Get the user/pass info for Basic authentication */
+ (const char*)authorization =
+ ap_table_get(globals->r->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, ArrayObj,
+ Tcl_NewStringObj("user", -1),
+ STRING_TO_UTF_TO_OBJ(user, POOL),
+ 0);
+ Tcl_ObjSetVar2(interp, ArrayObj,
+ Tcl_NewStringObj("pass", -1),
+ STRING_TO_UTF_TO_OBJ(pass, POOL),
+ 0);
+ }
+
+ return TCL_OK;
+}
+
/* Tcl command to get and parse any CGI and environmental variables */
/* Get the environmental variables, but do it from a tcl function, so
@@ -275,7 +327,6 @@
struct passwd *pw;
#endif /* ndef WIN32 */
char *t;
- char *authorization = NULL;
time_t date;
@@ -315,29 +366,6 @@
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*)authorization =
- ap_table_get(globals->r->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,
@@ -902,6 +930,11 @@
Tcl_CreateObjCommand(interp,
"load_cookies",
Rivet_LoadCookies,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "load_auth",
+ Rivet_LoadAuth,
NULL,
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
