Google GitGoogle Git
Sign in
apache/tcl-rivet/bf0bb2a066195be28b9ba2eeb02e3d9e9c495c74/./src/mod_rivet_ng/TclWebapache.c
blob: d4ae276598caab0379b3e1fa8c68daccbe31dcb7 [file]
/* -- TclWeb.c: Common API layer. */
/*
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
distributed with this work for additional information
regarding copyright ownership. The ASF licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*/
/* Rivet config */
#ifdef HAVE_CONFIG_H
#include <rivet_config.h>
#endif
#include <tcl.h>
#include <sys/types.h>
#ifndef WIN32
#include <pwd.h>
#endif /* WIN32 */
#include <httpd.h>
#include <http_request.h>
#include <ap_compat.h>
#include <apr_strings.h>
#include "apache_request.h"
#include "mod_rivet.h"
#include "TclWeb.h"
extern module rivet_module;
extern mod_rivet_globals* module_globals;
/* It's kind of an overkill, but we define macros for handling the
* flags that control and reduce the overhead when loading the
* environment variables */
#define ENV_COMMON_VARS_M 1
#define ENV_CGI_VARS_M 2
#define ENV_VARS_M 4
#define ENV_VARS_RESET(env) env = 0;
#define ENV_COMMON_VARS(env) env |= ENV_COMMON_VARS_M;
#define ENV_CGI_VARS(env) env |= ENV_CGI_VARS_M;
#define ENV_VARS(env) env |= ENV_VARS_M;
#define ENV_IS_LOADED(env) (env == (ENV_COMMON_VARS_M | ENV_CGI_VARS_M | ENV_VARS_M))
#define ENV_COMMON_VARS_LOADED(env) (env & ENV_COMMON_VARS_M) != 0
#define ENV_CGI_VARS_LOADED(env) (env & ENV_CGI_VARS_M) != 0
#define ENV_VARS_LOADED(env) (env & ENV_VARS_M) != 0
/* This is used below to determine what part of the parmsarray to parse. */
#define PARMSARRAY_COORDINATES(i,j,parray,nargs) i = 0; j = parray->nelts; \
if (source == VAR_SRC_QUERYSTRING) { j = nargs; } \
else if (source == VAR_SRC_POST) { i = nargs; }
/*
* -- TclWeb_NewRequestObject
*
*
*/
TclWebRequest*
TclWeb_NewRequestObject (apr_pool_t *p)
{
TclWebRequest* req = (TclWebRequest *)apr_pcalloc(p, sizeof(TclWebRequest));
req->interp = NULL;
req->req = NULL;
req->apachereq = ApacheRequest_new(p);
req->headers_printed = 0;
req->headers_set = 0;
ENV_VARS_RESET(req->environment_set)
req->charset = NULL; /* we will test against NULL to check if a charset *
* was specified in the conf */
return req;
}
/*
* -- TclWeb_InitRequest
*
* called once on every HTTP request initializes fields and
* objects referenced in a TclWebRequest object
*
* Arguments:
*
* TclWebRequest* req: a pointer to a TclWebRequest object to be intialized
* Tcl_Interp* interp: current Tcl_Interp object serving the request
* void* arg: generic pointer. Current implementation passes the
* request_rec object pointer
*
*/
int
TclWeb_InitRequest(rivet_thread_private* private, Tcl_Interp *interp)
{
request_rec* r = private->r;
TclWebRequest* req = private->req;
size_t content_type_len = strlen(r->content_type);
req->interp = interp;
req->req = r;
req->apachereq = ApacheRequest_init(req->apachereq,r);
req->headers_printed = 0;
req->headers_set = 0;
ENV_VARS_RESET(req->environment_set)
req->charset = NULL;
/*
* if strlen(req->content_type) > strlen([RIVET|TCL]_FILE_CTYPE)
* a charset parameters might be there
*/
if (((private->ctype==RIVET_TEMPLATE) && (content_type_len > strlen(RIVET_TEMPLATE_CTYPE))) || \
((private->ctype==RIVET_TCLFILE) && (content_type_len > strlen(RIVET_TCLFILE_CTYPE)))) {
char* charset;
/* we parse the content type: we are after a 'charset' parameter definition */
charset = strstr(r->content_type,"charset");
if (charset != NULL) {
charset = apr_pstrdup(r->pool,charset);
/* ther's some freedom about spaces in the AddType lines: let's strip them off */
apr_collapse_spaces(charset,charset);
req->charset = charset;
}
}
return TCL_OK;
}
INLINE int
TclWeb_SendHeaders(TclWebRequest *req)
{
//TODO: fix ap_send_http_header
ap_send_http_header(req->req);
return TCL_OK;
}
INLINE int
TclWeb_StopSending(TclWebRequest *req)
{
req->req->connection->aborted = 1;
return TCL_OK;
}
/* Set up the content type header */
int
TclWeb_SetHeaderType(char *header, TclWebRequest *req)
{
if (req->headers_set)
return TCL_ERROR;
ap_set_content_type(req->req,apr_pstrdup(req->req->pool, header));
req->headers_set = 1;
return TCL_OK;
}
/* Printer headers if they haven't been printed yet */
int
TclWeb_PrintHeaders(TclWebRequest *req)
{
if (req->headers_printed)
return TCL_ERROR;
/* Let's set the charset in the headers if one was set in the configuration */
if (!req->headers_set && (req->charset != NULL)) {
TclWeb_SetHeaderType(apr_pstrcat(req->req->pool,"text/html;",req->charset,NULL),req);
}
if (req->headers_set == 0)
{
TclWeb_SetHeaderType(DEFAULT_HEADER_TYPE, req);
}
/*
* seems that ap_send_http_header is redefined to ; in Apache2.2
* ap_send_http_header(req->req);
*/
TclWeb_SendHeaders(req);
req->headers_printed = 1;
return TCL_OK;
}
/* Print nice HTML formatted errors */
int
TclWeb_PrintError(CONST84 char *errstr, int htmlflag, TclWebRequest *req)
{
TclWeb_SetHeaderType(DEFAULT_HEADER_TYPE, req);
TclWeb_PrintHeaders(req);
if (htmlflag != 1)
ap_rputs(ER1, req->req);
if (errstr != NULL)
{
if (htmlflag != 1)
{
ap_rputs(ap_escape_html(req->req->pool,errstr),req->req);
} else {
ap_rputs(errstr, req->req);
}
}
if (htmlflag != 1)
ap_rputs(ER2, req->req);
return TCL_OK;
}
INLINE int
TclWeb_HeaderSet(char *header, char *val, TclWebRequest *req)
{
apr_table_set(req->req->headers_out, header, val);
return TCL_OK;
}
/* * accessing output headers *
*
* -- TclWeb_OutputHeaderSet: replicates the role of TclWeb_HeaderSet
*
* - the name stresses the fact it's an accessor to the output
* headers
* - it returns nothing since it's a wrapper around an APR call
* that doesn't return anything
*
* -- TclWeb_OutputHeaderGet: reads from the output headers and
* returns the value associated to a key. If the key is not
* existing it returns NULL
*
*/
INLINE void
TclWeb_OutputHeaderSet(char *header, char *val, TclWebRequest *req)
{
apr_table_set(req->req->headers_out, header, val);
}
INLINE const char*
TclWeb_OutputHeaderGet(char *header, TclWebRequest *req)
{
return apr_table_get(req->req->headers_out, header);
}
INLINE int
TclWeb_HeaderAdd(char *header, char *val, TclWebRequest *req)
{
apr_table_add(req->req->headers_out, header, val);
return TCL_OK;
}
INLINE int
TclWeb_SetStatus(int status, TclWebRequest *req)
{
req->req->status = status;
return TCL_OK;
}
INLINE int
TclWeb_MakeURL(Tcl_Obj *result, char *filename, TclWebRequest *req)
{
Tcl_SetStringObj(result,
ap_construct_url(req->req->pool,filename,req->req),-1);
return TCL_OK;
}
int
TclWeb_GetVar(Tcl_Obj *result, char *varname, int source, TclWebRequest *req)
{
int i,j;
apr_array_header_t *parmsarray = (apr_array_header_t *)apr_table_elts(req->apachereq->parms);
apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
int flag = 0;
PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
/* This isn't real efficient - move to hash table later on... */
while (i < j)
{
char *parmkey = TclWeb_StringToUtf(parms[i].key, req);
if (!strncmp(varname,parmkey,
strlen(varname) < strlen(parmkey) ?
strlen(parmkey) : strlen(varname)))
{
/* The following makes sure that we get one string,
with no sub lists. */
if (flag == 0)
{
flag = 1;
Tcl_SetStringObj (result,TclWeb_StringToUtf(parms[i].val,req),-1);
} else {
Tcl_Obj *tmpobj;
Tcl_Obj *tmpobjv[2];
tmpobjv[0] = result;
tmpobjv[1] = TclWeb_StringToUtfToObj (parms[i].val,req);
tmpobj = Tcl_ConcatObj (2,tmpobjv);
Tcl_SetStringObj (result,Tcl_GetString(tmpobj),-1);
}
}
i++;
}
if (result->length == 0) { return TCL_ERROR; }
return TCL_OK;
}
int
TclWeb_GetVarAsList(Tcl_Obj *result, char *varname, int source, TclWebRequest *req) {
int i, j;
apr_array_header_t *parmsarray = (apr_array_header_t *)
apr_table_elts(req->apachereq->parms);
apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
/* This isn't real efficient - move to hash table later on. */
while (i < j)
{
if (!strncmp(varname, TclWeb_StringToUtf(parms[i].key, req),
strlen(varname) < strlen(parms[i].key) ?
strlen(parms[i].key) : strlen(varname)))
{
Tcl_ListObjAppendElement(req->interp, result,
TclWeb_StringToUtfToObj(parms[i].val, req));
}
i++;
}
if (result == NULL)
{
return TCL_ERROR;
}
return TCL_OK;
}
int
TclWeb_GetAllVars(Tcl_Obj *result, int source, TclWebRequest *req)
{
int i, j;
apr_array_header_t *parmsarray = (apr_array_header_t *)
apr_table_elts(req->apachereq->parms);
apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
while (i < j)
{
Tcl_ListObjAppendElement(req->interp,result,
TclWeb_StringToUtfToObj(parms[i].key,req));
Tcl_ListObjAppendElement(req->interp,result,
TclWeb_StringToUtfToObj(parms[i].val,req));
i++;
}
if (result == NULL)
{
return TCL_ERROR;
}
return TCL_OK;
}
int
TclWeb_GetVarNames(Tcl_Obj *result, int source, TclWebRequest *req)
{
int i, j;
apr_array_header_t *parmsarray = (apr_array_header_t *)
apr_table_elts(req->apachereq->parms);
apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
while (i < j)
{
Tcl_ListObjAppendElement(req->interp, result,
TclWeb_StringToUtfToObj(parms[i].key, req));
i++;
}
if (result == NULL)
{
return TCL_ERROR;
}
return TCL_OK;
}
int
TclWeb_VarExists(Tcl_Obj *result, char *varname, int source, TclWebRequest *req)
{
int i, j;
apr_array_header_t *parmsarray = (apr_array_header_t *)
apr_table_elts(req->apachereq->parms);
apr_table_entry_t *parms = (apr_table_entry_t *)parmsarray->elts;
PARMSARRAY_COORDINATES(i,j,parmsarray,req->apachereq->nargs)
/* This isn't real efficient - move to hash table later on. */
while (i < j)
{
if (!strncmp(varname, TclWeb_StringToUtf(parms[i].key, req),
strlen(varname) < strlen(parms[i].key) ?
strlen(parms[i].key) : strlen(varname)))
{
Tcl_SetIntObj(result, 1);
return TCL_OK;
}
i++;
}
Tcl_SetIntObj(result, 0);
return TCL_OK;
}
int
TclWeb_VarNumber(Tcl_Obj *result, int source, TclWebRequest *req)
{
apr_array_header_t *parmsarray = (apr_array_header_t *)
apr_table_elts(req->apachereq->parms);
if (source == VAR_SRC_QUERYSTRING) {
Tcl_SetIntObj(result, req->apachereq->nargs);
} else if (source == VAR_SRC_POST) {
Tcl_SetIntObj(result, parmsarray->nelts - req->apachereq->nargs);
} else {
Tcl_SetIntObj(result, parmsarray->nelts);
}
return TCL_OK;
}
/* These 2 array must be aligned and a one-to-one correspondence preserved
* The enum include_vars_idx must be terminated by 'inval_env_var'
*/
static const char* include_env_vars[] =
{
"DATE_LOCAL","DATE_GMT","LAST_MODIFIED","DOCUMENT_URI","DOCUMENT_PATH_INFO","DOCUMENT_NAME",
"QUERY_STRING_UNESCAPED","USER_NAME","RIVET_CACHE_FREE","RIVET_CACHE_SIZE",
NULL
};
enum include_vars_idx {
date_local=0,date_gmt,last_modified,document_uri,document_path_info,document_name,
query_string_unescaped,user_name,rivet_cache_free,rivet_cache_size,
invalid_env_var
};
static char*
TclWeb_SelectEnvIncludeVar (rivet_thread_private* private,int idx)
{
switch (idx)
{
case date_local:
{
apr_pool_t* pool = private->req->req->pool;
apr_time_t date = private->req->req->request_time;
return ap_ht_time(pool,date,DEFAULT_TIME_FORMAT,0);
}
case date_gmt:
{
apr_pool_t* pool = private->req->req->pool;
apr_time_t date = private->req->req->request_time;
return ap_ht_time(pool,date,DEFAULT_TIME_FORMAT,1);
}
case last_modified:
{
apr_pool_t* pool = private->req->req->pool;
return ap_ht_time(pool,private->req->req->finfo.mtime,DEFAULT_TIME_FORMAT,1);
}
case document_uri:
{
return private->req->req->uri;
}
case document_path_info:
{
return private->req->req->path_info;
}
case document_name:
{
char *t;
if ((t = strrchr(private->req->req->filename,'/'))) {
return ++t;
} else {
return private->req->req->uri;
}
}
case query_string_unescaped:
{
if (private->req->req->args) {
apr_pool_t* pool = private->req->req->pool;
char *arg_copy = (char*) apr_pstrdup(pool,private->req->req->args);
ap_unescape_url(arg_copy);
return ap_escape_shell_cmd(pool,arg_copy);
} else {
return NULL;
}
}
case user_name:
{
#ifndef WIN32
struct passwd *pw = (struct passwd *) getpwuid(private->req->req->finfo.user);
if (pw) {
//apr_table_set( table, "USER_NAME",
// apr_pstrdup( pool, pw->pw_name ) );
return pw->pw_name;
} else {
apr_pool_t* pool = private->req->req->pool;
return (char*) apr_psprintf(pool,"user#%lu",(unsigned long)private->req->req->finfo.user);
}
#else
return NULL;
#endif
}
case rivet_cache_free:
{
apr_pool_t* pool = private->req->req->pool;
return (char*) apr_psprintf (pool, "%d",(RIVET_PEEK_INTERP(private,private->running_conf))->cache_free);
}
case rivet_cache_size:
{
apr_pool_t* pool = private->req->req->pool;
return (char*) apr_psprintf (pool, "%d",(RIVET_PEEK_INTERP(private,private->running_conf))->cache_size);
}
}
return NULL;
}
/*
* -- TclWeb_InitEnvVars
*
* Load the CGI and environment variables into the request_rec environment structure
* Variables belong to 3 cathegories
*
* + common variables (ap_add_common_vars)
* + CGI variables (ad_cgi_vars)
* + a miscellaneous set of variables
* listed in the array include_env_vars
*
* Each cathegory is controlled by flags in order to reduce the overhead of getting them
* into request_rec in case previous call to ::rivet::env could have already forced them
* into request_rec
*/
static void
TclWeb_InitEnvVars (rivet_thread_private* private)
{
TclWebRequest *req = private->req;
apr_table_t *table;
int idx;
if (ENV_IS_LOADED(req->environment_set)) return;
table = req->req->subprocess_env;
/* Retrieve cgi variables. */
if (!ENV_CGI_VARS_LOADED(req->environment_set))
{
ap_add_cgi_vars(req->req);
ENV_CGI_VARS(req->environment_set);
}
if (!ENV_COMMON_VARS_LOADED(req->environment_set))
{
ap_add_common_vars(req->req);
ENV_COMMON_VARS(req->environment_set)
}
/* Loading into 'table' the include vars */
/* actually this is not necessary. ENV_VARS is modified only here therefore
* if it's set this function has been called already
* and it should have returned at the beginning of the execution. I keep
* it for clarity and uniformity with the CGI variables and in case
* the incremental environment control is extended
*/
if (!ENV_VARS_LOADED(req->environment_set))
{
for (idx = 0;idx < invalid_env_var;idx++)
{
apr_table_set(table,include_env_vars[idx],TclWeb_SelectEnvIncludeVar(private,idx));
}
ENV_VARS(req->environment_set)
}
}
static char*
TclWeb_GetEnvIncludeVar (rivet_thread_private* private,char* key)
{
int idx;
for (idx = 0;idx < invalid_env_var; idx++)
{
const char* include_var_p = include_env_vars[idx];
if (strncmp(key,include_var_p,strlen(key) < strlen(include_var_p) ? strlen(key) : strlen(include_var_p)) == 0)
{
return TclWeb_SelectEnvIncludeVar(private,idx);
}
}
return NULL;
}
int
TclWeb_GetEnvVars(Tcl_Obj *envvar,rivet_thread_private* private)
{
int i;
apr_array_header_t *env_arr;
apr_table_entry_t *env;
Tcl_Obj *key;
Tcl_Obj *val;
TclWebRequest *req;
TclWeb_InitEnvVars(private);
req = private->req;
Tcl_IncrRefCount(envvar);
/* Transfer Apache internal CGI variables to TCL request namespace. */
env_arr = (apr_array_header_t *) apr_table_elts(req->req->subprocess_env);
env = (apr_table_entry_t *) env_arr->elts;
for (i = 0; i < env_arr->nelts; ++i)
{
if ((!env[i].key) || (!env[i].val)) {
continue;
}
key = TclWeb_StringToUtfToObj(env[i].key, req);
val = TclWeb_StringToUtfToObj(env[i].val, req);
Tcl_IncrRefCount(key);
Tcl_IncrRefCount(val);
/* Variable scope resolution changed to default (flags: 0)
* to enable creation of the array in the caller's local scope.
* Default behavior (creation in the ::request namespace)
* is now more consistently constrained by fully qualifying
* the default array names (see rivetCore.c). This should fix
* Bug #48963
*/
Tcl_ObjSetVar2(req->interp, envvar, key, val, 0);
Tcl_DecrRefCount(key);
Tcl_DecrRefCount(val);
}
Tcl_DecrRefCount(envvar);
return TCL_OK;
}
int
TclWeb_GetHeaderVars(Tcl_Obj *headersvar,rivet_thread_private* private)
{
int i;
TclWebRequest *req;
apr_array_header_t *hdrs_arr;
apr_table_entry_t *hdrs;
Tcl_Obj *key;
Tcl_Obj *val;
req = private->req;
TclWeb_InitEnvVars(private);
Tcl_IncrRefCount(headersvar);
/* Transfer client request headers to TCL request namespace. */
hdrs_arr = (apr_array_header_t*) apr_table_elts(req->req->headers_in);
hdrs = (apr_table_entry_t *) hdrs_arr->elts;
for (i = 0; i < hdrs_arr->nelts; ++i)
{
if (!hdrs[i].key)
continue;
key = TclWeb_StringToUtfToObj(hdrs[i].key, req);
val = TclWeb_StringToUtfToObj(hdrs[i].val, req);
Tcl_IncrRefCount(key);
Tcl_IncrRefCount(val);
/* See comment in TclWeb_GetEnvVars concerning Bug 48963*/
Tcl_ObjSetVar2(req->interp, headersvar, key, val, 0);
Tcl_DecrRefCount(key);
Tcl_DecrRefCount(val);
}
/* Transfer Apache internal CGI variables to TCL request namespace. */
Tcl_DecrRefCount(headersvar);
return TCL_OK;
}
INLINE int
TclWeb_Base64Encode(char *out, char *in, TclWebRequest *req)
{
out = ap_pbase64encode(req->req->pool, in);
return TCL_OK;
}
INLINE int
TclWeb_Base64Decode(char *out, char *in, TclWebRequest *req)
{
out = ap_pbase64decode(req->req->pool, in);
return TCL_OK;
}
INLINE int
TclWeb_EscapeShellCommand(char *out, char *in, TclWebRequest *req)
{
out = ap_escape_shell_cmd(req->req->pool, in);
return TCL_OK;
}
/* Functions to convert strings to UTF encoding */
/* These API's are a bit different, because it's so much more
* practical. */
char *TclWeb_StringToUtf(char *in, TclWebRequest *req)
{
char *tmp;
Tcl_DString dstr;
Tcl_DStringInit(&dstr);
Tcl_ExternalToUtfDString(NULL, in, (signed)strlen(in), &dstr);
tmp = (char*) apr_pstrdup(req->req->pool, Tcl_DStringValue(&dstr));
Tcl_DStringFree(&dstr);
return tmp;
}
INLINE Tcl_Obj *
TclWeb_StringToUtfToObj(char *in, TclWebRequest *req)
{
return Tcl_NewStringObj(TclWeb_StringToUtf(in, req), -1);
}
int TclWeb_PrepareUpload(char *varname, TclWebRequest *req)
{
req->upload = ApacheUpload_find(req->apachereq->upload, varname);
if (req->upload == NULL) {
return TCL_ERROR;
} else {
return TCL_OK;
}
}
int TclWeb_UploadChannel(char *varname, TclWebRequest *req)
{
Tcl_Channel chan;
chan = Tcl_OpenFileChannel(req->interp, req->upload->tempname, "r", 0);
if (chan == NULL) {
return TCL_ERROR;
} else {
Tcl_Obj* result;
if (Tcl_SetChannelOption(req->interp,chan,"-translation","binary") == TCL_ERROR) {
return TCL_ERROR;
}
if (Tcl_SetChannelOption(req->interp,chan,"-encoding","binary") == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_RegisterChannel(req->interp,chan);
result = Tcl_NewObj();
Tcl_SetStringObj(result, Tcl_GetChannelName(chan), -1);
Tcl_SetObjResult(req->interp, result);
return TCL_OK;
}
}
int TclWeb_UploadTempname(TclWebRequest *req)
{
Tcl_Obj *tempname = Tcl_NewObj();
Tcl_SetStringObj(tempname,TclWeb_StringToUtf(req->upload->tempname,req), -1);
Tcl_SetObjResult(req->interp, tempname);
return TCL_OK;
}
int TclWeb_UploadSave(char *varname, Tcl_Obj *filename, TclWebRequest *req)
{
apr_status_t status;
status = apr_file_copy(req->upload->tempname,Tcl_GetString(filename),APR_FILE_SOURCE_PERMS,req->req->pool);
if (status == APR_SUCCESS) {
return TCL_OK;
} else {
/* apr_strerror docs don't require a specific buffer size, we're just guessing it */
char error_msg[1024];
char* tcl_error_msg;
apr_strerror(status,error_msg,1024);
tcl_error_msg = apr_psprintf(req->req->pool,"Error copying upload '%s' to '%s' (%s)", req->upload->tempname,
Tcl_GetString(filename),
error_msg);
Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
}
int TclWeb_UploadData(char *varname, TclWebRequest *req)
{
Tcl_Obj* result;
rivet_server_conf *rsc = NULL;
rsc = RIVET_SERVER_CONF( req->req->server->module_config );
/* This sucks - we should use the hook, but I want to
get everything fixed and working first */
if (rsc->upload_files_to_var)
{
Tcl_Channel chan;
chan = Tcl_OpenFileChannel (req->interp, req->upload->tempname, "r", 0);
if (chan == NULL) {
char* tcl_error_msg;
int error_number = Tcl_GetErrno();
Tcl_AddErrorInfo(req->interp,"Error opening channel to uploaded data");
tcl_error_msg = apr_psprintf(req->req->pool,"Error setting channel option '%s': %s",
Tcl_ErrnoId(), Tcl_ErrnoMsg(error_number));
Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
if (Tcl_SetChannelOption(req->interp, chan, "-translation", "binary") == TCL_ERROR) {
char* tcl_error_msg;
int error_number = Tcl_GetErrno();
tcl_error_msg = apr_psprintf(req->req->pool,"Error setting channel option '%s': %s",
Tcl_ErrnoId(), Tcl_ErrnoMsg(error_number));
Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
if (Tcl_SetChannelOption(req->interp, chan, "-encoding", "binary") == TCL_ERROR) {
char* tcl_error_msg;
int error_number = Tcl_GetErrno();
tcl_error_msg = apr_psprintf(req->req->pool,"Error setting channel option '%s': %s",
Tcl_ErrnoId(), Tcl_ErrnoMsg(error_number));
Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
/* Put data in a variable */
result = Tcl_NewObj();
Tcl_ReadChars(chan, result, (int)ApacheUpload_size(req->upload), 0);
if (Tcl_Close(req->interp, chan) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_SetObjResult(req->interp, result);
} else {
Tcl_AppendResult(req->interp,
"RivetServerConf UploadFilesToVar is not set", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
int TclWeb_UploadSize(TclWebRequest *req)
{
Tcl_Obj* result = Tcl_NewObj();
Tcl_SetIntObj(result, (int)ApacheUpload_size(req->upload));
Tcl_SetObjResult(req->interp, result);
return TCL_OK;
}
int TclWeb_UploadType(TclWebRequest *req)
{
Tcl_Obj *type = Tcl_NewObj();
/* If there is a type, return it, if not, return blank. */
Tcl_SetStringObj(type, ApacheUpload_type(req->upload)
? (char *)ApacheUpload_type(req->upload) : (char *)"", -1);
Tcl_SetObjResult(req->interp, type);
return TCL_OK;
}
int TclWeb_UploadFilename(TclWebRequest *req)
{
Tcl_Obj *filename = Tcl_NewObj();
Tcl_SetStringObj(filename,TclWeb_StringToUtf(req->upload->filename,req), -1);
Tcl_SetObjResult(req->interp, filename);
return TCL_OK;
}
int TclWeb_UploadNames(TclWebRequest *req)
{
ApacheUpload *upload;
Tcl_Obj *names = Tcl_NewObj();
upload = ApacheRequest_upload(req->apachereq);
while (upload)
{
Tcl_ListObjAppendElement(req->interp,names,TclWeb_StringToUtfToObj(upload->name,req));
upload = upload->next;
}
Tcl_SetObjResult(req->interp,names);
return TCL_OK;
}
char *
TclWeb_GetEnvVar(rivet_thread_private* private,char *key)
{
char *val;
TclWebRequest *req = private->req;
/* Check to see if it's a header variable first. */
val = (char *)apr_table_get (req->req->headers_in,key);
if (val) { return val; }
/* We incrementally prepare subprocess_env */
/* CGI common vars first */
if (!ENV_COMMON_VARS_LOADED(req->environment_set))
{
ap_add_common_vars(req->req);
ENV_COMMON_VARS(req->environment_set)
}
val = (char *)apr_table_get(req->req->subprocess_env,key);
if (val) { return val; }
/* CGI HTTP 1.1 vars */
if (!ENV_CGI_VARS_LOADED(req->environment_set))
{
ap_add_cgi_vars(req->req);
ENV_CGI_VARS(req->environment_set)
}
val = (char *)apr_table_get(req->req->subprocess_env,key);
if (val) { return val; }
return TclWeb_GetEnvIncludeVar(private,key);
}
char *
TclWeb_GetVirtualFile(TclWebRequest *req, char *virtualname)
{
request_rec *apreq;
char *filename = NULL;
apreq = ap_sub_req_lookup_uri( virtualname, req->req, NULL );
//if( apreq->status == 200 && apreq->finfo.st_mode != 0 ) {
//TODO: is this the right behaviour?
if( apreq->status == 200 && apreq->finfo.filetype != APR_NOFILE ) {
filename = apreq->filename;
}
if( apreq != NULL ) ap_destroy_sub_req( apreq );
return( filename );
}
/*
*-----------------------------------------------------------------------------
*
* TclWeb_GetRawPost --
*
* Fetch the raw POST data from the request.
*
* Results:
* The data, or NULL if it's not a POST or there is no data.
*
* Side Effects:
* None.
*
*-----------------------------------------------------------------------------
*/
char *
TclWeb_GetRawPost ( TclWebRequest *req )
{
return ApacheRequest_get_raw_post(req->apachereq);
}