Initial revision
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..6c06ee3
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,59 @@
+/* ====================================================================
+ * The Apache Software License, Version 1.1
+ *
+ * Copyright (c) 2000 The Apache Software Foundation. All rights
+ * reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * 3. The end-user documentation included with the redistribution,
+ * if any, must include the following acknowledgment:
+ * "This product includes software developed by the
+ * Apache Software Foundation (http://www.apache.org/)."
+ * Alternately, this acknowledgment may appear in the software itself,
+ * if and wherever such third-party acknowledgments normally appear.
+ *
+ * 4. The names "Apache" and "Apache Software Foundation" must
+ * not be used to endorse or promote products derived from this
+ * software without prior written permission. For written
+ * permission, please contact apache@apache.org.
+ *
+ * 5. Products derived from this software may not be called "Apache",
+ * nor may "Apache" appear in their name, without prior written
+ * permission of the Apache Software Foundation.
+ *
+ * THIS SOFTWARE IS PROVIDED ``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 THE APACHE SOFTWARE FOUNDATION 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.
+ * ====================================================================
+ *
+ * This software consists of voluntary contributions made by many
+ * individuals on behalf of the Apache Software Foundation. For more
+ * information on the Apache Software Foundation, please see
+ * <http://www.apache.org/>.
+ *
+ * Portions of this software are based upon public domain software
+ * originally written at the National Center for Supercomputing Applications,
+ * University of Illinois, Urbana-Champaign.
+ */
+
+
diff --git a/Makefile.in b/Makefile.in
new file mode 100644
index 0000000..167b343
--- /dev/null
+++ b/Makefile.in
@@ -0,0 +1,3 @@
+
+include $(top_srcdir)/build/special.mk
+
diff --git a/README b/README
new file mode 100644
index 0000000..2a541a4
--- /dev/null
+++ b/README
@@ -0,0 +1,3 @@
+mod_tcl for Apache 2.0
+
+Please see http://www.fractal.net/ for documentation.
diff --git a/config.m4 b/config.m4
new file mode 100644
index 0000000..c0fe7b4
--- /dev/null
+++ b/config.m4
@@ -0,0 +1,48 @@
+dnl modules enabled in this directory by default
+
+APACHE_MODPATH_INIT(mod_tcl)
+
+APACHE_MODULE(tcl, embedded tcl interpreter, tcl_core.lo tcl_cmds.lo tcl_misc.lo, , yes)
+
+if test "$enable_tcl" = "yes"; then
+ AC_CHECK_HEADERS(tcl.h inttypes.h int_types.h)
+ AC_CHECK_FUNCS(asprintf)
+
+ dirs="/usr/local/lib /usr/lib"
+
+ found=0
+
+ for directory in $dirs ; do
+ AC_MSG_CHECKING(for tclConfig.sh in $directory)
+
+ if test -f "$directory/tclConfig.sh" ; then
+ tnm_cv_path_tcl_config=$directory
+ found=1
+
+ AC_MSG_RESULT(yes)
+
+ break
+ else
+ AC_MSG_RESULT(no)
+ fi
+ done
+
+ if test "$found" -eq 0 ; then
+ AC_MSG_ERROR([tclConfig.sh not found])
+ fi
+
+ . $tnm_cv_path_tcl_config/tclConfig.sh
+
+ AC_MSG_CHECKING(for tcl version)
+ AC_MSG_RESULT("$TCL_VERSION")
+
+ if test 8 -gt $TCL_MAJOR_VERSION; then
+ AC_MSG_ERROR("tcl 8.0 or later needed")
+ fi
+
+ LIBS="$LIBS -L$tnm_cv_path_tcl_config -ltcl$TCL_VERSION"
+ INCLUDES="$INCLUDES -I$TCL_PREFIX/include"
+ LDFLAGS="$LDFLAGS $TCL_LD_FLAGS"
+fi
+
+APACHE_MODPATH_FINISH
diff --git a/mod_tcl.h b/mod_tcl.h
new file mode 100644
index 0000000..7e1d3e6
--- /dev/null
+++ b/mod_tcl.h
@@ -0,0 +1,147 @@
+/* ====================================================================
+ * The Apache Software License, Version 1.1
+ *
+ * Copyright (c) 2000 The Apache Software Foundation. All rights
+ * reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * 3. The end-user documentation included with the redistribution,
+ * if any, must include the following acknowledgment:
+ * "This product includes software developed by the
+ * Apache Software Foundation (http://www.apache.org/)."
+ * Alternately, this acknowledgment may appear in the software itself,
+ * if and wherever such third-party acknowledgments normally appear.
+ *
+ * 4. The names "Apache" and "Apache Software Foundation" must
+ * not be used to endorse or promote products derived from this
+ * software without prior written permission. For written
+ * permission, please contact apache@apache.org.
+ *
+ * 5. Products derived from this software may not be called "Apache",
+ * nor may "Apache" appear in their name, without prior written
+ * permission of the Apache Software Foundation.
+ *
+ * THIS SOFTWARE IS PROVIDED ``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 THE APACHE SOFTWARE FOUNDATION 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.
+ * ====================================================================
+ *
+ * This software consists of voluntary contributions made by many
+ * individuals on behalf of the Apache Software Foundation. For more
+ * information on the Apache Software Foundation, please see
+ * <http://www.apache.org/>.
+ *
+ * Portions of this software are based upon public domain software
+ * originally written at the National Center for Supercomputing Applications,
+ * University of Illinois, Urbana-Champaign.
+ */
+
+#ifndef __MOD_TCL_H__
+#define __MOD_TCL_H__
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <unistd.h>
+#include <errno.h>
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <sys/mman.h>
+#include <fcntl.h>
+
+#ifdef HAVE_INTTYPES_H
+#include <inttypes.h>
+#endif /* HAVE_INTTYPES_H */
+
+#ifdef HAVE_INT_TYPES_H
+#include <int_types.h>
+#endif /* HAVE_INT_TYPES_H */
+
+#include "apr.h"
+#include "apr_strings.h"
+#include "apr_lib.h"
+
+#include "ap_config.h"
+#include "httpd.h"
+#include "http_config.h"
+#include "http_core.h"
+#include "http_log.h"
+#include "http_main.h"
+#include "http_protocol.h"
+#include "http_request.h"
+#include "util_script.h"
+
+#include "ap_config_auto.h"
+
+#ifndef HAVE_TCL_H
+#error "uhh, no tcl.h found"
+#endif /* HAVE_TCL_H */
+
+#include <tcl.h>
+
+#ifndef HAVE_ASPRINTF
+int int_vasprintf(char **result, const char *format, va_list *args);
+int vasprintf(char **result, const char *format, va_list args);
+int asprintf(char **result, const char *format, ...);
+#endif /* HAVE_ASPRINTF */
+
+void run_script(Tcl_Interp *interp, char *fmt, ...);
+void set_var(Tcl_Interp *interp, const char *var1, const char *var2, const char *fmt, ...);
+void set_var2(Tcl_Interp *interp, const char *var1, const char *var2, const char *data, int len);
+
+int cmd_rputs(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_rwrite(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_send_http_header(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_r(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_r_set(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_read_post(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_server_version(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_create_environment(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_abort(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_internal_redirect(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_random(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_srandom(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_base64_encode(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_base64_decode(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_allow_options(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_allow_overrides(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_default_type(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_document_root(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_remote_host(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_remote_logname(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_construct_url(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_server_name(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_server_port(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_limit_req_body(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_limit_xml_body(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_custom_response(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_exists_config_define(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_auth_type(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_auth_name(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_satisfies(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_requires(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+
+#endif /* __MOD_TCL_H__ */
diff --git a/modules.mk b/modules.mk
new file mode 100644
index 0000000..80183ae
--- /dev/null
+++ b/modules.mk
@@ -0,0 +1,4 @@
+libapachemod_tcl.la: tcl_core.lo tcl_cmds.lo tcl_misc.lo
+ $(LINK) tcl_core.lo tcl_cmds.lo tcl_misc.lo
+static = libapachemod_tcl.la
+shared =
diff --git a/tcl_cmds.c b/tcl_cmds.c
new file mode 100644
index 0000000..43def46
--- /dev/null
+++ b/tcl_cmds.c
@@ -0,0 +1,897 @@
+/* ====================================================================
+ * The Apache Software License, Version 1.1
+ *
+ * Copyright (c) 2000 The Apache Software Foundation. All rights
+ * reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * 3. The end-user documentation included with the redistribution,
+ * if any, must include the following acknowledgment:
+ * "This product includes software developed by the
+ * Apache Software Foundation (http://www.apache.org/)."
+ * Alternately, this acknowledgment may appear in the software itself,
+ * if and wherever such third-party acknowledgments normally appear.
+ *
+ * 4. The names "Apache" and "Apache Software Foundation" must
+ * not be used to endorse or promote products derived from this
+ * software without prior written permission. For written
+ * permission, please contact apache@apache.org.
+ *
+ * 5. Products derived from this software may not be called "Apache",
+ * nor may "Apache" appear in their name, without prior written
+ * permission of the Apache Software Foundation.
+ *
+ * THIS SOFTWARE IS PROVIDED ``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 THE APACHE SOFTWARE FOUNDATION 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.
+ * ====================================================================
+ *
+ * This software consists of voluntary contributions made by many
+ * individuals on behalf of the Apache Software Foundation. For more
+ * information on the Apache Software Foundation, please see
+ * <http://www.apache.org/>.
+ *
+ * Portions of this software are based upon public domain software
+ * originally written at the National Center for Supercomputing Applications,
+ * University of Illinois, Urbana-Champaign.
+ */
+
+#include "mod_tcl.h"
+
+extern Tcl_Interp *interp;
+extern apr_array_header_t *fcache;
+extern request_rec *_r;
+extern char *current_namespace;
+extern int read_post_ok;
+
+const uint8_t base64[] = {
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+};
+
+const uint8_t inv_base64[128] =
+{
+ 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 255, 255, 255, 255, 255,
+ 255, 255, 255, 62, 255, 255, 255, 63,
+ 52, 53, 54, 55, 56, 57, 58, 59,
+ 60, 61, 255, 255, 255, 255, 255, 255,
+ 255, 0, 1, 2, 3, 4, 5, 6,
+ 7, 8, 9, 10, 11, 12, 13, 14,
+ 15, 16, 17, 18, 19, 20, 21, 22,
+ 23, 24, 25, 255, 255, 255, 255, 255,
+ 255, 26, 27, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, 40,
+ 41, 42, 43, 44, 45, 46, 47, 48,
+ 49, 50, 51, 255, 255, 255, 255, 255,
+};
+
+static size_t is_base64_buf(uint8_t *buf, size_t buf_len)
+{
+ size_t i;
+
+ for (i = 0; i < buf_len; i++) {
+ /* Accept equal sign. */
+ if (buf[i] == '=') {
+ continue;
+ }
+ /* Don't accept anything else which isn't in base64. */
+ if (buf[i] > 127) {
+ break;
+ }
+
+ if (inv_base64[buf[i]] == 255) {
+ break;
+ }
+ }
+
+ return i;
+}
+
+static uint8_t* buf_to_base64(const uint8_t *buf, size_t buf_len)
+{
+ uint8_t *out;
+ size_t i, j;
+ uint32_t limb;
+
+ out = (uint8_t*) malloc(((buf_len * 8 + 5) / 6) + 5);
+
+ for (i = 0, j = 0, limb = 0; i + 2 < buf_len; i += 3, j += 4) {
+ limb =
+ ((uint32_t) buf[i] << 16) |
+ ((uint32_t) buf[i + 1] << 8) |
+ ((uint32_t) buf[i + 2]);
+
+ out[j] = base64[(limb >> 18) & 63];
+ out[j + 1] = base64[(limb >> 12) & 63];
+ out[j + 2] = base64[(limb >> 6) & 63];
+ out[j + 3] = base64[(limb) & 63];
+ }
+
+ switch (buf_len - i) {
+ case 0:
+ break;
+ case 1:
+ limb = ((uint32_t) buf[i]);
+ out[j++] = base64[(limb >> 2) & 63];
+ out[j++] = base64[(limb << 4) & 63];
+ out[j++] = '=';
+ out[j++] = '=';
+ break;
+ case 2:
+ limb = ((uint32_t) buf[i] << 8) | ((uint32_t) buf[i + 1]);
+ out[j++] = base64[(limb >> 10) & 63];
+ out[j++] = base64[(limb >> 4) & 63];
+ out[j++] = base64[(limb << 2) & 63];
+ out[j++] = '=';
+ break;
+ default:
+ // something wonkey happened...
+ break;
+ }
+
+ out[j] = '\0';
+
+ return out;
+}
+
+static uint8_t* base64_to_buf(uint8_t *str, size_t *buf_len)
+{
+ uint8_t *buf;
+ int i, j, len;
+ uint32_t limb;
+
+ len = strlen((char *) str);
+ *buf_len = (len * 6 + 7) / 8;
+ buf = (uint8_t*) malloc(*buf_len);
+
+ for (i = 0, j = 0, limb = 0; i + 3 < len; i += 4) {
+ if (str[i] == '=' || str[i + 1] == '=' || str[i + 2] == '=' || str[i + 3] == '=') {
+ if (str[i] == '=' || str[i + 1] == '=') {
+ break;
+ }
+
+ if (str[i + 2] == '=') {
+ limb =
+ ((uint32_t) inv_base64[str[i]] << 6) |
+ ((uint32_t) inv_base64[str[i + 1]]);
+ buf[j] = (uint8_t) (limb >> 4) & 0xff;
+ j++;
+ }
+ else {
+ limb =
+ ((uint32_t) inv_base64[str[i]] << 12) |
+ ((uint32_t) inv_base64[str[i + 1]] << 6) |
+ ((uint32_t) inv_base64[str[i + 2]]);
+ buf[j] = (uint8_t) (limb >> 10) & 0xff;
+ buf[j + 1] = (uint8_t) (limb >> 2) & 0xff;
+ j += 2;
+ }
+ }
+ else {
+ limb =
+ ((uint32_t) inv_base64[str[i]] << 18) |
+ ((uint32_t) inv_base64[str[i + 1]] << 12) |
+ ((uint32_t) inv_base64[str[i + 2]] << 6) |
+ ((uint32_t) inv_base64[str[i + 3]]);
+
+ buf[j] = (uint8_t) (limb >> 16) & 0xff;
+ buf[j + 1] = (uint8_t) (limb >> 8) & 0xff;
+ buf[j + 2] = (uint8_t) (limb) & 0xff;
+ j += 3;
+ }
+ }
+
+ *buf_len = j;
+
+ return buf;
+}
+
+static uint8_t* base64_remove_whitespace(const uint8_t *str, size_t len)
+{
+ uint8_t *cp;
+ size_t i, j;
+
+ if (len == 0) {
+ len = strlen((char *) str);
+ }
+
+ cp = (uint8_t*) malloc(len + 1);
+
+ for (i = 0, j = 0; i < len; i++) {
+ if (!(str[i] & 128)) {
+ if (inv_base64[str[i]] != 255 || str[i] == '=') {
+ cp[j++] = str[i];
+ }
+ }
+ }
+
+ cp[j] = '\0';
+
+ return cp;
+}
+
+static char* mstrstr(char *haystack, char *needle, size_t n, size_t m)
+{
+ size_t i;
+
+ if (m >= n) {
+ if (!memcmp(haystack, needle, n)) {
+ return haystack;
+ }
+ else {
+ return NULL;
+ }
+ }
+
+ for (i = 0; (i + m) < n; i++, haystack++) {
+ if (!memcmp(haystack, needle, m)) {
+ return haystack;
+ }
+ }
+
+ return NULL;
+}
+
+static int read_post_data(request_rec *r, Tcl_Interp *interp, char *boundary)
+{
+ int rc, lpos = 0, blen = strlen(boundary);
+ char *lbuf, *ptr;
+ long remaining;
+
+ if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR)) != OK) {
+ return rc;
+ }
+
+ remaining = r->remaining;
+ lbuf = (char*) apr_palloc(r->pool, remaining + 1);
+
+ if (ap_should_client_block(r)) {
+ char buf[HUGE_STRING_LEN];
+ int len_read;
+
+// ap_hard_timeout("read_post_data", r);
+
+ while ((len_read = ap_get_client_block(r, buf, sizeof(buf))) > 0) {
+// ap_reset_timeout(r);
+
+ memcpy(lbuf + lpos, buf, len_read);
+ lpos += len_read;
+ }
+
+ lbuf[lpos] = '\0';
+
+// ap_kill_timeout(r);
+ }
+
+ ptr = strstr(lbuf, boundary);
+ remaining -= (ptr - lbuf - sizeof(char*));
+ lbuf = ptr;
+
+ while (1) {
+ int i, vlen;
+ char *key, *val, *filename, *eptr;
+
+ if (!ptr) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "read_post_data(...): bad boundry condition in multipart/form-data");
+ return DECLINED;
+ }
+
+ if ((*(ptr + blen + 1) == '-') && (*(ptr + blen + 1) == '-')) {
+ return OK;
+ }
+
+ lbuf += (blen + 2);
+ remaining -= (blen + 2);
+
+ eptr = strstr(lbuf, "\r\n\r\n");
+
+ if (!eptr) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "read_post_data(...): bad headers in multipart/form-data");
+ return DECLINED;
+ }
+
+ ptr = lbuf;
+
+ memset(eptr + 2, 0, 2);
+ remaining -= (eptr - lbuf - sizeof(char*));
+ lbuf = eptr + 4;
+
+ while (*ptr) {
+ char *xptr = ap_getword(r->pool, (const char**) &ptr, ' ');
+
+ if (!strcmp("Content-Disposition:", xptr)) {
+ xptr = strstr(ptr, "name=");
+
+ if (!xptr) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "read_post_data(...): bad `Content-Disposition:' header");
+ return DECLINED;
+ }
+
+ xptr += 6;
+
+ for (i = 0; xptr[i] != '"'; i++) {
+ ;
+ }
+
+ key = (char*) apr_palloc(r->pool, i + 1);
+
+ memcpy(key, xptr, i);
+ key[i] = '\0';
+
+ xptr = strstr(ptr, "filename=");
+
+ if (xptr) {
+ char *file_key, *file_val;
+
+ xptr += 10;
+
+ for (i = 0; xptr[i] != '"'; i++) {
+ ;
+ }
+
+ file_val = (char*) apr_palloc(r->pool, i + 1);
+
+ memcpy(file_val, xptr, i);
+ file_val[i] = '\0';
+
+ file_key = apr_psprintf(r->pool, "%s_filename", key);
+
+ set_var2(interp, "::pram", file_key, file_val, i);
+ }
+
+ break;
+ }
+
+ ptr = strstr(ptr, "\r\n");
+ ptr += 2;
+ }
+
+ ptr = mstrstr(lbuf, boundary, remaining, blen);
+
+ vlen = (ptr - lbuf) - sizeof(char*);
+
+ if (vlen <= 0) {
+ val = (char*) malloc(1);
+ val[0] = '\0';
+ vlen = 0;
+ }
+ else {
+ val = (char*) malloc(vlen + 1);
+
+ memcpy(val, lbuf, vlen);
+ val[vlen] = '\0';
+ }
+
+ set_var2(interp, "::pram", key, val, vlen);
+
+ free(val);
+
+ lbuf = ptr;
+ remaining -= vlen;
+ }
+
+ return DECLINED;
+}
+
+static int read_post(request_rec *r, Tcl_Interp *interp)
+{
+ int rc;
+ const char *val, *key;
+ char *rbuf;
+
+ if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR)) != OK) {
+ return rc;
+ }
+
+ if (ap_should_client_block(r)) {
+ char buf[HUGE_STRING_LEN];
+ int rsize, len_read, rpos = 0;
+ long length = r->remaining;
+
+ rbuf = (char*) apr_pcalloc(r->pool, length + 1);
+
+// ap_hard_timeout("read_post", r);
+
+ while ((len_read = ap_get_client_block(r, buf, sizeof(buf))) > 0) {
+// ap_reset_timeout(r);
+
+ if ((rpos + len_read) > length) {
+ rsize = length - rpos;
+ }
+ else {
+ rsize = len_read;
+ }
+
+ memcpy(rbuf + rpos, buf, rsize);
+ rpos += rsize;
+ }
+
+// ap_kill_timeout(r);
+ }
+
+// ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r->server, 0, "read_post(...): %u, rbuf = %s", getpid(), rbuf);
+
+ while (rbuf && *rbuf && (val = ap_getword(r->pool, (const char**) &rbuf, '&'))) {
+ key = ap_getword(r->pool, &val, '=');
+
+ ap_unescape_url((char*) key);
+ ap_unescape_url((char*) val);
+
+ if (!key || !val) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "read_post(...): invalid key or value, key = %s, val = %s", key, val);
+ break;
+ }
+
+ set_var(interp, "::pram", key, val);
+ }
+
+ return OK;
+}
+
+static int read_post_init(request_rec *r, Tcl_Interp *interp)
+{
+ const char *type = apr_table_get(r->headers_in, "Content-Type");
+ char *boundary;
+
+ if (read_post_ok) {
+ read_post_ok = 0;
+ }
+ else {
+ /* already read */
+ return OK;
+ }
+
+ if (!strcmp(type, "application/x-www-form-urlencoded")) {
+ return read_post(r, interp);
+ }
+ else if (strstr(type, "multipart/form-data")) {
+ boundary = strstr(type, "boundary=");
+
+ if (!boundary) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "read_post_init(...): no boundry in multipart/form-data");
+ return DECLINED;
+ }
+
+ boundary += 9;
+
+ return read_post_data(r, interp, boundary);
+ }
+ else {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "read_post_init(...): unknown, Content-Type: %s", type);
+
+ return DECLINED;
+ }
+}
+
+int cmd_rputs(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ char *opt = NULL, *data;
+
+ switch (objc) {
+ case 3:
+ opt = Tcl_GetString(objv[1]);
+ data = Tcl_GetString(objv[2]);
+ break;
+ case 2:
+ data = Tcl_GetString(objv[1]);
+ break;
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? string");
+ return TCL_ERROR;
+ }
+
+ if (opt && strcmp(opt, "-nonewline")) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? string");
+ return TCL_ERROR;
+ }
+
+ ap_rprintf(_r, "%s%s", data, opt ? "" : "\n");
+
+ return TCL_OK;
+}
+
+int cmd_rwrite(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ char *data = NULL;
+ int length;
+
+ switch (objc) {
+ case 2:
+ data = (char*) Tcl_GetByteArrayFromObj(objv[1], &length);
+ break;
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_ERROR;
+ }
+
+ ap_rwrite(data, length, _r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_send_http_header(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_Obj *obj;
+
+ obj = Tcl_GetVar2Ex(ixx, "content_type", NULL, 0);
+
+ if (obj) {
+ _r->content_type = Tcl_GetString(obj);
+ }
+
+ ap_send_http_header(_r);
+
+ return TCL_OK;
+}
+
+static int set_headers_in(void *data, const char *key, const char *val)
+{
+ Tcl_Interp *interp = (Tcl_Interp*) data;
+
+ set_var(interp, "headers_in", key, val);
+
+ return 1;
+}
+
+int cmd_r(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "variable");
+ return TCL_ERROR;
+ }
+
+ if (!strcmp("method_number", Tcl_GetString(objv[1]))) {
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(_r->method_number));
+ }
+ else if (!strcmp("uri", Tcl_GetString(objv[1]))) {
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(_r->uri, -1));
+ }
+ else if (!strcmp("headers_in", Tcl_GetString(objv[1]))) {
+ apr_table_do(set_headers_in, ixx, _r->headers_in, NULL);
+ run_script(ixx, "array names headers_in");
+ }
+
+ return TCL_OK;
+}
+
+int cmd_r_set(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "variable ?variables?");
+ return TCL_ERROR;
+ }
+
+ if (!strcmp("content_type", Tcl_GetString(objv[1]))) {
+ _r->content_type = Tcl_GetString(objv[2]);
+ }
+ else if (!strcmp("headers_out", Tcl_GetString(objv[1]))) {
+ if (objc != 4) {
+ return TCL_ERROR;
+ }
+
+ apr_table_set(_r->headers_out, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
+ }
+
+ return TCL_OK;
+}
+
+int cmd_read_post(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (read_post_init(_r, ixx) != OK) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, _r->server, "cmd_read_post(...): read failed");
+ Tcl_AddErrorInfo(ixx, "read failed");
+
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_server_version(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_get_server_version(), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_create_environment(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ char **env;
+ int i;
+
+ ap_add_cgi_vars(_r);
+ ap_add_common_vars(_r);
+
+ env = ap_create_environment(_r->pool, _r->subprocess_env);
+
+ for (i = 0; env[i]; i++) {
+ char *sptr = strchr(env[i], '=');
+
+ *sptr = '\0';
+ set_var(ixx, "::env", env[i], sptr + 1);
+ *sptr = '=';
+ }
+
+ return TCL_OK;
+}
+
+int cmd_abort(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc == 2) {
+ Tcl_AddObjErrorInfo(ixx, Tcl_GetString(objv[1]), -1);
+ }
+
+ return TCL_ERROR;
+}
+
+int cmd_ap_internal_redirect(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "uri");
+
+ return TCL_ERROR;
+ }
+
+ ap_internal_redirect(Tcl_GetString(objv[1]), _r);
+
+ return TCL_OK;
+}
+
+int cmd_random(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(random()));
+
+ return TCL_OK;
+}
+
+int cmd_srandom(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "integer");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &i);
+ srandom((unsigned int) i);
+
+ return TCL_OK;
+}
+
+int cmd_base64_encode(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ uint8_t *data, *enc_data;
+ int length;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+
+ return TCL_ERROR;
+ }
+
+ data = Tcl_GetByteArrayFromObj(objv[1], &length);
+ enc_data = buf_to_base64(data, length);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((char*) enc_data, -1));
+
+ free(enc_data);
+
+ return TCL_OK;
+}
+
+int cmd_base64_decode(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ uint8_t *enc_data, *ws_data, *data;
+ size_t length;
+ Tcl_Obj *obj;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
+
+ return TCL_ERROR;
+ }
+
+ enc_data = (uint8_t*) Tcl_GetString(objv[1]);
+ ws_data = base64_remove_whitespace(enc_data, 0);
+ data = base64_to_buf(data, &length);
+
+ obj = Tcl_NewObj();
+ Tcl_SetByteArrayObj(obj, (unsigned char*) data, length);
+
+ free(ws_data);
+ free(data);
+
+ return TCL_OK;
+}
+
+int cmd_ap_allow_options(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_allow_options(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_allow_overrides(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_allow_overrides(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_default_type(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_default_type(_r), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_document_root(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_document_root(_r), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_remote_host(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &i);
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_get_remote_host(_r->connection, _r->per_dir_config, i), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_remote_logname(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_get_remote_logname(_r), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_construct_url(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "uri");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_construct_url(_r->pool, Tcl_GetString(objv[1]), _r), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_server_name(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_get_server_name(_r), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_server_port(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ /* int should suffice since ports are usually unsigned short */
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_get_server_port(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_limit_req_body(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ /* ap_get_limit_req_body returns an unsigned long, its possible it could overflow in TCL
+ as it doesn't appear to have any unsigned support... it might be possible to assign it
+ to a double?
+ */
+ Tcl_SetObjResult(ixx, Tcl_NewLongObj(ap_get_limit_req_body(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_limit_xml_body(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_get_limit_xml_body(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_custom_response(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int i;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "status string");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &i);
+ ap_custom_response(_r, i, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+int cmd_ap_exists_config_define(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_exists_config_define(Tcl_GetString(objv[1]))));
+
+ return TCL_OK;
+}
+
+int cmd_ap_auth_type(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_auth_type(_r), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_auth_name(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_auth_name(_r), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_satisfies(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_satisfies(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_requires(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int i;
+ const apr_array_header_t *a = ap_requires(_r);
+ require_line *ra = (require_line*) a->elts;
+ Tcl_Obj *obj = Tcl_NewObj();
+
+ for (i = 0; i < a->nelts; i++) {
+ Tcl_Obj *xobj = Tcl_NewObj();
+
+ Tcl_ListObjAppendElement(ixx, xobj, Tcl_NewIntObj(ra[i].method_mask));
+ Tcl_ListObjAppendElement(ixx, xobj, Tcl_NewStringObj(ra[i].requirement, -1));
+
+ Tcl_ListObjAppendElement(ixx, obj, xobj);
+ }
+
+ Tcl_SetObjResult(ixx, obj);
+
+ return TCL_OK;
+}
diff --git a/tcl_core.c b/tcl_core.c
new file mode 100644
index 0000000..e9575e3
--- /dev/null
+++ b/tcl_core.c
@@ -0,0 +1,633 @@
+/* ====================================================================
+ * The Apache Software License, Version 1.1
+ *
+ * Copyright (c) 2000 The Apache Software Foundation. All rights
+ * reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * 3. The end-user documentation included with the redistribution,
+ * if any, must include the following acknowledgment:
+ * "This product includes software developed by the
+ * Apache Software Foundation (http://www.apache.org/)."
+ * Alternately, this acknowledgment may appear in the software itself,
+ * if and wherever such third-party acknowledgments normally appear.
+ *
+ * 4. The names "Apache" and "Apache Software Foundation" must
+ * not be used to endorse or promote products derived from this
+ * software without prior written permission. For written
+ * permission, please contact apache@apache.org.
+ *
+ * 5. Products derived from this software may not be called "Apache",
+ * nor may "Apache" appear in their name, without prior written
+ * permission of the Apache Software Foundation.
+ *
+ * THIS SOFTWARE IS PROVIDED ``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 THE APACHE SOFTWARE FOUNDATION 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.
+ * ====================================================================
+ *
+ * This software consists of voluntary contributions made by many
+ * individuals on behalf of the Apache Software Foundation. For more
+ * information on the Apache Software Foundation, please see
+ * <http://www.apache.org/>.
+ *
+ * Portions of this software are based upon public domain software
+ * originally written at the National Center for Supercomputing Applications,
+ * University of Illinois, Urbana-Champaign.
+ */
+
+#include "mod_tcl.h"
+
+static void tcl_init(apr_pool_t *pconf, apr_pool_t *plog, apr_pool_t *ptemp);
+static apr_status_t tcl_cleanup(void *data);
+static void tcl_init_handler(apr_pool_t *pconf, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s);
+static void* tcl_create_dir_config(apr_pool_t *p, char *d);
+
+/* 0 */ static int tcl_handler(request_rec *r);
+/* 1 */ static int tcl_post_read_request(request_rec *r);
+/* 2 */ static int tcl_translate_name(request_rec *r);
+/* 3 */ static int tcl_header_parser(request_rec *r);
+/* 4 */ static int tcl_access_checker(request_rec *r);
+/* 5 */ static int tcl_check_user_id(request_rec *r);
+/* 6 */ static int tcl_auth_checker(request_rec *r);
+/* 7 */ static int tcl_type_checker(request_rec *r);
+/* 8 */ static int tcl_fixups(request_rec *r);
+/* 9 */ static int tcl_log_transaction(request_rec *r);
+
+static const char* add_hand(cmd_parms *parms, void *mconfig, const char *arg);
+static const char* sfl(cmd_parms *parms, void *mconfig, int flag);
+static const char* tcl_set(cmd_parms *parms, void *mconfig, const char *one, const char *two, const char *three);
+static const char* tcl_setlist(cmd_parms *parms, void *mconfig, const char *one, const char *two);
+
+typedef const char* (*fz_t)(void);
+
+#define NUM_HANDLERS 10
+
+static const command_rec tcl_commands[] = {
+ AP_INIT_FLAG( "Tcl", (fz_t) sfl, (void*) 1, OR_AUTHCFG, "turn mod_tcl on or off." ),
+ AP_INIT_TAKE23( "Tcl_Var", (fz_t) tcl_set, NULL, OR_AUTHCFG, "set global variables in TCL." ),
+ AP_INIT_TAKE2( "Tcl_ListVar", (fz_t) tcl_setlist, NULL, OR_AUTHCFG, "set global list variables." ),
+ AP_INIT_TAKE1( "Tcl_ContentHandlers", (fz_t) add_hand, (void*) 0, OR_AUTHCFG, "add content handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Post_Read_Request", (fz_t) add_hand, (void*) 1, OR_AUTHCFG, "add post_read_request handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Translate_Name", (fz_t) add_hand, (void*) 2, OR_AUTHCFG, "add translate_name handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Header_Parser", (fz_t) add_hand, (void*) 3, OR_AUTHCFG, "add header_parser handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Access_Checker", (fz_t) add_hand, (void*) 4, OR_AUTHCFG, "add access_checker handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Check_User_ID", (fz_t) add_hand, (void*) 5, OR_AUTHCFG, "add check_user_id handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Auth_Checker", (fz_t) add_hand, (void*) 6, OR_AUTHCFG, "add auth_checker handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Type_Checker", (fz_t) add_hand, (void*) 7, OR_AUTHCFG, "add type_checker handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Fixups", (fz_t) add_hand, (void*) 8, OR_AUTHCFG, "add fixups handlers." ),
+ AP_INIT_TAKE1( "Tcl_Hook_Log_Transaction", (fz_t) add_hand, (void*) 9, OR_AUTHCFG, "add log_transaction handlers." ),
+ { NULL }
+};
+
+static handler_rec tcl_handlers[] = {
+ { "tcl-handler", tcl_handler },
+ { NULL, NULL }
+};
+
+static void register_hooks(void)
+{
+ ap_hook_pre_config(tcl_init, NULL, NULL, AP_HOOK_REALLY_FIRST);
+ ap_hook_post_config(tcl_init_handler, NULL, NULL, AP_HOOK_MIDDLE);
+/*
+ ap_hook_post_read_request(tcl_post_read_request, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_translate_name(tcl_translate_name, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_header_parser(tcl_header_parser, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_access_checker(tcl_access_checker, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_check_user_id(tcl_check_user_id, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_auth_checker(tcl_auth_checker, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_type_checker(tcl_type_checker, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_fixups(tcl_fixups, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_log_transaction(tcl_log_transaction, NULL, NULL, AP_HOOK_MIDDLE);
+*/
+}
+
+AP_DECLARE_DATA module tcl_module = {
+ STANDARD20_MODULE_STUFF,
+ tcl_create_dir_config, /* create per-directory config structure */
+ NULL, /* merge per-directory config structures */
+ NULL, /* create per-server config structure */
+ NULL, /* merge per-server config structures */
+ tcl_commands, /* command apr_table_t */
+ tcl_handlers, /* handlers */
+ register_hooks /* register hooks */
+};
+
+typedef struct {
+ char *var1, *var2, *var3;
+ int fl;
+} var_cache;
+
+typedef struct {
+ int fl;
+ char *handlers[NUM_HANDLERS];
+ apr_array_header_t *var_list;
+} tcl_config_rec;
+
+static void* tcl_create_dir_config(apr_pool_t *p, char *d)
+{
+ int i;
+ tcl_config_rec *tclr = (tcl_config_rec*) apr_pcalloc(p, sizeof(tcl_config_rec));
+
+ tclr->fl = 0;
+ tclr->var_list = apr_make_array(p, 0, sizeof(var_cache));
+
+ for (i = 0; i < NUM_HANDLERS; i++) {
+ tclr->handlers[i] = NULL;
+ }
+
+ return tclr;
+}
+
+static const char* add_hand(cmd_parms *parms, void *mconfig, const char* arg)
+{
+ int pos = (int) parms->info;
+ tcl_config_rec *tclr = (tcl_config_rec*) mconfig;
+
+ tclr->handlers[pos] = apr_pstrdup(parms->pool, arg);
+
+ return NULL;
+}
+
+static const char* sfl(cmd_parms *parms, void *mconfig, int flag)
+{
+ int f = (int) parms->info;
+ tcl_config_rec *tclr = (tcl_config_rec*) mconfig;
+
+ if (flag) {
+ tclr->fl |= f;
+ }
+ else {
+ tclr->fl &= ~f;
+ }
+
+ return NULL;
+}
+
+static const char* tcl_set(cmd_parms *parms, void *mconfig, const char *one, const char *two, const char *three)
+{
+ tcl_config_rec *tclr = (tcl_config_rec*) mconfig;
+ char *ptr2, *ptr3;
+ var_cache *var = (var_cache*) apr_push_array(tclr->var_list);
+
+ if (three == NULL) {
+ ptr2 = NULL;
+ ptr3 = (char*) two;
+ }
+ else {
+ ptr2 = (char*) two;
+ ptr3 = (char*) three;
+ }
+
+ var->var1 = apr_pstrdup(parms->pool, one);
+ var->var2 = apr_pstrdup(parms->pool, ptr2);
+ var->var3 = apr_pstrdup(parms->pool, ptr3);
+
+ var->fl = 1;
+
+ return NULL;
+}
+
+static const char* tcl_setlist(cmd_parms *parms, void *mconfig, const char *one, const char *two)
+{
+ tcl_config_rec *tclr = (tcl_config_rec*) mconfig;
+ var_cache *var = (var_cache*) apr_push_array(tclr->var_list);
+
+ var->var1 = apr_pstrdup(parms->pool, one);
+ var->var2 = apr_pstrdup(parms->pool, two);
+
+ var->fl = 2;
+
+ return NULL;
+}
+
+void run_script(Tcl_Interp* interp, char *fmt, ...)
+{
+ char *bptr = NULL;
+ va_list va;
+ Tcl_Obj *obj;
+
+ va_start(va, fmt);
+ vasprintf(&bptr, fmt, va);
+ va_end(va);
+
+ obj = Tcl_NewStringObj(bptr, -1);
+
+ if (Tcl_EvalObjEx(interp, obj, 0) == TCL_ERROR) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL, "Tcl_EvalObjEx(%s): %s", bptr, Tcl_GetStringResult(interp));
+ }
+
+ free(bptr);
+}
+
+void set_var(Tcl_Interp* interp, const char *var1, const char *var2, const char *fmt, ...)
+{
+ char *bptr;
+ va_list va;
+ Tcl_Obj *obj;
+
+ va_start(va, fmt);
+ vasprintf(&bptr, fmt, va);
+ va_end(va);
+
+ obj = Tcl_NewStringObj(bptr, -1);
+
+ if (Tcl_SetVar2Ex(interp, (char*) var1, (char*) var2, obj, TCL_LEAVE_ERR_MSG) == NULL) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL, "Tcl_SetVarEx2(%s, %s, %s): %s", var1, var2 ? var2 : "NULL", bptr, Tcl_GetStringResult(interp));
+ }
+
+ free(bptr);
+}
+
+void set_var2(Tcl_Interp* interp, const char *var1, const char *var2, const char *data, int len)
+{
+ Tcl_Obj *obj;
+
+ obj = Tcl_NewByteArrayObj((unsigned char*) data, len);
+
+ if (Tcl_SetVar2Ex(interp, (char*) var1, (char*) var2, obj, TCL_LEAVE_ERR_MSG) == NULL) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL, "Tcl_SetVarEx2(%s, %s, %s): %s", var1, var2 ? var2 : "NULL", "*data*", Tcl_GetStringResult(interp));
+ }
+}
+
+typedef struct {
+ char *file;
+ struct stat st;
+} file_cache;
+
+Tcl_Interp *interp = NULL;
+apr_array_header_t *fcache = NULL;
+request_rec *_r = NULL;
+char *current_namespace = NULL;
+int read_post_ok;
+
+static void tcl_init(apr_pool_t *pconf, apr_pool_t *plog, apr_pool_t *ptemp)
+{
+ fcache = apr_make_array(pconf, 0, sizeof(file_cache));
+
+ interp = Tcl_CreateInterp();
+
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL, "Tcl_Init(0x%x): %s", interp, Tcl_GetStringResult(interp));
+ exit(1);
+ }
+
+ apr_register_cleanup(pconf, NULL, tcl_cleanup, apr_null_cleanup);
+
+ set_var(interp, "BAD_REQUEST", NULL, "%d", HTTP_BAD_REQUEST);
+ set_var(interp, "DECLINED", NULL, "%d", DECLINED);
+ set_var(interp, "DONE", NULL, "%d", DONE);
+ set_var(interp, "NOT_FOUND", NULL, "%d", HTTP_NOT_FOUND);
+ set_var(interp, "OK", NULL, "%d", OK);
+ set_var(interp, "REDIRECT", NULL, "%d", HTTP_MOVED_TEMPORARILY);
+ set_var(interp, "SERVER_ERROR", NULL, "%d", HTTP_INTERNAL_SERVER_ERROR);
+
+ set_var(interp, "M_POST", NULL, "%d", M_POST);
+ set_var(interp, "M_GET", NULL, "%d", M_GET);
+ set_var(interp, "M_PUT", NULL, "%d", M_PUT);
+ set_var(interp, "M_DELETE", NULL, "%d", M_DELETE);
+ set_var(interp, "M_CONNECT", NULL, "%d", M_CONNECT);
+ set_var(interp, "M_OPTIONS", NULL, "%d", M_OPTIONS);
+ set_var(interp, "M_TRACE", NULL, "%d", M_TRACE);
+ set_var(interp, "M_PATCH", NULL, "%d", M_PATCH);
+ set_var(interp, "M_PROPFIND", NULL, "%d", M_PROPFIND);
+ set_var(interp, "M_PROPPATCH", NULL, "%d", M_PROPPATCH);
+ set_var(interp, "M_MKCOL", NULL, "%d", M_MKCOL);
+ set_var(interp, "M_COPY", NULL, "%d", M_COPY);
+ set_var(interp, "M_MOVE", NULL, "%d", M_MOVE);
+ set_var(interp, "M_LOCK", NULL, "%d", M_LOCK);
+ set_var(interp, "M_UNLOCK", NULL, "%d", M_UNLOCK);
+ set_var(interp, "M_INVALID", NULL, "%d", M_INVALID);
+
+ set_var(interp, "HTTP_OK", NULL, "%d", HTTP_OK);
+ set_var(interp, "HTTP_CREATED", NULL, "%d", HTTP_CREATED);
+ set_var(interp, "HTTP_ACCEPTED", NULL, "%d", HTTP_ACCEPTED);
+ set_var(interp, "HTTP_NON_AUTHORITATIVE", NULL, "%d", HTTP_NON_AUTHORITATIVE);
+ set_var(interp, "HTTP_NO_CONTENT", NULL, "%d", HTTP_NO_CONTENT);
+ set_var(interp, "HTTP_PARTIAL_CONTENT", NULL, "%d", HTTP_PARTIAL_CONTENT);
+ set_var(interp, "HTTP_MULTIPLE_CHOICES", NULL, "%d", HTTP_MULTIPLE_CHOICES);
+ set_var(interp, "HTTP_MOVED_PERMANENTLY", NULL, "%d", HTTP_MOVED_PERMANENTLY);
+ set_var(interp, "HTTP_MOVED_TEMPORARILY", NULL, "%d", HTTP_MOVED_TEMPORARILY);
+ set_var(interp, "HTTP_NOT_MODIFIED", NULL, "%d", HTTP_NOT_MODIFIED);
+ set_var(interp, "HTTP_BAD_REQUEST", NULL, "%d", HTTP_BAD_REQUEST);
+ set_var(interp, "HTTP_UNAUTHORIZED", NULL, "%d", HTTP_UNAUTHORIZED);
+ set_var(interp, "HTTP_PAYMENT_REQUIRED", NULL, "%d", HTTP_PAYMENT_REQUIRED);
+ set_var(interp, "HTTP_FORBIDDEN", NULL, "%d", HTTP_FORBIDDEN);
+ set_var(interp, "HTTP_NOT_FOUND", NULL, "%d", HTTP_NOT_FOUND);
+ set_var(interp, "HTTP_METHOD_NOT_ALLOWED", NULL, "%d", HTTP_METHOD_NOT_ALLOWED);
+ set_var(interp, "HTTP_NOT_ACCEPTABLE", NULL, "%d", HTTP_NOT_ACCEPTABLE);
+ set_var(interp, "HTTP_PROXY_AUTHENTICATION_REQUIRED", NULL, "%d", HTTP_PROXY_AUTHENTICATION_REQUIRED);
+ set_var(interp, "HTTP_REQUEST_TIME_OUT", NULL, "%d", HTTP_REQUEST_TIME_OUT);
+ set_var(interp, "HTTP_GONE", NULL, "%d", HTTP_GONE);
+ set_var(interp, "HTTP_PRECONDITION_FAILED", NULL, "%d", HTTP_PRECONDITION_FAILED);
+ set_var(interp, "HTTP_REQUEST_ENTITY_TOO_LARGE", NULL, "%d", HTTP_REQUEST_ENTITY_TOO_LARGE);
+ set_var(interp, "HTTP_REQUEST_URI_TOO_LARGE", NULL, "%d", HTTP_REQUEST_URI_TOO_LARGE);
+ set_var(interp, "HTTP_UNSUPPORTED_MEDIA_TYPE", NULL, "%d", HTTP_UNSUPPORTED_MEDIA_TYPE);
+ set_var(interp, "HTTP_INTERNAL_SERVER_ERROR", NULL, "%d", HTTP_INTERNAL_SERVER_ERROR);
+ set_var(interp, "HTTP_NOT_IMPLEMENTED", NULL, "%d", HTTP_NOT_IMPLEMENTED);
+ set_var(interp, "HTTP_BAD_GATEWAY", NULL, "%d", HTTP_BAD_GATEWAY);
+ set_var(interp, "HTTP_SERVICE_UNAVAILABLE", NULL, "%d", HTTP_SERVICE_UNAVAILABLE);
+ set_var(interp, "HTTP_GATEWAY_TIME_OUT", NULL, "%d", HTTP_GATEWAY_TIME_OUT);
+ set_var(interp, "HTTP_VERSION_NOT_SUPPORTED", NULL, "%d", HTTP_VERSION_NOT_SUPPORTED);
+ set_var(interp, "HTTP_VARIANT_ALSO_VARIES", NULL, "%d", HTTP_VARIANT_ALSO_VARIES);
+
+ set_var(interp, "REMOTE_HOST", NULL, "%d", REMOTE_HOST);
+ set_var(interp, "REMOTE_NAME", NULL, "%d", REMOTE_NAME);
+ set_var(interp, "REMOTE_NOLOOKUP", NULL, "%d", REMOTE_NOLOOKUP);
+ set_var(interp, "REMOTE_DOUBLE_REV", NULL, "%d", REMOTE_DOUBLE_REV);
+
+ Tcl_CreateObjCommand(interp, "r", cmd_r, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "r_set", cmd_r_set, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "rputs", cmd_rputs, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "rwrite", cmd_rwrite, NULL, NULL);
+
+ /* sort this out later */
+ Tcl_CreateObjCommand(interp, "ap_internal_redirect", cmd_ap_internal_redirect, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_send_http_header", cmd_ap_send_http_header, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_server_version", cmd_ap_get_server_version, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_create_environment", cmd_ap_create_environment, NULL, NULL);
+
+ /* stuff from http_core.h */
+ Tcl_CreateObjCommand(interp, "ap_allow_options", cmd_ap_allow_options, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_allow_overrides", cmd_ap_allow_overrides, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_default_type", cmd_ap_default_type, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_document_root", cmd_ap_document_root, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_remote_host", cmd_ap_get_remote_host, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_remote_logname", cmd_ap_get_remote_logname, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_construct_url", cmd_ap_construct_url, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_server_name", cmd_ap_get_server_name, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_server_port", cmd_ap_get_server_port, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_limit_req_body", cmd_ap_get_limit_req_body, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_limit_xml_body", cmd_ap_get_limit_xml_body, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_custom_response", cmd_ap_custom_response, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_exists_config_define", cmd_ap_exists_config_define, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_auth_type", cmd_ap_auth_type, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_auth_name", cmd_ap_auth_name, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_satisfies", cmd_ap_satisfies, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_requires", cmd_ap_requires, NULL, NULL);
+
+ Tcl_CreateObjCommand(interp, "abort", cmd_abort, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "read_post", cmd_read_post, NULL, NULL);
+
+ Tcl_CreateObjCommand(interp, "random", cmd_random, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "srandom", cmd_srandom, NULL, NULL);
+
+ Tcl_CreateObjCommand(interp, "base64_encode", cmd_base64_encode, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "base64_decode", cmd_base64_decode, NULL, NULL);
+
+ // provided
+ {
+ char output_proc[] = "\
+ proc output { script } {\n\
+ set script [split $script \\n]\n\
+ \n\
+ foreach i $script {\n\
+ if { $i != \"\" } {\n\
+ regsub -all {\\\"} $i {\\\"} i\n\
+ uplevel 1 rputs \\\"$i\\\"\n\
+ }\n\
+ }\n\
+ }";
+
+ run_script(interp, output_proc);
+ }
+}
+
+static apr_status_t tcl_cleanup(void *data)
+{
+ if (interp) {
+ Tcl_DeleteInterp(interp);
+ interp = NULL;
+ }
+
+ return APR_SUCCESS;
+}
+
+static void tcl_init_handler(apr_pool_t *pconf, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s)
+{
+ ap_add_version_component(pconf, "mod_tcl/1.0d1");
+}
+
+static int run_handler(request_rec *r, int hh)
+{
+ int xx = HTTP_NOT_FOUND, i;
+ tcl_config_rec *tclr = (tcl_config_rec*) ap_get_module_config(r->per_dir_config, &tcl_module);
+ size_t flen = strlen(r->filename);
+ file_cache *fptr = NULL, *fa = (file_cache*) fcache->elts;
+ var_cache *vl = (var_cache*) tclr->var_list->elts;
+ struct stat st;
+
+ if (!(tclr->fl & 1) || !interp) {
+ return DECLINED;
+ }
+
+ /* handler wasn't set so ignore it */
+ if (!tclr->handlers[hh]) {
+ return DECLINED;
+ }
+
+ stat(r->filename, &st);
+
+ for (i = 0; i < fcache->nelts; i++) {
+ if (!strcmp(fa[i].file, r->filename)) {
+ fptr = &(fa[i]);
+ break;
+ }
+ }
+
+ if (!fptr) {
+ int fd;
+ void *mptr;
+ char *bptr;
+ off_t pos = 0;
+ Tcl_Obj *obj;
+
+ if ((fd = open(r->filename, O_RDONLY, 0)) == -1) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "open(%s, ...): %s", r->filename, strerror(errno));
+
+ return HTTP_NOT_FOUND;
+ }
+
+ mptr = mmap((caddr_t) 0, r->finfo.size, PROT_READ, MAP_SHARED, fd, 0);
+ bptr = (char*) malloc(r->finfo.size + flen + 21);
+
+ memcpy(bptr, "namespace eval ", 15); pos += 15;
+ memcpy(bptr + pos, r->filename, flen); pos += flen;
+ memcpy(bptr + pos, " {\n", 3); pos += 3;
+ memcpy(bptr + pos, mptr, r->finfo.size); pos += r->finfo.size;
+ memcpy(bptr + pos, "\n}\0", 3);
+
+ munmap((char*) mptr, r->finfo.size);
+ close(fd);
+
+ fptr = (file_cache*) apr_push_array(fcache);
+
+ fptr->file = apr_pstrdup(fcache->cont, r->filename);
+ memcpy(&(fptr->st), &st, sizeof(struct stat));
+
+ obj = Tcl_NewStringObj(bptr, -1);
+
+ free(bptr);
+
+ if (Tcl_EvalObjEx(interp, obj, 0) == TCL_ERROR) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "Tcl_EvalObjEx(...): %s\n%s", Tcl_GetStringResult(interp), Tcl_GetVar(interp, "errorInfo", 0));
+ return HTTP_INTERNAL_SERVER_ERROR;
+ }
+
+ for (i = 0; i < tclr->var_list->nelts; i++) {
+ if (vl[i].fl == 1) {
+ char *namespc = (char*) malloc(strlen(r->filename) + strlen(vl[i].var1) + 3);
+
+ sprintf(namespc, "%s::%s", r->filename, vl[i].var1);
+ set_var(interp, namespc, vl[i].var2, vl[i].var3);
+ free(namespc);
+ }
+ else if (vl[i].fl == 2) {
+ char *namespc = (char*) malloc(strlen(r->filename) + strlen(vl[i].var1) + 3);
+
+ sprintf(namespc, "%s::%s", r->filename, vl[i].var1);
+ run_script(interp, "lappend %s %s", namespc, vl[i].var2);
+ free(namespc);
+ }
+ }
+ }
+ else if (st.st_mtime > fptr->st.st_mtime) {
+ int fd;
+ void *mptr;
+ char *bptr;
+ off_t pos = 0;
+ Tcl_Obj *obj;
+
+ if ((fd = open(r->filename, O_RDONLY, 0)) == -1) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "open(%s, ...): %s", r->filename, strerror(errno));
+ return HTTP_INTERNAL_SERVER_ERROR;
+ }
+
+ mptr = mmap((caddr_t) 0, r->finfo.size, PROT_READ, MAP_SHARED, fd, 0);
+ bptr = malloc(r->finfo.size + flen + 21);
+
+ memcpy(bptr, "namespace eval ", 15); pos += 15;
+ memcpy(bptr + pos, r->filename, flen); pos += flen;
+ memcpy(bptr + pos, " {\n", 3); pos += 3;
+ memcpy(bptr + pos, mptr, r->finfo.size); pos += r->finfo.size;
+ memcpy(bptr + pos, "\n}\0", 3);
+
+ munmap((char*) mptr, r->finfo.size);
+ close(fd);
+
+ fptr = (file_cache*) apr_push_array(fcache);
+
+ fptr->file = apr_pstrdup(fcache->cont, r->filename);
+ memcpy(&(fptr->st), &st, sizeof(struct stat));
+
+ obj = Tcl_NewStringObj(bptr, -1);
+
+ free(bptr);
+
+ if (Tcl_EvalObjEx(interp, obj, 0) == TCL_ERROR) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "Tcl_EvalObjEx(...): %s\n%s", Tcl_GetStringResult(interp), Tcl_GetVar(interp, "errorInfo", 0));
+ return HTTP_INTERNAL_SERVER_ERROR;
+ }
+ }
+
+ _r = r;
+ current_namespace = r->filename;
+ read_post_ok = 1;
+
+ {
+ char *eptr = (char*) malloc(strlen(tclr->handlers[hh]) + flen + 3);
+ Tcl_Obj *obj;
+
+ sprintf(eptr, "%s::%s", fptr->file, tclr->handlers[hh]);
+
+ obj = Tcl_NewStringObj(eptr, -1);
+
+ free(eptr);
+
+ if (Tcl_EvalObjEx(interp, obj, 0) == TCL_ERROR) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "Tcl_EvalObjEx(%s): %s", eptr, Tcl_GetStringResult(interp));
+
+ r->content_type = "text/html";
+ ap_send_http_header(r);
+
+ ap_rprintf(r, "<H3>TCL Error</H3><BR><PRE>%s</PRE>", Tcl_GetString(Tcl_GetVar2Ex(interp, "errorInfo", NULL, 0)));
+
+ return OK;
+ }
+
+ Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &xx);
+ }
+
+ return xx;
+}
+
+static int tcl_handler(request_rec *r)
+{
+ return run_handler(r, 0);
+}
+
+static int tcl_post_read_request(request_rec *r)
+{
+ return run_handler(r, 1);
+}
+
+static int tcl_translate_name(request_rec *r)
+{
+ return run_handler(r, 2);
+}
+
+static int tcl_header_parser(request_rec *r)
+{
+ return run_handler(r, 3);
+}
+
+static int tcl_access_checker(request_rec *r)
+{
+ return run_handler(r, 4);
+}
+
+static int tcl_check_user_id(request_rec *r)
+{
+ return run_handler(r, 5);
+}
+
+static int tcl_auth_checker(request_rec *r)
+{
+ return run_handler(r, 6);
+}
+
+static int tcl_type_checker(request_rec *r)
+{
+ return run_handler(r, 7);
+}
+
+static int tcl_fixups(request_rec *r)
+{
+ return run_handler(r, 8);
+}
+
+static int tcl_log_transaction(request_rec *r)
+{
+ return run_handler(r, 9);
+}
+
diff --git a/tcl_misc.c b/tcl_misc.c
new file mode 100644
index 0000000..e0313b9
--- /dev/null
+++ b/tcl_misc.c
@@ -0,0 +1,165 @@
+/* ====================================================================
+ * The Apache Software License, Version 1.1
+ *
+ * Copyright (c) 2000 The Apache Software Foundation. All rights
+ * reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * 3. The end-user documentation included with the redistribution,
+ * if any, must include the following acknowledgment:
+ * "This product includes software developed by the
+ * Apache Software Foundation (http://www.apache.org/)."
+ * Alternately, this acknowledgment may appear in the software itself,
+ * if and wherever such third-party acknowledgments normally appear.
+ *
+ * 4. The names "Apache" and "Apache Software Foundation" must
+ * not be used to endorse or promote products derived from this
+ * software without prior written permission. For written
+ * permission, please contact apache@apache.org.
+ *
+ * 5. Products derived from this software may not be called "Apache",
+ * nor may "Apache" appear in their name, without prior written
+ * permission of the Apache Software Foundation.
+ *
+ * THIS SOFTWARE IS PROVIDED ``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 THE APACHE SOFTWARE FOUNDATION 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.
+ * ====================================================================
+ *
+ * This software consists of voluntary contributions made by many
+ * individuals on behalf of the Apache Software Foundation. For more
+ * information on the Apache Software Foundation, please see
+ * <http://www.apache.org/>.
+ *
+ * Portions of this software are based upon public domain software
+ * originally written at the National Center for Supercomputing Applications,
+ * University of Illinois, Urbana-Champaign.
+ */
+
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+
+#ifndef HAVE_ASPRINTF
+// ripped from gcc
+int int_vasprintf(char **result, const char *format, va_list *args)
+{
+ const char *p = format;
+ /* Add one to make sure that it is never zero, which might cause malloc
+ to return NULL. */
+ int total_width = strlen(format) + 1;
+ va_list ap;
+
+ memcpy((char*) &ap, (char*) args, sizeof(va_list));
+
+ while (*p != '\0') {
+ if (*p++ == '%') {
+ while (strchr ("-+ #0", *p)) {
+ ++p;
+ }
+
+ if (*p == '*') {
+ ++p;
+ total_width += abs(va_arg(ap, int));
+ }
+ else {
+ total_width += (unsigned long) strtol(p, (char**) &p, 10);
+ }
+
+ if (*p == '.') {
+ ++p;
+
+ if (*p == '*') {
+ ++p;
+ total_width += abs(va_arg(ap, int));
+ }
+ else {
+ total_width += (unsigned long) strtol(p, (char**) &p, 10);
+ }
+ }
+
+ while (strchr ("hlL", *p)) {
+ ++p;
+ }
+
+ /* Should be big enough for any format specifier except %s and floats. */
+ total_width += 30;
+
+ switch (*p) {
+ case 'd':
+ case 'i':
+ case 'o':
+ case 'u':
+ case 'x':
+ case 'X':
+ case 'c':
+ (void) va_arg(ap, int);
+ break;
+ case 'f':
+ case 'e':
+ case 'E':
+ case 'g':
+ case 'G':
+ (void) va_arg(ap, double);
+ /* Since an ieee double can have an exponent of 307, we'll
+ make the buffer wide enough to cover the gross case. */
+ total_width += 307;
+ break;
+ case 's':
+ total_width += strlen(va_arg(ap, char*));
+ break;
+ case 'p':
+ case 'n':
+ (void) va_arg(ap, char*);
+ break;
+ }
+ }
+ }
+
+ *result = (char*) malloc(total_width);
+
+ if (*result != NULL) {
+ return vsprintf(*result, format, *args);
+ }
+ else {
+ return 0;
+ }
+}
+
+int vasprintf(char **result, const char *format, va_list args)
+{
+ return int_vasprintf(result, format, &args);
+}
+
+int asprintf(char **result, const char *format, ...)
+{
+ va_list va;
+ int ret;
+
+ va_start(va, format);
+ ret = vasprintf(result, format, va);
+ va_end(va);
+
+ return ret;
+}
+#endif /* HAVE_ASPRINTF */