You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by da...@apache.org on 2006/01/14 18:16:52 UTC
svn commit: r369059 [6/7] - in /tcl/rivet/trunk: ./ doc/html/ src/
src/apache-1/ src/apache-2/
Added: tcl/rivet/trunk/src/apache-2/mod_rivet.c
URL: http://svn.apache.org/viewcvs/tcl/rivet/trunk/src/apache-2/mod_rivet.c?rev=369059&view=auto
==============================================================================
--- tcl/rivet/trunk/src/apache-2/mod_rivet.c (added)
+++ tcl/rivet/trunk/src/apache-2/mod_rivet.c Sat Jan 14 09:15:42 2006
@@ -0,0 +1,1708 @@
+/* mod_rivet.c -- The apache module itself, for Apache 1.3. */
+
+/* Copyright 2000-2005 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+
+/* Rivet config */
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include <sys/stat.h>
+#include <string.h>
+
+/* Apache includes */
+#include <httpd.h>
+#include <http_config.h>
+#include <http_request.h>
+#include <http_core.h>
+#include <http_protocol.h>
+#include <http_log.h>
+#include <http_main.h>
+#include <util_script.h>
+//#include "http_conf_globals.h"
+#include <http_config.h>
+
+#include <apr_pools.h>
+#include <apr_strings.h>
+#include <apr_tables.h>
+
+/* Tcl includes */
+#include <tcl.h>
+/* There is code ifdef'ed out below which uses internal
+ * declerations. */
+/* #include <tclInt.h> */
+
+/* Rivet Includes */
+#include "mod_rivet.h"
+#include "rivet.h"
+#include "rivetParser.h"
+#include "rivetChannel.h"
+
+//module AP_MODULE_DECLARE_DATA rivet_module;
+
+/* This is used *only* in the PanicProc. Otherwise, don't touch
+ * it! */
+static request_rec *globalrr;
+
+/* Need some arbitrary non-NULL pointer which can't also be a request_rec */
+#define NESTED_INCLUDE_MAGIC (&rivet_module)
+#define DEBUG(s) fprintf(stderr, s), fflush(stderr)
+
+/* rivet or tcl file */
+#define RIVET_FILE 1
+#define TCL_FILE 2
+
+/* rivet return codes */
+#define RIVET_OK 0
+#define RIVET_ERROR 1
+
+TCL_DECLARE_MUTEX(sendMutex);
+
+/* Function to be used should we desire to upload files to a variable */
+
+#if 0
+int
+Rivet_UploadHook(void *ptr, char *buf, int len, ApacheUpload *upload)
+{
+ Tcl_Interp *interp = ptr;
+ static int usenum = 0;
+ static int uploaded = 0;
+
+ if (oldptr != upload)
+ {
+ } else {
+ }
+
+ return len;
+}
+#endif /* 0 */
+
+/*
+ * Rivet_IsRivetFile(char*)
+ *
+ * small helper function to get the file type. Returns 1 if
+ * the file ends with .rvt, 0 otherwise.
+ */
+static int
+Rivet_IsRivetFile (char *filepath)
+{
+ char *fileCopy = (char*) malloc((strlen(filepath)+1) * sizeof(char));
+ char *cPtr;
+
+ strcpy (fileCopy, filepath);
+ cPtr = fileCopy + (strlen(fileCopy) - 3);
+
+ if (*(cPtr-1) != '.') {
+ char *ePtr = fileCopy + (strlen(fileCopy) - 1);
+ while (*ePtr-- != '?')
+ ;
+ ePtr++;
+ *ePtr = '\0';
+ cPtr = ePtr - 3;
+ }
+
+ if (strcmp (cPtr, "rvt") == 0) {
+ return RIVET_FILE;
+ }
+ else if (strcmp (cPtr, "tcl") == 0) {
+ return TCL_FILE;
+ }
+
+ return 0;
+}
+
+/*
+ * Rivet_ParseFileArgString (char *szDocRoot, char *szArgs, char **file)
+ *
+ * parses a string like /path/file.ext?arg1=value1&arg2=value2 into
+ * the filename and arguments. A Tcl_Hashtable is utilized for the
+ * arguments and returned. The file name is appended to the szDocRoot
+ * argument and stored in the *file pointer.
+ */
+static int
+Rivet_ParseFileArgString (const char *szDocRoot, const char *szArgs, char **file,
+ Tcl_HashTable *argTbl)
+{
+ int flen = 1, newEntry, i;
+ const char *rootPtr = szDocRoot, *argsPtr = szArgs, *argPos;
+ char *fn = (char*)malloc((strlen(szArgs)+1)*sizeof(char));
+ char *filePtr = fn;
+ char *argument, *value;
+ Tcl_HashEntry *entryPtr;
+
+ /*
+ * parse filename, that is everything before ? in the args string.
+ * Append it to the document root, if this is not NULL. We don't use
+ * strcat() here, just for fun...
+ */
+ while (*argsPtr && (*filePtr++ = *argsPtr++) != '?')
+ ;
+ if (*(filePtr-1) == '?')
+ *(filePtr-1) = '\0';
+ else
+ *filePtr = '\0';
+
+ flen += strlen (fn);
+ if (szDocRoot != NULL)
+ flen += strlen (szDocRoot);
+
+ *file = (char*) malloc (flen * sizeof(char));
+ filePtr = *file;
+ while ((*filePtr++ = *rootPtr++))
+ ;
+ filePtr--;
+ rootPtr = fn;
+ while ((*filePtr++ = *rootPtr++))
+ ;
+
+ if (argTbl == NULL)
+ return RIVET_OK;
+
+ /*
+ * past this point, parse remainder of the args string. For every argument,
+ * create a new entry in the argTbl Tcl_HashTable.
+ */
+ Tcl_InitHashTable (argTbl, TCL_STRING_KEYS);
+
+ for (i = 0, argPos = argsPtr; i < strlen(argsPtr); i++) {
+ if (*(argsPtr + i) == '=') {
+ /* argument ends */
+ argument = (char*) malloc ((strlen(szArgs)+1) * sizeof(char));
+ char *ap = argument;
+ while ((*ap++ = *argPos++) != '=')
+ ;
+ *--ap = '\0';
+ } else if (*(argsPtr + i) == '&' || i == strlen(argsPtr)-1) {
+ /* value ends */
+ value = (char*) malloc ((strlen(szArgs)+1) * sizeof(char));
+ char *vp = value;
+ while ((*vp++ = *argPos++) != '&')
+ ;
+ *--vp = '\0';
+
+ if (argument == NULL) {
+ argument = value;
+ value = "1";
+ }
+ entryPtr = Tcl_CreateHashEntry (argTbl, (CONST char*) argument,
+ &newEntry);
+ Tcl_SetHashValue (entryPtr, value);
+ argument = NULL;
+ value = NULL;
+ }
+ }
+
+ return RIVET_OK;
+}
+
+
+/*
+ * Setup an array in each interpreter to tell us things about Apache.
+ * This saves us from having to do any real call to load an entire
+ * environment. This routine only gets called once, when the child process
+ * is created.
+ *
+ * SERVER_ROOT - Apache's root location
+ * SERVER_CONF - Apache's configuration file
+ * RIVET_DIR - Rivet's Tcl source directory
+ * RIVET_INIT - Rivet's init.tcl file
+ */
+static void
+Rivet_InitServerVariables( Tcl_Interp *interp, apr_pool_t *p )
+{
+ Tcl_Obj *obj;
+
+ obj = Tcl_NewStringObj(ap_server_root, -1);
+ Tcl_IncrRefCount(obj);
+ Tcl_SetVar2Ex(interp,
+ "server",
+ "SERVER_ROOT",
+ obj,
+ TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(obj);
+
+ //obj = Tcl_NewStringObj(ap_server_root_relative(p, ap_server_confname), -1);
+ //TODO: fix server conf name
+ obj = Tcl_NewStringObj ("serverconfname", -1);
+ Tcl_IncrRefCount(obj);
+ Tcl_SetVar2Ex(interp,
+ "server",
+ "SERVER_CONF",
+ obj,
+ TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(obj);
+
+ obj = Tcl_NewStringObj(ap_server_root_relative(p, RIVET_DIR), -1);
+ Tcl_IncrRefCount(obj);
+ Tcl_SetVar2Ex(interp,
+ "server",
+ "RIVET_DIR",
+ obj,
+ TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(obj);
+
+ obj = Tcl_NewStringObj(ap_server_root_relative(p, RIVET_INIT), -1);
+ Tcl_IncrRefCount(obj);
+ Tcl_SetVar2Ex(interp,
+ "server",
+ "RIVET_INIT",
+ obj,
+ TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(obj);
+}
+
+static void
+Rivet_PropagateServerConfArray( Tcl_Interp *interp, rivet_server_conf *rsc )
+{
+ apr_table_t *t;
+ apr_array_header_t *arr;
+ apr_table_entry_t *elts;
+ int i, nelts;
+ Tcl_Obj *key;
+ Tcl_Obj *val;
+ Tcl_Obj *arrayName;
+
+ /* Propagate all of the ServerConf variables into an array. */
+ t = rsc->rivet_server_vars;
+ arr = (apr_array_header_t*) apr_table_elts( t );
+ elts = (apr_table_entry_t *) arr->elts;
+ nelts = arr->nelts;
+
+ arrayName = Tcl_NewStringObj("RivetServerConf", -1);
+ Tcl_IncrRefCount(arrayName);
+
+ for( i = 0; i < nelts; ++i )
+ {
+ key = Tcl_NewStringObj( elts[i].key, -1);
+ val = Tcl_NewStringObj( elts[i].val, -1);
+ Tcl_IncrRefCount(key);
+ Tcl_IncrRefCount(val);
+ Tcl_ObjSetVar2(interp,
+ arrayName,
+ key,
+ val,
+ TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(key);
+ Tcl_DecrRefCount(val);
+ }
+ Tcl_DecrRefCount(arrayName);
+}
+
+/* Calls Tcl_EvalObjEx() and checks for errors
+ * Prints the error buffer if any.
+ */
+static int
+Rivet_ExecuteAndCheck(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec *r)
+{
+ rivet_server_conf *conf = Rivet_GetConf(r);
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if( Tcl_EvalObjEx(interp, outbuf, 0) == TCL_ERROR ) {
+ Tcl_Obj *errscript;
+ Tcl_Obj *errorCodeListObj;
+ Tcl_Obj *errorCodeElementObj;
+ char *errorCodeSubString;
+
+ /* There was an error, see if it's from Rivet and it was caused
+ * by abort_page.
+ */
+
+ errorCodeListObj = Tcl_GetVar2Ex (interp, "errorCode", (char *)NULL, TCL_GLOBAL_ONLY);
+ /* errorCode is guaranteed to be set to NONE, but let's make sure
+ * anyway rather than causing a SIGSEGV
+ */
+ ap_assert (errorCodeListObj != (Tcl_Obj *)NULL);
+
+ /* dig the first element out of the errorCode list and see if it
+ * says Rivet -- this shouldn't fail either, but let's assert
+ * success so we don't get a SIGSEGV afterwards */
+ ap_assert (Tcl_ListObjIndex (interp, errorCodeListObj, 0, &errorCodeElementObj) == TCL_OK);
+
+ /* if the error was thrown by Rivet, see if it's abort_page and,
+ * if so, don't treat it as an error, i.e. don't execute the
+ * installed error handler or the default one, just let the
+ * page emit as normal
+ */
+ if (strcmp (Tcl_GetString (errorCodeElementObj), "RIVET") == 0) {
+
+ /* dig the second element out of the errorCode list, make sure
+ * it succeeds -- it should always
+ */
+ ap_assert (Tcl_ListObjIndex (interp, errorCodeListObj, 1, &errorCodeElementObj) == TCL_OK);
+
+ errorCodeSubString = Tcl_GetString (errorCodeElementObj);
+ if (strcmp (errorCodeSubString, "ABORTPAGE") == 0) {
+ goto good;
+ }
+ }
+
+ Tcl_SetVar( interp, "errorOutbuf",
+ Tcl_GetStringFromObj( outbuf, NULL ),
+ TCL_GLOBAL_ONLY );
+
+ /* If we don't have an error script, use the default error handler. */
+ if (conf->rivet_error_script ) {
+ errscript = Tcl_NewStringObj(conf->rivet_error_script, -1);
+ } else {
+ errscript = conf->rivet_default_error_script;
+ }
+
+ Tcl_IncrRefCount(errscript);
+ if (Tcl_EvalObjEx(interp, errscript, 0) == TCL_ERROR) {
+ CONST84 char *errorinfo = Tcl_GetVar( interp, "errorInfo", 0 );
+ TclWeb_PrintError("<b>Rivet ErrorScript failed!</b>", 1,
+ globals->req);
+ TclWeb_PrintError( errorinfo, 0, globals->req );
+ }
+
+ /* This shouldn't make the default_error_script go away,
+ * because it gets a Tcl_IncrRefCount when it is created. */
+ Tcl_DecrRefCount(errscript);
+ }
+
+ /* Make sure to flush the output if buffer_add was the only output */
+good:
+ TclWeb_PrintHeaders(globals->req);
+ Tcl_Flush(*(conf->outchannel));
+
+ return TCL_OK;
+}
+
+
+
+
+/* This is a separate function so that it may be called from 'Parse' */
+int
+Rivet_ParseExecFile(TclWebRequest *req, char *filename, int toplevel)
+{
+ char *hashKey = NULL;
+ int isNew = 0;
+ int result = 0;
+
+ Tcl_Obj *outbuf = NULL;
+ Tcl_HashEntry *entry = NULL;
+
+ time_t ctime;
+ time_t mtime;
+
+ rivet_server_conf *rsc;
+ Tcl_Interp *interp = req->interp;
+
+ rsc = Rivet_GetConf( req->req );
+
+ /* If the user configuration has indeed been updated, I guess that
+ pretty much invalidates anything that might have been
+ cached. */
+
+ /* This is all horrendously slow, and means we should *also* be
+ doing caching on the modification time of the .htaccess files
+ that concern us. FIXME */
+
+ if (rsc->user_scripts_updated && *(rsc->cache_size) != 0) {
+ int ct;
+ Tcl_HashEntry *delEntry;
+ /* Clean out the list. */
+ ct = *(rsc->cache_free);
+ while (ct < *(rsc->cache_size)) {
+ /* Free the corresponding hash entry. */
+ delEntry = Tcl_FindHashEntry(
+ rsc->objCache,
+ rsc->objCacheList[ct]);
+ if (delEntry != NULL)
+ Tcl_DecrRefCount((Tcl_Obj *)Tcl_GetHashValue(delEntry));
+ Tcl_DeleteHashEntry(delEntry);
+
+ free(rsc->objCacheList[ct]);
+ rsc->objCacheList[ct] = NULL;
+ ct ++;
+ }
+ *(rsc->cache_free) = *(rsc->cache_size);
+ }
+
+
+ /* If toplevel is 0, we are being called from Parse, which means
+ we need to get the information about the file ourselves. */
+ if (toplevel == 0)
+ {
+ Tcl_Obj *fnobj;
+ Tcl_StatBuf buf;
+
+ fnobj = Tcl_NewStringObj(filename, -1);
+ Tcl_IncrRefCount(fnobj);
+ if( Tcl_FSStat(fnobj, &buf) < 0 )
+ return TCL_ERROR;
+ Tcl_DecrRefCount(fnobj);
+ ctime = buf.st_ctime;
+ mtime = buf.st_mtime;
+ } else {
+ //ctime = req->req->finfo.st_ctime;
+ //mtime = req->req->finfo.st_mtime;
+ ctime = req->req->finfo.ctime;
+ mtime = req->req->finfo.mtime;
+ }
+
+ /* Look for the script's compiled version. If it's not found,
+ * create it.
+ */
+ if (*(rsc->cache_size))
+ {
+ hashKey = (char*) apr_psprintf(req->req->pool, "%s%lx%lx%d", filename,
+ mtime, ctime, toplevel);
+ entry = Tcl_CreateHashEntry(rsc->objCache, hashKey, &isNew);
+ }
+
+ /* We don't have a compiled version. Let's create one. */
+ if (isNew || *(rsc->cache_size) == 0)
+ {
+ //char *hkCopy;
+
+ outbuf = Tcl_NewObj();
+ Tcl_IncrRefCount(outbuf);
+
+ if (toplevel) {
+ if (rsc->rivet_before_script) {
+ Tcl_AppendObjToObj(outbuf,
+ Tcl_NewStringObj(rsc->rivet_before_script, -1));
+ }
+ }
+
+ //if( 1//STREQU( req->req->content_type, "application/x-httpd-rivet")
+ // || !toplevel )
+ if (Rivet_IsRivetFile(filename) == RIVET_FILE)
+ {
+ /* toplevel == 0 means we are being called from the parse
+ * command, which only works on Rivet .rvt files. */
+ result = Rivet_GetRivetFile(filename, toplevel, outbuf, interp);
+ } else {
+ /* It's a plain Tcl file */
+ result = Rivet_GetTclFile(filename, outbuf, interp);
+ }
+
+ if (result != TCL_OK)
+ {
+ Tcl_DecrRefCount(outbuf);
+ return result;
+ }
+ if (toplevel) {
+ if (rsc->rivet_after_script) {
+ Tcl_AppendObjToObj(outbuf,
+ Tcl_NewStringObj(rsc->rivet_after_script, -1));
+ }
+ }
+
+ if (*(rsc->cache_size)) {
+ /* We need to incr the reference count of outbuf because we want
+ * it to outlive this function. This allows it to stay alive
+ * as long as it's in the object cache.
+ */
+ Tcl_IncrRefCount( outbuf );
+ Tcl_SetHashValue(entry, (ClientData)outbuf);
+ }
+
+ if (*(rsc->cache_free)) {
+
+ //hkCopy = (char*) malloc ((strlen(hashKey)+1) * sizeof(char));
+ //strcpy(rsc->objCacheList[-- *(rsc->cache_free)], hashKey);
+ rsc->objCacheList[--*(rsc->cache_free)] =
+ (char*) malloc ((strlen(hashKey)+1) * sizeof(char));
+ strcpy(rsc->objCacheList[*(rsc->cache_free)], hashKey);
+ //rsc->objCacheList[-- *(rsc->cache_free) ] = strdup(hashKey);
+ } else if (*(rsc->cache_size)) { /* If it's zero, we just skip this. */
+ Tcl_HashEntry *delEntry;
+ delEntry = Tcl_FindHashEntry(
+ rsc->objCache,
+ rsc->objCacheList[*(rsc->cache_size) - 1]);
+ Tcl_DecrRefCount((Tcl_Obj *)Tcl_GetHashValue(delEntry));
+ Tcl_DeleteHashEntry(delEntry);
+ free(rsc->objCacheList[*(rsc->cache_size) - 1]);
+ memmove((rsc->objCacheList) + 1, rsc->objCacheList,
+ sizeof(char *) * (*(rsc->cache_size) -1));
+
+ //hkCopy = (char*) malloc ((strlen(hashKey)+1) * sizeof(char));
+ //strcpy (rsc->objCacheList[0], hashKey);
+ rsc->objCacheList[0] = (char*) malloc ((strlen(hashKey)+1) * sizeof(char));
+ strcpy (rsc->objCacheList[0], hashKey);
+
+ //rsc->objCacheList[0] = (char*) strdup(hashKey);
+ }
+ } else {
+ /* We found a compiled version of this page. */
+ outbuf = (Tcl_Obj *)Tcl_GetHashValue(entry);
+ Tcl_IncrRefCount(outbuf);
+ }
+ rsc->user_scripts_updated = 0;
+ {
+ int res = 0;
+ res = Rivet_ExecuteAndCheck(interp, outbuf, req->req);
+ Tcl_DecrRefCount(outbuf);
+ return res;
+ }
+}
+
+static void
+Rivet_CleanupRequest( request_rec *r )
+{
+#if 0
+ apr_table_t *t;
+ apr_array_header_t *arr;
+ apr_table_entry_t *elts;
+ int i, nelts;
+ Tcl_Obj *arrayName;
+ Tcl_Interp *interp;
+
+ rivet_server_conf *rsc = RIVET_SERVER_CONF( r->per_dir_config );
+
+ t = rsc->rivet_user_vars;
+ arr = (apr_array_header_t*) apr_table_elts( t );
+ elts = (apr_table_entry_t *) arr->elts;
+ nelts = arr->nelts;
+ arrayName = Tcl_NewStringObj( "RivetUserConf", -1 );
+ interp = rsc->server_interp;
+
+ for( i = 0; i < nelts; ++i )
+ {
+ Tcl_UnsetVar2(interp,
+ "RivetUserConf",
+ elts[i].key,
+ TCL_GLOBAL_ONLY);
+ }
+ Tcl_DecrRefCount(arrayName);
+
+ rivet_server_conf *rdc = RIVET_SERVER_CONF( r->per_dir_config );
+
+ if( rdc->rivet_before_script ) {
+ Tcl_DecrRefCount( rdc->rivet_before_script );
+ }
+ if( rdc->rivet_after_script ) {
+ Tcl_DecrRefCount( rdc->rivet_after_script );
+ }
+ if( rdc->rivet_error_script ) {
+ Tcl_DecrRefCount( rdc->rivet_error_script );
+ }
+#endif
+}
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_CopyConfig --
+ *
+ * Copy the rivet_server_conf struct.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void
+Rivet_CopyConfig( rivet_server_conf *oldrsc, rivet_server_conf *newrsc )
+{
+ FILEDEBUGINFO;
+
+ newrsc->server_interp = oldrsc->server_interp;
+ newrsc->rivet_global_init_script = oldrsc->rivet_global_init_script;
+
+ newrsc->rivet_before_script = oldrsc->rivet_before_script;
+ newrsc->rivet_after_script = oldrsc->rivet_after_script;
+ newrsc->rivet_error_script = oldrsc->rivet_error_script;
+
+ newrsc->user_scripts_updated = oldrsc->user_scripts_updated;
+
+ newrsc->rivet_default_error_script = oldrsc->rivet_default_error_script;
+
+ /* These are pointers so that they can be passed around... */
+ newrsc->cache_size = oldrsc->cache_size;
+ newrsc->cache_free = oldrsc->cache_free;
+ newrsc->cache_size = oldrsc->cache_size;
+ newrsc->cache_free = oldrsc->cache_free;
+ newrsc->upload_max = oldrsc->upload_max;
+ newrsc->upload_files_to_var = oldrsc->upload_files_to_var;
+ newrsc->separate_virtual_interps = oldrsc->separate_virtual_interps;
+ newrsc->server_name = oldrsc->server_name;
+ newrsc->upload_dir = oldrsc->upload_dir;
+ newrsc->rivet_server_vars = oldrsc->rivet_server_vars;
+ newrsc->rivet_dir_vars = oldrsc->rivet_dir_vars;
+ newrsc->rivet_user_vars = oldrsc->rivet_user_vars;
+ newrsc->objCacheList = oldrsc->objCacheList;
+ newrsc->objCache = oldrsc->objCache;
+
+ newrsc->outchannel = oldrsc->outchannel;
+}
+
+/*
+ * Merge the per-directory configuration options into a new configuration.
+ */
+static void
+Rivet_MergeDirConfigVars(apr_pool_t *p, rivet_server_conf *new,
+ rivet_server_conf *base, rivet_server_conf *add )
+{
+ FILEDEBUGINFO;
+
+ new->rivet_before_script = add->rivet_before_script ?
+ add->rivet_before_script : base->rivet_before_script;
+ new->rivet_after_script = add->rivet_after_script ?
+ add->rivet_after_script : base->rivet_after_script;
+ new->rivet_error_script = add->rivet_error_script ?
+ add->rivet_error_script : base->rivet_error_script;
+
+ new->user_scripts_updated = add->user_scripts_updated ?
+ add->user_scripts_updated : base->user_scripts_updated;
+
+ new->upload_dir = add->upload_dir ?
+ add->upload_dir : base->upload_dir;
+
+ /* Merge the tables of dir and user variables. */
+ if (base->rivet_dir_vars && add->rivet_dir_vars) {
+ new->rivet_dir_vars =
+ apr_table_overlay ( p, base->rivet_dir_vars, add->rivet_dir_vars );
+ } else {
+ new->rivet_dir_vars = base->rivet_dir_vars;
+ }
+ if (base->rivet_user_vars && add->rivet_user_vars) {
+ new->rivet_user_vars =
+ apr_table_overlay ( p, base->rivet_user_vars, add->rivet_user_vars );
+ } else {
+ new->rivet_user_vars = base->rivet_user_vars;
+ }
+}
+
+
+
+
+/* Function to get a config and merge the directory/server options */
+rivet_server_conf *
+Rivet_GetConf( request_rec *r )
+{
+ rivet_server_conf *newconfig = NULL;
+ rivet_server_conf *rsc = RIVET_SERVER_CONF( r->server->module_config );
+ rivet_server_conf *rdc;
+ void *dconf = r->per_dir_config;
+ //int tst;
+
+ FILEDEBUGINFO;
+
+ /* If there is no per dir config, just return the server config */
+ if (dconf == NULL) {
+ return rsc;
+ }
+
+ return rsc;
+
+ rdc = RIVET_SERVER_CONF( dconf );
+
+ newconfig = RIVET_NEW_CONF( r->pool );
+
+ Rivet_CopyConfig( rsc, newconfig );
+
+ Rivet_MergeDirConfigVars( r->pool, newconfig, rsc, rdc );
+
+ return newconfig;
+}
+
+static void *
+Rivet_CreateConfig(apr_pool_t *p, server_rec *s )
+{
+ rivet_server_conf *rsc = RIVET_NEW_CONF(p);
+
+ FILEDEBUGINFO;
+
+ rsc->server_interp = NULL;
+ rsc->rivet_global_init_script = NULL;
+ rsc->rivet_child_init_script = NULL;
+ rsc->rivet_child_exit_script = NULL;
+ rsc->rivet_before_script = NULL;
+ rsc->rivet_after_script = NULL;
+ rsc->rivet_error_script = NULL;
+
+ rsc->user_scripts_updated = 0;
+
+ rsc->rivet_default_error_script = Tcl_NewStringObj("::Rivet::handle_error", -1);
+ Tcl_IncrRefCount(rsc->rivet_default_error_script);
+
+ /* these are pointers so that they can be passed around... */
+ rsc->cache_size = apr_pcalloc(p, sizeof(int));
+ rsc->cache_free = apr_pcalloc(p, sizeof(int));
+ *(rsc->cache_size) = -1;
+ *(rsc->cache_free) = 0;
+ rsc->upload_max = 0;
+ rsc->upload_files_to_var = 0;
+ rsc->separate_virtual_interps = 0;
+ rsc->server_name = NULL;
+ rsc->upload_dir = "/tmp";
+ rsc->objCacheList = NULL;
+ rsc->objCache = NULL;
+
+ rsc->outchannel = NULL;
+
+ rsc->rivet_server_vars = (apr_table_t *) apr_table_make ( p, 4 );
+ rsc->rivet_dir_vars = (apr_table_t *) apr_table_make ( p, 4 );
+ rsc->rivet_user_vars = (apr_table_t *) apr_table_make ( p, 4 );
+
+ return rsc;
+}
+
+static void
+Rivet_PropagatePerDirConfArrays( Tcl_Interp *interp, rivet_server_conf *rsc )
+{
+ apr_table_t *t;
+ apr_array_header_t *arr;
+ apr_table_entry_t *elts;
+ int i, nelts;
+ Tcl_Obj *arrayName;
+ Tcl_Obj *key;
+ Tcl_Obj *val;
+
+ /* Make sure RivetDirConf doesn't exist from a previous request. */
+ Tcl_UnsetVar( interp, "RivetDirConf", TCL_GLOBAL_ONLY );
+
+ /* Propagate all of the DirConf variables into an array. */
+ t = rsc->rivet_dir_vars;
+ arr = (apr_array_header_t*) apr_table_elts( t );
+ elts = (apr_table_entry_t *)arr->elts;
+ nelts = arr->nelts;
+ arrayName = Tcl_NewStringObj( "RivetDirConf", -1 );
+ Tcl_IncrRefCount(arrayName);
+
+ for( i = 0; i < nelts; ++i )
+ {
+ key = Tcl_NewStringObj( elts[i].key, -1);
+ val = Tcl_NewStringObj( elts[i].val, -1);
+ Tcl_IncrRefCount(key);
+ Tcl_IncrRefCount(val);
+ Tcl_ObjSetVar2(interp, arrayName, key, val, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(key);
+ Tcl_DecrRefCount(val);
+ }
+ Tcl_DecrRefCount(arrayName);
+
+ /* Make sure RivetUserConf doesn't exist from a previous request. */
+ Tcl_UnsetVar( interp, "RivetUserConf", TCL_GLOBAL_ONLY );
+
+ /* Propagate all of the UserConf variables into an array. */
+ t = rsc->rivet_user_vars;
+ arr = (apr_array_header_t*) apr_table_elts( t );
+ elts = (apr_table_entry_t *)arr->elts;
+ nelts = arr->nelts;
+ arrayName = Tcl_NewStringObj( "RivetUserConf", -1 );
+ Tcl_IncrRefCount(arrayName);
+
+ for( i = 0; i < nelts; ++i )
+ {
+ key = Tcl_NewStringObj( elts[i].key, -1);
+ val = Tcl_NewStringObj( elts[i].val, -1);
+ Tcl_IncrRefCount(key);
+ Tcl_IncrRefCount(val);
+ Tcl_ObjSetVar2(interp, arrayName, key, val, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(key);
+ Tcl_DecrRefCount(val);
+ }
+ Tcl_DecrRefCount(arrayName);
+}
+
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_PerInterpInit --
+ *
+ * Do the initialization that needs to happen for every
+ * interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void
+Rivet_PerInterpInit(server_rec *s, rivet_server_conf *rsc, apr_pool_t *p)
+{
+ Tcl_Interp *interp = rsc->server_interp;
+ rivet_interp_globals *globals = NULL;
+
+ /* Create TCL commands to deal with Apache's BUFFs. */
+ rsc->outchannel = apr_pcalloc(p, sizeof(Tcl_Channel));
+ *(rsc->outchannel) = Tcl_CreateChannel(&RivetChan, "apacheout", rsc,
+ TCL_WRITABLE);
+
+ Tcl_SetStdChannel(*(rsc->outchannel), TCL_STDOUT);
+
+ /* Initialize the interpreter with Rivet's Tcl commands. */
+ Rivet_InitCore( interp );
+
+ /* Create a global array with information about the server. */
+ Rivet_InitServerVariables( interp, p );
+ Rivet_PropagateServerConfArray( interp, rsc );
+
+ /* Set up interpreter associated data */
+ globals = apr_pcalloc(p, sizeof(rivet_interp_globals));
+ Tcl_SetAssocData(interp, "rivet", NULL, globals);
+
+ /* Eval Rivet's init.tcl file to load in the Tcl-level
+ commands. */
+ if (Tcl_PkgRequire(interp, "RivetTcl", "1.1", 1) == NULL) {
+ ap_log_error( APLOG_MARK, APLOG_ERR, APR_EGENERAL, s,
+ "init.tcl must be installed correctly for Apache Rivet to function: %s",
+ Tcl_GetStringResult(interp) );
+ exit(1);
+ }
+
+ /* Set the output buffer size to the largest allowed value, so that we
+ * won't send any result packets to the browser unless the Rivet
+ * programmer does a "flush stdout" or the page is completed.
+ */
+ Tcl_SetChannelOption(interp, *(rsc->outchannel), "-buffersize", "1000000");
+ Tcl_RegisterChannel(interp, *(rsc->outchannel));
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Rivet_SetScript --
+ *
+ * Add the text from an apache directive, such as UserConf, to
+ * the corresponding variable in the rivet_server_conf structure.
+ * In most cases, we append the new value to any previously
+ * existing value, but Before, After and Error scripts override
+ * the old directive completely.
+ *
+ * Results:
+ *
+ * Returns the string representation of the current value for the
+ * directive.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+Rivet_SetScript(apr_pool_t *pool, rivet_server_conf *rsc, char *script, char *string)
+{
+ Tcl_Obj *objarg = NULL;
+
+ if( STREQU( script, "GlobalInitScript" ) ) {
+ if( rsc->rivet_global_init_script == NULL ) {
+ objarg = Tcl_NewStringObj( string, -1 );
+ Tcl_IncrRefCount( objarg );
+ Tcl_AppendToObj( objarg, "\n", 1 );
+ rsc->rivet_global_init_script = objarg;
+ } else {
+ objarg = rsc->rivet_global_init_script;
+ Tcl_AppendToObj( objarg, string, -1 );
+ Tcl_AppendToObj( objarg, "\n", 1 );
+ }
+ } else if( STREQU( script, "ChildInitScript" ) ) {
+ if( rsc->rivet_child_init_script == NULL ) {
+ objarg = Tcl_NewStringObj( string, -1 );
+ Tcl_IncrRefCount( objarg );
+ Tcl_AppendToObj( objarg, "\n", 1 );
+ rsc->rivet_child_init_script = objarg;
+ } else {
+ objarg = rsc->rivet_child_init_script;
+ Tcl_AppendToObj( objarg, string, -1 );
+ Tcl_AppendToObj( objarg, "\n", 1 );
+ }
+ } else if( STREQU( script, "ChildExitScript" ) ) {
+ if( rsc->rivet_child_exit_script == NULL ) {
+ objarg = Tcl_NewStringObj( string, -1 );
+ Tcl_IncrRefCount( objarg );
+ Tcl_AppendToObj( objarg, "\n", 1 );
+ rsc->rivet_child_exit_script = objarg;
+ } else {
+ objarg = rsc->rivet_child_exit_script;
+ Tcl_AppendToObj( objarg, string, -1 );
+ Tcl_AppendToObj( objarg, "\n", 1 );
+ }
+ } else if( STREQU( script, "BeforeScript" ) ) {
+ rsc->rivet_before_script = apr_pstrcat(pool, string, "\n", NULL);
+ } else if( STREQU( script, "AfterScript" ) ) {
+ rsc->rivet_after_script = apr_pstrcat(pool, string, "\n", NULL);
+ } else if( STREQU( script, "ErrorScript" ) ) {
+ rsc->rivet_error_script = apr_pstrcat(pool, string, "\n", NULL);
+ }
+
+ if( !objarg ) return string;
+
+ return Tcl_GetStringFromObj( objarg, NULL );
+}
+
+
+
+/*
+ * Implements the RivetServerConf Apache Directive
+ *
+ * Command Arguments:
+ * RivetServerConf GlobalInitScript <script>
+ * RivetServerConf ChildInitScript <script>
+ * RivetServerConf ChildExitScript <script>
+ * RivetServerConf BeforeScript <script>
+ * RivetServerConf AfterScript <script>
+ * RivetServerConf ErrorScript <script>
+ * RivetServerConf CacheSize <integer>
+ * RivetServerConf UploadDirectory <directory>
+ * RivetServerConf UploadMaxSize <integer>
+ * RivetServerConf UploadFilesToVar <yes|no>
+ * RivetServerConf SeparateVirtualInterps <yes|no>
+*/
+
+static const char *
+Rivet_ServerConf( cmd_parms *cmd, void *dummy, char *var, char *val )
+{
+ server_rec *s = cmd->server;
+ rivet_server_conf *rsc = RIVET_SERVER_CONF(s->module_config);
+ char *string = val;
+
+ FILEDEBUGINFO;
+
+ if ( var == NULL || val == NULL ) {
+ return "Rivet Error: RivetServerConf requires two arguments";
+ }
+
+ if( STREQU( var, "CacheSize" ) ) {
+ *(rsc->cache_size) = strtol( val, NULL, 10 );
+ } else if( STREQU( var, "UploadDirectory" ) ) {
+ rsc->upload_dir = val;
+ } else if( STREQU( var, "UploadMaxSize" ) ) {
+ rsc->upload_max = strtol( val, NULL, 10 );
+ } else if( STREQU( var, "UploadFilesToVar" ) ) {
+ Tcl_GetBoolean (NULL, val, &rsc->upload_files_to_var);
+ } else if( STREQU( var, "SeparateVirtualInterps" ) ) {
+ Tcl_GetBoolean (NULL, val, &rsc->separate_virtual_interps);
+ } else {
+ string = Rivet_SetScript( cmd->pool, rsc, var, val);
+ }
+
+ apr_table_set( rsc->rivet_server_vars, var, string );
+ return( NULL );
+}
+
+/*
+ * Implements the RivetDirConf Apache Directive
+ *
+ * Command Arguments:
+ * RivetDirConf BeforeScript <script>
+ * RivetDirConf AfterScript <script>
+ * RivetDirConf ErrorScript <script>
+ * RivetDirConf UploadDirectory <directory>
+*/
+static const char *
+Rivet_DirConf( cmd_parms *cmd, rivet_server_conf *rdc, char *var, char *val )
+{
+ char *string = val;
+
+ FILEDEBUGINFO;
+
+ if ( var == NULL || val == NULL ) {
+ return "Rivet Error: RivetDirConf requires two arguments";
+ }
+
+ if( STREQU( var, "UploadDirectory" ) ) {
+ rdc->upload_dir = val;
+ } else {
+ string = Rivet_SetScript( cmd->pool, rdc, var, val );
+ }
+
+ apr_table_set( rdc->rivet_dir_vars, var, string );
+ return NULL;
+}
+
+/*
+ * Implements the RivetUserConf Apache Directive
+ *
+ * Command Arguments:
+ * RivetUserConf BeforeScript <script>
+ * RivetUserConf AfterScript <script>
+ * RivetUserConf ErrorScript <script>
+*/
+static const char *
+Rivet_UserConf( cmd_parms *cmd, rivet_server_conf *rdc, char *var, char *val )
+{
+ char *string = val;
+
+ FILEDEBUGINFO;
+
+ if ( var == NULL || val == NULL ) {
+ return "Rivet Error: RivetUserConf requires two arguments";
+ }
+ /* We have modified these scripts. */
+ /* This is less than ideal though, because it will get set to 1
+ * every time - FIXME. */
+ rdc->user_scripts_updated = 1;
+
+ string = Rivet_SetScript( cmd->pool, rdc, var, val );
+ /* XXX Need to figure out what to do about setting the table. */
+ apr_table_set( rdc->rivet_user_vars, var, string );
+ return NULL;
+}
+
+static int
+Rivet_InitHandler(apr_pool_t *pPool, apr_pool_t *pLog, apr_pool_t *pTemp,
+ server_rec *s)
+{
+ ap_add_version_component(pPool, "Rivet");
+ return OK;
+}
+
+
+static void *
+Rivet_CreateDirConfig(apr_pool_t *p, char *dir)
+{
+ rivet_server_conf *rdc = RIVET_NEW_CONF(p);
+
+ FILEDEBUGINFO;
+
+ rdc->rivet_server_vars = (apr_table_t *) apr_table_make ( p, 4 );
+ rdc->rivet_dir_vars = (apr_table_t *) apr_table_make ( p, 4 );
+ rdc->rivet_user_vars = (apr_table_t *) apr_table_make ( p, 4 );
+
+ return rdc;
+}
+
+static void *
+Rivet_MergeDirConfig( apr_pool_t *p, void *basev, void *addv )
+{
+ rivet_server_conf *base = (rivet_server_conf *)basev;
+ rivet_server_conf *add = (rivet_server_conf *)addv;
+ rivet_server_conf *new = RIVET_NEW_CONF(p);
+
+ FILEDEBUGINFO;
+
+ Rivet_MergeDirConfigVars( p, new, base, add );
+
+ return new;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_MergeConfig --
+ *
+ * This function is called when there is a config option set both
+ * at the 'global' level, and for a virtual host. It "resolves
+ * the conflicts" so to speak, by creating a new configuration,
+ * and this function is where we get to have our say about how to
+ * go about doing that. For most of the options, we override the
+ * global option with the local one.
+ *
+ * Results:
+ * Returns a new server configuration.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void *
+Rivet_MergeConfig(apr_pool_t *p, void *basev, void *overridesv)
+{
+ rivet_server_conf *rsc = RIVET_NEW_CONF(p);
+ rivet_server_conf *base = (rivet_server_conf *) basev;
+ rivet_server_conf *overrides = (rivet_server_conf *) overridesv;
+
+ FILEDEBUGINFO;
+
+ /* For completeness' sake, we list the fate of all the members of
+ * the rivet_server_conf struct. */
+
+ /* server_interp isn't set at this point. */
+ /* rivet_global_init_script is global, not per server. */
+
+ rsc->rivet_child_init_script = overrides->rivet_child_init_script ?
+ overrides->rivet_child_init_script : base->rivet_child_init_script;
+
+ rsc->rivet_child_exit_script = overrides->rivet_child_exit_script ?
+ overrides->rivet_child_exit_script : base->rivet_child_exit_script;
+
+ rsc->rivet_before_script = overrides->rivet_before_script ?
+ overrides->rivet_before_script : base->rivet_before_script;
+
+ rsc->rivet_after_script = overrides->rivet_after_script ?
+ overrides->rivet_after_script : base->rivet_after_script;
+
+ rsc->rivet_error_script = overrides->rivet_error_script ?
+ overrides->rivet_error_script : base->rivet_error_script;
+
+ rsc->rivet_default_error_script = overrides->rivet_default_error_script ?
+ overrides->rivet_default_error_script : base->rivet_default_error_script;
+
+ /* cache_size is global, and set up later. */
+ /* cache_free is not set up at this point. */
+
+ rsc->upload_max = overrides->upload_max ?
+ overrides->upload_max : base->upload_max;
+
+ rsc->separate_virtual_interps = base->separate_virtual_interps;
+
+ /* server_name is set up later. */
+
+ rsc->upload_dir = overrides->upload_dir ?
+ overrides->upload_dir : base->upload_dir;
+
+ rsc->rivet_server_vars = overrides->rivet_server_vars ?
+ overrides->rivet_server_vars : base->rivet_server_vars;
+
+ rsc->rivet_dir_vars = overrides->rivet_dir_vars ?
+ overrides->rivet_dir_vars : base->rivet_dir_vars;
+
+ rsc->rivet_user_vars = overrides->rivet_user_vars ?
+ overrides->rivet_user_vars : base->rivet_user_vars;
+
+ /* objCacheList is set up later. */
+ /* objCache is set up later. */
+ /* outchannel is set up later. */
+
+ return rsc;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_PanicProc --
+ *
+ * Called when Tcl panics, usually because of memory problems.
+ * We log the request, in order to be able to determine what went
+ * wrong later.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Calls abort(), which does not return - the child exits.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void
+Rivet_Panic TCL_VARARGS_DEF(CONST char *, arg1)
+{
+ va_list argList;
+ char *buf;
+ char *format;
+
+ format = (char *) TCL_VARARGS_START(char *,arg1,argList);
+ buf = (char *) apr_pvsprintf(globalrr->pool, format, argList);
+ ap_log_error(APLOG_MARK, APLOG_CRIT, APR_EGENERAL, globalrr->server,
+ "Critical error in request: %s", globalrr->unparsed_uri);
+ ap_log_error(APLOG_MARK, APLOG_CRIT, APR_EGENERAL, globalrr->server, buf);
+
+ abort();
+}
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_ChildHandlers --
+ *
+ * Handles, depending on the situation, the scripts for the init
+ * and exit handlers.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Runs the rivet_child_init/exit_script scripts.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void
+Rivet_ChildHandlers(server_rec *s, int init)
+{
+ server_rec *sr;
+ rivet_server_conf *rsc;
+ rivet_server_conf *top;
+ void *function;
+ void *parentfunction;
+ char *errmsg;
+
+ top = RIVET_SERVER_CONF(s->module_config);
+ if (init == 1) {
+ parentfunction = top->rivet_child_init_script;
+ errmsg = "Error in Child init script: %s";
+ //errmsg = (char *) apr_pstrdup(p, "Error in child init script: %s");
+ } else {
+ parentfunction = top->rivet_child_exit_script;
+ errmsg = "Error in Child exit script: %s";
+ //errmsg = (char *) apr_pstrdup(p, "Error in child exit script: %s");
+ }
+
+ sr = s;
+ while (sr)
+ {
+ rsc = RIVET_SERVER_CONF(sr->module_config);
+ function = init ? rsc->rivet_child_init_script :
+ rsc->rivet_child_exit_script;
+
+ /* Execute it if it exists and it's the top level, separate
+ * virtual interps are turned on, or it's different than the
+ * main script. */
+ if(function &&
+ ( sr == s || rsc->separate_virtual_interps ||
+ function != parentfunction))
+ {
+ if (Tcl_EvalObjEx(rsc->server_interp,
+ function, 0) != TCL_OK) {
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, s,
+ errmsg, Tcl_GetString(function));
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, s, "%s",
+ Tcl_GetVar(rsc->server_interp, "errorInfo", 0));
+ }
+ }
+ sr = sr->next;
+ }
+}
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_ChildExit --
+ *
+ * Run when each Apache child process is about to exit.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Runs Tcl_Finalize.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static apr_status_t
+Rivet_ChildExit(void *data)
+{
+ server_rec *s = (server_rec*) data;
+ Rivet_ChildHandlers(s, 0);
+ Tcl_Finalize();
+ return OK;
+}
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_InitTclStuff --
+ *
+ * Initialize the Tcl system - create interpreters, load commands
+ * and so forth.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+Rivet_InitTclStuff(server_rec *s, apr_pool_t *p)
+{
+ Tcl_Interp *interp;
+ rivet_server_conf *rsc = RIVET_SERVER_CONF( s->module_config );
+ rivet_server_conf *myrsc;
+ server_rec *sr;
+ extern int ap_max_requests_per_child;
+
+ /* Initialize TCL stuff */
+ Tcl_FindExecutable(NAMEOFEXECUTABLE);
+ interp = Tcl_CreateInterp();
+
+ if (interp == NULL)
+ {
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, s,
+ "Error in Tcl_CreateInterp, aborting\n");
+ exit(1);
+ }
+ if (Tcl_Init(interp) == TCL_ERROR)
+ {
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, s,
+ Tcl_GetStringResult(interp));
+ exit(1);
+ }
+
+ Tcl_SetPanicProc(Rivet_Panic);
+
+ rsc->server_interp = interp; /* root interpreter */
+
+ Rivet_PerInterpInit(s, rsc, p);
+
+ /* If the user didn't set a cache size in their configuration, we
+ * will assume an arbitrary size for them.
+ *
+ * If the cache size is 0, the user has requested not to cache
+ * documents.
+ */
+ if(*(rsc->cache_size) < 0) {
+ if (ap_max_requests_per_child != 0) {
+ *(rsc->cache_size) = ap_max_requests_per_child / 5;
+ } else {
+ *(rsc->cache_size) = 10; /* FIXME: Arbitrary number */
+ }
+ }
+
+ if (*(rsc->cache_size) != 0) {
+ *(rsc->cache_free) = *(rsc->cache_size);
+ }
+
+ /* Initialize cache structures */
+ if (*(rsc->cache_size)) {
+ rsc->objCacheList = apr_pcalloc(
+ p, (signed)(*(rsc->cache_size) * sizeof(char *)));
+ rsc->objCache = apr_pcalloc(p, sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(rsc->objCache, TCL_STRING_KEYS);
+ }
+
+ if (rsc->rivet_global_init_script != NULL) {
+ if (Tcl_EvalObjEx(interp, rsc->rivet_global_init_script, 0) != TCL_OK)
+ {
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, s, "%s",
+ Tcl_GetVar(interp, "errorInfo", 0));
+ }
+ }
+
+ sr = s;
+ while (sr)
+ {
+ myrsc = RIVET_SERVER_CONF(sr->module_config);
+ /* We only have a different rivet_server_conf if MergeConfig
+ * was called. We really need a separate one for each server,
+ * so we go ahead and create one here, if necessary. */
+ if (sr != s && myrsc == rsc) {
+ myrsc = RIVET_NEW_CONF(p);
+ ap_set_module_config(sr->module_config, &rivet_module, myrsc);
+ Rivet_CopyConfig( rsc, myrsc );
+ }
+
+ myrsc->outchannel = rsc->outchannel;
+ /* This sets up slave interpreters for other virtual hosts. */
+ if (sr != s) /* not the first one */
+ {
+ if (rsc->separate_virtual_interps != 0) {
+ char *slavename = (char*) apr_psprintf(p, "%s_%d",
+ sr->server_hostname,
+ sr->port);
+ /* Separate virtual interps. */
+ myrsc->server_interp = Tcl_CreateSlave(interp,
+ slavename, 0);
+ Rivet_PerInterpInit(s, myrsc, p);
+ } else {
+ myrsc->server_interp = rsc->server_interp;
+ }
+
+ /* Since these things are global, we copy them into the
+ * rivet_server_conf struct. */
+ myrsc->cache_size = rsc->cache_size;
+ myrsc->cache_free = rsc->cache_free;
+ myrsc->objCache = rsc->objCache;
+ myrsc->objCacheList = rsc->objCacheList;
+ }
+ myrsc->server_name = (char*)apr_pstrdup(p, sr->server_hostname);
+
+ sr = sr->next;
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_ChildInit --
+ *
+ * This function is run when each individual Apache child process
+ * is created.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Calls Tcl initialization function.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+Rivet_ChildInit(apr_pool_t *pChild, server_rec *s)
+{
+ Rivet_InitTclStuff(s, pChild);
+ Rivet_ChildHandlers(s, 1);
+
+ //cleanup
+ //apr_pool_cleanup_register (pChild, s, Rivet_ChildExit, Rivet_ChildExit);
+}
+
+static int
+Rivet_TranslateUri (request_rec *r)
+{
+ char *filename;
+ /*
+ Tcl_HashTable argTbl;
+ Tcl_HashSearch searchPtr;
+ Tcl_HashEntry *entryPtr;
+ */
+ int res = RIVET_OK;
+
+ fprintf(stderr, "file: %s\n", r->filename);
+ fflush(stderr);
+ if (r->main)
+ filename = r->main->filename;
+ else
+ filename = r->filename;
+
+ if (r->main) {
+ res = Rivet_ParseFileArgString (ap_document_root(r), r->args,
+ &r->main->filename, NULL);
+ filename = r->main->filename;
+ }
+ else {
+ res = Rivet_ParseFileArgString (ap_document_root(r), r->args,
+ &r->filename, NULL);
+ filename = r->filename;
+ }
+
+ if (res != RIVET_OK)
+ return HTTP_BAD_REQUEST;
+
+ if (!Rivet_IsRivetFile (filename))
+ return DECLINED;
+
+ /*
+ for (entryPtr = Tcl_FirstHashEntry(&argTbl, &searchPtr);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry (&searchPtr)) {
+ char *arg, *val;
+ arg = Tcl_GetHashKey(&argTbl, entryPtr);
+ val = (char*) Tcl_GetHashValue(entryPtr);
+ fprintf (stderr, "arg=%s, val=%s\n", arg, val);
+ fflush (stderr);
+ }
+ */
+
+ /*
+ * seems that a subrequest is created for / processing. If this is a /
+ * request, set the filename into r->main (which is the request that
+ * is propagated through)
+ */
+ if (r->main)
+ r->main->filename = filename;
+ else
+ r->filename = filename;
+
+ return DECLINED;
+}
+
+/* Set things up to execute a file, then execute */
+static int
+Rivet_SendContent(request_rec *r)
+{
+ char error[MAX_STRING_LEN];
+ char timefmt[MAX_STRING_LEN];
+ int errstatus;
+ int retval;
+
+ Tcl_Interp *interp;
+ static Tcl_Obj *request_init = NULL;
+ static Tcl_Obj *request_cleanup = NULL;
+
+ rivet_interp_globals *globals = NULL;
+ rivet_server_conf *rsc = NULL;
+ rivet_server_conf *rdc;
+
+ if (!Rivet_IsRivetFile(r->filename))
+ return DECLINED;
+
+ Tcl_MutexLock(&sendMutex);
+
+ /* Set the global request req to know what we are dealing with in
+ * case we have to call the PanicProc. */
+ globalrr = r;
+
+ rsc = Rivet_GetConf(r);
+ interp = rsc->server_interp;
+ globals = Tcl_GetAssocData(interp, "rivet", NULL);
+ globals->r = r;
+ globals->req = (TclWebRequest *)apr_pcalloc(r->pool, sizeof(TclWebRequest));
+
+ if (r->per_dir_config != NULL)
+ rdc = RIVET_SERVER_CONF( r->per_dir_config );
+ else
+ rdc = rsc;
+
+ r->allowed |= (1 << M_GET);
+ r->allowed |= (1 << M_POST);
+ if (r->method_number != M_GET && r->method_number != M_POST) {
+ retval = DECLINED;
+ goto sendcleanup;
+ }
+
+ //if (r->finfo.st_mode == 0)
+ if (!r->finfo.valid)
+ {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, APR_EGENERAL, r->server,
+ "File does not exist: %s",
+ (r->path_info
+ ? (char*)apr_pstrcat(r->pool, r->filename, r->path_info, NULL)
+ : r->filename));
+ retval = HTTP_NOT_FOUND;
+ goto sendcleanup;
+ }
+
+ if ((errstatus = ap_meets_conditions(r)) != OK) {
+ retval = errstatus;
+ goto sendcleanup;
+ }
+
+ apr_cpystrn(error, DEFAULT_ERROR_MSG, sizeof(error));
+ apr_cpystrn(timefmt, DEFAULT_TIME_FORMAT, sizeof(timefmt));
+
+ /* This one is the big catch when it comes to moving towards
+ Apache 2.0, or one of them, at least. */
+ //apr_chdir_file(r->filename);
+
+ //TODO: clarify whether rsc or rdc
+ //Rivet_PropagatePerDirConfArrays( interp, rdc );
+ Rivet_PropagatePerDirConfArrays( interp, rsc );
+
+ /* Initialize this the first time through and keep it around. */
+ if (request_init == NULL) {
+ request_init = Tcl_NewStringObj("::Rivet::initialize_request\n", -1);
+ Tcl_IncrRefCount(request_init);
+ }
+ if (Tcl_EvalObjEx(interp, request_init, 0) == TCL_ERROR)
+ {
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, r->server,
+ "Could not create request namespace\n");
+ retval = HTTP_BAD_REQUEST;
+ goto sendcleanup;
+ }
+
+ /* Set the script name. */
+ {
+#if 1
+ Tcl_Obj *infoscript = Tcl_NewStringObj("info script ", -1);
+ Tcl_IncrRefCount(infoscript);
+ Tcl_AppendToObj(infoscript, r->filename, -1);
+ Tcl_EvalObjEx(interp, infoscript, TCL_EVAL_DIRECT);
+ Tcl_DecrRefCount(infoscript);
+#else
+ /* This speeds things up, but you have to use Tcl internal
+ * declerations, which is not so great... */
+ Interp *iPtr = (Interp *) interp;
+ if (iPtr->scriptFile != NULL) {
+ Tcl_DecrRefCount(iPtr->scriptFile);
+ }
+ iPtr->scriptFile = Tcl_NewStringObj(r->filename, -1);
+ Tcl_IncrRefCount(iPtr->scriptFile);
+#endif
+ }
+
+ /* Apache Request stuff */
+ TclWeb_InitRequest(globals->req, interp, r);
+ ApacheRequest_set_post_max(globals->req->apachereq, rsc->upload_max);
+ ApacheRequest_set_temp_dir(globals->req->apachereq, rsc->upload_dir);
+
+#if 0
+ if (upload_files_to_var)
+ {
+ globals->req->apachereq->hook_data = interp;
+ globals->req->apachereq->upload_hook = Rivet_UploadHook;
+ }
+#endif
+
+ errstatus = ApacheRequest_parse(globals->req->apachereq);
+ if (errstatus != OK) {
+ retval = errstatus;
+ goto sendcleanup;
+ }
+
+ if (r->header_only)
+ {
+ TclWeb_SetHeaderType(DEFAULT_HEADER_TYPE, globals->req);
+ TclWeb_PrintHeaders(globals->req);
+ retval = OK;
+ goto sendcleanup;
+ }
+
+ if (Rivet_ParseExecFile(globals->req, r->filename, 1) != TCL_OK)
+ {
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, r->server, "%s",
+ Tcl_GetVar(interp, "errorInfo", 0));
+ }
+
+ if (request_cleanup == NULL) {
+ request_cleanup = Tcl_NewStringObj("::Rivet::cleanup_request\n", -1);
+ Tcl_IncrRefCount(request_cleanup);
+ }
+ if(Tcl_EvalObjEx(interp, request_cleanup, 0) == TCL_ERROR) {
+ ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, r->server, "%s",
+ Tcl_GetVar(interp, "errorInfo", 0));
+ }
+
+ /* Reset globals */
+ Rivet_CleanupRequest( r );
+
+ retval = OK;
+sendcleanup:
+ globals->req->content_sent = 0;
+ Tcl_MutexUnlock(&sendMutex);
+ return retval;
+}
+
+
+static void
+rivet_register_hooks (apr_pool_t *p)
+{
+ //static const char * const aszPre[] = {
+ // "http_core.c", "mod_mime.c", NULL };
+ static const char * const aszPreTranslate[] = {"mod_alias.c", NULL};
+
+ ap_hook_post_config (Rivet_InitHandler, NULL, NULL, APR_HOOK_LAST);
+ ap_hook_handler (Rivet_SendContent, NULL, NULL, APR_HOOK_LAST);
+ ap_hook_translate_name (Rivet_TranslateUri, aszPreTranslate, NULL,
+ APR_HOOK_MIDDLE);
+ ap_hook_child_init (Rivet_ChildInit, NULL, NULL, APR_HOOK_LAST);
+}
+
+
+const command_rec rivet_cmds[] =
+{
+ AP_INIT_TAKE2("RivetServerConf", Rivet_ServerConf,
+ NULL, RSRC_CONF, NULL),
+ AP_INIT_TAKE2("RivetDirConf", Rivet_DirConf,
+ NULL, ACCESS_CONF, NULL),
+ AP_INIT_TAKE2("RivetUserConf", Rivet_UserConf,
+ NULL, ACCESS_CONF|OR_FILEINFO,
+ "RivetUserConf key value: sets RivetUserConf(key) = value"),
+ {NULL}
+};
+
+module AP_MODULE_DECLARE_DATA rivet_module =
+{
+ STANDARD20_MODULE_STUFF,
+ Rivet_CreateDirConfig,
+ Rivet_MergeDirConfig,
+ Rivet_CreateConfig,
+ Rivet_MergeConfig,
+ rivet_cmds,
+ rivet_register_hooks
+};
+
+
Added: tcl/rivet/trunk/src/apache-2/mod_rivet.h
URL: http://svn.apache.org/viewcvs/tcl/rivet/trunk/src/apache-2/mod_rivet.h?rev=369059&view=auto
==============================================================================
--- tcl/rivet/trunk/src/apache-2/mod_rivet.h (added)
+++ tcl/rivet/trunk/src/apache-2/mod_rivet.h Sat Jan 14 09:15:42 2006
@@ -0,0 +1,117 @@
+
+#ifndef MOD_RIVET_H
+#define MOD_RIVET_H 1
+
+#include <tcl.h>
+#include "apache_request.h"
+#include "TclWeb.h"
+
+/* init.tcl file relative to the server root directory */
+#define RIVET_DIR "rivet"
+#define RIVET_INIT RIVET_DIR"/init.tcl"
+
+#if 0
+#define FILEDEBUGINFO fprintf(stderr, "Function " __FUNCTION__ "\n")
+#else
+#define FILEDEBUGINFO
+#endif
+
+/* Configuration options */
+
+/* If you do not have a threaded Tcl, you can define this to 0. This
+ has the effect of running Tcl Init code in the main parent init
+ handler, instead of in child init handlers. */
+#ifdef __MINGW32__
+#define THREADED_TCL 1
+#else
+#define THREADED_TCL 0 /* Unless you have MINGW32, modify this one! */
+#endif
+
+/* If you want to show the mod_rivet version in the server
+ information, you can define this to 0.
+
+ Otherwise, set this to 1 to hide the version from potential
+ troublemakers. */
+#define HIDE_RIVET_VERSION 1
+
+/* End Configuration options */
+
+/* For Tcl 8.3/8.4 compatibility - see http://mini.net/tcl/3669 */
+#ifndef CONST84
+# define CONST84
+#endif
+
+#define VAR_SRC_QUERYSTRING 1
+#define VAR_SRC_POST 2
+#define VAR_SRC_ALL 3
+
+#define DEFAULT_ERROR_MSG "[an error occurred while processing this directive]"
+#define DEFAULT_TIME_FORMAT "%A, %d-%b-%Y %H:%M:%S %Z"
+#define MULTIPART_FORM_DATA 1
+/* #define RIVET_VERSION "X.X.X" */
+
+/* IMPORTANT: If you make any changes to the rivet_server_conf struct,
+ * you need to make the appropriate modifications to Rivet_CopyConfig,
+ * Rivet_CreateConfig, Rivet_MergeConfig and so on. */
+
+module AP_MODULE_DECLARE_DATA rivet_module;
+
+typedef struct _rivet_server_conf {
+ Tcl_Interp *server_interp; /* per server Tcl interpreter */
+ Tcl_Obj *rivet_global_init_script; /* run once when apache is started */
+ Tcl_Obj *rivet_child_init_script;
+ Tcl_Obj *rivet_child_exit_script;
+ char *rivet_before_script; /* script run before each page */
+ char *rivet_after_script; /* after */
+ char *rivet_error_script; /* for errors */
+
+ /* This flag is used with the above directives. If any of them
+ have changed, it gets set. */
+ int user_scripts_updated;
+
+ Tcl_Obj *rivet_default_error_script; /* for errors */
+ int *cache_size;
+ int *cache_free;
+ int upload_max;
+ int upload_files_to_var;
+ int separate_virtual_interps;
+ char *server_name;
+ char *upload_dir;
+ apr_table_t *rivet_server_vars;
+ apr_table_t *rivet_dir_vars;
+ apr_table_t *rivet_user_vars;
+ char **objCacheList; /* Array of cached objects (for priority handling) */
+ Tcl_HashTable *objCache; /* Objects cache - the key is the script name */
+
+ /* stuff for buffering output */
+ Tcl_Channel *outchannel;
+} rivet_server_conf;
+
+/* eventually we will transfer 'global' variables in here and
+ 'de-globalize' them */
+
+typedef struct _rivet_interp_globals {
+ request_rec *r; /* request rec */
+ TclWebRequest *req; /* TclWeb API request */
+} rivet_interp_globals;
+
+int Rivet_ParseExecFile(TclWebRequest *req, char *filename, int toplevel);
+
+rivet_server_conf *Rivet_GetConf(request_rec *r);
+
+#ifdef ap_get_module_config
+#undef ap_get_module_config
+#endif
+#ifdef ap_set_module_config
+#undef ap_set_module_config
+#endif
+
+#define RIVET_SERVER_CONF(module) \
+ (rivet_server_conf *)ap_get_module_config(module, &rivet_module)
+
+#define RIVET_NEW_CONF(p) \
+ (rivet_server_conf *)apr_pcalloc(p, sizeof(rivet_server_conf))
+
+
+#endif /* MOD_RIVET_H */
+
Added: tcl/rivet/trunk/src/apache-2/rivetCore.c
URL: http://svn.apache.org/viewcvs/tcl/rivet/trunk/src/apache-2/rivetCore.c?rev=369059&view=auto
==============================================================================
--- tcl/rivet/trunk/src/apache-2/rivetCore.c (added)
+++ tcl/rivet/trunk/src/apache-2/rivetCore.c Sat Jan 14 09:15:42 2006
@@ -0,0 +1,1004 @@
+/*
+ * rivetCore.c - Core commands which are compiled into mod_rivet itself.
+ */
+
+/* Copyright 2002-2004 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/* $Id: rivetCore.c,v 1.45 2005/08/21 15:31:38 davidw Exp $ */
+
+/* Rivet config */
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include <sys/stat.h>
+
+#include "httpd.h"
+#include "http_config.h"
+#include "http_request.h"
+#include "http_core.h"
+#include "http_protocol.h"
+#include "http_log.h"
+#include "http_main.h"
+#include "util_script.h"
+//#include "http_conf_globals.h"
+#include "http_config.h"
+
+
+#include <tcl.h>
+#include <string.h>
+#include <stdio.h>
+
+#include "apache_request.h"
+#include "mod_rivet.h"
+#include "rivet.h"
+#include "TclWeb.h"
+
+#define ENV_ARRAY_NAME "env"
+#define HEADERS_ARRAY_NAME "headers"
+#define COOKIES_ARRAY_NAME "cookies"
+
+extern module rivet_module;
+
+#define POOL (globals->r->pool)
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_MakeURL --
+ *
+ * Make a self-referencing URL.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_MakeURL )
+{
+ Tcl_Obj *result = NULL;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "filename");
+ return TCL_ERROR;
+ }
+ result = Tcl_NewObj();
+ TclWeb_MakeURL(result, Tcl_GetString(objv[1]), globals->req);
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_Parse --
+ *
+ * Include and parse a Rivet file.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side Effects:
+ * Whatever occurs in the Rivet page parsed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_Parse )
+{
+ char *filename;
+ Tcl_StatBuf buf;
+ Tcl_Obj *fnobj;
+ int retval = 0;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if( objc < 2 || objc > 3 )
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-virtual? filename");
+ return TCL_ERROR;
+ }
+
+ if( objc == 2 ) {
+ filename = Tcl_GetStringFromObj( objv[1], (int *)NULL );
+ } else {
+ if( !STREQU( Tcl_GetStringFromObj(objv[1], (int *)NULL), "-virtual") ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "?-virtual? filename" );
+ return TCL_ERROR;
+ }
+ filename = TclWeb_GetVirtualFile( globals->req,
+ Tcl_GetStringFromObj(objv[2], (int *)NULL) );
+ }
+
+ if (!strcmp(filename, globals->r->filename))
+ {
+ Tcl_AddErrorInfo(interp, "Cannot recursively call the same file!");
+ return TCL_ERROR;
+ }
+
+ fnobj = Tcl_NewStringObj(filename, -1);
+ Tcl_IncrRefCount(fnobj);
+ retval = Tcl_FSStat(fnobj, &buf);
+ Tcl_DecrRefCount(fnobj);
+ if (retval != 0)
+ {
+ Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
+ return TCL_ERROR;
+ }
+
+ if (Rivet_ParseExecFile(globals->req, filename, 0) == TCL_OK) {
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_Include --
+ *
+ * Includes a file literally in the output stream. Useful for
+ * images, plain HTML and the like.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * Adds to the output stream.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_Include )
+{
+ int sz;
+ Tcl_Channel fd;
+ Tcl_Channel tclstdout;
+ Tcl_Obj *outobj;
+ char *filename;
+ Tcl_DString transoptions;
+ Tcl_DString encoptions;
+
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if( objc < 2 || objc > 3 )
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-virtual? filename");
+ return TCL_ERROR;
+ }
+
+ if( objc == 2 ) {
+ filename = Tcl_GetStringFromObj( objv[1], (int *)NULL );
+ } else {
+ if( !STREQU( Tcl_GetStringFromObj(objv[1], (int *)NULL), "-virtual") ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "?-virtual? filename" );
+ return TCL_ERROR;
+ }
+ filename = TclWeb_GetVirtualFile( globals->req,
+ Tcl_GetStringFromObj(objv[2], (int *)NULL) );
+ }
+
+ fd = Tcl_OpenFileChannel(interp, filename, "r", 0664);
+
+ if (fd == NULL)
+ {
+ return TCL_ERROR;
+ }
+ Tcl_SetChannelOption(interp, fd, "-translation", "binary");
+
+ outobj = Tcl_NewObj();
+ Tcl_IncrRefCount(outobj);
+ sz = Tcl_ReadChars(fd, outobj, -1, 0);
+ if (sz == -1)
+ {
+ Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
+ Tcl_DecrRefCount(outobj);
+ return TCL_ERROR;
+ }
+
+ /* What we are doing is saving the translation and encoding
+ * options, setting them both to binary, and the restoring the
+ * previous settings. */
+ Tcl_DStringInit(&transoptions);
+ Tcl_DStringInit(&encoptions);
+ tclstdout = Tcl_GetChannel(interp, "stdout", NULL);
+ Tcl_GetChannelOption(interp, tclstdout, "-translation", &transoptions);
+ Tcl_GetChannelOption(interp, tclstdout, "-encoding", &encoptions);
+ Tcl_SetChannelOption(interp, tclstdout, "-translation", "binary");
+ Tcl_WriteObj(tclstdout, outobj);
+ Tcl_SetChannelOption(interp, tclstdout, "-translation", Tcl_DStringValue(&transoptions));
+ Tcl_SetChannelOption(interp, tclstdout, "-encoding", Tcl_DStringValue(&encoptions));
+ Tcl_DStringFree(&transoptions);
+ Tcl_DStringFree(&encoptions);
+ Tcl_DecrRefCount(outobj);
+ return Tcl_Close(interp, fd);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_Headers --
+ *
+ * Command to manipulate HTTP headers from Tcl.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_Headers )
+{
+ char *opt;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if (objc < 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (globals->req->headers_printed != 0)
+ {
+ Tcl_AddObjErrorInfo(interp,
+ "Cannot manipulate headers - already sent", -1);
+ return TCL_ERROR;
+ }
+ opt = Tcl_GetStringFromObj(objv[1], NULL);
+
+ if (!strcmp("redirect", opt)) /* ### redirect ### */
+ {
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "new-url");
+ return TCL_ERROR;
+ }
+ apr_table_set(globals->r->headers_out, "Location",
+ Tcl_GetStringFromObj (objv[2], (int *)NULL));
+ TclWeb_SetStatus(301, globals->req);
+ return TCL_RETURN;
+ }
+ else if (!strcmp("set", opt)) /* ### set ### */
+ {
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "headername value");
+ return TCL_ERROR;
+ }
+ TclWeb_HeaderSet(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]), globals->req);
+ }
+ else if (!strcmp("add", opt)) /* ### set ### */
+ {
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "headername value");
+ return TCL_ERROR;
+ }
+ TclWeb_HeaderAdd(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]), globals->req);
+ }
+ else if (!strcmp("type", opt)) /* ### set ### */
+ {
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "mime/type");
+ return TCL_ERROR;
+ }
+ TclWeb_SetHeaderType(Tcl_GetString(objv[2]), globals->req);
+ } else if (!strcmp("numeric", opt)) /* ### numeric ### */
+ {
+ int st = 200;
+
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "response_code_number");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[2], &st) != TCL_ERROR) {
+ TclWeb_SetStatus(st, globals->req);
+ } else {
+ return TCL_ERROR;
+ }
+ } else {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_LoadEnv --
+ *
+ * Load the "environmental variables" - those variables that are
+ * set in the environment in a standard CGI program. If no array
+ * name is supplied, they are loaded into an array whose name is
+ * the value of the ENV_ARRAY_NAME #define.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_LoadEnv )
+{
+ 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( ENV_ARRAY_NAME, -1 );
+ }
+
+ return TclWeb_GetEnvVars(ArrayObj, globals->req);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_LoadHeaders --
+ *
+ * Load the HTTP headers supplied by the client into a Tcl array,
+ * whose name defaults to the value of the HEADERS_ARRAY_NAME
+ * #define.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * Creates an array variable if none exists.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER ( Rivet_LoadHeaders )
+{
+ 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( HEADERS_ARRAY_NAME, -1 );
+ }
+
+ return TclWeb_GetHeaderVars(ArrayObj, globals->req);
+}
+
+/* Tcl command to return a particular variable. */
+
+/* Use:
+*/
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_Var --
+ *
+ * Returns information about GET or POST variables:
+ *
+ * var get foo ?default?
+ * var list foo
+ * var names
+ * var number
+ * var all
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER ( Rivet_Var )
+{
+ char *cmd;
+ char *command;
+ Tcl_Obj *result = NULL;
+ int source;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if (objc < 2 || objc > 4)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "(get varname ?default?|list varname|exists varname|names"
+ "|number|all)");
+ return TCL_ERROR;
+ }
+ cmd = Tcl_GetString(objv[0]);
+ command = Tcl_GetString(objv[1]);
+ result = Tcl_NewObj();
+
+ /* determine if var_qs, var_post or var was called */
+ if (!strcmp(cmd, "var_qs")) source = VAR_SRC_QUERYSTRING;
+ else if (!strcmp(cmd, "var_post")) source = VAR_SRC_POST;
+ else source = VAR_SRC_ALL;
+
+ if (!strcmp(command, "get"))
+ {
+ char *key = NULL;
+ char *deflt = NULL;
+ if (objc != 3 && objc != 4)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "variablename ?defaultval?");
+ return TCL_ERROR;
+ }
+ key = Tcl_GetStringFromObj(objv[2], NULL);
+ if (objc == 4)
+ {
+ deflt = Tcl_GetString(objv[3]);
+ }
+
+ if (TclWeb_GetVar(result, key, source, globals->req) != TCL_OK)
+ {
+ if (deflt == NULL) {
+ Tcl_SetStringObj(result, "", -1);
+ } else {
+ Tcl_SetStringObj(result, deflt, -1);
+ }
+ }
+ } else if(!strcmp(command, "exists")) {
+ char *key;
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "variablename");
+ return TCL_ERROR;
+ }
+ key = Tcl_GetString(objv[2]);
+
+ TclWeb_VarExists(result, key, source, globals->req);
+ } else if(!strcmp(command, "list")) {
+ char *key;
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "variablename");
+ return TCL_ERROR;
+ }
+ key = Tcl_GetStringFromObj(objv[2], NULL);
+
+ if (TclWeb_GetVarAsList(result, key, source, globals->req) != TCL_OK)
+ {
+ result = Tcl_NewStringObj("", -1);
+ }
+ } else if(!strcmp(command, "names")) {
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ if (TclWeb_GetVarNames(result, source, globals->req) != TCL_OK)
+ {
+ result = Tcl_NewStringObj("", -1);
+ }
+ } else if(!strcmp(command, "number")) {
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ TclWeb_VarNumber(result, source, globals->req);
+ } else if(!strcmp(command, "all")) {
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ if (TclWeb_GetAllVars(result, source, globals->req) != TCL_OK)
+ {
+ result = Tcl_NewStringObj("", -1);
+ }
+ } else {
+ /* bad command */
+ Tcl_AppendResult(interp, "bad option: must be one of ",
+ "'get, list, names, number, all'", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, result);
+
+ return TCL_OK;
+}
+
+/*
+*/
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_Upload --
+ *
+ * Deals with file uploads (multipart/form-data) like so:
+ *
+ * upload channel uploadname
+ * upload save name uploadname
+ * upload data uploadname
+ * upload exists uploadname
+ * upload size uploadname
+ * upload type uploadname
+ * upload filename uploadname
+ * upload names
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * Has the potential to create files on the file system, or work
+ * with large amounts of data.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_Upload )
+{
+ char *varname = NULL;
+ char *command = NULL;
+
+ int subcommandindex;
+
+ Tcl_Obj *result = NULL;
+
+ static CONST84 char *SubCommand[] = {
+ "channel",
+ "save",
+ "data",
+ "exists",
+ "size",
+ "type",
+ "filename",
+ "names",
+ NULL
+ };
+
+ enum subcommand {
+ CHANNEL,
+ SAVE,
+ DATA,
+ EXISTS,
+ SIZE,
+ TYPE,
+ FILENAME,
+ NAMES
+ };
+
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+ command = Tcl_GetString(objv[1]);
+ Tcl_GetIndexFromObj(interp, objv[1], SubCommand,
+ "channel|save|data|exists|size|type|filename|names",
+ 0, &subcommandindex);
+
+ /* If it's any of these, we need to find a specific name. */
+
+ /* Excluded cases are EXISTS and NAMES. */
+ if ((enum subcommand)subcommandindex == CHANNEL ||
+ (enum subcommand)subcommandindex == SAVE ||
+ (enum subcommand)subcommandindex == DATA ||
+ (enum subcommand)subcommandindex == EXISTS ||
+ (enum subcommand)subcommandindex == SIZE ||
+ (enum subcommand)subcommandindex == TYPE ||
+ (enum subcommand)subcommandindex == FILENAME)
+ {
+ varname = Tcl_GetString(objv[2]);
+ if ((enum subcommand)subcommandindex != EXISTS)
+ {
+ if (TclWeb_PrepareUpload(varname, globals->req) != TCL_OK)
+ {
+ Tcl_AddErrorInfo(interp, "Unable to find variable");
+ return TCL_ERROR;
+ }
+ }
+
+ /* If it's not the 'save' command, then it has to have an objc
+ of 3. */
+ if ((enum subcommand)subcommandindex != SAVE && objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "varname");
+ return TCL_ERROR;
+ }
+ }
+
+ result = Tcl_NewObj();
+
+ switch ((enum subcommand)subcommandindex)
+ {
+ case CHANNEL: {
+ Tcl_Channel chan;
+ char *channelname = NULL;
+
+ if (TclWeb_UploadChannel(varname, &chan, globals->req) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ channelname = (char *)Tcl_GetChannelName(chan);
+ Tcl_SetStringObj(result, channelname, -1);
+ break;
+ }
+ case SAVE:
+ /* save data to a specified filename */
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "uploadname filename");
+ return TCL_ERROR;
+ }
+
+ if (TclWeb_UploadSave(varname, objv[3], globals->req) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ break;
+ case DATA:
+ if (TclWeb_UploadData(varname, result, globals->req) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case EXISTS:
+ if (TclWeb_PrepareUpload(varname, globals->req) != TCL_OK)
+ {
+ Tcl_SetIntObj(result, 0);
+ } else {
+ Tcl_SetIntObj(result, 1);
+ }
+ break;
+ case SIZE:
+ TclWeb_UploadSize(result, globals->req);
+ break;
+ case TYPE:
+ TclWeb_UploadType(result, globals->req);
+ break;
+ case FILENAME:
+ TclWeb_UploadFilename(result, globals->req);
+ break;
+ case NAMES:
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "names");
+ return TCL_ERROR;
+ }
+ TclWeb_UploadNames(result, globals->req);
+ break;
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "channel|save ?name?|data|exists|size|type|filename|names");
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_RawPost --
+ *
+ * Returns the raw POST data.
+ *
+ * Results:
+ * The raw post data, or an empty string if there is none.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER ( Rivet_RawPost )
+{
+ char *data;
+ Tcl_Obj *retval;
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ data = TclWeb_GetRawPost(globals->req);
+
+ if (!data) {
+ data = "";
+ }
+ retval = Tcl_NewStringObj(data, -1);
+ Tcl_SetObjResult(interp, retval);
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_NoBody --
+ *
+ * Tcl command to erase body, so that only header is returned.
+ * Necessary for 304 responses.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side Effects:
+ * Eliminates any body returned in the HTTP response.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_NoBody )
+{
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+
+ if (globals->req->content_sent == 1) {
+ Tcl_AddErrorInfo(interp, "Content already sent");
+ return TCL_ERROR;
+ }
+
+ globals->req->content_sent = 1;
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_AbortPageCmd --
+ *
+ * Similar in purpose to PHP's "die" command, which halts all
+ * further output to the user. Like an "exit" for web pages, but
+ * without actually exiting the apache child.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * Flushes the standard (apache) output channel, and tells apache
+ * to stop sending data.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_AbortPageCmd )
+{
+ static char *errorMessage = "Page generation terminated by abort_page directive";
+
+ if (objc != 1)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+
+ Tcl_AddErrorInfo (interp, errorMessage);
+ Tcl_SetErrorCode (interp, "RIVET", "ABORTPAGE", errorMessage, (char *)NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_EnvCmd --
+ *
+ * Loads a single environmental variable, to avoid the overhead
+ * of storing all of them when only one is needed.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_EnvCmd )
+{
+ rivet_interp_globals *globals = Tcl_GetAssocData( interp, "rivet", NULL );
+ char *key;
+ char *val;
+
+ if( objc != 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "variable" );
+ return TCL_ERROR;
+ }
+
+ key = Tcl_GetStringFromObj( objv[1], NULL );
+
+ val = TclWeb_GetEnvVar( globals->req, key );
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj( val, -1 ) );
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_VirtualFilenameCmd --
+ *
+ * Gets file according to its relationship with the request's
+ * root. (FIXME - check this).
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+TCL_CMD_HEADER( Rivet_VirtualFilenameCmd )
+{
+ rivet_interp_globals *globals = Tcl_GetAssocData( interp, "rivet", NULL );
+ char *filename;
+ char *virtual;
+
+ if( objc != 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "filename" );
+ return TCL_ERROR;
+ }
+
+ virtual = Tcl_GetStringFromObj( objv[1], NULL );
+ filename = TclWeb_GetVirtualFile( globals->req, virtual );
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj( filename, -1 ) );
+ return TCL_OK;
+}
+
+#define TESTPANIC 0
+
+#ifdef TESTPANIC
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestpanicCmd --
+ *
+ * Calls the panic routine.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * May exit application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestpanicCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
+{
+ CONST char *argString;
+
+ /*
+ * Put the arguments into a var args structure
+ * Append all of the arguments together separated by spaces
+ */
+
+ argString = Tcl_Merge(argc-1, argv+1);
+ panic(argString);
+ ckfree((char *)argString);
+
+ return TCL_OK;
+}
+#endif /* TESTPANIC */
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Rivet_InitCore --
+ *
+ * Creates the core rivet commands.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * Creates new commands.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+Rivet_InitCore( Tcl_Interp *interp )
+{
+ Tcl_CreateObjCommand(interp,
+ "makeurl",
+ Rivet_MakeURL,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "headers",
+ Rivet_Headers,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "load_env",
+ Rivet_LoadEnv,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "load_headers",
+ Rivet_LoadHeaders,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "var",
+ Rivet_Var,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "var_qs",
+ Rivet_Var,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "var_post",
+ Rivet_Var,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "raw_post",
+ Rivet_RawPost,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "upload",
+ Rivet_Upload,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "include",
+ Rivet_Include,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "parse",
+ Rivet_Parse,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "no_body",
+ Rivet_NoBody,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp,
+ "env",
+ Rivet_EnvCmd,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+
+#ifdef TESTPANIC
+ Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+#endif
+
+ TCL_OBJ_CMD( "abort_page", Rivet_AbortPageCmd );
+ TCL_OBJ_CMD( "virtual_filename", Rivet_VirtualFilenameCmd );
+
+ return TCL_OK;
+}
Modified: tcl/rivet/trunk/src/rivetChannel.c
URL: http://svn.apache.org/viewcvs/tcl/rivet/trunk/src/rivetChannel.c?rev=369059&r1=369058&r2=369059&view=diff
==============================================================================
--- tcl/rivet/trunk/src/rivetChannel.c (original)
+++ tcl/rivet/trunk/src/rivetChannel.c Sat Jan 14 09:15:42 2006
@@ -27,7 +27,7 @@
#include <tcl.h>
#include <errno.h>
-#include "apache_request.h"
+//#include "apache_request.h"
#include "mod_rivet.h"
#include "TclWeb.h"
@@ -46,19 +46,13 @@
{
rivet_server_conf *rsc = (rivet_server_conf *)instancedata;
rivet_interp_globals *globals =
- Tcl_GetAssocData(rsc->server_interp, "rivet", NULL);
-
- /* If this is true, we're in the process of shutting down - just
- * throw it away. */
- if (globals == NULL) {
- return toWrite;
- }
+ Tcl_GetAssocData(rsc->server_interp, "rivet", NULL);
TclWeb_PrintHeaders(globals->req);
if (globals->req->content_sent == 0)
{
- ap_rwrite(buf, toWrite, globals->r);
- ap_rflush(globals->r);
+ ap_rwrite(buf, toWrite, globals->r);
+ ap_rflush(globals->r);
}
return toWrite;
}
@@ -103,3 +97,4 @@
NULL,
NULL
};
+
Modified: tcl/rivet/trunk/src/rivetCore.c
URL: http://svn.apache.org/viewcvs/tcl/rivet/trunk/src/rivetCore.c?rev=369059&r1=369058&r2=369059&view=diff
==============================================================================
--- tcl/rivet/trunk/src/rivetCore.c (original)
+++ tcl/rivet/trunk/src/rivetCore.c Sat Jan 14 09:15:42 2006
@@ -2,7 +2,7 @@
* rivetCore.c - Core commands which are compiled into mod_rivet itself.
*/
-/* Copyright 2002-2005 The Apache Software Foundation
+/* Copyright 2002-2004 The Apache Software Foundation
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
@@ -881,7 +881,11 @@
*/
static int
-TestpanicCmd(ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
+TestpanicCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST char **argv; /* Argument strings. */
{
CONST char *argString;
@@ -909,8 +913,7 @@
* A standard Tcl result.
*
* Side Effects:
- * Adds core Rivet commands to the specified Tcl interpreter, such
- * as makeurl, headers, load_env, load_headers, var, etc.
+ * Creates new commands.
*
*-----------------------------------------------------------------------------
*/
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-cvs-help@tcl.apache.org