Artifact
be09dda683b979fd812c29b293fb372ae539d507:
- File
socket.sls
— part of check-in
[cd7a31d87b]
at
2017-05-03 18:01:41
on branch trunk
— many fixes to usb.sls
(user:
aldo
size: 7576)
0000: 3b 3b 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 ;;.;; Copyright
0010: 32 30 31 36 20 41 6c 64 6f 20 4e 69 63 6f 6c 61 2016 Aldo Nicola
0020: 73 20 42 72 75 6e 6f 0a 3b 3b 0a 3b 3b 20 4c 69 s Bruno.;;.;; Li
0030: 63 65 6e 73 65 64 20 75 6e 64 65 72 20 74 68 65 censed under the
0040: 20 41 70 61 63 68 65 20 4c 69 63 65 6e 73 65 2c Apache License,
0050: 20 56 65 72 73 69 6f 6e 20 32 2e 30 20 28 74 68 Version 2.0 (th
0060: 65 20 22 4c 69 63 65 6e 73 65 22 29 3b 0a 3b 3b e "License");.;;
0070: 20 79 6f 75 20 6d 61 79 20 6e 6f 74 20 75 73 65 you may not use
0080: 20 74 68 69 73 20 66 69 6c 65 20 65 78 63 65 70 this file excep
0090: 74 20 69 6e 20 63 6f 6d 70 6c 69 61 6e 63 65 20 t in compliance
00a0: 77 69 74 68 20 74 68 65 20 4c 69 63 65 6e 73 65 with the License
00b0: 2e 0a 3b 3b 20 59 6f 75 20 6d 61 79 20 6f 62 74 ..;; You may obt
00c0: 61 69 6e 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ain a copy of th
00d0: 65 20 4c 69 63 65 6e 73 65 20 61 74 0a 3b 3b 0a e License at.;;.
00e0: 3b 3b 20 20 20 20 20 68 74 74 70 3a 2f 2f 77 77 ;; http://ww
00f0: 77 2e 61 70 61 63 68 65 2e 6f 72 67 2f 6c 69 63 w.apache.org/lic
0100: 65 6e 73 65 73 2f 4c 49 43 45 4e 53 45 2d 32 2e enses/LICENSE-2.
0110: 30 0a 3b 3b 0a 3b 3b 20 55 6e 6c 65 73 73 20 72 0.;;.;; Unless r
0120: 65 71 75 69 72 65 64 20 62 79 20 61 70 70 6c 69 equired by appli
0130: 63 61 62 6c 65 20 6c 61 77 20 6f 72 20 61 67 72 cable law or agr
0140: 65 65 64 20 74 6f 20 69 6e 20 77 72 69 74 69 6e eed to in writin
0150: 67 2c 20 73 6f 66 74 77 61 72 65 0a 3b 3b 20 64 g, software.;; d
0160: 69 73 74 72 69 62 75 74 65 64 20 75 6e 64 65 72 istributed under
0170: 20 74 68 65 20 4c 69 63 65 6e 73 65 20 69 73 20 the License is
0180: 64 69 73 74 72 69 62 75 74 65 64 20 6f 6e 20 61 distributed on a
0190: 6e 20 22 41 53 20 49 53 22 20 42 41 53 49 53 2c n "AS IS" BASIS,
01a0: 0a 3b 3b 20 57 49 54 48 4f 55 54 20 57 41 52 52 .;; WITHOUT WARR
01b0: 41 4e 54 49 45 53 20 4f 52 20 43 4f 4e 44 49 54 ANTIES OR CONDIT
01c0: 49 4f 4e 53 20 4f 46 20 41 4e 59 20 4b 49 4e 44 IONS OF ANY KIND
01d0: 2c 20 65 69 74 68 65 72 20 65 78 70 72 65 73 73 , either express
01e0: 20 6f 72 20 69 6d 70 6c 69 65 64 2e 0a 3b 3b 20 or implied..;;
01f0: 53 65 65 20 74 68 65 20 4c 69 63 65 6e 73 65 20 See the License
0200: 66 6f 72 20 74 68 65 20 73 70 65 63 69 66 69 63 for the specific
0210: 20 6c 61 6e 67 75 61 67 65 20 67 6f 76 65 72 6e language govern
0220: 69 6e 67 20 70 65 72 6d 69 73 73 69 6f 6e 73 20 ing permissions
0230: 61 6e 64 0a 3b 3b 20 6c 69 6d 69 74 61 74 69 6f and.;; limitatio
0240: 6e 73 20 75 6e 64 65 72 20 74 68 65 20 4c 69 63 ns under the Lic
0250: 65 6e 73 65 2e 0a 0a 28 6c 69 62 72 61 72 79 20 ense...(library
0260: 28 73 6f 63 6b 65 74 29 0a 20 20 28 65 78 70 6f (socket). (expo
0270: 72 74 20 66 69 6c 65 2d 77 72 69 74 65 20 66 69 rt file-write fi
0280: 6c 65 2d 72 65 61 64 20 62 79 74 65 73 2d 72 65 le-read bytes-re
0290: 61 64 79 20 73 6f 63 6b 65 74 20 63 6c 6f 73 65 ady socket close
02a0: 0a 09 20 20 73 6f 63 6b 65 74 2d 64 6f 6d 61 69 .. socket-domai
02b0: 6e 20 73 6f 63 6b 65 74 2d 74 79 70 65 2d 66 6c n socket-type-fl
02c0: 61 67 20 73 6f 63 6b 65 74 2d 74 79 70 65 20 67 ag socket-type g
02d0: 65 74 68 6f 73 74 62 79 6e 61 6d 65 0a 09 20 20 ethostbyname..
02e0: 63 6f 6e 6e 65 63 74 2f 69 6e 65 74 20 62 69 6e connect/inet bin
02f0: 64 2f 69 6e 65 74 20 6c 69 73 74 65 6e 20 61 63 d/inet listen ac
0300: 63 65 70 74 29 0a 20 20 0a 20 20 28 69 6d 70 6f cept). . (impo
0310: 72 74 20 28 65 78 63 65 70 74 20 28 63 68 65 7a rt (except (chez
0320: 73 63 68 65 6d 65 29 20 62 79 74 65 76 65 63 74 scheme) bytevect
0330: 6f 72 2d 63 6f 70 79 29 0a 09 20 20 28 70 6f 73 or-copy).. (pos
0340: 69 78 29 0a 09 20 20 28 6f 6e 6c 79 20 28 70 6f ix).. (only (po
0350: 73 69 78 20 65 72 72 6e 6f 29 20 45 41 47 41 49 six errno) EAGAI
0360: 4e 20 45 49 4e 54 52 29 0a 09 20 20 28 66 66 69 N EINTR).. (ffi
0370: 2d 75 74 69 6c 73 29 29 0a 0a 20 20 28 6d 65 74 -utils)).. (met
0380: 61 2d 63 6f 6e 64 0a 20 20 20 5b 28 6d 65 6d 71 a-cond. [(memq
0390: 20 28 6d 61 63 68 69 6e 65 2d 74 79 70 65 29 20 (machine-type)
03a0: 27 28 61 36 6c 65 20 74 61 36 6c 65 29 29 0a 20 '(a6le ta6le)).
03b0: 20 20 20 0a 20 20 20 20 28 64 65 66 69 6e 65 2d . (define-
03c0: 65 6e 75 6d 65 72 61 74 69 6f 6e 2a 20 73 6f 63 enumeration* soc
03d0: 6b 65 74 2d 64 6f 6d 61 69 6e 0a 20 20 20 20 20 ket-domain.
03e0: 20 28 75 6e 73 70 65 63 20 6c 6f 63 61 6c 20 69 (unspec local i
03f0: 6e 65 74 20 61 78 32 35 20 69 70 78 20 61 70 70 net ax25 ipx app
0400: 6c 65 74 61 6c 6b 0a 09 20 20 20 20 20 20 6e 65 letalk.. ne
0410: 74 72 6f 6d 20 62 72 69 64 67 65 20 61 74 6d 70 trom bridge atmp
0420: 76 63 20 78 32 35 20 69 6e 65 74 36 20 72 6f 73 vc x25 inet6 ros
0430: 65 20 64 65 63 6e 65 74 20 6e 65 74 62 65 75 69 e decnet netbeui
0440: 20 73 65 63 75 72 69 74 79 20 6b 65 79 0a 09 20 security key..
0450: 20 20 20 20 20 6e 65 74 6c 69 6e 6b 20 70 61 63 netlink pac
0460: 6b 65 74 20 61 73 68 20 65 63 6f 6e 65 74 20 61 ket ash econet a
0470: 74 6d 73 76 63 20 72 64 73 20 73 6e 61 20 69 72 tmsvc rds sna ir
0480: 64 61 20 70 70 6f 78 20 77 61 6e 70 69 70 65 20 da ppox wanpipe
0490: 6c 6c 63 20 69 62 20 6d 70 6c 73 0a 09 20 20 20 llc ib mpls..
04a0: 20 20 20 63 61 6e 20 74 69 70 63 20 62 6c 75 65 can tipc blue
04b0: 74 6f 6f 74 68 20 69 75 63 76 20 72 78 72 70 63 tooth iucv rxrpc
04c0: 20 69 73 64 6e 20 70 68 6f 6e 65 74 20 69 65 65 isdn phonet iee
04d0: 65 38 30 32 31 35 34 20 63 61 69 66 20 61 6c 67 e802154 caif alg
04e0: 20 6e 66 63 0a 09 20 20 20 20 20 20 76 73 6f 63 nfc.. vsoc
04f0: 6b 20 6b 63 6d 29 29 0a 0a 20 20 20 20 28 64 65 k kcm)).. (de
0500: 66 69 6e 65 2d 65 6e 75 6d 65 72 61 74 69 6f 6e fine-enumeration
0510: 2a 20 73 6f 63 6b 65 74 2d 74 79 70 65 20 28 75 * socket-type (u
0520: 6e 73 70 65 63 20 73 74 72 65 61 6d 20 64 67 72 nspec stream dgr
0530: 61 6d 20 72 61 77 20 73 65 71 70 61 63 6b 65 74 am raw seqpacket
0540: 20 64 63 63 70 29 29 0a 20 20 20 20 28 64 65 66 dccp)). (def
0550: 69 6e 65 2d 66 6c 61 67 73 20 73 6f 63 6b 65 74 ine-flags socket
0560: 2d 74 79 70 65 2d 66 6c 61 67 0a 20 20 20 20 20 -type-flag.
0570: 20 28 63 6c 6f 73 65 2d 6f 6e 2d 65 78 65 63 20 (close-on-exec
0580: 23 6f 30 32 30 30 30 30 30 30 29 0a 20 20 20 20 #o02000000).
0590: 20 20 28 6e 6f 6e 2d 62 6c 6f 63 6b 20 23 6f 30 (non-block #o0
05a0: 30 30 30 34 30 30 30 29 29 0a 20 20 20 20 0a 20 0004000)). .
05b0: 20 20 20 28 64 65 66 69 6e 65 2d 66 74 79 70 65 (define-ftype
05c0: 20 68 6f 73 74 65 6e 74 0a 20 20 20 20 20 20 28 hostent. (
05d0: 73 74 72 75 63 74 0a 20 20 20 20 20 20 20 28 68 struct. (h
05e0: 5f 6e 61 6d 65 20 28 2a 20 63 68 61 72 29 29 0a _name (* char)).
05f0: 20 20 20 20 20 20 20 28 68 5f 61 6c 69 61 73 65 (h_aliase
0600: 73 20 76 6f 69 64 2a 29 0a 20 20 20 20 20 20 20 s void*).
0610: 28 68 5f 61 64 64 72 74 79 70 65 20 69 6e 74 29 (h_addrtype int)
0620: 0a 20 20 20 20 20 20 20 28 68 5f 6c 65 6e 67 74 . (h_lengt
0630: 68 20 69 6e 74 29 0a 20 20 20 20 20 20 20 28 68 h int). (h
0640: 5f 61 64 64 72 5f 6c 69 73 74 20 76 6f 69 64 2a _addr_list void*
0650: 29 29 29 0a 20 20 20 20 0a 20 20 20 20 28 64 65 ))). . (de
0660: 66 69 6e 65 2d 66 74 79 70 65 20 73 61 5f 66 61 fine-ftype sa_fa
0670: 6d 69 6c 79 5f 74 20 75 6e 73 69 67 6e 65 64 2d mily_t unsigned-
0680: 73 68 6f 72 74 29 0a 20 20 20 20 28 64 65 66 69 short). (defi
0690: 6e 65 2d 66 74 79 70 65 20 69 6e 5f 70 6f 72 74 ne-ftype in_port
06a0: 5f 74 20 75 6e 73 69 67 6e 65 64 2d 31 36 29 0a _t unsigned-16).
06b0: 20 20 20 20 0a 20 20 20 20 28 64 65 66 69 6e 65 . (define
06c0: 2d 66 74 79 70 65 20 73 6f 63 6b 6c 65 6e 5f 74 -ftype socklen_t
06d0: 20 75 6e 73 69 67 6e 65 64 2d 69 6e 74 29 0a 20 unsigned-int).
06e0: 20 20 20 28 64 65 66 69 6e 65 2d 66 74 79 70 65 (define-ftype
06f0: 20 73 6f 63 6b 61 64 64 72 5f 75 6e 0a 20 20 20 sockaddr_un.
0700: 20 20 20 28 73 74 72 75 63 74 20 28 73 75 6e 5f (struct (sun_
0710: 66 61 6d 69 6c 79 20 73 61 5f 66 61 6d 69 6c 79 family sa_family
0720: 5f 74 29 0a 09 20 20 20 20 20 20 28 73 75 6e 5f _t).. (sun_
0730: 64 61 74 61 20 28 61 72 72 61 79 20 31 30 38 20 data (array 108
0740: 63 68 61 72 29 29 29 29 0a 20 20 20 20 0a 20 20 char)))). .
0750: 20 20 28 64 65 66 69 6e 65 2d 66 74 79 70 65 20 (define-ftype
0760: 69 6e 5f 61 64 64 72 5f 74 20 75 6e 73 69 67 6e in_addr_t unsign
0770: 65 64 2d 33 32 29 0a 20 20 20 20 28 64 65 66 69 ed-32). (defi
0780: 6e 65 2d 66 74 79 70 65 20 69 6e 5f 61 64 64 72 ne-ftype in_addr
0790: 0a 20 20 20 20 20 20 28 73 74 72 75 63 74 20 28 . (struct (
07a0: 73 5f 61 64 64 72 20 69 6e 5f 61 64 64 72 5f 74 s_addr in_addr_t
07b0: 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 ))). . ;;
07c0: 57 41 52 4e 49 4e 47 2d 20 68 65 72 65 20 74 68 WARNING- here th
07d0: 65 20 73 69 7a 65 20 6f 66 20 73 69 6e 5f 7a 65 e size of sin_ze
07e0: 72 6f 20 73 68 6f 75 6c 64 20 62 65 20 63 61 6c ro should be cal
07f0: 63 75 6c 61 74 65 64 20 6f 6e 20 79 6f 75 72 20 culated on your
0800: 6d 61 63 68 69 6e 65 20 61 73 3a 0a 20 20 20 20 machine as:.
0810: 0a 20 20 20 20 23 3b 28 69 6d 70 6f 72 74 20 28 . #;(import (
0820: 63 2d 65 76 61 6c 29 29 0a 20 20 20 20 23 3b 28 c-eval)). #;(
0830: 70 61 72 61 6d 65 74 65 72 69 7a 65 20 28 5b 63 parameterize ([c
0840: 2d 65 76 61 6c 2d 69 6e 63 6c 75 64 65 73 20 27 -eval-includes '
0850: 28 22 73 74 64 69 6f 2e 68 22 20 22 73 79 73 2f ("stdio.h" "sys/
0860: 73 6f 63 6b 65 74 2e 68 22 20 22 6e 65 74 69 6e socket.h" "netin
0870: 65 74 2f 69 6e 2e 68 22 29 5d 29 0a 20 20 20 20 et/in.h")]).
0880: 28 63 2d 65 76 61 6c 2d 70 72 69 6e 74 66 20 22 (c-eval-printf "
0890: 25 64 22 20 22 73 69 7a 65 6f 66 28 28 28 73 74 %d" "sizeof(((st
08a0: 72 75 63 74 20 73 6f 63 6b 61 64 64 72 5f 69 6e ruct sockaddr_in
08b0: 20 2a 29 20 4e 55 4c 4c 29 2d 3e 73 69 6e 5f 7a *) NULL)->sin_z
08c0: 65 72 6f 29 22 29 29 0a 20 20 20 20 3b 3b 20 69 ero)")). ;; i
08d0: 6e 20 6d 79 20 63 61 73 65 20 20 28 61 36 6c 65 n my case (a6le
08e0: 29 20 2d 3e 20 38 0a 20 20 20 20 0a 20 20 20 20 ) -> 8. .
08f0: 28 64 65 66 69 6e 65 2d 66 74 79 70 65 20 73 6f (define-ftype so
0900: 63 6b 61 64 64 72 5f 69 6e 0a 20 20 20 20 20 20 ckaddr_in.
0910: 28 73 74 72 75 63 74 0a 20 20 20 20 20 20 20 28 (struct. (
0920: 73 69 6e 5f 66 61 6d 69 6c 79 20 73 61 5f 66 61 sin_family sa_fa
0930: 6d 69 6c 79 5f 74 29 0a 20 20 20 20 20 20 20 28 mily_t). (
0940: 73 69 6e 5f 70 6f 72 74 20 69 6e 5f 70 6f 72 74 sin_port in_port
0950: 5f 74 29 0a 20 20 20 20 20 20 20 28 73 69 6e 5f _t). (sin_
0960: 61 64 64 72 20 69 6e 5f 61 64 64 72 29 0a 20 20 addr in_addr).
0970: 20 20 20 20 20 28 73 69 6e 5f 7a 65 72 6f 20 28 (sin_zero (
0980: 61 72 72 61 79 20 38 20 75 6e 73 69 67 6e 65 64 array 8 unsigned
0990: 2d 38 29 29 29 29 0a 20 20 0a 20 20 20 20 28 64 -8)))). . (d
09a0: 65 66 69 6e 65 20 49 4e 41 44 44 52 5f 41 4e 59 efine INADDR_ANY
09b0: 20 30 29 0a 20 20 20 20 5d 0a 20 20 20 5b 65 6c 0). ]. [el
09c0: 73 65 0a 20 20 20 20 28 65 72 72 6f 72 20 27 73 se. (error 's
09d0: 6f 63 6b 65 74 2e 73 6c 73 20 22 75 6e 73 75 70 ocket.sls "unsup
09e0: 70 6f 72 74 65 64 20 6d 61 63 68 69 6e 65 2d 74 ported machine-t
09f0: 79 70 65 20 7e 61 22 20 28 6d 61 63 68 69 6e 65 ype ~a" (machine
0a00: 2d 74 79 70 65 29 29 5d 29 0a 0a 20 20 28 64 65 -type))]).. (de
0a10: 66 69 6e 65 20 28 73 6f 63 6b 65 74 20 64 6f 6d fine (socket dom
0a20: 61 69 6e 20 74 79 70 65 20 74 79 70 65 2d 66 6c ain type type-fl
0a30: 61 67 73 20 70 72 6f 74 6f 63 6f 6c 29 20 20 0a ags protocol) .
0a40: 20 20 20 20 28 64 65 66 69 6e 65 20 73 6f 63 6b (define sock
0a50: 65 74 2a 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f et* (foreign-pro
0a60: 63 65 64 75 72 65 20 22 73 6f 63 6b 65 74 22 20 cedure "socket"
0a70: 28 69 6e 74 20 69 6e 74 20 69 6e 74 29 20 69 6e (int int int) in
0a80: 74 29 29 0a 20 20 20 20 28 6c 65 74 20 28 5b 72 t)). (let ([r
0a90: 20 28 73 6f 63 6b 65 74 2a 20 28 73 6f 63 6b 65 (socket* (socke
0aa0: 74 2d 64 6f 6d 61 69 6e 20 64 6f 6d 61 69 6e 29 t-domain domain)
0ab0: 0a 09 09 20 20 20 20 20 20 28 6c 6f 67 69 6f 72 ... (logior
0ac0: 20 28 73 6f 63 6b 65 74 2d 74 79 70 65 20 74 79 (socket-type ty
0ad0: 70 65 29 0a 09 09 09 20 20 20 20 20 20 28 61 70 pe).... (ap
0ae0: 70 6c 79 20 73 6f 63 6b 65 74 2d 74 79 70 65 2d ply socket-type-
0af0: 66 6c 61 67 20 74 79 70 65 2d 66 6c 61 67 73 29 flag type-flags)
0b00: 29 0a 09 09 20 20 20 20 20 20 70 72 6f 74 6f 63 )... protoc
0b10: 6f 6c 29 5d 29 0a 09 20 20 28 77 68 65 6e 20 28 ol)]).. (when (
0b20: 3c 20 72 20 30 29 0a 09 09 28 65 72 72 6f 72 66 < r 0)...(errorf
0b30: 20 27 73 6f 63 6b 65 74 20 22 66 61 69 6c 65 64 'socket "failed
0b40: 3a 20 7e 61 22 20 28 73 74 72 65 72 72 6f 72 29 : ~a" (strerror)
0b50: 29 29 0a 09 20 20 28 6f 70 65 6e 2d 66 64 2d 69 )).. (open-fd-i
0b60: 6e 70 75 74 2f 6f 75 74 70 75 74 2d 70 6f 72 74 nput/output-port
0b70: 20 72 29 29 29 0a 0a 20 20 3b 3b 20 4d 4d 4d 2e r))).. ;; MMM.
0b80: 2e 2e 20 4c 49 4e 55 58 20 4d 41 4e 20 50 41 47 .. LINUX MAN PAG
0b90: 45 53 20 53 41 59 53 20 54 48 49 53 20 49 53 20 ES SAYS THIS IS
0ba0: 44 45 50 52 45 43 41 54 45 44 2e 2e 2e 0a 20 20 DEPRECATED....
0bb0: 28 64 65 66 69 6e 65 20 28 67 65 74 68 6f 73 74 (define (gethost
0bc0: 62 79 6e 61 6d 65 20 6e 61 6d 65 29 0a 20 20 20 byname name).
0bd0: 20 28 64 65 66 69 6e 65 20 67 68 62 6e 2a 20 28 (define ghbn* (
0be0: 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 foreign-procedur
0bf0: 65 20 22 67 65 74 68 6f 73 74 62 79 6e 61 6d 65 e "gethostbyname
0c00: 22 20 28 73 74 72 69 6e 67 29 20 76 6f 69 64 2a " (string) void*
0c10: 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 68 )). (define h
0c20: 73 74 72 65 72 72 6f 72 2a 20 28 66 6f 72 65 69 strerror* (forei
0c30: 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 68 73 gn-procedure "hs
0c40: 74 72 65 72 72 6f 72 22 20 28 69 6e 74 29 20 73 trerror" (int) s
0c50: 74 72 69 6e 67 29 29 0a 20 20 20 20 28 64 65 66 tring)). (def
0c60: 69 6e 65 20 28 68 2d 65 72 72 6e 6f 29 0a 20 20 ine (h-errno).
0c70: 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 72 65 66 (foreign-ref
0c80: 20 27 69 6e 74 20 28 66 6f 72 65 69 67 6e 2d 65 'int (foreign-e
0c90: 6e 74 72 79 20 22 5f 5f 68 5f 65 72 72 6e 6f 22 ntry "__h_errno"
0ca0: 29 20 30 29 29 0a 20 20 20 20 0a 20 20 20 20 28 ) 0)). . (
0cb0: 6c 65 74 20 28 5b 72 20 28 67 68 62 6e 2a 20 6e let ([r (ghbn* n
0cc0: 61 6d 65 29 5d 29 0a 20 20 20 20 20 20 28 77 68 ame)]). (wh
0cd0: 65 6e 20 28 7a 65 72 6f 3f 20 72 29 0a 09 20 20 en (zero? r)..
0ce0: 20 20 28 65 72 72 6f 72 66 20 27 67 65 74 68 6f (errorf 'getho
0cf0: 73 74 62 79 6e 61 6d 65 20 22 66 61 69 6c 65 64 stbyname "failed
0d00: 3a 20 7e 61 22 20 28 68 73 74 72 65 72 72 6f 72 : ~a" (hstrerror
0d10: 2a 20 28 68 2d 65 72 72 6e 6f 29 29 29 29 0a 20 * (h-errno)))).
0d20: 20 20 20 20 20 28 6d 61 6b 65 2d 66 74 79 70 65 (make-ftype
0d30: 2d 70 6f 69 6e 74 65 72 20 68 6f 73 74 65 6e 74 -pointer hostent
0d40: 20 72 29 29 29 0a 20 20 20 20 20 0a 20 20 28 64 r))). . (d
0d50: 65 66 69 6e 65 20 28 68 74 6f 6e 73 20 6e 29 0a efine (htons n).
0d60: 20 20 20 20 28 64 65 66 69 6e 65 20 68 74 6f 6e (define hton
0d70: 73 2a 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 s* (foreign-proc
0d80: 65 64 75 72 65 20 22 68 74 6f 6e 73 22 20 28 75 edure "htons" (u
0d90: 6e 73 69 67 6e 65 64 2d 31 36 29 20 75 6e 73 69 nsigned-16) unsi
0da0: 67 6e 65 64 2d 31 36 29 29 0a 20 20 20 20 28 68 gned-16)). (h
0db0: 74 6f 6e 73 2a 20 6e 29 29 0a 20 20 0a 20 20 28 tons* n)). . (
0dc0: 64 65 66 69 6e 65 20 28 6d 65 6d 73 65 74 20 64 define (memset d
0dd0: 65 73 74 20 76 61 6c 20 6e 29 0a 20 20 20 20 28 est val n). (
0de0: 64 65 66 69 6e 65 20 6d 65 6d 73 65 74 2a 20 28 define memset* (
0df0: 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 foreign-procedur
0e00: 65 20 22 6d 65 6d 73 65 74 22 20 28 76 6f 69 64 e "memset" (void
0e10: 2a 20 69 6e 74 20 73 69 7a 65 5f 74 29 20 76 6f * int size_t) vo
0e20: 69 64 2a 29 29 0a 20 20 20 20 28 6d 65 6d 73 65 id*)). (memse
0e30: 74 2a 20 64 65 73 74 20 76 61 6c 20 6e 29 0a 20 t* dest val n).
0e40: 20 20 20 28 76 6f 69 64 29 29 0a 20 20 0a 20 20 (void)). .
0e50: 28 64 65 66 69 6e 65 20 28 6d 65 6d 63 70 79 20 (define (memcpy
0e60: 64 65 73 74 20 73 72 63 20 6e 29 0a 20 20 20 20 dest src n).
0e70: 28 64 65 66 69 6e 65 20 6d 65 6d 63 70 79 2a 20 (define memcpy*
0e80: 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 (foreign-procedu
0e90: 72 65 20 22 6d 65 6d 63 70 79 22 20 28 76 6f 69 re "memcpy" (voi
0ea0: 64 2a 20 76 6f 69 64 2a 20 73 69 7a 65 5f 74 29 d* void* size_t)
0eb0: 20 76 6f 69 64 2a 29 29 0a 20 20 20 20 28 6d 65 void*)). (me
0ec0: 6d 63 70 79 2a 20 64 65 73 74 20 73 72 63 20 6e mcpy* dest src n
0ed0: 29 0a 20 20 20 20 28 76 6f 69 64 29 29 0a 20 20 ). (void)).
0ee0: 20 20 0a 20 20 28 64 65 66 69 6e 65 20 28 63 6f . (define (co
0ef0: 6e 6e 65 63 74 2f 69 6e 65 74 20 73 6f 63 6b 65 nnect/inet socke
0f00: 74 20 61 64 64 72 65 73 73 20 70 6f 72 74 29 0a t address port).
0f10: 20 20 20 20 28 64 65 66 69 6e 65 20 63 6f 6e 6e (define conn
0f20: 65 63 74 2a 20 28 66 6f 72 65 69 67 6e 2d 70 72 ect* (foreign-pr
0f30: 6f 63 65 64 75 72 65 20 22 63 6f 6e 6e 65 63 74 ocedure "connect
0f40: 22 20 28 69 6e 74 20 28 2a 20 73 6f 63 6b 61 64 " (int (* sockad
0f50: 64 72 5f 69 6e 29 20 73 6f 63 6b 6c 65 6e 5f 74 dr_in) socklen_t
0f60: 29 20 69 6e 74 29 29 0a 20 20 20 20 28 64 65 66 ) int)). (def
0f70: 69 6e 65 20 73 65 72 76 65 72 20 28 67 65 74 68 ine server (geth
0f80: 6f 73 74 62 79 6e 61 6d 65 20 61 64 64 72 65 73 ostbyname addres
0f90: 73 29 29 0a 20 20 20 20 28 6c 65 74 20 28 5b 61 s)). (let ([a
0fa0: 64 64 72 20 28 6d 61 6b 65 2d 66 74 79 70 65 2d ddr (make-ftype-
0fb0: 70 6f 69 6e 74 65 72 20 73 6f 63 6b 61 64 64 72 pointer sockaddr
0fc0: 5f 69 6e 0a 09 09 09 09 20 20 20 20 28 66 6f 72 _in..... (for
0fd0: 65 69 67 6e 2d 61 6c 6c 6f 63 20 28 66 74 79 70 eign-alloc (ftyp
0fe0: 65 2d 73 69 7a 65 6f 66 20 73 6f 63 6b 61 64 64 e-sizeof sockadd
0ff0: 72 5f 69 6e 29 29 29 5d 29 0a 20 20 20 20 20 20 r_in)))]).
1000: 28 6d 65 6d 73 65 74 20 28 66 74 79 70 65 2d 70 (memset (ftype-p
1010: 6f 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 61 ointer-address a
1020: 64 64 72 29 20 30 20 28 66 74 79 70 65 2d 73 69 ddr) 0 (ftype-si
1030: 7a 65 6f 66 20 73 6f 63 6b 61 64 64 72 5f 69 6e zeof sockaddr_in
1040: 29 29 0a 20 20 20 20 20 20 28 66 74 79 70 65 2d )). (ftype-
1050: 73 65 74 21 20 73 6f 63 6b 61 64 64 72 5f 69 6e set! sockaddr_in
1060: 20 28 73 69 6e 5f 66 61 6d 69 6c 79 29 20 61 64 (sin_family) ad
1070: 64 72 20 28 73 6f 63 6b 65 74 2d 64 6f 6d 61 69 dr (socket-domai
1080: 6e 20 27 69 6e 65 74 29 29 0a 20 20 20 20 20 20 n 'inet)).
1090: 28 6d 65 6d 63 70 79 20 28 66 74 79 70 65 2d 70 (memcpy (ftype-p
10a0: 6f 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 28 ointer-address (
10b0: 66 74 79 70 65 2d 26 72 65 66 20 73 6f 63 6b 61 ftype-&ref socka
10c0: 64 64 72 5f 69 6e 20 28 73 69 6e 5f 61 64 64 72 ddr_in (sin_addr
10d0: 29 20 61 64 64 72 29 29 0a 09 20 20 20 20 20 20 ) addr))..
10e0: 28 66 6f 72 65 69 67 6e 2d 72 65 66 20 27 76 6f (foreign-ref 'vo
10f0: 69 64 2a 20 28 66 74 79 70 65 2d 72 65 66 20 68 id* (ftype-ref h
1100: 6f 73 74 65 6e 74 20 28 68 5f 61 64 64 72 5f 6c ostent (h_addr_l
1110: 69 73 74 29 20 73 65 72 76 65 72 29 20 30 29 0a ist) server) 0).
1120: 09 20 20 20 20 20 20 28 66 74 79 70 65 2d 72 65 . (ftype-re
1130: 66 20 68 6f 73 74 65 6e 74 20 28 68 5f 6c 65 6e f hostent (h_len
1140: 67 74 68 29 20 73 65 72 76 65 72 29 29 0a 20 20 gth) server)).
1150: 20 20 20 20 28 66 74 79 70 65 2d 73 65 74 21 20 (ftype-set!
1160: 73 6f 63 6b 61 64 64 72 5f 69 6e 20 28 73 69 6e sockaddr_in (sin
1170: 5f 70 6f 72 74 29 20 61 64 64 72 20 28 68 74 6f _port) addr (hto
1180: 6e 73 20 70 6f 72 74 29 29 0a 20 20 20 20 20 20 ns port)).
1190: 28 6c 65 74 20 28 5b 72 20 28 63 6f 6e 6e 65 63 (let ([r (connec
11a0: 74 2a 20 28 70 6f 72 74 2d 66 69 6c 65 2d 64 65 t* (port-file-de
11b0: 73 63 72 69 70 74 6f 72 20 73 6f 63 6b 65 74 29 scriptor socket)
11c0: 0a 09 09 09 20 61 64 64 72 20 28 66 74 79 70 65 .... addr (ftype
11d0: 2d 73 69 7a 65 6f 66 20 73 6f 63 6b 61 64 64 72 -sizeof sockaddr
11e0: 5f 69 6e 29 29 5d 29 0a 09 28 66 6f 72 65 69 67 _in))])..(foreig
11f0: 6e 2d 66 72 65 65 20 28 66 74 79 70 65 2d 70 6f n-free (ftype-po
1200: 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 61 64 inter-address ad
1210: 64 72 29 29 0a 09 28 77 68 65 6e 20 28 3c 20 72 dr))..(when (< r
1220: 20 30 29 0a 09 20 20 20 20 28 69 66 20 28 3d 20 0).. (if (=
1230: 28 65 72 72 6e 6f 29 20 45 49 4e 54 52 29 20 28 (errno) EINTR) (
1240: 63 6f 6e 6e 65 63 74 2f 69 6e 65 74 20 73 6f 63 connect/inet soc
1250: 6b 65 74 20 61 64 64 72 65 73 73 20 70 6f 72 74 ket address port
1260: 29 0a 09 09 28 65 72 72 6f 72 66 20 27 63 6f 6e )...(errorf 'con
1270: 6e 65 63 74 2f 69 6e 65 74 20 22 66 61 69 6c 65 nect/inet "faile
1280: 64 3a 20 7e 61 22 20 28 73 74 72 65 72 72 6f 72 d: ~a" (strerror
1290: 29 29 29 29 29 29 29 0a 0a 20 20 28 64 65 66 69 ))))))).. (defi
12a0: 6e 65 20 28 62 69 6e 64 2f 69 6e 65 74 20 73 6f ne (bind/inet so
12b0: 63 6b 65 74 20 61 64 64 72 65 73 73 20 70 6f 72 cket address por
12c0: 74 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 53 t). (define S
12d0: 4f 5f 52 45 55 53 45 41 44 44 52 20 32 29 0a 20 O_REUSEADDR 2).
12e0: 20 20 20 28 64 65 66 69 6e 65 20 53 4f 4c 5f 53 (define SOL_S
12f0: 4f 43 4b 45 54 20 31 29 0a 20 20 20 20 28 64 65 OCKET 1). (de
1300: 66 69 6e 65 20 73 65 74 73 6f 63 6b 6f 70 74 2a fine setsockopt*
1310: 20 28 66 6f 72 65 69 67 6e 2d 70 72 6f 63 65 64 (foreign-proced
1320: 75 72 65 20 22 73 65 74 73 6f 63 6b 6f 70 74 22 ure "setsockopt"
1330: 20 28 69 6e 74 20 69 6e 74 20 69 6e 74 20 75 38 (int int int u8
1340: 2a 20 73 6f 63 6b 6c 65 6e 5f 74 29 20 69 6e 74 * socklen_t) int
1350: 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 62 )). (define b
1360: 69 6e 64 2a 20 28 66 6f 72 65 69 67 6e 2d 70 72 ind* (foreign-pr
1370: 6f 63 65 64 75 72 65 20 22 62 69 6e 64 22 20 28 ocedure "bind" (
1380: 69 6e 74 20 28 2a 20 73 6f 63 6b 61 64 64 72 5f int (* sockaddr_
1390: 69 6e 29 20 73 6f 63 6b 6c 65 6e 5f 74 29 20 69 in) socklen_t) i
13a0: 6e 74 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 nt)). (define
13b0: 20 6f 70 74 20 28 6d 61 6b 65 2d 62 79 74 65 76 opt (make-bytev
13c0: 65 63 74 6f 72 20 28 66 74 79 70 65 2d 73 69 7a ector (ftype-siz
13d0: 65 6f 66 20 69 6e 74 29 29 29 0a 20 20 20 20 28 eof int))). (
13e0: 62 79 74 65 76 65 63 74 6f 72 2d 73 69 6e 74 2d bytevector-sint-
13f0: 73 65 74 21 20 6f 70 74 20 30 20 31 20 28 6e 61 set! opt 0 1 (na
1400: 74 69 76 65 2d 65 6e 64 69 61 6e 6e 65 73 73 29 tive-endianness)
1410: 20 28 66 74 79 70 65 2d 73 69 7a 65 6f 66 20 69 (ftype-sizeof i
1420: 6e 74 29 29 0a 20 20 20 20 28 73 65 74 73 6f 63 nt)). (setsoc
1430: 6b 6f 70 74 2a 20 28 70 6f 72 74 2d 66 69 6c 65 kopt* (port-file
1440: 2d 64 65 73 63 72 69 70 74 6f 72 20 73 6f 63 6b -descriptor sock
1450: 65 74 29 20 53 4f 4c 5f 53 4f 43 4b 45 54 20 53 et) SOL_SOCKET S
1460: 4f 5f 52 45 55 53 45 41 44 44 52 20 6f 70 74 20 O_REUSEADDR opt
1470: 28 66 74 79 70 65 2d 73 69 7a 65 6f 66 20 69 6e (ftype-sizeof in
1480: 74 29 29 0a 20 20 20 20 28 6c 65 74 20 28 5b 61 t)). (let ([a
1490: 64 64 72 20 28 6d 61 6b 65 2d 66 74 79 70 65 2d ddr (make-ftype-
14a0: 70 6f 69 6e 74 65 72 20 73 6f 63 6b 61 64 64 72 pointer sockaddr
14b0: 5f 69 6e 0a 09 09 09 09 20 20 20 20 28 66 6f 72 _in..... (for
14c0: 65 69 67 6e 2d 61 6c 6c 6f 63 20 28 66 74 79 70 eign-alloc (ftyp
14d0: 65 2d 73 69 7a 65 6f 66 20 73 6f 63 6b 61 64 64 e-sizeof sockadd
14e0: 72 5f 69 6e 29 29 29 5d 29 0a 20 20 20 20 20 20 r_in)))]).
14f0: 28 6d 65 6d 73 65 74 20 28 66 74 79 70 65 2d 70 (memset (ftype-p
1500: 6f 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 61 ointer-address a
1510: 64 64 72 29 20 30 20 28 66 74 79 70 65 2d 73 69 ddr) 0 (ftype-si
1520: 7a 65 6f 66 20 73 6f 63 6b 61 64 64 72 5f 69 6e zeof sockaddr_in
1530: 29 29 0a 20 20 20 20 20 20 28 66 74 79 70 65 2d )). (ftype-
1540: 73 65 74 21 20 73 6f 63 6b 61 64 64 72 5f 69 6e set! sockaddr_in
1550: 20 28 73 69 6e 5f 66 61 6d 69 6c 79 29 20 61 64 (sin_family) ad
1560: 64 72 20 28 73 6f 63 6b 65 74 2d 64 6f 6d 61 69 dr (socket-domai
1570: 6e 20 27 69 6e 65 74 29 29 0a 20 20 20 20 20 20 n 'inet)).
1580: 28 63 61 73 65 20 61 64 64 72 65 73 73 0a 09 5b (case address..[
1590: 61 6e 79 0a 09 20 28 66 74 79 70 65 2d 73 65 74 any.. (ftype-set
15a0: 21 20 69 6e 5f 61 64 64 72 20 28 73 5f 61 64 64 ! in_addr (s_add
15b0: 72 29 20 28 66 74 79 70 65 2d 26 72 65 66 20 73 r) (ftype-&ref s
15c0: 6f 63 6b 61 64 64 72 5f 69 6e 20 28 73 69 6e 5f ockaddr_in (sin_
15d0: 61 64 64 72 29 20 61 64 64 72 29 20 49 4e 41 44 addr) addr) INAD
15e0: 44 52 5f 41 4e 59 29 5d 0a 09 5b 65 6c 73 65 0a DR_ANY)]..[else.
15f0: 09 20 28 6c 65 74 20 28 5b 73 65 72 76 65 72 20 . (let ([server
1600: 28 67 65 74 68 6f 73 74 62 79 6e 61 6d 65 20 61 (gethostbyname a
1610: 64 64 72 65 73 73 29 5d 29 0a 09 20 20 20 28 6d ddress)]).. (m
1620: 65 6d 63 70 79 20 28 66 74 79 70 65 2d 70 6f 69 emcpy (ftype-poi
1630: 6e 74 65 72 2d 61 64 64 72 65 73 73 20 28 66 74 nter-address (ft
1640: 79 70 65 2d 26 72 65 66 20 73 6f 63 6b 61 64 64 ype-&ref sockadd
1650: 72 5f 69 6e 20 28 73 69 6e 5f 61 64 64 72 29 20 r_in (sin_addr)
1660: 61 64 64 72 29 29 0a 09 09 20 20 20 28 66 6f 72 addr))... (for
1670: 65 69 67 6e 2d 72 65 66 20 27 76 6f 69 64 2a 20 eign-ref 'void*
1680: 28 66 74 79 70 65 2d 72 65 66 20 68 6f 73 74 65 (ftype-ref hoste
1690: 6e 74 20 28 68 5f 61 64 64 72 5f 6c 69 73 74 29 nt (h_addr_list)
16a0: 20 73 65 72 76 65 72 29 20 30 29 0a 09 09 20 20 server) 0)...
16b0: 20 28 66 74 79 70 65 2d 72 65 66 20 68 6f 73 74 (ftype-ref host
16c0: 65 6e 74 20 28 68 5f 6c 65 6e 67 74 68 29 20 73 ent (h_length) s
16d0: 65 72 76 65 72 29 29 29 5d 29 0a 20 20 20 20 20 erver)))]).
16e0: 20 28 66 74 79 70 65 2d 73 65 74 21 20 73 6f 63 (ftype-set! soc
16f0: 6b 61 64 64 72 5f 69 6e 20 28 73 69 6e 5f 70 6f kaddr_in (sin_po
1700: 72 74 29 20 61 64 64 72 20 28 68 74 6f 6e 73 20 rt) addr (htons
1710: 70 6f 72 74 29 29 0a 20 20 20 20 20 20 28 6c 65 port)). (le
1720: 74 20 28 5b 72 20 28 62 69 6e 64 2a 20 28 70 6f t ([r (bind* (po
1730: 72 74 2d 66 69 6c 65 2d 64 65 73 63 72 69 70 74 rt-file-descript
1740: 6f 72 20 73 6f 63 6b 65 74 29 0a 09 09 20 20 20 or socket)...
1750: 20 20 20 61 64 64 72 20 28 66 74 79 70 65 2d 73 addr (ftype-s
1760: 69 7a 65 6f 66 20 73 6f 63 6b 61 64 64 72 5f 69 izeof sockaddr_i
1770: 6e 29 29 5d 29 0a 09 28 66 6f 72 65 69 67 6e 2d n))])..(foreign-
1780: 66 72 65 65 20 28 66 74 79 70 65 2d 70 6f 69 6e free (ftype-poin
1790: 74 65 72 2d 61 64 64 72 65 73 73 20 61 64 64 72 ter-address addr
17a0: 29 29 0a 09 28 77 68 65 6e 20 28 3c 20 72 20 30 ))..(when (< r 0
17b0: 29 0a 09 20 20 20 20 20 20 28 65 72 72 6f 72 66 ).. (errorf
17c0: 20 27 62 69 6e 64 2f 69 6e 65 74 20 22 66 61 69 'bind/inet "fai
17d0: 6c 65 64 3a 20 7e 61 22 20 28 73 74 72 65 72 72 led: ~a" (strerr
17e0: 6f 72 29 29 29 29 29 29 0a 20 20 0a 20 20 28 64 or)))))). . (d
17f0: 65 66 69 6e 65 20 28 6c 69 73 74 65 6e 20 73 20 efine (listen s
1800: 62 61 63 6b 6c 6f 67 29 0a 20 20 20 20 28 64 65 backlog). (de
1810: 66 69 6e 65 20 6c 69 73 74 65 6e 2a 20 28 66 6f fine listen* (fo
1820: 72 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 reign-procedure
1830: 22 6c 69 73 74 65 6e 22 20 28 69 6e 74 20 69 6e "listen" (int in
1840: 74 29 20 69 6e 74 29 29 0a 20 20 20 20 28 6c 65 t) int)). (le
1850: 74 20 28 5b 72 20 28 6c 69 73 74 65 6e 2a 20 28 t ([r (listen* (
1860: 70 6f 72 74 2d 66 69 6c 65 2d 64 65 73 63 72 69 port-file-descri
1870: 70 74 6f 72 20 73 29 20 62 61 63 6b 6c 6f 67 29 ptor s) backlog)
1880: 5d 29 0a 20 20 20 20 20 20 28 77 68 65 6e 20 28 ]). (when (
1890: 3c 20 72 20 30 29 0a 09 20 20 20 20 28 65 72 72 < r 0).. (err
18a0: 6f 72 66 20 27 6c 69 73 74 65 6e 20 22 66 61 69 orf 'listen "fai
18b0: 6c 65 64 3a 20 7e 61 22 20 28 73 74 72 65 72 72 led: ~a" (strerr
18c0: 6f 72 29 29 29 0a 20 20 20 20 20 20 72 29 29 0a or))). r)).
18d0: 20 20 0a 20 20 28 64 65 66 69 6e 65 20 28 61 63 . (define (ac
18e0: 63 65 70 74 20 73 29 0a 20 20 20 20 28 64 65 66 cept s). (def
18f0: 69 6e 65 20 61 63 63 65 70 74 2a 20 28 66 6f 72 ine accept* (for
1900: 65 69 67 6e 2d 70 72 6f 63 65 64 75 72 65 20 22 eign-procedure "
1910: 61 63 63 65 70 74 22 20 28 69 6e 74 20 76 6f 69 accept" (int voi
1920: 64 2a 20 76 6f 69 64 2a 29 20 69 6e 74 29 29 0a d* void*) int)).
1930: 20 20 20 20 3b 3b 20 54 4f 44 4f 3a 20 67 65 74 ;; TODO: get
1940: 20 74 68 65 20 63 6c 69 65 6e 74 20 61 64 64 72 the client addr
1950: 65 73 73 21 0a 20 20 20 20 0a 20 20 20 20 28 6c ess!. . (l
1960: 65 74 20 28 5b 72 20 28 61 63 63 65 70 74 2a 20 et ([r (accept*
1970: 28 70 6f 72 74 2d 66 69 6c 65 2d 64 65 73 63 72 (port-file-descr
1980: 69 70 74 6f 72 20 73 29 20 30 20 30 29 5d 29 0a iptor s) 0 0)]).
1990: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
19a0: 20 20 20 5b 28 3c 20 72 20 30 29 0a 09 28 69 66 [(< r 0)..(if
19b0: 20 28 3d 20 28 65 72 72 6e 6f 29 20 45 49 4e 54 (= (errno) EINT
19c0: 52 29 0a 09 20 20 20 20 28 61 63 63 65 70 74 20 R).. (accept
19d0: 73 29 0a 09 20 20 20 20 28 65 72 72 6f 72 66 20 s).. (errorf
19e0: 27 61 63 63 65 70 74 20 22 66 61 69 6c 65 64 3a 'accept "failed:
19f0: 20 7e 61 22 20 28 73 74 72 65 72 72 6f 72 29 29 ~a" (strerror))
1a00: 29 5d 0a 20 20 20 20 20 20 20 5b 65 6c 73 65 0a )]. [else.
1a10: 09 28 6f 70 65 6e 2d 66 64 2d 69 6e 70 75 74 2f .(open-fd-input/
1a20: 6f 75 74 70 75 74 2d 70 6f 72 74 20 72 29 5d 29 output-port r)])
1a30: 29 29 0a 20 20 29 0a 0a 0a 23 7c 0a 3b 45 78 61 )). )...#|.;Exa
1a40: 6d 70 6c 65 3a 0a 0a 28 6c 6f 61 64 20 22 73 6f mple:..(load "so
1a50: 63 6b 65 74 2e 73 6c 73 22 29 0a 0a 3b 3b 20 63 cket.sls")..;; c
1a60: 6c 69 65 6e 74 0a 28 69 6d 70 6f 72 74 20 28 73 lient.(import (s
1a70: 6f 63 6b 65 74 29 29 0a 0a 28 64 65 66 69 6e 65 ocket))..(define
1a80: 20 28 68 74 74 70 2d 67 65 74 20 68 6f 73 74 6e (http-get hostn
1a90: 61 6d 65 20 70 6f 72 74 20 71 29 0a 20 20 28 64 ame port q). (d
1aa0: 65 66 69 6e 65 20 73 6f 63 6b 20 28 73 6f 63 6b efine sock (sock
1ab0: 65 74 20 27 69 6e 65 74 20 27 73 74 72 65 61 6d et 'inet 'stream
1ac0: 20 27 28 29 20 30 29 29 0a 20 20 28 63 6f 6e 6e '() 0)). (conn
1ad0: 65 63 74 2f 69 6e 65 74 20 73 6f 63 6b 20 68 6f ect/inet sock ho
1ae0: 73 74 6e 61 6d 65 20 70 6f 72 74 29 0a 20 20 28 stname port). (
1af0: 70 75 74 2d 62 79 74 65 76 65 63 74 6f 72 20 73 put-bytevector s
1b00: 6f 63 6b 20 28 73 74 72 69 6e 67 2d 3e 75 74 66 ock (string->utf
1b10: 38 20 28 66 6f 72 6d 61 74 20 23 66 20 22 47 45 8 (format #f "GE
1b20: 54 20 7e 61 20 48 54 54 50 2f 31 2e 31 5c 72 5c T ~a HTTP/1.1\r\
1b30: 6e 48 6f 73 74 3a 20 7e 61 5c 72 5c 6e 43 6f 6e nHost: ~a\r\nCon
1b40: 6e 65 63 74 69 6f 6e 3a 20 43 6c 6f 73 65 5c 72 nection: Close\r
1b50: 5c 6e 5c 72 5c 6e 22 20 71 20 68 6f 73 74 6e 61 \n\r\n" q hostna
1b60: 6d 65 29 29 29 0a 20 20 28 66 6c 75 73 68 2d 6f me))). (flush-o
1b70: 75 74 70 75 74 2d 70 6f 72 74 20 73 6f 63 6b 29 utput-port sock)
1b80: 0a 20 20 28 64 6f 20 28 5b 63 20 28 67 65 74 2d . (do ([c (get-
1b90: 75 38 20 73 6f 63 6b 29 20 28 67 65 74 2d 75 38 u8 sock) (get-u8
1ba0: 20 73 6f 63 6b 29 5d 20 0a 09 20 20 20 20 20 5b sock)] .. [
1bb0: 6c 20 27 28 29 20 28 63 6f 6e 73 20 63 20 6c 29 l '() (cons c l)
1bc0: 5d 29 0a 20 20 20 20 28 28 65 6f 66 2d 6f 62 6a ]). ((eof-obj
1bd0: 65 63 74 3f 20 63 29 20 28 75 74 66 38 2d 3e 73 ect? c) (utf8->s
1be0: 74 72 69 6e 67 20 28 61 70 70 6c 79 20 62 79 74 tring (apply byt
1bf0: 65 76 65 63 74 6f 72 20 28 72 65 76 65 72 73 65 evector (reverse
1c00: 20 6c 29 29 29 29 29 29 0a 0a 28 73 75 62 73 74 l))))))..(subst
1c10: 72 69 6e 67 20 28 68 74 74 70 2d 67 65 74 20 22 ring (http-get "
1c20: 73 63 68 65 6d 65 2e 63 6f 6d 22 20 38 30 20 22 scheme.com" 80 "
1c30: 2f 74 73 70 6c 34 2f 69 6e 74 72 6f 2e 68 74 6d /tspl4/intro.htm
1c40: 6c 22 29 20 30 20 32 30 30 29 0a 0a 3b 3b 20 73 l") 0 200)..;; s
1c50: 65 72 76 65 72 0a 28 69 6d 70 6f 72 74 20 28 73 erver.(import (s
1c60: 6f 63 6b 65 74 29 29 0a 28 64 65 66 69 6e 65 20 ocket)).(define
1c70: 73 6f 63 6b 20 28 73 6f 63 6b 65 74 20 27 69 6e sock (socket 'in
1c80: 65 74 20 27 73 74 72 65 61 6d 20 27 28 29 20 30 et 'stream '() 0
1c90: 29 29 0a 28 62 69 6e 64 2f 69 6e 65 74 20 73 6f )).(bind/inet so
1ca0: 63 6b 20 27 61 6e 79 20 38 30 30 31 29 0a 28 6c ck 'any 8001).(l
1cb0: 69 73 74 65 6e 20 73 6f 63 6b 20 31 30 29 0a 28 isten sock 10).(
1cc0: 64 65 66 69 6e 65 20 63 6c 69 73 6f 63 6b 20 28 define clisock (
1cd0: 61 63 63 65 70 74 20 73 6f 63 6b 29 29 0a 28 64 accept sock)).(d
1ce0: 65 66 69 6e 65 20 28 72 65 61 64 2d 61 6c 6c 20 efine (read-all
1cf0: 73 6f 63 6b 29 20 0a 20 20 28 64 6f 20 28 5b 63 sock) . (do ([c
1d00: 20 28 67 65 74 2d 75 38 20 73 6f 63 6b 29 20 28 (get-u8 sock) (
1d10: 67 65 74 2d 75 38 20 73 6f 63 6b 29 5d 20 0a 09 get-u8 sock)] ..
1d20: 20 20 20 20 20 5b 6c 20 27 28 29 20 28 63 6f 6e [l '() (con
1d30: 73 20 63 20 6c 29 5d 29 0a 20 20 20 20 20 20 28 s c l)]). (
1d40: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 63 29 20 (eof-object? c)
1d50: 28 75 74 66 38 2d 3e 73 74 72 69 6e 67 20 28 61 (utf8->string (a
1d60: 70 70 6c 79 20 62 79 74 65 76 65 63 74 6f 72 20 pply bytevector
1d70: 28 72 65 76 65 72 73 65 20 6c 29 29 29 29 29 29 (reverse l))))))
1d80: 0a 28 72 65 61 64 2d 61 6c 6c 20 63 6c 69 73 6f .(read-all cliso
1d90: 63 6b 29 0a 7c 23 0a 0a ck).|#..