Artifact d344d0a505267e7c73ed1539c19ca6e01652ad02:
- File webgate-soup.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: 4967)
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 66 6f 72 65 69 67 6e 2d 64 65 63 6c 61 ..(foreign-decla 04d0: 72 65 0a 20 20 22 23 69 6e 63 6c 75 64 65 20 3c re. "#include < 04e0: 67 6c 69 62 2e 68 3e 5c 6e 22 0a 20 20 22 23 69 glib.h>\n". "#i 04f0: 6e 63 6c 75 64 65 20 3c 6c 69 62 73 6f 75 70 2f nclude <libsoup/ 0500: 73 6f 75 70 2e 68 3e 5c 6e 22 29 0a 0a 28 66 6f soup.h>\n")..(fo 0510: 72 65 69 67 6e 2d 63 6f 64 65 0a 20 20 22 67 5f reign-code. "g_ 0520: 74 79 70 65 5f 69 6e 69 74 28 29 3b 22 29 0a 0a type_init();").. 0530: 28 64 65 66 69 6e 65 20 73 6f 75 70 2d 73 65 72 (define soup-ser 0540: 76 65 72 2d 6e 65 77 0a 20 20 28 66 6f 72 65 69 ver-new. (forei 0550: 67 6e 2d 6c 61 6d 62 64 61 2a 20 28 63 2d 70 6f gn-lambda* (c-po 0560: 69 6e 74 65 72 20 22 53 6f 75 70 53 65 72 76 65 inter "SoupServe 0570: 72 22 29 20 28 28 75 6e 73 69 67 6e 65 64 2d 69 r") ((unsigned-i 0580: 6e 74 65 67 65 72 20 70 6f 72 74 29 29 0a 20 20 nteger port)). 0590: 20 20 22 43 5f 72 65 74 75 72 6e 28 73 6f 75 70 "C_return(soup 05a0: 5f 73 65 72 76 65 72 5f 6e 65 77 28 53 4f 55 50 _server_new(SOUP 05b0: 5f 53 45 52 56 45 52 5f 50 4f 52 54 2c 20 70 6f _SERVER_PORT, po 05c0: 72 74 2c 20 53 4f 55 50 5f 53 45 52 56 45 52 5f rt, SOUP_SERVER_ 05d0: 52 41 57 5f 50 41 54 48 53 2c 20 54 52 55 45 2c RAW_PATHS, TRUE, 05e0: 20 4e 55 4c 4c 29 29 3b 22 29 29 0a 0a 28 64 65 NULL));"))..(de 05f0: 66 69 6e 65 2d 65 78 74 65 72 6e 61 6c 20 28 77 fine-external (w 0600: 65 62 67 61 74 65 5f 73 6f 75 70 5f 63 61 6c 6c ebgate_soup_call 0610: 62 61 63 6b 20 28 28 63 2d 70 6f 69 6e 74 65 72 back ((c-pointer 0620: 20 22 53 6f 75 70 53 65 72 76 65 72 22 29 20 73 "SoupServer") s 0630: 65 72 76 65 72 29 0a 09 09 09 09 09 28 28 63 2d erver)......((c- 0640: 70 6f 69 6e 74 65 72 20 22 53 6f 75 70 4d 65 73 pointer "SoupMes 0650: 73 61 67 65 22 29 20 6d 65 73 73 61 67 65 29 0a sage") message). 0660: 09 09 09 09 09 28 28 63 6f 6e 73 74 20 63 2d 73 .....((const c-s 0670: 74 72 69 6e 67 29 20 70 61 74 68 29 0a 09 09 09 tring) path).... 0680: 09 09 28 28 63 2d 70 6f 69 6e 74 65 72 20 22 47 ..((c-pointer "G 0690: 48 61 73 68 54 61 62 6c 65 22 29 20 71 75 65 72 HashTable") quer 06a0: 79 29 0a 09 09 09 09 09 28 28 63 2d 70 6f 69 6e y)......((c-poin 06b0: 74 65 72 20 22 53 6f 75 70 43 6c 69 65 6e 74 43 ter "SoupClientC 06c0: 6f 6e 74 65 78 74 22 29 20 63 6c 69 65 6e 74 29 ontext") client) 06d0: 0a 09 09 09 09 09 28 63 2d 70 6f 69 6e 74 65 72 ......(c-pointer 06e0: 20 72 6f 6f 74 29 29 20 76 6f 69 64 0a 20 20 28 root)) void. ( 06f0: 28 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 ((foreign-lambda 0700: 20 73 63 68 65 6d 65 2d 6f 62 6a 65 63 74 20 22 scheme-object " 0710: 43 48 49 43 4b 45 4e 5f 67 63 5f 72 6f 6f 74 5f CHICKEN_gc_root_ 0720: 72 65 66 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 2d 70 ref" nonnull-c-p 0730: 6f 69 6e 74 65 72 29 0a 20 20 20 20 72 6f 6f 74 ointer). root 0740: 29 0a 20 20 20 73 65 72 76 65 72 20 6d 65 73 73 ). server mess 0750: 61 67 65 20 70 61 74 68 29 29 0a 0a 28 64 65 66 age path))..(def 0760: 69 6e 65 20 73 6f 75 70 2d 73 65 72 76 65 72 2d ine soup-server- 0770: 61 64 64 2d 68 61 6e 64 6c 65 72 0a 20 20 28 66 add-handler. (f 0780: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 76 oreign-lambda* v 0790: 6f 69 64 20 28 28 28 6e 6f 6e 6e 75 6c 6c 2d 63 oid (((nonnull-c 07a0: 2d 70 6f 69 6e 74 65 72 20 22 53 6f 75 70 53 65 -pointer "SoupSe 07b0: 72 76 65 72 22 29 20 73 65 72 76 65 72 29 0a 09 rver") server).. 07c0: 09 09 20 28 63 2d 73 74 72 69 6e 67 20 70 61 74 .. (c-string pat 07d0: 68 29 0a 09 09 09 20 28 73 63 68 65 6d 65 2d 6f h).... (scheme-o 07e0: 62 6a 65 63 74 20 70 72 6f 63 29 29 0a 20 20 20 bject proc)). 07f0: 20 22 76 6f 69 64 20 2a 72 6f 6f 74 20 3d 20 43 "void *root = C 0800: 48 49 43 4b 45 4e 5f 6e 65 77 5f 67 63 5f 72 6f HICKEN_new_gc_ro 0810: 6f 74 28 29 3b 5c 6e 22 0a 20 20 20 20 22 43 48 ot();\n". "CH 0820: 49 43 4b 45 4e 5f 67 63 5f 72 6f 6f 74 5f 73 65 ICKEN_gc_root_se 0830: 74 28 72 6f 6f 74 2c 20 70 72 6f 63 29 3b 5c 6e t(root, proc);\n 0840: 22 0a 20 20 20 20 22 73 6f 75 70 5f 73 65 72 76 ". "soup_serv 0850: 65 72 5f 61 64 64 5f 68 61 6e 64 6c 65 72 28 73 er_add_handler(s 0860: 65 72 76 65 72 2c 20 70 61 74 68 2c 20 77 65 62 erver, path, web 0870: 67 61 74 65 5f 73 6f 75 70 5f 63 61 6c 6c 62 61 gate_soup_callba 0880: 63 6b 2c 20 72 6f 6f 74 2c 20 43 48 49 43 4b 45 ck, root, CHICKE 0890: 4e 5f 64 65 6c 65 74 65 5f 67 63 5f 72 6f 6f 74 N_delete_gc_root 08a0: 29 3b 5c 6e 22 29 29 0a 0a 28 64 65 66 69 6e 65 );\n"))..(define 08b0: 20 73 6f 75 70 2d 73 65 72 76 65 72 2d 72 75 6e soup-server-run 08c0: 0a 20 20 28 66 6f 72 65 69 67 6e 2d 73 61 66 65 . (foreign-safe 08d0: 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 73 6f -lambda void "so 08e0: 75 70 5f 73 65 72 76 65 72 5f 72 75 6e 22 20 28 up_server_run" ( 08f0: 6e 6f 6e 6e 75 6c 6c 2d 63 2d 70 6f 69 6e 74 65 nonnull-c-pointe 0900: 72 20 22 53 6f 75 70 53 65 72 76 65 72 22 29 29 r "SoupServer")) 0910: 29 0a 0a 28 64 65 66 69 6e 65 20 73 6f 75 70 2d )..(define soup- 0920: 6d 65 73 73 61 67 65 2d 6d 65 74 68 6f 64 0a 20 message-method. 0930: 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 (foreign-lambda 0940: 2a 20 63 2d 73 74 72 69 6e 67 20 28 28 28 6e 6f * c-string (((no 0950: 6e 6e 75 6c 6c 2d 63 2d 70 6f 69 6e 74 65 72 20 nnull-c-pointer 0960: 22 53 6f 75 70 4d 65 73 73 61 67 65 22 29 20 6d "SoupMessage") m 0970: 65 73 73 61 67 65 29 29 0a 20 20 20 20 22 43 5f essage)). "C_ 0980: 72 65 74 75 72 6e 28 6d 65 73 73 61 67 65 2d 3e return(message-> 0990: 6d 65 74 68 6f 64 29 3b 22 29 29 0a 0a 28 64 65 method);"))..(de 09a0: 66 69 6e 65 20 73 6f 75 70 2d 6d 65 73 73 61 67 fine soup-messag 09b0: 65 2d 71 75 65 72 79 0a 20 20 28 66 6f 72 65 69 e-query. (forei 09c0: 67 6e 2d 6c 61 6d 62 64 61 2a 20 63 2d 73 74 72 gn-lambda* c-str 09d0: 69 6e 67 20 28 28 28 6e 6f 6e 6e 75 6c 6c 2d 63 ing (((nonnull-c 09e0: 2d 70 6f 69 6e 74 65 72 20 22 53 6f 75 70 4d 65 -pointer "SoupMe 09f0: 73 73 61 67 65 22 29 20 6d 65 73 73 61 67 65 29 ssage") message) 0a00: 29 0a 20 20 20 20 22 43 5f 72 65 74 75 72 6e 28 ). "C_return( 0a10: 73 6f 75 70 5f 75 72 69 5f 67 65 74 5f 71 75 65 soup_uri_get_que 0a20: 72 79 28 73 6f 75 70 5f 6d 65 73 73 61 67 65 5f ry(soup_message_ 0a30: 67 65 74 5f 75 72 69 28 6d 65 73 73 61 67 65 29 get_uri(message) 0a40: 29 29 3b 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 ));"))..(define 0a50: 73 6f 75 70 2d 72 65 71 75 65 73 74 2d 68 65 61 soup-request-hea 0a60: 64 65 72 2d 72 65 66 0a 20 20 28 66 6f 72 65 69 der-ref. (forei 0a70: 67 6e 2d 6c 61 6d 62 64 61 2a 20 63 2d 73 74 72 gn-lambda* c-str 0a80: 69 6e 67 20 28 28 28 6e 6f 6e 6e 75 6c 6c 2d 63 ing (((nonnull-c 0a90: 2d 70 6f 69 6e 74 65 72 20 22 53 6f 75 70 4d 65 -pointer "SoupMe 0aa0: 73 73 61 67 65 22 29 20 6d 65 73 73 61 67 65 29 ssage") message) 0ab0: 0a 09 09 09 20 20 20 20 20 28 6e 6f 6e 6e 75 6c .... (nonnul 0ac0: 6c 2d 63 2d 73 74 72 69 6e 67 20 6e 61 6d 65 29 l-c-string name) 0ad0: 29 0a 20 20 20 20 22 43 5f 72 65 74 75 72 6e 28 ). "C_return( 0ae0: 73 6f 75 70 5f 6d 65 73 73 61 67 65 5f 68 65 61 soup_message_hea 0af0: 64 65 72 73 5f 67 65 74 5f 6c 69 73 74 28 6d 65 ders_get_list(me 0b00: 73 73 61 67 65 2d 3e 72 65 71 75 65 73 74 5f 68 ssage->request_h 0b10: 65 61 64 65 72 73 2c 20 6e 61 6d 65 29 29 3b 22 eaders, name));" 0b20: 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 6f 75 70 ))..(define soup 0b30: 2d 72 65 71 75 65 73 74 2d 62 6f 64 79 0a 20 20 -request-body. 0b40: 28 66 6f 72 65 69 67 6e 2d 70 72 69 6d 69 74 69 (foreign-primiti 0b50: 76 65 20 73 63 68 65 6d 65 2d 6f 62 6a 65 63 74 ve scheme-object 0b60: 20 28 28 28 6e 6f 6e 6e 75 6c 6c 2d 63 2d 70 6f (((nonnull-c-po 0b70: 69 6e 74 65 72 20 22 53 6f 75 70 4d 65 73 73 61 inter "SoupMessa 0b80: 67 65 22 29 20 6d 65 73 73 61 67 65 29 29 0a 20 ge") message)). 0b90: 20 20 20 22 53 6f 75 70 4d 65 73 73 61 67 65 42 "SoupMessageB 0ba0: 6f 64 79 20 2a 62 6f 64 79 20 3d 20 6d 65 73 73 ody *body = mess 0bb0: 61 67 65 2d 3e 72 65 71 75 65 73 74 5f 62 6f 64 age->request_bod 0bc0: 79 3b 5c 6e 22 0a 20 20 20 20 22 43 5f 77 6f 72 y;\n". "C_wor 0bd0: 64 20 2a 70 6f 6f 6c 20 3d 20 43 5f 61 6c 6c 6f d *pool = C_allo 0be0: 63 28 43 5f 53 49 5a 45 4f 46 5f 53 54 52 49 4e c(C_SIZEOF_STRIN 0bf0: 47 28 62 6f 64 79 2d 3e 6c 65 6e 67 74 68 29 29 G(body->length)) 0c00: 3b 5c 6e 22 0a 20 20 20 20 22 43 5f 72 65 74 75 ;\n". "C_retu 0c10: 72 6e 28 43 5f 73 74 72 69 6e 67 28 26 70 6f 6f rn(C_string(&poo 0c20: 6c 2c 20 62 6f 64 79 2d 3e 6c 65 6e 67 74 68 2c l, body->length, 0c30: 20 28 63 68 61 72 20 2a 29 62 6f 64 79 2d 3e 64 (char *)body->d 0c40: 61 74 61 29 29 3b 5c 6e 22 29 29 0a 0a 28 64 65 ata));\n"))..(de 0c50: 66 69 6e 65 20 73 6f 75 70 2d 72 65 73 70 6f 6e fine soup-respon 0c60: 73 65 2d 68 65 61 64 65 72 2d 61 64 64 21 0a 20 se-header-add!. 0c70: 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 (foreign-lambda 0c80: 2a 20 76 6f 69 64 20 28 28 28 6e 6f 6e 6e 75 6c * void (((nonnul 0c90: 6c 2d 63 2d 70 6f 69 6e 74 65 72 20 22 53 6f 75 l-c-pointer "Sou 0ca0: 70 4d 65 73 73 61 67 65 22 29 20 6d 65 73 73 61 pMessage") messa 0cb0: 67 65 29 0a 09 09 09 20 28 6e 6f 6e 6e 75 6c 6c ge).... (nonnull 0cc0: 2d 63 2d 73 74 72 69 6e 67 20 6e 61 6d 65 29 0a -c-string name). 0cd0: 09 09 09 20 28 63 2d 73 74 72 69 6e 67 20 76 61 ... (c-string va 0ce0: 6c 75 65 29 29 0a 20 20 20 20 22 73 6f 75 70 5f lue)). "soup_ 0cf0: 6d 65 73 73 61 67 65 5f 68 65 61 64 65 72 73 5f message_headers_ 0d00: 61 70 70 65 6e 64 28 6d 65 73 73 61 67 65 2d 3e append(message-> 0d10: 72 65 73 70 6f 6e 73 65 5f 68 65 61 64 65 72 73 response_headers 0d20: 2c 20 6e 61 6d 65 2c 20 76 61 6c 75 65 29 3b 22 , name, value);" 0d30: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 6f 75 ))..(define (sou 0d40: 70 2d 72 65 73 70 6f 6e 73 65 2d 62 6f 64 79 2d p-response-body- 0d50: 61 64 64 21 20 6d 65 73 73 61 67 65 20 64 61 74 add! message dat 0d60: 61 29 0a 20 20 28 28 66 6f 72 65 69 67 6e 2d 6c a). ((foreign-l 0d70: 61 6d 62 64 61 2a 20 76 6f 69 64 20 28 28 28 6e ambda* void (((n 0d80: 6f 6e 6e 75 6c 6c 2d 63 2d 70 6f 69 6e 74 65 72 onnull-c-pointer 0d90: 20 22 53 6f 75 70 4d 65 73 73 61 67 65 22 29 20 "SoupMessage") 0da0: 6d 65 73 73 61 67 65 29 0a 09 09 09 20 20 28 73 message).... (s 0db0: 63 68 65 6d 65 2d 70 6f 69 6e 74 65 72 20 64 61 cheme-pointer da 0dc0: 74 61 29 20 28 75 6e 73 69 67 6e 65 64 2d 69 6e ta) (unsigned-in 0dd0: 74 65 67 65 72 20 6c 65 6e 67 74 68 29 29 0a 20 teger length)). 0de0: 20 20 20 20 22 73 6f 75 70 5f 6d 65 73 73 61 67 "soup_messag 0df0: 65 5f 62 6f 64 79 5f 61 70 70 65 6e 64 28 6d 65 e_body_append(me 0e00: 73 73 61 67 65 2d 3e 72 65 73 70 6f 6e 73 65 5f ssage->response_ 0e10: 62 6f 64 79 2c 20 53 4f 55 50 5f 4d 45 4d 4f 52 body, SOUP_MEMOR 0e20: 59 5f 43 4f 50 59 2c 20 64 61 74 61 2c 20 6c 65 Y_COPY, data, le 0e30: 6e 67 74 68 29 3b 22 29 0a 20 20 20 6d 65 73 73 ngth);"). mess 0e40: 61 67 65 20 64 61 74 61 20 28 73 74 72 69 6e 67 age data (string 0e50: 2d 6c 65 6e 67 74 68 20 64 61 74 61 29 29 29 0a -length data))). 0e60: 0a 28 64 65 66 69 6e 65 20 28 73 6f 75 70 2d 72 .(define (soup-r 0e70: 65 73 70 6f 6e 73 65 2d 73 65 74 21 20 6d 65 73 esponse-set! mes 0e80: 73 61 67 65 20 72 73 70 29 0a 20 20 28 28 66 6f sage rsp). ((fo 0e90: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi 0ea0: 64 20 22 73 6f 75 70 5f 6d 65 73 73 61 67 65 5f d "soup_message_ 0eb0: 73 65 74 5f 73 74 61 74 75 73 5f 66 75 6c 6c 22 set_status_full" 0ec0: 0a 20 20 20 20 28 6e 6f 6e 6e 75 6c 6c 2d 63 2d . (nonnull-c- 0ed0: 70 6f 69 6e 74 65 72 20 22 53 6f 75 70 4d 65 73 pointer "SoupMes 0ee0: 73 61 67 65 22 29 20 75 6e 73 69 67 6e 65 64 2d sage") unsigned- 0ef0: 69 6e 74 65 67 65 72 20 6e 6f 6e 6e 75 6c 6c 2d integer nonnull- 0f00: 63 2d 73 74 72 69 6e 67 29 0a 20 20 20 6d 65 73 c-string). mes 0f10: 73 61 67 65 20 28 72 65 73 70 6f 6e 73 65 2d 73 sage (response-s 0f20: 74 61 74 75 73 20 72 73 70 29 20 28 72 65 73 70 tatus rsp) (resp 0f30: 6f 6e 73 65 2d 73 74 61 74 75 73 2d 6d 65 73 73 onse-status-mess 0f40: 61 67 65 20 72 73 70 29 29 0a 20 20 28 63 6f 6e age rsp)). (con 0f50: 64 0a 20 20 20 28 28 6d 65 73 73 61 67 65 2d 74 d. ((message-t 0f60: 79 70 65 20 72 73 70 29 0a 20 20 20 20 3d 3e 20 ype rsp). => 0f70: 28 63 75 74 20 73 6f 75 70 2d 72 65 73 70 6f 6e (cut soup-respon 0f80: 73 65 2d 68 65 61 64 65 72 2d 61 64 64 21 20 6d se-header-add! m 0f90: 65 73 73 61 67 65 20 22 43 6f 6e 74 65 6e 74 2d essage "Content- 0fa0: 54 79 70 65 22 20 3c 3e 29 29 29 0a 20 20 28 66 Type" <>))). (f 0fb0: 6f 72 2d 65 61 63 68 0a 20 20 20 20 28 6c 61 6d or-each. (lam 0fc0: 62 64 61 20 28 68 65 61 64 65 72 29 0a 20 20 20 bda (header). 0fd0: 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d 76 61 (call-with-va 0fe0: 6c 75 65 73 20 28 63 75 74 20 63 61 72 2b 63 64 lues (cut car+cd 0ff0: 72 20 68 65 61 64 65 72 29 0a 20 20 20 20 20 20 r header). 1000: 20 20 28 63 75 74 20 73 6f 75 70 2d 72 65 73 70 (cut soup-resp 1010: 6f 6e 73 65 2d 68 65 61 64 65 72 2d 61 64 64 21 onse-header-add! 1020: 20 6d 65 73 73 61 67 65 20 3c 3e 20 3c 3e 29 29 message <> <>)) 1030: 29 0a 20 20 20 20 28 6d 65 73 73 61 67 65 2d 68 ). (message-h 1040: 65 61 64 65 72 73 20 72 73 70 29 29 0a 20 20 28 eaders rsp)). ( 1050: 63 6f 6e 64 0a 20 20 20 28 28 6d 65 73 73 61 67 cond. ((messag 1060: 65 2d 62 6f 64 79 20 72 73 70 29 0a 20 20 20 20 e-body rsp). 1070: 3d 3e 20 28 63 75 74 20 73 6f 75 70 2d 72 65 73 => (cut soup-res 1080: 70 6f 6e 73 65 2d 62 6f 64 79 2d 61 64 64 21 20 ponse-body-add! 1090: 6d 65 73 73 61 67 65 20 3c 3e 29 29 29 29 0a 0a message <>)))).. 10a0: 3b 3b 20 73 6f 75 70 20 73 65 72 76 65 72 20 6c ;; soup server l 10b0: 6f 6f 70 0a 0a 28 64 65 66 69 6e 65 20 28 73 6f oop..(define (so 10c0: 75 70 2d 6d 61 69 6e 2d 6c 6f 6f 70 20 68 61 6e up-main-loop han 10d0: 64 6c 65 2d 72 65 71 75 65 73 74 20 70 6f 72 74 dle-request port 10e0: 29 0a 20 20 28 6c 65 74 20 28 28 73 65 72 76 65 ). (let ((serve 10f0: 72 20 28 73 6f 75 70 2d 73 65 72 76 65 72 2d 6e r (soup-server-n 1100: 65 77 20 70 6f 72 74 29 29 29 0a 20 20 20 20 28 ew port))). ( 1110: 73 6f 75 70 2d 73 65 72 76 65 72 2d 61 64 64 2d soup-server-add- 1120: 68 61 6e 64 6c 65 72 0a 20 20 20 20 20 73 65 72 handler. ser 1130: 76 65 72 20 23 66 0a 20 20 20 20 20 28 6c 61 6d ver #f. (lam 1140: 62 64 61 20 28 73 65 72 76 65 72 20 6d 65 73 73 bda (server mess 1150: 61 67 65 20 70 61 74 68 29 0a 20 20 20 20 20 20 age path). 1160: 20 28 68 61 6e 64 6c 65 2d 72 65 71 75 65 73 74 (handle-request 1170: 0a 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 . (lambda 1180: 20 28 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 (name). 1190: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond. 11a0: 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 6e 61 ((string=? na 11b0: 6d 65 20 22 52 45 51 55 45 53 54 5f 4d 45 54 48 me "REQUEST_METH 11c0: 4f 44 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 OD"). 11d0: 20 28 73 6f 75 70 2d 6d 65 73 73 61 67 65 2d 6d (soup-message-m 11e0: 65 74 68 6f 64 20 6d 65 73 73 61 67 65 29 29 0a ethod message)). 11f0: 20 20 20 20 20 20 20 20 20 20 20 28 28 73 74 72 ((str 1200: 69 6e 67 3d 3f 20 6e 61 6d 65 20 22 50 41 54 48 ing=? name "PATH 1210: 5f 49 4e 46 4f 22 29 0a 20 20 20 20 20 20 20 20 _INFO"). 1220: 20 20 20 20 70 61 74 68 29 0a 20 20 20 20 20 20 path). 1230: 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 ((string=? 1240: 6e 61 6d 65 20 22 51 55 45 52 59 5f 53 54 52 49 name "QUERY_STRI 1250: 4e 47 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 NG"). 1260: 20 28 73 6f 75 70 2d 6d 65 73 73 61 67 65 2d 71 (soup-message-q 1270: 75 65 72 79 20 6d 65 73 73 61 67 65 29 29 0a 20 uery message)). 1280: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else. 1290: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 6f 75 (sou 12a0: 70 2d 72 65 71 75 65 73 74 2d 68 65 61 64 65 72 p-request-header 12b0: 2d 72 65 66 20 6d 65 73 73 61 67 65 20 28 73 74 -ref message (st 12c0: 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 6e ring-translate n 12d0: 61 6d 65 20 23 5c 5f 20 23 5c 2d 29 29 29 29 29 ame #\_ #\-))))) 12e0: 0a 20 20 20 20 20 20 20 20 28 6f 70 65 6e 2d 69 . (open-i 12f0: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 73 6f 75 nput-string (sou 1300: 70 2d 72 65 71 75 65 73 74 2d 62 6f 64 79 20 6d p-request-body m 1310: 65 73 73 61 67 65 29 29 0a 20 20 20 20 20 20 20 essage)). 1320: 20 28 63 75 74 20 73 6f 75 70 2d 72 65 73 70 6f (cut soup-respo 1330: 6e 73 65 2d 73 65 74 21 20 6d 65 73 73 61 67 65 nse-set! message 1340: 20 3c 3e 29 29 29 29 0a 20 20 20 20 28 73 6f 75 <>)))). (sou 1350: 70 2d 73 65 72 76 65 72 2d 72 75 6e 20 73 65 72 p-server-run ser 1360: 76 65 72 29 29 29 0a ver))).