/* ====================================================================
*
* 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 <db.h> */
#include <assert.h>
#include <stdio.h>
#ifdef linux
#include <dlfcn.h>
#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_aolserver/0.0.0");
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 */
};