Artifact 53e59a7183de2ed5e93492741521ebf4c4e00533:
- File webgate-scgi.scm — part of check-in [11d7807ffd] at 2013-11-24 22:17:36 on branch trunk — Optional direct HTTP support using soup (user: murphy size: 2095)
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 3b 3b 3b 20 53 43 47 49 20 73 65 72 76 65 ..;;; SCGI serve 04d0: 72 20 6c 6f 6f 70 20 28 61 6e 64 20 64 69 72 65 r loop (and dire 04e0: 63 74 6c 79 20 72 65 6c 61 74 65 64 20 73 74 75 ctly related stu 04f0: 66 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 63 ff)..(define (sc 0500: 67 69 2d 6d 61 69 6e 2d 6c 6f 6f 70 20 68 61 6e gi-main-loop han 0510: 64 6c 65 2d 72 65 71 75 65 73 74 20 6c 69 73 74 dle-request list 0520: 65 6e 65 72 29 0a 20 20 28 6c 65 74 20 28 28 65 ener). (let ((e 0530: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 72 78 0a 09 20 nvironment-rx.. 0540: 28 69 72 72 65 67 65 78 20 27 28 3a 20 28 24 20 (irregex '(: ($ 0550: 28 2a 20 28 7e 20 23 5c 6e 75 6c 29 29 29 20 23 (* (~ #\nul))) # 0560: 5c 6e 75 6c 20 28 24 20 28 2a 20 28 7e 20 23 5c \nul ($ (* (~ #\ 0570: 6e 75 6c 29 29 29 20 23 5c 6e 75 6c 29 29 29 29 nul))) #\nul)))) 0580: 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop ( 0590: 29 0a 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c ). (let-val 05a0: 75 65 73 20 28 28 28 69 6e 70 75 74 2d 70 6f 72 ues (((input-por 05b0: 74 20 6f 75 74 70 75 74 2d 70 6f 72 74 29 20 28 t output-port) ( 05c0: 74 63 70 2d 61 63 63 65 70 74 20 6c 69 73 74 65 tcp-accept liste 05d0: 6e 65 72 29 29 29 0a 09 28 74 68 72 65 61 64 2d ner)))..(thread- 05e0: 73 74 61 72 74 21 0a 09 20 28 6d 61 6b 65 2d 74 start!.. (make-t 05f0: 68 72 65 61 64 0a 09 20 20 28 6c 61 6d 62 64 61 hread.. (lambda 0600: 20 28 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 ().. (let (( 0610: 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 09 09 20 20 environment... 0620: 20 28 69 72 72 65 67 65 78 2d 66 6f 6c 64 0a 09 (irregex-fold.. 0630: 09 20 20 20 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 . environment 0640: 2d 72 78 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 -rx... (lambd 0650: 61 20 28 73 74 61 72 74 20 6d 20 65 6e 76 69 72 a (start m envir 0660: 6f 6e 6d 65 6e 74 29 0a 09 09 20 20 20 20 20 20 onment)... 0670: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set! 0680: 0a 09 09 20 20 20 20 20 20 20 65 6e 76 69 72 6f ... enviro 0690: 6e 6d 65 6e 74 20 28 69 72 72 65 67 65 78 2d 6d nment (irregex-m 06a0: 61 74 63 68 2d 73 75 62 73 74 72 69 6e 67 20 6d atch-substring m 06b0: 20 31 29 0a 09 09 20 20 20 20 20 20 20 28 69 72 1)... (ir 06c0: 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 75 62 73 regex-match-subs 06d0: 74 72 69 6e 67 20 6d 20 32 29 29 0a 09 09 20 20 tring m 2))... 06e0: 20 20 20 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 29 environment) 06f0: 0a 09 09 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 ... (make-has 0700: 68 2d 74 61 62 6c 65 20 23 3a 74 65 73 74 20 73 h-table #:test s 0710: 74 72 69 6e 67 3d 3f 20 23 3a 68 61 73 68 20 73 tring=? #:hash s 0720: 74 72 69 6e 67 2d 68 61 73 68 29 0a 09 09 20 20 tring-hash)... 0730: 20 20 28 72 65 61 64 2d 6e 65 74 73 74 72 69 6e (read-netstrin 0740: 67 20 69 6e 70 75 74 2d 70 6f 72 74 29 29 29 29 g input-port)))) 0750: 0a 09 20 20 20 20 20 20 28 68 61 6e 64 6c 65 2d .. (handle- 0760: 72 65 71 75 65 73 74 0a 09 20 20 20 20 20 20 20 request.. 0770: 28 63 75 74 20 68 61 73 68 2d 74 61 62 6c 65 2d (cut hash-table- 0780: 72 65 66 2f 64 65 66 61 75 6c 74 20 65 6e 76 69 ref/default envi 0790: 72 6f 6e 6d 65 6e 74 20 3c 3e 20 23 66 29 0a 09 ronment <> #f).. 07a0: 20 20 20 20 20 20 20 69 6e 70 75 74 2d 70 6f 72 input-por 07b0: 74 20 28 63 75 74 20 77 72 69 74 65 2d 72 65 73 t (cut write-res 07c0: 70 6f 6e 73 65 20 3c 3e 20 6f 75 74 70 75 74 2d ponse <> output- 07d0: 70 6f 72 74 29 29 29 0a 09 20 20 20 20 28 63 6c port))).. (cl 07e0: 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 ose-input-port i 07f0: 6e 70 75 74 2d 70 6f 72 74 29 0a 09 20 20 20 20 nput-port).. 0800: 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f (close-output-po 0810: 72 74 20 6f 75 74 70 75 74 2d 70 6f 72 74 29 29 rt output-port)) 0820: 29 29 0a 09 28 6c 6f 6f 70 29 29 29 29 29 0a ))..(loop))))).