1 /*
2 * webout.c --- Tcl interface to webout, the output handler of websh 3
3 * nca-073-9
4 *
5 * Copyright (c) 1996-2000 by Netcetera AG.
6 * Copyright (c) 2001 by Apache Software Foundation.
7 * All rights reserved.
8 *
9 * See the file "license.terms" for information on usage and
10 * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * @(#) $Id: webout.c 814683 2009-09-14 15:11:40Z ronnie $
13 *
14 */
15
16 #include <tcl.h>
17 #include <stdio.h>
18 #include "webout.h" /* is member of output module of websh */
19 #include "args.h" /* arg processing */
20 #include "webutl.h"
21 #include "hashutl.h"
22 #include "request.h"
23 #include "paramlist.h" /* destroyParamList */
24
25
26 /* ----------------------------------------------------------------------------
27 * init -- start up output handler module of websh3
28 * ------------------------------------------------------------------------- */
webout_Init(Tcl_Interp * interp)29 int webout_Init(Tcl_Interp * interp)
30 {
31
32 OutData *outData;
33
34 /* --------------------------------------------------------------------------
35 * interpreter running ?
36 * ----------------------------------------------------------------------- */
37 if (interp == NULL)
38 return TCL_ERROR;
39
40 /* --------------------------------------------------------------------------
41 * init internal data
42 * ----------------------------------------------------------------------- */
43 outData = createOutData(interp);
44 WebAssertData(interp, outData, "webout_Init", TCL_ERROR);
45
46 /* --------------------------------------------------------------------------
47 * register new commands
48 * ----------------------------------------------------------------------- */
49 Tcl_CreateObjCommand(interp, "web::putx",
50 Web_Eval, (ClientData) outData, NULL);
51
52 Tcl_CreateObjCommand(interp, "web::put",
53 Web_Puts, (ClientData) outData, NULL);
54
55 Tcl_CreateObjCommand(interp, "web::response",
56 Web_Response, (ClientData) outData, NULL);
57
58 /* Tcl_CreateObjCommand(interp, "web::varopen", */
59 /* Web_VarOpen, */
60 /* (ClientData)outData, */
61 /* NULL); */
62
63 /* --------------------------------------------------------------------------
64 * register private data with interp
65 * ----------------------------------------------------------------------- */
66 Tcl_SetAssocData(interp, WEB_OUT_ASSOC_DATA,
67 (Tcl_InterpDeleteProc *) destroyOutData,
68 (ClientData) outData);
69 return TCL_OK;
70 }
71
72 /* ----------------------------------------------------------------------------
73 * Web_Eval -- the web::putx command
74 * ------------------------------------------------------------------------- */
Web_Eval(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])75 int Web_Eval(ClientData clientData,
76 Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[])
77 {
78 ResponseObj *savedObj = NULL;
79 ResponseObj *responseObj = NULL;
80 OutData *outData = NULL;
81 Tcl_Obj *code = NULL;
82 int retval = 0;
83
84 /* --------------------------------------------------------------------------
85 * sanity
86 * ----------------------------------------------------------------------- */
87 WebAssertData(interp, clientData, "web::putx", TCL_ERROR);
88 outData = (OutData *) clientData;
89
90 /* --------------------------------------------------------------------------
91 * web::putx myVar test
92 * 0 1 2
93 * ----------------------------------------------------------------------- */
94 WebAssertObjc((objc < 2)
95 || (objc > 3), 1, "?channel|#globalvar? extendedstring");
96
97 if (objc == 2) {
98 responseObj = outData->defaultResponseObj;
99 savedObj = responseObj;
100 code = objv[1];
101
102 }
103 else {
104 savedObj = outData->defaultResponseObj;
105 responseObj = getResponseObj(interp, outData, Tcl_GetString(objv[1]));
106 code = objv[2];
107 }
108
109 if (responseObj == NULL) {
110
111 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__, __LINE__,
112 "web::putx", WEBLOG_ERROR,
113 "error accessing response object", NULL);
114 return TCL_ERROR;
115 }
116 outData->defaultResponseObj = responseObj;
117
118 /* --------------------------------------------------------------------------
119 * call eval
120 * ----------------------------------------------------------------------- */
121
122 switch (outData->putxMarkup) {
123 case brace:
124 retval = webout_eval_tag(interp, responseObj, code, "{", "}");
125 break;
126 case tag:
127 retval = webout_eval_tag(interp, responseObj, code, "<?", "?>");
128 break;
129 default:
130 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__, __LINE__,
131 "web::putx", WEBLOG_ERROR, "unknown putxmarkup type", NULL);
132 retval = TCL_ERROR;
133 break;
134 }
135
136 outData->defaultResponseObj = savedObj;
137 return retval;
138 }
139
140
141 /* ----------------------------------------------------------------------------
142 * Web_Puts -- the web::puts command
143 * ------------------------------------------------------------------------- */
Web_Puts(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])144 int Web_Puts(ClientData clientData,
145 Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[])
146 {
147
148 ResponseObj *responseObj = NULL;
149 OutData *outData = NULL;
150 Tcl_Obj *code = NULL;
151
152 /* --------------------------------------------------------------------------
153 * sanity
154 * ----------------------------------------------------------------------- */
155 WebAssertData(interp, clientData, "web::put", TCL_ERROR);
156 outData = (OutData *) clientData;
157
158 /* --------------------------------------------------------------------------
159 * web::put myVar test
160 * 0 1 2
161 * ----------------------------------------------------------------------- */
162 WebAssertObjc((objc < 2) || (objc > 3), 1, "?channel|#globalvar? string");
163
164 if (objc == 2) {
165
166 responseObj = outData->defaultResponseObj;
167 code = objv[1];
168
169 }
170 else {
171
172 responseObj = getResponseObj(interp, outData, Tcl_GetString(objv[1]));
173 code = objv[2];
174 }
175
176 if (responseObj == NULL) {
177
178 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__, __LINE__,
179 "web::put", WEBLOG_ERROR,
180 "error accessing response object", NULL);
181 return TCL_ERROR;
182 }
183
184 return putsCmdImpl(interp, responseObj, code);
185 }
186
187
188 /* ----------------------------------------------------------------------------
189 * Web_Response -- the web::output command (config of web::put and web::putx)
190 * ------------------------------------------------------------------------- */
Web_Response(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])191 int Web_Response(ClientData clientData, Tcl_Interp * interp,
192 int objc, Tcl_Obj * CONST objv[])
193 {
194
195
196 ResponseObj *responseObj = NULL;
197 OutData *outData = NULL;
198
199 /*
200 char *channelName = NULL;
201 Tcl_Obj *result = NULL;
202 Tcl_Channel channel = NULL;
203 int mode = 0;
204 int lastIndex = objc -1;
205 int idx = -1;
206 int iCurArg = -1;
207 */
208 int res;
209
210 static char *params[] = { "-sendheader",
211 "-select",
212 "-bytessent",
213 "-httpresponse",
214 "-reset",
215 "-resetall",
216 NULL
217 };
218 enum params
219 { SENDHEADER, SELECT, BYTESSENT, HTTPRESPONSE, RESET, RESETALL };
220
221 /* --------------------------------------------------------------------------
222 * sanity
223 * ----------------------------------------------------------------------- */
224 WebAssertData(interp, clientData, "web::response", TCL_ERROR)
225 outData = (OutData *) clientData;
226 WebAssertData(interp, outData->responseObjHash, "web::response",
227 TCL_ERROR);
228
229 /* get the current response object */
230 responseObj = outData->defaultResponseObj;
231 if (responseObj == NULL) {
232 Tcl_SetResult(interp, "no current response object", TCL_STATIC);
233 return TCL_ERROR;
234 }
235
236 /* handle first paramList things */
237 /* note: the keys might not be strictly case sensitive */
238 res = paramGet((ParamList *) responseObj->headers, interp, objc, objv, 1);
239
240 if (res == TCL_CONTINUE) {
241
242 if (objc == 1) {
243 /* ----------------------------------------------------------------------
244 * return name of default channel
245 * ------------------------------------------------------------------- */
246 Tcl_ResetResult(interp); /* empty string */
247 if (responseObj->name != NULL) {
248 Tcl_SetObjResult(interp, responseObj->name);
249 return TCL_OK;
250 }
251 Tcl_SetResult(interp, "current response has no name", TCL_STATIC);
252 return TCL_ERROR;
253 }
254 else {
255 int opt;
256 if (paramGetIndexFromObj
257 (interp, objv[1], params, "subcommand", 0, &opt) == TCL_ERROR)
258 return TCL_ERROR;
259
260 switch ((enum params) opt) {
261 case RESETALL:
262 WebAssertObjc(objc != 2, 2, NULL);
263 return resetOutData(interp, outData);
264
265 case RESET:{
266 Tcl_Obj *tmp;
267 char *tname;
268
269 WebAssertObjc(objc != 2, 2, NULL);
270
271 /* --------------------------------------------------------------------
272 * just reset this one
273 * ----------------------------------------------------------------- */
274
275 removeFromHashTable(outData->responseObjHash,
276 Tcl_GetString(responseObj->name));
277
278 tmp = Tcl_DuplicateObj(responseObj->name);
279 Tcl_IncrRefCount(tmp);
280 tname = Tcl_GetString(tmp);
281
282 if (responseObj == outData->defaultResponseObj)
283 outData->defaultResponseObj = NULL;
284 destroyResponseObj((ClientData) responseObj, interp);
285
286 /* if we reset the default response object, we have to recreate it
287 * with our special createDefaultResponseObj function ...
288 */
289
290 if (isDefaultResponseObj(interp, tname)) {
291 responseObj = createDefaultResponseObj(interp);
292 /* add it to Hash Table */
293 if (appendToHashTable(outData->responseObjHash,
294 Tcl_GetString(responseObj->name),
295 (ClientData) responseObj) != TCL_OK) {
296 Tcl_SetResult(interp,
297 "could not reset default response object",
298 TCL_STATIC);
299 return TCL_ERROR;
300 }
301 } else
302 responseObj = getResponseObj(interp, outData, tname);
303
304 Tcl_DecrRefCount(tmp);
305 if (responseObj == NULL) {
306 Tcl_SetResult(interp,
307 "could not reset response object",
308 TCL_STATIC);
309 return TCL_ERROR;
310 }
311
312 if (outData->defaultResponseObj == NULL)
313 outData->defaultResponseObj = responseObj;
314
315 return TCL_OK;
316 break;
317 }
318 case SENDHEADER:{
319 int res;
320 WebAssertObjc(objc > 3, 2, NULL);
321 res = responseObj->sendHeader;
322 if (objc == 3)
323 /* set new value */
324 if (Tcl_GetBooleanFromObj(interp, objv[2],
325 &(responseObj->
326 sendHeader)) ==
327 TCL_ERROR) {
328
329 return TCL_ERROR;
330 }
331 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(res));
332 return TCL_OK;
333 break;
334 }
335 case SELECT:{
336 ResponseObj *old = NULL;
337 char *name = NULL;
338 /* fprintf(stderr,"DBG -select called\n"); fflush(stderr); */
339
340 WebAssertObjc(objc != 3, 2, "channelName");
341 old = responseObj;
342 name = Tcl_GetString(objv[2]);
343 /* we have to find the new channel */
344 if (!strcmp(name, "default")) {
345 name = (char *) requestGetDefaultOutChannelName(interp);
346 }
347 responseObj =
348 getResponseObj(interp, outData, name);
349
350 if (responseObj == NULL) {
351 Tcl_ResetResult(interp);
352 Tcl_AppendResult(interp, "invalid response object \"",
353 name, "\"",
354 (char *) NULL);
355 return TCL_ERROR;
356 }
357 outData->defaultResponseObj = responseObj;
358 Tcl_ResetResult(interp); /* empty string */
359 if (old->name != NULL) {
360 Tcl_SetObjResult(interp, old->name);
361 }
362 return TCL_OK;
363 break;
364 }
365
366 case BYTESSENT:
367 WebAssertObjc(objc != 2, 2, NULL);
368 Tcl_SetObjResult(interp,
369 Tcl_NewLongObj(responseObj->bytesSent));
370 return TCL_OK;
371
372 case HTTPRESPONSE:{
373 Tcl_Obj *current;
374 WebAssertObjc(objc > 3, 2, NULL);
375 current = responseObj->httpresponse;
376 if (current)
377 Tcl_SetObjResult(interp, current);
378 if (objc == 3) {
379 /* if length = 0 we reset
380 * if equal to "default", take from HTTP_RESPONSE
381 * otherwise take value */
382 int len;
383 char *response = Tcl_GetStringFromObj(objv[2], &len);
384 if (len == 0)
385 responseObj->httpresponse = NULL;
386 else {
387 if (!strcmp("default", response)) {
388 responseObj->httpresponse =
389 Tcl_NewStringObj(HTTP_RESPONSE, -1);
390 }
391 else {
392 responseObj->httpresponse =
393 Tcl_DuplicateObj(objv[2]);
394 }
395 Tcl_IncrRefCount(responseObj->httpresponse);
396 }
397 /* forget old value */
398 if (current)
399 Tcl_DecrRefCount(current);
400 }
401 return TCL_OK;
402 break;
403 }
404 default:
405 break;
406
407 }
408 }
409 WebAssertObjc(1, 1, "(unknown syntax)");
410 }
411 return res;
412
413 }
414