#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 "http_conf_globals.h"
#include <tcl.h>
#include <string.h>
#define ER1 "<h1> ERROR </h1><p><xmp>\n"
#define ER2 "</xmp><h1> ERROR </h1>\n"
#define DBG 0
#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 DEFAULT_HEADER_TYPE "text/html"
#define DTCL_VERSION "0.7.3"
static Tcl_Interp *interp;
static request_rec *global_rr;
typedef struct {
char *buf;
int len;
} obuff;
static obuff obuffer = {
NULL,
0
};
static Tcl_Obj *namespacePrologue;
module MODULE_VAR_EXPORT dtcl_module;
module dtcl_module;
static char **objCacheList;
static Tcl_HashTable objCache;
static int buffer_output = 0;
static int headers_printed = 0;
static int headers_set = 0;
static int content_sent = 0;
static int cacheSize = 0;
static int cacheFreeSize = 0;
static int outputproc(ClientData, char *, int, int *);
static Tcl_ChannelType Achan = {
"apache_channel",
NULL,
NULL,
NULL,
outputproc,
NULL,
NULL,
NULL,
NULL,
#if TCL_MINOR_VERSION >= 2
NULL,
NULL
#else
NULL
#endif
};
#define NESTED_INCLUDE_MAGIC (&dtcl_module)
static int memwrite(obuff *, char *, int);
static int parseargs(char *, request_rec *);
static int send_parsed_content(request_rec *);
static int send_parsed_file(request_rec *, char *, struct stat*, int);
static int set_header_type(request_rec *, char *);
static int print_headers(request_rec *);
static int print_error(request_rec *, int, ...);
static int flush_output_buffer(request_rec *);
int outputproc(ClientData instancedata, char *buf, int toWrite, int *errorCodePtr)
{
memwrite(&obuffer, buf, toWrite);
return toWrite;
}
static int memwrite(obuff *buffer, char *input, int len)
{
if (buffer->len == 0)
{
buffer->buf = Tcl_Alloc(len + 1);
memcpy(buffer->buf, input, len);
buffer->buf[len] = '\0';
buffer->len = len;
}
else
{
char *bufend;
buffer->buf = Tcl_Realloc(buffer->buf, len + buffer->len + 1);
bufend = buffer->buf + buffer->len;
memmove(bufend, input, len);
buffer->buf[len + buffer->len] = '\0';
buffer->len += len;
}
return len;
}
static int set_header_type(request_rec *r, char *header)
{
if (headers_set == 0)
{
r->content_type = header;
headers_set = 1;
return 1;
} else {
return 0;
}
}
static int print_headers(request_rec *r)
{
if (headers_printed == 0)
{
if (headers_set == 0)
set_header_type(r, DEFAULT_HEADER_TYPE);
ap_send_http_header(global_rr);
headers_printed = 1;
return 1;
} else {
return 0;
}
}
static int print_error(request_rec *r, int strs, ...)
{
int i;
va_list ap;
set_header_type(r, DEFAULT_HEADER_TYPE);
print_headers(r);
ap_rputs(ER1, r);
va_start(ap, strs);
for (i = 0; i < strs; i++)
ap_rputs(va_arg(ap, char *), global_rr);
va_end(ap);
ap_rputs(ER2, r);
return 0;
}
static int flush_output_buffer(request_rec *r)
{
print_headers(r);
if (obuffer.len != 0)
{
ap_rwrite(obuffer.buf, obuffer.len, r);
free(obuffer.buf);
obuffer.len = 0;
obuffer.buf = NULL;
}
content_sent = 1;
return 0;
}
static char *cgiEncodeObj (Tcl_Obj *sObj)
{
unsigned char hexchars[] = "0123456789ABCDEF";
register int x, y;
unsigned char *str;
char *s;
int len;
s = Tcl_GetStringFromObj(sObj, &len);
str = (unsigned char *) ap_palloc(global_rr->pool, 3 * len + 1);
for (x = 0, y = 0; len--; x++, y++)
{
str[y] = (unsigned char) s[x];
if (str[y] == ' ')
{
str[y] = '+';
} else if ((str[y] < '0' && str[y] != '-' && str[y] != '.') ||
(str[y] < 'A' && str[y] > '9') ||
(str[y] > 'Z' && str[y] < 'a' && str[y] != '_') ||
(str[y] > 'z'))
{
str[y++] = '%';
str[y++] = hexchars[(unsigned char) s[x] >> 4];
str[y] = hexchars[(unsigned char) s[x] & 15];
}
}
str[y] = '\0';
return ((char *) str);
}
static char *cgiDecodeString (char *text)
{
char *cp, *xp;
for (cp = text, xp = text; *cp; cp++)
{
if (*cp == '%')
{
if (strchr("0123456789ABCDEFabcdef", *(cp + 1))
&& strchr("0123456789ABCDEFabcdef", *(cp + 2)))
{
if (islower(*(cp + 1)))
*(cp + 1) = toupper(*(cp + 1));
if (islower(*(cp + 2)))
*(cp + 2) = toupper(*(cp + 2));
*(xp) = (*(cp + 1) >= 'A' ? *(cp + 1) - 'A' + 10 : *(cp + 1) - '0' ) * 16
+ (*(cp + 2) >= 'A' ? *(cp + 2) - 'A' + 10 : *(cp + 2) - '0');
xp++ ; cp += 2;
}
} else {
*(xp++) = *cp;
}
}
memset(xp, 0, cp - xp);
return text;
}
static int Parse(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *filename;
struct stat finfo;
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "filename");
return TCL_ERROR;
}
filename = Tcl_GetStringFromObj (objv[1], (int *)NULL);
if (!strcmp(filename, global_rr->filename))
{
Tcl_AddErrorInfo(interp, "Cannot recursively call the same file!");
return TCL_ERROR;
}
if (stat(filename, &finfo))
{
Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
return TCL_ERROR;
}
if (send_parsed_file(global_rr, filename, &finfo, 0) == OK)
return TCL_OK;
else
return TCL_ERROR;
}
static int Include(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
Tcl_Channel fd;
int sz;
char buf[2000];
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "filename");
return TCL_ERROR;
}
fd = Tcl_OpenFileChannel(interp,
Tcl_GetStringFromObj (objv[1], (int *)NULL), "r", 0664);
if (fd == NULL)
{
return TCL_ERROR;
} else {
Tcl_SetChannelOption(interp, fd, "-translation", "lf");
}
flush_output_buffer(global_rr);
while ((sz = Tcl_Read(fd, buf, sizeof(buf) - 1)))
{
if (sz == -1)
{
Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
return TCL_ERROR;
}
buf[sz] = '\0';
memwrite(&obuffer, buf, sz);
if (sz < sizeof(buf) - 1)
break;
}
return Tcl_Close(interp,fd);
return TCL_OK;
}
static int Buffer_Add(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *arg1;
int len;
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
arg1 = Tcl_GetByteArrayFromObj(objv[1], &len);
memwrite(&obuffer, arg1, len);
content_sent = 0;
return TCL_OK;
}
static int Hputs(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *arg1;
int length;
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
arg1 = Tcl_GetByteArrayFromObj(objv[1], &length);
if (!strncmp("-error", arg1, 6))
{
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, global_rr->server, "Mod_Dtcl Error: %s", Tcl_GetStringFromObj (objv[2], (int *)NULL));
} else {
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
}
if (buffer_output == 1)
{
memwrite(&obuffer, arg1, length);
} else {
flush_output_buffer(global_rr);
ap_rwrite(arg1, length, global_rr);
}
return TCL_OK;
}
static int Headers(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *opt;
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "headers option arg ?arg ...?");
return TCL_ERROR;
}
if (headers_printed != 0)
{
print_error(global_rr, 1, "Cannot manipulate headers - already sent");
return TCL_ERROR;
}
opt = Tcl_GetStringFromObj(objv[1], NULL);
if (!strcmp("setcookie", opt))
{
char *cookie;
int i, idx;
static char* cookieParms[] = {
"-expires", "-domain", "-path", "-secure", NULL
};
static char* cookieStrings[] = {
"; expires=", "; domain=", "; path=", "; secure"
};
if (objc < 4 || objc > 10)
{
Tcl_WrongNumArgs(interp, 1, objv,
"setcookie cookie-name cookie-value ?-expires expires? ?-domain domain? ?-path path? ?-secure?");
return TCL_ERROR;
}
if (*(Tcl_GetStringFromObj(objv[3], NULL)))
{
cookie = ap_pstrcat(global_rr->pool, cgiEncodeObj(objv[2]), "=",
cgiEncodeObj(objv[3]), NULL);
} else {
cookie = cgiEncodeObj(objv[2]);
}
for (i = 4; i < objc; i++)
{
if (Tcl_GetIndexFromObj(interp, objv[i], cookieParms, "option", 0, &idx) != TCL_OK)
{
return TCL_ERROR;
} else if (idx == 4) {
cookie = ap_pstrcat(global_rr->pool, cookie, cookieStrings[idx], NULL);
} else if (++i >= objc) {
Tcl_WrongNumArgs(interp, 1, objv,
"setcookie cookie-name cookie-value ?-expires expires? ?-domain domain? ?-path path? ?-secure?");
return TCL_ERROR;
} else {
cookie = ap_pstrcat(global_rr->pool, cookie, cookieStrings[idx],
cgiEncodeObj(objv[i]), NULL);
}
}
ap_table_add(global_rr->headers_out, "Set-Cookie", cookie);
}
else if (!strcmp("redirect", opt))
{
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 1, objv, "headers redirect new-url");
return TCL_ERROR;
}
ap_table_set(global_rr->headers_out, "Location", Tcl_GetStringFromObj (objv[2], (int *)NULL));
global_rr->status = 301;
ap_send_error_response(global_rr, 0);
return TCL_RETURN;
}
else if (!strcmp("set", opt))
{
if (objc != 4)
{
Tcl_WrongNumArgs(interp, 1, objv, "set headername value");
return TCL_ERROR;
}
ap_table_set(global_rr->headers_out,
Tcl_GetStringFromObj (objv[2], (int *)NULL),
Tcl_GetStringFromObj (objv[3], (int *)NULL));
}
else if (!strcmp("type", opt))
{
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 1, objv, "type mime/type");
return TCL_ERROR;
}
set_header_type(global_rr, Tcl_GetStringFromObj(objv[2], (int *)NULL));
} else {
return TCL_ERROR;
}
return TCL_OK;
}
static int Buffered(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *opt = Tcl_GetStringFromObj(objv[1], NULL);
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "on/off");
return TCL_ERROR;
}
if (!strncmp(opt, "on", 2))
{
buffer_output = 1;
} else if (!strncmp(opt, "off", 3)) {
buffer_output = 0;
} else {
return TCL_ERROR;
}
flush_output_buffer(global_rr);
return TCL_OK;
}
static int HFlush(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
if (objc != 1)
{
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
flush_output_buffer(global_rr);
ap_rflush(global_rr);
return TCL_OK;
}
static int HGetVars(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *timefmt = DEFAULT_TIME_FORMAT;
#ifndef WIN32
struct passwd *pw;
#endif
char *t;
time_t date = global_rr->request_time;
int i;
array_header *hdrs_arr = ap_table_elts(global_rr->headers_in);
table_entry *hdrs = (table_entry *) hdrs_arr->elts;
array_header *env_arr = ap_table_elts(global_rr->subprocess_env);
table_entry *env = (table_entry *) env_arr->elts;
Tcl_SetVar2(interp, "::request::ENVS", "DATE_LOCAL", ap_ht_time(global_rr->pool, date, timefmt, 0), 0);
Tcl_SetVar2(interp, "::request::ENVS", "DATE_GMT", ap_ht_time(global_rr->pool, date, timefmt, 1), 0);
Tcl_SetVar2(interp, "::request::ENVS", "LAST_MODIFIED", ap_ht_time(global_rr->pool, global_rr->finfo.st_mtime, timefmt, 0), 0);
Tcl_SetVar2(interp, "::request::ENVS", "DOCUMENT_URI", global_rr->uri, 0);
Tcl_SetVar2(interp, "::request::ENVS", "DOCUMENT_PATH_INFO", global_rr->path_info, 0);
#ifndef WIN32
pw = getpwuid(global_rr->finfo.st_uid);
if (pw)
Tcl_SetVar2(interp, "::request::ENVS", "USER_NAME", ap_pstrdup(global_rr->pool, pw->pw_name), 0);
else
Tcl_SetVar2(interp, "::request::ENVS", "USER_NAME",
ap_psprintf(global_rr->pool, "user#%lu", (unsigned long) global_rr->finfo.st_uid), 0);
#endif
if ((t = strrchr(global_rr->filename, '/')))
Tcl_SetVar2(interp, "::request::ENVS", "DOCUMENT_NAME", ++t, 0);
else
Tcl_SetVar2(interp, "::request::ENVS", "DOCUMENT_NAME", global_rr->uri, 0);
if (global_rr->args)
{
char *arg_copy = ap_pstrdup(global_rr->pool, global_rr->args);
ap_unescape_url(arg_copy);
Tcl_SetVar2(interp, "::request::ENVS", "QUERY_STRING_UNESCAPED", ap_escape_shell_cmd(global_rr->pool, arg_copy), 0);
}
for (i = 0; i < hdrs_arr->nelts; ++i)
{
if (!hdrs[i].key)
continue;
if (!strncmp(hdrs[i].key, "Cookie", strlen("Cookie")))
{
char *var;
char *val = NULL;
char *p = ap_pstrdup(global_rr->pool, hdrs[i].val);
var = strtok(p, ";");
while(var)
{
val = strchr(var, '=');
if (val)
{
*val++ = '\0';
var = cgiDecodeString(var);
}
Tcl_SetVar2(interp, "::request::COOKIES", var, val, 0);
var = strtok(NULL, ";");
}
} else {
Tcl_SetVar2(interp, "::request::ENVS", hdrs[i].key, hdrs[i].val, 0);
}
}
ap_clear_table(global_rr->subprocess_env);
ap_add_cgi_vars(global_rr);
ap_add_common_vars(global_rr);
for (i = 0; i < env_arr->nelts; ++i)
{
if (!env[i].key)
continue;
Tcl_SetVar2(interp, "::request::ENVS", env[i].key, env[i].val, 0);
}
ap_clear_table(global_rr->subprocess_env);
return TCL_OK;
}
static int Dtcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *tble;
tble = ap_psprintf(global_rr->pool,
"<table border=0 bgcolor=green><tr><td>\n"
"<table border=0 bgcolor=\"#000000\">\n"
"<tr><td align=center bgcolor=blue><font color=\"#ffffff\" size=+2>dtcl_info</font><br></td></tr>\n"
"<tr><td><font color=\"#ffffff\">Free cache size: %d</font><br></td></tr>\n"
"<tr><td><font color=\"#ffffff\">PID: %d</font><br></td></tr>\n"
"</table>\n"
"</td></tr></table>\n", cacheFreeSize, getpid());
flush_output_buffer(global_rr);
print_headers(global_rr);
ap_rputs(tble, global_rr);
return TCL_OK;
}
static int parseargs(char *inargs, request_rec *r)
{
char *line, *cp, *var = NULL, *val = NULL, *linept;
int i, numargs;
line = ap_pstrdup(r->pool, inargs);
for (cp = line; *cp; cp++)
if (*cp == '+')
*cp = ' ';
if (strlen(line))
{
for (numargs = 1, cp = line; *cp; cp++)
if (*cp == '&') numargs++;
} else
numargs = 0;
linept = line;
for(i = 0; i < numargs; i ++)
{
cp = strchr(linept, '=');
if (cp != NULL)
{
var = ap_pstrndup(r->pool, linept, cp - linept);
linept = cp;
linept ++;
cp = strchr(linept, '&');
if (cp != NULL)
{
val = ap_pstrndup(r->pool, linept, cp - linept);
linept = cp;
linept ++;
}
else
{
val = ap_pstrdup(r->pool, linept);
}
}
else
{
var = linept;
val = ap_pstrdup(r->pool, "");
}
{
Tcl_Obj *vars = Tcl_NewStringObj("::request::VARS", -1);
Tcl_Obj *newval = Tcl_NewStringObj(cgiDecodeString(val), -1);
Tcl_Obj *newvar = Tcl_NewStringObj(cgiDecodeString(var), -1);
Tcl_Obj *oldvar = Tcl_ObjGetVar2(interp, vars, newvar, 0);
if (oldvar == NULL)
{
Tcl_ObjSetVar2(interp, vars, newvar, newval, 0);
} else {
Tcl_Obj *concat[2];
concat[0] = oldvar;
concat[1] = newval;
Tcl_ObjSetVar2(interp, vars, newvar, Tcl_ConcatObj(2, concat), 0);
}
}
}
return 0;
}
static int send_parsed_file(request_rec *r, char *filename, struct stat *finfo, int toplevel)
{
char *errorinfo;
char *hashKey;
Tcl_Obj *outbuf;
int isNew;
Tcl_HashEntry *entry;
hashKey = ap_psprintf(r->pool, "%s%ld%ld%d", filename, finfo->st_mtime, finfo->st_ctime, toplevel);
entry = Tcl_CreateHashEntry(&objCache, hashKey, &isNew);
if (isNew || !cacheSize) {
char inside = 0;
const char *strstart = STARTING_SEQUENCE;
const char *strend = ENDING_SEQUENCE;
char c;
int ch;
int l = strlen(ENDING_SEQUENCE), l2 = strlen(STARTING_SEQUENCE), p = 0;
FILE *f = NULL;
if (!(f = ap_pfopen(r->pool, filename, "r")))
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server,
"file permissions deny server access: %s", filename);
return HTTP_FORBIDDEN;
}
if (toplevel)
outbuf = Tcl_NewStringObj("namespace eval request { buffer_add {", -1);
else
outbuf = Tcl_NewStringObj("hputs {\n", -1);
while ((ch = getc(f)) != EOF)
{
if (!inside)
{
if (ch == -1)
if (ferror(f))
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server,
"Encountered error in mod_dtcl getchar routine while reading %s",
r->uri);
ap_pfclose( r->pool, f);
}
c = ch;
if (c == strstart[p])
{
if (( ++p ) == l)
{
Tcl_AppendToObj(outbuf, "}\n", 2);
inside = 1;
p = 0;
continue;
}
} else {
Tcl_AppendToObj(outbuf, (char *)strstart, p);
if (c == '}')
Tcl_AppendToObj(outbuf, "}", -1);
else if ( c == '{')
Tcl_AppendToObj(outbuf, "{", -1);
else
Tcl_AppendToObj(outbuf, &c, 1);
p = 0;
continue;
}
} else {
if (ch == -1)
if (ferror(f))
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server,
"Encountered error in mod_dtcl getchar routine while reading %s",
r->uri);
ap_pfclose( r->pool, f);
return DONE;
}
c = ch;
if (c == strend[p])
{
if ((++p) == l2)
{
inside = 0;
Tcl_AppendToObj(outbuf, "\n hputs {", -1);
p = 0;
continue;
}
}
else
{
Tcl_AppendToObj(outbuf, (char *)strend, p);
Tcl_AppendToObj(outbuf, &c, 1);
p = 0;
}
}
}
ap_pfclose(r->pool, f);
if (!inside)
{
Tcl_AppendToObj(outbuf, "}", 1);
}
if (toplevel)
Tcl_AppendToObj(outbuf, "\n}\nnamespace delete request\n", -1);
else
Tcl_AppendToObj(outbuf, "\n", -1);
Tcl_IncrRefCount(outbuf);
Tcl_SetHashValue(entry, (ClientData)outbuf);
if (cacheFreeSize) {
objCacheList[--cacheFreeSize ] = strdup(hashKey);
} else if (cacheSize) {
Tcl_HashEntry *delEntry;
delEntry = Tcl_FindHashEntry(&objCache, objCacheList[cacheSize - 1]);
Tcl_DecrRefCount((Tcl_Obj *)Tcl_GetHashValue(delEntry));
Tcl_DeleteHashEntry(delEntry);
free(objCacheList[cacheSize - 1]);
memmove(objCacheList + 1, objCacheList, sizeof(char *)*(cacheSize -1));
objCacheList[0] = strdup(hashKey);
}
} else {
outbuf = (Tcl_Obj *)Tcl_GetHashValue(entry);
}
#if DBG
print_error(r, 1,
Tcl_GetStringFromObj(outbuf, (int *)NULL));
return OK;
#endif
if (Tcl_EvalObj(interp, outbuf) == TCL_ERROR)
{
errorinfo = Tcl_GetVar(interp, "errorInfo", 0);
print_error(r, 3, errorinfo,
"</xmp><b>OUTPUT BUFFER</b><xmp>",
Tcl_GetStringFromObj(outbuf, (int *)NULL));
} else {
flush_output_buffer(global_rr);
}
return OK;
}
static int send_parsed_content(request_rec *r)
{
char error[MAX_STRING_LEN];
char timefmt[MAX_STRING_LEN];
int rslt = 0;
int errstatus;
global_rr = r;
r->allowed |= (1 << M_GET);
r->allowed |= (1 << M_POST);
if (r->method_number != M_GET && r->method_number != M_POST)
return DECLINED;
if (r->finfo.st_mode == 0)
{
ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r->server,
"File does not exist: %s",
(r->path_info
? ap_pstrcat(r->pool, r->filename, r->path_info, NULL)
: r->filename));
return HTTP_NOT_FOUND;
}
if ((errstatus = ap_meets_conditions(r)) != OK)
return errstatus;
if (r->header_only)
{
set_header_type(r, DEFAULT_HEADER_TYPE);
print_headers(r);
return OK;
}
ap_hard_timeout("send DTCL", r);
ap_cpystrn(error, DEFAULT_ERROR_MSG, sizeof(error));
ap_cpystrn(timefmt, DEFAULT_TIME_FORMAT, sizeof(timefmt));
ap_chdir_file(r->filename);
if (Tcl_EvalObj(interp, namespacePrologue) == TCL_ERROR)
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server, "Could not create request namespace\n");
exit(1);
}
if (r->args)
rslt = parseargs(r->args, r);
if (rslt)
{
print_error(r, 1, r->args);
return DONE;
}
if ((rslt = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR)))
return DECLINED;
if (ap_should_client_block(r))
{
int len_read;
char argsbuffer[HUGE_STRING_LEN + 1];
char *argscumulative = NULL;
ap_hard_timeout("copy script args", r);
while ((len_read = ap_get_client_block(r, argsbuffer, HUGE_STRING_LEN)) > 0)
{
argsbuffer[len_read] = '\0';
ap_reset_timeout(r);
if (argscumulative != NULL)
argscumulative = ap_pstrcat(r->pool, argscumulative, argsbuffer, NULL);
else
argscumulative = ap_pstrdup(r->pool, argsbuffer);
}
rslt = parseargs(argscumulative, r);
if (rslt)
{
print_error(r, 1, argscumulative);
return DONE;
}
ap_kill_timeout(r);
}
send_parsed_file(r, r->filename, &(r->finfo), 1);
buffer_output = 0;
headers_printed = 0;
headers_set = 0;
content_sent = 0;
ap_kill_timeout(r);
return OK;
}
typedef struct {
char *dtcl_global_script;
char *dtcl_init_script;
char *dtcl_exit_script;
int dtcl_cache_size;
} dtcl_server_conf;
void dtcl_init_handler(server_rec *s, pool *p)
{
int rslt;
void *sconf = s->module_config;
Tcl_Channel achan;
dtcl_server_conf *dsc = (dtcl_server_conf *) ap_get_module_config(sconf, &dtcl_module);
interp = Tcl_CreateInterp();
achan = Tcl_CreateChannel(&Achan, "apacheout", NULL, TCL_WRITABLE);
Tcl_SetStdChannel(achan, TCL_STDOUT);
Tcl_SetChannelOption(interp, achan, "-buffering", "none");
Tcl_RegisterChannel(interp, achan);
if (interp == NULL)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Error in Tcl_CreateInterp, aborting\n");
exit(1);
}
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
Tcl_FindExecutable("");
#endif
if (Tcl_Init(interp) == TCL_ERROR)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, Tcl_GetStringResult(interp));
exit(1);
}
Tcl_CreateObjCommand(interp, "hputs", Hputs, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "buffer_add", Buffer_Add, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "buffered", Buffered, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "headers", Headers, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "hgetvars", HGetVars, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "include", Include, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "parse", Parse, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "hflush", HFlush, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "dtcl_info", Dtcl_Info, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
namespacePrologue = Tcl_NewStringObj("catch { namespace delete request }\n"
"namespace eval request { }", -1);
Tcl_IncrRefCount(namespacePrologue);
#if DBG
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Config string = \"%s\"", dsc->dtcl_global_script);
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Cache size = \"%d\"", dsc->dtcl_cache_size);
#endif
if (dsc->dtcl_global_script != NULL)
{
rslt = Tcl_EvalFile(interp, dsc->dtcl_global_script);
if (rslt != TCL_OK)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, "%s",
Tcl_GetVar(interp, "errorInfo", 0));
}
}
if (dsc->dtcl_cache_size != 0)
{
cacheSize = dsc->dtcl_cache_size;
cacheFreeSize = dsc->dtcl_cache_size;
} else {
cacheSize = ap_max_requests_per_child / 2;
cacheFreeSize = cacheSize;
}
objCacheList = malloc(cacheSize * sizeof(char *));
Tcl_InitHashTable(&objCache, TCL_STRING_KEYS);
ap_add_version_component("Mod_dtcl " DTCL_VERSION);
}
static const char *set_globalscript(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
dtcl_server_conf *conf = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
conf->dtcl_global_script = arg;
return NULL;
}
static const char *set_initscript(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
dtcl_server_conf *conf = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
conf->dtcl_init_script = arg;
return NULL;
}
static const char *set_exitscript(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
dtcl_server_conf *conf = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
conf->dtcl_exit_script = arg;
return NULL;
}
static const char *set_cachesize(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
dtcl_server_conf *conf = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
conf->dtcl_cache_size = strtol(arg, NULL, 10);
return NULL;
}
static void *create_dtcl_config(pool *p, server_rec *s)
{
dtcl_server_conf *dts = (dtcl_server_conf *) ap_pcalloc(p, sizeof(dtcl_server_conf));
dts->dtcl_global_script = NULL;
dts->dtcl_init_script = NULL;
dts->dtcl_exit_script = NULL;
return dts;
}
static void *merge_dtcl_config(pool *p, void *basev, void *overridesv)
{
dtcl_server_conf *base = (dtcl_server_conf *) basev, *overrides = (dtcl_server_conf *) overridesv;
return overrides->dtcl_global_script ? overrides : base;
}
static void dtcl_child_init(server_rec *s, pool *p)
{
dtcl_server_conf *dsc = (dtcl_server_conf *) ap_get_module_config(s->module_config, &dtcl_module);
if (dsc->dtcl_init_script != NULL)
if (Tcl_EvalFile(interp, dsc->dtcl_init_script) != TCL_OK)
ap_log_error(APLOG_MARK, APLOG_ERR, s,
"Problem running child init script: %s", dsc->dtcl_init_script);
}
static void dtcl_child_exit(server_rec *s, pool *p)
{
dtcl_server_conf *dsc = (dtcl_server_conf *) ap_get_module_config(s->module_config, &dtcl_module);
if (dsc->dtcl_exit_script != NULL)
if (Tcl_EvalFile(interp, dsc->dtcl_exit_script) != TCL_OK)
ap_log_error(APLOG_MARK, APLOG_ERR, s,
"Problem running child exit script: %s", dsc->dtcl_exit_script);
}
static const handler_rec dtcl_handlers[] =
{
{"application/x-httpd-tcl", send_parsed_content},
{NULL}
};
static const command_rec dtcl_cmds[] =
{
{"Dtcl_GlobalScript", set_globalscript, NULL, RSRC_CONF, TAKE1, "the name of the global configuration script"},
{"Dtcl_ChildInitScript", set_initscript, NULL, RSRC_CONF, TAKE1, "the name of the per child init configuration script"},
{"Dtcl_ChildExitScript", set_exitscript, NULL, RSRC_CONF, TAKE1, "the name of the per child exit configuration script"},
{"Dtcl_CacheSize", set_cachesize, NULL, RSRC_CONF, TAKE1, "number of ttml scripts cached"},
{NULL}
};
module MODULE_VAR_EXPORT dtcl_module =
{
STANDARD_MODULE_STUFF,
dtcl_init_handler,
NULL,
NULL,
create_dtcl_config,
merge_dtcl_config,
dtcl_cmds,
dtcl_handlers,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
dtcl_child_init,
dtcl_child_exit,
NULL
};