Index: mod_nsd/mod_nsd.c
===================================================================
RCS file: /usr/local/cvsroot/mod_nsd/mod_nsd.c,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ mod_nsd/mod_nsd.c 5 Jun 2001 11:50:15 -0000 1.1
@@ -0,0 +1,1081 @@
+/* ====================================================================
+ *
+ * Copyright (c) 2000, Robert S. Thau. Derived from the NeoSoft
+ * extensions to Apache; portions copyright NeoSoft and The Apache
+ * Group, and redistributed in accord with their respective licenses.
+ *
+ * Copyright (c) 1996-1998 NeoSoft, Inc. All rights reserved.
+ *
+ * You may freely redistribute most NeoSoft extensions to the Apache webserver
+ * for any purpose except commercial resale and/or use in secure servers,
+ * which requires, in either case, written permission from NeoSoft, Inc. Any
+ * redistribution of this software must retain this copyright, unmodified
+ * from the original.
+ *
+ * Certain NeoSoft extensions, such as those in support of electronic
+ * commerce, require a license for use and may not be redistributed
+ * without explicit written permission, obtained in advance of any
+ * such distribution from NeoSoft, Inc. These files are clearly marked
+ * with a different copyright.
+ *
+ * Other packages included with this distribution may contain their own
+ * copyrights. It is your responsibility to insure that you are operating
+ * in compliance with all relevant copyrights. The NeoSoft copyright is
+ * not intenteded to infringe on the rights of the authors or owners of
+ * said copyrights.
+ *
+ * Some of the software in this file may be derived from code
+ * Copyright (c) 1995 The Apache Group. All rights reserved.
+ *
+ * Redistribution and use of Apache code in source and binary forms is
+ * permitted under most conditions. Please consult the source code to
+ * a standard Apache module, such as mod_include.c, for the exact
+ * terms of this copyright.
+ *
+ * THIS SOFTWARE IS PROVIDED BY NEOSOFT ``AS IS'' AND ANY
+ * EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL NEOSOFT, THE APACHE GROUP, OR
+ * ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+ * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ * ====================================================================
+ */
+
+/*
+ * mod_nsd.c: Handles AOLserver TCL and, eventually, ADP.
+ *
+ * Based on NeoScript TCL extensions to Apache, which were in turn
+ * based on include processing module originally written by Rob McCool;
+ * with substantial fixups by David Robinson;
+ * incorporated into the Shambhala module framework by rst.
+ *
+ * Alterations from there to present form by NeoSoft
+ *
+ */
+
+#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 "util_md5.h"
+
+/* #include <db.h> */
+#include <assert.h>
+#include <stdio.h>
+
+#ifdef linux
+#include <dlfcn.h>
+#endif
+
+#include "tcl.h"
+
+#include "mod_nsd.h"
+#include "nsd.h"
+
+/* Data structures --- some of the following are private to this file.
+ * See mod_nsd.h for the semipublic interfaces.
+ */
+
+Tcl_Interp *master_interp = NULL;
+Tcl_Interp *aolcmd_interp = NULL;
+module MODULE_VAR_EXPORT aolserver_module;
+static void Tcl_InitExtensions(Tcl_Interp *interp, int for_main);
+
+static int tcl_subprocess(void *, child_info *);
+static int tcl_subprocess_detached(void *, child_info *);
+
+request_rec *Tcl_request_rec = NULL;
+pool *Tcl_pool = NULL;
+server_rec *Tcl_server = NULL;
+
+Ns_Tls client_block_setup; /* Not null if we've done setup_client_block */
+Ns_Tls client_block_done; /* Not null if we've done should_client_block */
+Ns_Tls forced_error; /* Error code forced by tcl ... */
+
+char *nsServer = NULL;
+
+/* Per server config --- pretty vestigial at this point */
+
+typedef struct {
+ table *aol_server_vars;
+} aol_server_config;
+
+/* Implementation of some commands, particularly those which involve
+ * heavy interaction with Apache machinery
+ */
+
+static int
+BadArgs0(Tcl_Interp *interp, char *cmd, char *args)
+{
+ Tcl_AppendResult(interp, "wrong # of args: should be \"",
+ cmd, " ", args, "\"", NULL);
+
+ return TCL_ERROR;
+}
+
+int
+Tcl_ns_write(ClientData notused, Tcl_Interp *interp, int argc, char **argv)
+{
+ request_rec *r = Tcl_request_rec;
+ int i = 1;
+
+ if (!r->sent_bodyct) {
+ /* User is faking their own http headers with ns_write.
+ * Let Apache know we're faking it.
+ */
+ r->sent_bodyct = 1;
+ }
+
+ for (i = 1; i < argc; ++i) ap_rputs (argv[i], r);
+ return TCL_OK;
+}
+
+int
+Tcl_ns_return_status (ClientData notused, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ request_rec *r = Tcl_request_rec;
+ int *gorp = ap_palloc (r->pool, sizeof(int));
+
+ if (argc != 2) return BadArgs0 (interp, argv[0], "status");
+ if (Tcl_GetInt (interp, argv[1], gorp) != TCL_OK) return TCL_ERROR;
+
+ Ns_TlsSet (&forced_error, gorp);
+ return TCL_OK;
+}
+
+int
+Tcl_ns_return(ClientData notused, Tcl_Interp *interp, int argc, char **argv)
+{
+ request_rec *r = Tcl_request_rec;
+
+ if (argc == 5) ++argv; /* ignore conn-id arg */
+ else if (argc != 4)
+ return BadArgs0 (interp, argv[0], "status content-type message");
+
+ r->status = atoi (argv[1]);
+ r->content_type = ap_pstrdup (r->pool, argv[2]);
+ ap_send_http_header (r);
+ ap_rputs (argv[3], r);
+ return TCL_OK;
+}
+
+int
+Tcl_start_subprocess(ClientData notused, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ int do_detach;
+ pid_t pid;
+
+ if (argc != 3) {
+ Tcl_SetResult (interp, "Wrong number of args", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ do_detach = !strcmp (argv[1], "detach");
+
+ /*
+ * Need to add code here to wipe all database handles. (We could
+ * try doing it in the child, and leaving them open in the parent,
+ * but if the close stuff in the child involves any communication
+ * at all with the db, which it well might, that won't work...).
+ */
+
+ pid = ap_spawn_child (TCL_POOL(),
+ do_detach ? tcl_subprocess_detached : tcl_subprocess,
+ argv[2],
+ do_detach? kill_never : kill_after_timeout,
+ NULL, NULL, NULL);
+
+ if (!pid) {
+ Ns_ModLog (Error, "spawn", "Could not spawn subprocess for %s",
+ argv[2]);
+ Tcl_AppendResult (interp, "Could not spawn subprocess for ",
+ argv[2], NULL);
+ return TCL_ERROR;
+ }
+
+ if (do_detach) {
+ /* child will immediately fork and exit, so this should be
+ * very fast...
+ */
+ int status;
+ waitpid(pid, &status, 0);
+ }
+
+ return TCL_OK;
+}
+
+static int tcl_subprocess (void *cmd_voidp, child_info *dummy)
+{
+ char *cmd = (char *)cmd_voidp;
+
+ if (Tcl_GlobalEval (master_interp, cmd) == TCL_ERROR) {
+ Ns_ModLog (Error, "spawn",
+ "Execution of %s in a subprocess threw an error:\n%s",
+ cmd, Tcl_GetVar (master_interp, "errorInfo",
+ TCL_GLOBAL_ONLY));
+ }
+ return 0;
+}
+
+static int tcl_subprocess_detached (void *cmd_voidp, child_info *dummy)
+{
+ switch (fork()) {
+ case -1:
+ /* error */
+ Ns_ModLog(Error, "tcl_subprocess_detached", "could not fork to detach subprocess for %s", (char *)cmd_voidp);
+ break;
+
+ case 0:
+ /* child */
+ tcl_subprocess(cmd_voidp, dummy);
+ break;
+
+ default:
+ /* parent */
+ break;
+ }
+
+ exit(0);
+}
+
+int
+Tcl_ns_info_hostname(ClientData notused, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ server_rec *s = Tcl_request_rec ? Tcl_request_rec->server : Tcl_server;
+ Tcl_SetResult (interp, s->server_hostname, TCL_STATIC);
+ return TCL_OK;
+}
+
+static void
+move_table_elements(table *to, table *from)
+{
+ int i;
+
+ int from_nelts = ap_table_elts(from)->nelts;
+ table_entry *from_elts = (table_entry *) ap_table_elts(from)->elts;
+
+ pool *to_pool = ap_table_elts(to)->pool;
+ pool *from_pool = ap_table_elts(from)->pool;
+ int copy_p = to_pool != from_pool;
+
+ for (i = 0; i < from_nelts; i++) {
+ table_entry *new = (table_entry *) ap_push_array(ap_table_elts(to));
+ if (copy_p) {
+ new->key = ap_pstrdup(to_pool, from_elts[i].key);
+ new->val = ap_pstrdup(to_pool, from_elts[i].val);
+ }
+ else {
+ new->key = from_elts[i].key;
+ new->val = from_elts[i].val;
+ }
+ }
+
+ ap_clear_table(from);
+}
+
+int
+Tcl_ns_conn(ClientData notused, Tcl_Interp *interp, int argc, char **argv)
+{
+ /* Note that some of ns_conn is implemented in tcl ... */
+
+ request_rec *r = Tcl_request_rec;
+
+ if (argc != 2)
+ return BadArgs0 (interp, argv[0],
+ "[authpasswd|authuser|close|contentlength|"
+ "driver|form|headers|host|isconnected|location|"
+ "location|method|outputheaders|peeraddr|port|"
+ "protocol|query|request|url|urlc|urlv|version]");
+
+ /* Host not done */
+
+ if (!strcmp (argv[1], "isconnected")) {
+ Tcl_SetResult(interp, (Tcl_request_rec ? "1" : "0"), TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (!Tcl_request_rec) {
+ Tcl_SetResult (interp, "Not in a connection thread", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ if (!strcmp (argv[1], "authuser")) {
+ Tcl_SetResult (interp, r->connection->user, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ /* authpasswd not done */
+
+ if (!strcmp (argv[1], "close")) {
+ ap_finalize_request_protocol(r);
+ return TCL_OK;
+ }
+
+ /* contentlength not done --- not defined until read if chunked input. */
+
+ if (!strcmp (argv[1], "driver")) {
+ /* XXX should return nssssl if secure... but which SSL package? */
+ Tcl_SetResult (interp, "nssock", TCL_STATIC);
+ return TCL_OK;
+ }
+
+ /* form done in C. */
+
+ if (!strcmp (argv[1], "headers")) {
+ /* Assume HeaderCase *always* set to preserve */
+ ns_enter_set(interp,
+ ns_set_create_internal("Headers", r->headers_in));
+ return TCL_OK;
+ }
+
+ if (!strcmp (argv[1], "outputheaders")) {
+
+ /* In order to show the complete list, we have to copy anything
+ * prior modules placed in r->headers_out from there into
+ * r->err_headers_out. This isn't a wonderful solution, but in
+ * almost all cases, the r->headers_out will be output anyway
+ * if we get this far, so this loses in a way that's far less
+ * consequential than, say, not showing the tcl code some of the
+ * output headers.
+ */
+
+ move_table_elements (r->err_headers_out, r->headers_out);
+ ns_enter_set(interp,
+ ns_set_create_internal("Headers", r->headers_out));
+ return TCL_OK;
+ }
+
+ if (!strcmp (argv[1], "method")) {
+ /* Cast below is to shrug off a "const" */
+ Tcl_SetResult (interp, (char *)r->method, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (!strcmp (argv[1], "query")) {
+ Tcl_SetResult (interp, r->args, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (!strcmp (argv[1], "url")) {
+ Tcl_SetResult (interp, r->uri, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (!strcmp (argv[1], "status")) {
+ char buf[20];
+ sprintf (buf, "%d", r->status);
+ Tcl_SetResult (interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+
+ /* urlc and urlv done in tcl */
+
+ if (!strcmp (argv[1], "host")) {
+ /* cast to lose a "const" */
+ Tcl_SetResult (interp, (char *)ap_get_server_name (r), TCL_STATIC);
+ return TCL_OK;
+ }
+
+ if (!strcmp (argv[1], "port")) {
+ char buf[16];
+ sprintf (buf, "%d", ap_get_server_port (r));
+ Tcl_SetResult (interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+ }
+
+ if (!strcmp (argv[1], "request")) {
+ Tcl_SetResult (interp, r->the_request, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ /* protocol not done --- useless as specified. Which isn't this: */
+
+ if (!strcmp (argv[1], "rprotocol")) {
+ Tcl_SetResult (interp, r->protocol, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ /* location, version done in C */
+
+ if (!strcmp (argv[1], "peeraddr")) {
+ Tcl_SetResult (interp, r->connection->remote_ip, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ /* But one thing done here which is not in aolserver; this
+ * is for error handling...
+ */
+
+ if (!strcmp (argv[1], "sentheader")) {
+ Tcl_SetResult (interp, r->sent_bodyct? "1" : "0", TCL_STATIC);
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult (interp, "ns_conn ", argv[1], " unsupported", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ * C assists for form handling. First, some common framework...
+ * routines to set up and finish off reading a request body. Setup
+ * routine returns TCL_BREAK if the request has no body, and TCL_ERROR
+ * if there was an error which needs to be reported back to the
+ * client. Wrapup routine takes a user comprehensible name for
+ * whatever ate the request body, so we get to report an intelligible
+ * error if something else tries to do it again for the same request.
+ */
+
+static int request_body_setup (Tcl_Interp *interp)
+{
+ request_rec *r = Tcl_request_rec;
+
+ if (Ns_TlsGet (&client_block_done)) {
+ Tcl_AppendResult (interp, "Request body already processed by",
+ Ns_TlsGet (&client_block_done), NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Ns_TlsGet (&client_block_setup)) {
+ int errstatus = ap_setup_client_block (r, REQUEST_CHUNKED_DECHUNK);
+ if (errstatus) {
+ Tcl_AppendResult (interp,
+ "Error setting up to receive request body",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (!ap_should_client_block(r)) {
+ return TCL_BREAK;
+ }
+
+ ap_soft_timeout("Uplinking PUT/POST", r);
+ return TCL_OK;
+}
+
+static void request_body_wrapup (char *consumer) {
+ ap_kill_timeout(Tcl_request_rec);
+ Ns_TlsSet (&client_block_done, consumer);
+}
+
+/*
+ * If request has a body, upload it and
+ * return it as a string; otherwise, return r->args.
+ */
+
+int
+Tcl_ns_req_data (ClientData notused, Tcl_Interp *interp, int argc, char**argv)
+{
+ request_rec *r = Tcl_request_rec;
+ char argsbuffer[HUGE_STRING_LEN];
+ Tcl_DString tclStdinString;
+ int len_read, setup_status;
+
+ if ((setup_status = request_body_setup (interp)) != TCL_OK) {
+
+ if (setup_status != TCL_BREAK) return setup_status;
+
+ Tcl_SetResult (interp, r->args, TCL_STATIC);
+ return TCL_OK;
+ }
+
+ Tcl_DStringInit(&tclStdinString);
+
+ do {
+ len_read = ap_get_client_block (r, argsbuffer, sizeof(argsbuffer));
+
+ if (len_read > 0)
+ Tcl_DStringAppend (&tclStdinString, argsbuffer, len_read);
+ } while (len_read > 0);
+
+ Tcl_SetResult (interp, Tcl_DStringValue(&tclStdinString), TCL_VOLATILE);
+ Tcl_DStringFree(&tclStdinString);
+
+ request_body_wrapup ("ns_conn form");
+
+ return TCL_OK;
+}
+
+/* Dump the request body into a tcl channel */
+
+int
+Tcl_ns_conncptofp (ClientData notused, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ char *channame = argv[1];
+ int status, len_read;
+ Tcl_Channel chan;
+ char argsbuffer[HUGE_STRING_LEN];
+ request_rec *r = Tcl_request_rec;
+
+ if (argc == 3) { channame = argv[2]; }
+ else if (argc != 2) { return BadArgs0 (interp, argv[0], "channel"); }
+
+ if ((chan = Tcl_GetChannel (interp, channame, &status)) == NULL) {
+ return TCL_ERROR;
+ }
+ if (!(status&TCL_WRITABLE)) {
+ Tcl_AppendResult (interp, "Channel ", channame, " not writable", NULL);
+ return TCL_ERROR;
+ }
+ if (r == NULL) {
+ Tcl_SetResult (interp, "Not connected", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if ((status = request_body_setup (interp)) != TCL_OK) {
+ if (status == TCL_BREAK)
+ Tcl_AppendResult (interp, argv[0], " for a ", r->method,
+ " request with no body", NULL);
+ return TCL_ERROR;
+ }
+
+ status = TCL_OK;
+
+ do {
+ /* NB even with write errors, we still read the complete req body */
+
+ len_read = ap_get_client_block (r, argsbuffer, sizeof(argsbuffer));
+
+ if (len_read > 0 && status == TCL_OK &&
+ Tcl_Write (chan, argsbuffer, len_read) < 0)
+ {
+ Ns_ModLog (Error, "write",
+ "Error writing request body to channel %s", channame);
+
+ status = TCL_ERROR;
+ Tcl_AppendResult (interp, "Write error on channel ", channame,
+ ": ", Tcl_PosixError(interp), NULL);
+ }
+ } while (len_read > 0);
+
+ request_body_wrapup ("ns_conncptofp");
+ return status;
+}
+
+/* A few unix primitives needed by the ns_mutex and ns_cond code */
+
+static int
+Tcl_ap_pid(ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
+{
+ sprintf(interp->result, "%lu", (unsigned long)getpid());
+ return TCL_OK;
+}
+
+static int
+Tcl_ap_mkfifo(ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
+{
+ if (argc != 3) return BadArgs0 (interp, argv[0], "path mode");
+
+ if (mkfifo (argv[1], strtol (argv[2], NULL, 8)) < 0) {
+ Ns_ModLog (Error, "mkfifo", "Could not create fifo %s", argv[1]);
+ Tcl_SetResult (interp, "It failed --- consult error log for reason",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/* Making some of the above routines, as well as everything we've imported
+ * from the actual AOLserver C code, available to the tcl slave interpreter
+ * which runs user tcl...
+ */
+
+int
+Tcl_ExtendSlaveCmd (dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_Interp *slaveInterp;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " slaveInterpName\"", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slaveInterp = Tcl_GetSlave(interp, argv[1]);
+ if (slaveInterp == (Tcl_Interp *)NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_InitExtensions (slaveInterp, 0);
+ aolcmd_interp = slaveInterp;
+ return TCL_OK;
+}
+
+/* Database support */
+
+int ns_db_init (ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
+{
+ /* At some point we may decide to package db drivers into their
+ * own loadable Apache modules (to be loaded after mod_aolserver);
+ * when we do that, explicit invocation of the driver's DbDriverInit
+ * here goes away...
+ */
+ Ns_DbDriverInit (DB_DRIVER_NAME, "ns/db/driver/" DB_DRIVER_NAME);
+
+ /* NsDbInit() initializes the pool data structures; it's been
+ * modified here to expect all db drivers to have been already loaded.
+ * So this stays here...
+ */
+
+ NsDbInit();
+ return TCL_OK;
+}
+
+int ns_db_cleanup (ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
+{
+ ns_release_all_db_handles();
+ return TCL_OK;
+}
+
+/* Initialization functions. */
+
+static int ns_set_servername (ClientData dummy, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ /* Called during configuration to set nsServer, if need be */
+
+ if (argc != 2) {
+ Tcl_SetResult (interp, "One arg only!", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ nsServer = ap_pstrdup (Tcl_pool, argv[1]);
+ return TCL_OK;
+}
+
+static void do_one_cmd (server_rec *s, pool *p, char *cmd)
+{
+ int code;
+
+ Tcl_pool = p;
+ code = Tcl_Eval(master_interp, cmd);
+ if (code == TCL_ERROR) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, s,
+ "Tcl error in server_shutdown hook: %s\n",
+ Tcl_GetVar (master_interp, "errorInfo", TCL_GLOBAL_ONLY));
+ }
+ Tcl_pool = NULL;
+}
+
+struct aol_exit_data {
+ pool *p;
+ server_rec *s;
+};
+
+static void aol_exit(void *vdata)
+{
+ struct aol_exit_data *data = (struct aol_exit_data *)vdata;
+ do_one_cmd (data->s, data->p, "run_hooks server_shutdown");
+}
+
+#ifdef linux
+static void load_libpthread(void)
+{
+ /*
+ * On Linux, libclntsh.so (the Oracle client library) is linked
+ * against libpthread.so. So libpthread.so gets loaded into
+ * Apache when mod_aolserver.so gets loaded. But then Apache
+ * unloads mod_aolserver before detaching, which winds up
+ * unloading libpthread.so. Unloading libpthread.so makes things
+ * crash. So we load libpthread.so here in a way that will keep
+ * it loaded.
+ */
+
+ void *lib = dlopen("libpthread.so", RTLD_LAZY);
+ fprintf(stderr, "libpthread.so loaded at %p\n", lib);
+}
+#endif
+
+static void init_aol(server_rec *s, pool *p)
+{
+ table *t;
+ table_entry *elts;
+ array_header *arr;
+ int i, nelts;
+ aol_server_config *ns;
+ struct aol_exit_data *aol_exit_hook;
+
+#ifdef linux
+ load_libpthread();
+#endif
+
+ /* Get a handle on our server config, and do basic internal setup */
+
+ if (Tcl_server == NULL) Tcl_server = s;
+ ns = (aol_server_config *)ap_get_module_config(Tcl_server->module_config,
+ &aolserver_module);
+
+ ap_add_version_component("mod_nsd/1.3b1");
+
+ nsServer = "server1"; /* Default */
+ ns_init_tls();
+ Ns_TlsAlloc (&client_block_setup, NULL);
+ Ns_TlsAlloc (&client_block_done, NULL);
+ Ns_TlsAlloc (&forced_error, NULL);
+
+ /* Initialize core Tcl components and extensions */
+
+ if (master_interp) {
+ Tcl_DeleteInterp(master_interp);
+ }
+ master_interp = Tcl_CreateInterp();
+
+ /* Tcl */
+ if (Tcl_Init(master_interp) == TCL_ERROR) {
+ fprintf(stderr,
+ "failed to init mod_aolserver Tcl component: %s\n",
+ master_interp->result);
+ exit(1);
+ }
+
+ /* Initialize aolserver subsystems */
+
+ NsAdpInit();
+
+ /* Add our own commands */
+
+ Tcl_InitExtensions(master_interp, 1);
+
+ /*
+ * copy any variables defined with mod_aolserver (nee neowebscript)
+ * server config commands into a Tcl array
+ */
+
+ t = ns->aol_server_vars;
+
+ arr = ap_table_elts(t);
+ elts = (table_entry *)arr->elts;
+ nelts = arr->nelts;
+
+ for (i = 0; i < nelts; ++i)
+ Tcl_SetVar2(master_interp, "ap_server_conf",
+ elts[i].key, elts[i].val, TCL_GLOBAL_ONLY);
+
+ Tcl_SetVar2(master_interp, "ap_server_conf",
+ "SERVER_ROOT", ap_server_root_relative(p, "."), TCL_GLOBAL_ONLY);
+
+ /* Do the bootstrap load */
+
+ Tcl_pool = p; /* Give tcl run in config a resource pool... */
+
+ if (Tcl_VarEval(master_interp, "source ",
+ ap_server_root_relative(p, "libexec/aol_bootstrap.tcl"), (char *)NULL) == TCL_ERROR)
+ {
+ char *errorInfo;
+
+ errorInfo = Tcl_GetVar (master_interp, "errorInfo", TCL_GLOBAL_ONLY);
+ fprintf(stderr,"mod_aolserver startup failed: %s\n", errorInfo);
+ exit(1);
+ }
+
+ /* Set up the server_shutdown hook */
+
+ aol_exit_hook = (struct aol_exit_data *)
+ ap_palloc (p, sizeof (struct aol_exit_data));
+
+ aol_exit_hook->s = s;
+ aol_exit_hook->p = p;
+ ap_register_cleanup(p, (void *)aol_exit_hook, aol_exit, NULL);
+
+ Tcl_pool = NULL;
+}
+
+static void
+Tcl_InitExtensions(Tcl_Interp *interp, int for_main)
+{
+ extern void nsv_install_cmds (Tcl_Interp *, int);
+
+ Tcl_CreateCommand (interp, "ns_return", Tcl_ns_return, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_write", Tcl_ns_write, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_conncptofp", Tcl_ns_conncptofp, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_returnstatus", Tcl_ns_return_status,
+ NULL, NULL);
+ Tcl_CreateCommand (interp, "ap_pid", Tcl_ap_pid, NULL, NULL);
+
+ NsTclCreateCmds (interp); /* For imported aolserver C commands... */
+ nsv_install_cmds (interp, for_main);
+
+ if (!for_main) return;
+
+ Tcl_CreateCommand (interp, "ap_mkfifo", Tcl_ap_mkfifo, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_conn_inner", Tcl_ns_conn, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_req_data", Tcl_ns_req_data, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_db_init", ns_db_init, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_db_cleanup", ns_db_cleanup, NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_set_servername", ns_set_servername,
+ NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_info_hostname", Tcl_ns_info_hostname,
+ NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_extend_slave", Tcl_ExtendSlaveCmd,
+ NULL, NULL);
+ Tcl_CreateCommand (interp, "ns_spawn_child", Tcl_start_subprocess,
+ NULL, NULL);
+}
+
+int Ns_TclInitInterps (char *server, int (*proc)(Tcl_Interp *, void *),
+ void *data)
+{
+ return proc (aolcmd_interp, data);
+}
+
+static void aol_child_init(server_rec *s, pool *p)
+{
+ do_one_cmd (s, p, "run_hooks child_init");
+}
+
+static void aol_child_exit(server_rec *s, pool *p)
+{
+ do_one_cmd (s, p, "run_hooks child_exit");
+}
+
+/* ------------------------ Environment function -------------------------- */
+
+
+/*
+ * process_file_in_tcl --- apply the given cmd to the contents of the FILE*
+ * --- note that if any slave interpreters are involved, we leave tcl to
+ * arrange the mechanics.
+ */
+static void process_file_in_tcl (request_rec *r, char *cmd)
+{
+ Tcl_DString userCommand;
+ char *commandString;
+
+ Tcl_DStringInit(&userCommand);
+ Tcl_DStringAppendElement(&userCommand, cmd);
+ Tcl_DStringAppendElement(&userCommand, r->filename);
+ commandString = Tcl_DStringValue(&userCommand);
+
+ if (Tcl_GlobalEval (master_interp, commandString) == TCL_ERROR) {
+ ap_rprintf (r, "[%s error %s]", commandString, master_interp->result);
+ }
+ Tcl_DStringFree(&userCommand);
+}
+
+static int aolserver_fixup (request_rec *r)
+{
+ request_rec *Tcl_saved_request_rec = Tcl_request_rec;
+ int retval;
+ char *done_client;
+ int *status;
+
+ if (r->server != Tcl_server) return DECLINED;
+
+ /* Kludge --- don't run filters (or procs!) on subrequests.
+ * *Should* just suppress filters, and run procs in a handler
+ */
+
+ if (r->main) return DECLINED;
+
+ Tcl_request_rec = r;
+
+ retval = Tcl_GlobalEval (master_interp, "run_aol_filters");
+ done_client = Ns_TlsGet (&client_block_done);
+ status = (int *)Ns_TlsGet (&forced_error);
+
+ Tcl_request_rec = Tcl_saved_request_rec;
+
+ if (retval == TCL_ERROR) {
+ ap_log_rerror (APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
+ "Yipes! aol_bootstrap filter code threw an error: %s",
+ Tcl_GetVar (master_interp,"errorInfo",TCL_GLOBAL_ONLY));
+ return SERVER_ERROR;
+ }
+
+ if (!strcmp (master_interp->result, "filter_return") || r->sent_bodyct) {
+ r->handler = "aolsuppress";
+ }
+ else if (done_client != NULL) {
+ ap_log_rerror (APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
+ "Filter consumed %s body with %s but sent no response",
+ r->method, done_client);
+ return SERVER_ERROR;
+ }
+
+ return (status != NULL) ? *status : OK;
+}
+
+static int aolserver_wrapup (request_rec *r)
+{
+ request_rec *Tcl_saved_request_rec = Tcl_request_rec;
+
+ if (r->server != Tcl_server) return DECLINED;
+
+ Tcl_request_rec = r;
+
+ if (Tcl_GlobalEval (master_interp, "run_aol_wrapup") == TCL_ERROR) {
+ ap_log_rerror (APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
+ "Yipes! aol_bootstrap wrapup code threw an error: %s",
+ Tcl_GetVar (master_interp,"errorInfo",TCL_GLOBAL_ONLY));
+ return SERVER_ERROR;
+ }
+
+ Tcl_request_rec = Tcl_saved_request_rec;
+ return OK;
+}
+
+static int aolsuppress_handler (request_rec *r)
+{
+ /* Filters have already handled the request, so... */
+ return OK;
+}
+
+static int send_aolserver_file (request_rec *r, int is_adp)
+{
+ FILE *f;
+ int *status;
+ int errstatus;
+ request_rec *Tcl_saved_request_rec = Tcl_request_rec;
+
+ if (r->server != Tcl_server) return DECLINED;
+
+ if (!(ap_allow_options(r) & OPT_EXECCGI)) return DECLINED;
+
+ r->allowed |= (1 << M_GET) | (1 << M_POST);
+
+ if (r->finfo.st_mode == 0) {
+ ap_log_rerror(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
+ "File does not exist: %s", r->filename);
+ return HTTP_NOT_FOUND;
+ }
+
+ if (!(f = ap_pfopen(r->pool, r->filename, "r"))) {
+ ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
+ "file permissions deny server access: %s", r->filename);
+ return HTTP_FORBIDDEN;
+ }
+
+ /* PUT and POST handling */
+
+ if ((errstatus = ap_setup_client_block(r, REQUEST_CHUNKED_DECHUNK))) {
+ return errstatus;
+ }
+
+ Ns_TlsSet (&client_block_setup, (void*)&client_block_setup);
+
+#ifdef CHARSET_EBCDIC
+ ap_bsetflag(r->connection->client, BEBCDIC2ASCII, 1);
+#endif
+
+ /* Actually run the request */
+
+ Tcl_request_rec = r;
+
+ ap_soft_timeout ("send", r);
+
+ if (is_adp)
+ Ns_AdpRequest(r, r->filename);
+ else
+ process_file_in_tcl (r, "handle_aol_request");
+
+ ap_kill_timeout(r);
+ status = (int *)Ns_TlsGet (&forced_error);
+
+ Tcl_request_rec = Tcl_saved_request_rec;
+
+ return (status != NULL) ? *status : OK;
+}
+
+static int send_adp_file (request_rec *r)
+{
+ return send_aolserver_file (r, 1);
+}
+
+static int send_aolserver_tcl (request_rec *r)
+{
+ return send_aolserver_file (r, 0);
+}
+
+const char *nws_server_command(cmd_parms *cmd, void *dummy, char *var, char *val)
+{
+ server_rec *s = cmd->server;
+ aol_server_config *ns;
+
+ if (Tcl_server == NULL) {
+ Tcl_server = s;
+ }
+ else if (Tcl_server != s) {
+ return "mod_aolserver can only run currently in one virtual server";
+ }
+
+ ns = (aol_server_config *)ap_get_module_config(s->module_config, &aolserver_module);
+ ap_table_set (ns->aol_server_vars, var, val);
+ return NULL;
+}
+
+void *create_aol_server_config (pool *p, server_rec *s)
+{
+ aol_server_config *new =
+ (aol_server_config *) ap_palloc (p, sizeof(aol_server_config));
+
+ new->aol_server_vars = ap_make_table (p, 4);
+
+ return new;
+}
+
+void *merge_aol_server_configs (pool *p, void *basev, void *addv)
+{
+ aol_server_config *base = (aol_server_config *)basev;
+ aol_server_config *add = (aol_server_config *)addv;
+ aol_server_config *new = (aol_server_config *)ap_palloc(p, sizeof(aol_server_config));
+
+ new->aol_server_vars
+ = ap_overlay_tables (p, base->aol_server_vars,
+ add->aol_server_vars);
+
+ return new;
+}
+
+static const command_rec aol_cmds[] =
+{
+ { "AolServerConf", nws_server_command, NULL, RSRC_CONF, TAKE2, NULL },
+ { NULL }
+};
+
+static const handler_rec aol_handlers[] =
+{
+ { "aolserver", send_aolserver_tcl },
+ { "adp", send_adp_file },
+ { "aolsuppress", aolsuppress_handler },
+ { NULL }
+};
+
+module MODULE_VAR_EXPORT aolserver_module =
+{
+ STANDARD_MODULE_STUFF,
+ init_aol, /* initializer */
+ NULL, /* dir config creater */
+ NULL, /* dir merger --- default is to override */
+ create_aol_server_config, /* server config */
+ merge_aol_server_configs, /* merge server config */
+ aol_cmds, /* command table */
+ aol_handlers, /* handlers */
+ NULL, /* filename translation */
+ NULL, /* check_user_id */
+ NULL, /* check auth */
+ NULL, /* check access */
+ NULL, /* type_checker */
+ aolserver_fixup, /* fixups --- run pre/postauth filters*/
+ aolserver_wrapup, /* logger */
+ NULL, /* header parser */
+ aol_child_init, /* child_init */
+ aol_child_exit, /* child_exit */
+ NULL, /* post read-request */
+};
Index: mod_nsd/mod_nsd.h
===================================================================
RCS file: /usr/local/cvsroot/mod_nsd/mod_nsd.h,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ mod_nsd/mod_nsd.h 5 Jun 2001 11:50:15 -0000 1.1
@@ -0,0 +1,16 @@
+#include <httpd.h>
+#include <http_config.h>
+#include <tcl.h>
+
+/* Glue which mediates between Apache and aolserver data structures */
+
+extern module aolserver_module;
+extern server_rec *Tcl_server; /* sole virtual server we run in, for now */
+extern request_rec *Tcl_request_rec;
+extern pool *Tcl_pool;
+extern char *nsServer;
+
+#define TCL_POOL() (Tcl_request_rec? Tcl_request_rec->pool : Tcl_pool)
+
+int Ns_TclInitInterps (char *server, int (*)(Tcl_Interp *, void*), void *);
+