/* ====================================================================
 *
 * 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_neoscript.c: Handles NeoWebScript server-parsed HTML documents
 *
 * 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
 * $Id: mod_neoscript.c,v 1.8 2000/07/21 23:49:29 damon Exp $
 * 
 */

#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>

#include "tcl.h"
#include "tclExtend.h"

extern char ap_server_root[];
extern char ap_server_confname[];

Tcl_Interp *interp = NULL;
void Tcl_InitExtensions(Tcl_Interp *interp);

char softwareStartTimeString[32];

/* Code to handle delayed sending of http headers */
static int headersSent;
#define NEO_SEND_HEADERS(r) \
{ \
    if (!headersSent) { \
	ap_send_http_header(r); \
	headersSent = 1; \
    } \
}

#define NEOWEBSCRIPT_VERSION "3.3.0"
#define NWS_VERSION_COMPONENT "NeoWebScript/3.3.0"
#define STARTING_NWS_SEQUENCE "<nws>"
#define ENDING_NWS_SEQUENCE "</nws>"

#define STARTING_SEQUENCE "<!--#"
#define ENDING_SEQUENCE "-->"
#define DEFAULT_ERROR_MSG "[an error occurred while processing this directive]"
#define DEFAULT_TIME_FORMAT "%A, %d-%b-%Y %H:%M:%S %Z"
#define SIZEFMT_BYTES 0
#define SIZEFMT_KMG 1
#ifdef CHARSET_EBCDIC
#define RAW_ASCII_CHAR(ch)	os_toebcdic[(unsigned char)ch]
#else /*CHARSET_EBCDIC*/
#define RAW_ASCII_CHAR(ch)	(ch)
#endif /*CHARSET_EBCDIC*/

static request_rec *Tcl_request_rec = NULL;

#define STREQU(s1, s2) ( strcmp( s1, s2 ) == 0 )

#define NESTED_INCLUDE_MAGIC (&neoscript_module)

module MODULE_VAR_EXPORT neoscript_module;

typedef struct {
    table *nws_dir_vars;
    table *nws_user_vars;
} nws_dir_config;

typedef struct {
    table *nws_server_vars;
} nws_server_config;

static char *NeoWebCacheName;
static int NeoWebCacheEnabled;

int load_sub_req (Tcl_Interp *interp, request_rec *r)
{
    int errstatus;
    int fd;
    char *buffer;

    if (r->finfo.st_mode == 0) {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason: %s", r->filename,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "File does not exist");
        return HTTP_NOT_FOUND;
    }

    ap_set_last_modified(r);

    if ((errstatus = ap_set_content_length (r, r->finfo.st_size))
        || ((errstatus = ap_meets_conditions (r)) != OK))
        return errstatus;

    fd = open(r->filename, O_RDONLY);

    if (fd == -1) {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s", r->filename,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "file permissions deny server access");
        return HTTP_FORBIDDEN;
    }

    buffer = (char *)ckalloc(r->finfo.st_size + 1);
    if ((read(fd,buffer,r->finfo.st_size) == r->finfo.st_size) ||
	(errno == EINTR))
    {
	buffer[r->finfo.st_size] = '\0';
	if (Tcl_GlobalEval(interp, buffer) != TCL_OK) {
	    ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
			 "Error loading file '%s': %s", r->filename,
			 interp->result);
	    ap_rprintf(r,"[error loading %s]", r->filename);
	    ckfree(buffer);
	    close (fd);
	    return SERVER_ERROR;
	}
    }
    ckfree(buffer);
    close(fd);
    return OK;
}


/*
 *-----------------------------------------------------------------------------
 *
 * Neo_IncludeCmd --
 *     Implements the Neo TCL web load and include commands:
 *         SAFE_include_file slave file
 *         SAFE_include_virtual slave file
 *         SAFE_load_file slave file
 *         SAFE_load_virtual slave file
 *
 * Results:
 *     Standard TCL results.
 *
 *-----------------------------------------------------------------------------
 */
int
Neo_IncludeCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    request_rec *rr=NULL;
    request_rec *p;
    request_rec *r = Tcl_request_rec;
    char c;
    int include;
    int virtual;
    Tcl_Interp *slaveInterp;

    if (argc != 3) {
	Tcl_AppendResult (interp,
	    "wrong # args: should be \"",
	    argv[0],
	    " slaveInterp file",
	    (char *) NULL);
	return TCL_ERROR;
    }

    if ((slaveInterp = Tcl_GetSlave (interp, argv[1])) == (Tcl_Interp *)NULL) {
	Tcl_AppendResult (interp,
	    argv[0],
	    ": unknown slave interpreter '",
	    argv[1],
	    "'",
	    (char *) NULL);
	return TCL_ERROR;
    }

	/* Determine what the command was by parsing argv[0].  Change made for Win32 by gporter */
    c = argv[0][0];

	if (!strcmp(argv[0], "SAFE_include_file")) {
		include = 1;
		virtual = 0;
	} else if (!strcmp(argv[0], "SAFE_include_virtual")) {
		include = 1;
		virtual = 1;
	} else if (!strcmp(argv[0], "SAFE_load_file")) {
		include = 0;
		virtual = 0;
	} else if (!strcmp(argv[0], "SAFE_load_virtual")) {
		include = 0;
		virtual = 1;
	} else {

        if (c == 'i') {
			include = 1;
			c = argv[0][8];
			if (c == 'f') {
				virtual = 0;
			} else if (c == 'v') {
				virtual = 1;
			} else {
				Tcl_AppendResult (interp,
				argv[0],
				": not invoked as 'SAFE_include_file' or 'SAFE_include_virtual'",
				(char *) NULL);
				return TCL_ERROR;
			}
	
		} else if (c == 'l') {
			include = 0;
			c = argv[0][5];
			if (c == 'f') {
				virtual = 0;
			} else if (c == 'v') {
				virtual = 1;
			} else {
				Tcl_AppendResult (interp,
				argv[0],
				": not invoked as 'SAFE_load_file' or 'SAFE_load_virtual'",
				(char *) NULL);
				return TCL_ERROR;
			}
	
		} else {
			Tcl_AppendResult (interp,
				argv[0],
				": not invoked as 'SAFE_include_' or 'SAFE_load_'",
				(char *) NULL);
			return TCL_ERROR;
		}
	}
    if (virtual) {
	rr = ap_sub_req_lookup_uri (argv[2], r);
    } else {
	if( Tcl_IsSafe( slaveInterp ) ) {
	    /* be safe; only files in this directory or below allowed */
	    char *tmp = (char *)ckalloc(strlen(argv[2]) + 3);

	    sprintf(tmp, "/%s/", argv[2]);
	    if ((*argv[2] == '/') || (strstr(tmp, "/../") != NULL)) {
		Tcl_AppendResult (interp,
		    argv[0],
		    ": unable to include '",
		    argv[2],
		    "': illegal filename from '",
		    r->filename,
		    "'",
		    (char *) NULL);
		ckfree(tmp);
		return TCL_ERROR;
	    }
	    ckfree(tmp);
	}
	rr = ap_sub_req_lookup_file (argv[2], r);
    }

    if (rr->status != 200) {
	Tcl_AppendResult (interp,
	    argv[0],
	    ": unable to load or include '",
	    argv[2],
	    "' from '",
	    r->filename,
	    "'",
	    (char *) NULL);
	if (rr != NULL) ap_destroy_sub_req (rr);
	return TCL_ERROR;
    }

    if ((ap_allow_options(rr) & OPT_INCNOEXEC) && (rr->content_type)
	&& (strncmp (rr->content_type, "text/", 5))) {
	    Tcl_AppendResult (interp,
		argv[0],
		": unable to load or include potential exec '",
		argv[2],
		"' from '",
		r->filename,
		"'",
		(char *) NULL);
	    if (rr != NULL) ap_destroy_sub_req (rr);
	    return TCL_ERROR;
    }

    for (p = r; p != NULL; p = p->main) {
	if (strcmp(p->filename, rr->filename) == 0) break;
    }

    if (p != NULL) {
	Tcl_AppendResult (interp,
	    argv[0],
	    ": recursive load or include of '",
	    argv[2],
	    "' from '",
	    r->filename,
	    "'",
	    (char *) NULL);
	if (rr != NULL) ap_destroy_sub_req (rr);
	return TCL_ERROR;
    }

    if (include) {
	if (ap_run_sub_req (rr)) {
	    Tcl_AppendResult (interp,
		argv[0],
		": unable to process include '",
		argv[2],
		"' from '",
		r->filename,
		"'",
		(char *) NULL);
	    if (rr != NULL) ap_destroy_sub_req (rr);
	    return TCL_ERROR;
	}
    } else {
	if (load_sub_req (slaveInterp, rr)) {
	    Tcl_AppendResult (interp,
		argv[0],
		": unable to load '",
		argv[2],
		"' from '",
		r->filename,
		"'<p><pre>",
		Tcl_GetVar(slaveInterp, "errorInfo", TCL_GLOBAL_ONLY),
		"</pre><p>",
		(char *) NULL);
	    if (rr != NULL) ap_destroy_sub_req (rr);
	    return TCL_ERROR;
	}
    }

    if (rr != NULL) ap_destroy_sub_req (rr);
    return TCL_OK;
}
/*-----------------------------------------------------------------------------
 * Neo_FlushBufferCmd --
 *     Implements the flush_page TCL command:
 *         flush_page
 *
 * Results:
 *      Standard TCL result.
 *-----------------------------------------------------------------------------
 */
int
Neo_FlushBufferCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                          "\"", (char *) NULL);
        return TCL_ERROR;
    }

    ap_bflush (Tcl_request_rec->connection->client);
    return TCL_OK;
}


/*-----------------------------------------------------------------------------
 * Neo_AbortPageCmd --
 *     Implements the abort_page TCL command:
 *         abort_page
 *
 * Results:
 *      Standard TCL result.
 *-----------------------------------------------------------------------------
 */
int
Neo_AbortPageCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                          "\"", (char *) NULL);
        return TCL_ERROR;
    }

    ap_bflush (Tcl_request_rec->connection->client);
/*-------------
 * removed from http_main.c in 1.2b8 - Eugene
 *
    abort_connection(Tcl_request_rec->connection);
 *-------------
*/
    Tcl_request_rec->connection->aborted = 1;

    return TCL_OK;
}


/*-----------------------------------------------------------------------------
 * Neo_HttpdCmd --
 *     Make the child apache process do things
 *        httpd child_terminate -- Exit child when this page is done
 *
 * Results
 *     Standard TCL result.
 *-----------------------------------------------------------------------------
 */
int
Neo_HttpdCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    if (argc != 2 || strncmp("child_terminate", argv[1], strlen(argv[1]))) {
	interp->result = "Usage: httpd child_terminate";
	return TCL_ERROR;
    }

/*  It looks like Win32 doesn't do this... -gporter
    ap_child_terminate(Tcl_request_rec);
*/

    return TCL_OK;
}


/*-----------------------------------------------------------------------------
 * Neo_UnescapeUrlCmd --
 *     Implements the unescape_url TCL command:
 *         unescape_url pathname
 *
 * Results:
 *      Standard TCL result.
 *-----------------------------------------------------------------------------
 */
int
Neo_UnescapeUrlCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                          " url\"", (char *) NULL);
        return TCL_ERROR;
    }

    if (ap_unescape_url(argv[1]) == OK) {
        interp->result = argv[1];
    }
    return TCL_OK;
}


/*
 *-----------------------------------------------------------------------------
 *
 * Neo_RequestInfoCmd --
 *     Implements the Neo TCL request_info command:
 *         request_info args
 *
 * Results:
 *     Standard TCL results.
 *
 *-----------------------------------------------------------------------------
 */
int
Neo_RequestInfoCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    char intbuf[20];
    char *varName;
    int depth;
    request_rec *r = Tcl_request_rec;

    if (argc != 2 && argc != 4) {
	Tcl_AppendResult (interp,
	    "wrong # args: should be \"",
	    argv[0],
	    " [next|prev|main depth] arrayVarName\"",
	    (char *) NULL);
	return TCL_ERROR;
    }

    if (argc == 2) {
	varName = argv[1];
    } else {
	varName = argv[3];
	strcpy(interp->result,"0");
	if (Tcl_GetInt (interp, argv[2], &depth) == TCL_ERROR)
	    return TCL_ERROR;
	if (strcmp(argv[1], "prev") == 0) {
	   while (depth--) {
	       if (r->prev) {
		   r = r->prev;
	       } else {
		   return TCL_OK;
	       }
	   }
	} else if (strcmp(argv[1], "next") == 0) {
	   while (depth--) {
	       if (r->next) {
		   r = r->next;
	       } else {
		   return TCL_OK;
	       }
	   }
	} else if (strcmp(argv[1], "main") == 0) {
	   while (depth--) {
	       if (r->main) {
		   r = r->main;
	       } else {
		   return TCL_OK;
	       }
	   }
	} else {
	    Tcl_AppendResult (interp,
		"bad arg: should be \"",
		argv[0],
		" [next|prev|main depth] arrayVarName\"",
		(char *) NULL);
	    return TCL_ERROR;
	}
    }

#define REQUEST_CHAR_VAR(X) if (Tcl_SetVar2(interp, varName, #X, r->X == (char *)NULL ? "" : (char *)(r->X), TCL_LEAVE_ERR_MSG) == NULL) return TCL_ERROR

#define REQUEST_INT_VAR(X) {sprintf(intbuf, "%d", r->X); if (Tcl_SetVar2(interp, varName, #X, intbuf, TCL_LEAVE_ERR_MSG) == NULL) return TCL_ERROR;}

#define REQUEST_LONG_VAR(X) {sprintf(intbuf, "%ld", r->X); if (Tcl_SetVar2(interp, varName, #X, intbuf, TCL_LEAVE_ERR_MSG) == NULL) return TCL_ERROR;}

    REQUEST_CHAR_VAR(the_request);
    REQUEST_INT_VAR(assbackwards);
    REQUEST_INT_VAR(header_only);
    REQUEST_CHAR_VAR(protocol);
    REQUEST_CHAR_VAR(status_line);
    REQUEST_INT_VAR(status);
    REQUEST_CHAR_VAR(method);
    REQUEST_INT_VAR(method_number);
    REQUEST_LONG_VAR(bytes_sent);
    REQUEST_CHAR_VAR(content_type);
    REQUEST_CHAR_VAR(content_encoding);
    REQUEST_CHAR_VAR(content_language);
    REQUEST_INT_VAR(no_cache);
    REQUEST_CHAR_VAR(uri);
    REQUEST_CHAR_VAR(filename);
    REQUEST_CHAR_VAR(path_info);
    REQUEST_CHAR_VAR(args);

    if (Tcl_SetVar2(interp, varName, "main", r->main ? "1" : "0", TCL_LEAVE_ERR_MSG) == NULL) return TCL_ERROR;
    if (Tcl_SetVar2(interp, varName, "prev", r->prev ? "1" : "0", TCL_LEAVE_ERR_MSG) == NULL) return TCL_ERROR;
    if (Tcl_SetVar2(interp, varName, "next", r->next ? "1" : "0", TCL_LEAVE_ERR_MSG) == NULL) return TCL_ERROR;

    sprintf(intbuf, "%d", (int)(r->finfo.st_uid));
    if (Tcl_SetVar2(interp, varName, "file_uid", intbuf, TCL_LEAVE_ERR_MSG) == NULL) return TCL_ERROR;

    interp->result = "1";
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * Neo_SetHeaderCmd --
 *     Implements the NeoWebScript set_header command:
 *         set_header header-name header-value ...
 *
 * Results:
 *     Standard TCL results.
 *
 *-----------------------------------------------------------------------------
 */
int
Tcl_SetHeaderCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    int i, forceHeaders = 1;
    table *h = Tcl_request_rec->headers_out;

    if ((argc % 2 == 0) && !(strcmp(argv[argc - 1], "-force"))) {
    	forceHeaders = 0;
	argc--;
    }

    if (argc % 2 != 1) {
	sprintf(interp->result, "usage: %s header value ...", argv[0]);
	return TCL_ERROR;
    }

    if (forceHeaders && headersSent) {
	sprintf(interp->result, "headers have already gone out");
	return TCL_ERROR;
    }

    for (i = 1; i < argc; i += 2)
	ap_table_set(h, argv[i], argv[i+1]);
    return TCL_OK;
}

int
NWS_MD5Cmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    char *digest;

    if (argc != 2) {
	sprintf(interp->result, "usage: md5 string");
	return TCL_ERROR;
    }
    digest = ap_md5(Tcl_request_rec->pool, argv[1]);
    Tcl_SetResult(interp, digest, TCL_STATIC);
    return TCL_OK;
}

int
Tcl_gm_timestr_822Cmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    char *ascii_time;
    int clock;

    if (argc != 2) {
	sprintf(interp->result, "usage: gm_timestr_822 time");
	return TCL_ERROR;
    }
    if (Tcl_GetInt(interp, argv[1], &clock) == TCL_ERROR)
	return TCL_ERROR;
    ascii_time = ap_gm_timestr_822(Tcl_request_rec->pool, clock);
    Tcl_SetResult(interp, ascii_time, TCL_STATIC);
    return TCL_OK;
}

int
Tcl_ExtendSafeSlaveCmd(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;
    }

    /* Do this in the setup using load so that unsafe version can be used */
    /*
    if (Tclx_SafeInit (slaveInterp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    */

    Tcl_CreateCommand (slaveInterp, "www_request_info",
		      Neo_RequestInfoCmd,
                      (ClientData) NULL, (void (*)()) NULL);

    return TCL_OK;
}


/*-----------------------------------------------------------------------------
 * Neo_SimplifyPathnameCmd --
 *     Implements the simplify_pathname TCL command:
 *         simplify_pathname pathname
 *
 * Results:
 *      Standard TCL result.
 *-----------------------------------------------------------------------------
 */
int
Neo_SimplifyPathnameCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                          " pathname\"", (char *) NULL);
        return TCL_ERROR;
    }

    ap_getparents(argv[1]);
    interp->result = argv[1];
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_HtmlCmd --
 *
 *	This procedure is invoked to process the "html" Tcl command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_HtmlCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int i = 1, tagstart, newline = 0;

    if ((argc >= 2) && (argv[i][0] == '-') &&
       ((strcmp(argv[i], "-newline") == 0) || (strcmp(argv[i], "-n") == 0))) {
	newline = 1;
	i++;
    }

    if (i >= argc) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
			" ?-newline? string ?tag ...?\"", (char *)NULL);
	return TCL_ERROR;
    }

    NEO_SEND_HEADERS(Tcl_request_rec);

    /* argv[i] == string
     * argv[tagstart] = 1st tag
     */
    tagstart = i+1;
    if (tagstart == argc) {
	ap_rprintf(Tcl_request_rec, "%s", argv[i]);
    } else {
	int c, t;

	for (t = tagstart; t < argc; t++) {
	    ap_rprintf(Tcl_request_rec, "<%s>", argv[t]);
	}
	ap_rprintf (Tcl_request_rec, "%s", argv[i]);
	for (t--; t >= tagstart; t--) {
	    for (c = 0; (argv[t][c] != ' ') && (argv[t][c] != '\0'); c++) {}
	    ap_rprintf(Tcl_request_rec, "</%.*s>", c, argv[t]);
	}
    }
    if (newline) {
	ap_rprintf(Tcl_request_rec, "%c", '\n');
    }
    return TCL_OK;
}


/* ----------------------- Initialization function ------------------------- */

void init_nws(server_rec *s, pool *p)
{
    time_t date;
    table *t;
    table_entry *elts;
    array_header *arr;
    int i, nelts;
    nws_server_config *ns = (nws_server_config *)ap_get_module_config(s->module_config ,&neoscript_module);
    
    ap_add_version_component( NWS_VERSION_COMPONENT );

    if (interp) {
	Tcl_DeleteInterp(interp);
    }
    interp = Tcl_CreateInterp();

    /* get the current time (startup time)
     * so we can return server uptime info */

    time(&date);
    sprintf(softwareStartTimeString, "%ld", date);

    /* Initialize core Tcl components and extensions */
	
	/* Setup a library Path */
	TclpInitLibraryPath(".");

	/* Tcl */
    if (Tcl_Init(interp) == TCL_ERROR) {
	fprintf(stderr,
		"failed to init NeoWebScript Tcl component: %s\n",
		interp->result);
	exit(1);
    }

    /* Extended Tcl */
    if (Tclx_Init(interp) == TCL_ERROR) {
	fprintf(stderr,
		"failed to init NeoWebScript Tclx component: %s\n",
		interp->result);
	exit(1);
    }
    Tcl_StaticPackage(interp, "Tclx", Tclx_Init, Tclx_SafeInit);
    /* Tclx does its own call to Tcl_StaticPackage */

#ifdef POSTGRESQL
    /* PostgreSQL (v6.0+) Database Interface */
    if (Pgtcl_Init(interp) == TCL_ERROR) {
	fprintf(stderr,
		"failed to init NeoWebScript PostgreSQL component: %s\n",
		interp->result);
	exit(1);
    }
    Tcl_StaticPackage(interp, "Pgtcl", Pgtcl_Init, Pgtcl_Init);
#endif

#ifdef POSTGRES95
    /* Postgres95 Database Interface */
    if (Pg_Init(interp) == TCL_ERROR) {
	fprintf(stderr,
		"failed to init NeoWebScript Postgres95 component: %s\n",
		interp->result);
	exit(1);
    }
    Tcl_StaticPackage(interp, "Pg", Pg_Init, Pg_Init);
#endif

#ifdef PQATCL
    /* Another Postgres95 Database Interface */
    if (Pqa_Init(interp) == TCL_ERROR) {
	fprintf(stderr,
		"failed to init NeoWebScript Postgres-Pqa component: %s\n",
		interp->result);
	exit(1);
    }
    Tcl_StaticPackage(interp, "Pqa", Pqa_Init, Pqa_Init);
#endif

#ifdef GDTCL
    /* GIF generation*/
    if (Gd_Init(interp) == TCL_ERROR) {
	fprintf(stderr,
		"failed to init NeoWebScript Gd component: %s\n",
		interp->result);
	exit(1);
    }
    Tcl_StaticPackage(interp, "Gd", Gd_Init, Gd_Init);
#endif

    /* NeoSoft Extensions */
    if (Neo_Init(interp) == TCL_ERROR) {
	fprintf(stderr,
		"failed to init NeoWebScript Neo component: %s\n",
		interp->result);
	exit(1);
    }
    Tcl_StaticPackage(interp, "Neo", Neo_Init, NULL);

    /*
     * copy any variables defined with neowebscript server config commands
     * into a Tcl array
     */

    t = ns->nws_server_vars;

    arr = ap_table_elts(t);
    elts = (table_entry *)arr->elts;
    nelts = arr->nelts;

    for (i = 0; i < nelts; ++i)
	Tcl_SetVar2(interp, "NeoWebServerConf",
		elts[i].key, elts[i].val, TCL_GLOBAL_ONLY);

    /* Tcl_InitMath (interp); */
    Tcl_InitExtensions(interp);

    Tcl_SetVar2(interp, "server",
    	"SERVER_ROOT", ap_server_root_relative(p, "."), TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "server",
    	"SERVER_CONF", ap_server_confname, TCL_GLOBAL_ONLY);

    if (Tcl_VarEval(interp, "source ",
	ap_server_root_relative(p, "neowebscript/init.tcl"), (char *)NULL)
	== TCL_ERROR)
    {
	char *errorInfo;

	errorInfo = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
	fprintf(stderr,"NeoWebScript startup failed: %s\n", errorInfo);
	exit(1);
    }
}

void
Tcl_InitExtensions(Tcl_Interp *interp) {

    Tcl_CreateCommand(interp, "SAFE_include_file",
		     Neo_IncludeCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "SAFE_include_virtual",
		     Neo_IncludeCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "SAFE_load_file",
		     Neo_IncludeCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "SAFE_load_virtual",
		     Neo_IncludeCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "flush_page",
		     Neo_FlushBufferCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "abort_page",
		     Neo_AbortPageCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "httpd",
		     Neo_HttpdCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "extend_slave",
		     Tcl_ExtendSafeSlaveCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "html",
		     Tcl_HtmlCmd,
		     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(interp, "www_simplify_pathname",
		     Neo_SimplifyPathnameCmd,
                     (ClientData) NULL, (void (*)()) NULL);

    Tcl_CreateCommand(interp, "www_unescape_url",
		     Neo_UnescapeUrlCmd,
                     (ClientData) NULL, (void (*)()) NULL);

    Tcl_CreateCommand(interp, "www_request_info",
		     Neo_RequestInfoCmd,
                     (ClientData) NULL, (void (*)()) NULL);

    Tcl_CreateCommand(interp, "set_header",
		     Tcl_SetHeaderCmd,
                     (ClientData) NULL, (void (*)()) NULL);

    Tcl_CreateCommand(interp, "md5",
		     NWS_MD5Cmd,
                     (ClientData) NULL, (void (*)()) NULL);

    Tcl_CreateCommand(interp, "gm_timestr_822",
		     Tcl_gm_timestr_822Cmd,
                     (ClientData) NULL, (void (*)()) NULL);
}

/* ------------------------ Environment function -------------------------- */

static void add_include_vars(request_rec *r, char *timefmt)
{
 #ifndef WIN32
    struct passwd *pw;
 #endif /* WIN32 */
    table *e = r->subprocess_env;
    char *t;
    time_t date = time(NULL);

    ap_table_setn(e, "DATE_LOCAL", ap_ht_time(r->pool, date, timefmt, 0));
    ap_table_setn(e, "DATE_GMT", ap_ht_time(r->pool, date, timefmt, 1));
    ap_table_setn(e, "LAST_MODIFIED",
		ap_ht_time(r->pool, r->finfo.st_mtime, timefmt, 0));
    ap_table_setn(e, "DOCUMENT_URI", r->uri);
    ap_table_setn(e, "DOCUMENT_PATH_INFO", r->path_info);
 #ifndef WIN32
    pw = getpwuid(r->finfo.st_uid);
    if (pw) {
        ap_table_setn(e, "USER_NAME", ap_pstrdup(r->pool, pw->pw_name));
    }
    else {
		ap_table_setn(e, "USER_NAME", ap_psprintf(r->pool, "user#%lu", (unsigned long) r->finfo.st_uid));
    }
 #endif /* ndef WIN32 */

    if ((t = strrchr(r->filename, '/'))) {
        ap_table_setn(e, "DOCUMENT_NAME", ++t);
    }
    else {
        ap_table_setn(e, "DOCUMENT_NAME", r->uri);
    }
    if (r->args) {
        char *arg_copy = ap_pstrdup(r->pool, r->args);

        ap_unescape_url(arg_copy);
        ap_table_setn(e, "QUERY_STRING_UNESCAPED",
                  ap_escape_shell_cmd(r->pool, arg_copy));
    }
}



/* --------------------------- Parser functions --------------------------- */

static char *http2env(pool *a, char *w)
{
    char *res = ap_pstrcat (a, "HTTP_", w, NULL);
    char *cp = res;

    while (*++cp)
      if (*cp == '-') *cp = '_';
      else *cp = toupper(*cp);

    return res;
}

#define OUTBUFSIZE 4096
/* PUT_CHAR and FLUSH_BUF currently only work within the scope of
 * find_string(); they are hacks to avoid calling rputc for each and
 * every character output.  A common set of buffering calls for this
 * type of output SHOULD be implemented.
 */
#define NWS_PUT_CHAR(c,r) \
 { \
    outbuf[outind++] = c; \
    if (outind == OUTBUFSIZE) { \
        NWS_FLUSH_BUF(r) \
    }; \
 }

/* there SHOULD be some error checking on the return value of
 * rwrite, however it is unclear what the API for rwrite returning
 * errors is and little can really be done to help the error in
 * any case.
 */
#define NWS_FLUSH_BUF(r) \
 { \
   ap_rwrite(outbuf, outind, r); \
   outind = 0; \
 }

/*
 * f: file handle being read from
 * c: character to read into
 * ret: return value to use if input fails
 * r: current request_rec
 *
 * This macro is redefined after find_string() for historical reasons
 * to avoid too many code changes.  This is one of the many things
 * that should be fixed.
 */
#define GET_CHAR(f,c,r,p) \
 { \
   int i = getc(f); \
   if (i == EOF) { /* either EOF or error -- needs error handling if latter */ \
       if (ferror(f)) { \
           fprintf(stderr, "encountered error in GET_CHAR macro, " \
                   "mod_neoscript.\n"); \
       } \
       ap_pfclose(p, f); \
       return r; \
   } \
   c = (char)i; \
 }

#define NWS_GET_CHAR(f,c,ret,r) \
 { \
   int i = getc(f); \
   if (i == EOF) { /* either EOF or error -- needs error handling if latter */ \
       if (ferror(f)) { \
           fprintf(stderr, "encountered error in GET_CHAR macro, " \
                   "mod_neoscript.\n"); \
       } \
       NWS_FLUSH_BUF(r); \
       ap_pfclose(r->pool, f); \
       return ret; \
   } \
   c = (char)i; \
 }

static int find_string(FILE *in, const char *str, request_rec *r, int printing)
{
    int x, l = strlen(str), p;
    char outbuf[OUTBUFSIZE];
    int outind = 0;
    char c;

    p = 0;
    while (1) {
        NWS_GET_CHAR(in, c, 1, r);
        if (c == str[p]) {
            if ((++p) == l) {
                NWS_FLUSH_BUF(r);
                return 0;
            }
        }
        else {
            if (printing) {
                for (x = 0; x < p; x++) {
                    NWS_PUT_CHAR(str[x], r);
                }
                NWS_PUT_CHAR(c, r);
            }
            p = 0;
        }
    }
}

/* A hack of find_string to find both the normal SSI starting sequence, and
 * NeoWebScript's new tag-like HTML sequence.  It may be more efficient on
 * servers with more RAM to slurp the entire buffer into a Tcl interpreter.
 * - Eugene
 */

int find_string2(FILE *in, char *str1, char *str2, request_rec *r, int *result, int printing)
{ int x, l1 = strlen(str1), l2 = strlen(str2), p, p1, p2, m1, m2;
    char c, *str, outbuf[OUTBUFSIZE];
    int outind = 0;

    p1 = p2 = 0;
    while(1) {
	NWS_GET_CHAR(in, c, 1, r);
	m1 = m2 = 0;
        if(c == str1[p1]) {
	    ++m1;
            if ((++p1) == l1) {
                NWS_FLUSH_BUF(r);
		*result = 1;
                return 0;
	    }
        }
        if (c == str2[p2]) {
	    ++m2;
            if ((++p2) == l2) {
                NWS_FLUSH_BUF(r);
		*result = 2;
                return 0;
	    }
        }
        if (!m1 && !m2) {
	    NEO_SEND_HEADERS(r);

	    p = (p2 > p1) ? p2 : p1;
	    str = (p2 > p1) ? str2 : str1;
            if (printing) {
                for (x=0; x<p; x++) {
                    NWS_PUT_CHAR(str[x], r);
                }
                NWS_PUT_CHAR(c, r);
            }
	    p1 = p2 = 0;
        }
    }
}

#undef NWS_FLUSH_BUF
#undef NWS_PUT_CHAR
#undef NWS_GET_CHAR

/*
 * decodes a string containing html entities or numeric character references.
 * 's' is overwritten with the decoded string.
 * If 's' is syntatically incorrect, then the followed fixups will be made:
 *   unknown entities will be left undecoded;
 *   references to unused numeric characters will be deleted.
 *   In particular, &#00; will not be decoded, but will be deleted.
 *
 * drtr
 */

/* maximum length of any ISO-LATIN-1 HTML entity name. */
#define MAXENTLEN (6)

/* The following is a shrinking transformation, therefore safe. */

static void decodehtml(char *s)
{
    int val, i, j;
    char *p = s;
    const char *ents;
    static const char * const entlist[MAXENTLEN + 1] =
    {
	NULL,  /* 0 */
	NULL,  /* 1 */
	"lt\074gt\076", /* 2 */
	"amp\046ETH\320eth\360", /* 3 */
	"quot\042Auml\304Euml\313Iuml\317Ouml\326Uuml\334auml\344euml\353\
iuml\357ouml\366uuml\374yuml\377", /* 4 */
	"Acirc\302Aring\305AElig\306Ecirc\312Icirc\316Ocirc\324Ucirc\333\
THORN\336szlig\337acirc\342aring\345aelig\346ecirc\352icirc\356ocirc\364\
ucirc\373thorn\376", /* 5 */
	"Agrave\300Aacute\301Atilde\303Ccedil\307Egrave\310Eacute\311\
Igrave\314Iacute\315Ntilde\321Ograve\322Oacute\323Otilde\325Oslash\330\
Ugrave\331Uacute\332Yacute\335agrave\340aacute\341atilde\343ccedil\347\
egrave\350eacute\351igrave\354iacute\355ntilde\361ograve\362oacute\363\
otilde\365oslash\370ugrave\371uacute\372yacute\375" /* 6 */
    };

    for (; *s != '\0'; s++, p++) {
	if (*s != '&') {
	    *p = *s;
	    continue;
	}
	/* find end of entity */
        for (i = 1; s[i] != ';' && s[i] != '\0'; i++) {
            continue;
        }

	if (s[i] == '\0') {	/* treat as normal data */
	    *p = *s;
	    continue;
	}

        /* is it numeric ? */
        if (s[1] == '#') {
            for (j = 2, val = 0; j < i && ap_isdigit(s[j]); j++) {
                val = val * 10 + s[j] - '0';
            }
            s += i;
            if (j < i || val <= 8 || (val >= 11 && val <= 31) ||
                (val >= 127 && val <= 160) || val >= 256) {
                p--;            /* no data to output */
            }
            else {
                *p = RAW_ASCII_CHAR(val);
            }
        }
        else {
            j = i - 1;
            if (j > MAXENTLEN || entlist[j] == NULL) {
                /* wrong length */
                *p = '&';
                continue;       /* skip it */
            }
            for (ents = entlist[j]; *ents != '\0'; ents += i) {
                if (strncmp(s + 1, ents, j) == 0) {
                    break;
                }
            }

            if (*ents == '\0') {
                *p = '&';       /* unknown */
            }
            else {
                *p = RAW_ASCII_CHAR(((const unsigned char *) ents)[j]);
                s += i;
            }
        }
    }

    *p = '\0';
}

/*
 * extract the next tag name and value.
 * if there are no more tags, set the tag name to 'done'
 * the tag value is html decoded if dodecode is non-zero
 */

static char *get_tag(pool *p, FILE *in, char *tag, int tagbuf_len, int dodecode)
{
    char *t = tag, *tag_val, c, term;

    /* makes code below a little less cluttered */
    --tagbuf_len;

    do {                        /* skip whitespace */
        GET_CHAR(in, c, NULL, p);
    } while (ap_isspace(c));

    /* tags can't start with - */
    if (c == '-') {
        GET_CHAR(in, c, NULL, p);
        if (c == '-') {
            do {
                GET_CHAR(in, c, NULL, p);
            } while (ap_isspace(c));
            if (c == '>') {
                ap_cpystrn(tag, "done", tagbuf_len);
                return tag;
            }
        }
        return NULL;            /* failed */
    }

    /* find end of tag name */
    while (1) {
        if (t - tag == tagbuf_len) {
            *t = '\0';
            return NULL;
        }
        if (c == '=' || ap_isspace(c)) {
            break;
        }
        *(t++) = ap_tolower(c);
        GET_CHAR(in, c, NULL, p);
    }

    *t++ = '\0';
    tag_val = t;

    while (ap_isspace(c)) {
        GET_CHAR(in, c, NULL, p);       /* space before = */
    }
    if (c != '=') {
        ungetc(c, in);
        return NULL;
    }

    do {
        GET_CHAR(in, c, NULL, p);       /* space after = */
    } while (ap_isspace(c));

    /* we should allow a 'name' as a value */

    if (c != '"' && c != '\'') {
        return NULL;
    }
    term = c;
    while (1) {
        GET_CHAR(in, c, NULL, p);
        if (t - tag == tagbuf_len) {
            *t = '\0';
            return NULL;
        }
/* Want to accept \" as a valid character within a string. */
        if (c == '\\') {
            *(t++) = c;         /* Add backslash */
            GET_CHAR(in, c, NULL, p);
            if (c == term) {    /* Only if */
                *(--t) = c;     /* Replace backslash ONLY for terminator */
            }
        }
        else if (c == term) {
            break;
        }
        *(t++) = c;
    }
    *t = '\0';
    if (dodecode) {
        decodehtml(tag_val);
    }
    return ap_pstrdup(p, tag_val);
}

static char *
get_nws_code(pool *p, FILE *in, char *dummy, int codebuf_len, char *sequence) {
    char *t = dummy, *code_val, c;
    int n, l=(strlen(sequence)-1), cp;

    n = 0;

    do { /* skip whitespace */
	GET_CHAR(in,c,NULL,p);
    } while (ap_isspace(c));

    cp=0;
    code_val = t;
    while(1) {
	if(++n == codebuf_len) {
	    t[codebuf_len - 1] = '\0';
	    return NULL;
	}
	if(c == sequence[cp]) {
	    *(t++) = c;
	    if(cp == l)
		break;
	    else
		cp++;
	    GET_CHAR(in,c,NULL,p);
	    continue;
	}
	else if(cp > 0)
	    cp=0;
	*(t++) = c;
	GET_CHAR(in,c,NULL,p);
    }
    for(n=0;n<=l;n++) {
	t--;
	*t = '\0';
    }
    return ap_pstrdup (p, code_val);
}

static int get_directive(FILE *in, char *dest, size_t len, pool *p)
{
    char *d = dest;
    char c;

    /* make room for nul terminator */
    --len;

    /* skip initial whitespace */
    while (1) {
        GET_CHAR(in, c, 1, p);
        if (!ap_isspace(c)) {
            break;
        }
    }
    /* now get directive */
    while (1) {
        if (d - dest == len) {
            return 1;
        }
        *d++ = ap_tolower(c);
        GET_CHAR(in, c, 1, p);
        if (ap_isspace(c)) {
            break;
        }
    }
    *d = '\0';
    return 0;
}

/* ------------------------ Environment function -------------------------- */

void propagate_vars_to_nws(Tcl_Interp *interp, request_rec *r)
{
    server_rec *s = r->server;
    conn_rec *c = r->connection;
    char *t, *tmpbuf;
    char timeTextBuf[16], portbuf[10];

    array_header *hdrs_arr = ap_table_elts (r->headers_in);
    table_entry *hdrs = (table_entry *)hdrs_arr->elts;
    int i;

    /* First, add environment vars from headers... this is as per
     * CGI specs, though other sorts of scripting interfaces see
     * the same vars...
     */

    Tcl_UnsetVar(interp, "webenv", TCL_GLOBAL_ONLY);

    for (i = 0; i < hdrs_arr->nelts; ++i) {
        if (!hdrs[i].key) continue;

	/* A few headers are special cased --- Authorization to prevent
	 * rogue scripts from capturing passwords; content-type and -length
	 * for no particular reason.
	 */

	if (!strcasecmp (hdrs[i].key, "Content-type"))
	    Tcl_SetVar2(interp, "webenv", "CONTENT_TYPE",
	        hdrs[i].val, TCL_GLOBAL_ONLY);
	else if (!strcasecmp (hdrs[i].key, "Content-length"))
	    Tcl_SetVar2(interp, "webenv", "CONTENT_LENGTH",
	        hdrs[i].val, TCL_GLOBAL_ONLY);
	else if (!strcasecmp (hdrs[i].key, "Authorization"))
	    continue;
	else
	    Tcl_SetVar2(interp, "webenv", http2env (r->pool, hdrs[i].key),
	        hdrs[i].val, TCL_GLOBAL_ONLY);
    }

    Tcl_SetVar2(interp, "webenv", "SERVER_SOFTWARE",
        (char *)ap_get_server_version(), TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "SERVER_ADMIN",
        s->server_admin, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "SERVER_NAME",
        s->server_hostname, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "NEOSCRIPT_VERSION",
        NEOWEBSCRIPT_VERSION, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "NEOWEBSCRIPT_VERSION",
        NEOWEBSCRIPT_VERSION, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "NEO_SOFTWARE_START",
        softwareStartTimeString, TCL_GLOBAL_ONLY);
    sprintf(portbuf, "%u", ap_get_server_port(r));
    Tcl_SetVar2(interp, "webenv", "SERVER_PORT",
        portbuf, TCL_GLOBAL_ONLY);

    Tcl_SetVar2(interp, "webenv", "SERVER_ROOT",
        ap_server_root, TCL_GLOBAL_ONLY);

    Tcl_SetVar2(interp, "webenv", "REMOTE_HOST",
        (char *)ap_get_remote_host(r->connection, r->per_dir_config, REMOTE_NAME),
	TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "REMOTE_ADDR",
        c->remote_ip, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "DOCUMENT_ROOT",
        (char *)ap_document_root(r), TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "SCRIPT_FILENAME",
        r->filename, TCL_GLOBAL_ONLY);

    if (c->user)
        Tcl_SetVar2(interp, "webenv", "REMOTE_USER",
	    c->user, TCL_GLOBAL_ONLY);
    if (c->ap_auth_type)
        Tcl_SetVar2(interp, "webenv", "AUTH_TYPE",
	    c->ap_auth_type, TCL_GLOBAL_ONLY);
    if (c->remote_logname)
        Tcl_SetVar2(interp, "webenv", "REMOTE_IDENT",
	    c->remote_logname, TCL_GLOBAL_ONLY);

    /* Apache custom error responses. If we have redirected set two new vars */
    if (r->prev) {
        if (r->prev->args)
	    Tcl_SetVar2(interp, "webenv",
	        "REDIRECT_QUERY_STRING", r->prev->args, TCL_GLOBAL_ONLY);
	if (r->prev->uri)
	    Tcl_SetVar2(interp, "webenv",
	        "REDIRECT_URL", r->prev->uri, TCL_GLOBAL_ONLY);
    }

    /* To prevent "discards const" warning */
    tmpbuf = ckalloc((int) sizeof(r->method) + 1);
    strcpy(tmpbuf, r->method);

    /* these four are normally for CGI's */
    Tcl_SetVar2(interp, "webenv", "GATEWAY_INTERFACE",
        "CGI/1.1", TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "SERVER_PROTOCOL",
        r->protocol, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "REQUEST_METHOD",
        tmpbuf, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "DOCUMENT_URI",
        r->uri, TCL_GLOBAL_ONLY);
    if ((t = strrchr(r->filename, '/')))
        Tcl_SetVar2(interp, "webenv", "DOCUMENT_NAME",
	    ++t, TCL_GLOBAL_ONLY);
    else
        Tcl_SetVar2(interp, "webenv", "DOCUMENT_NAME",
	    r->uri, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "DOCUMENT_PATH_INFO",
        r->path_info ? r->path_info : "", TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "webenv", "QUERY_STRING",
        r->args ? r->args : "", TCL_GLOBAL_ONLY);
    sprintf (timeTextBuf, "%ld", r->finfo.st_mtime);
    Tcl_SetVar2(interp, "webenv", "NEO_LAST_MODIFIED",
        timeTextBuf, TCL_GLOBAL_ONLY);

    sprintf (timeTextBuf, "%ld", r->finfo.st_uid);
    Tcl_SetVar2(interp, "webenv", "NEO_DOCUMENT_UID",
        timeTextBuf, TCL_GLOBAL_ONLY);

    Tcl_SetVar2(interp, "webenv", "NEO_TIME_FORMAT",
        DEFAULT_TIME_FORMAT, TCL_GLOBAL_ONLY);

    ckfree(tmpbuf);
}

/* --------------------------- Action handlers ---------------------------- */

/* ensure that path is relative, and does not contain ".." elements
 * ensentially ensure that it does not match the regex:
 * (^/|(^|/)\.\.(/|$))
 * XXX: this needs os abstraction... consider c:..\foo in win32
 */
static int is_only_below(const char *path)
{
#if WIN32
    if (path[1] == ':')
  return 0;
#endif
    if (path[0] == '/') {
        return 0;
    }
    if (path[0] == '.' && path[1] == '.'
        && (path[2] == '\0' || path[2] == '/')) {
        return 0;
    }
    while (*path) {
        if (*path == '/' && path[1] == '.' && path[2] == '.'
            && (path[3] == '\0' || path[3] == '/')) {
            return 0;
        }
        ++path;
    }
    return 1;
}

int run_pickfile_req( request_rec *r )
{
    int errstatus;
    FILE *f;
    char buf[IOBUFSIZE];
    int nLines;
    int whichLine;

    if (r->method_number != M_GET) return DECLINED;
    if (r->finfo.st_mode == 0 || (r->path_info && *r->path_info)) {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s", r->filename,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "File does not exist");
        return HTTP_NOT_FOUND;
    }

    ap_set_last_modified(r);
    if ((errstatus = ap_set_content_length (r, r->finfo.st_size))
        || ((errstatus = ap_meets_conditions (r)) != OK))
        return errstatus;

    f = fopen (r->filename, "r");

    if (f == NULL) {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s", r->filename,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "file permissions deny server access");
        return HTTP_FORBIDDEN;
    }

    if ((fgets(buf, IOBUFSIZE, f) != NULL) || (errno == EINTR)) {
	nLines = atoi(buf);
	if (nLines <= 0) {
	    fclose (f);
	    return OK;
	}

	ap_soft_timeout("send-pick", r);

	srand((int)(getpid() * 17 + time((long *) 0)));
	for (whichLine = rand() % nLines; whichLine-- >= 0; ) {
	    if ((fgets(buf,IOBUFSIZE,f)) == NULL) {
		if (errno != EINTR) break;
	    }
	}
	ap_rprintf (r, "%s", buf);
    }
    fclose(f);
    return OK;
}

Tcl_Interp *get_slave_interp (request_rec *r, char *handler_name, char *name) {
    extern Tcl_Interp *interp;
    Tcl_Interp *safeInterp;
    struct request_rec *q;
    char *safeInterpName;
    table *t;
    array_header *arr;
    table_entry *elts;
    int i, nelts;
    char script[101];

    /* look into the request record and find out if we already have a safe
     * interpreter running with the right user ID.
     *
     * if not, create one and register it.  if so, hook up to it.
     *
     */

     for (q = r, safeInterpName = (char *)NULL; q != (struct request_rec *)NULL; q = q->main) {
	 if (r->finfo.st_uid != q->finfo.st_uid) break;
	 if ((safeInterpName = ap_get_module_config(q->request_config, &neoscript_module)) != NULL) break;
     }
     if (safeInterpName) {
	    safeInterp = Tcl_GetSlave(interp, safeInterpName);
	    assert (safeInterp != NULL);
     } else {

	/* Set array for the config information here, once, when the slave
	 * interp is created.  Saves repeating work when several script blocks
	 * exist within a page.
	 */
	nws_dir_config *ns = (nws_dir_config *)ap_get_module_config(r->per_dir_config,&neoscript_module);

	t = ns->nws_dir_vars;
	arr = ap_table_elts(t);
	elts = (table_entry *)arr->elts;
	nelts = arr->nelts;

	/* Make sure it doesn't exist from a previous page served by this
	 * process.
	 */
	Tcl_UnsetVar (interp, "NeoWebDirConf", TCL_GLOBAL_ONLY);
	for (i = 0; i < nelts; ++i)
	{
	    Tcl_SetVar2(interp, "NeoWebDirConf",
			elts[i].key, elts[i].val, TCL_GLOBAL_ONLY);
	}

	Tcl_SetVar2(interp, "webenv",
	    "NEO_HANDLER", handler_name, TCL_GLOBAL_ONLY);
        strcpy (script, "setup_safe_interpreter");
	if (Tcl_GlobalEval(interp, script) != TCL_OK) {
	    char *errorInfo;

	    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
            ap_log_rerror(APLOG_MARK, APLOG_ERR, r, "%s", errorInfo);
	    fprintf(stderr, "setup_safe_interpreter: %s\n", errorInfo);
	    exit(1);
	} else {
	    safeInterpName = (char *) ap_palloc(r->pool,
					       strlen(interp->result) + 1);
	    strcpy(safeInterpName, interp->result);

	    safeInterp = Tcl_GetSlave(interp, safeInterpName);
	    /*assert (safeInterp != NULL);*/
	    if (safeInterp == NULL) {
		exit(1);
	    }

	    t = ns->nws_user_vars;
	    arr = ap_table_elts(t);
	    elts = (table_entry *)arr->elts;
	    nelts = arr->nelts;

	    for (i = 0; i < nelts; ++i)
	    {
		Tcl_SetVar2(safeInterp, "NeoWebUserConf",
			   elts[i].key, elts[i].val, TCL_GLOBAL_ONLY);
	    }
	}

	ap_register_cleanup(r->pool, (void *)safeInterp,
			   (void (*)())Tcl_DeleteInterp,
			   (void (*)())Tcl_DeleteInterp);
	ap_set_module_config(r->request_config, &neoscript_module,
			    safeInterpName);

	/*
	propagate_vars_to_nws(safeInterp, r);
	*/
    }
    if (name != NULL) {
	strcpy(name, safeInterpName);
    }
    return safeInterp;
}

int handle_old_nws(FILE *in, request_rec *r, char *error, char *safeInterpName)
{
    char tag[MAX_STRING_LEN];
    char *tag_val;
    extern Tcl_Interp *interp;

    /* parse the tag=value pairs.  build up a neoscript command
     * including name of the safe interp we're running against.
     */
    while(1) {
	Tcl_DString userCommand;
	char *commandString;

        if (!(tag_val = get_tag(r->pool, in, tag, MAX_STRING_LEN, 1))) {
            return 1;
	}

        if (!strcmp(tag, "done"))
	    break;

	Tcl_DStringInit(&userCommand);
	Tcl_DStringAppendElement(&userCommand, "handle_neowebscript_request");
	Tcl_DStringAppendElement(&userCommand, safeInterpName);
	Tcl_DStringAppendElement(&userCommand, tag);
	Tcl_DStringAppendElement(&userCommand, tag_val);
	commandString = Tcl_DStringValue(&userCommand);

	if (Tcl_GlobalEval (interp, commandString) == TCL_ERROR) {
	    ap_rprintf (r, "[%s error %s]", tag, interp->result);
	}
	Tcl_DStringFree(&userCommand);
    }
    return 0;
}

int handle_nws(FILE *in, request_rec *r, char *error,
	char *safeInterpName)
{
    char code[MAX_STRING_LEN];
    char *nws_code;
    extern Tcl_Interp *interp;
    request_rec *Tcl_saved_request_rec;

    Tcl_DString userCommand;
    char *commandString;

    Tcl_saved_request_rec = Tcl_request_rec;
    Tcl_request_rec = r;

    if(!(nws_code = get_nws_code (r->pool, in, code, MAX_STRING_LEN, ENDING_NWS_SEQUENCE))) {
	Tcl_request_rec = Tcl_saved_request_rec;
	return 1;
    }

    Tcl_DStringInit(&userCommand);
    Tcl_DStringAppendElement(&userCommand, "handle_neowebscript_request");
    Tcl_DStringAppendElement(&userCommand, safeInterpName);
    Tcl_DStringAppendElement(&userCommand, "code");
    Tcl_DStringAppendElement(&userCommand, nws_code);
    commandString = Tcl_DStringValue(&userCommand);

    if (Tcl_GlobalEval (interp, commandString) == TCL_ERROR) {
	ap_rprintf (r, "[%s error %s]", "code", interp->result);
    }
    Tcl_DStringFree(&userCommand);

    Tcl_request_rec = Tcl_saved_request_rec;
    return 0;
}

int handle_nws_config(FILE *in, request_rec *r, char *error, char *tf,
                  int *sizefmt) {
    char tag[MAX_STRING_LEN];
    char *tag_val;
    table *env = r->subprocess_env;

    while(1) {
        if(!(tag_val = get_tag(r->pool, in, tag, MAX_STRING_LEN, 0)))
            return 1;
        if(!strcmp(tag,"errmsg"))
            strcpy(error,tag_val);
        else if(!strcmp(tag,"timefmt")) {
	    time_t date = time(NULL);
            strcpy(tf,tag_val);
            ap_table_set (env, "DATE_LOCAL", ap_ht_time(r->pool,date,tf,0));
            ap_table_set (env, "DATE_GMT", ap_ht_time(r->pool,date,tf,1));
            ap_table_set (env, "LAST_MODIFIED", ap_ht_time(r->pool,r->finfo.st_mtime,tf,0));
        }
        else if(!strcmp(tag,"sizefmt")) {
	    decodehtml(tag_val);
            if(!strcmp(tag_val,"bytes"))
                *sizefmt = SIZEFMT_BYTES;
            else if(!strcmp(tag_val,"abbrev"))
                *sizefmt = SIZEFMT_KMG;
        }
        else if(!strcmp(tag,"done"))
            return 0;
        else {
            char errstr[MAX_STRING_LEN];
            sprintf(errstr,"unknown parameter \"%s\" to tag \"config\" in %s",
                    tag, r->filename);
            ap_log_rerror(APLOG_MARK, APLOG_ERR, r, "%s", errstr);
            ap_rprintf (r,"%s",error);
        }
    }
}

void add_include_environment(request_rec *r)
{
    ap_add_common_vars(r);
    ap_add_cgi_vars(r);
    add_include_vars(r, DEFAULT_TIME_FORMAT);
}


/* -------------------------- The main function --------------------------- */

/* This is a stub which parses a file descriptor. */

int send_parsed_content(FILE *f, request_rec *r)
{
    char directive[MAX_STRING_LEN], error[MAX_STRING_LEN];
    char timefmt[MAX_STRING_LEN];
    int noexec = ap_allow_options(r) & OPT_INCNOEXEC;
    int ret, sizefmt, seqtype=0;
    int init_environment, if_nesting, printing, conditional_status;
    Tcl_Interp *safeInterp = 0;
    int has_includes = 0;
    char safeInterpName[20];
    request_rec *Tcl_saved_request_rec;

    Tcl_saved_request_rec = Tcl_request_rec;
    Tcl_request_rec = r;

    ap_cpystrn(error, DEFAULT_ERROR_MSG, sizeof(error));
    ap_cpystrn(timefmt, DEFAULT_TIME_FORMAT, sizeof(timefmt));

    sizefmt = SIZEFMT_KMG;

/*  Turn printing on */
    printing = conditional_status = 1;
    if_nesting = 0;
    init_environment = 0;

 #ifndef WIN32
    ap_chdir_file(r->filename);
 #endif
    if (r->args) { /* add QUERY stuff to env cause it ain't yet */
        char *arg_copy = ap_pstrdup(r->pool, r->args);

        ap_table_setn(r->subprocess_env, "QUERY_STRING", r->args);
        ap_unescape_url(arg_copy);
        ap_table_setn(r->subprocess_env, "QUERY_STRING_UNESCAPED",
                ap_escape_shell_cmd(r->pool, arg_copy));
    }

    /* find_string2 returns 0 if there is an SSI, non-0 if not.
     * look in seqtype for whether it is apache-style or <nws> style.
     */

    while (1) {

      if (!find_string2(f, STARTING_SEQUENCE, STARTING_NWS_SEQUENCE, r,
                        &seqtype, printing)) {
	has_includes = 1;
        if (seqtype == 2) {
	    if (!safeInterp) {
		safeInterp = get_slave_interp(r, "neo-server-parsed",
                                              safeInterpName);
	    }

	    ret = handle_nws(f, r, error, safeInterpName);
            if (ret) {
                ap_log_rerror(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
			     "httpd: premature EOF in parsed file %s",
			     r->filename);
                break;
	    }
	}
	else if (seqtype == 1) {
            if (get_directive(f, directive, sizeof(directive), r->pool)) {
                ap_log_rerror(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
                             "mod_include: error reading directive in %s",
                             r->filename);
                ap_rputs(error, r);
                break;
            }

            if (!strcmp(directive,"neowebscript") ||
                     !strcmp(directive,"neoscript") ||
                     !strcmp(directive,"nws")) {
		if (!safeInterp) {
		    safeInterp = get_slave_interp(r, "neo-server-parsed",
						 safeInterpName);
		}
                ret = handle_old_nws(f, r, error, safeInterpName);
	    } else if (!strcmp(directive, "neoconfig")) {
                ret = handle_nws_config(f, r, error, timefmt, &sizefmt);
            } else {
                ap_log_rerror(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
			     "httpd: unknown directive \"%s\" "
			     "in parsed doc %s", directive, r->filename);
                if (printing) {
                    ap_rputs(error, r);
                }
                ret = find_string(f, ENDING_SEQUENCE, r, 0);
            }

            if (ret) {
                ap_log_rerror(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
			     "httpd: premature EOF in parsed file %s",
			     r->filename);
                break;
            } else {
		NEO_SEND_HEADERS(r);
	    }
        }
      } else {
        NEO_SEND_HEADERS(r);
        break;
      }
    }
    Tcl_request_rec = Tcl_saved_request_rec;
    return has_includes;
}

void *create_nws_dir_config(pool *p, char *dummy)
{
    nws_dir_config *new =
      (nws_dir_config *) ap_palloc (p, sizeof(nws_dir_config));

    new->nws_dir_vars = ap_make_table (p, 4);
    new->nws_user_vars = ap_make_table (p, 4);

    return new;
}

/*
 * send_subst_content
 *
 * The contents of the file are passed to the Tcl slave's subst command.
 * The result is written to the browser.  We just do the setup, and the
 * final output.  Most of the work (and policy) is implemented in Tcl
 * code using the master interpreter.
 */
void send_subst_content(FILE *f, request_rec *r)
{
    Tcl_Interp *safeInterp = 0;
    char safeInterpName[20];
    extern Tcl_Interp *interp;
    request_rec *Tcl_saved_request_rec;
    Tcl_Channel fchan;
    char *fchan_name;
    Tcl_DString userCommand;
    char *commandString;
    int fno;

    Tcl_saved_request_rec = Tcl_request_rec;
    Tcl_request_rec = r;

    ap_chdir_file (r->filename);

    safeInterp = get_slave_interp(r, "neo-server-subst", safeInterpName);
    fno = fileno(f);

#if TCL_MAJOR_VERSION == 8
    fchan = Tcl_MakeFileChannel((ClientData) fno, TCL_READABLE);
#else
    fchan = Tcl_MakeFileChannel((ClientData)fno, (ClientData)NULL,TCL_READABLE);
#endif

    Tcl_RegisterChannel(interp, fchan);
    fchan_name = Tcl_GetChannelName(fchan);
    Tcl_DStringInit(&userCommand);
    Tcl_DStringAppendElement(&userCommand, "handle_subst_request");
    Tcl_DStringAppendElement(&userCommand, safeInterpName);
    Tcl_DStringAppendElement(&userCommand, fchan_name);
    commandString = Tcl_DStringValue(&userCommand);

    if (Tcl_GlobalEval (interp, commandString) == TCL_ERROR) {
	ap_rprintf (r, "[%s error %s]", commandString, interp->result);
    }
    Tcl_DStringFree(&userCommand);
    Tcl_request_rec = Tcl_saved_request_rec;
}

int check_cache_status(char *filename, long mtime)
{
    int status;
    DBT key;
    DBT data;
    DB *db;

    if (db_open(NeoWebCacheName, DB_HASH, DB_CREATE, 0644, NULL, NULL, &db)) {
	perror(NeoWebCacheName);
	return HTTP_NOT_FOUND;
    }

    key.data = filename;
    key.size = strlen(filename) + 1;

    status = db->get(db, NULL, &key, &data, 0);
    db->close(db, NULL);
    if (status)
	return HTTP_NOT_FOUND;
    /*
    fprintf(stderr, "db get %s = %d, data = %ld\n", filename, status,
	    *(long*)data.data);
    */
    if (*(long*)data.data == mtime)
	return USE_LOCAL_COPY;
    return 0;
}

void set_cache_status(char *filename, int cache_status, int has_includes, long mtime)
{
    int status;
    DBT key;
    DBT data;
    DB *db;

    /* No entry in cache and there are includes -- no change */
    if (cache_status == 0 && has_includes)
	return;

    if (db_open(NeoWebCacheName, DB_HASH, NULL, 0644, NULL, NULL, &db))
	return;

    key.data = filename;
    key.size = strlen(filename) + 1;

    /* delete the previous entry if no longer needed */
    if (!has_includes && cache_status == 0) {
	/* fprintf(stderr, "Delete key %s\n", filename); */
	status = db->del(db, NULL, &key, 0);
    } else {
	data.data = (void*)&mtime;
	data.size = sizeof(long);
	/* fprintf(stderr, "Put %s: %ld\n", filename, mtime); */
	status = db->put(db, NULL, &key, &data, 0);
	/* if (status == -1)
	    perror("db->put"); */
    }
    db->close(db, NULL);
    return;
}

static int send_parsed_file(request_rec *r, int mode)
{
    FILE *f;
    FILE *fp;
    nws_dir_config *ns =
    (nws_dir_config *)ap_get_module_config(r->per_dir_config,&neoscript_module);
    int errstatus, cache_status, has_mime = 0;
    char *pragma;
    request_rec *parent;
    char script[101];

    extern Tcl_Interp *interp;
    int is_included = !strcmp (r->protocol, "INCLUDED");
    char *argv0;
    int nph;
    char *lenp = (char *) ap_table_get (r->headers_in, "Content-length");
    char argsbuffer[HUGE_STRING_LEN];

    struct request_rec *hrr = NULL;
    struct request_rec *frr = NULL;

    if (!(ap_allow_options(r) & OPT_INCLUDES)) return DECLINED;

    r->allowed |= (1 << M_GET);
    if (r->finfo.st_mode == 0) {
        ap_log_rerror(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r,
		     "File does not exist: %s",
                     (r->path_info
                     ? ap_pstrcat(r->pool, r->filename, r->path_info, NULL)
                     : r->filename, r));
        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;
    }

    if ((errstatus = ap_meets_conditions (r)) != OK)
    {
	return errstatus;
    }

    if (NeoWebCacheEnabled && mode == 0 && !is_included) {
	pragma = (char *) ap_table_get (r->headers_in, "Pragma");

	ap_set_last_modified(r);
	if (!pragma || strcasecmp(pragma, "no-cache")) {
	    cache_status = check_cache_status(r->filename, r->finfo.st_mtime);
	    if (cache_status == USE_LOCAL_COPY
		&& ((errstatus = ap_meets_conditions (r)) != OK))
	    return errstatus;
	}
    }

    /**** Handle PUT and POST for NeoWebScript ****/

    /* Point argv0 to the tail part of the filename */
    if((argv0 = strrchr(r->filename,'/')) != NULL)
    {
        argv0++;
    }
    else
    {
	argv0 = r->filename;
    }

    /* It's NPH if we want to create our own response headers on output.
     *
     * Note that the whole "No Parse Headers" concept shows all the
     * kludgey ways people have invented to try to work around the
     * lack of a better hints mechanism for the page to tell the server
     * things about itself without altering the text of the URL.  Sigh.
     */
    nph = !(strncmp(argv0,"nph-",4));

    if (nph && is_included)
    {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s", r->filename,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "attempt to include NPH NeoWebScript CGI script");
	return HTTP_FORBIDDEN;
    }

    if ((errstatus = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR)))
    {
	return errstatus;
    }

    ap_hard_timeout ("send", r);

    if ((parent = ap_get_module_config(r->request_config, &neoscript_module))) {
	/* Kludge --- for nested includes, we want to keep the subprocess
	 * environment of the base document (for compatibility); that means
	 * torquing our own last_modified date as well so that the
	 * LAST_MODIFIED variable gets reset to the proper value if the
	 * nested document resets <!--#config timefmt-->.
	 * We also insist that the memory for this subrequest not be
	 * destroyed, that's dealt with in handle_include().
	 */
	r->subprocess_env = parent->subprocess_env;
	ap_pool_join(parent->pool, r->pool);
	r->finfo.st_mtime= parent->finfo.st_mtime;
    }
    else {
	/* we're not a nested include, so we create an initial environment
	 */
	ap_add_common_vars(r);
	ap_add_cgi_vars(r);
	add_include_vars(r, DEFAULT_TIME_FORMAT);

        /*
	 * ??? Not needed most of the time; need to figure this out
	 */
	propagate_vars_to_nws(interp, r);
    }

    /* Final part of NeoWebScript PUT and POST handling */

    if (!is_included && ap_should_client_block(r)) {
	Tcl_DString tclStdinString;
        void (*handler)();
	char *content_type = (char *) ap_table_get(r->headers_in,
						  "Content-type");
	int remaining = atoi(lenp);

	/* If it's a POST or a PUT,
	 *
	 *   If it's not a MIME upload, we read the data from stdin and build
	 *   it up in a Tcl dynamic string (DString), then store it into an
	 *   element of our global "webenv" array.
	 *
	 *   If it is a MIME upload, we call the Tcl interpreter to set
	 *   things up for us, then suck in any form fields that aren't
	 *   files, and squirrel away things that are files, for the
	 *   NeoWebScript code will make a decision about what to do with
	 *   it from there.
	 */
        ap_hard_timeout("Uplinking PUT/POST", r);
        handler = signal(SIGPIPE, SIG_IGN);

	if (content_type &&
	  strncmp(content_type, "multipart/form-data", 19) == 0) {

	    /* It is a MIME upload.  Call a Tcl proc named
	     * "handle_neowebscript_mime_upload".  It is expected to return
	     * a filename (which from C we'll see in interp->result) that
	     * we'll copy the uploaded data to.
	     *
	     * When done, we'll call a Tcl proc named
	     * "finish_neowebscript_mime_upload"
	     */
	    has_mime = 1;
	    strcpy(script, "handle_neowebscript_mime_upload");
	    if (Tcl_GlobalEval(interp, script) == TCL_ERROR)
	    {
		char *errorInfo;

                /* An error occured setting up for the upload.  We have
		 * failed.  Report it and move on.
		 */
		ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
			     "Error handling MIME file upload '%s': %s",
			     r->filename, interp->result);
		errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
		ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
			     "NeoWebScript MIME upload failed: %s\n",
			     errorInfo);
	    } else {
		FILE *fp;
		long len_written;

		/* No Tcl error while setting up to handle the MIME upload,
		 * let's reel it in.
		 *
		 * Note:  File must already exist because we are counting
		 * on the Tcl code to have set up a basic MIME multipart
		 * header there for us.
		 */
		if ((fp = fopen (interp->result, "a")) == (FILE *)NULL) {
		    ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
			         "Error opening MIME save file during upload:"
				 " %s: %s",
				 interp->result, strerror(errno));
		} else {
		    while ((remaining > 0))
		    {
			int len_read, len_to_read = remaining;
			if (len_to_read > HUGE_STRING_LEN)
			    len_to_read = HUGE_STRING_LEN;
			len_read = ap_get_client_block(r, argsbuffer,
			                              len_to_read);
			len_written = fwrite(argsbuffer, sizeof(char),
			                    len_read, fp);
			if (len_read == 0) break;
			if (len_written != len_read) {
			    ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
					 "Error writing to MIME save file"
					 " during upload: %s: %s",
					 interp->result, strerror(errno));
			    break;
			}
			remaining -= len_read;
		    }
		    fclose(fp);
		    strcpy(script, "finish_neowebscript_mime_upload");
		    if (Tcl_GlobalEval(interp, script) == TCL_ERROR)
		    {
			/* An error occured finishing handling the MIME
			 * upload.
			 */
			ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
				     "Error finishing MIME file upload: %s",
				     interp->result);
		    }
		}
	    }

	} else {

	    /* It's not a MIME upload; it's a regular POST.
	     * Read in all the data and store it in the Tcl
	     * global array element webenv(NEO_POST_DATA).
	     * Tcl's string handling will make quick work of parsing
	     * out the response, etc.
	     */
	    Tcl_DStringInit(&tclStdinString);
	    while ((remaining > 0))
	    {
		int len_read, len_to_read = remaining;
		if (len_to_read > HUGE_STRING_LEN) len_to_read = HUGE_STRING_LEN;

		len_read = ap_get_client_block (r, argsbuffer, len_to_read);
		Tcl_DStringAppend(&tclStdinString, argsbuffer, len_read);
		if (len_read == 0) break;
		remaining -= len_read;
	    }
	    Tcl_SetVar2(interp, "webenv", "NEO_POST_DATA",
	               Tcl_DStringValue(&tclStdinString), TCL_GLOBAL_ONLY);
	    Tcl_DStringFree(&tclStdinString);
	}
	signal(SIGPIPE, handler);
	ap_kill_timeout(r);

    }
    /* End of last part of put and post handling for NeoWebScript */

    /* If it's not "no parse headers", send the header.
     *
     * If it's header only (The received HTTP request was HEAD
     * instead of GET), we're done.
     */

    headersSent = 0;
    if (!nph) {
	/* We are going to assume that for nph- files, the user
	 * correctly sends out the correct headers.  This is the
	 * current behavior, subject to change -gporter */
        /* ap_send_http_header(r); */
        if (r->header_only) {
	    ap_send_http_header(r);
	    headersSent = 1;
            ap_kill_timeout (r);
	    ap_pfclose (r->pool, f);
	    return OK;
        }
    } else {
	headersSent = 1;
    }

    ap_hard_timeout("send SSI", r);

#ifdef CHARSET_EBCDIC
    ap_bsetflag(r->connection->client, BEBCDIC2ASCII, 1);
#endif

    /*
     * Check for special NeoWebUserConf variables and handle them.
     *
     * HeaderFile	A file to be included before the main request.
     * FooterFile	A file to be included after the main request.
     */
    if( !is_included ) {
	table *t = ns->nws_user_vars;
	table_entry *elts;
	array_header *arr;
	int i, nelts;
	char *headerFile = NULL;
	char *footerFile = NULL;

	t = ns->nws_user_vars;
	arr = ap_table_elts(t);
	elts = (table_entry *)arr->elts;
	nelts = arr->nelts;

	/*
	 * We go through the table elements ourselves rather than call
	 * ap_table_get() so that we can properly override the variables
	 * if they exist from a parent directory.
	 */
	for (i = 0; i < nelts; ++i)
	{
	    if( STREQU( elts[i].key, "HeaderFile" ) ) {
		headerFile = elts[i].val;
	    }
	    if( STREQU( elts[i].key, "FooterFile" ) ) {
		footerFile = elts[i].val;
	    }
	}

	if( headerFile != NULL ) {
	    hrr = ap_sub_req_lookup_uri( headerFile, r );
	    if( hrr->status != 200 ) {
		ap_destroy_sub_req(hrr);
		hrr = NULL;
	    }
	    Tcl_SetVar2(interp, "webenv",
		"NEO_HEADER_FILE", headerFile, TCL_GLOBAL_ONLY);
	}

	if( footerFile != NULL ) {
	    frr = ap_sub_req_lookup_uri( footerFile, r );
	    if( frr->status != 200 ) {
		ap_destroy_sub_req(frr);
		frr = NULL;
	    }
	    Tcl_SetVar2(interp, "webenv",
		"NEO_FOOTER_FILE", footerFile, TCL_GLOBAL_ONLY);
	}
    }

    /* 
     * If there was a header request, send it out.
     *
     * We open the file and send it out with send_X_content ourselves rather
     * than calling it as a sub_request so that all three files: header, main
     * and footer can all use the same interpreter.
     */
    if( hrr != NULL ) {
	if ((fp = ap_pfopen(hrr->pool, hrr->filename, "r"))) {
	    if( STREQU( r->handler, "neo-server-subst" ) ) {
		send_subst_content(fp, r);
	    } else {
		send_parsed_content(fp, r);
	    }
	    ap_pfclose(hrr->pool, fp);
	}
	ap_destroy_sub_req(hrr);
    }

    if (mode == 1) {
	send_subst_content (f, r);
    }
    else {
	int has_includes = send_parsed_content (f, r);
	if (NeoWebCacheEnabled && !is_included
	   && !(cache_status == HTTP_NOT_FOUND && has_includes))
	    set_cache_status(r->filename, cache_status, has_includes,
			    r->finfo.st_mtime);
    }

    if (parent) {
	ap_set_module_config(r->request_config, &neoscript_module,
			    NESTED_INCLUDE_MAGIC);
    }

    /* If there was a footer request, send it out. */
    if( frr != NULL ) {
	if ((fp = ap_pfopen(frr->pool, frr->filename, "r"))) {
	    if( STREQU( r->handler, "neo-server-subst" ) ) {
		send_subst_content(fp, r);
	    } else {
		send_parsed_content(fp, r);
	    }
	    ap_pfclose(frr->pool, fp);
	}
	ap_destroy_sub_req(frr);
    }

    if (has_mime)
    {
	/* remove temp files created by handle_neowebscript_mime_upload
	 */
	strcpy(script, "cleanup_neowebscript_mime_upload");
	if (Tcl_GlobalEval(interp, script) == TCL_ERROR)
	{
	    /* An error occured finishing handling the MIME upload. */
	    ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
			 "Error cleaning up after MIME file upload: %s",
			 interp->result);
	}
    }
    ap_kill_timeout(r);
    return OK;
}

static int send_sparsed_file(request_rec *r)
{
    r->content_type = "text/html";
    return send_parsed_file(r, 0);
}

static int send_subst_file(request_rec *r)
{
    r->content_type = "text/html";
    return send_parsed_file(r, 1);
}

static int send_shtml_file(request_rec *r)
{
    r->content_type = "text/html";
    return send_parsed_file(r, 0);
}

#ifdef GDTCL
/*
 * send_generated_image:
 *
 * Sets up safe interpreter and then calls Tcl proc handle_image_request.
 * Tcl should return a file handle containing the data to be used for the
 * image.  All caching, expiration and other policies are handled in Tcl
 * code by handle_image_request.
 */

int send_generated_image(request_rec *r)
{
    FILE *f = NULL;
    int errstatus;
    Tcl_Interp *safeInterp = 0;
    char *channel_name;
    char safeInterpName[20], script[101];

    extern Tcl_Interp *interp;

/* if POST or PUT, it is an error.  will try to allow QUERY_STRING
 * to work with images to allow passing of options
 */
    if (r->method_number != M_GET) {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s",
		     r->filename,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "Method != GET for generated image:");
	return BAD_REQUEST;
    }

    ap_hard_timeout("send", r);

    Tcl_request_rec = r;
    propagate_vars_to_nws(interp, r);

    safeInterp = get_slave_interp(r, "neo-generate-image", safeInterpName);

/* if not exists, make automatic reference to cache */
    if (r->finfo.st_mode == 0) {
	strcpy(script, "handle_cached_location");
	errstatus = Tcl_GlobalEval(interp, script);
    } else {
	strcpy(script, "handle_image_request ");
	errstatus = Tcl_VarEval(interp, script, safeInterpName, (char*)NULL);
    }
    if (errstatus == TCL_ERROR) {
	ap_log_rerror(APLOG_MARK, APLOG_ERR, r, "%s",
		     Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY));
	return HTTP_NOT_FOUND;
    }

    if (interp->result == '\0') {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s",
		     r->filename,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "no image returned");
	return HTTP_NOT_FOUND;
    }

    channel_name = ap_pstrdup(r->pool, interp->result);

    if (Tcl_GetOpenFile(interp, channel_name, 0, 0, (ClientData*)&f)
       == TCL_ERROR) {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s",
		     interp->result,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "unable to access tcl_file");
	return HTTP_NOT_FOUND;
    }

    if (f == NULL) {
        ap_log_rerror(APLOG_MARK, APLOG_ERR, r,
		     "access to %s failed for %s, reason %s",
		     interp->result,
		     ap_get_remote_host(r->connection, r->per_dir_config,
				       REMOTE_NAME),
		     "file permissions deny server access");
        return HTTP_FORBIDDEN;
    }

    /* Save a copy of the file descriptor - must close the one in the
     * trusted interp or it would stick around too long.
     */
    f = ap_pfdopen(r->pool, dup(fileno(f)), "r");
    Tcl_VarEval(interp, "close ", channel_name, (char*)NULL);

    fstat(fileno(f), &r->finfo);

    if ((errstatus = ap_set_content_length (r, r->finfo.st_size)))
	return errstatus;
    if (ap_table_get(r->headers_out, "Expires")) {
	ap_set_last_modified(r);
	if ((errstatus = ap_meets_conditions (r)) != OK)
	    return errstatus;
    }

    ap_soft_timeout("send", r);

    ap_send_http_header(r);
    if (!r->header_only) ap_send_fd(f, r);
    return OK;
}
#endif

const char *nws_dir_command(cmd_parms *cmd, nws_dir_config *m, char *var, char *val)
{
    ap_table_set(m->nws_dir_vars, var, val);
    return NULL;
}

const char *nws_user_command(cmd_parms *cmd, nws_dir_config *m, char *var, char *val)
{
    ap_table_set(m->nws_user_vars, var, val);
    return NULL;
}

const char *nws_server_command(cmd_parms *cmd, void *dummy, char *var,char *val)
{
    server_rec *s = cmd->server;
    nws_server_config *ns;

    ns = (nws_server_config *)ap_get_module_config(s->module_config, &neoscript_module);
    ap_table_set(ns->nws_server_vars, var, val);
    return NULL;
}


/* -------------------------- The main function --------------------------- */

/* This is a stub which parses a file descriptor. */

void *merge_nws_dir_configs(pool *p, void *basev, void *addv)
{
    nws_dir_config *base = (nws_dir_config *)basev;
    nws_dir_config *add = (nws_dir_config *)addv;
    nws_dir_config *new =
      (nws_dir_config *)ap_palloc(p, sizeof(nws_dir_config));

    new->nws_dir_vars =
    	ap_overlay_tables(p, base->nws_dir_vars, add->nws_dir_vars);
    new->nws_user_vars =
	ap_overlay_tables(p, base->nws_user_vars, add->nws_user_vars);

    return new;
}

void *create_nws_server_config(pool *p, server_rec *s)
{
    nws_server_config *new =
    	(nws_server_config *)ap_palloc(p, sizeof(nws_server_config));

    new->nws_server_vars = ap_make_table(p, 4);

    return new;
}

void *merge_nws_server_configs(pool *p, void *basev, void *addv)
{
    nws_server_config *base = (nws_server_config *)basev;
    nws_server_config *add = (nws_server_config *)addv;
    nws_server_config *new =
	(nws_server_config *)ap_palloc(p, sizeof(nws_server_config));

    new->nws_server_vars =
	ap_overlay_tables(p, base->nws_server_vars, add->nws_server_vars);

    return new;
}

const char *nws_cache_path_command(cmd_parms *cmd, nws_dir_config *m, char *arg)
{
   /*
   DB *db;
   */
   NeoWebCacheName = ap_server_root_relative(cmd->pool, arg);
   NeoWebCacheEnabled = 1;
   fprintf(stderr, "Lookaside enabled: %s\n", NeoWebCacheName);
   /*
   db = dbopen(NeoWebCacheName, (O_CREAT|O_RDWR|DB_LOCK), 0644, DB_HASH,
	      (void *)NULL);
   if (db == (DB *)NULL) {
	perror(NeoWebCacheName);
   } else {
       db->close(db);
       NeoWebCacheEnabled = 1;
   }
   */
   return NULL;
}

static const command_rec nws_cmds[] =
{
    { "NeoWebServerConf", nws_server_command, NULL, RSRC_CONF, TAKE2, NULL },
    { "NeoWebCache", nws_cache_path_command, NULL, RSRC_CONF, TAKE1, NULL },
    { "NeoWebDirConf", nws_dir_command, NULL, ACCESS_CONF, TAKE2, NULL },
    { "NeoWebUserConf", nws_user_command, NULL, ACCESS_CONF|OR_FILEINFO, TAKE2, "NeoWebUserConf key value: sets NeoWebUserConf(key)=value in safe interpreter" },
    { NULL }
};

static const handler_rec nws_handlers[] =
{
    { INCLUDES_MAGIC_TYPE, send_shtml_file },
    { INCLUDES_MAGIC_TYPE3, send_shtml_file },
    { "neo-server-parsed", send_sparsed_file },
    { "neo-server-subst", send_subst_file },
#ifdef GDTCL
    { "neo-generate-image", send_generated_image },
#endif
    { NULL }
};

module MODULE_VAR_EXPORT neoscript_module =
{
    STANDARD_MODULE_STUFF,
    init_nws,                       /* initializer */
    create_nws_dir_config,          /* dir config creater */
    merge_nws_dir_configs,          /* dir merger --- default is to override */
    create_nws_server_config,       /* server config */
    merge_nws_server_configs,       /* merge server config */
    nws_cmds,                       /* command table */
    nws_handlers,                   /* handlers */
    NULL,                           /* filename translation */
    NULL,                           /* check_user_id */
    NULL,                           /* check auth */
    NULL,                           /* check access */
    NULL,                           /* type_checker */
    NULL,                           /* fixups */
    NULL,                           /* logger */
    NULL,                           /* header parser */
    NULL,                           /* child_init */
    NULL,                           /* child_exit */
    NULL,                           /* post read-request */
};