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/09/05 14:01:22 UTC
cvs commit: tcl-moddtcl/debian rules
davidw 01/09/05 05:01:22
Modified: . Makefile mod_dtcl.c mod_dtcl.h tcl_commands.c
debian rules
Added: . channel.c channel.h
Log:
Large commit:
Broke channel out into its own file.
Changed pretty much everything but HPuts over to using the ApacheChan
for output.
Stylistic changes (line wrapping).
Discarded obuff in favor of DString.
Revision Changes Path
1.18 +5 -3 tcl-moddtcl/Makefile
Index: Makefile
===================================================================
RCS file: /home/cvs/tcl-moddtcl/Makefile,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- Makefile 2001/08/28 16:06:20 1.17
+++ Makefile 2001/09/05 12:01:22 1.18
@@ -1,4 +1,4 @@
-# $Id: Makefile,v 1.17 2001/08/28 16:06:20 davidw Exp $
+# $Id: Makefile,v 1.18 2001/09/05 12:01:22 davidw Exp $
# Changed to use the Tcl variables from tclConfig.sh
@@ -14,7 +14,7 @@
SHLIB=mod_dtcl$(TCL_SHLIB_SUFFIX)
APREQ_OBJECTS=apache_cookie.o apache_multipart_buffer.o apache_request.o
-OBJECTS=mod_dtcl.o tcl_commands.o parser.o $(APREQ_OBJECTS)
+OBJECTS=mod_dtcl.o tcl_commands.o parser.o channel.o $(APREQ_OBJECTS)
# The following TCL_* variables are all exported from builddtcl.sh
@@ -37,11 +37,13 @@
$(COMPILE)
apache_request.o: apache_request.c apache_request.h
$(COMPILE)
-mod_dtcl.o: mod_dtcl.c mod_dtcl.h tcl_commands.h apache_request.h parser.h
+mod_dtcl.o: mod_dtcl.c mod_dtcl.h tcl_commands.h apache_request.h parser.h parser.h
$(COMPILE) -DDTCL_VERSION=`cat VERSION`
tcl_commands.o: tcl_commands.c tcl_commands.h mod_dtcl.h
$(COMPILE)
parser.o: parser.c mod_dtcl.h parser.h
+ $(COMPILE)
+channel.o: channel.c mod_dtcl.h channel.h
$(COMPILE)
clean:
1.48 +79 -157 tcl-moddtcl/mod_dtcl.c
Index: mod_dtcl.c
===================================================================
RCS file: /home/cvs/tcl-moddtcl/mod_dtcl.c,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- mod_dtcl.c 2001/09/02 14:04:16 1.47
+++ mod_dtcl.c 2001/09/05 12:01:22 1.48
@@ -57,7 +57,7 @@
* originally written at the National Center for Supercomputing Applications,
* University of Illinois, Urbana-Champaign. */
-/* $Id: mod_dtcl.c,v 1.47 2001/09/02 14:04:16 davidw Exp $ */
+/* $Id: mod_dtcl.c,v 1.48 2001/09/05 12:01:22 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. */
@@ -77,128 +77,22 @@
#include "tcl_commands.h"
#include "parser.h"
+#include "channel.h"
#include "apache_request.h"
#include "mod_dtcl.h"
-/* *** Global variables *** */
-Tcl_Encoding system_encoding; /* Default encoding */
-
module MODULE_VAR_EXPORT dtcl_module;
static void tcl_init_stuff(server_rec *s, pool *p);
static void copy_dtcl_config(pool *p, dtcl_server_conf *olddsc, dtcl_server_conf *newdsc);
-static int get_ttml_file(request_rec *r, dtcl_server_conf *dsc, Tcl_Interp *interp, char *filename, int toplevel, Tcl_Obj *outbuf);
+static int get_ttml_file(request_rec *r, dtcl_server_conf *dsc,
+ Tcl_Interp *interp, char *filename, int toplevel, Tcl_Obj *outbuf);
static int send_content(request_rec *);
static int execute_and_check(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec *r);
/* just need some arbitrary non-NULL pointer which can't also be a request_rec */
#define NESTED_INCLUDE_MAGIC (&dtcl_module)
-/* Functions for Tcl Channel */
-
-static int closeproc(ClientData, Tcl_Interp *);
-static int inputproc(ClientData, char *, int, int *);
-static int outputproc(ClientData, char *, int, int *);
-static int setoptionproc(ClientData, Tcl_Interp *, char *, char *);
-/*
- static int getoptionproc(ClientData, Tcl_Interp *, char *, Tcl_DString *); */
-static void watchproc(ClientData, int);
-static int gethandleproc(ClientData, int, ClientData *);
-
-/* Apache BUFF Channel Type */
-static Tcl_ChannelType Achan = {
- "apache_channel",
- NULL,
- closeproc,
- inputproc,
- outputproc,
- NULL,
- setoptionproc,
- NULL,
- watchproc,
- gethandleproc,
- NULL
-};
-
-static int inputproc(ClientData instancedata, char *buf, int toRead, int *errorCodePtr)
-{
- return EINVAL;
-}
-
-/* This is the output 'method' for the Memory Buffer Tcl 'File'
- Channel that we create to divert stdout to */
-
-static int outputproc(ClientData instancedata, char *buf, int toWrite, int *errorCodePtr)
-{
- Tcl_DString outstring;
- dtcl_server_conf *dsc = (dtcl_server_conf *)instancedata;
- /* we will have to deal with this when we switch over to using the
- channel directly */
- Tcl_UtfToExternalDString(NULL, buf, toWrite, &outstring);
- memwrite(dsc->obuffer, Tcl_DStringValue(&outstring),
- Tcl_DStringLength(&outstring));
- Tcl_DStringFree(&outstring);
- return toWrite;
-}
-
-static int closeproc(ClientData instancedata, Tcl_Interp *interp)
-{
- dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
- print_headers(globals->r);
- flush_output_buffer(globals->r);
- return 0;
-}
-
-static int setoptionproc(ClientData instancedata, Tcl_Interp *interp, char *optionname, char *value)
-{
- return TCL_OK;
-}
-
-/*
-int getoptionproc(ClientData instancedata, Tcl_Interp *intepr,
- char *optionname, Tcl_DString *dsPtr)
-{
- return TCL_OK;
-}
-*/
-
-static void watchproc(ClientData instancedata, int mask)
-{
- /* not much to do here */
- return;
-}
-
-static int gethandleproc(ClientData instancedata, int direction, ClientData *handlePtr)
-{
- return TCL_ERROR;
-}
-
-/* Write something to the output buffer structure */
-
-/* In the future, we ought to replace calls to this with
- Tcl_WriteChars or something else that uses the channel directly. */
-
-int memwrite(obuff *buffer, char *input, int len)
-{
- if (buffer->len == 0)
- {
- buffer->buf = Tcl_Alloc(len + 1);
- memcpy(buffer->buf, input, len);
- buffer->buf[len] = '\0';
- buffer->len = len;
- }
- else
- {
- char *bufend;
- buffer->buf = Tcl_Realloc(buffer->buf, len + buffer->len + 1);
- bufend = buffer->buf + buffer->len;
- memmove(bufend, input, len);
- buffer->buf[len + buffer->len] = '\0';
- buffer->len += len;
- }
- return len;
-}
-
/* Set up the content type header */
int set_header_type(request_rec *r, char *header)
@@ -262,12 +156,10 @@
int flush_output_buffer(request_rec *r)
{
dtcl_server_conf *dsc = dtcl_get_conf(r);
- if (dsc->obuffer->len != 0)
+ if (Tcl_DStringLength(dsc->buffer) != 0)
{
- ap_rwrite(dsc->obuffer->buf, dsc->obuffer->len, r);
- Tcl_Free(dsc->obuffer->buf);
- dsc->obuffer->len = 0;
- dsc->obuffer->buf = NULL;
+ ap_rwrite(Tcl_DStringValue(dsc->buffer), Tcl_DStringLength(dsc->buffer), r);
+ Tcl_DStringInit(dsc->buffer);
}
*(dsc->content_sent) = 1;
return 0;
@@ -280,7 +172,7 @@
char *temp;
Tcl_DString dstr;
Tcl_DStringInit(&dstr);
- Tcl_ExternalToUtfDString(system_encoding, input, strlen(input), &dstr);
+ Tcl_ExternalToUtfDString(NULL, input, strlen(input), &dstr);
temp = ap_pstrdup(pool, Tcl_DStringValue(&dstr));
Tcl_DStringFree(&dstr);
@@ -354,7 +246,8 @@
/* Parse and execute a ttml file */
-static int get_ttml_file(request_rec *r, dtcl_server_conf *dsc, Tcl_Interp *interp, char *filename, int toplevel, Tcl_Obj *outbuf)
+static int get_ttml_file(request_rec *r, dtcl_server_conf *dsc, Tcl_Interp *interp,
+ char *filename, int toplevel, Tcl_Obj *outbuf)
{
/* BEGIN PARSER */
int inside = 0; /* are we inside the starting/ending delimiters */
@@ -467,7 +360,8 @@
create it. */
if (*(dsc->cache_size))
{
- hashKey = ap_psprintf(r->pool, "%s%lx%lx%d", r->filename, r->finfo.st_mtime, r->finfo.st_ctime, toplevel);
+ hashKey = ap_psprintf(r->pool, "%s%lx%lx%d", r->filename,
+ r->finfo.st_mtime, r->finfo.st_ctime, toplevel);
entry = Tcl_CreateHashEntry(dsc->objCache, hashKey, &isNew);
}
if (isNew || *(dsc->cache_size) == 0)
@@ -493,11 +387,13 @@
dsc->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(dsc->objCache, dsc->objCacheList[*(dsc->cache_size) - 1]);
+ delEntry = Tcl_FindHashEntry(dsc->objCache,
+ dsc->objCacheList[*(dsc->cache_size) - 1]);
Tcl_DecrRefCount((Tcl_Obj *)Tcl_GetHashValue(delEntry));
Tcl_DeleteHashEntry(delEntry);
free(dsc->objCacheList[*(dsc->cache_size) - 1]);
- memmove((dsc->objCacheList) + 1, dsc->objCacheList, sizeof(char *) * (*(dsc->cache_size) -1));
+ memmove((dsc->objCacheList) + 1, dsc->objCacheList,
+ sizeof(char *) * (*(dsc->cache_size) -1));
dsc->objCacheList[0] = strdup(hashKey);
}
} else {
@@ -703,24 +599,23 @@
static void tcl_init_stuff(server_rec *s, pool *p)
{
int rslt;
- Tcl_Channel achan;
Tcl_Interp *interp;
- dtcl_server_conf *dsc = (dtcl_server_conf *) ap_get_module_config(s->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(s->module_config, &dtcl_module);
server_rec *sr;
/* Initialize TCL stuff */
+ Tcl_FindExecutable(NULL);
interp = Tcl_CreateInterp();
dsc->server_interp = interp; /* root interpreter */
/* Create TCL commands to deal with Apache's BUFFs. */
- achan = Tcl_CreateChannel(&Achan, "apacheout", dsc, TCL_WRITABLE);
-
- system_encoding = Tcl_GetEncoding(NULL, "iso8859-1"); /* FIXME */
+ *(dsc->outchannel) = Tcl_CreateChannel(&ApacheChan, "apacheout", dsc, TCL_WRITABLE);
- Tcl_SetStdChannel(achan, TCL_STDOUT);
- Tcl_SetChannelOption(interp, achan, "-buffering", "none");
+ Tcl_SetStdChannel(*(dsc->outchannel), TCL_STDOUT);
+ Tcl_SetChannelOption(interp, *(dsc->outchannel), "-buffering", "none");
- Tcl_RegisterChannel(interp, achan);
+ Tcl_RegisterChannel(interp, *(dsc->outchannel));
if (interp == NULL)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Error in Tcl_CreateInterp, aborting\n");
@@ -743,7 +638,8 @@
Tcl_IncrRefCount(dsc->namespacePrologue);
#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, "Config string = \"%s\"",
+ Tcl_GetStringFromObj(dsc->dtcl_global_init_script, NULL)); /* XXX */
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Cache size = \"%d\"", *(dsc->cache_size)); /* XXX */
#endif
@@ -792,8 +688,8 @@
{
mydsc->server_interp = Tcl_CreateSlave(interp, sr->server_hostname, 0);
tcl_create_commands(mydsc);
- Tcl_SetChannelOption(mydsc->server_interp, achan, "-buffering", "none");
- Tcl_RegisterChannel(mydsc->server_interp, achan);
+ Tcl_SetChannelOption(mydsc->server_interp, *(dsc->outchannel), "-buffering", "none");
+ Tcl_RegisterChannel(mydsc->server_interp, *(dsc->outchannel));
}
mydsc->server_name = ap_pstrdup(p, sr->server_hostname);
@@ -857,7 +753,8 @@
static const char *set_cachesize(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
- dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(s->module_config, &dtcl_module);
*(dsc->cache_size) = strtol(arg, NULL, 10);
return NULL;
}
@@ -865,7 +762,8 @@
static const char *set_uploaddir(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
- dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(s->module_config, &dtcl_module);
dsc->upload_dir = arg;
return NULL;
}
@@ -873,7 +771,8 @@
static const char *set_uploadmax(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
- dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ 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;
}
@@ -881,7 +780,8 @@
static const char *set_filestovar(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
- dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(s->module_config, &dtcl_module);
if (!strcmp(arg, "on"))
dsc->upload_files_to_var = 1;
else
@@ -892,7 +792,8 @@
static const char *set_seperatevirtinterps(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
- dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(s->module_config, &dtcl_module);
if (!strcmp(arg, "on"))
dsc->seperate_virtual_interps = 1;
else
@@ -917,9 +818,12 @@
newconfig->server_interp = dsc->server_interp;
copy_dtcl_config(r->pool, dsc, newconfig);
/* list here things that can be per-directory */
- 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;
+ 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; /* if there is no per dir config, just return the
@@ -954,7 +858,8 @@
newdsc->headers_printed = olddsc->headers_printed;
newdsc->headers_set = olddsc->headers_set;
newdsc->content_sent = olddsc->content_sent;
- newdsc->obuffer = olddsc->obuffer;
+ newdsc->buffer = olddsc->buffer;
+ newdsc->outchannel = olddsc->outchannel;
}
static void *create_dtcl_config(pool *p, server_rec *s)
@@ -991,7 +896,9 @@
*(dsc->headers_printed) = 0;
*(dsc->headers_set) = 0;
*(dsc->content_sent) = 0;
- dsc->obuffer = ap_pcalloc(p, sizeof(obuff));
+ dsc->buffer = ap_pcalloc(p, sizeof(Tcl_DString));
+ Tcl_DStringInit(dsc->buffer);
+ dsc->outchannel = ap_pcalloc(p, sizeof(Tcl_Channel));
return dsc;
}
@@ -1007,29 +914,41 @@
dtcl_server_conf *base = (dtcl_server_conf *) basev;
dtcl_server_conf *overrides = (dtcl_server_conf *) overridesv;
- dsc->server_interp = overrides->server_interp ? overrides->server_interp : base->server_interp;
+ dsc->server_interp = overrides->server_interp ?
+ overrides->server_interp : base->server_interp;
#if 0 /* this stuff should only be done once at the top level */
- dsc->dtcl_global_init_script = overrides->dtcl_global_init_script ? overrides->dtcl_global_init_script : base->dtcl_global_init_script;
+ dsc->dtcl_global_init_script = overrides->dtcl_global_init_script ?
+ overrides->dtcl_global_init_script : base->dtcl_global_init_script;
- dsc->dtcl_child_init_script = overrides->dtcl_child_init_script ? overrides->dtcl_child_init_script : base->dtcl_child_init_script;
+ dsc->dtcl_child_init_script = overrides->dtcl_child_init_script ?
+ overrides->dtcl_child_init_script : base->dtcl_child_init_script;
- dsc->dtcl_child_exit_script = overrides->dtcl_child_exit_script ? overrides->dtcl_child_exit_script : base->dtcl_child_exit_script;
+ dsc->dtcl_child_exit_script = overrides->dtcl_child_exit_script ?
+ overrides->dtcl_child_exit_script : base->dtcl_child_exit_script;
#endif
-
- dsc->dtcl_before_script = overrides->dtcl_before_script ? overrides->dtcl_before_script : base->dtcl_before_script;
- dsc->dtcl_after_script = overrides->dtcl_after_script ? overrides->dtcl_after_script : base->dtcl_after_script;
+ dsc->dtcl_before_script = overrides->dtcl_before_script ?
+ overrides->dtcl_before_script : base->dtcl_before_script;
- dsc->dtcl_error_script = overrides->dtcl_error_script ? overrides->dtcl_error_script : base->dtcl_error_script;
+ dsc->dtcl_after_script = overrides->dtcl_after_script ?
+ overrides->dtcl_after_script : base->dtcl_after_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->dtcl_error_script = overrides->dtcl_error_script ?
+ overrides->dtcl_error_script : base->dtcl_error_script;
- dsc->server_name = overrides->server_name ? overrides->server_name : base->server_name;
- dsc->upload_dir = overrides->upload_dir ? overrides->upload_dir : base->upload_dir;
+/* 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->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;
}
@@ -1050,19 +969,22 @@
if (dsc->dtcl_child_init_script != NULL)
if (Tcl_EvalObjEx(dsc->server_interp, dsc->dtcl_child_init_script, 0) != TCL_OK)
ap_log_error(APLOG_MARK, APLOG_ERR, s,
- "Problem running child init script: %s", Tcl_GetString(dsc->dtcl_child_init_script));
+ "Problem running child init script: %s",
+ Tcl_GetString(dsc->dtcl_child_init_script));
sr = sr->next;
}
}
void dtcl_child_exit(server_rec *s, pool *p)
{
- dtcl_server_conf *dsc = (dtcl_server_conf *) ap_get_module_config(s->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(s->module_config, &dtcl_module);
if (dsc->dtcl_child_exit_script != NULL)
if (Tcl_EvalObjEx(dsc->server_interp, dsc->dtcl_child_exit_script, 0) != TCL_OK)
ap_log_error(APLOG_MARK, APLOG_ERR, s,
- "Problem running child exit script: %s", Tcl_GetStringFromObj(dsc->dtcl_child_exit_script, NULL));
+ "Problem running child exit script: %s",
+ Tcl_GetStringFromObj(dsc->dtcl_child_exit_script, NULL));
}
const handler_rec dtcl_handlers[] =
1.13 +5 -7 tcl-moddtcl/mod_dtcl.h
Index: mod_dtcl.h
===================================================================
RCS file: /home/cvs/tcl-moddtcl/mod_dtcl.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- mod_dtcl.h 2001/09/02 14:04:16 1.12
+++ mod_dtcl.h 2001/09/05 12:01:22 1.13
@@ -1,6 +1,9 @@
#ifndef MOD_DTCL_H
#define MOD_DTCL_H 1
+#include <tcl.h>
+#include "apache_request.h"
+
/* Error wrappers */
#define ER1 "<hr><p><code><pre>\n"
#define ER2 "</pre></code><hr>\n"
@@ -49,11 +52,6 @@
/* #define DTCL_VERSION "X.X.X" */
typedef struct {
- char *buf;
- int len;
-} obuff;
-
-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;
@@ -79,7 +77,8 @@
int *headers_printed; /* has the header been printed yet? */
int *headers_set; /* has the header been set yet? */
int *content_sent; /* make sure something gets sent */
- obuff *obuffer;
+ Tcl_DString *buffer;
+ Tcl_Channel *outchannel;
} dtcl_server_conf;
/* eventually we will transfer 'global' variables in here and
@@ -90,7 +89,6 @@
ApacheRequest *req; /* libapreq request */
} dtcl_interp_globals;
-int memwrite(obuff *, char *, int);
int get_parse_exec_file(request_rec *r, dtcl_server_conf *dsc, int toplevel);
int set_header_type(request_rec *, char *);
int print_headers(request_rec *);
1.17 +62 -47 tcl-moddtcl/tcl_commands.c
Index: tcl_commands.c
===================================================================
RCS file: /home/cvs/tcl-moddtcl/tcl_commands.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- tcl_commands.c 2001/09/02 14:04:16 1.16
+++ tcl_commands.c 2001/09/05 12:01:22 1.17
@@ -31,7 +31,8 @@
char *filename;
struct stat finfo;
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);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc != 2)
{
@@ -65,7 +66,10 @@
int sz;
char buf[BUFSZ];
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);
+ dtcl_server_conf *dsc =
+ (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config,
+ &dtcl_module);
+ Tcl_Obj *outobj;
if (objc != 2)
{
@@ -74,7 +78,7 @@
}
fd = Tcl_OpenFileChannel(interp,
- Tcl_GetStringFromObj (objv[1], (int *)NULL), "r", 0664);
+ Tcl_GetStringFromObj(objv[1], (int *)NULL), "r", 0664);
if (fd == NULL)
{
@@ -85,13 +89,14 @@
/* print_headers(globals->r);
flush_output_buffer(globals->r); */
- /* Use Tcl_Read because we don't want to fool with UTF - just read
- it in and dump it out. */
- while ((sz = Tcl_Read(fd, buf, BUFSZ - 1)))
+ outobj = Tcl_NewObj();
+ Tcl_IncrRefCount(outobj);
+ while ((sz = Tcl_ReadChars(fd, outobj, BUFSZ - 1, 0)))
{
if (sz == -1)
{
Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
+ Tcl_DecrRefCount(outobj);
return TCL_ERROR;
}
@@ -99,38 +104,30 @@
/* we could include code to either ap_pwrite this or memwrite
it, depending on buffering */
- memwrite(dsc->obuffer, buf, sz);
+ Tcl_WriteObj(*(dsc->outchannel), outobj);
if (sz < BUFSZ - 1)
break;
}
- return Tcl_Close(interp,fd);
-
-/* close(fd); */
- return TCL_OK;
+ Tcl_DecrRefCount(outobj);
+ return Tcl_Close(interp, fd);
}
/* Command to *only* add to the output buffer */
int Buffer_Add(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
- char *arg1;
- int len;
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);
- Tcl_DString outstring;
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
- arg1 = Tcl_GetByteArrayFromObj(objv[1], &len);
-
- Tcl_UtfToExternalDString(NULL, arg1, len, &outstring);
- memwrite(dsc->obuffer, Tcl_DStringValue(&outstring), Tcl_DStringLength(&outstring));
+ Tcl_WriteObj(*(dsc->outchannel), objv[1]);
*(dsc->content_sent) = 0;
- Tcl_DStringFree(&outstring);
return TCL_OK;
}
@@ -141,7 +138,8 @@
char *arg1;
int length;
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);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc < 2)
{
@@ -149,7 +147,7 @@
return TCL_ERROR;
}
- arg1 = Tcl_GetByteArrayFromObj(objv[1], &length);
+ arg1 = Tcl_GetStringFromObj(objv[1], &length);
if (!strncmp("-error", arg1, 6))
{
@@ -170,11 +168,11 @@
}
/* transform it from UTF to External representation */
Tcl_UtfToExternalDString(NULL, arg1, length, &outstring);
- arg1 = Tcl_DStringValue(&outstring);
+ arg1 = Tcl_DStringValue(&outstring);
length = Tcl_DStringLength(&outstring);
if (*(dsc->buffer_output) == 1)
{
- memwrite(dsc->obuffer, arg1, length);
+ Tcl_DStringAppend(dsc->buffer, arg1, length);
} else {
print_headers(globals->r);
flush_output_buffer(globals->r);
@@ -192,7 +190,8 @@
{
char *opt;
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);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc < 2)
{
@@ -243,7 +242,8 @@
Tcl_WrongNumArgs(interp, 2, objv, "new-url");
return TCL_ERROR;
}
- ap_table_set(globals->r->headers_out, "Location", Tcl_GetStringFromObj (objv[2], (int *)NULL));
+ ap_table_set(globals->r->headers_out, "Location",
+ Tcl_GetStringFromObj (objv[2], (int *)NULL));
globals->r->status = 301;
return TCL_RETURN;
}
@@ -292,7 +292,8 @@
{
char *opt = NULL;
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);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc != 2)
{
@@ -393,31 +394,42 @@
}
/* These were the "include vars" */
- 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);
+ 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(globals->r->finfo.st_uid);
if (pw)
- Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("USER_NAME", -1), STRING_TO_UTF_TO_OBJ(ap_pstrdup(POOL, pw->pw_name), POOL), 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(POOL, "user#%lu", (unsigned long) globals->r->finfo.st_uid), POOL), 0);
+ 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, EnvsObj, Tcl_NewStringObj("DOCUMENT_NAME", -1), STRING_TO_UTF_TO_OBJ(++t, POOL), 0);
+ 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(globals->r->uri, POOL), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, 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, EnvsObj, Tcl_NewStringObj("QUERY_STRING_UNESCAPED", -1), STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(POOL, arg_copy), POOL), 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);
}
/* ---------------------------- */
@@ -428,7 +440,8 @@
if (!hdrs[i].key)
continue;
else {
- Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(hdrs[i].key, POOL), STRING_TO_UTF_TO_OBJ(hdrs[i].val, POOL), 0);
+ Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(hdrs[i].key, POOL),
+ STRING_TO_UTF_TO_OBJ(hdrs[i].val, POOL), 0);
}
}
@@ -437,7 +450,8 @@
{
if (!env[i].key)
continue;
- Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(env[i].key, POOL), STRING_TO_UTF_TO_OBJ(env[i].val, POOL), 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 */
@@ -487,7 +501,8 @@
if (objc < 2 || objc > 3)
{
- Tcl_WrongNumArgs(interp, 1, objv, "(get varname|list varname|exists varname|names|number|all)");
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "(get varname|list varname|exists varname|names|number|all)");
return TCL_ERROR;
}
command = Tcl_GetString(objv[1]);
@@ -666,7 +681,8 @@
Tcl_Obj *result = NULL;
ApacheUpload *upload;
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);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc < 2 || objc > 5)
{
@@ -838,8 +854,8 @@
"</table>\n"
"</td></tr></table>\n", *(dsc->cache_free), getpid());
/* print_headers(globals->r);
- flush_output_buffer(globals->r); */
- memwrite(dsc->obuffer, tble, strlen(tble));
+ flush_output_buffer(globals->r); */
+ Tcl_WriteObj(*(dsc->outchannel), Tcl_NewStringObj(tble, -1));
return TCL_OK;
}
@@ -850,14 +866,13 @@
{
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);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)
+ ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (*(dsc->content_sent) == 1)
return TCL_ERROR;
print_headers(globals->r);
- Tcl_Free(dsc->obuffer->buf);
- dsc->obuffer->buf = NULL;
- dsc->obuffer->len = 0;
+ Tcl_DStringInit(dsc->buffer);
return TCL_OK;
}
1.1 tcl-moddtcl/channel.c
Index: channel.c
===================================================================
#include "httpd.h"
#include "http_config.h"
#include "http_request.h"
#include <tcl.h>
#include <errno.h>
#include "apache_request.h"
#include "mod_dtcl.h"
/* This file describes the mod_dtcl Tcl output channel. */
static int inputproc(ClientData instancedata, char *buf, int toRead, int *errorCodePtr)
{
return EINVAL;
}
/* This is the output 'method' for the Memory Buffer Tcl 'File'
Channel that we create to divert stdout to */
static int outputproc(ClientData instancedata, char *buf, int toWrite, int *errorCodePtr)
{
dtcl_server_conf *dsc = (dtcl_server_conf *)instancedata;
Tcl_DStringAppend(dsc->buffer, buf, toWrite);
return toWrite;
}
static int closeproc(ClientData instancedata, Tcl_Interp *interp)
{
dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
print_headers(globals->r);
flush_output_buffer(globals->r);
return 0;
}
static int setoptionproc(ClientData instancedata, Tcl_Interp *interp,
char *optionname, char *value)
{
return TCL_OK;
}
/*
int getoptionproc(ClientData instancedata, Tcl_Interp *intepr,
char *optionname, Tcl_DString *dsPtr)
{
return TCL_OK;
}
*/
static void watchproc(ClientData instancedata, int mask)
{
/* not much to do here */
return;
}
static int gethandleproc(ClientData instancedata, int direction, ClientData *handlePtr)
{
return TCL_ERROR;
}
Tcl_ChannelType ApacheChan = {
"apache_channel",
NULL,
closeproc,
inputproc,
outputproc,
NULL,
setoptionproc,
NULL,
watchproc,
gethandleproc,
NULL
};
1.1 tcl-moddtcl/channel.h
Index: channel.h
===================================================================
/* Functions for mod_dtcl Tcl output channel .*/
#include "mod_dtcl.h"
extern int closeproc(ClientData, Tcl_Interp *);
extern int inputproc(ClientData, char *, int, int *);
extern int outputproc(ClientData, char *, int, int *);
extern int setoptionproc(ClientData, Tcl_Interp *, char *, char *);
/* extern int getoptionproc(ClientData, Tcl_Interp *, char *, Tcl_DString *); */
extern void watchproc(ClientData, int);
extern int gethandleproc(ClientData, int, ClientData *);
extern Tcl_ChannelType ApacheChan;
1.7 +1 -3 tcl-moddtcl/debian/rules
Index: rules
===================================================================
RCS file: /home/cvs/tcl-moddtcl/debian/rules,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- rules 2001/05/22 17:05:42 1.6
+++ rules 2001/09/05 12:01:22 1.7
@@ -1,7 +1,7 @@
#!/usr/bin/make -f
# Made with the aid of debmake, by Christoph Lameter,
# based on the sample debian/rules file for GNU hello by Ian Jackson.
-# $Id: rules,v 1.6 2001/05/22 17:05:42 davidw Exp $
+# $Id: rules,v 1.7 2001/09/05 12:01:22 davidw Exp $
TCL_VERSION=8.3
@@ -32,8 +32,6 @@
cd debian/tmp && install -d `cat ../dirs`
cp mod_dtcl.so debian/tmp/usr/lib/apache/1.3/
cp debian/400mod_dtcl.info debian/tmp/usr/lib/apache/1.3/
-# Must have debmake installed for this to work. Otherwise please copy
-# /usr/bin/debstd into the debian directory and change debstd to debian/debstd
dh_installdocs docs/ contrib/
dh_installchangelogs
dh_installmanpages