View Source

[modwtcl]
apreq.h
dist/
libapreq1/
mod_wtcl.c
mod_wtcl.h
setupExclude.txt
util/
win.def
win.mak
wt1.1/
WtAppTable.c
WtAppTable.h
WtBasicCmds.c
WtBasicCmds.h
WtClientRequest.c
WtClientRequest.h
WtCollection.c
WtCollection.h
WtCollectionCmds.c
WtCollectionCmds.h
WtContext.c
WtContext.h
WtContextEvents.c
WtContextEvents.h
WtCookie.c
WtCookie.h
WtDbSession.c
WtDbSession.h
WtExecute.c
WtExecute.h
WtHtmlEntities.c
WtHtmlEntities.h
WtInitCmds.c
WtInitCmds.h
WtMtTable.c
WtMtTable.h
WtMultiTable.c
WtMultiTable.h
WtOS.h
WtProcSession.c
WtProcSession.h
WtResponse.c
WtResponse.h
WtServerCmds.c
WtServerCmds.h
WtSession.c
WtSession.h
WtSettings.c
WtSettings.h
WtTable.c
WtTable.h
WtTableCmds.c
WtTableCmds.h
WtTableUtil.c
WtTableUtil.h
WtUpload.c
WtUpload.h
WtUtil.c
WtUtil.h
WtWebErrors.c
WtWebErrors.h
WtWindows.h
File: / archive / modwtcl / WtWebErrors.c

Lines Size Modified Created Owner MIME Types
541 13,173 2010/05/08 18:46:41 2011/06/13 15:35:16 BUILTIN\Administrators text/x-csrc

0001
/*
0002
 * Copyright 2001 Alexander Boverman and the original authors.
0003
 * 
0004
 * Licensed under the Apache License, Version 2.0 (the "License");
0005
 * you may not use this file except in compliance with the License.
0006
 * You may obtain a copy of the License at
0007
 * 
0008
 *      http://www.apache.org/licenses/LICENSE-2.0
0009
 * 
0010
 * Unless required by applicable law or agreed to in writing, software
0011
 * distributed under the License is distributed on an "AS IS" BASIS,
0012
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
0013
 * See the License for the specific language governing permissions and
0014
 * limitations under the License.
0015
 */
0016
0017
#include "WtWebErrors.h"
0018
#include "WtUtil.h"
0019
#include "WtContextEvents.h"
0020
#include "WtTable.h"
0021
#include "WtTableUtil.h"
0022
#include "WtResponse.h"
0023
0024
/* Handle the errors collected during a request */
0025
0026
int WtHandleErrors(WtContext *w, Tcl_Interp *interp, request_rec *apReq,
0027
    int useScripts, int *sendStatus)
0028
{
0029
  int ok = 1, len, done = 0;
0030
  Tcl_Obj *handlers, *handler, *destString;
0031
0032
  if (!interp && w->web) {
0033
    interp = w->web->interp;
0034
  }
0035
0036
  if (interp && useScripts) {
0037
    /* Try the user-defined error handlers */
0038
0039
    handlers = WtTableGetObjFromStr(w->web->ctxEventHandlers, "error", NULL);
0040
    if (handlers) {
0041
      if (Tcl_ListObjLength(interp, handlers, &len) != TCL_OK) {
0042
        ok = 0;
0043
      } else if (len) {
0044
        if (!WtEvalEventHandlers(&w->web->ctxEventHandlers, "error",
0045
            interp, w)) {
0046
          WtInterpError(HERE, w, interp);
0047
          ok = 0;
0048
        } else {
0049
          done = 1;
0050
        }
0051
      }
0052
    }
0053
0054
    /* Try the default error handler script */
0055
0056
    if (!done) {
0057
      if (Tcl_PkgRequire(interp, "wt::server", NULL, 0) == NULL) {
0058
        WtInterpError(HERE, w, interp);
0059
        ok = 0;
0060
      } else {
0061
        handler = WtNewString("wt::server::handleErrors");
0062
        Tcl_IncrRefCount(handler);
0063
        if (WtEvalIncr(interp, 1, &handler, TCL_EVAL_DIRECT) != TCL_OK) {
0064
          WtInterpError(HERE, w, interp);
0065
          ok = 0;
0066
        } else {
0067
          done = 1;
0068
        }
0069
        Tcl_DecrRefCount(handler);
0070
      }
0071
    }
0072
  }
0073
0074
  /* If the scripts failed, use the error function below */
0075
0076
  if (!done) {
0077
    destString = WtNewString(NULL);
0078
    Tcl_IncrRefCount(destString);
0079
0080
    if (!WtPrintErrorNotices(w, destString, interp)) {
0081
      WtInterpError(HERE, w, interp);
0082
      ok = 0;
0083
    }
0084
0085
    if (!WtWriteResponse(WtToString(destString),
0086
        Tcl_GetCharLength(destString), w)) {
0087
      ok = 0;
0088
    } else {
0089
      done = 1;
0090
    }
0091
0092
    Tcl_DecrRefCount(destString);
0093
  }
0094
0095
  *sendStatus = done;
0096
0097
  return ok;
0098
}
0099
0100
/* Create an HTML error page */
0101
0102
int WtPrintError(const char *msg, Tcl_Obj *destString)
0103
{
0104
  int ok = 1, len;
0105
0106
  Tcl_AppendToObj(destString,
0107
    "<html>\n<head>\n<title>Wtcl Error</title>\n</head>\n<body>\n", -1);
0108
  Tcl_AppendToObj(destString, "<h1>Error</h1>\n", -1);
0109
0110
  if (msg && (len = strlen(msg))) {
0111
    Tcl_AppendToObj(destString,
0112
      "<p>Sorry, an error occurred while processing this request:</p>\n", -1);
0113
    Tcl_AppendToObj(destString, "<p><ul><pre>", -1);
0114
    Tcl_AppendToObj(destString, msg, len);
0115
    Tcl_AppendToObj(destString, "</pre></ul></p>", -1);
0116
  } else {
0117
    Tcl_AppendToObj(destString,
0118
      "<p>Sorry, an error occurred while processing this request.</p>\n", -1);
0119
  }
0120
0121
  Tcl_AppendToObj(destString, "</body>\n</html>\n", -1);
0122
0123
  return ok;
0124
}
0125
0126
/* Create an HTML string containing the error notices. This
0127
   function is used if the interp is invalid. Otherwise,
0128
   the error handler script is evaluated. */
0129
0130
int WtPrintErrorNotices(WtContext *w, Tcl_Obj *destString, Tcl_Interp *interp)
0131
{
0132
  int ok = 1, i, len, level;
0133
  Tcl_Obj *errors, *item, *levelObj, *err;
0134
0135
  errors = Tcl_NewStringObj(NULL, 0);
0136
  Tcl_IncrRefCount(errors);
0137
0138
  if (interp && w->web && w->web->notices) {
0139
    if (Tcl_ListObjLength(interp, w->web->notices, &len) != TCL_OK) {
0140
      ok = 0;
0141
    } else {
0142
      for (i = 0; i < len; i++) {
0143
        if (Tcl_ListObjIndex(interp, w->web->notices, i, &item) != TCL_OK) {
0144
          ok = 0;
0145
          break;
0146
        } else if (Tcl_ListObjIndex(interp, item, 0, &levelObj) != TCL_OK ||
0147
            Tcl_ListObjIndex(interp, item, 1, &err) != TCL_OK) {
0148
          ok = 0;
0149
        } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) {
0150
          ok = 0;
0151
        } else if (level <= APLOG_ERR) {
0152
          Tcl_AppendToObj(errors, "<p>", 3);
0153
          Tcl_AppendObjToObj(errors, err);
0154
          Tcl_AppendToObj(errors, "</p>", 4);
0155
        }
0156
      }
0157
    }
0158
  }
0159
0160
  if (ok) {
0161
    if (!WtPrintError(WtToString(errors), destString)) {
0162
      ok = 0;
0163
    }
0164
  } else {
0165
    WtInterpError(HERE, w, interp);
0166
    err = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
0167
    if (!err || !Tcl_GetCharLength(err)) {
0168
      err = Tcl_GetObjResult(interp);
0169
    }
0170
    if (!WtPrintError((err ? WtToString(err) : NULL), destString)) {
0171
      ok = 0;
0172
    }
0173
  }
0174
0175
  Tcl_DecrRefCount(errors);
0176
0177
  return ok;
0178
}
0179
0180
/* Create an error page using a format string */
0181
0182
int WtPrintErrorFmt(char *file, int line, Tcl_Obj *destString,
0183
    WtContext *w, request_rec *apReq, const char *fmt, ...)
0184
{
0185
  va_list args;
0186
  int ok = 1;
0187
  char buf[MAX_STRING_LEN];
0188
0189
  va_start(args, fmt);
0190
  ap_vsnprintf(buf, sizeof(buf), fmt, args);
0191
  va_end(args);
0192
  ok = WtPrintError(buf, destString);
0193
0194
  return ok;
0195
}
0196
0197
/* Print an initialization error before the interp is ready */
0198
0199
int WtPrintInitError(char *file, int line, int mask,
0200
    request_rec *apReq, int sendHeadersAndFlush, const char *fmt, ...)
0201
{
0202
  va_list args;
0203
  int ok = 1;
0204
  char buf[MAX_STRING_LEN];
0205
  Tcl_Obj *logString, *clientString;
0206
0207
  buf[0] = '\0';
0208
  va_start(args, fmt);
0209
  if (fmt) {
0210
    ap_vsnprintf(buf, sizeof(buf), fmt, args);
0211
  }
0212
  va_end(args);
0213
0214
  /* Log the error */
0215
0216
  logString = WtNewString("Wtcl: ");
0217
  Tcl_IncrRefCount(logString);
0218
  Tcl_AppendToObj(logString, buf, -1);
0219
  ap_log_rerror(APLOG_MARK, mask, apReq, "%s", WtToString(logString));
0220
  Tcl_DecrRefCount(logString);
0221
0222
  /* Write the error to the client */
0223
0224
  clientString = WtNewString(NULL);
0225
  Tcl_IncrRefCount(clientString);
0226
  WtPrintError(buf, clientString);
0227
0228
  if (sendHeadersAndFlush) {
0229
    WtSendApHeaders(apReq);
0230
  }
0231
  ap_rwrite(WtToString(clientString), Tcl_GetCharLength(clientString),
0232
    apReq);
0233
  if (sendHeadersAndFlush) {
0234
    ap_rflush(apReq);
0235
  }
0236
0237
  Tcl_DecrRefCount(clientString);
0238
0239
  return ok;
0240
}
0241
0242
/* Log an interpreter error */
0243
0244
int WtInterpError(const char *file, int line, WtContext *w,
0245
    Tcl_Interp *interp)
0246
{
0247
  int ok = 1;
0248
  Tcl_Obj *err = NULL;
0249
0250
  if (interp) {
0251
    err = Tcl_GetVar2Ex(interp, "errorInfo", NULL,
0252
      TCL_GLOBAL_ONLY);
0253
    if (!Tcl_GetCharLength(err)) {
0254
      err = Tcl_GetObjResult(interp);
0255
    }
0256
  }
0257
0258
  if (!err) {
0259
    err = WtNewString(NULL);
0260
  }
0261
0262
  Tcl_IncrRefCount(err);
0263
  ok = WtLog(file, line, APLOG_ERR | APLOG_NOERRNO, w, "%s",
0264
    WtSafeStr(WtToString(err)));
0265
  Tcl_DecrRefCount(err);
0266
0267
  return ok;
0268
}
0269
0270
/* Evaluate the error handler inside the task namespace */
0271
0272
int WtHandleErrorsNs(WtContext *w)
0273
{
0274
  int ok = 1, sendStatus, boolVal;
0275
  Tcl_Obj *objv[4];
0276
0277
  if (!w->web->interp) {
0278
    if (!WtHandleErrors(w, NULL, w->web->apReq, 0, &sendStatus)) {
0279
      ok = 0;
0280
    }
0281
    return ok;
0282
  }
0283
0284
  if (!Tcl_CreateObjCommand(w->web->interp,
0285
      "::wt::internal::handleErrors", WtHandleErrorsCmd,
0286
      NULL, NULL)) {
0287
    WtInterpError(HERE, w, w->web->interp);
0288
    ok = 0;
0289
  } else {
0290
    objv[0] = WtNewString("namespace");
0291
    objv[1] = WtNewString("eval");
0292
    objv[2] = w->web->taskNamespace;
0293
    objv[3] = WtNewString("::wt::internal::handleErrors");
0294
0295
    if (WtEvalIncr(w->web->interp, 4, objv, TCL_EVAL_DIRECT) != TCL_OK ||
0296
        !WtGetBoolResult(w->web->interp, &boolVal)) {
0297
      WtInterpError(HERE, w, w->web->interp);
0298
      ok = 0;
0299
    } else if (!boolVal) {
0300
      ok = 0;
0301
    }
0302
  }
0303
0304
  return ok;
0305
}
0306
0307
/* Internal command to print the request errors */
0308
0309
int WtHandleErrorsCmd(ClientData clientData, Tcl_Interp *interp,
0310
    int objc, Tcl_Obj *const objv[])
0311
{
0312
  int ok = 1, sendStatus = 0;
0313
  WtContext *w = WtGetAssocContext(interp);
0314
0315
  if (Tcl_DeleteCommand(interp, Tcl_GetString(objv[0])) != 0) {
0316
    WtInterpError(HERE, w, interp);
0317
    ok = 0;
0318
  } else {
0319
    ok = WtHandleErrors(w, interp, w->web->apReq, 1, &sendStatus);
0320
  }
0321
0322
  Tcl_SetObjResult(interp, WtNewBool(ok));
0323
0324
  return TCL_OK;
0325
}
0326
0327
/* Start collecting command errors */
0328
0329
int WtStartErrors(WtContext *w, Tcl_Interp *interp, int *errorSetId)
0330
{
0331
  int ok = 1, len;
0332
  Tcl_Obj *list;
0333
0334
  *errorSetId = -1;
0335
0336
  if (!w->web->errorStack) {
0337
    w->web->errorStack = Tcl_NewListObj(0, NULL);
0338
    Tcl_IncrRefCount(w->web->errorStack);
0339
  }
0340
0341
  list = Tcl_NewListObj(0, NULL);
0342
  Tcl_IncrRefCount(list);
0343
0344
  if (Tcl_ListObjAppendElement(interp, w->web->errorStack, list) != TCL_OK) {
0345
    ok = 0;
0346
  } else if (Tcl_ListObjLength(interp, w->web->errorStack, &len) != TCL_OK) {
0347
    ok = 0;
0348
  } else {
0349
    *errorSetId = len - 1;
0350
  }
0351
0352
  Tcl_DecrRefCount(list);
0353
0354
  return ok;
0355
}
0356
0357
/* Stop collecting command errors */
0358
0359
int WtStopErrors(WtContext *w, Tcl_Interp *interp, int errorSetId,
0360
    int setResult)
0361
{
0362
  int ok = 1, sets, len, i;
0363
  Tcl_Obj *list, *msg = NULL, *item, *errorCode, *errorInfo;
0364
0365
  if (!w->web->errorStack) {
0366
    Tcl_AppendResult(interp, "Invalid errorStack.", NULL);
0367
    return 0;
0368
  }
0369
0370
  if (Tcl_ListObjLength(interp, w->web->errorStack, &sets) != TCL_OK) {
0371
    ok = 0;
0372
  } else if (errorSetId < 0 || errorSetId >= sets) {
0373
    Tcl_AppendResult(interp, "Invalid error set ID.", NULL);
0374
    ok = 0;
0375
  } else if (Tcl_ListObjIndex(interp, w->web->errorStack, errorSetId,
0376
      &list) != TCL_OK) {
0377
    ok = 0;
0378
  } if (Tcl_ListObjLength(interp, list, &len) != TCL_OK) {
0379
    ok = 0;
0380
  } else if (setResult && len) {
0381
    msg = WtNewString(NULL);
0382
    Tcl_IncrRefCount(msg);
0383
0384
    for (i = 0; i < len; i++) {
0385
      if (Tcl_ListObjIndex(interp, list, i, &item) != TCL_OK) {
0386
        ok = 0;
0387
        break;
0388
      }
0389
      if (!WtConvertToTable(item, interp)) {
0390
        ok = 0;
0391
        break;
0392
      }
0393
0394
      if (i == 0 && len == 1) {
0395
        errorCode = WtTableGetObjFromStr(item, "errorCode", NULL);
0396
        if (!errorCode) {
0397
          ok = 0;
0398
          Tcl_AppendResult(interp, "Invalid errorCode.", NULL);
0399
          break;
0400
        }
0401
        Tcl_SetObjErrorCode(interp, errorCode);
0402
      }
0403
0404
      errorInfo = WtTableGetObjFromStr(item, "errorInfo", NULL);
0405
      if (!errorInfo) {
0406
        ok = 0;
0407
        Tcl_AppendResult(interp, "Invalid errorInfo.", NULL);
0408
        break;
0409
      }
0410
0411
      if (i > 0) {
0412
        Tcl_AppendToObj(msg, "\n    followed by\n", -1);
0413
      }
0414
0415
      Tcl_AppendObjToObj(msg, errorInfo);
0416
    }
0417
0418
    if (ok) {
0419
      Tcl_ResetResult(interp);
0420
      /* Tcl_AddObjErrorInfo(interp, WtToString(msg), -1); */
0421
      Tcl_SetObjResult(interp, msg);
0422
    }
0423
    Tcl_DecrRefCount(msg);
0424
  }
0425
0426
  if (ok) {
0427
    if (Tcl_ListObjReplace(interp, w->web->errorStack,
0428
        errorSetId, sets - errorSetId, 0, NULL) != TCL_OK) {
0429
      ok = 0;
0430
    }
0431
  }
0432
0433
  return ok ? len : -1;
0434
}
0435
0436
/* Add a Tcl error to the current error list */
0437
0438
int WtAddEvalError(Tcl_Interp *interp, WtContext *w)
0439
{
0440
  return WtAddInterpErrorInternal(interp, w, 1);
0441
}
0442
0443
int WtAddInterpError(Tcl_Interp *interp, WtContext *w)
0444
{
0445
  return WtAddInterpErrorInternal(interp, w, 0);
0446
}
0447
0448
int WtAddInterpErrorInternal(Tcl_Interp *interp, WtContext *w,
0449
    int useErrorInfo)
0450
{
0451
  int ok = 1;
0452
  Tcl_Obj *errorInfo = NULL, *errorCode = NULL;
0453
0454
  /* errorCode */
0455
0456
  if (useErrorInfo) {
0457
    errorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, 0);
0458
  }
0459
  if (!errorCode) {
0460
    errorCode = WtNewString(NULL);
0461
  }
0462
  Tcl_IncrRefCount(errorCode);
0463
0464
  /* errorInfo */
0465
0466
  if (useErrorInfo) {
0467
    errorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, 0);
0468
  }
0469
  if (!errorInfo || !Tcl_GetCharLength(errorInfo)) {
0470
    errorInfo = Tcl_GetObjResult(interp);
0471
  }
0472
  if (!errorInfo) {
0473
    errorInfo = WtNewString(NULL);
0474
  }
0475
  Tcl_IncrRefCount(errorInfo);
0476
0477
  /* Reset result */
0478
0479
  Tcl_ResetResult(interp);
0480
0481
  if (!WtAddError(errorCode, errorInfo, interp, w)) {
0482
    ok = 0;
0483
  }
0484
0485
  Tcl_DecrRefCount(errorCode);
0486
  Tcl_DecrRefCount(errorInfo);
0487
0488
  return ok;
0489
}
0490
0491
int WtAddError(Tcl_Obj *errorCode, Tcl_Obj *errorInfo, Tcl_Interp *interp,
0492
    WtContext *w)
0493
{
0494
  int ok = 1, sets;
0495
  Tcl_Obj *list, *item;
0496
0497
  if (!w->web->errorStack) {
0498
    Tcl_AppendResult(interp, "Invalid list.", NULL);
0499
    ok = 0;
0500
  } else if (Tcl_ListObjLength(interp, w->web->errorStack, &sets) != TCL_OK) {
0501
    ok = 0;
0502
  } else if (Tcl_ListObjIndex(interp, w->web->errorStack, sets - 1,
0503
      &list) != TCL_OK) {
0504
    ok = 0;
0505
  } else {
0506
    item = WtNewTableObj();
0507
    Tcl_IncrRefCount(item);
0508
0509
    if (errorCode) {
0510
      WtTableSetStrToObj(item, "errorCode",
0511
        Tcl_DuplicateObj(errorCode));
0512
    } else {
0513
      WtTableSetStrToObj(item, "errorCode", WtNewString(NULL));
0514
    }
0515
0516
    if (errorInfo) {
0517
      WtTableSetStrToObj(item, "errorInfo",
0518
        Tcl_DuplicateObj(errorInfo));
0519
    } else {
0520
      WtTableSetStrToObj(item, "errorInfo", WtNewString(NULL));
0521
    }
0522
0523
    if (Tcl_ListObjAppendElement(interp, list, item) != TCL_OK) {
0524
      ok = 0;
0525
    }
0526
0527
    Tcl_DecrRefCount(item);
0528
  }
0529
0530
  return ok;
0531
}
0532
0533
int WtDeleteErrors(WtContext *w, Tcl_Interp *interp)
0534
{
0535
  if (w->web->errorStack) {
0536
    Tcl_DecrRefCount(w->web->errorStack);
0537
    w->web->errorStack = NULL;
0538
  }
0539
0540
  return 1;
0541
}