Artifact 19cdd101e2518fd561ffc1fbfed53a4ebc1101df:
- File webgate.scm — part of check-in [1c90f0c41c] at 2015-05-04 09:22:50 on branch trunk — Use TweetNaCl instead of Cryptlib for suspension encapsulation (user: murphy size: 5141)
0000: 3b 3b 20 2d 2a 2d 20 6d 6f 64 65 3a 20 53 63 68 ;; -*- mode: Sch 0010: 65 6d 65 3b 20 2d 2a 2d 0a 3b 3b 0a 3b 3b 20 54 eme; -*-.;;.;; T 0020: 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 72 74 his file is part 0030: 20 6f 66 20 57 65 62 47 61 74 65 20 66 6f 72 20 of WebGate for 0040: 43 48 49 43 4b 45 4e 2e 0a 3b 3b 20 43 6f 70 79 CHICKEN..;; Copy 0050: 72 69 67 68 74 20 28 63 29 20 32 30 31 31 2d 32 right (c) 2011-2 0060: 30 31 33 20 62 79 20 54 68 6f 6d 61 73 20 43 68 013 by Thomas Ch 0070: 75 73 74 2e 20 20 41 6c 6c 20 72 69 67 68 74 73 ust. All rights 0080: 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b 0a 3b 3b reserved..;;.;; 0090: 20 50 65 72 6d 69 73 73 69 6f 6e 20 69 73 20 68 Permission is h 00a0: 65 72 65 62 79 20 67 72 61 6e 74 65 64 2c 20 66 ereby granted, f 00b0: 72 65 65 20 6f 66 20 63 68 61 72 67 65 2c 20 74 ree of charge, t 00c0: 6f 20 61 6e 79 20 70 65 72 73 6f 6e 0a 3b 3b 20 o any person.;; 00d0: 6f 62 74 61 69 6e 69 6e 67 20 61 20 63 6f 70 79 obtaining a copy 00e0: 20 6f 66 20 74 68 69 73 20 73 6f 66 74 77 61 72 of this softwar 00f0: 65 20 61 6e 64 20 61 73 73 6f 63 69 61 74 65 64 e and associated 0100: 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 0a 3b documentation.; 0110: 3b 20 66 69 6c 65 73 20 28 74 68 65 20 53 6f 66 ; files (the Sof 0120: 74 77 61 72 65 29 2c 20 74 6f 20 64 65 61 6c 20 tware), to deal 0130: 69 6e 20 74 68 65 20 53 6f 66 74 77 61 72 65 20 in the Software 0140: 77 69 74 68 6f 75 74 20 72 65 73 74 72 69 63 74 without restrict 0150: 69 6f 6e 2c 0a 3b 3b 20 69 6e 63 6c 75 64 69 6e ion,.;; includin 0160: 67 20 77 69 74 68 6f 75 74 20 6c 69 6d 69 74 61 g without limita 0170: 74 69 6f 6e 20 74 68 65 20 72 69 67 68 74 73 20 tion the rights 0180: 74 6f 20 75 73 65 2c 20 63 6f 70 79 2c 20 6d 6f to use, copy, mo 0190: 64 69 66 79 2c 0a 3b 3b 20 6d 65 72 67 65 2c 20 dify,.;; merge, 01a0: 70 75 62 6c 69 73 68 2c 20 64 69 73 74 72 69 62 publish, distrib 01b0: 75 74 65 2c 20 73 75 62 6c 69 63 65 6e 73 65 2c ute, sublicense, 01c0: 20 61 6e 64 2f 6f 72 20 73 65 6c 6c 20 63 6f 70 and/or sell cop 01d0: 69 65 73 20 6f 66 20 74 68 65 0a 3b 3b 20 53 6f ies of the.;; So 01e0: 66 74 77 61 72 65 2c 20 61 6e 64 20 74 6f 20 70 ftware, and to p 01f0: 65 72 6d 69 74 20 70 65 72 73 6f 6e 73 20 74 6f ermit persons to 0200: 20 77 68 6f 6d 20 74 68 65 20 53 6f 66 74 77 61 whom the Softwa 0210: 72 65 20 69 73 20 66 75 72 6e 69 73 68 65 64 0a re is furnished. 0220: 3b 3b 20 74 6f 20 64 6f 20 73 6f 2c 20 73 75 62 ;; to do so, sub 0230: 6a 65 63 74 20 74 6f 20 74 68 65 20 66 6f 6c 6c ject to the foll 0240: 6f 77 69 6e 67 20 63 6f 6e 64 69 74 69 6f 6e 73 owing conditions 0250: 3a 0a 3b 3b 20 0a 3b 3b 20 54 68 65 20 61 62 6f :.;; .;; The abo 0260: 76 65 20 63 6f 70 79 72 69 67 68 74 20 6e 6f 74 ve copyright not 0270: 69 63 65 20 61 6e 64 20 74 68 69 73 20 70 65 72 ice and this per 0280: 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 63 65 20 73 mission notice s 0290: 68 61 6c 6c 20 62 65 0a 3b 3b 20 69 6e 63 6c 75 hall be.;; inclu 02a0: 64 65 64 20 69 6e 20 61 6c 6c 20 63 6f 70 69 65 ded in all copie 02b0: 73 20 6f 72 20 73 75 62 73 74 61 6e 74 69 61 6c s or substantial 02c0: 20 70 6f 72 74 69 6f 6e 73 20 6f 66 20 74 68 65 portions of the 02d0: 20 53 6f 66 74 77 61 72 65 2e 0a 3b 3b 20 0a 3b Software..;; .; 02e0: 3b 20 54 48 45 20 53 4f 46 54 57 41 52 45 20 49 ; THE SOFTWARE I 02f0: 53 20 50 52 4f 56 49 44 45 44 20 41 53 49 53 2c S PROVIDED ASIS, 0300: 20 57 49 54 48 4f 55 54 20 57 41 52 52 41 4e 54 WITHOUT WARRANT 0310: 59 20 4f 46 20 41 4e 59 20 4b 49 4e 44 2c 0a 3b Y OF ANY KIND,.; 0320: 3b 20 45 58 50 52 45 53 53 20 4f 52 20 49 4d 50 ; EXPRESS OR IMP 0330: 4c 49 45 44 2c 20 49 4e 43 4c 55 44 49 4e 47 20 LIED, INCLUDING 0340: 42 55 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 20 BUT NOT LIMITED 0350: 54 4f 20 54 48 45 20 57 41 52 52 41 4e 54 49 45 TO THE WARRANTIE 0360: 53 20 4f 46 0a 3b 3b 20 4d 45 52 43 48 41 4e 54 S OF.;; MERCHANT 0370: 41 42 49 4c 49 54 59 2c 20 46 49 54 4e 45 53 53 ABILITY, FITNESS 0380: 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 FOR A PARTICULA 0390: 52 20 50 55 52 50 4f 53 45 20 41 4e 44 0a 3b 3b R PURPOSE AND.;; 03a0: 20 4e 4f 4e 49 4e 46 52 49 4e 47 45 4d 45 4e 54 NONINFRINGEMENT 03b0: 2e 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 53 48 . IN NO EVENT SH 03c0: 41 4c 4c 20 54 48 45 20 41 55 54 48 4f 52 53 20 ALL THE AUTHORS 03d0: 4f 52 20 43 4f 50 59 52 49 47 48 54 20 48 4f 4c OR COPYRIGHT HOL 03e0: 44 45 52 53 0a 3b 3b 20 42 45 20 4c 49 41 42 4c DERS.;; BE LIABL 03f0: 45 20 46 4f 52 20 41 4e 59 20 43 4c 41 49 4d 2c E FOR ANY CLAIM, 0400: 20 44 41 4d 41 47 45 53 20 4f 52 20 4f 54 48 45 DAMAGES OR OTHE 0410: 52 20 4c 49 41 42 49 4c 49 54 59 2c 20 57 48 45 R LIABILITY, WHE 0420: 54 48 45 52 20 49 4e 20 41 4e 0a 3b 3b 20 41 43 THER IN AN.;; AC 0430: 54 49 4f 4e 20 4f 46 20 43 4f 4e 54 52 41 43 54 TION OF CONTRACT 0440: 2c 20 54 4f 52 54 20 4f 52 20 4f 54 48 45 52 57 , TORT OR OTHERW 0450: 49 53 45 2c 20 41 52 49 53 49 4e 47 20 46 52 4f ISE, ARISING FRO 0460: 4d 2c 20 4f 55 54 20 4f 46 20 4f 52 20 49 4e 0a M, OUT OF OR IN. 0470: 3b 3b 20 43 4f 4e 4e 45 43 54 49 4f 4e 20 57 49 ;; CONNECTION WI 0480: 54 48 20 54 48 45 20 53 4f 46 54 57 41 52 45 20 TH THE SOFTWARE 0490: 4f 52 20 54 48 45 20 55 53 45 20 4f 52 20 4f 54 OR THE USE OR OT 04a0: 48 45 52 20 44 45 41 4c 49 4e 47 53 20 49 4e 20 HER DEALINGS IN 04b0: 54 48 45 0a 3b 3b 20 53 4f 46 54 57 41 52 45 2e THE.;; SOFTWARE. 04c0: 0a 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 72 61 ..(require-libra 04d0: 72 79 0a 20 73 72 66 69 2d 31 20 73 72 66 69 2d ry. srfi-1 srfi- 04e0: 34 20 73 72 66 69 2d 31 33 20 73 72 66 69 2d 31 4 srfi-13 srfi-1 04f0: 34 20 73 72 66 69 2d 31 38 20 73 72 66 69 2d 36 4 srfi-18 srfi-6 0500: 39 20 73 72 66 69 2d 39 39 0a 20 64 61 74 61 2d 9 srfi-99. data- 0510: 73 74 72 75 63 74 75 72 65 73 20 70 6f 72 74 73 structures ports 0520: 20 65 78 74 72 61 73 20 6c 6f 6c 65 76 65 6c 20 extras lolevel 0530: 69 72 72 65 67 65 78 20 74 63 70 20 70 6f 73 69 irregex tcp posi 0540: 78 0a 20 73 75 73 70 65 6e 73 69 6f 6e 20 74 77 x. suspension tw 0550: 65 65 74 6e 61 63 6c 29 0a 0a 28 6d 6f 64 75 6c eetnacl)..(modul 0560: 65 20 77 65 62 67 61 74 65 2d 75 74 69 6c 73 0a e webgate-utils. 0570: 20 20 28 77 72 69 74 65 2d 6e 65 74 73 74 72 69 (write-netstri 0580: 6e 67 20 72 65 61 64 2d 6e 65 74 73 74 72 69 6e ng read-netstrin 0590: 67 0a 20 20 20 6d 61 6b 65 2d 61 74 2d 72 65 61 g. make-at-rea 05a0: 64 65 72 20 6d 61 6b 65 2d 61 74 2d 72 65 61 64 der make-at-read 05b0: 2d 74 61 62 6c 65 20 75 73 65 2d 61 74 2d 72 65 -table use-at-re 05c0: 61 64 2d 74 61 62 6c 65 0a 20 20 20 75 72 69 2d ad-table. uri- 05d0: 65 6e 63 6f 64 65 20 75 72 69 2d 64 65 63 6f 64 encode uri-decod 05e0: 65 0a 20 20 20 62 61 73 65 36 34 2d 65 6e 63 6f e. base64-enco 05f0: 64 65 20 62 61 73 65 36 34 2d 64 65 63 6f 64 65 de base64-decode 0600: 0a 20 20 20 77 72 69 74 65 2d 68 74 6d 6c 29 0a . write-html). 0610: 20 20 28 69 6d 70 6f 72 74 0a 20 20 20 73 63 68 (import. sch 0620: 65 6d 65 20 63 68 69 63 6b 65 6e 20 66 6f 72 65 eme chicken fore 0630: 69 67 6e 0a 20 20 20 73 72 66 69 2d 31 20 73 72 ign. srfi-1 sr 0640: 66 69 2d 31 33 20 73 72 66 69 2d 31 34 20 73 72 fi-13 srfi-14 sr 0650: 66 69 2d 36 39 0a 20 20 20 64 61 74 61 2d 73 74 fi-69. data-st 0660: 72 75 63 74 75 72 65 73 20 65 78 74 72 61 73 20 ructures extras 0670: 69 72 72 65 67 65 78 29 0a 20 20 28 69 6e 63 6c irregex). (incl 0680: 75 64 65 0a 20 20 20 22 77 65 62 67 61 74 65 2d ude. "webgate- 0690: 75 74 69 6c 73 2e 73 63 6d 22 29 29 0a 0a 28 6d utils.scm"))..(m 06a0: 6f 64 75 6c 65 20 77 65 62 67 61 74 65 2d 63 6f odule webgate-co 06b0: 72 65 0a 20 20 28 6d 65 73 73 61 67 65 20 6d 61 re. (message ma 06c0: 6b 65 2d 6d 65 73 73 61 67 65 20 6d 65 73 73 61 ke-message messa 06d0: 67 65 3f 0a 20 20 20 6d 65 73 73 61 67 65 2d 74 ge?. message-t 06e0: 79 70 65 20 6d 65 73 73 61 67 65 2d 68 65 61 64 ype message-head 06f0: 65 72 73 20 6d 65 73 73 61 67 65 2d 62 6f 64 79 ers message-body 0700: 20 6d 65 73 73 61 67 65 2d 74 65 78 74 0a 20 20 message-text. 0710: 20 77 72 69 74 65 2d 6d 65 73 73 61 67 65 0a 20 write-message. 0720: 20 20 6d 61 78 2d 72 65 71 75 65 73 74 2d 73 69 max-request-si 0730: 7a 65 0a 20 20 20 72 65 71 75 65 73 74 2d 6d 65 ze. request-me 0740: 74 68 6f 64 2d 68 61 6e 64 6c 65 72 0a 20 20 20 thod-handler. 0750: 72 65 71 75 65 73 74 2d 62 6f 64 79 2d 68 61 6e request-body-han 0760: 64 6c 65 72 0a 20 20 20 72 65 71 75 65 73 74 2d dler. request- 0770: 70 61 72 61 6d 65 74 65 72 2d 68 61 6e 64 6c 65 parameter-handle 0780: 72 0a 20 20 20 70 61 72 61 6d 65 74 65 72 2d 6c r. parameter-l 0790: 69 73 74 2d 72 65 66 20 70 61 72 61 6d 65 74 65 ist-ref paramete 07a0: 72 2d 72 65 66 0a 20 20 20 72 65 73 6f 75 72 63 r-ref. resourc 07b0: 65 2d 63 6f 6e 74 65 78 74 20 63 75 72 72 65 6e e-context curren 07c0: 74 2d 72 65 73 6f 75 72 63 65 2d 63 6f 6e 74 65 t-resource-conte 07d0: 78 74 20 72 65 73 6f 75 72 63 65 2d 63 6f 6e 74 xt resource-cont 07e0: 65 78 74 3f 0a 20 20 20 72 65 73 6f 75 72 63 65 ext?. resource 07f0: 2d 63 6f 6e 74 65 78 74 2d 67 65 74 65 6e 76 20 -context-getenv 0800: 72 65 73 6f 75 72 63 65 2d 63 6f 6e 74 65 78 74 resource-context 0810: 2d 6d 65 74 68 6f 64 20 72 65 73 6f 75 72 63 65 -method resource 0820: 2d 63 6f 6e 74 65 78 74 2d 70 61 74 68 0a 20 20 -context-path. 0830: 20 72 65 73 70 6f 6e 73 65 20 6d 61 6b 65 2d 72 response make-r 0840: 65 73 70 6f 6e 73 65 20 72 65 73 70 6f 6e 73 65 esponse response 0850: 3f 0a 20 20 20 63 6f 6c 6c 65 63 74 2d 72 65 73 ?. collect-res 0860: 70 6f 6e 73 65 20 6d 61 6b 65 2d 68 74 6d 6c 2d ponse make-html- 0870: 72 65 73 70 6f 6e 73 65 20 6d 61 6b 65 2d 65 72 response make-er 0880: 72 6f 72 2d 72 65 73 70 6f 6e 73 65 0a 20 20 20 ror-response. 0890: 6d 61 6b 65 2d 72 65 64 69 72 65 63 74 2d 72 65 make-redirect-re 08a0: 73 70 6f 6e 73 65 0a 20 20 20 72 65 73 70 6f 6e sponse. respon 08b0: 73 65 2d 73 74 61 74 75 73 20 72 65 73 70 6f 6e se-status respon 08c0: 73 65 2d 73 74 61 74 75 73 2d 6d 65 73 73 61 67 se-status-messag 08d0: 65 0a 20 20 20 77 72 69 74 65 2d 72 65 73 70 6f e. write-respo 08e0: 6e 73 65 0a 20 20 20 72 65 73 6f 75 72 63 65 2d nse. resource- 08f0: 68 61 6e 64 6c 65 72 20 72 65 73 6f 75 72 63 65 handler resource 0900: 2d 75 72 69 0a 20 20 20 28 64 65 66 69 6e 65 2d -uri. (define- 0910: 72 65 73 6f 75 72 63 65 20 72 65 73 6f 75 72 63 resource resourc 0920: 65 2d 68 61 6e 64 6c 65 72 20 65 78 74 65 6e 64 e-handler extend 0930: 2d 70 72 6f 63 65 64 75 72 65 20 70 72 6f 63 65 -procedure proce 0940: 64 75 72 65 2d 64 61 74 61 29 0a 20 20 20 68 61 dure-data). ha 0950: 6e 64 6c 65 2d 71 75 65 72 79 2d 70 61 72 61 6d ndle-query-param 0960: 65 74 65 72 73 0a 20 20 20 68 61 6e 64 6c 65 2d eters. handle- 0970: 72 65 71 75 65 73 74 29 0a 20 20 28 69 6d 70 6f request). (impo 0980: 72 74 0a 20 20 20 73 63 68 65 6d 65 20 63 68 69 rt. scheme chi 0990: 63 6b 65 6e 0a 20 20 20 73 72 66 69 2d 31 20 73 cken. srfi-1 s 09a0: 72 66 69 2d 34 20 73 72 66 69 2d 31 33 20 73 72 rfi-4 srfi-13 sr 09b0: 66 69 2d 31 38 20 73 72 66 69 2d 36 39 20 73 72 fi-18 srfi-69 sr 09c0: 66 69 2d 39 39 0a 20 20 20 64 61 74 61 2d 73 74 fi-99. data-st 09d0: 72 75 63 74 75 72 65 73 20 70 6f 72 74 73 20 65 ructures ports e 09e0: 78 74 72 61 73 20 6c 6f 6c 65 76 65 6c 20 69 72 xtras lolevel ir 09f0: 72 65 67 65 78 0a 20 20 20 73 75 73 70 65 6e 73 regex. suspens 0a00: 69 6f 6e 20 77 65 62 67 61 74 65 2d 75 74 69 6c ion webgate-util 0a10: 73 29 0a 20 20 28 69 6e 63 6c 75 64 65 0a 20 20 s). (include. 0a20: 20 22 77 65 62 67 61 74 65 2d 63 6f 72 65 2e 73 "webgate-core.s 0a30: 63 6d 22 29 29 0a 0a 28 6d 6f 64 75 6c 65 20 77 cm"))..(module w 0a40: 65 62 67 61 74 65 2d 73 75 73 70 65 6e 64 0a 20 ebgate-suspend. 0a50: 20 28 63 75 72 72 65 6e 74 2d 73 75 73 70 65 6e (current-suspen 0a60: 73 69 6f 6e 2d 6b 65 79 0a 20 20 20 73 75 73 70 sion-key. susp 0a70: 65 6e 64 65 64 0a 20 20 20 73 65 6e 64 2f 73 75 ended. send/su 0a80: 73 70 65 6e 64 29 0a 20 20 28 69 6d 70 6f 72 74 spend). (import 0a90: 0a 20 20 20 73 63 68 65 6d 65 20 63 68 69 63 6b . scheme chick 0aa0: 65 6e 0a 20 20 20 73 72 66 69 2d 31 20 73 72 66 en. srfi-1 srf 0ab0: 69 2d 34 20 73 72 66 69 2d 31 33 20 73 72 66 69 i-4 srfi-13 srfi 0ac0: 2d 31 38 20 73 72 66 69 2d 36 39 0a 20 20 20 64 -18 srfi-69. d 0ad0: 61 74 61 2d 73 74 72 75 63 74 75 72 65 73 20 65 ata-structures e 0ae0: 78 74 72 61 73 20 73 75 73 70 65 6e 73 69 6f 6e xtras suspension 0af0: 20 74 77 65 65 74 6e 61 63 6c 20 77 65 62 67 61 tweetnacl webga 0b00: 74 65 2d 75 74 69 6c 73 20 77 65 62 67 61 74 65 te-utils webgate 0b10: 2d 63 6f 72 65 0a 20 20 20 28 6f 6e 6c 79 20 70 -core. (only p 0b20: 6f 73 69 78 20 63 75 72 72 65 6e 74 2d 75 73 65 osix current-use 0b30: 72 2d 69 64 20 63 75 72 72 65 6e 74 2d 67 72 6f r-id current-gro 0b40: 75 70 2d 69 64 20 63 75 72 72 65 6e 74 2d 64 69 up-id current-di 0b50: 72 65 63 74 6f 72 79 29 29 0a 20 20 28 69 6e 63 rectory)). (inc 0b60: 6c 75 64 65 0a 20 20 20 22 77 65 62 67 61 74 65 lude. "webgate 0b70: 2d 73 75 73 70 65 6e 64 2e 73 63 6d 22 29 29 0a -suspend.scm")). 0b80: 0a 28 6d 6f 64 75 6c 65 20 77 65 62 67 61 74 65 .(module webgate 0b90: 2d 63 67 69 0a 20 20 28 63 67 69 2d 6d 61 69 6e -cgi. (cgi-main 0ba0: 2d 6c 6f 6f 70 29 0a 20 20 28 69 6d 70 6f 72 74 -loop). (import 0bb0: 0a 20 20 20 73 63 68 65 6d 65 20 63 68 69 63 6b . scheme chick 0bc0: 65 6e 0a 20 20 20 28 6f 6e 6c 79 20 77 65 62 67 en. (only webg 0bd0: 61 74 65 2d 63 6f 72 65 20 77 72 69 74 65 2d 72 ate-core write-r 0be0: 65 73 70 6f 6e 73 65 29 29 0a 20 20 28 69 6e 63 esponse)). (inc 0bf0: 6c 75 64 65 0a 20 20 20 22 77 65 62 67 61 74 65 lude. "webgate 0c00: 2d 63 67 69 2e 73 63 6d 22 29 29 0a 0a 28 6d 6f -cgi.scm"))..(mo 0c10: 64 75 6c 65 20 77 65 62 67 61 74 65 2d 73 63 67 dule webgate-scg 0c20: 69 0a 20 20 28 73 63 67 69 2d 6d 61 69 6e 2d 6c i. (scgi-main-l 0c30: 6f 6f 70 29 0a 20 20 28 69 6d 70 6f 72 74 0a 20 oop). (import. 0c40: 20 20 73 63 68 65 6d 65 20 63 68 69 63 6b 65 6e scheme chicken 0c50: 0a 20 20 20 73 72 66 69 2d 31 33 20 73 72 66 69 . srfi-13 srfi 0c60: 2d 31 38 20 73 72 66 69 2d 36 39 0a 20 20 20 64 -18 srfi-69. d 0c70: 61 74 61 2d 73 74 72 75 63 74 75 72 65 73 20 69 ata-structures i 0c80: 72 72 65 67 65 78 20 77 65 62 67 61 74 65 2d 75 rregex webgate-u 0c90: 74 69 6c 73 20 74 63 70 0a 20 20 20 28 6f 6e 6c tils tcp. (onl 0ca0: 79 20 77 65 62 67 61 74 65 2d 63 6f 72 65 20 77 y webgate-core w 0cb0: 72 69 74 65 2d 72 65 73 70 6f 6e 73 65 29 29 0a rite-response)). 0cc0: 20 20 28 69 6e 63 6c 75 64 65 0a 20 20 20 22 77 (include. "w 0cd0: 65 62 67 61 74 65 2d 73 63 67 69 2e 73 63 6d 22 ebgate-scgi.scm" 0ce0: 29 29 0a 0a 28 63 6f 6e 64 2d 65 78 70 61 6e 64 ))..(cond-expand 0cf0: 0a 20 20 28 65 6e 61 62 6c 65 2d 73 6f 75 70 0a . (enable-soup. 0d00: 20 20 20 28 6d 6f 64 75 6c 65 20 77 65 62 67 61 (module webga 0d10: 74 65 2d 73 6f 75 70 0a 20 20 20 20 20 28 73 6f te-soup. (so 0d20: 75 70 2d 6d 61 69 6e 2d 6c 6f 6f 70 29 0a 20 20 up-main-loop). 0d30: 20 20 20 28 69 6d 70 6f 72 74 0a 20 20 20 20 20 (import. 0d40: 20 73 63 68 65 6d 65 20 63 68 69 63 6b 65 6e 20 scheme chicken 0d50: 66 6f 72 65 69 67 6e 0a 20 20 20 20 20 20 73 72 foreign. sr 0d60: 66 69 2d 31 0a 20 20 20 20 20 20 64 61 74 61 2d fi-1. data- 0d70: 73 74 72 75 63 74 75 72 65 73 20 77 65 62 67 61 structures webga 0d80: 74 65 2d 63 6f 72 65 29 0a 20 20 20 20 20 28 69 te-core). (i 0d90: 6e 63 6c 75 64 65 0a 20 20 20 20 20 20 22 77 65 nclude. "we 0da0: 62 67 61 74 65 2d 73 6f 75 70 2e 73 63 6d 22 29 bgate-soup.scm") 0db0: 29 29 0a 20 20 28 65 6c 73 65 29 29 0a 0a 28 6d )). (else))..(m 0dc0: 6f 64 75 6c 65 20 77 65 62 67 61 74 65 0a 20 20 odule webgate. 0dd0: 28 77 65 62 67 61 74 65 2d 6d 61 69 6e 29 0a 20 (webgate-main). 0de0: 20 28 69 6d 70 6f 72 74 0a 20 20 20 73 63 68 65 (import. sche 0df0: 6d 65 20 63 68 69 63 6b 65 6e 0a 20 20 20 73 72 me chicken. sr 0e00: 66 69 2d 31 33 20 77 65 62 67 61 74 65 2d 63 67 fi-13 webgate-cg 0e10: 69 20 77 65 62 67 61 74 65 2d 73 63 67 69 20 74 i webgate-scgi t 0e20: 63 70 0a 20 20 20 28 6f 6e 6c 79 20 77 65 62 67 cp. (only webg 0e30: 61 74 65 2d 63 6f 72 65 0a 09 20 68 61 6e 64 6c ate-core.. handl 0e40: 65 2d 72 65 71 75 65 73 74 29 0a 20 20 20 28 6f e-request). (o 0e50: 6e 6c 79 20 77 65 62 67 61 74 65 2d 73 75 73 70 nly webgate-susp 0e60: 65 6e 64 0a 09 20 63 75 72 72 65 6e 74 2d 73 75 end.. current-su 0e70: 73 70 65 6e 73 69 6f 6e 2d 6b 65 79 29 29 0a 20 spension-key)). 0e80: 20 28 63 6f 6e 64 2d 65 78 70 61 6e 64 0a 20 20 (cond-expand. 0e90: 20 20 28 65 6e 61 62 6c 65 2d 73 6f 75 70 0a 20 (enable-soup. 0ea0: 20 20 20 20 28 69 6d 70 6f 72 74 20 77 65 62 67 (import webg 0eb0: 61 74 65 2d 73 6f 75 70 29 29 0a 20 20 20 20 28 ate-soup)). ( 0ec0: 65 6c 73 65 29 29 0a 20 20 28 72 65 65 78 70 6f else)). (reexpo 0ed0: 72 74 0a 20 20 20 28 6f 6e 6c 79 20 77 65 62 67 rt. (only webg 0ee0: 61 74 65 2d 63 6f 72 65 0a 09 20 6d 65 73 73 61 ate-core.. messa 0ef0: 67 65 20 6d 61 6b 65 2d 6d 65 73 73 61 67 65 20 ge make-message 0f00: 6d 65 73 73 61 67 65 3f 0a 09 20 6d 65 73 73 61 message?.. messa 0f10: 67 65 2d 74 79 70 65 20 6d 65 73 73 61 67 65 2d ge-type message- 0f20: 68 65 61 64 65 72 73 20 6d 65 73 73 61 67 65 2d headers message- 0f30: 62 6f 64 79 20 6d 65 73 73 61 67 65 2d 74 65 78 body message-tex 0f40: 74 0a 09 20 70 61 72 61 6d 65 74 65 72 2d 6c 69 t.. parameter-li 0f50: 73 74 2d 72 65 66 20 70 61 72 61 6d 65 74 65 72 st-ref parameter 0f60: 2d 72 65 66 0a 09 20 72 65 73 6f 75 72 63 65 2d -ref.. resource- 0f70: 63 6f 6e 74 65 78 74 20 63 75 72 72 65 6e 74 2d context current- 0f80: 72 65 73 6f 75 72 63 65 2d 63 6f 6e 74 65 78 74 resource-context 0f90: 20 72 65 73 6f 75 72 63 65 2d 63 6f 6e 74 65 78 resource-contex 0fa0: 74 3f 0a 09 20 72 65 73 6f 75 72 63 65 2d 63 6f t?.. resource-co 0fb0: 6e 74 65 78 74 2d 67 65 74 65 6e 76 20 72 65 73 ntext-getenv res 0fc0: 6f 75 72 63 65 2d 63 6f 6e 74 65 78 74 2d 6d 65 ource-context-me 0fd0: 74 68 6f 64 20 72 65 73 6f 75 72 63 65 2d 63 6f thod resource-co 0fe0: 6e 74 65 78 74 2d 70 61 74 68 0a 09 20 72 65 73 ntext-path.. res 0ff0: 70 6f 6e 73 65 20 6d 61 6b 65 2d 72 65 73 70 6f ponse make-respo 1000: 6e 73 65 20 72 65 73 70 6f 6e 73 65 3f 0a 09 20 nse response?.. 1010: 63 6f 6c 6c 65 63 74 2d 72 65 73 70 6f 6e 73 65 collect-response 1020: 20 6d 61 6b 65 2d 68 74 6d 6c 2d 72 65 73 70 6f make-html-respo 1030: 6e 73 65 20 6d 61 6b 65 2d 65 72 72 6f 72 2d 72 nse make-error-r 1040: 65 73 70 6f 6e 73 65 0a 09 20 6d 61 6b 65 2d 72 esponse.. make-r 1050: 65 64 69 72 65 63 74 2d 72 65 73 70 6f 6e 73 65 edirect-response 1060: 0a 09 20 72 65 73 70 6f 6e 73 65 2d 73 74 61 74 .. response-stat 1070: 75 73 20 72 65 73 70 6f 6e 73 65 2d 73 74 61 74 us response-stat 1080: 75 73 2d 6d 65 73 73 61 67 65 0a 09 20 64 65 66 us-message.. def 1090: 69 6e 65 2d 72 65 73 6f 75 72 63 65 20 72 65 73 ine-resource res 10a0: 6f 75 72 63 65 2d 75 72 69 29 0a 20 20 20 28 6f ource-uri). (o 10b0: 6e 6c 79 20 77 65 62 67 61 74 65 2d 73 75 73 70 nly webgate-susp 10c0: 65 6e 64 0a 09 20 73 65 6e 64 2f 73 75 73 70 65 end.. send/suspe 10d0: 6e 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 77 nd))..(define (w 10e0: 65 62 67 61 74 65 2d 6d 61 69 6e 20 23 21 6f 70 ebgate-main #!op 10f0: 74 69 6f 6e 61 6c 20 28 61 72 67 75 6d 65 6e 74 tional (argument 1100: 73 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 2d s (command-line- 1110: 61 72 67 75 6d 65 6e 74 73 29 29 29 0a 20 20 28 arguments))). ( 1120: 61 70 70 6c 79 0a 20 20 20 28 6c 61 6d 62 64 61 apply. (lambda 1130: 20 28 23 21 6b 65 79 20 28 70 6f 72 74 20 23 66 (#!key (port #f 1140: 29 20 28 62 61 63 6b 6c 6f 67 20 34 29 20 28 68 ) (backlog 4) (h 1150: 6f 73 74 20 22 6c 6f 63 61 6c 68 6f 73 74 22 29 ost "localhost") 1160: 20 28 73 75 73 70 65 6e 73 69 6f 6e 2d 6b 65 79 (suspension-key 1170: 20 23 66 29 29 0a 20 20 20 20 20 28 63 6f 6e 64 #f)). (cond 1180: 0a 20 20 20 20 20 20 28 73 75 73 70 65 6e 73 69 . (suspensi 1190: 6f 6e 2d 6b 65 79 20 3d 3e 20 63 75 72 72 65 6e on-key => curren 11a0: 74 2d 73 75 73 70 65 6e 73 69 6f 6e 2d 6b 65 79 t-suspension-key 11b0: 29 29 0a 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 )). (cond. 11c0: 20 20 20 20 28 28 61 6e 64 20 70 6f 72 74 20 28 ((and port ( 11d0: 65 71 75 61 6c 3f 20 68 6f 73 74 20 22 68 74 74 equal? host "htt 11e0: 70 3a 2a 22 29 29 0a 20 20 20 20 20 20 20 28 63 p:*")). (c 11f0: 6f 6e 64 2d 65 78 70 61 6e 64 0a 20 20 20 20 20 ond-expand. 1200: 20 20 20 28 65 6e 61 62 6c 65 2d 73 6f 75 70 0a (enable-soup. 1210: 20 20 20 20 20 20 20 20 20 28 73 6f 75 70 2d 6d (soup-m 1220: 61 69 6e 2d 6c 6f 6f 70 20 68 61 6e 64 6c 65 2d ain-loop handle- 1230: 72 65 71 75 65 73 74 20 28 73 74 72 69 6e 67 2d request (string- 1240: 3e 6e 75 6d 62 65 72 20 70 6f 72 74 29 29 29 0a >number port))). 1250: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else. 1260: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 77 (error 'w 1270: 65 62 67 61 74 65 2d 6d 61 69 6e 20 22 48 54 54 ebgate-main "HTT 1280: 50 20 73 75 70 70 6f 72 74 20 6e 6f 74 20 65 6e P support not en 1290: 61 62 6c 65 64 22 29 29 29 29 0a 20 20 20 20 20 abled")))). 12a0: 20 28 70 6f 72 74 0a 20 20 20 20 20 20 20 28 6c (port. (l 12b0: 65 74 20 28 28 65 61 72 20 28 74 63 70 2d 6c 69 et ((ear (tcp-li 12c0: 73 74 65 6e 20 28 73 74 72 69 6e 67 2d 3e 6e 75 sten (string->nu 12d0: 6d 62 65 72 20 70 6f 72 74 29 20 62 61 63 6b 6c mber port) backl 12e0: 6f 67 20 68 6f 73 74 29 29 29 0a 20 20 20 20 20 og host))). 12f0: 20 20 20 20 28 64 79 6e 61 6d 69 63 2d 77 69 6e (dynamic-win 1300: 64 0a 09 20 20 20 20 20 76 6f 69 64 0a 09 20 20 d.. void.. 1310: 20 20 20 28 63 75 74 20 73 63 67 69 2d 6d 61 69 (cut scgi-mai 1320: 6e 2d 6c 6f 6f 70 20 68 61 6e 64 6c 65 2d 72 65 n-loop handle-re 1330: 71 75 65 73 74 20 65 61 72 29 0a 09 20 20 20 20 quest ear).. 1340: 20 28 63 75 74 20 74 63 70 2d 63 6c 6f 73 65 20 (cut tcp-close 1350: 65 61 72 29 29 29 29 0a 20 20 20 20 20 20 28 65 ear)))). (e 1360: 6c 73 65 0a 20 20 20 20 20 20 20 28 63 67 69 2d lse. (cgi- 1370: 6d 61 69 6e 2d 6c 6f 6f 70 20 68 61 6e 64 6c 65 main-loop handle 1380: 2d 72 65 71 75 65 73 74 29 29 29 29 0a 20 20 20 -request)))). 1390: 28 6d 61 70 0a 20 20 20 20 28 6c 61 6d 62 64 61 (map. (lambda 13a0: 20 28 61 72 67 29 0a 20 20 20 20 20 20 28 69 66 (arg). (if 13b0: 20 28 73 74 72 69 6e 67 2d 70 72 65 66 69 78 3f (string-prefix? 13c0: 20 22 2d 22 20 61 72 67 29 0a 09 20 20 28 73 74 "-" arg).. (st 13d0: 72 69 6e 67 2d 3e 6b 65 79 77 6f 72 64 20 28 73 ring->keyword (s 13e0: 75 62 73 74 72 69 6e 67 2f 73 68 61 72 65 64 20 ubstring/shared 13f0: 61 72 67 20 31 29 29 0a 09 20 20 61 72 67 29 29 arg 1)).. arg)) 1400: 0a 20 20 20 20 61 72 67 75 6d 65 6e 74 73 29 29 . arguments)) 1410: 29 0a 0a 29 0a )..).