You are viewing a plain text version of this content. The canonical link for it is here.
Posted to mod_dtcl-cvs@tcl.apache.org by da...@apache.org on 2001/06/26 01:30:11 UTC
cvs commit: tcl-moddtcl/docs documentation.html
davidw 01/06/25 16:30:11
Modified: . apache_request.h mod_dtcl.c mod_dtcl.h
tcl_commands.c
docs documentation.html
Log:
Begin 'global' elimination campaign!
Revision Changes Path
1.8 +1 -0 tcl-moddtcl/apache_request.h
Index: apache_request.h
===================================================================
RCS file: /home/cvs/tcl-moddtcl/apache_request.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- apache_request.h 2001/06/23 14:11:03 1.7
+++ apache_request.h 2001/06/25 23:30:00 1.8
@@ -116,6 +116,7 @@
ApacheUpload_info(upload, "Content-Type")
#define ApacheRequest_set_post_max(req, max) (req->post_max = max)
+#define ApacheRequest_set_temp_dir(req, dir) (req->temp_dir = dir)
char *ApacheUtil_expires(pool *p, char *time_str, int type);
#define EXPIRES_HTTP 1
1.34 +73 -88 tcl-moddtcl/mod_dtcl.c
Index: mod_dtcl.c
===================================================================
RCS file: /home/cvs/tcl-moddtcl/mod_dtcl.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- mod_dtcl.c 2001/06/23 14:11:03 1.33
+++ mod_dtcl.c 2001/06/25 23:30:01 1.34
@@ -57,7 +57,7 @@
* originally written at the National Center for Supercomputing Applications,
* University of Illinois, Urbana-Champaign. */
-/* $Id: mod_dtcl.c,v 1.33 2001/06/23 14:11:03 davidw Exp $ */
+/* $Id: mod_dtcl.c,v 1.34 2001/06/25 23:30:01 davidw Exp $ */
/* mod_dtcl.c by David Welton <da...@apache.org> - originally mod_include. */
/* See http://tcl.apache.org/mod_dtcl/credits.ttml for additional credits. */
@@ -80,8 +80,6 @@
#include "mod_dtcl.h"
/* *** Global variables *** */
-request_rec *global_rr; /* request rec */
-ApacheRequest *global_req; /* libapreq request */
Tcl_Encoding system_encoding; /* Default encoding */
/* output buffer for initial buffer_add. We use traditional memory
@@ -104,47 +102,13 @@
static int headers_set = 0; /* has the header been set yet? */
int content_sent = 0; /* make sure something gets sent */
-static int cacheSize = 0; /* size of cache, determined
- either in conf files, or
- set to
- "ap_max_requests_per_child
- / 2"; in the
- dtcl_init_handler function */
-int cacheFreeSize = 0; /* free space in cache */
+//dtcl_interp_globals globals;
-int upload_files_to_var = 0;
-
-static char *upload_dir = "/tmp/"; /* Upload directory */
-static unsigned int upload_max = 0; /* Maximum amount of data that may be uploaded */
-
-
-/* eventually we will transfer 'global' variables in here and
- 'de-globalize' them */
-#if 0
-typedef struct {
-} dtcl_globals;
-
-dtcl_globals globals;
-#endif
-
-typedef struct {
- Tcl_Interp *server_interp; /* per server Tcl interpreter */
- Tcl_Obj *dtcl_global_init_script; /* run once when apache is first started */
- Tcl_Obj *dtcl_child_init_script;
- Tcl_Obj *dtcl_child_exit_script;
- Tcl_Obj *dtcl_before_script; /* script run before each page */
- Tcl_Obj *dtcl_after_script; /* after */
- Tcl_Obj *dtcl_error_script; /* for errors */
- int dtcl_cache_size;
- char *server_name;
-} dtcl_server_conf;
-
#define GETREQINTERP(req) ((dtcl_server_conf *)ap_get_module_config(req->server->module_config, &dtcl_module))->server_interp
static void tcl_init_stuff(server_rec *s, pool *p);
static int send_content(request_rec *);
static int execute_and_check(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec *r);
-static dtcl_server_conf *dtcl_get_conf(request_rec *r);
/* Functions for Tcl Channel */
@@ -175,7 +139,7 @@
/* just need some arbitrary non-NULL pointer which can't also be a request_rec */
#define NESTED_INCLUDE_MAGIC (&dtcl_module)
-int inputproc(ClientData instancedata, char *buf, int toRead, int *errorCodePtr)
+static int inputproc(ClientData instancedata, char *buf, int toRead, int *errorCodePtr)
{
return EINVAL;
}
@@ -191,8 +155,9 @@
static int closeproc(ClientData instancedata, Tcl_Interp *interp2)
{
- print_headers(global_rr);
- flush_output_buffer(global_rr);
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp2, "dtcl", NULL);
+ print_headers(globals->r);
+ flush_output_buffer(globals->r);
return 0;
}
@@ -266,7 +231,7 @@
if (headers_set == 0)
set_header_type(r, DEFAULT_HEADER_TYPE);
- ap_send_http_header(global_rr);
+ ap_send_http_header(r);
headers_printed = 1;
return 1;
} else {
@@ -316,7 +281,7 @@
/* Function to convert strings to UTF encoding */
-char *StringToUtf(char *input)
+char *StringToUtf(char *input, ap_pool *pool)
{
#if DTCL_I18N == 1
char *temp;
@@ -324,7 +289,7 @@
Tcl_DStringInit(&dstr);
Tcl_ExternalToUtfDString(system_encoding, input, strlen(input), &dstr);
- temp = ap_pstrdup(global_rr->pool, Tcl_DStringValue(&dstr));
+ temp = ap_pstrdup(pool, Tcl_DStringValue(&dstr));
Tcl_DStringFree(&dstr);
return temp;
#else
@@ -571,7 +536,7 @@
#if DTCL_I18N == 1
/* Convert to encoding */
- Tcl_SetStringObj(outbuf, StringToUtf(Tcl_GetString(outbuf)), -1);
+ Tcl_SetStringObj(outbuf, StringToUtf(Tcl_GetString(outbuf), r->pool), -1);
#endif
/* END PARSER */
@@ -591,8 +556,8 @@
Tcl_Obj *errscript = conf->dtcl_error_script ? conf->dtcl_error_script :
conf->dtcl_error_script ? conf->dtcl_error_script : NULL;
- print_headers(global_rr);
- flush_output_buffer(global_rr);
+ print_headers(r);
+ flush_output_buffer(r);
if (errscript)
{
if (Tcl_EvalObj(interp, errscript) == TCL_ERROR)
@@ -608,8 +573,8 @@
Tcl_GetStringFromObj(outbuf, (int *)NULL)); */
} else {
/* We make sure to flush the output if buffer_add was the only output */
- print_headers(global_rr);
- flush_output_buffer(global_rr);
+ print_headers(r);
+ flush_output_buffer(r);
}
return OK;
}
@@ -626,14 +591,16 @@
Tcl_HashEntry *entry = NULL;
Tcl_Interp *interp = GETREQINTERP(r);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(r->server->module_config, &dtcl_module);
+
/* Look for the script's compiled version. If it's not found,
create it. */
- if (cacheSize)
+ if (dsc->cache_size)
{
hashKey = ap_psprintf(r->pool, "%s%ld%ld%d", r->filename, r->finfo.st_mtime, r->finfo.st_ctime, toplevel);
entry = Tcl_CreateHashEntry(&objCache, hashKey, &isNew);
}
- if (isNew || !cacheSize)
+ if (isNew || !dsc->cache_size)
{
outbuf = Tcl_NewObj();
Tcl_IncrRefCount(outbuf);
@@ -649,19 +616,19 @@
if (result != TCL_OK)
return result;
- if (cacheSize)
+ if (dsc->cache_size)
Tcl_SetHashValue(entry, (ClientData)outbuf);
- if (cacheFreeSize) {
+ if (dsc->cache_free) {
/* This MUST be malloc-ed, because it's permanent */
- objCacheList[--cacheFreeSize ] = strdup(hashKey);
- } else if (cacheSize) { /* if it's zero, we just skip this... */
+ objCacheList[--(dsc->cache_free) ] = strdup(hashKey);
+ } else if (dsc->cache_size) { /* if it's zero, we just skip this... */
Tcl_HashEntry *delEntry;
- delEntry = Tcl_FindHashEntry(&objCache, objCacheList[cacheSize - 1]);
+ delEntry = Tcl_FindHashEntry(&objCache, objCacheList[dsc->cache_size - 1]);
Tcl_DecrRefCount((Tcl_Obj *)Tcl_GetHashValue(delEntry));
Tcl_DeleteHashEntry(delEntry);
- free(objCacheList[cacheSize - 1]);
- memmove(objCacheList + 1, objCacheList, sizeof(char *)*(cacheSize -1));
+ free(objCacheList[dsc->cache_size - 1]);
+ memmove(objCacheList + 1, objCacheList, sizeof(char *)*(dsc->cache_size -1));
objCacheList[0] = strdup(hashKey);
}
} else {
@@ -682,12 +649,14 @@
Tcl_Interp *interp;
- ApacheRequest *req = NULL;
+ dtcl_server_conf *dsc;
ApacheUpload *upload;
- global_rr = r; /* Assign request to global request var */
+ dtcl_interp_globals globals;
+ globals.r = r; /* Assign request to global request var */
interp = GETREQINTERP(r);
+ dsc = dtcl_get_conf(r);
r->allowed |= (1 << M_GET);
r->allowed |= (1 << M_POST);
@@ -725,22 +694,27 @@
if (Tcl_EvalObj(interp, namespacePrologue) == TCL_ERROR)
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server, "Could not create request namespace\n");
- exit(1);
+ return HTTP_BAD_REQUEST;
}
/* Apache Request stuff */
- req = ApacheRequest_new(r);
- ApacheRequest_set_post_max(req, upload_max);
- global_req = req;
+
+ globals.req = ApacheRequest_new(r);
+ globals.r = r;
+ Tcl_SetAssocData(interp, "dtcl", NULL, &globals); /* we use this instead of global_rr */
+
+ ApacheRequest_set_post_max(globals.req, dsc->upload_max);
+ ApacheRequest_set_temp_dir(globals.req, dsc->upload_dir);
+
#if 0
if (upload_files_to_var)
{
- req->hook_data = interp;
- req->upload_hook = dtcl_upload_hook;
+ globals.req->hook_data = interp;
+ globals.req->upload_hook = dtcl_upload_hook;
}
#endif
- ApacheRequest___parse(req);
+ ApacheRequest___parse(globals.req);
/* take results and create tcl variables from them */
#if USE_ONLY_VAR_COMMAND == 1
@@ -904,7 +878,7 @@
#if DBG
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Config string = \"%s\"", Tcl_GetStringFromObj(dsc->dtcl_global_init_script, NULL)); /* XXX */
- ap_log_error(APLOG_MARK, APLOG_ERR, s, "Cache size = \"%d\"", dsc->dtcl_cache_size); /* XXX */
+ ap_log_error(APLOG_MARK, APLOG_ERR, s, "Cache size = \"%d\"", dsc->dtcl_dsc->cache_size); /* XXX */
#endif
if (dsc->dtcl_global_init_script != NULL)
@@ -918,21 +892,18 @@
}
/* This is what happens if it is not set by the user */
- if(dsc->dtcl_cache_size < 0)
+ if(dsc->cache_size < 0)
{
if (ap_max_requests_per_child != 0)
- cacheSize = ap_max_requests_per_child / 2;
+ dsc->cache_size = ap_max_requests_per_child / 2;
else
- cacheSize = 10; /* Arbitrary number FIXME */
- cacheFreeSize = cacheSize;
- } else if (dsc->dtcl_cache_size > 0) {
- cacheSize = dsc->dtcl_cache_size;
- cacheFreeSize = dsc->dtcl_cache_size;
- } else {
- cacheSize = 0;
+ dsc->cache_size = 10; /* Arbitrary number FIXME */
+ dsc->cache_free = dsc->cache_size;
+ } else if (dsc->cache_size > 0) {
+ dsc->cache_free = dsc->cache_size;
}
/* Initializing cache structures */
- objCacheList = malloc(cacheSize * sizeof(char *));
+ objCacheList = malloc(dsc->cache_size * sizeof(char *));
Tcl_InitHashTable(&objCache, TCL_STRING_KEYS);
sr = s;
@@ -999,7 +970,7 @@
else
ddc->dtcl_error_script = objarg;
} else {
- return "Mod_Dtcl Error: Dtcl_Script must have a second argument, which is one of: GlobalInitScript, ChildInitScript, ChildExitScript, BeforeScript, AfterScript";
+ return "Mod_Dtcl Error: Dtcl_Script must have a second argument, which is one of: GlobalInitScript, ChildInitScript, ChildExitScript, BeforeScript, AfterScript, ErrorScript";
}
return NULL;
}
@@ -1008,28 +979,37 @@
{
server_rec *s = cmd->server;
dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
- dsc->dtcl_cache_size = strtol(arg, NULL, 10);
+ dsc->cache_size = strtol(arg, NULL, 10);
return NULL;
}
static const char *set_uploaddir(cmd_parms *cmd, void *dummy, char *arg)
{
- upload_dir = arg;
+ server_rec *s = cmd->server;
+ dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ dsc->upload_dir = arg;
return NULL;
}
const char *set_uploadmax(cmd_parms *cmd, void *dummy, char *arg)
{
- upload_max = strtol(arg, NULL, 10);
+ server_rec *s = cmd->server;
+ dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ dsc->upload_max = strtol(arg, NULL, 10);
return NULL;
}
const char *set_filestovar(cmd_parms *cmd, void *dummy, char *arg)
{
- upload_files_to_var = strtol(arg, NULL, 10);
+ server_rec *s = cmd->server;
+ dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ dsc->upload_files_to_var = strtol(arg, NULL, 10);
return NULL;
}
/* function to get a config, and merge the directory/server options */
-static dtcl_server_conf *dtcl_get_conf(request_rec *r)
+
+/* NOTE that this returns values which cannot be modified, as they are
+ just copies of the original! */
+dtcl_server_conf *dtcl_get_conf(request_rec *r)
{
dtcl_server_conf *newconfig = NULL;
dtcl_server_conf *dsc = NULL; /* server config */
@@ -1045,7 +1025,6 @@
newconfig->dtcl_before_script = ddc->dtcl_before_script ? ddc->dtcl_before_script : dsc->dtcl_before_script;
newconfig->dtcl_after_script = ddc->dtcl_after_script ? ddc->dtcl_after_script : dsc->dtcl_after_script;
newconfig->dtcl_error_script = ddc->dtcl_error_script ? ddc->dtcl_error_script : dsc->dtcl_error_script;
-
return newconfig;
}
return dsc;
@@ -1061,7 +1040,10 @@
dsc->dtcl_before_script = NULL;
dsc->dtcl_after_script = NULL;
dsc->dtcl_error_script = NULL;
- dsc->dtcl_cache_size = -1;
+ dsc->cache_size = -1;
+ dsc->cache_free = 0;
+ dsc->upload_max = 0;
+ dsc->upload_dir = "/tmp";
dsc->server_name = ap_pstrdup(p, s->server_hostname);
return dsc;
}
@@ -1087,7 +1069,6 @@
dsc->dtcl_child_exit_script = overrides->dtcl_child_exit_script ? overrides->dtcl_child_exit_script : base->dtcl_child_exit_script;
- dsc->dtcl_cache_size = overrides->dtcl_cache_size ? overrides->dtcl_cache_size : base->dtcl_cache_size;
#endif
dsc->dtcl_before_script = overrides->dtcl_before_script ? overrides->dtcl_before_script : base->dtcl_before_script;
@@ -1095,9 +1076,13 @@
dsc->dtcl_after_script = overrides->dtcl_after_script ? overrides->dtcl_after_script : base->dtcl_after_script;
dsc->dtcl_error_script = overrides->dtcl_error_script ? overrides->dtcl_error_script : base->dtcl_error_script;
-
+ dsc->cache_size = overrides->cache_size ? overrides->cache_size : base->cache_size;
+ dsc->cache_free = overrides->cache_free ? overrides->cache_free : base->cache_free;
+ dsc->upload_max = overrides->upload_max ? overrides->upload_max : base->upload_max;
+ dsc->upload_files_to_var = overrides->upload_files_to_var ? overrides->upload_files_to_var : base->upload_files_to_var;
dsc->server_name = overrides->server_name ? overrides->server_name : base->server_name;
+ dsc->upload_dir = overrides->upload_dir ? overrides->upload_dir : base->upload_dir;
return dsc;
}
1.7 +28 -3 tcl-moddtcl/mod_dtcl.h
Index: mod_dtcl.h
===================================================================
RCS file: /home/cvs/tcl-moddtcl/mod_dtcl.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- mod_dtcl.h 2001/06/21 17:47:11 1.6
+++ mod_dtcl.h 2001/06/25 23:30:02 1.7
@@ -54,19 +54,44 @@
/* #define DTCL_VERSION "X.X.X" */
typedef struct {
+ Tcl_Interp *server_interp; /* per server Tcl interpreter */
+ Tcl_Obj *dtcl_global_init_script; /* run once when apache is first started */
+ Tcl_Obj *dtcl_child_init_script;
+ Tcl_Obj *dtcl_child_exit_script;
+ Tcl_Obj *dtcl_before_script; /* script run before each page */
+ Tcl_Obj *dtcl_after_script; /* after */
+ Tcl_Obj *dtcl_error_script; /* for errors */
+ int cache_size;
+ int cache_free;
+ int upload_max;
+ int upload_files_to_var;
+ char *server_name;
+ char *upload_dir;
+} dtcl_server_conf;
+
+/* eventually we will transfer 'global' variables in here and
+ 'de-globalize' them */
+
+typedef struct {
+ request_rec *r; /* request rec */
+ ApacheRequest *req; /* libapreq request */
+} dtcl_interp_globals;
+
+typedef struct {
char *buf;
int len;
} obuff;
int memwrite(obuff *, char *, int);
-int get_parse_exec_file(request_rec *r, int toplevel);
+int get_parse_exec_file(request_rec *r, int toplevel);
int set_header_type(request_rec *, char *);
int print_headers(request_rec *);
int print_error(request_rec *, int, char *);
int flush_output_buffer(request_rec *);
-char *StringToUtf(char *input);
+char *StringToUtf(char *input, ap_pool *pool);
+dtcl_server_conf *dtcl_get_conf(request_rec *r);
/* Macro to Tcl Objectify StringToUtf stuff */
-#define STRING_TO_UTF_TO_OBJ(string) Tcl_NewStringObj(StringToUtf(string), -1)
+#define STRING_TO_UTF_TO_OBJ(string, pool) Tcl_NewStringObj(StringToUtf(string, pool), -1)
#endif
1.11 +105 -78 tcl-moddtcl/tcl_commands.c
Index: tcl_commands.c
===================================================================
RCS file: /home/cvs/tcl-moddtcl/tcl_commands.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- tcl_commands.c 2001/06/23 15:30:56 1.10
+++ tcl_commands.c 2001/06/25 23:30:03 1.11
@@ -18,16 +18,15 @@
#define BUFSZ 4096
-extern request_rec *global_rr;
+extern module dtcl_module;
+
extern obuff obuffer;
extern int content_sent;
extern int buffer_output;
extern int headers_printed;
-extern int cacheFreeSize;
-extern int upload_files_to_var;
extern Tcl_Obj *uploadstorage[];
-extern ApacheRequest *global_req;
+#define POOL (globals->r->pool)
/* Include and parse a file */
@@ -36,6 +35,8 @@
char *filename;
struct stat finfo;
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "filename");
@@ -43,7 +44,7 @@
}
filename = Tcl_GetStringFromObj (objv[1], (int *)NULL);
- if (!strcmp(filename, global_rr->filename))
+ if (!strcmp(filename, globals->r->filename))
{
Tcl_AddErrorInfo(interp, "Cannot recursively call the same file!");
return TCL_ERROR;
@@ -54,7 +55,7 @@
Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
return TCL_ERROR;
}
- if (get_parse_exec_file(global_rr, 0) == OK)
+ if (get_parse_exec_file(globals->r, 0) == OK)
return TCL_OK;
else
return TCL_ERROR;
@@ -83,8 +84,8 @@
} else {
Tcl_SetChannelOption(interp, fd, "-translation", "lf");
}
-/* print_headers(global_rr);
- flush_output_buffer(global_rr); */
+/* print_headers(globals->r);
+ flush_output_buffer(globals->r); */
while ((sz = Tcl_Read(fd, buf, BUFSZ - 1)))
{
if (sz == -1)
@@ -132,6 +133,9 @@
{
char *arg1;
int length;
+
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
@@ -148,7 +152,7 @@
return TCL_ERROR;
}
ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE,
- global_rr->server, "Mod_Dtcl Error: %s",
+ globals->r->server, "Mod_Dtcl Error: %s",
Tcl_GetStringFromObj (objv[2], (int *)NULL));
} else {
if (objc != 2)
@@ -160,9 +164,9 @@
{
memwrite(&obuffer, arg1, length);
} else {
- print_headers(global_rr);
- flush_output_buffer(global_rr);
- ap_rwrite(arg1, length, global_rr);
+ print_headers(globals->r);
+ flush_output_buffer(globals->r);
+ ap_rwrite(arg1, length, globals->r);
}
}
@@ -174,6 +178,8 @@
int Headers(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *opt;
+
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
@@ -206,7 +212,7 @@
{
stringopts[i] = Tcl_GetString(objv[i + 2]);
}
- cookie = ApacheCookie_new(global_rr,
+ cookie = ApacheCookie_new(globals->r,
stringopts[0], stringopts[1],
stringopts[2], stringopts[3],
stringopts[4], stringopts[5],
@@ -223,8 +229,8 @@
Tcl_WrongNumArgs(interp, 2, objv, "new-url");
return TCL_ERROR;
}
- ap_table_set(global_rr->headers_out, "Location", Tcl_GetStringFromObj (objv[2], (int *)NULL));
- global_rr->status = 301;
+ ap_table_set(globals->r->headers_out, "Location", Tcl_GetStringFromObj (objv[2], (int *)NULL));
+ globals->r->status = 301;
return TCL_RETURN;
}
else if (!strcmp("set", opt)) /* ### set ### */
@@ -234,7 +240,7 @@
Tcl_WrongNumArgs(interp, 2, objv, "headername value");
return TCL_ERROR;
}
- ap_table_set(global_rr->headers_out,
+ ap_table_set(globals->r->headers_out,
Tcl_GetStringFromObj (objv[2], (int *)NULL),
Tcl_GetStringFromObj (objv[3], (int *)NULL));
}
@@ -245,7 +251,7 @@
Tcl_WrongNumArgs(interp, 2, objv, "mime/type");
return TCL_ERROR;
}
- set_header_type(global_rr, Tcl_GetStringFromObj(objv[2], (int *)NULL));
+ set_header_type(globals->r, Tcl_GetStringFromObj(objv[2], (int *)NULL));
} else if (!strcmp("numeric", opt)) /* ### numeric ### */
{
int st = 200;
@@ -256,7 +262,7 @@
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[2], &st) != TCL_ERROR)
- global_rr->status = st;
+ globals->r->status = st;
else
return TCL_ERROR;
} else {
@@ -270,19 +276,23 @@
int Buffered(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
- char *opt = Tcl_GetStringFromObj(objv[1], NULL);
+ char *opt = NULL;
+
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "on/off");
return TCL_ERROR;
}
+ opt = Tcl_GetStringFromObj(objv[1], NULL);
if (!strncmp(opt, "on", 2))
{
buffer_output = 1;
} else if (!strncmp(opt, "off", 3)) {
buffer_output = 0;
- print_headers(global_rr);
- flush_output_buffer(global_rr);
+ print_headers(globals->r);
+ flush_output_buffer(globals->r);
} else {
return TCL_ERROR;
}
@@ -292,14 +302,16 @@
int HFlush(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+
if (objc != 1)
{
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- print_headers(global_rr);
- flush_output_buffer(global_rr);
- ap_rflush(global_rr);
+ print_headers(globals->r);
+ flush_output_buffer(globals->r);
+ ap_rflush(globals->r);
return TCL_OK;
}
@@ -317,7 +329,7 @@
char *t;
char *authorization = NULL;
- time_t date = global_rr->request_time;
+ time_t date;
int i;
@@ -325,69 +337,75 @@
table_entry *hdrs;
array_header *env_arr;
table_entry *env;
+
+ dtcl_interp_globals *globals = NULL;
+ Tcl_Obj *EnvsObj = NULL;
- Tcl_Obj *EnvsObj = Tcl_NewStringObj("::request::ENVS", -1);
+ globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+
+ EnvsObj = Tcl_NewStringObj("::request::ENVS", -1);
Tcl_IncrRefCount(EnvsObj);
+ date = globals->r->request_time;
/* ensure that the system area which holds the cgi variables is empty */
- ap_clear_table(global_rr->subprocess_env);
+ ap_clear_table(globals->r->subprocess_env);
/* retrieve cgi variables */
- ap_add_cgi_vars(global_rr);
- ap_add_common_vars(global_rr);
+ ap_add_cgi_vars(globals->r);
+ ap_add_common_vars(globals->r);
- hdrs_arr = ap_table_elts(global_rr->headers_in);
+ hdrs_arr = ap_table_elts(globals->r->headers_in);
hdrs = (table_entry *) hdrs_arr->elts;
- env_arr = ap_table_elts(global_rr->subprocess_env);
+ 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(global_rr->headers_in, "Authorization");
- if (authorization && !strcasecmp(ap_getword_nc(global_rr->pool, &authorization, ' '), "Basic"))
+ (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(global_rr->pool, authorization);
- user = ap_getword_nulls_nc(global_rr->pool, &tmp, ':');
+ 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),
+ 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),
+ STRING_TO_UTF_TO_OBJ(pass, POOL),
0);
}
/* These were the "include vars" */
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DATE_LOCAL", -1), STRING_TO_UTF_TO_OBJ(ap_ht_time(global_rr->pool, date, timefmt, 0)), 0);
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DATE_GMT", -1), STRING_TO_UTF_TO_OBJ(ap_ht_time(global_rr->pool, date, timefmt, 1)), 0);
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("LAST_MODIFIED", -1), STRING_TO_UTF_TO_OBJ(ap_ht_time(global_rr->pool, global_rr->finfo.st_mtime, timefmt, 0)), 0);
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_URI", -1), STRING_TO_UTF_TO_OBJ(global_rr->uri), 0);
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_PATH_INFO", -1), STRING_TO_UTF_TO_OBJ(global_rr->path_info), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DATE_LOCAL", -1), STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL, date, timefmt, 0), POOL), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DATE_GMT", -1), STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL, date, timefmt, 1), POOL), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, 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, EnvsObj, Tcl_NewStringObj("DOCUMENT_URI", -1), STRING_TO_UTF_TO_OBJ(globals->r->uri, POOL), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_PATH_INFO", -1), STRING_TO_UTF_TO_OBJ(globals->r->path_info, POOL), 0);
#ifndef WIN32
- pw = getpwuid(global_rr->finfo.st_uid);
+ pw = getpwuid(globals->r->finfo.st_uid);
if (pw)
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("USER_NAME", -1), STRING_TO_UTF_TO_OBJ(ap_pstrdup(global_rr->pool, pw->pw_name)), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("USER_NAME", -1), STRING_TO_UTF_TO_OBJ(ap_pstrdup(POOL, pw->pw_name), POOL), 0);
else
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("USER_NAME", -1),
- STRING_TO_UTF_TO_OBJ(ap_psprintf(global_rr->pool, "user#%lu", (unsigned long) global_rr->finfo.st_uid)), 0);
+ STRING_TO_UTF_TO_OBJ(ap_psprintf(POOL, "user#%lu", (unsigned long) globals->r->finfo.st_uid), POOL), 0);
#endif
- if ((t = strrchr(global_rr->filename, '/')))
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_NAME", -1), STRING_TO_UTF_TO_OBJ(++t), 0);
+ if ((t = strrchr(globals->r->filename, '/')))
+ Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_NAME", -1), STRING_TO_UTF_TO_OBJ(++t, POOL), 0);
else
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_NAME", -1), STRING_TO_UTF_TO_OBJ(global_rr->uri), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_NAME", -1), STRING_TO_UTF_TO_OBJ(globals->r->uri, POOL), 0);
- if (global_rr->args)
+ if (globals->r->args)
{
- char *arg_copy = ap_pstrdup(global_rr->pool, global_rr->args);
+ char *arg_copy = ap_pstrdup(POOL, globals->r->args);
ap_unescape_url(arg_copy);
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("QUERY_STRING_UNESCAPED", -1), STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(global_rr->pool, arg_copy)), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("QUERY_STRING_UNESCAPED", -1), STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(POOL, arg_copy), POOL), 0);
}
/* ---------------------------- */
@@ -398,7 +416,7 @@
if (!hdrs[i].key)
continue;
else {
- Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(hdrs[i].key), STRING_TO_UTF_TO_OBJ(hdrs[i].val), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(hdrs[i].key, POOL), STRING_TO_UTF_TO_OBJ(hdrs[i].val, POOL), 0);
}
}
@@ -407,11 +425,11 @@
{
if (!env[i].key)
continue;
- Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(env[i].key), STRING_TO_UTF_TO_OBJ(env[i].val), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(env[i].key, POOL), STRING_TO_UTF_TO_OBJ(env[i].val, POOL), 0);
}
do { /* I do this because I want some 'local' variables */
- ApacheCookieJar *cookies = ApacheCookie_parse(global_rr, NULL);
+ ApacheCookieJar *cookies = ApacheCookie_parse(globals->r, NULL);
Tcl_Obj *cookieobj = Tcl_NewStringObj("::request::COOKIES", -1);
for (i = 0; i < ApacheCookieJarItems(cookies); i++) {
@@ -421,15 +439,15 @@
char *name = c->name;
char *value = ApacheCookieFetch(c, j);
Tcl_ObjSetVar2(interp, cookieobj,
- STRING_TO_UTF_TO_OBJ(name),
- STRING_TO_UTF_TO_OBJ(value), 0);
+ STRING_TO_UTF_TO_OBJ(name, POOL),
+ STRING_TO_UTF_TO_OBJ(value, POOL), 0);
}
}
} while (0);
/* cleanup system cgi variables */
- ap_clear_table(global_rr->subprocess_env);
+ ap_clear_table(globals->r->subprocess_env);
return TCL_OK;
}
@@ -449,7 +467,8 @@
char *command;
int i;
Tcl_Obj *result = NULL;
- array_header *parmsarray = ap_table_elts(global_req->parms);
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+ array_header *parmsarray = ap_table_elts(globals->req->parms);
table_entry *parms = (table_entry *)parmsarray->elts;
if (objc < 2 || objc > 3)
@@ -473,18 +492,18 @@
on... */
for (i = 0; i < parmsarray->nelts; ++i)
{
- if (!strncmp(key, StringToUtf(parms[i].key), strlen(key)))
+ if (!strncmp(key, 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);
+ 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);
+ tmpobjv[1] = STRING_TO_UTF_TO_OBJ(parms[i].val, POOL);
result = Tcl_ConcatObj(2, tmpobjv);
}
}
@@ -506,7 +525,7 @@
/* This isn't real efficient - move to hash table later on. */
for (i = 0; i < parmsarray->nelts; ++i)
{
- if (!strncmp(key, StringToUtf(parms[i].key), strlen(key)))
+ if (!strncmp(key, StringToUtf(parms[i].key, POOL), strlen(key)))
{
result = Tcl_NewIntObj(1);
Tcl_IncrRefCount(result);
@@ -530,7 +549,7 @@
/* This isn't real efficient - move to hash table later on. */
for (i = 0; i < parmsarray->nelts; ++i)
{
- if (!strncmp(key, StringToUtf(parms[i].key), strlen(key)))
+ if (!strncmp(key, StringToUtf(parms[i].key, POOL), strlen(key)))
{
if (result == NULL)
{
@@ -538,7 +557,7 @@
Tcl_IncrRefCount(result);
}
Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].val));
+ STRING_TO_UTF_TO_OBJ(parms[i].val, POOL));
}
}
@@ -557,7 +576,7 @@
for (i = 0; i < parmsarray->nelts; ++i)
{
Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].key));
+ STRING_TO_UTF_TO_OBJ(parms[i].key, POOL));
}
if (result == NULL)
@@ -586,9 +605,9 @@
for (i = 0; i < parmsarray->nelts; ++i)
{
Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].key));
+ STRING_TO_UTF_TO_OBJ(parms[i].key, POOL));
Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(parms[i].val));
+ STRING_TO_UTF_TO_OBJ(parms[i].val, POOL));
}
if (result == NULL)
@@ -632,6 +651,10 @@
char *command = NULL;
Tcl_Obj *result = NULL;
ApacheUpload *upload;
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+ dtcl_server_conf *dsc = NULL;
+
+ dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc < 2 || objc > 5)
{
@@ -650,7 +673,7 @@
return TCL_ERROR;
}
varname = Tcl_GetString(objv[2]);
- upload = ApacheUpload_find(global_req->upload, varname);
+ upload = ApacheUpload_find(globals->req->upload, varname);
if (upload != NULL) /* make sure we have an upload */
{
Tcl_Channel chan;
@@ -707,7 +730,7 @@
} else if (!strcmp(method, "data")) {
/* this sucks - we should use the hook, but I want to
get everything fixed and working first */
- if (upload_files_to_var)
+ if (dsc->upload_files_to_var)
{
char *bytes = NULL;
Tcl_Channel chan = NULL;
@@ -739,7 +762,7 @@
varname = Tcl_GetString(objv[2]);
infotype = Tcl_GetString(objv[3]);
- upload = ApacheUpload_find(global_req->upload, varname);
+ upload = ApacheUpload_find(globals->req->upload, varname);
if (upload != NULL)
{
if (!strcmp(infotype, "exists"))
@@ -755,7 +778,7 @@
else
Tcl_SetStringObj(result, "", -1);
} else if (!strcmp(infotype, "filename")) {
- Tcl_SetStringObj(result, StringToUtf(upload->filename), -1);
+ Tcl_SetStringObj(result, StringToUtf(upload->filename, POOL), -1);
} else {
Tcl_AddErrorInfo(interp, "unknown upload info command, should be exists|size|type|filename");
return TCL_ERROR;
@@ -769,11 +792,11 @@
}
}
} else if (!strcmp(command, "names")) {
- upload = ApacheRequest_upload(global_req);
+ upload = ApacheRequest_upload(globals->req);
while (upload)
{
Tcl_ListObjAppendElement(interp, result,
- STRING_TO_UTF_TO_OBJ(upload->name));
+ STRING_TO_UTF_TO_OBJ(upload->name, POOL));
upload = upload->next;
}
} else {
@@ -791,16 +814,19 @@
int Dtcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *tble;
- tble = ap_psprintf(global_rr->pool,
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
+
+ tble = ap_psprintf(POOL,
"<table border=0 bgcolor=green><tr><td>\n"
"<table border=0 bgcolor=\"#000000\">\n"
"<tr><td align=center bgcolor=blue><font color=\"#ffffff\" size=\"+2\">dtcl_info</font><br></td></tr>\n"
"<tr><td><font color=\"#ffffff\">Free cache size: %d</font><br></td></tr>\n"
"<tr><td><font color=\"#ffffff\">PID: %d</font><br></td></tr>\n"
"</table>\n"
- "</td></tr></table>\n", cacheFreeSize, getpid());
-/* print_headers(global_rr);
- flush_output_buffer(global_rr); */
+ "</td></tr></table>\n", dsc->cache_free, getpid());
+/* print_headers(globals->r);
+ flush_output_buffer(globals->r); */
memwrite(&obuffer, tble, strlen(tble));
return TCL_OK;
}
@@ -810,10 +836,11 @@
int No_Body(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
+ dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
if (content_sent == 1)
return TCL_ERROR;
- print_headers(global_rr);
+ print_headers(globals->r);
Tcl_Free(obuffer.buf);
obuffer.buf = NULL;
obuffer.len = 0;
1.10 +2 -5 tcl-moddtcl/docs/documentation.html
Index: documentation.html
===================================================================
RCS file: /home/cvs/tcl-moddtcl/docs/documentation.html,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- documentation.html 2001/06/15 17:19:46 1.9
+++ documentation.html 2001/06/25 23:30:09 1.10
@@ -1,8 +1,5 @@
-<!-- $Id: documentation.html,v 1.9 2001/06/15 17:19:46 davidw Exp $ -->
-
-
-
-
+<!-- $Id: documentation.html,v 1.10 2001/06/25 23:30:09 davidw Exp $ -->
+
<!-- The load dtd is so that I can work on the documentation
with emacs' SGML in all its glory - davidw -->