1 /*
2 * url.c -- url generation
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: url.c 814683 2009-09-14 15:11:40Z ronnie $
13 *
14 */
15
16 #include <tcl.h>
17 #include <time.h>
18 #include "url.h"
19 #include "paramlist.h"
20 #include "crypt.h"
21 #include "stdlib.h" /* getenv */
22 #include "log.h"
23 #include "request.h"
24
25
26
27 /* if direct is 1: don't try to get configured value, but the one
28 from the environment / requestData */
29 #define WEB_URL_GETFROMREQDATA(scheme,key,direct) \
30 if(!direct && urlData->scheme != NULL ) \
31 scheme = urlData->scheme; \
32 if( scheme == NULL ) \
33 if( urlData->requestData != NULL ) \
34 scheme = paramListGetObjectByString(interp,urlData->requestData->request,key);
35
36
37 static TCLCONST char *urlElementOpts[] = {
38 "-scheme",
39 "-host",
40 "-port",
41 "-scriptname",
42 "-pathinfo",
43 "-querystring",
44 NULL
45 };
46
47 /* to which flags the names above correspond */
48 static int urlElementFlags[] = {
49 WEB_URL_WITH_SCHEME,
50 WEB_URL_WITH_HOST,
51 WEB_URL_WITH_PORT,
52 WEB_URL_WITH_SCRIPTNAME,
53 WEB_URL_WITH_PATHINFO,
54 WEB_URL_WITH_QUERYSTRING
55 };
56
57 enum urlElement
58 {
59 SCHEME,
60 HOST,
61 PORT,
62 SCRIPTNAME,
63 PATHINFO,
64 QUERYSTRING,
65 URLCFGRESET,
66 URLCFGURLFORMAT,
67 URLCFGEND
68 };
69
70
71 /* ----------------------------------------------------------------------------
72 * Init --
73 * ------------------------------------------------------------------------- */
url_Init(Tcl_Interp * interp)74 int url_Init(Tcl_Interp * interp)
75 {
76
77 UrlData *urlData;
78
79 /* --------------------------------------------------------------------------
80 * interpreter running ?
81 * ----------------------------------------------------------------------- */
82 if (interp == NULL)
83 return TCL_ERROR;
84
85 /* --------------------------------------------------------------------------
86 * new data
87 * ----------------------------------------------------------------------- */
88 urlData = createUrlData();
89
90 /* --------------------------------------------------------------------------
91 * register commands
92 * ----------------------------------------------------------------------- */
93 Tcl_CreateObjCommand(interp, "web::cmdurlcfg",
94 Web_CmdUrlCfg, (ClientData) urlData, NULL);
95
96 Tcl_CreateObjCommand(interp, "web::cmdurl",
97 Web_CmdUrl, (ClientData) urlData, NULL);
98
99 /* --------------------------------------------------------------------------
100 * associate data with Interpreter
101 * ----------------------------------------------------------------------- */
102 Tcl_SetAssocData(interp, WEB_URL_ASSOC_DATA,
103 destroyUrlData, (ClientData) urlData);
104
105 /* --------------------------------------------------------------------------
106 * done
107 * ----------------------------------------------------------------------- */
108 return TCL_OK;
109 }
110
111
112 /* ----------------------------------------------------------------------------
113 * create
114 * ------------------------------------------------------------------------- */
createUrlData()115 UrlData *createUrlData()
116 {
117
118 UrlData *urlData = NULL;
119
120 urlData = WebAllocInternalData(UrlData);
121
122 if (urlData != NULL) {
123 urlData->defaultscheme = NULL;
124 urlData->scheme = NULL;
125 /* we want to read port from request if available */
126 /*WebNewStringObjFromStringIncr(urlData->port,WEB_DEFAULT_PORT); */
127 urlData->port = NULL;
128 urlData->host = NULL;
129 urlData->scriptname = NULL;
130 urlData->pathinfo = NULL;
131 urlData->querystring = NULL;
132
133 urlData->requestData = NULL;
134
135 urlData->urlformat = WEB_URL_URLFORMAT;
136 }
137
138 return urlData;
139 }
140
141 /* ----------------------------------------------------------------------------
142 * reset
143 * ------------------------------------------------------------------------- */
resetUrlData(Tcl_Interp * interp,UrlData * urlData)144 int resetUrlData(Tcl_Interp * interp, UrlData * urlData)
145 {
146 if ((interp == NULL) || (urlData == NULL))
147 return TCL_ERROR;
148
149 WebDecrRefCountIfNotNullAndSetNull(urlData->defaultscheme);
150 WebDecrRefCountIfNotNullAndSetNull(urlData->scheme);
151
152 WebDecrRefCountIfNotNullAndSetNull(urlData->port);
153 /* we want to read port from request if available */
154 /*WebNewStringObjFromStringIncr(urlData->port,WEB_DEFAULT_PORT); */
155
156 WebDecrRefCountIfNotNullAndSetNull(urlData->host);
157
158 WebDecrRefCountIfNotNullAndSetNull(urlData->scriptname);
159
160 WebDecrRefCountIfNotNullAndSetNull(urlData->pathinfo);
161
162 WebDecrRefCountIfNotNullAndSetNull(urlData->querystring);
163
164 /* do not touch requestData */
165
166 urlData->urlformat = WEB_URL_URLFORMAT;
167
168 return TCL_OK;
169 }
170
171 /* ----------------------------------------------------------------------------
172 * destroy
173 * ------------------------------------------------------------------------- */
destroyUrlData(ClientData clientData,Tcl_Interp * interp)174 void destroyUrlData(ClientData clientData, Tcl_Interp * interp)
175 {
176
177 UrlData *urlData = NULL;
178
179 if (clientData != NULL) {
180
181 urlData = (UrlData *) clientData;
182
183 WebDecrRefCountIfNotNull(urlData->defaultscheme);
184 WebDecrRefCountIfNotNull(urlData->scheme);
185 WebDecrRefCountIfNotNull(urlData->port);
186 WebDecrRefCountIfNotNull(urlData->host);
187 WebDecrRefCountIfNotNull(urlData->scriptname);
188 WebDecrRefCountIfNotNull(urlData->pathinfo);
189
190 WebFreeIfNotNull(urlData);
191
192 }
193 }
194
195 /* ----------------------------------------------------------------------------
196 * parseUrlFormat -- parse the -with list and turn corresponding bits on,
197 * or 0 in case of error
198 * ------------------------------------------------------------------------- */
parseUrlFormat(Tcl_Interp * interp,Tcl_Obj * list)199 int parseUrlFormat(Tcl_Interp * interp, Tcl_Obj * list)
200 {
201
202 int objc = -1;
203 Tcl_Obj **objv = NULL;
204 int i = -1;
205 int res = 0;
206
207 TCLCONST char *accepted[20];
208 enum urlElement e;
209
210
211 /* --------------------------------------------------------------------------
212 * minimal
213 * ----------------------------------------------------------------------- */
214 if (list == NULL) {
215 LOG_MSG(interp, WRITE_LOG | SET_RESULT,
216 __FILE__, __LINE__,
217 "web::cmdurl -urlformat", WEBLOG_ERROR,
218 "cannot access list", NULL);
219 return 0;
220 }
221
222 for (e = SCHEME; e <= QUERYSTRING; e++)
223 accepted[e] = &(urlElementOpts[e][1]);
224 accepted[e] = NULL;
225
226 /* --------------------------------------------------------------------------
227 * convert list to array of objs
228 * ----------------------------------------------------------------------- */
229 if (Tcl_ListObjGetElements(interp, list, &objc, &objv) == TCL_ERROR) {
230 LOG_MSG(interp, WRITE_LOG | SET_RESULT,
231 __FILE__, __LINE__,
232 "web::cmdurl -urlformat", WEBLOG_ERROR,
233 "cannot convert \"", Tcl_GetString(list), "\" to list", NULL);
234 return 0;
235 }
236
237 /* empty list */
238 if (objc == 0) {
239 Tcl_SetResult(interp, "no url elements specified", TCL_STATIC);
240 return 0;
241 }
242
243 /* --------------------------------------------------------------------------
244 * now see what we got
245 * ----------------------------------------------------------------------- */
246 for (i = 0; i < objc; i++) {
247 int idx = 0;
248 if (Tcl_GetIndexFromObj(interp,
249 objv[i],
250 accepted,
251 "url element", 0, &idx) == TCL_ERROR)
252 return 0;
253 else {
254 res |= urlElementFlags[idx];
255 }
256 }
257 return res;
258 }
259
260
261 /* ----------------------------------------------------------------------------
262 * mergeLists -- assume key-value paired list; take value from staticP if no
263 * key is found in cmdlineP
264 * ------------------------------------------------------------------------- */
mergeLists(Tcl_Interp * interp,Tcl_Obj * cmdlineP,Tcl_Obj * staticP)265 Tcl_Obj *mergeLists(Tcl_Interp * interp, Tcl_Obj * cmdlineP,
266 Tcl_Obj * staticP)
267 {
268
269 int staticPLen = -1;
270 int cmdlinePLen = -1;
271 int i = -1;
272 int j = -1;
273 Tcl_Obj *res = NULL;
274 Tcl_Obj *key1 = NULL;
275 Tcl_Obj *key2 = NULL;
276 Tcl_Obj *val = NULL;
277 int keyOnCmdLine = TCL_ERROR;
278
279 if ((staticP == NULL) || (cmdlineP == NULL))
280 return NULL;
281
282 staticPLen = tclGetListLength(interp, staticP);
283 cmdlinePLen = tclGetListLength(interp, cmdlineP);
284
285 if ((staticPLen % 2) != 0) {
286
287 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__, __LINE__,
288 "web::cmdurl", WEBLOG_INFO,
289 "key-value list \"", Tcl_GetString(staticP),
290 "\" must be even-numbered", NULL);
291 return NULL;
292 }
293
294 if ((cmdlinePLen % 2) != 0) {
295
296 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__, __LINE__,
297 "web::cmdurl", WEBLOG_INFO,
298 "key-value list \"", Tcl_GetString(cmdlineP),
299 "\" must be even-numbered", NULL);
300 return NULL;
301 }
302
303 res = Tcl_NewObj();
304 Tcl_IncrRefCount(res);
305
306 for (i = 0; i < staticPLen; i += 2) {
307
308 key1 = NULL;
309 key2 = NULL;
310 val = NULL;
311
312 if (Tcl_ListObjIndex(interp, staticP, i, &key1) == TCL_ERROR) {
313 Tcl_DecrRefCount(res);
314 return NULL;
315 }
316
317 keyOnCmdLine = TCL_ERROR;
318
319 for (j = 0; j < cmdlinePLen; j += 2) {
320
321 if (Tcl_ListObjIndex(interp, cmdlineP, j, &key2) == TCL_ERROR) {
322 Tcl_DecrRefCount(res);
323 return NULL;
324 }
325
326 if (strcmp(Tcl_GetString(key1), Tcl_GetString(key2)) == 0) {
327
328 keyOnCmdLine = TCL_OK;
329 break;
330 }
331 }
332
333 if (keyOnCmdLine == TCL_ERROR) {
334
335 if (Tcl_ListObjIndex(interp, staticP, i + 1, &val) == TCL_ERROR) {
336 Tcl_DecrRefCount(res);
337 return NULL;
338 }
339
340 if (Tcl_ListObjAppendElement(interp, res, key1) == TCL_ERROR) {
341 Tcl_DecrRefCount(res);
342 return NULL;
343 }
344
345 if (Tcl_ListObjAppendElement(interp, res, val) == TCL_ERROR) {
346 Tcl_DecrRefCount(res);
347 return NULL;
348 }
349 }
350 }
351
352 return res;
353 }
354
355 /* ----------------------------------------------------------------------------
356 * createQueryList -- put elements of query_string together to form a list
357 * - cmd may be NULL. In this case it is ignored.
358 * - plist may be NULL. In this case it is ignored.
359 * ------------------------------------------------------------------------- */
createQueryList(Tcl_Interp * interp,Tcl_Obj * cmd,Tcl_Obj * plist,UrlData * urlData,int flag)360 Tcl_Obj *createQueryList(Tcl_Interp * interp, Tcl_Obj * cmd, Tcl_Obj * plist,
361 UrlData * urlData, int flag)
362 {
363
364 Tcl_Obj *qStr = NULL;
365 Tcl_Obj *tmp = NULL;
366 int errCnt = 0;
367
368 if (urlData == NULL)
369 return NULL;
370
371 errCnt = 0;
372 qStr = Tcl_NewObj();
373
374 if (qStr == NULL)
375 return NULL;
376
377 Tcl_IncrRefCount(qStr);
378
379 if (plist != NULL)
380 if (Tcl_ListObjAppendList(interp, qStr, plist) == TCL_ERROR)
381 errCnt++;
382
383 /* ..........................................................................
384 * append static params
385 * ....................................................................... */
386 if (urlData->requestData != NULL) {
387
388 if (urlData->requestData->staticList != NULL) {
389
390 tmp = paramListAsListObj(urlData->requestData->staticList);
391
392 /* ----------------------------------------------------------------------
393 * merge
394 * ------------------------------------------------------------------- */
395 if (plist != NULL) {
396
397 Tcl_Obj *tmp2 = NULL;
398 tmp2 = mergeLists(interp, plist, tmp);
399
400 if (tmp2 == NULL) {
401
402 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__,
403 __LINE__, "web::cmdurl", WEBLOG_INFO,
404 "error mergings parameters from cmdline ",
405 "and static parameters. Details: ",
406 Tcl_GetStringResult(interp), NULL);
407
408 Tcl_DecrRefCount(qStr);
409 return NULL;
410 }
411
412 Tcl_DecrRefCount(tmp);
413 tmp = tmp2;
414 }
415
416 if (Tcl_ListObjAppendList(interp, qStr, tmp) == TCL_ERROR)
417 errCnt++;
418
419 Tcl_DecrRefCount(tmp);
420
421 }
422 }
423
424 /* After appending each element in elemListPtr,
425 * Tcl_ListObjAppendList increments the element's reference count
426 * since listPtr now also refers to it. For the same reason,
427 * Tcl_ListObjAppendElement increments objPtr's reference count. If
428 * no error occurs, the two procedures return TCL_OK after appending
429 * the objects. */
430
431 /* ..........................................................................
432 * append command tag
433 * ....................................................................... */
434 if (cmd != NULL) {
435 if ((flag & WEB_URL_NOCMD) == 0) {
436 if (urlData->requestData != NULL)
437 if (urlData->requestData->cmdTag != NULL)
438 if (Tcl_ListObjAppendElement(interp, qStr,
439 urlData->requestData->cmdTag)
440 == TCL_ERROR)
441 errCnt++;
442 if (errCnt < 1)
443 if (Tcl_ListObjAppendElement(interp, qStr, cmd) == TCL_ERROR)
444 errCnt++;
445 }
446 }
447
448 /* ..........................................................................
449 * append time
450 * ....................................................................... */
451 if ((flag & WEB_URL_NOTIMESTAMP) == 0) {
452 if (urlData->requestData != NULL)
453 if (urlData->requestData->timeTag != NULL)
454 if (Tcl_ListObjAppendElement(interp, qStr,
455 urlData->requestData->timeTag)
456 == TCL_ERROR)
457 errCnt++;
458 if (errCnt < 1)
459 if (Tcl_ListObjAppendElement
460 (interp, qStr, Tcl_NewLongObj(time(NULL))) == TCL_ERROR)
461 errCnt++;
462 }
463
464 /* ..........................................................................
465 * finish
466 * ....................................................................... */
467 if (errCnt > 0) {
468
469 Tcl_DecrRefCount(qStr);
470 return NULL;
471 }
472
473 return qStr;
474 }
475
476
477 /* ----------------------------------------------------------------------------
478 * Web_CmdUrl -- url generation
479 * ------------------------------------------------------------------------- */
Web_CmdUrl(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])480 int Web_CmdUrl(ClientData clientData,
481 Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[])
482 {
483
484 static TCLCONST char *params[] = { "-urlformat",
485 "-notimestamp", NULL
486 };
487 enum params
488 { URLFORMAT,
489 NOTIMESTAMP
490 };
491 int Nparams[] = { 1, 0 };
492
493 int iCurArg = 0;
494 UrlData *urlData = NULL;
495 Tcl_Obj *plist = NULL;
496 Tcl_Obj *cmd = NULL;
497 Tcl_Obj *qStrList = NULL;
498 int plistLen = 0;
499 int i = 0;
500 int flag = 0;
501 int bool = 1;
502 int urlformat = 0;
503 Tcl_Obj *urlFmt = NULL;
504 Tcl_Obj *res = NULL;
505
506 /* --------------------------------------------------------------------------
507 * internal data ?
508 * ----------------------------------------------------------------------- */
509 WebAssertData(interp, clientData, "Web_CmdUrl", TCL_ERROR)
510 urlData = (UrlData *) clientData;
511
512 /* make sure we have request data */
513 if (requestFillRequestValues(interp, urlData->requestData) == TCL_ERROR)
514 return TCL_ERROR;
515
516
517 /* --------------------------------------------------------------------------
518 * first arg is cmd
519 * ----------------------------------------------------------------------- */
520 iCurArg = argIndexOfFirstArg(objc, objv, params, Nparams);
521 if ((objc - iCurArg) < 1) {
522 Tcl_WrongNumArgs(interp, 1, objv, "cmdName");
523 return TCL_ERROR;
524 }
525 if (Tcl_GetCharLength(objv[iCurArg]) > 0) {
526 cmd = objv[iCurArg];
527 }
528 iCurArg++;
529
530 /* --------------------------------------------------------------------------
531 * any params we don't accept ?
532 * ----------------------------------------------------------------------- */
533 WebAssertArgs(interp, objc, objv, params, i, -1);
534
535 /* --------------------------------------------------------------------------
536 * check for flags
537 * ----------------------------------------------------------------------- */
538 urlformat = urlData->urlformat;
539 if ((urlFmt = argValueOfKey(objc, objv, (char *)params[URLFORMAT])) != NULL) {
540
541 urlformat = parseUrlFormat(interp, urlFmt);
542
543 if (urlformat == 0)
544 return TCL_ERROR;
545 }
546
547 if (argIndexOfKey(objc, objv, (char *)params[NOTIMESTAMP]) > 0)
548 flag = (flag | WEB_URL_NOTIMESTAMP);
549
550 Tcl_GetBooleanFromObj(interp, urlData->requestData->cmdUrlTimestamp, &bool);
551 if (bool == 0)
552 flag = (flag | WEB_URL_NOTIMESTAMP);
553
554 /* --------------------------------------------------------------------------
555 * do we need to create a querystring ?
556 * ----------------------------------------------------------------------- */
557 if ((urlformat & WEB_URL_WITH_QUERYSTRING) != 0) {
558
559 if (urlData->querystring != NULL) {
560 /* take the one which was configured in web::cmdurlcfg */
561 qStrList = Tcl_DuplicateObj(urlData->querystring);
562 Tcl_IncrRefCount(qStrList);
563
564 }
565 else {
566 /* create a new one */
567
568 /* ---------------------------------------------------------------------
569 * create query_string
570 * ------------------------------------------------------------------ */
571 switch (objc - iCurArg) {
572 case 0:
573 /* ...................................................................
574 * web::cmdurl [options] cmd
575 * ................................................................ */
576 qStrList = createQueryList(interp, cmd, NULL, urlData, flag);
577 break;
578 case 1:
579 /* ...................................................................
580 * web::cmdurl [options] cmd list
581 * ................................................................ */
582 if ((plistLen =
583 tclGetListLength(interp, objv[iCurArg])) == -1)
584 return TCL_ERROR;
585 if ((plistLen % 2) != 0) {
586 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__,
587 __LINE__, "web::cmdurl", WEBLOG_INFO,
588 "key-value list \"", Tcl_GetString(objv[iCurArg]),
589 "\" must be even-numbered", NULL);
590 return TCL_ERROR;
591 }
592 qStrList =
593 createQueryList(interp, cmd, objv[iCurArg], urlData,
594 flag);
595 break;
596 default:
597 /* ................................................................
598 * web::cmdurl [options] "" k1 v1 ... kn vn
599 * ................................................................ */
600 if (((objc - iCurArg) % 2) != 0) {
601 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__,
602 __LINE__, "web::cmdurl", WEBLOG_INFO,
603 "key without the matching value (uneven list), starting at \"",
604 Tcl_GetString(objv[iCurArg]), "\"", NULL);
605 return TCL_ERROR;
606 }
607 plist = Tcl_NewObj();
608 if (plist == NULL)
609 return TCL_ERROR;
610 Tcl_IncrRefCount(plist);
611 for (i = iCurArg; i < objc; i += 2) {
612 if (Tcl_ListObjAppendElement(interp, plist, objv[i]) ==
613 TCL_ERROR) {
614 Tcl_DecrRefCount(plist);
615 return TCL_ERROR;
616 }
617 if (Tcl_ListObjAppendElement(interp, plist, objv[i + 1])
618 == TCL_ERROR) {
619 Tcl_DecrRefCount(plist);
620 return TCL_ERROR;
621 }
622 }
623 qStrList = createQueryList(interp, cmd, plist, urlData, flag);
624 Tcl_DecrRefCount(plist);
625 }
626
627 /* ------------------------------------------------------------------
628 * crypt
629 * ------------------------------------------------------------------ */
630 if (doencrypt(interp, qStrList, 1) != TCL_OK) {
631
632 LOG_MSG(interp, WRITE_LOG, __FILE__, __LINE__,
633 "web::cmdurl", WEBLOG_ERROR,
634 "error encrypting \"", Tcl_GetString(qStrList), "\"",
635 NULL);
636 if (qStrList != NULL)
637 Tcl_DecrRefCount(qStrList);
638 return TCL_ERROR;
639
640 } else {
641
642 if (qStrList != NULL)
643 Tcl_DecrRefCount(qStrList);
644 qStrList = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
645 Tcl_IncrRefCount(qStrList);
646 Tcl_ResetResult(interp);
647 }
648 }
649 }
650
651 /* ==========================================================================
652 * url (stuff before query_string)
653 * ======================================================================= */
654 res = Tcl_NewObj();
655 Tcl_IncrRefCount(res);
656
657 if ((urlformat & WEB_URL_WITH_SCHEME) != 0) {
658 if (urlData->defaultscheme != NULL) {
659 Tcl_AppendObjToObj(res, urlData->defaultscheme);
660 Tcl_AppendToObj(res, WEBURL_SCHEME_SEP, -1);
661 } else {
662 Tcl_Obj *schemeObj = NULL;
663 char *scheme = NULL;
664 if( urlData->requestData != NULL ) {
665 schemeObj = paramListGetObjectByString(interp, urlData->requestData->request, "HTTPS");
666 if (schemeObj != NULL) {
667 Tcl_IncrRefCount(schemeObj);
668 scheme = Tcl_GetString(schemeObj);
669 }
670 }
671 /* scheme detection: HTTPS variable can be upper case too
672 (e.g. on Sunone) */
673 if (scheme != NULL && !STRCASECMP(scheme, "on")) {
674 Tcl_AppendToObj(res, WEB_SECURE_SCHEME, -1);
675 Tcl_AppendToObj(res, WEBURL_SCHEME_SEP, -1);
676 } else {
677 Tcl_AppendToObj(res,WEB_DEFAULT_SCHEME, -1);
678 Tcl_AppendToObj(res, WEBURL_SCHEME_SEP, -1);
679 }
680 if (schemeObj != NULL)
681 Tcl_DecrRefCount(schemeObj);
682 }
683 }
684
685 if ((urlformat & WEB_URL_WITH_HOST) != 0) {
686 Tcl_Obj *host = NULL;
687 /* try to get requested host */
688 WEB_URL_GETFROMREQDATA(host, "HTTP_HOST", 0);
689 if (host == NULL) {
690 /* fall back use server name */
691 WEB_URL_GETFROMREQDATA(host, "SERVER_NAME", 0);
692 }
693 if (host != NULL) {
694 char *hostname = Tcl_GetString(host);
695 char *colon = hostname;
696 size_t pos = 0;
697 size_t len = strlen(hostname);
698 Tcl_IncrRefCount(host);
699
700 for (; pos < len; pos++) {
701 if (*colon++ == ':') {
702 break;
703 }
704 }
705 Tcl_AppendToObj(res, WEBURL_HOST_SEP, -1);
706
707 if (pos < len) {
708 /* only insert up to colon */
709 Tcl_AppendToObj(res, hostname, pos);
710 } else {
711 Tcl_AppendObjToObj(res, host);
712 /* reset colon */
713 }
714 Tcl_DecrRefCount(host);
715 }
716 }
717
718 if ((urlformat & WEB_URL_WITH_PORT) != 0) {
719 Tcl_Obj *port = NULL;
720
721 /* To get the Port, try the following:
722 1. Take port explicitly configured in Websh if available
723 2. Take port from HTTP_HOST or SERVER_NAME if available
724 3. Take port from SERVER_PORT if available
725 4. Take default port (fallback)
726 */
727
728 if (urlData->port != NULL) {
729 port = urlData->port;
730 Tcl_IncrRefCount(port);
731 }
732
733 if (port == NULL) {
734 /* nothign found yet */
735 /* try to get requested host */
736 Tcl_Obj *host = NULL;
737 WEB_URL_GETFROMREQDATA(host, "HTTP_HOST", 1);
738 if (host == NULL) {
739 /* fall back use server name */
740 WEB_URL_GETFROMREQDATA(host, "SERVER_NAME", 1);
741 }
742 if (host != NULL) {
743 char *hostname = Tcl_GetString(host);
744 char *colon = hostname;
745 size_t pos = 0;
746 size_t len = strlen(hostname);
747 Tcl_IncrRefCount(host);
748
749 for (; pos < len; pos++) {
750 if (*colon++ == ':') {
751 break;
752 }
753 }
754
755 if (pos < len) {
756 /* colon points to port */
757 port = Tcl_NewStringObj(colon, -1);
758 Tcl_IncrRefCount(port);
759 }
760 Tcl_DecrRefCount(host);
761 }
762 }
763
764 if (port == NULL) {
765 /* still nothing found */
766 WEB_URL_GETFROMREQDATA(port, "SERVER_PORT", 0);
767 if (port != NULL) {
768 Tcl_IncrRefCount(port);
769 }
770 }
771
772 Tcl_AppendToObj(res, WEBURL_PORT_SEP, -1);
773 if (port != NULL) {
774 /* found one */
775 Tcl_AppendObjToObj(res, port);
776 Tcl_DecrRefCount(port);
777 } else {
778 /* output the default port */
779 Tcl_AppendToObj(res, WEB_DEFAULT_PORT, -1);
780 }
781 }
782
783 if ((urlformat & WEB_URL_WITH_SCRIPTNAME) != 0) {
784 Tcl_Obj *scriptname = NULL;
785 WEB_URL_GETFROMREQDATA(scriptname, "SCRIPT_NAME", 0);
786 if (scriptname != NULL) {
787 Tcl_IncrRefCount(scriptname);
788 Tcl_AppendObjToObj(res, scriptname);
789 Tcl_DecrRefCount(scriptname);
790 }
791 }
792
793 if ((urlformat & WEB_URL_WITH_PATHINFO) != 0) {
794 Tcl_Obj *pathinfo = NULL;
795 WEB_URL_GETFROMREQDATA(pathinfo, "PATH_INFO", 0);
796 if (pathinfo != NULL) {
797 Tcl_IncrRefCount(pathinfo);
798 Tcl_AppendObjToObj(res, pathinfo);
799 Tcl_DecrRefCount(pathinfo);
800 }
801 }
802
803 if ((urlformat & WEB_URL_WITH_QUERYSTRING) != 0) {
804 if (qStrList != NULL) {
805 Tcl_AppendToObj(res, WEBURL_QUERY_STRING_SEP, -1);
806 Tcl_AppendObjToObj(res, qStrList);
807 }
808 }
809 if (qStrList != NULL) {
810 Tcl_DecrRefCount(qStrList);
811 }
812
813 Tcl_SetObjResult(interp, res);
814 Tcl_DecrRefCount(res);
815
816 return TCL_OK;
817 }
818
819 /* ----------------------------------------------------------------------------
820 * Web_CmdUrlCfg -- configuration of url generation
821 * syntax: web::cmdurlcfg get|set|add|delete tag|param [key] [value] [default]
822 * param -- manage static parameters which are appended to
823 * every query_string
824 * set - set entry with name "key" to "value",
825 * overwriting any existing
826 * add - append "value" to entry with name "key" (entry is a list)
827 * del - delete entry with name "key"
828 * get - return list from entry with name "key"
829 * or list of keys, if now key is given, or "default", if
830 * no entry with name "key" exists
831 * tag -- manage tags for special entries in query_string. Syntax as above,
832 * except that "add" is mapped to "set", since tags must be
833 * single-valued lists.
834 * For the same reason, "del" is not implemented.
835 * Needed tags are: session-id, command, time
836 * Defaults are:
837 * session-id: id
838 * command: cmd
839 * time: t
840 * ------------------------------------------------------------------------- */
Web_CmdUrlCfg(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])841 int Web_CmdUrlCfg(ClientData clientData,
842 Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[])
843 {
844
845
846 UrlData *urlData = NULL;
847 /* note: this could be dynamic, but 20 is enough ... */
848 char *params[20];
849 int i;
850 int res;
851
852 for (i = SCHEME; i <= QUERYSTRING; i++)
853 params[i] = (char *) urlElementOpts[i];
854
855 params[URLCFGRESET] = "-reset";
856 params[URLCFGURLFORMAT] = "-urlformat";
857 params[URLCFGEND] = NULL;
858
859
860 /* --------------------------------------------------------------------------
861 *
862 * ----------------------------------------------------------------------- */
863 WebAssertData(interp, clientData, "Web_CmdUrlCfg", TCL_ERROR)
864 urlData = (UrlData *) clientData;
865
866 /* --------------------------------------------------------------------------
867 *
868 * ----------------------------------------------------------------------- */
869
870 res = paramGet((ParamList *) urlData->requestData->staticList,
871 interp, objc, objv, 1);
872
873 if (res == TCL_CONTINUE) {
874 int opt;
875 Tcl_Obj *tmpObj = NULL;
876
877 if (objc <= 1) {
878 Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
879 return TCL_ERROR;
880 }
881
882 if (paramGetIndexFromObj
883 (interp, objv[1], params, "subcommand", 0, &opt) == TCL_ERROR)
884 return TCL_ERROR;
885
886 /* ----------------------------------------------------------------------
887 * it is one of my options
888 * -------------------------------------------------------------------- */
889
890 /* ----------------------------------------------------------------------
891 * web::cmdurlcfg -protocol value
892 * 0 1 2
893 * ------------------------------------------------------------------- */
894 if (objc == 3)
895 tmpObj = objv[2];
896 else
897 tmpObj = NULL;
898
899 switch ((enum urlElement) opt) {
900 case SCHEME:
901 WebAssertObjc(objc > 3, 2, "?value?");
902 if (urlData->defaultscheme != NULL) {
903 Tcl_SetObjResult(interp,
904 Tcl_DuplicateObj(urlData->defaultscheme));
905 if (tmpObj != NULL) {
906 Tcl_DecrRefCount(urlData->defaultscheme);
907 urlData->defaultscheme = Tcl_DuplicateObj(tmpObj);
908 Tcl_IncrRefCount(urlData->defaultscheme);
909 }
910 return TCL_OK;
911 } else {
912 Tcl_SetObjResult(interp,
913 Tcl_NewStringObj(WEB_DEFAULT_SCHEME, -1));
914 if (tmpObj != NULL) {
915 if (strcmp(Tcl_GetString(tmpObj), "")) {
916 urlData->defaultscheme = Tcl_DuplicateObj(tmpObj);
917 Tcl_IncrRefCount(urlData->defaultscheme);
918 }
919 }
920 return TCL_OK;
921 }
922 break;
923 case HOST:
924 WebAssertObjc(objc > 3, 2, "?value?");
925 return handleConfig(interp, &urlData->host, tmpObj, 1);
926 break;
927 case PORT:
928 WebAssertObjc(objc > 3, 2, "?value?");
929 return handleConfig(interp, &urlData->port, tmpObj, 1);
930 break;
931 case SCRIPTNAME:
932 WebAssertObjc(objc > 3, 2, "?value?");
933 return handleConfig(interp, &urlData->scriptname, tmpObj, 1);
934 break;
935 case PATHINFO:
936 WebAssertObjc(objc > 3, 2, "?value?");
937 return handleConfig(interp, &urlData->pathinfo, tmpObj, 1);
938 break;
939 case QUERYSTRING:
940 WebAssertObjc(objc > 3, 2, "?value?");
941 return handleConfig(interp, &urlData->querystring, tmpObj, 1);
942 break;
943 case URLCFGRESET:
944 WebAssertObjc(objc != 2, 2, NULL);
945 return resetUrlData(interp, urlData);
946 break;
947 case URLCFGURLFORMAT:{
948 int urlformat = 0;
949 Tcl_Obj *res = NULL;
950 Tcl_Obj *tmpres = NULL;
951 enum urlElement i;
952 WebAssertObjc(objc > 3, 2, "?value?");
953 /* format current */
954 res = Tcl_NewObj();
955 Tcl_IncrRefCount(res);
956 for (i = SCHEME; i <= QUERYSTRING; i++) {
957 if (((urlData->urlformat) & urlElementFlags[i]) != 0) {
958 tmpres =
959 Tcl_NewStringObj(&(urlElementOpts[i][1]), -1);
960 Tcl_ListObjAppendElement(interp, res, tmpres);
961 }
962 }
963
964 if (tmpObj != NULL) {
965 /* we have to set it as well */
966 urlformat = parseUrlFormat(interp, tmpObj);
967 if (urlformat == 0) {
968 /* cleanup */
969 Tcl_DecrRefCount(res);
970 return TCL_ERROR;
971 }
972 urlData->urlformat = urlformat;
973 }
974 Tcl_SetObjResult(interp, res);
975 Tcl_DecrRefCount(res);
976 return TCL_OK;
977 break;
978 }
979 default:
980 LOG_MSG(interp, WRITE_LOG | SET_RESULT, __FILE__, __LINE__,
981 "web::cmdurl", WEBLOG_INFO, "unknown option", NULL);
982 return TCL_ERROR;
983 }
984 }
985 return res;
986 }
987