1.0d3
diff --git a/AUTHORS b/AUTHORS
new file mode 100644
index 0000000..d5e30cd
--- /dev/null
+++ b/AUTHORS
@@ -0,0 +1 @@
+Michael Link, mlink@fractal.net
diff --git a/INSTALL b/INSTALL
new file mode 100644
index 0000000..6c32803
--- /dev/null
+++ b/INSTALL
@@ -0,0 +1,7 @@
+% tar -zxf mod_tcl.tar.gz
+% mv mod_tcl apache_2.0a9/modules/.
+% cd apache_2.0a9
+% autoconf
+% autoheader
+% ./configure
+% make
diff --git a/NEWS b/NEWS
new file mode 100644
index 0000000..0486439
--- /dev/null
+++ b/NEWS
@@ -0,0 +1 @@
+1.0d3
diff --git a/README b/README
index 2a541a4..bad4c45 100644
--- a/README
+++ b/README
@@ -1,3 +1,3 @@
mod_tcl for Apache 2.0
-Please see http://www.fractal.net/ for documentation.
+Please see www.fractal.net for documentation.
diff --git a/mod_tcl.h b/mod_tcl.h
index 7e1d3e6..fcd2718 100644
--- a/mod_tcl.h
+++ b/mod_tcl.h
@@ -93,6 +93,7 @@
#include "http_protocol.h"
#include "http_request.h"
#include "util_script.h"
+#include "util_uri.h"
#include "ap_config_auto.h"
@@ -109,23 +110,20 @@
#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);
+void set_var(Tcl_Interp *interp, char *var1, char *var2, const char *fmt, ...);
+void set_vari(Tcl_Interp* interp, char *var1, char *var2, int var);
+void set_varb(Tcl_Interp *interp, char *var1, char *var2, 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[]);
+
+/* http_core.h */
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[]);
@@ -144,4 +142,50 @@
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[]);
+/* http_log.h */
+int cmd_ap_log_error(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+
+/* http_protocol.h */
+int cmd_ap_send_http_header(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_send_http_trace(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_send_http_options(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_finalize_request_protocol(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_send_error_response(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_set_content_length(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_set_keepalive(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_rationalize_mtime(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_make_etag(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_set_etag(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_set_last_modified(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_meets_conditions(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+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_rflush(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_status_line(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_setup_client_block(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_client_block(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_discard_request_body(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_note_auth_failure(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_note_basic_auth_failure(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_note_digest_auth_failure(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_basic_auth_pw(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_parse_uri(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_method_number_of(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_method_name_of(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+
+/* http_request.h */
+int cmd_ap_internal_redirect(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_internal_redirect_handler(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_some_auth_required(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_update_mtime(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_allow_methods(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+
+/* httpd.h */
+int cmd_ap_get_server_version(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_add_version_component(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+int cmd_ap_get_server_built(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+
+/* util_script.h */
+int cmd_ap_create_environment(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[]);
+
#endif /* __MOD_TCL_H__ */
diff --git a/tcl_cmds.c b/tcl_cmds.c
index 43def46..ea5c6a9 100644
--- a/tcl_cmds.c
+++ b/tcl_cmds.c
@@ -61,9 +61,12 @@
extern Tcl_Interp *interp;
extern apr_array_header_t *fcache;
extern request_rec *_r;
+extern apr_pool_t *_pconf;
extern char *current_namespace;
extern int read_post_ok;
+static int sorted = 0, r_size = 0, connection_size = 0, server_size = 0;
+
const uint8_t base64[] = {
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
};
@@ -359,7 +362,7 @@
file_key = apr_psprintf(r->pool, "%s_filename", key);
- set_var2(interp, "::pram", file_key, file_val, i);
+ set_varb(interp, "::pram", file_key, file_val, i);
}
break;
@@ -385,7 +388,7 @@
val[vlen] = '\0';
}
- set_var2(interp, "::pram", key, val, vlen);
+ set_varb(interp, "::pram", key, val, vlen);
free(val);
@@ -445,7 +448,7 @@
break;
}
- set_var(interp, "::pram", key, val);
+ set_var(interp, "::pram", (char*) key, (char*) val);
}
return OK;
@@ -486,123 +489,1011 @@
}
}
-int cmd_rputs(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+static Tcl_Obj* r_the_request(void)
{
- char *opt = NULL, *data;
+ return Tcl_NewStringObj(_r->the_request, -1);
+}
+
+static Tcl_Obj* r_assbackwards(void)
+{
+ return Tcl_NewIntObj(_r->assbackwards);
+}
+
+static Tcl_Obj* r_proxyreq(void)
+{
+ return Tcl_NewIntObj(_r->proxyreq);
+}
+
+static Tcl_Obj* r_header_only(void)
+{
+ return Tcl_NewIntObj(_r->header_only);
+}
+
+static Tcl_Obj* r_protocol(void)
+{
+ return Tcl_NewStringObj(_r->protocol, -1);
+}
+
+static Tcl_Obj* r_proto_num(void)
+{
+ return Tcl_NewIntObj(_r->proto_num);
+}
+
+static Tcl_Obj* r_hostname(void)
+{
+ return Tcl_NewStringObj(_r->hostname, -1);
+}
+
+static Tcl_Obj* r_request_time(void)
+{
+ return Tcl_NewLongObj(_r->request_time);
+}
+
+static Tcl_Obj* r_status_line(void)
+{
+ return Tcl_NewStringObj(_r->status_line, -1);
+}
+
+static Tcl_Obj* r_status(void)
+{
+ return Tcl_NewIntObj(_r->status);
+}
+
+static Tcl_Obj* r_method(void)
+{
+ return Tcl_NewStringObj(_r->method, -1);
+}
+
+static Tcl_Obj* r_method_number(void)
+{
+ return Tcl_NewIntObj(_r->method_number);
+}
+
+static Tcl_Obj* r_allowed(void)
+{
+ return Tcl_NewIntObj(_r->allowed);
+}
+
+/* hasn't been implemented ? */
+static Tcl_Obj* r_allowed_xmethods(void)
+{
+ return Tcl_NewStringObj("", -1);
+}
+
+static Tcl_Obj* r_allowed_methods(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ char **method_list = (char**) _r->allowed_methods->method_list->elts;
- 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;
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewIntObj(_r->allowed_methods->method_mask));
+
+ for (i = 0; i < _r->allowed_methods->method_list->nelts; i++) {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(method_list[i], -1));
}
- if (opt && strcmp(opt, "-nonewline")) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? string");
- return TCL_ERROR;
+ return obj;
+}
+
+static Tcl_Obj* r_sent_bodyct(void)
+{
+ return Tcl_NewIntObj(_r->sent_bodyct);
+}
+
+static Tcl_Obj* r_bytes_sent(void)
+{
+ return Tcl_NewIntObj(_r->bytes_sent);
+}
+
+static Tcl_Obj* r_mtime(void)
+{
+ return Tcl_NewLongObj(_r->mtime);
+}
+
+static Tcl_Obj* r_chunked(void)
+{
+ return Tcl_NewIntObj(_r->chunked);
+}
+
+static Tcl_Obj* r_boundary(void)
+{
+ return Tcl_NewStringObj(_r->boundary, -1);
+}
+
+static Tcl_Obj* r_range(void)
+{
+ return Tcl_NewStringObj(_r->range, -1);
+}
+
+static Tcl_Obj* r_clength(void)
+{
+ return Tcl_NewLongObj(_r->clength);
+}
+
+static Tcl_Obj* r_remaining(void)
+{
+ return Tcl_NewLongObj(_r->remaining);
+}
+
+static Tcl_Obj* r_read_length(void)
+{
+ return Tcl_NewLongObj(_r->read_length);
+}
+
+static Tcl_Obj* r_read_body(void)
+{
+ return Tcl_NewIntObj(_r->read_body);
+}
+
+static Tcl_Obj* r_read_chunked(void)
+{
+ return Tcl_NewIntObj(_r->read_chunked);
+}
+
+static Tcl_Obj* r_expecting_100(void)
+{
+ return Tcl_NewIntObj(_r->expecting_100);
+}
+
+static Tcl_Obj* r_headers_in(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ apr_array_header_t *ha = apr_table_elts(_r->headers_in);
+ apr_table_entry_t *hte = (apr_table_entry_t*) ha->elts;
+
+ for (i = 0; i < ha->nelts; i++) {
+ Tcl_SetVar2Ex(interp, "headers_in", hte[i].key, Tcl_NewStringObj(hte[i].val, -1), 0);
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(hte[i].key, -1));
}
- ap_rprintf(_r, "%s%s", data, opt ? "" : "\n");
+ return obj;
+}
+
+static Tcl_Obj* r_headers_out(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ apr_array_header_t *ha = apr_table_elts(_r->headers_out);
+ apr_table_entry_t *hte = (apr_table_entry_t*) ha->elts;
+
+ for (i = 0; i < ha->nelts; i++) {
+ Tcl_SetVar2Ex(interp, "headers_out", hte[i].key, Tcl_NewStringObj(hte[i].val, -1), 0);
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(hte[i].key, -1));
+ }
+
+ return obj;
+}
+
+static Tcl_Obj* r_err_headers_out(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ apr_array_header_t *ha = apr_table_elts(_r->err_headers_out);
+ apr_table_entry_t *hte = (apr_table_entry_t*) ha->elts;
+
+ for (i = 0; i < ha->nelts; i++) {
+ Tcl_SetVar2Ex(interp, "err_headers_out", hte[i].key, Tcl_NewStringObj(hte[i].val, -1), 0);
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(hte[i].key, -1));
+ }
+
+ return obj;
+}
+
+/* ap_create_environment() sets ::env */
+static Tcl_Obj* r_subprocess_env(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ apr_array_header_t *ha = apr_table_elts(_r->subprocess_env);
+ apr_table_entry_t *hte = (apr_table_entry_t*) ha->elts;
+
+ for (i = 0; i < ha->nelts; i++) {
+ Tcl_SetVar2Ex(interp, "subprocess_env", hte[i].key, Tcl_NewStringObj(hte[i].val, -1), 0);
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(hte[i].key, -1));
+ }
+
+ return obj;
+}
+
+static Tcl_Obj* r_notes(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ apr_array_header_t *ha = apr_table_elts(_r->notes);
+ apr_table_entry_t *hte = (apr_table_entry_t*) ha->elts;
+
+ for (i = 0; i < ha->nelts; i++) {
+ Tcl_SetVar2Ex(interp, "notes", hte[i].key, Tcl_NewStringObj(hte[i].val, -1), 0);
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(hte[i].key, -1));
+ }
+
+ return obj;
+}
+
+static Tcl_Obj* r_content_type(void)
+{
+ return Tcl_NewStringObj(_r->content_type, -1);
+}
+
+static Tcl_Obj* r_handler(void)
+{
+ return Tcl_NewStringObj(_r->handler, -1);
+}
+
+static Tcl_Obj* r_content_encoding(void)
+{
+ return Tcl_NewStringObj(_r->content_encoding, -1);
+}
+
+static Tcl_Obj* r_content_languages(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ char **content_languages = (char**) _r->content_languages->elts;
+
+ for (i = 0; i < _r->content_languages->nelts; i++) {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(content_languages[i], -1));
+ }
+
+ return obj;
+}
+
+static Tcl_Obj* r_vlist_validator(void)
+{
+ return Tcl_NewStringObj(_r->vlist_validator, -1);
+}
+
+static Tcl_Obj* r_user(void)
+{
+ return Tcl_NewStringObj(_r->user, -1);
+}
+
+static Tcl_Obj* r_ap_auth_type(void)
+{
+ return Tcl_NewStringObj(_r->ap_auth_type, -1);
+}
+
+static Tcl_Obj* r_no_cache(void)
+{
+ return Tcl_NewIntObj(_r->no_cache);
+}
+
+static Tcl_Obj* r_no_local_copy(void)
+{
+ return Tcl_NewIntObj(_r->no_local_copy);
+}
+
+static Tcl_Obj* r_unparsed_uri(void)
+{
+ return Tcl_NewStringObj(_r->unparsed_uri, -1);
+}
+
+static Tcl_Obj* r_uri(void)
+{
+ return Tcl_NewStringObj(_r->uri, -1);
+}
+
+static Tcl_Obj* r_filename(void)
+{
+ return Tcl_NewStringObj(_r->filename, -1);
+}
+
+static Tcl_Obj* r_path_info(void)
+{
+ return Tcl_NewStringObj(_r->path_info, -1);
+}
+
+static Tcl_Obj* r_args(void)
+{
+ return Tcl_NewStringObj(_r->args, -1);
+}
+
+static Tcl_Obj* r_parsed_uri(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.scheme, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.hostinfo, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.user, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.password, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.hostname, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.port_str, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.path, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.query, -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->parsed_uri.fragment, -1));
+
+ /* is the rest important? */
+
+ return obj;
+}
+
+/* variables in r->connection */
+
+static Tcl_Obj* r_connection_remote_ip(void)
+{
+ return Tcl_NewStringObj(_r->connection->remote_ip, -1);
+}
+
+static Tcl_Obj* r_connection_remote_host(void)
+{
+ return Tcl_NewStringObj(_r->connection->remote_host, -1);
+}
+
+static Tcl_Obj* r_connection_remote_logname(void)
+{
+ return Tcl_NewStringObj(_r->connection->remote_logname, -1);
+}
+
+static Tcl_Obj* r_connection_aborted(void)
+{
+ return Tcl_NewIntObj(_r->connection->aborted);
+}
+
+static Tcl_Obj* r_connection_keepalive(void)
+{
+ return Tcl_NewIntObj(_r->connection->keepalive);
+}
+
+static Tcl_Obj* r_connection_keptalive(void)
+{
+ return Tcl_NewIntObj(_r->connection->keptalive);
+}
+
+static Tcl_Obj* r_connection_double_reverse(void)
+{
+ return Tcl_NewIntObj(_r->connection->double_reverse);
+}
+
+static Tcl_Obj* r_connection_keepalives(void)
+{
+ return Tcl_NewIntObj(_r->connection->keepalives);
+}
+
+static Tcl_Obj* r_connection_local_ip(void)
+{
+ return Tcl_NewStringObj(_r->connection->local_ip, -1);
+}
+
+static Tcl_Obj* r_connection_local_host(void)
+{
+ return Tcl_NewStringObj(_r->connection->local_host, -1);
+}
+
+static Tcl_Obj* r_connection_id(void)
+{
+ return Tcl_NewLongObj(_r->connection->id);
+}
+
+static Tcl_Obj* r_connection_notes(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ apr_array_header_t *ha = apr_table_elts(_r->connection->notes);
+ apr_table_entry_t *hte = (apr_table_entry_t*) ha->elts;
+
+ for (i = 0; i < ha->nelts; i++) {
+ Tcl_SetVar2Ex(interp, "connection_notes", hte[i].key, Tcl_NewStringObj(hte[i].val, -1), 0);
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(hte[i].key, -1));
+ }
+
+ return obj;
+}
+
+static Tcl_Obj* r_connection_remain(void)
+{
+ return Tcl_NewLongObj(_r->connection->remain);
+}
+
+static Tcl_Obj* r_server_defn_name(void)
+{
+ return Tcl_NewStringObj(_r->server->defn_name, -1);
+}
+
+static Tcl_Obj* r_server_defn_line_number(void)
+{
+ return Tcl_NewIntObj(_r->server->defn_line_number);
+}
+
+static Tcl_Obj* r_server_server_admin(void)
+{
+ return Tcl_NewStringObj(_r->server->server_admin, -1);
+}
+
+static Tcl_Obj* r_server_server_hostname(void)
+{
+ return Tcl_NewStringObj(_r->server->server_hostname, -1);
+}
+
+static Tcl_Obj* r_server_port(void)
+{
+ return Tcl_NewIntObj(_r->server->port);
+}
+
+static Tcl_Obj* r_server_error_fname(void)
+{
+ return Tcl_NewStringObj(_r->server->error_fname, -1);
+}
+
+static Tcl_Obj* r_server_loglevel(void)
+{
+ return Tcl_NewIntObj(_r->server->loglevel);
+}
+
+static Tcl_Obj* r_server_is_virtual(void)
+{
+ return Tcl_NewIntObj(_r->server->is_virtual);
+}
+
+static Tcl_Obj* r_server_addrs(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewIntObj(_r->server->addrs->host_port));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(_r->server->addrs->virthost, -1));
+
+ return obj;
+}
+
+static Tcl_Obj* r_server_timeout(void)
+{
+ return Tcl_NewIntObj(_r->server->timeout);
+}
+
+static Tcl_Obj* r_server_keep_alive_timeout(void)
+{
+ return Tcl_NewIntObj(_r->server->keep_alive_timeout);
+}
+
+static Tcl_Obj* r_server_keep_alive_max(void)
+{
+ return Tcl_NewIntObj(_r->server->keep_alive_max);
+}
+
+static Tcl_Obj* r_server_keep_alive(void)
+{
+ return Tcl_NewIntObj(_r->server->keep_alive);
+}
+
+static Tcl_Obj* r_server_path(void)
+{
+ return Tcl_NewStringObj(_r->server->path, -1);
+}
+
+static Tcl_Obj* r_server_names(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ char **a = (char**) _r->server->names->elts;
+
+ for (i = 0; i < _r->server->names->nelts; i++) {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(a[i], -1));
+ }
+
+ return obj;
+}
+
+static Tcl_Obj* r_server_wild_names(void)
+{
+ Tcl_Obj *obj = Tcl_NewObj();
+ int i;
+ char **a = (char**) _r->server->wild_names->elts;
+
+ for (i = 0; i < _r->server->wild_names->nelts; i++) {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(a[i], -1));
+ }
+
+ return obj;
+}
+
+static Tcl_Obj* r_server_limit_req_line(void)
+{
+ return Tcl_NewIntObj(_r->server->limit_req_line);
+}
+
+static Tcl_Obj* r_server_limit_req_fieldsize(void)
+{
+ return Tcl_NewIntObj(_r->server->limit_req_fieldsize);
+}
+
+static Tcl_Obj* r_server_limit_req_fields(void)
+{
+ return Tcl_NewIntObj(_r->server->limit_req_fields);
+}
+
+/* sets */
+static int r_set_the_request(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->the_request = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
return TCL_OK;
}
-int cmd_rwrite(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+static int r_set_assbackwards(int objc, Tcl_Obj *CONST objv[])
{
- char *data = NULL;
- int length;
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->assbackwards));
- switch (objc) {
- case 2:
- data = (char*) Tcl_GetByteArrayFromObj(objv[1], &length);
- break;
- default:
- Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_OK;
+}
+
+static int r_set_proxyreq(int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->proxyreq));
+
+ return TCL_OK;
+}
+
+static int r_set_header_only(int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->header_only));
+
+ return TCL_OK;
+}
+
+static int r_set_protocol(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->protocol = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_proto_num(int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->proto_num));
+
+ return TCL_OK;
+}
+
+static int r_set_allowed(int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->allowed));
+
+ return TCL_OK;
+}
+
+/* ? */
+static int r_set_allowed_xmethods(int objc, Tcl_Obj *CONST objv[])
+{
+ return TCL_OK;
+}
+
+static int r_set_allowed_methods(int objc, Tcl_Obj *CONST objv[])
+{
+ int xxobjc;
+ Tcl_Obj **xxobjv;
+ int i;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "method_mask method_list");
return TCL_ERROR;
}
- ap_rwrite(data, length, _r);
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->allowed_methods->method_mask));
- 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);
+ if (Tcl_ListObjGetElements(interp, objv[3], &xxobjc, &xxobjv) == TCL_ERROR) {
+ return TCL_ERROR;
}
- ap_send_http_header(_r);
+ _r->allowed_methods->method_list = apr_make_array(_r->allowed_methods->method_list->cont, xxobjc, sizeof(char*));
+
+ for (i = 0; i < xxobjc; i++) {
+ char *xx = apr_push_array(_r->allowed_methods->method_list);
+
+ xx = apr_pstrdup(_r->allowed_methods->method_list->cont, Tcl_GetString(xxobjv[i]));
+ }
return TCL_OK;
}
-static int set_headers_in(void *data, const char *key, const char *val)
+static int r_set_headers_out(int objc, Tcl_Obj *CONST objv[])
{
- Tcl_Interp *interp = (Tcl_Interp*) data;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "header_name header");
+ return TCL_ERROR;
+ }
- set_var(interp, "headers_in", key, val);
+ apr_table_set(_r->headers_out, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
- return 1;
+ return TCL_OK;
}
+static int r_set_err_headers_out(int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "header_name header");
+ return TCL_ERROR;
+ }
+
+ apr_table_set(_r->err_headers_out, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
+
+ return TCL_OK;
+}
+
+static int r_set_subprocess_env(int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "variable_name variable");
+ return TCL_ERROR;
+ }
+
+ apr_table_set(_r->subprocess_env, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
+
+ return TCL_OK;
+}
+
+static int r_set_notes(int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "note_name note");
+ return TCL_ERROR;
+ }
+
+ apr_table_set(_r->notes, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
+
+ return TCL_OK;
+}
+
+static int r_set_content_type(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->content_type = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_content_encoding(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->content_encoding = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_content_languages(int objc, Tcl_Obj *CONST objv[])
+{
+ int xxobjc;
+ Tcl_Obj **xxobjv;
+ int i;
+
+ if (Tcl_ListObjGetElements(interp, objv[2], &xxobjc, &xxobjv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ _r->content_languages = apr_make_array(_r->content_languages->cont, xxobjc, sizeof(char*));
+
+ for (i = 0; i < xxobjc; i++) {
+ char *xx = apr_push_array(_r->content_languages);
+
+ xx = apr_pstrdup(_r->content_languages->cont, Tcl_GetString(xxobjv[i]));
+ }
+
+ return TCL_OK;
+}
+
+static int r_set_vlist_validator(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->vlist_validator = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_user(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->user = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_ap_auth_type(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->ap_auth_type = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_no_cache(int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->no_cache));
+
+ return TCL_OK;
+}
+
+static int r_set_no_local_copy(int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_GetIntFromObj(interp, objv[2], &(_r->no_local_copy));
+
+ return TCL_OK;
+}
+
+static int r_set_unparsed_uri(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->unparsed_uri = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_uri(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->uri = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_path_info(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->path_info = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_args(int objc, Tcl_Obj *CONST objv[])
+{
+ _r->args = apr_pstrdup(_r->pool, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+static int r_set_parsed_uri(int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(ap_parse_uri_components(_r->pool, Tcl_GetString(objv[2]), &(_r->parsed_uri))));
+
+ return TCL_OK;
+}
+
+static int r_set_connection_notes(int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "note_name note");
+ return TCL_ERROR;
+ }
+
+ apr_table_set(_r->connection->notes, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
+
+ return TCL_OK;
+}
+
+
+typedef Tcl_Obj* (*fy_t)(void);
+typedef int (*fx_t)(int objc, Tcl_Obj *CONST objv[]);
+
+typedef struct {
+ char *var;
+ fy_t rd_func;
+ fx_t wr_func;
+} r_table;
+
+static int r_find(const void *x, const void *y)
+{
+ return strcmp(((r_table*) x)->var, ((r_table*) y)->var);
+}
+
+r_table r_tbl[] = {
+ { "allowed", r_allowed, r_set_allowed },
+ { "allowed_methods", r_allowed_methods, r_set_allowed_methods },
+ { "allowed_xmethods", r_allowed_xmethods, r_set_allowed_xmethods },
+ { "ap_auth_type", r_ap_auth_type, r_set_ap_auth_type },
+ { "args", r_args, r_set_args },
+ { "assbackwards", r_assbackwards, r_set_assbackwards },
+ { "boundary", r_boundary, NULL },
+ { "bytes_sent", r_bytes_sent, NULL },
+ { "chunked", r_chunked, NULL },
+ { "clength", r_clength, NULL },
+ { "content_encoding", r_content_encoding, r_set_content_encoding },
+/* { "content_languages", r_content_languages,r_set_content_languages }, this is fuct up, and I have no idea why */
+ { "content_type", r_content_type, r_set_content_type },
+ { "err_headers_out", r_err_headers_out, r_set_err_headers_out },
+ { "expecting_100", r_expecting_100, NULL },
+ { "filename", r_filename, NULL },
+ { "handler", r_handler, NULL },
+ { "headers_in", r_headers_in, NULL },
+ { "headers_out", r_headers_out, r_set_headers_out },
+ { "header_only", r_header_only, r_set_header_only },
+ { "hostname", r_hostname, NULL },
+ { "method", r_method, NULL },
+ { "method_number", r_method_number, NULL },
+ { "mtime", r_mtime, NULL },
+ { "notes", r_notes, r_set_notes },
+ { "no_cache", r_no_cache, r_set_no_cache },
+ { "no_local_copy", r_no_local_copy, r_set_no_local_copy },
+ { "parsed_uri", r_parsed_uri, r_set_parsed_uri },
+ { "path_info", r_path_info, r_set_path_info },
+ { "protocol", r_protocol, r_set_protocol },
+ { "proto_num", r_proto_num, r_set_proto_num },
+ { "proxyreq", r_proxyreq, r_set_proxyreq },
+ { "range", r_range, NULL },
+ { "read_body", r_read_body, NULL },
+ { "read_chunked", r_read_chunked, NULL },
+ { "read_length", r_read_length, NULL },
+ { "remaining", r_remaining, NULL },
+ { "request_time", r_request_time, NULL },
+ { "sent_bodyct", r_sent_bodyct, NULL },
+ { "status", r_status, NULL },
+ { "status_line", r_status_line, NULL },
+ { "subprocess_env", r_subprocess_env, r_set_subprocess_env },
+ { "the_request", r_the_request, r_set_the_request },
+ { "unparsed_uri", r_unparsed_uri, r_set_unparsed_uri },
+ { "uri", r_uri, r_set_uri },
+ { "user", r_user, r_set_user },
+ { "vlist_validator", r_vlist_validator, r_set_vlist_validator },
+ { NULL, NULL, NULL }
+};
+
+r_table r_connection_tbl[] = {
+ { "remote_ip", r_connection_remote_ip, NULL },
+ { "remote_host", r_connection_remote_host, NULL },
+ { "remote_logname", r_connection_remote_logname, NULL },
+ { "aborted", r_connection_aborted, NULL },
+ { "keepalive", r_connection_keepalive, NULL },
+ { "keptalive", r_connection_keptalive, NULL },
+ { "doublereverse", r_connection_double_reverse, NULL },
+ { "keepalives", r_connection_keepalives, NULL },
+ { "local_ip", r_connection_local_ip, NULL },
+ { "local_host", r_connection_local_host, NULL },
+ { "id", r_connection_id, NULL },
+ { "notes", r_connection_notes, r_set_connection_notes },
+ { "remain", r_connection_remain, NULL },
+ { NULL, NULL, NULL }
+};
+
+r_table r_server_tbl[] = {
+ { "defn_name", r_server_defn_name, NULL },
+ { "defn_line_number", r_server_defn_line_number, NULL },
+ { "server_admin", r_server_server_admin, NULL },
+ { "server_hostname", r_server_server_hostname, NULL },
+ { "port", r_server_port, NULL },
+ { "error_fname", r_server_error_fname, NULL },
+ { "loglevel", r_server_loglevel, NULL },
+ { "is_virtual", r_server_is_virtual, NULL },
+ { "addrs", r_server_addrs, NULL },
+ { "timeout", r_server_timeout, NULL },
+ { "keep_alive_timeout", r_server_keep_alive_timeout, NULL },
+ { "keep_alive_max", r_server_keep_alive_max, NULL },
+ { "keep_alive", r_server_keep_alive, NULL },
+ { "path", r_server_path, NULL },
+ { "names", r_server_names, NULL },
+ { "wild_names", r_server_wild_names, NULL },
+ { "limit_req_line", r_server_limit_req_line, NULL },
+ { "limit_req_fieldsize", r_server_limit_req_fieldsize, NULL },
+ { "limit_req_fields", r_server_limit_req_fields, NULL },
+ { NULL, NULL, NULL }
+};
+
int cmd_r(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
{
- if (objc != 2) {
+ char *xx = NULL, *yy = NULL;
+ r_table *r_table_ptr, key;
+
+ switch (objc) {
+ case 3: yy = Tcl_GetString(objv[2]);
+ case 2: xx = Tcl_GetString(objv[1]); break;
+ default:
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));
+ if (!sorted) {
+ for (; r_tbl[r_size].var != NULL; r_size++);
+ for (; r_connection_tbl[connection_size].var != NULL; connection_size++);
+ for (; r_server_tbl[server_size].var != NULL; server_size++);
+
+ qsort(r_tbl, r_size, sizeof(r_table), r_find);
+ qsort(r_connection_tbl, connection_size, sizeof(r_table), r_find);
+ qsort(r_server_tbl, server_size, sizeof(r_table), r_find);
+
+ sorted = 1;
}
- else if (!strcmp("uri", Tcl_GetString(objv[1]))) {
- Tcl_SetObjResult(ixx, Tcl_NewStringObj(_r->uri, -1));
+
+ if (!strcmp(xx, "server")) {
+ if (!yy) {
+ Tcl_WrongNumArgs(interp, 2, objv, "variable");
+ return TCL_ERROR;
+ }
+
+ key.var = yy;
+ r_table_ptr = (r_table*) bsearch(&key, r_server_tbl, server_size, sizeof(r_table), r_find);
}
- 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");
- }
+ else if (!strcmp(xx, "connection")) {
+ if (!yy) {
+ Tcl_WrongNumArgs(interp, 2, objv, "variable");
+ return TCL_ERROR;
+ }
+
+ key.var = yy;
+ r_table_ptr = (r_table*) bsearch(&key, r_connection_tbl, connection_size, sizeof(r_table), r_find);
+ }
+ else {
+ key.var = xx;
+ r_table_ptr = (r_table*) bsearch(&key, r_tbl, r_size, sizeof(r_table), r_find);
+ }
+
+ if (!r_table_ptr) {
+ char *p;
+
+ asprintf(&p, "%s is not known in structure.", xx);
+ Tcl_AddObjErrorInfo(interp, p, -1);
+
+ free(p);
+
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, r_table_ptr->rd_func());
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?");
+ char *xx, *yy;
+ r_table *r_table_ptr, key;
+
+ switch (objc) {
+ default:
+ case 3: yy = Tcl_GetString(objv[2]);
+ case 2: xx = Tcl_GetString(objv[1]); break;
+ case 1:
+ Tcl_WrongNumArgs(interp, 1, objv, "variable");
return TCL_ERROR;
}
- if (!strcmp("content_type", Tcl_GetString(objv[1]))) {
- _r->content_type = Tcl_GetString(objv[2]);
+ if (!sorted) {
+ for (; r_tbl[r_size].var != NULL; r_size++);
+ for (; r_connection_tbl[connection_size].var != NULL; connection_size++);
+ for (; r_server_tbl[server_size].var != NULL; server_size++);
+
+ qsort(r_tbl, r_size, sizeof(r_table), r_find);
+ qsort(r_connection_tbl, connection_size, sizeof(r_table), r_find);
+ qsort(r_server_tbl, server_size, sizeof(r_table), r_find);
+
+ sorted = 1;
}
- else if (!strcmp("headers_out", Tcl_GetString(objv[1]))) {
- if (objc != 4) {
+
+ if (!strcmp(xx, "server")) {
+ if (!yy) {
+ Tcl_WrongNumArgs(interp, 2, objv, "variable ?variables?");
return TCL_ERROR;
}
- apr_table_set(_r->headers_out, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
+ key.var = yy;
+ r_table_ptr = (r_table*) bsearch(&key, r_server_tbl, server_size, sizeof(r_table), r_find);
+ }
+ else if (!strcmp(xx, "connection")) {
+ if (!yy) {
+ Tcl_WrongNumArgs(interp, 2, objv, "variable ?variables?");
+ return TCL_ERROR;
+ }
+
+ key.var = yy;
+ r_table_ptr = (r_table*) bsearch(&key, r_connection_tbl, connection_size, sizeof(r_table), r_find);
+ }
+ else {
+ key.var = xx;
+ r_table_ptr = (r_table*) bsearch(&key, r_tbl, r_size, sizeof(r_table), r_find);
}
- return TCL_OK;
+ if (!r_table_ptr) {
+ char *p;
+
+ asprintf(&p, "%s is not known in structure.", xx);
+ Tcl_AddObjErrorInfo(interp, p, -1);
+
+ free(p);
+
+ return TCL_ERROR;
+ }
+
+ if (r_table_ptr->wr_func) {
+ return r_table_ptr->wr_func(objc, objv);
+ }
+ else {
+ Tcl_AddObjErrorInfo(interp, "this variable is not writable", -1);
+ return TCL_ERROR;
+ }
}
int cmd_read_post(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
{
- if (read_post_init(_r, ixx) != OK) {
+ if (read_post_init(_r, interp) != OK) {
ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, _r->server, "cmd_read_post(...): read failed");
- Tcl_AddErrorInfo(ixx, "read failed");
+ Tcl_AddErrorInfo(interp, "read failed");
return TCL_ERROR;
}
@@ -610,56 +1501,15 @@
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);
+ Tcl_AddObjErrorInfo(interp, 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()));
@@ -728,6 +1578,8 @@
return TCL_OK;
}
+/* http_core.h */
+
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)));
@@ -895,3 +1747,490 @@
return TCL_OK;
}
+
+/* http_log.h */
+
+int cmd_ap_log_error(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int i, j;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "level status string");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &i);
+ Tcl_GetIntFromObj(interp, objv[2], &j);
+
+ ap_log_error(APLOG_MARK, i, j, _r->server, Tcl_GetString(objv[3]));
+
+ return TCL_OK;
+}
+
+/* http_protocol.h */
+
+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;
+}
+
+int cmd_ap_send_http_trace(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_send_http_trace(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_send_http_options(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_send_http_options(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_finalize_request_protocol(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ ap_finalize_request_protocol(_r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_send_error_response(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int recursive_error;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "recursive_error");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &recursive_error);
+
+ ap_send_error_response(_r, recursive_error);
+
+ return TCL_OK;
+}
+
+int cmd_ap_set_content_length(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ apr_off_t length;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "length");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], (int*) &length);
+
+ ap_set_content_length(_r, length);
+
+ return TCL_OK;
+}
+
+int cmd_ap_set_keepalive(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_set_keepalive(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_rationalize_mtime(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ apr_time_t mtime;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "mtime");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], (int*) &mtime);
+
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_rationalize_mtime(_r, mtime)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_make_etag(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "force_weak");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &i);
+
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_make_etag(_r, i), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_set_etag(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ ap_set_etag(_r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_set_last_modified(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ ap_set_last_modified(_r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_meets_conditions(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_meets_conditions(_r)));
+
+ return TCL_OK;
+}
+
+/* ... skipping method stuff ... */
+
+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_rflush(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ ap_rflush(_r);
+
+ return TCL_OK;
+}
+
+/* skip ap_index_of_response() */
+
+int cmd_ap_get_status_line(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int status;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "status");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &status);
+
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_get_status_line(status), -1));
+
+ return TCL_OK;
+}
+
+int cmd_ap_setup_client_block(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int read_policy;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "read_policy");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &read_policy);
+
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_setup_client_block(_r, read_policy)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_client_block(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int bufsiz;
+ char *buffer;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "bufsiz");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &bufsiz);
+
+ buffer = malloc(bufsiz);
+
+ bufsiz = ap_get_client_block(_r, buffer, bufsiz);
+
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(bufsiz));
+
+ if (bufsiz > 0) {
+ Tcl_SetVar2Ex(interp, "R", NULL, Tcl_NewByteArrayObj(buffer, bufsiz), TCL_LEAVE_ERR_MSG);
+ }
+
+ return TCL_OK;
+}
+
+int cmd_ap_discard_request_body(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_discard_request_body(_r)));
+
+ return TCL_OK;
+}
+
+int cmd_ap_note_auth_failure(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ ap_note_auth_failure(_r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_note_basic_auth_failure(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ ap_note_basic_auth_failure(_r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_note_digest_auth_failure(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ ap_note_digest_auth_failure(_r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_basic_auth_pw(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ const char *pw;
+ int xx;
+
+ xx = ap_get_basic_auth_pw(_r, &pw);
+
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(xx));
+
+ if (xx != 0) {
+ Tcl_SetVar2Ex(interp, "R", NULL, Tcl_NewStringObj(pw, -1), TCL_LEAVE_ERR_MSG);
+ }
+
+ return TCL_OK;
+}
+
+/* skip ap_set_sub_req_protocol() and ap_finalize_sub_req_protocol() */
+
+int cmd_ap_parse_uri(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "uri");
+
+ return TCL_ERROR;
+ }
+
+ ap_parse_uri(_r, Tcl_GetString(objv[1]));
+
+ return TCL_OK;
+}
+
+/* skip ap_getline(), not sure what it does yet */
+
+int cmd_ap_method_number_of(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_method_number_of(Tcl_GetString(objv[1]))));
+
+ return TCL_OK;
+}
+
+int cmd_ap_method_name_of(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int methnum;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &methnum);
+
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_method_name_of(methnum), -1));
+
+ return TCL_OK;
+}
+
+/* http_request.h */
+
+/* skip sub requests ... */
+
+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_ap_internal_redirect_handler(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_handler(Tcl_GetString(objv[1]), _r);
+
+ return TCL_OK;
+}
+
+int cmd_ap_some_auth_required(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewIntObj(ap_some_auth_required(_r)));
+
+ return TCL_OK;
+}
+
+/* skip ap_is_initial_req() */
+
+int cmd_ap_update_mtime(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int dependency_mtime;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dependency_mtime");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &dependency_mtime);
+
+ ap_update_mtime(_r, dependency_mtime);
+
+ return TCL_OK;
+}
+
+int cmd_ap_allow_methods(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ int reset;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "reset methods");
+
+ return TCL_ERROR;
+ }
+
+ Tcl_GetIntFromObj(interp, objv[1], &reset);
+
+ ap_allow_methods(_r, reset, Tcl_GetString(objv[2]));
+
+ return TCL_OK;
+}
+
+/* httpd.h */
+
+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_add_version_component(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "component");
+
+ return TCL_ERROR;
+ }
+
+ ap_add_version_component(_pconf, Tcl_GetString(objv[1]));
+
+ return TCL_OK;
+}
+
+int cmd_ap_get_server_built(ClientData cd, Tcl_Interp *ixx, int objc, Tcl_Obj *CONST objv[])
+{
+ Tcl_SetObjResult(ixx, Tcl_NewStringObj(ap_get_server_built(), -1));
+
+ return TCL_OK;
+}
+
+/* util_script.h */
+
+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;
+}
diff --git a/tcl_core.c b/tcl_core.c
index e9575e3..03d509a 100644
--- a/tcl_core.c
+++ b/tcl_core.c
@@ -74,14 +74,18 @@
/* 8 */ static int tcl_fixups(request_rec *r);
/* 9 */ static int tcl_log_transaction(request_rec *r);
+/* 10 */ static int tcl_http_method(const 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);
+static const char* tcl_raw_args(cmd_parms *parms, void *mconfig, char *arg);
+static const char *tcl_no_args(cmd_parms *parms, void *mconfig);
typedef const char* (*fz_t)(void);
-#define NUM_HANDLERS 10
+#define NUM_HANDLERS 11
static const command_rec tcl_commands[] = {
AP_INIT_FLAG( "Tcl", (fz_t) sfl, (void*) 1, OR_AUTHCFG, "turn mod_tcl on or off." ),
@@ -97,6 +101,9 @@
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." ),
+ AP_INIT_TAKE1( "Tcl_Hook_HTTP_Method", (fz_t) add_hand, (void*) 10, OR_AUTHCFG, "add http_method handlers." ),
+ AP_INIT_RAW_ARGS( "<Tcl>", (fz_t) tcl_raw_args, NULL, OR_AUTHCFG, "add raw tcl to the interpreter." ),
+ AP_INIT_NO_ARGS( "</Tcl>", (fz_t) tcl_no_args, NULL, OR_AUTHCFG, "end of tcl section." ),
{ NULL }
};
@@ -120,6 +127,10 @@
ap_hook_fixups(tcl_fixups, NULL, NULL, AP_HOOK_MIDDLE);
ap_hook_log_transaction(tcl_log_transaction, NULL, NULL, AP_HOOK_MIDDLE);
*/
+
+/*
+ ap_hook_http_method(tcl_http_method, NULL, NULL, AP_HOOK_MIDDLE);
+*/
}
AP_DECLARE_DATA module tcl_module = {
@@ -142,6 +153,7 @@
int fl;
char *handlers[NUM_HANDLERS];
apr_array_header_t *var_list;
+ apr_array_header_t *raw_list;
} tcl_config_rec;
static void* tcl_create_dir_config(apr_pool_t *p, char *d)
@@ -151,10 +163,9 @@
tclr->fl = 0;
tclr->var_list = apr_make_array(p, 0, sizeof(var_cache));
+ tclr->raw_list = apr_make_array(p, 0, sizeof(char*));
- for (i = 0; i < NUM_HANDLERS; i++) {
- tclr->handlers[i] = NULL;
- }
+ memset(tclr->handlers, 0, NUM_HANDLERS * sizeof(char*));
return tclr;
}
@@ -221,6 +232,53 @@
return NULL;
}
+static const char *tcl_raw_args(cmd_parms *parms, void *mconfig, char *arg)
+{
+ tcl_config_rec *tclr = (tcl_config_rec*) mconfig;
+ char l[MAX_STRING_LEN];
+ char **line, *script, **xx;
+ int i, j = 0, k = 0;
+ apr_array_header_t *temp = apr_make_array(parms->pool, 0, sizeof(char*));
+ char **temp_elts = (char**) temp->elts;
+
+ while (!(ap_cfg_getline(l, MAX_STRING_LEN, parms->config_file))) {
+ if (!strncasecmp(l, "</Tcl>", 6)) {
+ goto cleanup;
+ }
+
+ line = (char**) apr_push_array(temp);
+ j += asprintf(line, l);
+ k++;
+ }
+
+ cleanup:
+
+ script = (char*) malloc(j + k + 1);
+ j = 0;
+
+ for (i = 0; i < temp->nelts; i++) {
+ memcpy(&(script[j]), temp_elts[i], j += strlen(temp_elts[i]));
+ script[j] = '\n';
+ j++;
+
+ free(temp_elts[i]);
+ }
+
+ script[j] = '\0';
+
+ xx = (char**) apr_push_array(tclr->raw_list);
+ *xx = apr_pstrdup(parms->pool, script);
+
+ free(script);
+
+ return NULL;
+}
+
+static const char *tcl_no_args(cmd_parms *parms, void *dummy)
+{
+ return NULL;
+}
+
void run_script(Tcl_Interp* interp, char *fmt, ...)
{
char *bptr = NULL;
@@ -240,7 +298,7 @@
free(bptr);
}
-void set_var(Tcl_Interp* interp, const char *var1, const char *var2, const char *fmt, ...)
+void set_var(Tcl_Interp* interp, char *var1, char *var2, const char *fmt, ...)
{
char *bptr;
va_list va;
@@ -252,20 +310,27 @@
obj = Tcl_NewStringObj(bptr, -1);
- if (Tcl_SetVar2Ex(interp, (char*) var1, (char*) var2, obj, TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_SetVar2Ex(interp, var1, 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)
+void set_vari(Tcl_Interp* interp, char *var1, char *var2, int var)
+{
+ if (Tcl_SetVar2Ex(interp, var1, var2, Tcl_NewIntObj(var), TCL_LEAVE_ERR_MSG) == NULL) {
+ ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL, "Tcl_SetVarEx2(%s, %s, %d): %s", var1, var2 ? var2 : "NULL", var, Tcl_GetStringResult(interp));
+ }
+}
+
+void set_varb(Tcl_Interp* interp, char *var1, char *var2, char *data, int len)
{
Tcl_Obj *obj;
- obj = Tcl_NewByteArrayObj((unsigned char*) data, len);
+ obj = Tcl_NewByteArrayObj(data, len);
- if (Tcl_SetVar2Ex(interp, (char*) var1, (char*) var2, obj, TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_SetVar2Ex(interp, var1, 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));
}
}
@@ -277,12 +342,14 @@
Tcl_Interp *interp = NULL;
apr_array_header_t *fcache = NULL;
+apr_pool_t *_pconf = 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)
{
+ _pconf = pconf;
fcache = apr_make_array(pconf, 0, sizeof(file_cache));
interp = Tcl_CreateInterp();
@@ -294,80 +361,116 @@
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_vari(interp, "DECLINED", NULL, DECLINED);
+ set_vari(interp, "DONE", NULL, DONE);
+ set_vari(interp, "OK", NULL, OK);
- 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);
+ /* legacy */
+ set_vari(interp, "BAD_REQUEST", NULL, HTTP_BAD_REQUEST);
+ set_vari(interp, "REDIRECT", NULL, HTTP_MOVED_TEMPORARILY);
+ set_vari(interp, "SERVER_ERROR", NULL, HTTP_INTERNAL_SERVER_ERROR);
+ set_vari(interp, "NOT_FOUND", NULL, HTTP_NOT_FOUND);
- 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_vari(interp, "M_POST", NULL, M_POST);
+ set_vari(interp, "M_GET", NULL, M_GET);
+ set_vari(interp, "M_PUT", NULL, M_PUT);
+ set_vari(interp, "M_DELETE", NULL, M_DELETE);
+ set_vari(interp, "M_CONNECT", NULL, M_CONNECT);
+ set_vari(interp, "M_OPTIONS", NULL, M_OPTIONS);
+ set_vari(interp, "M_TRACE", NULL, M_TRACE);
+ set_vari(interp, "M_PATCH", NULL, M_PATCH);
+ set_vari(interp, "M_PROPFIND", NULL, M_PROPFIND);
+ set_vari(interp, "M_PROPPATCH", NULL, M_PROPPATCH);
+ set_vari(interp, "M_MKCOL", NULL, M_MKCOL);
+ set_vari(interp, "M_COPY", NULL, M_COPY);
+ set_vari(interp, "M_MOVE", NULL, M_MOVE);
+ set_vari(interp, "M_LOCK", NULL, M_LOCK);
+ set_vari(interp, "M_UNLOCK", NULL, M_UNLOCK);
+ set_vari(interp, "M_INVALID", NULL, M_INVALID);
- 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);
+ set_vari(interp, "HTTP_CONTINUE", NULL, HTTP_CONTINUE);
+ set_vari(interp, "HTTP_SWITCHING_PROTOCOLS", NULL, HTTP_SWITCHING_PROTOCOLS);
+ set_vari(interp, "HTTP_PROCESSING", NULL, HTTP_PROCESSING);
+ set_vari(interp, "HTTP_OK", NULL, HTTP_OK);
+ set_vari(interp, "HTTP_CREATED", NULL, HTTP_CREATED);
+ set_vari(interp, "HTTP_ACCEPTED", NULL, HTTP_ACCEPTED);
+ set_vari(interp, "HTTP_NON_AUTHORITATIVE", NULL, HTTP_NON_AUTHORITATIVE);
+ set_vari(interp, "HTTP_NO_CONTENT", NULL, HTTP_NO_CONTENT);
+ set_vari(interp, "HTTP_RESET_CONTENT", NULL, HTTP_RESET_CONTENT);
+ set_vari(interp, "HTTP_PARTIAL_CONTENT", NULL, HTTP_PARTIAL_CONTENT);
+ set_vari(interp, "HTTP_MULTI_STATUS", NULL, HTTP_MULTI_STATUS);
+ set_vari(interp, "HTTP_MULTIPLE_CHOICES", NULL, HTTP_MULTIPLE_CHOICES);
+ set_vari(interp, "HTTP_MOVED_PERMANENTLY", NULL, HTTP_MOVED_PERMANENTLY);
+ set_vari(interp, "HTTP_MOVED_TEMPORARILY", NULL, HTTP_MOVED_TEMPORARILY);
+ set_vari(interp, "HTTP_SEE_OTHER", NULL, HTTP_SEE_OTHER);
+ set_vari(interp, "HTTP_NOT_MODIFIED", NULL, HTTP_NOT_MODIFIED);
+ set_vari(interp, "HTTP_USE_PROXY", NULL, HTTP_USE_PROXY);
+ set_vari(interp, "HTTP_TEMPORARY_REDIRECT", NULL, HTTP_TEMPORARY_REDIRECT);
+ set_vari(interp, "HTTP_BAD_REQUEST", NULL, HTTP_BAD_REQUEST);
+ set_vari(interp, "HTTP_UNAUTHORIZED", NULL, HTTP_UNAUTHORIZED);
+ set_vari(interp, "HTTP_PAYMENT_REQUIRED", NULL, HTTP_PAYMENT_REQUIRED);
+ set_vari(interp, "HTTP_FORBIDDEN", NULL, HTTP_FORBIDDEN);
+ set_vari(interp, "HTTP_NOT_FOUND", NULL, HTTP_NOT_FOUND);
+ set_vari(interp, "HTTP_METHOD_NOT_ALLOWED", NULL, HTTP_METHOD_NOT_ALLOWED);
+ set_vari(interp, "HTTP_NOT_ACCEPTABLE", NULL, HTTP_NOT_ACCEPTABLE);
+ set_vari(interp, "HTTP_PROXY_AUTHENTICATION_REQUIRED", NULL, HTTP_PROXY_AUTHENTICATION_REQUIRED);
+ set_vari(interp, "HTTP_REQUEST_TIME_OUT", NULL, HTTP_REQUEST_TIME_OUT);
+ set_vari(interp, "HTTP_CONFLICT", NULL, HTTP_CONFLICT);
+ set_vari(interp, "HTTP_GONE", NULL, HTTP_GONE);
+ set_vari(interp, "HTTP_LENGTH_REQUIRED", NULL, HTTP_LENGTH_REQUIRED);
+ set_vari(interp, "HTTP_PRECONDITION_FAILED", NULL, HTTP_PRECONDITION_FAILED);
+ set_vari(interp, "HTTP_REQUEST_ENTITY_TOO_LARGE", NULL, HTTP_REQUEST_ENTITY_TOO_LARGE);
+ set_vari(interp, "HTTP_REQUEST_URI_TOO_LARGE", NULL, HTTP_REQUEST_URI_TOO_LARGE);
+ set_vari(interp, "HTTP_UNSUPPORTED_MEDIA_TYPE", NULL, HTTP_UNSUPPORTED_MEDIA_TYPE);
+ set_vari(interp, "HTTP_RANGE_NOT_SATISFIABLE", NULL, HTTP_RANGE_NOT_SATISFIABLE);
+ set_vari(interp, "HTTP_EXPECTATION_FAILED", NULL, HTTP_EXPECTATION_FAILED);
+ set_vari(interp, "HTTP_UNPROCESSABLE_ENTITY", NULL, HTTP_UNPROCESSABLE_ENTITY);
+ set_vari(interp, "HTTP_LOCKED", NULL, HTTP_LOCKED);
+ set_vari(interp, "HTTP_FAILED_DEPENDENCY", NULL, HTTP_FAILED_DEPENDENCY);
+ set_vari(interp, "HTTP_INTERNAL_SERVER_ERROR", NULL, HTTP_INTERNAL_SERVER_ERROR);
+ set_vari(interp, "HTTP_NOT_IMPLEMENTED", NULL, HTTP_NOT_IMPLEMENTED);
+ set_vari(interp, "HTTP_BAD_GATEWAY", NULL, HTTP_BAD_GATEWAY);
+ set_vari(interp, "HTTP_SERVICE_UNAVAILABLE", NULL, HTTP_SERVICE_UNAVAILABLE);
+ set_vari(interp, "HTTP_GATEWAY_TIME_OUT", NULL, HTTP_GATEWAY_TIME_OUT);
+ set_vari(interp, "HTTP_VERSION_NOT_SUPPORTED", NULL, HTTP_VERSION_NOT_SUPPORTED);
+ set_vari(interp, "HTTP_VARIANT_ALSO_VARIES", NULL, HTTP_VARIANT_ALSO_VARIES);
+ set_vari(interp, "HTTP_INSUFFICIENT_STORAGE", NULL, HTTP_INSUFFICIENT_STORAGE);
+ set_vari(interp, "HTTP_NOT_EXTENDED", NULL, HTTP_NOT_EXTENDED);
+ set_vari(interp, "REMOTE_HOST", NULL, REMOTE_HOST);
+ set_vari(interp, "REMOTE_NAME", NULL, REMOTE_NAME);
+ set_vari(interp, "REMOTE_NOLOOKUP", NULL, REMOTE_NOLOOKUP);
+ set_vari(interp, "REMOTE_DOUBLE_REV", NULL, REMOTE_DOUBLE_REV);
+
+ set_vari(interp, "APLOG_EMERG", NULL, APLOG_EMERG);
+ set_vari(interp, "APLOG_ALERT", NULL, APLOG_ALERT);
+ set_vari(interp, "APLOG_CRIT", NULL, APLOG_CRIT);
+ set_vari(interp, "APLOG_ERR", NULL, APLOG_ERR);
+ set_vari(interp, "APLOG_WARNING", NULL, APLOG_WARNING);
+ set_vari(interp, "APLOG_NOTICE", NULL, APLOG_NOTICE);
+ set_vari(interp, "APLOG_INFO", NULL, APLOG_INFO);
+ set_vari(interp, "APLOG_DEBUG", NULL, APLOG_DEBUG);
+ set_vari(interp, "APLOG_NOERRNO", NULL, APLOG_NOERRNO);
+
+ set_vari(interp, "REQUEST_NO_BODY", NULL, REQUEST_NO_BODY);
+ set_vari(interp, "REQUEST_CHUNKED_ERROR", NULL, REQUEST_CHUNKED_ERROR);
+ set_vari(interp, "REQUEST_CHUNKED_DECHUNK", NULL, REQUEST_CHUNKED_DECHUNK);
+
+ /* misc util */
+ 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);
+
+ /* read and set stuff from request_rec */
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 */
+ /* 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);
@@ -386,14 +489,56 @@
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);
+ /* http_log.h */
+ Tcl_CreateObjCommand(interp, "ap_log_error", cmd_ap_log_error, NULL, NULL);
- Tcl_CreateObjCommand(interp, "random", cmd_random, NULL, NULL);
- Tcl_CreateObjCommand(interp, "srandom", cmd_srandom, NULL, NULL);
+ /* http_protocol.h */
+ Tcl_CreateObjCommand(interp, "ap_send_http_header", cmd_ap_send_http_header, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_send_http_trace", cmd_ap_send_http_trace, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_send_http_options", cmd_ap_send_http_options, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_finalize_request_protocol", cmd_ap_finalize_request_protocol, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_send_error_response", cmd_ap_send_error_response, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_set_content_length", cmd_ap_set_content_length, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_set_keepalive", cmd_ap_set_keepalive, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_rationalize_mtime", cmd_ap_rationalize_mtime, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_make_etag", cmd_ap_make_etag, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_set_etag", cmd_ap_set_etag, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_set_last_modified", cmd_ap_set_last_modified, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_meets_conditions", cmd_ap_meets_conditions, NULL, NULL);
+ /**/
+ Tcl_CreateObjCommand(interp, "rputs", cmd_rputs, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "rwrite", cmd_rwrite, NULL, NULL);
+ /**/
+ Tcl_CreateObjCommand(interp, "ap_rputs", cmd_rputs, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_rwrite", cmd_rwrite, NULL, NULL);
+ /**/
+ Tcl_CreateObjCommand(interp, "ap_rflush", cmd_ap_rflush, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_status_line", cmd_ap_get_status_line, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_setup_client_block", cmd_ap_setup_client_block, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_client_block", cmd_ap_get_client_block, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_discard_request_body", cmd_ap_discard_request_body, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_note_auth_failure", cmd_ap_note_auth_failure, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_note_basic_auth_failure", cmd_ap_note_basic_auth_failure, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_note_digest_auth_failure", cmd_ap_note_digest_auth_failure, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_basic_auth_pw", cmd_ap_get_basic_auth_pw, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_parse_uri", cmd_ap_parse_uri, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_method_number_of", cmd_ap_method_number_of, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_method_name_of", cmd_ap_method_name_of, NULL, NULL);
+
+ /* http_request.h */
+ Tcl_CreateObjCommand(interp, "ap_internal_redirect", cmd_ap_internal_redirect, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_internal_redirect_handler", cmd_ap_internal_redirect_handler, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_some_auth_required", cmd_ap_some_auth_required, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_update_mtime", cmd_ap_update_mtime, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_allow_methods", cmd_ap_allow_methods, NULL, NULL);
+
+ /* httpd.h */
+ Tcl_CreateObjCommand(interp, "ap_get_server_version", cmd_ap_get_server_version, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_add_version_component", cmd_ap_add_version_component, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "ap_get_server_built", cmd_ap_get_server_built, NULL, NULL);
- Tcl_CreateObjCommand(interp, "base64_encode", cmd_base64_encode, NULL, NULL);
- Tcl_CreateObjCommand(interp, "base64_decode", cmd_base64_decode, NULL, NULL);
+ /* util_script.h */
+ Tcl_CreateObjCommand(interp, "ap_create_environment", cmd_ap_create_environment, NULL, NULL);
// provided
{
@@ -425,7 +570,7 @@
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");
+ ap_add_version_component(pconf, "mod_tcl/1.0d3");
}
static int run_handler(request_rec *r, int hh)
@@ -435,6 +580,7 @@
size_t flen = strlen(r->filename);
file_cache *fptr = NULL, *fa = (file_cache*) fcache->elts;
var_cache *vl = (var_cache*) tclr->var_list->elts;
+ char **rl = (char**) tclr->raw_list->elts;
struct stat st;
if (!(tclr->fl & 1) || !interp) {
@@ -510,6 +656,27 @@
free(namespc);
}
}
+
+ for (i = 0, pos = 0; i < tclr->raw_list->nelts; i++) {
+ int rl_len = strlen(rl[i]);
+
+ bptr = (char*) malloc(rl_len + 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, rl[i], rl_len); pos += rl_len;
+ memcpy(bptr + pos, "\n}\0", 3);
+
+ 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;
+ }
+ }
}
else if (st.st_mtime > fptr->st.st_mtime) {
int fd;
@@ -631,3 +798,8 @@
return run_handler(r, 9);
}
+static int tcl_http_method(const request_rec *r)
+{
+ /* this isn't nice at all!!! */
+ return run_handler((request_rec*) r, 10);
+}
