/* ==================================================================== * * 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 */ };