Index: mod_nsd/mod_aolserver.c =================================================================== RCS file: /usr/local/cvsroot/mod_nsd/Attic/mod_aolserver.c,v diff -u -N --- mod_nsd/mod_aolserver.c 2 May 2001 15:01:20 -0000 1.3 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,1081 +0,0 @@ -/* ==================================================================== - * - * 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_aolserver.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 */ -#include -#include - -#ifdef linux -#include -#endif - -#include "tcl.h" - -#include "mod_aolserver.h" -#include "nsd.h" - -/* Data structures --- some of the following are private to this file. - * See mod_aolserver.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_aolserver.h =================================================================== RCS file: /usr/local/cvsroot/mod_nsd/Attic/mod_aolserver.h,v diff -u -N --- mod_nsd/mod_aolserver.h 13 Apr 2001 21:09:32 -0000 1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,16 +0,0 @@ -#include -#include -#include - -/* 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 *); -