/WtWebErrors.c
http://aptcl.googlecode.com/ · C · 541 lines · 403 code · 101 blank · 37 comment · 124 complexity · 800b265790b0114e56177ae2ddcfa06c MD5 · raw file
- /*
- * Copyright 2000 the original author or authors.
- *
- * Licensed 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.
- */
- #include "WtWebErrors.h"
- #include "WtUtil.h"
- #include "WtContextEvents.h"
- #include "WtTable.h"
- #include "WtTableUtil.h"
- #include "WtResponse.h"
- /* Handle the errors collected during a request */
- int WtHandleErrors(WtContext *w, Tcl_Interp *interp, request_rec *apReq,
- int useScripts, int *sendStatus)
- {
- int ok = 1, len, done = 0;
- Tcl_Obj *handlers, *handler, *destString;
- if (!interp && w->web) {
- interp = w->web->interp;
- }
- if (interp && useScripts) {
- /* Try the user-defined error handlers */
- handlers = WtTableGetObjFromStr(w->web->ctxEventHandlers, "error", NULL);
- if (handlers) {
- if (Tcl_ListObjLength(interp, handlers, &len) != TCL_OK) {
- ok = 0;
- } else if (len) {
- if (!WtEvalEventHandlers(&w->web->ctxEventHandlers, "error",
- interp, w)) {
- WtInterpError(HERE, w, interp);
- ok = 0;
- } else {
- done = 1;
- }
- }
- }
- /* Try the default error handler script */
- if (!done) {
- if (Tcl_PkgRequire(interp, "wt::server", NULL, 0) == NULL) {
- WtInterpError(HERE, w, interp);
- ok = 0;
- } else {
- handler = WtNewString("wt::server::handleErrors");
- Tcl_IncrRefCount(handler);
- if (WtEvalIncr(interp, 1, &handler, TCL_EVAL_DIRECT) != TCL_OK) {
- WtInterpError(HERE, w, interp);
- ok = 0;
- } else {
- done = 1;
- }
- Tcl_DecrRefCount(handler);
- }
- }
- }
- /* If the scripts failed, use the error function below */
- if (!done) {
- destString = WtNewString(NULL);
- Tcl_IncrRefCount(destString);
- if (!WtPrintErrorNotices(w, destString, interp)) {
- WtInterpError(HERE, w, interp);
- ok = 0;
- }
- if (!WtWriteResponse(WtToString(destString),
- Tcl_GetCharLength(destString), w)) {
- ok = 0;
- } else {
- done = 1;
- }
- Tcl_DecrRefCount(destString);
- }
- *sendStatus = done;
- return ok;
- }
- /* Create an HTML error page */
- int WtPrintError(const char *msg, Tcl_Obj *destString)
- {
- int ok = 1, len;
- Tcl_AppendToObj(destString,
- "<html>\n<head>\n<title>Wtcl Error</title>\n</head>\n<body>\n", -1);
- Tcl_AppendToObj(destString, "<h1>Error</h1>\n", -1);
- if (msg && (len = strlen(msg))) {
- Tcl_AppendToObj(destString,
- "<p>Sorry, an error occurred while processing this request:</p>\n", -1);
- Tcl_AppendToObj(destString, "<p><ul><pre>", -1);
- Tcl_AppendToObj(destString, msg, len);
- Tcl_AppendToObj(destString, "</pre></ul></p>", -1);
- } else {
- Tcl_AppendToObj(destString,
- "<p>Sorry, an error occurred while processing this request.</p>\n", -1);
- }
- Tcl_AppendToObj(destString, "</body>\n</html>\n", -1);
- return ok;
- }
- /* Create an HTML string containing the error notices. This
- function is used if the interp is invalid. Otherwise,
- the error handler script is evaluated. */
- int WtPrintErrorNotices(WtContext *w, Tcl_Obj *destString, Tcl_Interp *interp)
- {
- int ok = 1, i, len, level;
- Tcl_Obj *errors, *item, *levelObj, *err;
- errors = Tcl_NewStringObj(NULL, 0);
- Tcl_IncrRefCount(errors);
- if (interp && w->web && w->web->notices) {
- if (Tcl_ListObjLength(interp, w->web->notices, &len) != TCL_OK) {
- ok = 0;
- } else {
- for (i = 0; i < len; i++) {
- if (Tcl_ListObjIndex(interp, w->web->notices, i, &item) != TCL_OK) {
- ok = 0;
- break;
- } else if (Tcl_ListObjIndex(interp, item, 0, &levelObj) != TCL_OK ||
- Tcl_ListObjIndex(interp, item, 1, &err) != TCL_OK) {
- ok = 0;
- } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) {
- ok = 0;
- } else if (level <= APLOG_ERR) {
- Tcl_AppendToObj(errors, "<p>", 3);
- Tcl_AppendObjToObj(errors, err);
- Tcl_AppendToObj(errors, "</p>", 4);
- }
- }
- }
- }
- if (ok) {
- if (!WtPrintError(WtToString(errors), destString)) {
- ok = 0;
- }
- } else {
- WtInterpError(HERE, w, interp);
- err = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
- if (!err || !Tcl_GetCharLength(err)) {
- err = Tcl_GetObjResult(interp);
- }
- if (!WtPrintError((err ? WtToString(err) : NULL), destString)) {
- ok = 0;
- }
- }
- Tcl_DecrRefCount(errors);
- return ok;
- }
- /* Create an error page using a format string */
- int WtPrintErrorFmt(char *file, int line, Tcl_Obj *destString,
- WtContext *w, request_rec *apReq, const char *fmt, ...)
- {
- va_list args;
- int ok = 1;
- char buf[MAX_STRING_LEN];
- va_start(args, fmt);
- ap_vsnprintf(buf, sizeof(buf), fmt, args);
- va_end(args);
- ok = WtPrintError(buf, destString);
- return ok;
- }
- /* Print an initialization error before the interp is ready */
- int WtPrintInitError(char *file, int line, int mask,
- request_rec *apReq, int sendHeadersAndFlush, const char *fmt, ...)
- {
- va_list args;
- int ok = 1;
- char buf[MAX_STRING_LEN];
- Tcl_Obj *logString, *clientString;
- buf[0] = '\0';
- va_start(args, fmt);
- if (fmt) {
- ap_vsnprintf(buf, sizeof(buf), fmt, args);
- }
- va_end(args);
- /* Log the error */
- logString = WtNewString("Wtcl: ");
- Tcl_IncrRefCount(logString);
- Tcl_AppendToObj(logString, buf, -1);
- ap_log_rerror(APLOG_MARK, mask, apReq, "%s", WtToString(logString));
- Tcl_DecrRefCount(logString);
- /* Write the error to the client */
- clientString = WtNewString(NULL);
- Tcl_IncrRefCount(clientString);
- WtPrintError(buf, clientString);
- if (sendHeadersAndFlush) {
- WtSendApHeaders(apReq);
- }
- ap_rwrite(WtToString(clientString), Tcl_GetCharLength(clientString),
- apReq);
- if (sendHeadersAndFlush) {
- ap_rflush(apReq);
- }
- Tcl_DecrRefCount(clientString);
- return ok;
- }
- /* Log an interpreter error */
- int WtInterpError(const char *file, int line, WtContext *w,
- Tcl_Interp *interp)
- {
- int ok = 1;
- Tcl_Obj *err = NULL;
- if (interp) {
- err = Tcl_GetVar2Ex(interp, "errorInfo", NULL,
- TCL_GLOBAL_ONLY);
- if (!Tcl_GetCharLength(err)) {
- err = Tcl_GetObjResult(interp);
- }
- }
- if (!err) {
- err = WtNewString(NULL);
- }
- Tcl_IncrRefCount(err);
- ok = WtLog(file, line, APLOG_ERR | APLOG_NOERRNO, w, "%s",
- WtSafeStr(WtToString(err)));
- Tcl_DecrRefCount(err);
- return ok;
- }
- /* Evaluate the error handler inside the task namespace */
- int WtHandleErrorsNs(WtContext *w)
- {
- int ok = 1, sendStatus, boolVal;
- Tcl_Obj *objv[4];
- if (!w->web->interp) {
- if (!WtHandleErrors(w, NULL, w->web->apReq, 0, &sendStatus)) {
- ok = 0;
- }
- return ok;
- }
- if (!Tcl_CreateObjCommand(w->web->interp,
- "::wt::internal::handleErrors", WtHandleErrorsCmd,
- NULL, NULL)) {
- WtInterpError(HERE, w, w->web->interp);
- ok = 0;
- } else {
- objv[0] = WtNewString("namespace");
- objv[1] = WtNewString("eval");
- objv[2] = w->web->taskNamespace;
- objv[3] = WtNewString("::wt::internal::handleErrors");
- if (WtEvalIncr(w->web->interp, 4, objv, TCL_EVAL_DIRECT) != TCL_OK ||
- !WtGetBoolResult(w->web->interp, &boolVal)) {
- WtInterpError(HERE, w, w->web->interp);
- ok = 0;
- } else if (!boolVal) {
- ok = 0;
- }
- }
- return ok;
- }
- /* Internal command to print the request errors */
- int WtHandleErrorsCmd(ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[])
- {
- int ok = 1, sendStatus = 0;
- WtContext *w = WtGetAssocContext(interp);
- if (Tcl_DeleteCommand(interp, Tcl_GetString(objv[0])) != 0) {
- WtInterpError(HERE, w, interp);
- ok = 0;
- } else {
- ok = WtHandleErrors(w, interp, w->web->apReq, 1, &sendStatus);
- }
- Tcl_SetObjResult(interp, WtNewBool(ok));
- return TCL_OK;
- }
- /* Start collecting command errors */
- int WtStartErrors(WtContext *w, Tcl_Interp *interp, int *errorSetId)
- {
- int ok = 1, len;
- Tcl_Obj *list;
- *errorSetId = -1;
- if (!w->web->errorStack) {
- w->web->errorStack = Tcl_NewListObj(0, NULL);
- Tcl_IncrRefCount(w->web->errorStack);
- }
- list = Tcl_NewListObj(0, NULL);
- Tcl_IncrRefCount(list);
- if (Tcl_ListObjAppendElement(interp, w->web->errorStack, list) != TCL_OK) {
- ok = 0;
- } else if (Tcl_ListObjLength(interp, w->web->errorStack, &len) != TCL_OK) {
- ok = 0;
- } else {
- *errorSetId = len - 1;
- }
- Tcl_DecrRefCount(list);
- return ok;
- }
- /* Stop collecting command errors */
- int WtStopErrors(WtContext *w, Tcl_Interp *interp, int errorSetId,
- int setResult)
- {
- int ok = 1, sets, len, i;
- Tcl_Obj *list, *msg = NULL, *item, *errorCode, *errorInfo;
- if (!w->web->errorStack) {
- Tcl_AppendResult(interp, "Invalid errorStack.", NULL);
- return 0;
- }
- if (Tcl_ListObjLength(interp, w->web->errorStack, &sets) != TCL_OK) {
- ok = 0;
- } else if (errorSetId < 0 || errorSetId >= sets) {
- Tcl_AppendResult(interp, "Invalid error set ID.", NULL);
- ok = 0;
- } else if (Tcl_ListObjIndex(interp, w->web->errorStack, errorSetId,
- &list) != TCL_OK) {
- ok = 0;
- } if (Tcl_ListObjLength(interp, list, &len) != TCL_OK) {
- ok = 0;
- } else if (setResult && len) {
- msg = WtNewString(NULL);
- Tcl_IncrRefCount(msg);
- for (i = 0; i < len; i++) {
- if (Tcl_ListObjIndex(interp, list, i, &item) != TCL_OK) {
- ok = 0;
- break;
- }
- if (!WtConvertToTable(item, interp)) {
- ok = 0;
- break;
- }
- if (i == 0 && len == 1) {
- errorCode = WtTableGetObjFromStr(item, "errorCode", NULL);
- if (!errorCode) {
- ok = 0;
- Tcl_AppendResult(interp, "Invalid errorCode.", NULL);
- break;
- }
- Tcl_SetObjErrorCode(interp, errorCode);
- }
- errorInfo = WtTableGetObjFromStr(item, "errorInfo", NULL);
- if (!errorInfo) {
- ok = 0;
- Tcl_AppendResult(interp, "Invalid errorInfo.", NULL);
- break;
- }
- if (i > 0) {
- Tcl_AppendToObj(msg, "\n followed by\n", -1);
- }
- Tcl_AppendObjToObj(msg, errorInfo);
- }
- if (ok) {
- Tcl_ResetResult(interp);
- /* Tcl_AddObjErrorInfo(interp, WtToString(msg), -1); */
- Tcl_SetObjResult(interp, msg);
- }
- Tcl_DecrRefCount(msg);
- }
- if (ok) {
- if (Tcl_ListObjReplace(interp, w->web->errorStack,
- errorSetId, sets - errorSetId, 0, NULL) != TCL_OK) {
- ok = 0;
- }
- }
- return ok ? len : -1;
- }
- /* Add a Tcl error to the current error list */
- int WtAddEvalError(Tcl_Interp *interp, WtContext *w)
- {
- return WtAddInterpErrorInternal(interp, w, 1);
- }
- int WtAddInterpError(Tcl_Interp *interp, WtContext *w)
- {
- return WtAddInterpErrorInternal(interp, w, 0);
- }
- int WtAddInterpErrorInternal(Tcl_Interp *interp, WtContext *w,
- int useErrorInfo)
- {
- int ok = 1;
- Tcl_Obj *errorInfo = NULL, *errorCode = NULL;
- /* errorCode */
- if (useErrorInfo) {
- errorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, 0);
- }
- if (!errorCode) {
- errorCode = WtNewString(NULL);
- }
- Tcl_IncrRefCount(errorCode);
- /* errorInfo */
- if (useErrorInfo) {
- errorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, 0);
- }
- if (!errorInfo || !Tcl_GetCharLength(errorInfo)) {
- errorInfo = Tcl_GetObjResult(interp);
- }
- if (!errorInfo) {
- errorInfo = WtNewString(NULL);
- }
- Tcl_IncrRefCount(errorInfo);
- /* Reset result */
- Tcl_ResetResult(interp);
- if (!WtAddError(errorCode, errorInfo, interp, w)) {
- ok = 0;
- }
- Tcl_DecrRefCount(errorCode);
- Tcl_DecrRefCount(errorInfo);
- return ok;
- }
- int WtAddError(Tcl_Obj *errorCode, Tcl_Obj *errorInfo, Tcl_Interp *interp,
- WtContext *w)
- {
- int ok = 1, sets;
- Tcl_Obj *list, *item;
- if (!w->web->errorStack) {
- Tcl_AppendResult(interp, "Invalid list.", NULL);
- ok = 0;
- } else if (Tcl_ListObjLength(interp, w->web->errorStack, &sets) != TCL_OK) {
- ok = 0;
- } else if (Tcl_ListObjIndex(interp, w->web->errorStack, sets - 1,
- &list) != TCL_OK) {
- ok = 0;
- } else {
- item = WtNewTableObj();
- Tcl_IncrRefCount(item);
- if (errorCode) {
- WtTableSetStrToObj(item, "errorCode",
- Tcl_DuplicateObj(errorCode));
- } else {
- WtTableSetStrToObj(item, "errorCode", WtNewString(NULL));
- }
- if (errorInfo) {
- WtTableSetStrToObj(item, "errorInfo",
- Tcl_DuplicateObj(errorInfo));
- } else {
- WtTableSetStrToObj(item, "errorInfo", WtNewString(NULL));
- }
- if (Tcl_ListObjAppendElement(interp, list, item) != TCL_OK) {
- ok = 0;
- }
- Tcl_DecrRefCount(item);
- }
- return ok;
- }
- int WtDeleteErrors(WtContext *w, Tcl_Interp *interp)
- {
- if (w->web->errorStack) {
- Tcl_DecrRefCount(w->web->errorStack);
- w->web->errorStack = NULL;
- }
- return 1;
- }