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 */ +#include +#include + +#ifdef linux +#include +#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 +#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 *); +