You are viewing a plain text version of this content. The canonical link for it is here.
Posted to websh-cvs@tcl.apache.org by ro...@apache.org on 2002/04/18 16:40:12 UTC
cvs commit: tcl-websh/src/generic cfg.c mod_websh.c mod_websh.h modwebsh.h modwebsh_ap.c modwebsh_cgi.c request.h request_ap.c request_cgi.c
ronnie 02/04/18 07:40:12
Modified: src/generic cfg.c mod_websh.c mod_websh.h modwebsh.h
modwebsh_ap.c modwebsh_cgi.c request.h request_ap.c
request_cgi.c
Log:
- removed handling of [web::config script] from Web_Cfg (cfg.c)
- call Web_ConfigPath in Web_Cfg to handle all mod_webh specific stuff (cfg.c)
- added a second assoc data to pool interpreter (mod_websh.c mod_websh.h)
- added Web_ConfigPath (modwebsh_ap.c modwebsh_cgi.c modwebsh.h)
- removed requestScriptName (request_ap.c request_cgi.c request.h)
Revision Changes Path
1.11 +10 -11 tcl-websh/src/generic/cfg.c
Index: cfg.c
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/cfg.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- cfg.c 17 Apr 2002 11:27:37 -0000 1.10
+++ cfg.c 18 Apr 2002 14:40:11 -0000 1.11
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: cfg.c,v 1.10 2002/04/17 11:27:37 davidw Exp $
+ * @(#) $Id: cfg.c,v 1.11 2002/04/18 14:40:11 ronnie Exp $
* ------------------------------------------------------------------------- */
#include <tcl.h>
@@ -163,8 +163,8 @@
INTERPCLASS
};
-
- int idx1;
+ int idx1, result;
+
CfgData *cfgData = NULL;
WebAssertData(interp, clientData, "Web_Cfg", TCL_ERROR);
@@ -174,11 +174,17 @@
* parse arguments
* ----------------------------------------------------------------------- */
if (objc < 2) {
-
Tcl_GetIndexFromObj(interp, objv[0], subCmd1, "usage", 0, &idx1);
return TCL_ERROR;
}
+ /* ---------------------------------------------------------------------
+ * handle special config stuff (mod_websh)
+ * ------------------------------------------------------------------ */
+ result = Web_ConfigPath(interp, objc, objv);
+ if (result != TCL_CONTINUE)
+ return result;
+
/* ------------------------------------------------------------------------
* determine first sub-command
* --------------------------------------------------------------------- */
@@ -458,13 +464,6 @@
Tcl_SetBooleanObj(cfgData->requestData->cmdUrlTimestamp, 1);
- return TCL_OK;
- }
- case SCRIPT: {
- char *scriptname;
- WebAssertObjc(objc != 2, 2, NULL);
- requestScriptName(interp, &scriptname);
- Tcl_SetResult(interp, scriptname, NULL);
return TCL_OK;
}
default:
1.13 +5 -1 tcl-websh/src/generic/mod_websh.c
Index: mod_websh.c
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/mod_websh.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- mod_websh.c 17 Apr 2002 11:27:37 -0000 1.12
+++ mod_websh.c 18 Apr 2002 14:40:11 -0000 1.13
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: mod_websh.c,v 1.12 2002/04/17 11:27:37 davidw Exp $
+ * @(#) $Id: mod_websh.c,v 1.13 2002/04/18 14:40:11 ronnie Exp $
* ------------------------------------------------------------------------- */
/* ====================================================================
@@ -281,6 +281,9 @@
Tcl_SetAssocData(webInterp->interp, WEB_AP_ASSOC_DATA, NULL,
(ClientData) r);
+ Tcl_SetAssocData(webInterp->interp, WEB_INTERP_ASSOC_DATA, NULL,
+ (ClientData) webInterp);
+
if (createApchannel(webInterp->interp, r) != TCL_OK) {
#ifndef APACHE2
ap_log_printf(r->server, "mod_websh - cannot create apchannel\n");
@@ -341,6 +344,7 @@
}
Tcl_DeleteAssocData(webInterp->interp, WEB_AP_ASSOC_DATA);
+ Tcl_DeleteAssocData(webInterp->interp, WEB_INTERP_ASSOC_DATA);
poolReleaseWebInterp(webInterp);
1.4 +2 -1 tcl-websh/src/generic/mod_websh.h
Index: mod_websh.h
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/mod_websh.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mod_websh.h 25 Oct 2001 17:50:13 -0000 1.3
+++ mod_websh.h 18 Apr 2002 14:40:11 -0000 1.4
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: mod_websh.h,v 1.3 2001/10/25 17:50:13 davidw Exp $
+ * @(#) $Id: mod_websh.h,v 1.4 2002/04/18 14:40:11 ronnie Exp $
*
*/
@@ -41,6 +41,7 @@
#endif /* APACHE2 */
#define WEB_AP_ASSOC_DATA "web::ap"
+#define WEB_INTERP_ASSOC_DATA "web::interp"
typedef struct
{
1.4 +3 -1 tcl-websh/src/generic/modwebsh.h
Index: modwebsh.h
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/modwebsh.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modwebsh.h 25 Oct 2001 17:50:13 -0000 1.3
+++ modwebsh.h 18 Apr 2002 14:40:11 -0000 1.4
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: modwebsh.h,v 1.3 2001/10/25 17:50:13 davidw Exp $
+ * @(#) $Id: modwebsh.h,v 1.4 2002/04/18 14:40:11 ronnie Exp $
*
*/
@@ -34,6 +34,8 @@
int Web_InterpClassCfg(ClientData clientData,
Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[]);
+
+int Web_ConfigPath(Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[]);
int modwebsh_createcmd(Tcl_Interp * interp);
1.8 +68 -3 tcl-websh/src/generic/modwebsh_ap.c
Index: modwebsh_ap.c
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/modwebsh_ap.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modwebsh_ap.c 9 Apr 2002 13:42:07 -0000 1.7
+++ modwebsh_ap.c 18 Apr 2002 14:40:11 -0000 1.8
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: modwebsh_ap.c,v 1.7 2002/04/09 13:42:07 ronnie Exp $
+ * @(#) $Id: modwebsh_ap.c,v 1.8 2002/04/18 14:40:11 ronnie Exp $
*
*/
@@ -422,11 +422,76 @@
Tcl_SetObjResult(interp, Tcl_GetObjResult(conf->mainInterp));
Tcl_ResetResult(conf->mainInterp);
}
-#ifdef APACHE2
+
Tcl_MutexUnlock(&(conf->mainInterpLock));
-#endif /* APACHE2 */
+
return res;
}
+
+
+/* ----------------------------------------------------------------------------
+ * Web_ConfigPath -- (sub)command in pool interp (called from Web_Cfg)
+ * ------------------------------------------------------------------------- */
+
+int Web_ConfigPath(Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[]) {
+
+ /* these options should be in sync with the options in Web_Cfg
+ * not the order or anything, but the actual text strings */
+ static char *subCmd[] = {
+ "script",
+ "server_root",
+ "document_root",
+ "interpclass",
+ NULL
+ };
+
+ enum subCmd
+ {
+ SCRIPT,
+ SERVER_ROOT,
+ DOCUMENT_ROOT,
+ INTERPCLASS
+ };
+
+ int index;
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], subCmd, "subcommand", 0, &index)
+ != TCL_OK) {
+ /* let the caller handle the web::config command */
+ Tcl_ResetResult(interp);
+ return TCL_CONTINUE;
+ }
+
+ WebAssertObjc(objc != 2, 2, NULL);
+
+ switch ((enum subCmd) index) {
+
+ case SCRIPT: {
+ request_rec *r;
+ r = (request_rec *)Tcl_GetAssocData(interp, WEB_AP_ASSOC_DATA, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(r->filename, -1));
+ break;
+ }
+ case SERVER_ROOT: {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(ap_server_root, -1));
+ break;
+ }
+ case DOCUMENT_ROOT: {
+ request_rec *r;
+ r = (request_rec *)Tcl_GetAssocData(interp, WEB_AP_ASSOC_DATA, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(ap_document_root(r), -1));
+ break;
+ }
+ case INTERPCLASS: {
+ WebInterp *webInterp;
+ webInterp = (WebInterp *)Tcl_GetAssocData(interp, WEB_INTERP_ASSOC_DATA, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(webInterp->interpClass->filename, -1));
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
/* -------------------------------------------------------------------------
1.5 +67 -1 tcl-websh/src/generic/modwebsh_cgi.c
Index: modwebsh_cgi.c
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/modwebsh_cgi.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modwebsh_cgi.c 5 Apr 2002 09:18:52 -0000 1.4
+++ modwebsh_cgi.c 18 Apr 2002 14:40:11 -0000 1.5
@@ -9,11 +9,12 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: modwebsh_cgi.c,v 1.4 2002/04/05 09:18:52 ronnie Exp $
+ * @(#) $Id: modwebsh_cgi.c,v 1.5 2002/04/18 14:40:11 ronnie Exp $
*
*/
#include "tcl.h"
+#include "macros.h"
/* ----------------------------------------------------------------------------
* Web_Initializer -- just eval the code
@@ -96,6 +97,71 @@
return TCL_OK;
}
+
+/* ----------------------------------------------------------------------------
+ * Web_ConfigPath -- (sub)command (called from Web_Cfg)
+ * ------------------------------------------------------------------------- */
+
+int Web_ConfigPath(Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[]) {
+
+ /* these options should be in sync with the options in Web_Cfg
+ * not the order or anything, but the actual text strings */
+ static char *subCmd[] = {
+ "script",
+ "server_root",
+ "document_root",
+ "interpclass",
+ NULL
+ };
+
+ enum subCmd
+ {
+ SCRIPT,
+ SERVER_ROOT,
+ DOCUMENT_ROOT,
+ INTERPCLASS
+ };
+
+ int index;
+ Tcl_Obj *res = NULL;
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], subCmd, "subcommand", 0, &index)
+ != TCL_OK) {
+ /* let the caller handle the web::config command */
+ Tcl_ResetResult(interp);
+ return TCL_CONTINUE;
+ }
+
+ /* fixme: usefull returns for cgi mode */
+
+ WebAssertObjc(objc != 2, 2, NULL);
+
+ switch ((enum subCmd) index) {
+
+ case SCRIPT: {
+ res = tclSetEnv(interp, "SCRIPT_FILENAME", NULL);
+ break;
+ }
+ case SERVER_ROOT: {
+ res = tclSetEnv(interp, "SERVER_ROOT", NULL);
+ break;
+ }
+ case DOCUMENT_ROOT: {
+ res = tclSetEnv(interp, "DOCUMENT_ROOT", NULL);
+ break;
+ }
+ case INTERPCLASS: {
+ res = tclSetEnv(interp, "SCRIPT_FILENAME", NULL);
+ break;
+ }
+ }
+ /* reset errors from getting invalid env vars */
+ Tcl_ResetResult(interp);
+ if (res)
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK;
+}
+
/* -------------------------------------------------------------------------
* init --
1.8 +1 -3 tcl-websh/src/generic/request.h
Index: request.h
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/request.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- request.h 17 Apr 2002 11:27:37 -0000 1.7
+++ request.h 18 Apr 2002 14:40:11 -0000 1.8
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: request.h,v 1.7 2002/04/17 11:27:37 davidw Exp $
+ * @(#) $Id: request.h,v 1.8 2002/04/18 14:40:11 ronnie Exp $
*
*/
@@ -190,7 +190,5 @@
char *requestGetDefaultOutChannelName();
int requestFillRequestValues(Tcl_Interp * interp, RequestData * requestData);
-
-int requestScriptName(Tcl_Interp *interp, char **filename);
#endif
1.11 +1 -13 tcl-websh/src/generic/request_ap.c
Index: request_ap.c
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/request_ap.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- request_ap.c 17 Apr 2002 16:29:39 -0000 1.10
+++ request_ap.c 18 Apr 2002 14:40:11 -0000 1.11
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: request_ap.c,v 1.10 2002/04/17 16:29:39 ronnie Exp $
+ * @(#) $Id: request_ap.c,v 1.11 2002/04/18 14:40:11 ronnie Exp $
*
*/
@@ -20,7 +20,6 @@
#include "mod_websh.h"
-
/* ----------------------------------------------------------------------------
* web::request -channel: where input for request obj comes from
* ------------------------------------------------------------------------- */
@@ -92,16 +91,5 @@
paramListSetAsWhole(requestData->request, "GATEWAY_INTERFACE",
Tcl_NewStringObj("CGI-websh/1.1", -1));
- return TCL_OK;
-}
-
-int requestScriptName(Tcl_Interp *interp, char **filename) {
- request_rec *r;
- r = (request_rec *)Tcl_GetAssocData(interp, WEB_AP_ASSOC_DATA, NULL);
-#ifdef APACHE2
- *filename = (char *) apr_pstrdup(r->pool, r->filename);
-#else /* not APACHE2 */
- *filename = ap_pstrdup(r->pool, r->filename);
-#endif /* APACHE2 */
return TCL_OK;
}
1.6 +1 -10 tcl-websh/src/generic/request_cgi.c
Index: request_cgi.c
===================================================================
RCS file: /home/cvs/tcl-websh/src/generic/request_cgi.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- request_cgi.c 17 Apr 2002 16:12:44 -0000 1.5
+++ request_cgi.c 18 Apr 2002 14:40:11 -0000 1.6
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * @(#) $Id: request_cgi.c,v 1.5 2002/04/17 16:12:44 ronnie Exp $
+ * @(#) $Id: request_cgi.c,v 1.6 2002/04/18 14:40:11 ronnie Exp $
*
*/
@@ -43,13 +43,4 @@
return TCL_OK;
requestData->requestIsInitialized = 1;
return Tcl_Eval(interp, "web::cgi::copyenv");
-}
-
-
-int requestScriptName(Tcl_Interp *interp, char **filename) {
- /* fixme: we should return script filen name from the CGI env
- * what's the status of such a char pointer (who allocates)??
- * Maybe it would be easier to return a Tcl_Obj */
- *filename = "";
- return TCL_OK;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: websh-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: websh-cvs-help@tcl.apache.org