Artifact
24167fae4d9a783ea12528051756f330ebaf3cb4:
0000: 3b 3b 20 75 6c 65 78 3a 20 44 69 73 74 72 69 62 ;; ulex: Distrib
0010: 75 74 65 64 20 73 71 6c 69 74 65 33 20 64 62 0a uted sqlite3 db.
0020: 3b 3b 3b 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 ;;;.;; Copyright
0030: 20 28 43 29 20 32 30 31 38 2d 32 30 32 31 20 4d (C) 2018-2021 M
0040: 61 74 74 20 57 65 6c 6c 61 6e 64 0a 3b 3b 20 52 att Welland.;; R
0050: 65 64 69 73 74 72 69 62 75 74 69 6f 6e 20 61 6e edistribution an
0060: 64 20 75 73 65 20 69 6e 20 73 6f 75 72 63 65 20 d use in source
0070: 61 6e 64 20 62 69 6e 61 72 79 20 66 6f 72 6d 73 and binary forms
0080: 2c 20 77 69 74 68 20 6f 72 20 77 69 74 68 6f 75 , with or withou
0090: 74 0a 3b 3b 20 6d 6f 64 69 66 69 63 61 74 69 6f t.;; modificatio
00a0: 6e 2c 20 69 73 20 70 65 72 6d 69 74 74 65 64 2e n, is permitted.
00b0: 0a 3b 3b 0a 3b 3b 20 54 48 49 53 20 53 4f 46 54 .;;.;; THIS SOFT
00c0: 57 41 52 45 20 49 53 20 50 52 4f 56 49 44 45 44 WARE IS PROVIDED
00d0: 20 42 59 20 54 48 45 20 41 55 54 48 4f 52 20 60 BY THE AUTHOR `
00e0: 60 41 53 20 49 53 27 27 20 41 4e 44 20 41 4e 59 `AS IS'' AND ANY
00f0: 20 45 58 50 52 45 53 53 0a 3b 3b 20 4f 52 20 49 EXPRESS.;; OR I
0100: 4d 50 4c 49 45 44 20 57 41 52 52 41 4e 54 49 45 MPLIED WARRANTIE
0110: 53 2c 20 49 4e 43 4c 55 44 49 4e 47 2c 20 42 55 S, INCLUDING, BU
0120: 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 20 54 4f T NOT LIMITED TO
0130: 2c 20 54 48 45 20 49 4d 50 4c 49 45 44 0a 3b 3b , THE IMPLIED.;;
0140: 20 57 41 52 52 41 4e 54 49 45 53 20 4f 46 20 4d WARRANTIES OF M
0150: 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 41 ERCHANTABILITY A
0160: 4e 44 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 ND FITNESS FOR A
0170: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0180: 4f 53 45 0a 3b 3b 20 41 52 45 20 44 49 53 43 4c OSE.;; ARE DISCL
0190: 41 49 4d 45 44 2e 20 20 49 4e 20 4e 4f 20 45 56 AIMED. IN NO EV
01a0: 45 4e 54 20 53 48 41 4c 4c 20 54 48 45 20 41 55 ENT SHALL THE AU
01b0: 54 48 4f 52 20 4f 52 20 43 4f 4e 54 52 49 42 55 THOR OR CONTRIBU
01c0: 54 4f 52 53 20 42 45 0a 3b 3b 20 4c 49 41 42 4c TORS BE.;; LIABL
01d0: 45 20 46 4f 52 20 41 4e 59 20 44 49 52 45 43 54 E FOR ANY DIRECT
01e0: 2c 20 49 4e 44 49 52 45 43 54 2c 20 49 4e 43 49 , INDIRECT, INCI
01f0: 44 45 4e 54 41 4c 2c 20 53 50 45 43 49 41 4c 2c DENTAL, SPECIAL,
0200: 20 45 58 45 4d 50 4c 41 52 59 2c 20 4f 52 0a 3b EXEMPLARY, OR.;
0210: 3b 20 43 4f 4e 53 45 51 55 45 4e 54 49 41 4c 20 ; CONSEQUENTIAL
0220: 44 41 4d 41 47 45 53 20 28 49 4e 43 4c 55 44 49 DAMAGES (INCLUDI
0230: 4e 47 2c 20 42 55 54 20 4e 4f 54 20 4c 49 4d 49 NG, BUT NOT LIMI
0240: 54 45 44 20 54 4f 2c 20 50 52 4f 43 55 52 45 4d TED TO, PROCUREM
0250: 45 4e 54 0a 3b 3b 20 4f 46 20 53 55 42 53 54 49 ENT.;; OF SUBSTI
0260: 54 55 54 45 20 47 4f 4f 44 53 20 4f 52 20 53 45 TUTE GOODS OR SE
0270: 52 56 49 43 45 53 3b 20 4c 4f 53 53 20 4f 46 20 RVICES; LOSS OF
0280: 55 53 45 2c 20 44 41 54 41 2c 20 4f 52 20 50 52 USE, DATA, OR PR
0290: 4f 46 49 54 53 3b 20 4f 52 0a 3b 3b 20 42 55 53 OFITS; OR.;; BUS
02a0: 49 4e 45 53 53 20 49 4e 54 45 52 52 55 50 54 49 INESS INTERRUPTI
02b0: 4f 4e 29 20 48 4f 57 45 56 45 52 20 43 41 55 53 ON) HOWEVER CAUS
02c0: 45 44 20 41 4e 44 20 4f 4e 20 41 4e 59 20 54 48 ED AND ON ANY TH
02d0: 45 4f 52 59 20 4f 46 0a 3b 3b 20 4c 49 41 42 49 EORY OF.;; LIABI
02e0: 4c 49 54 59 2c 20 57 48 45 54 48 45 52 20 49 4e LITY, WHETHER IN
02f0: 20 43 4f 4e 54 52 41 43 54 2c 20 53 54 52 49 43 CONTRACT, STRIC
0300: 54 20 4c 49 41 42 49 4c 49 54 59 2c 20 4f 52 20 T LIABILITY, OR
0310: 54 4f 52 54 0a 3b 3b 20 28 49 4e 43 4c 55 44 49 TORT.;; (INCLUDI
0320: 4e 47 20 4e 45 47 4c 49 47 45 4e 43 45 20 4f 52 NG NEGLIGENCE OR
0330: 20 4f 54 48 45 52 57 49 53 45 29 20 41 52 49 53 OTHERWISE) ARIS
0340: 49 4e 47 20 49 4e 20 41 4e 59 20 57 41 59 20 4f ING IN ANY WAY O
0350: 55 54 20 4f 46 20 54 48 45 0a 3b 3b 20 55 53 45 UT OF THE.;; USE
0360: 20 4f 46 20 54 48 49 53 20 53 4f 46 54 57 41 52 OF THIS SOFTWAR
0370: 45 2c 20 45 56 45 4e 20 49 46 20 41 44 56 49 53 E, EVEN IF ADVIS
0380: 45 44 20 4f 46 20 54 48 45 20 50 4f 53 53 49 42 ED OF THE POSSIB
0390: 49 4c 49 54 59 20 4f 46 20 53 55 43 48 0a 3b 3b ILITY OF SUCH.;;
03a0: 20 44 41 4d 41 47 45 2e 0a 0a 3b 3b 3d 3d 3d 3d DAMAGE...;;====
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03f0: 3d 3d 0a 3b 3b 20 41 42 4f 55 54 3a 0a 3b 3b 20 ==.;; ABOUT:.;;
0400: 20 20 53 65 65 20 52 45 41 44 4d 45 20 69 6e 20 See README in
0410: 74 68 65 20 64 69 73 74 72 69 62 75 74 69 6f 6e the distribution
0420: 20 61 74 20 68 74 74 70 73 3a 2f 2f 77 77 77 2e at https://www.
0430: 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 kiatoa.com/fossi
0440: 6c 73 2f 75 6c 65 78 0a 3b 3b 20 4e 4f 54 45 53 ls/ulex.;; NOTES
0450: 3a 0a 3b 3b 20 20 20 57 68 79 20 73 71 6c 2d 64 :.;; Why sql-d
0460: 65 2d 6c 69 74 65 20 61 6e 64 20 6e 6f 74 20 73 e-lite and not s
0470: 61 79 2c 20 64 62 69 3f 20 20 2d 20 70 65 72 66 ay, dbi? - perf
0480: 6f 72 6d 61 6e 63 65 20 6d 6f 73 74 6c 79 2c 20 ormance mostly,
0490: 74 68 65 6e 20 73 69 6d 70 6c 69 63 69 74 79 2e then simplicity.
04a0: 0a 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;.;;==========
04b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 6d ============..(m
04f0: 6f 64 75 6c 65 20 75 6c 65 78 0a 09 2a 0a 09 23 odule ulex..*..#
0500: 3b 28 0a 20 20 20 20 20 0a 20 20 20 20 20 3b 3b ;(. . ;;
0510: 20 4e 4f 54 45 3a 20 6c 6f 6f 6b 69 6e 67 20 66 NOTE: looking f
0520: 6f 72 20 74 68 65 20 68 61 6e 64 6c 65 72 20 70 or the handler p
0530: 72 6f 63 20 2d 20 66 69 6e 64 20 74 68 65 20 72 roc - find the r
0540: 75 6e 2d 6c 69 73 74 65 6e 65 72 20 3a 29 0a 20 un-listener :).
0550: 20 20 20 20 0a 20 20 20 20 20 72 75 6e 2d 6c 69 . run-li
0560: 73 74 65 6e 65 72 20 20 20 20 20 3b 3b 20 28 72 stener ;; (r
0570: 75 6e 2d 6c 69 73 74 65 6e 65 72 20 68 61 6e 64 un-listener hand
0580: 6c 65 72 2d 70 72 6f 63 20 5b 70 6f 72 74 5d 29 ler-proc [port])
0590: 20 3d 3e 20 75 63 6f 6e 6e 0a 0a 20 20 20 20 20 => uconn..
05a0: 3b 3b 20 4e 4f 54 45 3a 20 68 61 6e 64 6c 65 72 ;; NOTE: handler
05b0: 2d 70 72 6f 63 20 70 61 72 61 6d 73 3b 0a 20 20 -proc params;.
05c0: 20 20 20 3b 3b 20 20 20 20 20 20 20 28 68 61 6e ;; (han
05d0: 64 6c 65 72 2d 70 72 6f 63 20 72 65 6d 2d 68 6f dler-proc rem-ho
05e0: 73 74 2d 70 6f 72 74 20 71 72 79 6b 65 79 20 63 st-port qrykey c
05f0: 6d 64 20 70 61 72 61 6d 73 29 0a 0a 20 20 20 20 md params)..
0600: 20 73 65 6e 64 2d 72 65 63 65 69 76 65 20 20 20 send-receive
0610: 20 20 3b 3b 20 28 73 65 6e 64 2d 72 65 63 65 69 ;; (send-recei
0620: 76 65 20 75 63 6f 6e 6e 20 68 6f 73 74 2d 70 6f ve uconn host-po
0630: 72 74 20 63 6d 64 20 64 61 74 61 29 0a 0a 20 20 rt cmd data)..
0640: 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 63 6d 64 20 ;; NOTE: cmd
0650: 63 61 6e 20 62 65 20 61 6e 79 20 70 6c 61 69 6e can be any plain
0660: 20 74 65 78 74 20 73 79 6d 62 6f 6c 20 65 78 63 text symbol exc
0670: 65 70 74 20 66 6f 72 20 74 68 65 73 65 3b 0a 20 ept for these;.
0680: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 27 ;; '
0690: 70 69 6e 67 20 27 61 63 6b 20 27 67 6f 6f 64 62 ping 'ack 'goodb
06a0: 79 65 20 27 72 65 73 70 6f 6e 73 65 0a 20 20 20 ye 'response.
06b0: 20 20 0a 20 20 20 20 20 73 65 74 2d 77 6f 72 6b . set-work
06c0: 2d 68 61 6e 64 6c 65 72 20 3b 3b 20 28 73 65 74 -handler ;; (set
06d0: 2d 77 6f 72 6b 2d 68 61 6e 64 6c 65 72 20 70 72 -work-handler pr
06e0: 6f 63 29 0a 0a 20 20 20 20 20 77 61 69 74 2d 61 oc).. wait-a
06f0: 6e 64 2d 63 6c 6f 73 65 20 20 20 3b 3b 20 28 77 nd-close ;; (w
0700: 61 69 74 2d 61 6e 64 2d 63 6c 6f 73 65 20 75 63 ait-and-close uc
0710: 6f 6e 6e 29 0a 0a 20 20 20 20 20 75 6c 65 78 2d onn).. ulex-
0720: 6c 69 73 74 65 6e 65 72 3f 0a 20 20 20 20 20 0a listener?. .
0730: 20 20 20 20 20 3b 3b 20 6e 65 65 64 65 64 20 74 ;; needed t
0740: 6f 20 67 65 74 20 74 68 65 20 69 6e 74 65 72 66 o get the interf
0750: 61 63 65 3a 70 6f 72 74 20 74 68 61 74 20 77 61 ace:port that wa
0760: 73 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 s automatically
0770: 66 6f 75 6e 64 0a 20 20 20 20 20 75 64 61 74 2d found. udat-
0780: 70 6f 72 74 0a 20 20 20 20 20 75 64 61 74 2d 68 port. udat-h
0790: 6f 73 74 2d 70 6f 72 74 0a 20 20 20 20 20 0a 20 ost-port. .
07a0: 20 20 20 20 3b 3b 20 66 6f 72 20 74 65 73 74 69 ;; for testi
07b0: 6e 67 20 6f 6e 6c 79 0a 20 20 20 20 20 3b 3b 20 ng only. ;;
07c0: 70 70 2d 75 63 6f 6e 6e 0a 20 20 20 20 20 0a 20 pp-uconn. .
07d0: 20 20 20 20 3b 3b 20 70 61 72 61 6d 65 74 65 72 ;; parameter
07e0: 73 0a 20 20 20 20 20 77 6f 72 6b 2d 6d 65 74 68 s. work-meth
07f0: 6f 64 20 20 20 3b 3b 20 70 61 72 61 6d 65 74 65 od ;; paramete
0800: 72 3b 20 27 74 68 72 65 61 64 73 2c 20 27 6d 61 r; 'threads, 'ma
0810: 69 6c 62 6f 78 2c 20 27 6c 69 6d 69 74 65 64 2c ilbox, 'limited,
0820: 20 27 64 69 72 65 63 74 0a 20 20 20 20 20 72 65 'direct. re
0830: 74 75 72 6e 2d 6d 65 74 68 6f 64 20 3b 3b 20 70 turn-method ;; p
0840: 61 72 61 6d 65 74 65 72 3b 20 27 6d 61 69 6c 62 arameter; 'mailb
0850: 6f 78 2c 20 27 70 6f 6c 6c 69 6e 67 2c 20 27 64 ox, 'polling, 'd
0860: 69 72 65 63 74 0a 20 20 20 20 20 29 0a 0a 28 69 irect. )..(i
0870: 6d 70 6f 72 74 20 73 63 68 65 6d 65 0a 09 63 68 mport scheme..ch
0880: 69 63 6b 65 6e 2e 62 61 73 65 0a 09 63 68 69 63 icken.base..chic
0890: 6b 65 6e 2e 66 69 6c 65 0a 09 63 68 69 63 6b 65 ken.file..chicke
08a0: 6e 2e 69 6f 0a 09 63 68 69 63 6b 65 6e 2e 74 69 n.io..chicken.ti
08b0: 6d 65 0a 09 63 68 69 63 6b 65 6e 2e 63 6f 6e 64 me..chicken.cond
08c0: 69 74 69 6f 6e 0a 09 63 68 69 63 6b 65 6e 2e 73 ition..chicken.s
08d0: 74 72 69 6e 67 0a 09 63 68 69 63 6b 65 6e 2e 73 tring..chicken.s
08e0: 6f 72 74 0a 09 63 68 69 63 6b 65 6e 2e 70 72 65 ort..chicken.pre
08f0: 74 74 79 2d 70 72 69 6e 74 0a 09 63 68 69 63 6b tty-print..chick
0900: 65 6e 2e 74 63 70 0a 09 0a 09 61 64 64 72 65 73 en.tcp....addres
0910: 73 2d 69 6e 66 6f 0a 09 6d 61 69 6c 62 6f 78 0a s-info..mailbox.
0920: 09 6d 61 74 63 68 61 62 6c 65 0a 09 3b 3b 20 71 .matchable..;; q
0930: 75 65 75 65 73 0a 09 72 65 67 65 78 0a 09 72 65 ueues..regex..re
0940: 67 65 78 2d 63 61 73 65 0a 09 73 69 6d 70 6c 65 gex-case..simple
0950: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 73 31 31 -exceptions..s11
0960: 6e 0a 09 73 72 66 69 2d 31 0a 09 73 72 66 69 2d n..srfi-1..srfi-
0970: 31 38 0a 09 73 72 66 69 2d 34 0a 09 73 72 66 69 18..srfi-4..srfi
0980: 2d 36 39 0a 09 73 79 73 74 65 6d 2d 69 6e 66 6f -69..system-info
0990: 72 6d 61 74 69 6f 6e 0a 09 3b 3b 20 74 63 70 36 rmation..;; tcp6
09a0: 0a 09 74 63 70 2d 73 65 72 76 65 72 0a 09 74 79 ..tcp-server..ty
09b0: 70 65 64 2d 72 65 63 6f 72 64 73 0a 09 29 0a 0a ped-records..)..
09c0: 3b 3b 20 75 64 61 74 20 73 74 72 75 63 74 2c 20 ;; udat struct,
09d0: 75 73 65 64 20 62 79 20 62 6f 74 68 20 63 61 6c used by both cal
09e0: 6c 65 72 20 61 6e 64 20 63 61 6c 6c 65 65 0a 3b ler and callee.;
09f0: 3b 20 69 6e 73 74 61 6e 74 69 61 74 65 64 20 61 ; instantiated a
0a00: 73 20 75 63 6f 6e 6e 20 62 79 20 63 6f 6e 76 65 s uconn by conve
0a10: 6e 74 69 6f 6e 0a 3b 3b 0a 28 64 65 66 73 74 72 ntion.;;.(defstr
0a20: 75 63 74 20 75 64 61 74 0a 20 20 3b 3b 20 74 68 uct udat. ;; th
0a30: 65 20 6c 69 73 74 65 6e 65 72 20 73 69 64 65 0a e listener side.
0a40: 20 20 28 70 6f 72 74 20 23 66 29 0a 20 20 28 68 (port #f). (h
0a50: 6f 73 74 2d 70 6f 72 74 20 23 66 29 20 3b 3b 20 ost-port #f) ;;
0a60: 6d 79 20 68 6f 73 74 3a 70 6f 72 74 0a 20 20 28 my host:port. (
0a70: 73 6f 63 6b 65 74 20 23 66 29 0a 20 20 3b 3b 20 socket #f). ;;
0a80: 74 68 65 20 70 65 65 72 73 0a 20 20 28 70 65 65 the peers. (pee
0a90: 72 73 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 rs (make-hash-t
0aa0: 61 62 6c 65 29 29 20 3b 3b 20 68 6f 73 74 3a 70 able)) ;; host:p
0ab0: 6f 72 74 2d 3e 70 65 65 72 0a 20 20 3b 3b 20 77 ort->peer. ;; w
0ac0: 6f 72 6b 20 68 61 6e 64 6c 69 6e 67 0a 20 20 28 ork handling. (
0ad0: 77 6f 72 6b 2d 71 75 65 75 65 20 28 6d 61 6b 65 work-queue (make
0ae0: 2d 6d 61 69 6c 62 6f 78 29 29 0a 20 20 28 77 6f -mailbox)). (wo
0af0: 72 6b 2d 70 72 6f 63 20 20 23 66 29 20 20 20 20 rk-proc #f)
0b00: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 73 ;; s
0b10: 65 74 20 62 79 20 75 73 65 72 0a 20 20 28 63 6e et by user. (cn
0b20: 75 6d 20 20 20 20 20 20 20 30 29 20 20 20 20 20 um 0)
0b30: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 63 ;; c
0b40: 6f 6f 6b 69 65 20 6e 75 6d 62 65 72 0a 20 20 28 ookie number. (
0b50: 6d 62 6f 78 65 73 20 20 20 20 20 28 6d 61 6b 65 mboxes (make
0b60: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;;
0b70: 20 66 6f 72 20 74 68 65 20 72 65 70 6c 69 65 73 for the replies
0b80: 0a 20 20 28 61 76 61 69 6c 2d 63 6d 62 6f 78 65 . (avail-cmboxe
0b90: 73 20 27 28 29 29 20 20 20 20 20 20 20 20 20 20 s '())
0ba0: 20 20 3b 3b 20 6c 69 73 74 20 6f 66 20 28 3c 63 ;; list of (<c
0bb0: 6f 6f 6b 69 65 3e 20 2e 20 3c 6d 62 6f 78 3e 29 ookie> . <mbox>)
0bc0: 20 66 6f 72 20 72 65 2d 75 73 65 0a 20 20 3b 3b for re-use. ;;
0bd0: 20 74 68 72 65 61 64 73 0a 20 20 28 6e 75 6d 74 threads. (numt
0be0: 68 72 65 61 64 73 20 31 30 29 0a 20 20 28 63 6d hreads 10). (cm
0bf0: 64 2d 74 68 72 65 61 64 20 23 66 29 0a 20 20 28 d-thread #f). (
0c00: 77 6f 72 6b 2d 71 75 65 75 65 2d 74 68 72 65 61 work-queue-threa
0c10: 64 20 23 66 29 0a 20 20 28 6e 75 6d 2d 74 68 72 d #f). (num-thr
0c20: 65 61 64 73 2d 72 75 6e 6e 69 6e 67 20 30 29 0a eads-running 0).
0c30: 20 20 29 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ) ..;;========
0c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
0c80: 3b 20 6c 69 73 74 65 6e 65 72 0a 3b 3b 3d 3d 3d ; listener.;;===
0c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cd0: 3d 3d 3d 0a 0a 3b 3b 20 69 73 20 75 63 6f 6e 6e ===..;; is uconn
0ce0: 20 61 20 75 6c 65 78 20 63 6f 6e 6e 65 63 74 6f a ulex connecto
0cf0: 72 20 28 6c 69 73 74 65 6e 65 72 29 0a 3b 3b 0a r (listener).;;.
0d00: 28 64 65 66 69 6e 65 20 28 75 6c 65 78 2d 6c 69 (define (ulex-li
0d10: 73 74 65 6e 65 72 3f 20 75 63 6f 6e 6e 29 0a 20 stener? uconn).
0d20: 20 28 75 64 61 74 3f 20 75 63 6f 6e 6e 29 29 0a (udat? uconn)).
0d30: 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 74 63 70 .;; create a tcp
0d40: 20 6c 69 73 74 65 6e 65 72 20 61 6e 64 20 72 65 listener and re
0d50: 74 75 72 6e 20 61 20 70 6f 70 75 6c 61 74 65 64 turn a populated
0d60: 20 75 64 61 74 20 73 74 72 75 63 74 20 77 69 74 udat struct wit
0d70: 68 0a 3b 3b 20 6d 79 20 70 6f 72 74 2c 20 61 64 h.;; my port, ad
0d80: 64 72 65 73 73 2c 20 68 6f 73 74 6e 61 6d 65 2c dress, hostname,
0d90: 20 70 69 64 20 65 74 63 2e 0a 3b 3b 20 72 65 74 pid etc..;; ret
0da0: 75 72 6e 20 23 66 20 69 66 20 66 61 69 6c 20 74 urn #f if fail t
0db0: 6f 20 66 69 6e 64 20 61 20 70 6f 72 74 20 74 6f o find a port to
0dc0: 20 61 6c 6c 6f 63 61 74 65 2e 0a 3b 3b 0a 3b 3b allocate..;;.;;
0dd0: 20 20 69 66 20 75 64 61 74 61 2d 69 6e 20 69 73 if udata-in is
0de0: 20 23 66 20 63 72 65 61 74 65 20 74 68 65 20 72 #f create the r
0df0: 65 63 6f 72 64 0a 3b 3b 20 20 69 66 20 74 68 65 ecord.;; if the
0e00: 72 65 20 69 73 20 61 6c 72 65 61 64 79 20 61 20 re is already a
0e10: 73 65 72 76 2d 6c 69 73 74 65 6e 65 72 20 72 65 serv-listener re
0e20: 74 75 72 6e 20 74 68 65 20 75 64 61 74 61 0a 3b turn the udata.;
0e30: 3b 0a 28 64 65 66 69 6e 65 20 28 73 65 74 75 70 ;.(define (setup
0e40: 2d 6c 69 73 74 65 6e 65 72 20 75 63 6f 6e 6e 20 -listener uconn
0e50: 23 21 6f 70 74 69 6f 6e 61 6c 20 28 70 6f 72 74 #!optional (port
0e60: 20 34 32 34 32 29 29 0a 20 20 28 68 61 6e 64 6c 4242)). (handl
0e70: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 e-exceptions.
0e80: 65 78 6e 0a 20 20 20 28 69 66 20 28 3c 20 70 6f exn. (if (< po
0e90: 72 74 20 36 35 35 33 35 29 0a 20 20 20 20 20 20 rt 65535).
0ea0: 20 28 73 65 74 75 70 2d 6c 69 73 74 65 6e 65 72 (setup-listener
0eb0: 20 75 63 6f 6e 6e 20 28 2b 20 70 6f 72 74 20 31 uconn (+ port 1
0ec0: 29 29 0a 20 20 20 20 20 20 20 23 66 29 0a 20 20 )). #f).
0ed0: 20 28 63 6f 6e 6e 65 63 74 2d 6c 69 73 74 65 6e (connect-listen
0ee0: 65 72 20 75 63 6f 6e 6e 20 70 6f 72 74 29 29 29 er uconn port)))
0ef0: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 6e 65 ..(define (conne
0f00: 63 74 2d 6c 69 73 74 65 6e 65 72 20 75 63 6f 6e ct-listener ucon
0f10: 6e 20 70 6f 72 74 29 0a 20 20 3b 3b 20 28 74 63 n port). ;; (tc
0f20: 70 2d 6c 69 73 74 65 6e 65 72 2d 73 6f 63 6b 65 p-listener-socke
0f30: 74 20 4c 49 53 54 45 4e 45 52 29 28 73 6f 63 6b t LISTENER)(sock
0f40: 65 74 2d 6e 61 6d 65 20 73 6f 29 0a 20 20 3b 3b et-name so). ;;
0f50: 20 73 6f 63 6b 61 64 64 72 2d 61 64 64 72 65 73 sockaddr-addres
0f60: 73 2c 20 73 6f 63 6b 61 64 64 72 2d 70 6f 72 74 s, sockaddr-port
0f70: 2c 20 73 6f 63 6b 61 64 64 72 2d 3e 73 74 72 69 , sockaddr->stri
0f80: 6e 67 0a 20 20 28 6c 65 74 2a 20 28 28 74 6c 73 ng. (let* ((tls
0f90: 6e 20 28 74 63 70 2d 6c 69 73 74 65 6e 20 70 6f n (tcp-listen po
0fa0: 72 74 20 31 30 30 30 20 23 66 29 29 20 3b 3b 20 rt 1000 #f)) ;;
0fb0: 28 74 63 70 2d 6c 69 73 74 65 6e 20 54 43 50 50 (tcp-listen TCPP
0fc0: 4f 52 54 20 5b 42 41 43 4b 4c 4f 47 20 5b 48 4f ORT [BACKLOG [HO
0fd0: 53 54 5d 5d 29 0a 09 20 28 61 64 64 72 20 28 67 ST]]).. (addr (g
0fe0: 65 74 2d 6d 79 2d 62 65 73 74 2d 61 64 64 72 65 et-my-best-addre
0ff0: 73 73 29 29 29 20 3b 3b 20 28 68 6f 73 74 69 6e ss))) ;; (hostin
1000: 66 6f 2d 61 64 64 72 65 73 73 65 73 20 28 68 6f fo-addresses (ho
1010: 73 74 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 st-information (
1020: 63 75 72 72 65 6e 74 2d 68 6f 73 74 6e 61 6d 65 current-hostname
1030: 29 29 29 0a 20 20 20 20 28 75 64 61 74 2d 70 6f ))). (udat-po
1040: 72 74 2d 73 65 74 21 20 20 20 20 20 20 75 63 6f rt-set! uco
1050: 6e 6e 20 70 6f 72 74 29 0a 20 20 20 20 28 75 64 nn port). (ud
1060: 61 74 2d 68 6f 73 74 2d 70 6f 72 74 2d 73 65 74 at-host-port-set
1070: 21 20 75 63 6f 6e 6e 20 28 63 6f 6e 63 20 61 64 ! uconn (conc ad
1080: 64 72 22 3a 22 70 6f 72 74 29 29 0a 20 20 20 20 dr":"port)).
1090: 28 75 64 61 74 2d 73 6f 63 6b 65 74 2d 73 65 74 (udat-socket-set
10a0: 21 20 20 20 20 75 63 6f 6e 6e 20 74 6c 73 6e 29 ! uconn tlsn)
10b0: 0a 20 20 20 20 75 63 6f 6e 6e 29 29 0a 0a 3b 3b . uconn))..;;
10c0: 20 72 75 6e 2d 6c 69 73 74 65 6e 65 72 20 64 6f run-listener do
10d0: 65 73 20 61 6c 6c 20 74 68 65 20 77 6f 72 6b 20 es all the work
10e0: 6f 66 20 73 74 61 72 74 69 6e 67 20 61 20 6c 69 of starting a li
10f0: 73 74 65 6e 65 72 20 69 6e 20 61 20 74 68 72 65 stener in a thre
1100: 61 64 0a 3b 3b 20 69 74 20 74 68 65 6e 20 72 65 ad.;; it then re
1110: 74 75 72 6e 73 20 63 6f 6e 74 72 6f 6c 0a 3b 3b turns control.;;
1120: 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 6c 69 .(define (run-li
1130: 73 74 65 6e 65 72 20 68 61 6e 64 6c 65 72 2d 70 stener handler-p
1140: 72 6f 63 20 23 21 6f 70 74 69 6f 6e 61 6c 20 28 roc #!optional (
1150: 70 6f 72 74 2d 73 75 67 67 65 73 74 69 6f 6e 20 port-suggestion
1160: 34 32 34 32 29 29 0a 20 20 28 6c 65 74 2a 20 28 4242)). (let* (
1170: 28 75 63 6f 6e 6e 20 28 6d 61 6b 65 2d 75 64 61 (uconn (make-uda
1180: 74 29 29 29 0a 20 20 20 20 28 75 64 61 74 2d 77 t))). (udat-w
1190: 6f 72 6b 2d 70 72 6f 63 2d 73 65 74 21 20 75 63 ork-proc-set! uc
11a0: 6f 6e 6e 20 68 61 6e 64 6c 65 72 2d 70 72 6f 63 onn handler-proc
11b0: 29 0a 20 20 20 20 28 69 66 20 28 73 65 74 75 70 ). (if (setup
11c0: 2d 6c 69 73 74 65 6e 65 72 20 75 63 6f 6e 6e 20 -listener uconn
11d0: 70 6f 72 74 2d 73 75 67 67 65 73 74 69 6f 6e 29 port-suggestion)
11e0: 0a 09 28 28 6d 61 6b 65 2d 74 63 70 2d 73 65 72 ..((make-tcp-ser
11f0: 76 65 72 0a 09 20 20 28 75 64 61 74 2d 73 6f 63 ver.. (udat-soc
1200: 6b 65 74 20 75 63 6f 6e 6e 29 0a 09 20 20 28 6c ket uconn).. (l
1210: 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 28 6c ambda ().. (l
1220: 65 74 2a 20 28 28 72 64 61 74 20 20 28 64 65 73 et* ((rdat (des
1230: 65 72 69 61 6c 69 7a 65 29 29 20 3b 3b 20 27 28 erialize)) ;; '(
1240: 6d 79 2d 68 6f 73 74 2d 70 6f 72 74 20 71 72 79 my-host-port qry
1250: 6b 65 79 20 63 6d 64 20 70 61 72 61 6d 73 29 0a key cmd params).
1260: 09 09 20 20 20 28 72 65 73 70 20 20 28 64 6f 2d .. (resp (do-
1270: 77 6f 72 6b 20 75 63 6f 6e 6e 20 72 64 61 74 29 work uconn rdat)
1280: 29 29 0a 09 20 20 20 20 20 20 28 73 65 72 69 61 )).. (seria
1290: 6c 69 7a 65 20 72 65 73 70 29 29 29 29 29 0a 09 lize resp)))))..
12a0: 28 61 73 73 65 72 74 20 23 66 20 22 45 52 52 4f (assert #f "ERRO
12b0: 52 3a 20 72 75 6e 2d 6c 69 73 74 65 6e 65 72 20 R: run-listener
12c0: 63 61 6c 6c 65 64 20 77 69 74 68 6f 75 74 20 70 called without p
12d0: 72 6f 70 65 72 20 73 65 74 75 70 2e 22 29 29 29 roper setup.")))
12e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 77 61 69 74 )..(define (wait
12f0: 2d 61 6e 64 2d 63 6c 6f 73 65 20 75 63 6f 6e 6e -and-close uconn
1300: 29 0a 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e ). (thread-join
1310: 21 20 28 75 64 61 74 2d 63 6d 64 2d 74 68 72 65 ! (udat-cmd-thre
1320: 61 64 20 75 63 6f 6e 6e 29 29 0a 20 20 28 74 63 ad uconn)). (tc
1330: 70 2d 63 6c 6f 73 65 20 28 75 64 61 74 2d 73 6f p-close (udat-so
1340: 63 6b 65 74 20 75 63 6f 6e 6e 29 29 29 0a 0a 3b cket uconn)))..;
1350: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1390: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 3d 3d 20 3c 3c =======.;; == <<
13a0: 20 3b 3b 20 70 65 65 72 73 20 61 6e 64 20 63 6f ;; peers and co
13b0: 6e 6e 65 63 74 69 6f 6e 73 0a 3b 3b 20 3d 3d 20 nnections.;; ==
13c0: 3c 3c 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d << ;;===========
13d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
1410: 66 69 6e 65 20 2a 73 65 6e 64 2d 6d 75 74 65 78 fine *send-mutex
1420: 2a 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a * (make-mutex)).
1430: 0a 3b 3b 20 73 65 6e 64 20 73 74 72 75 63 74 75 .;; send structu
1440: 72 65 64 20 64 61 74 61 20 74 6f 20 72 65 63 69 red data to reci
1450: 70 69 65 6e 74 0a 3b 3b 0a 3b 3b 20 20 4e 4f 54 pient.;;.;; NOT
1460: 45 3a 20 71 72 79 6b 65 79 20 69 73 20 77 68 61 E: qrykey is wha
1470: 74 20 77 61 73 20 63 61 6c 6c 65 64 20 74 68 65 t was called the
1480: 20 22 63 6f 6f 6b 69 65 22 20 70 72 65 76 69 6f "cookie" previo
1490: 75 73 6c 79 0a 3b 3b 0a 3b 3b 20 20 20 20 20 72 usly.;;.;; r
14a0: 65 74 76 61 6c 20 74 65 6c 6c 73 20 73 65 6e 64 etval tells send
14b0: 20 74 6f 20 65 78 70 65 63 74 20 61 6e 64 20 77 to expect and w
14c0: 61 69 74 20 66 6f 72 20 72 65 74 75 72 6e 20 64 ait for return d
14d0: 61 74 61 20 28 6f 6e 65 20 6c 69 6e 65 29 20 61 ata (one line) a
14e0: 6e 64 20 72 65 74 75 72 6e 20 69 74 20 6f 72 20 nd return it or
14f0: 74 69 6d 65 20 6f 75 74 0a 3b 3b 20 20 20 20 20 time out.;;
1500: 20 20 74 68 69 73 20 69 73 20 66 6f 72 20 70 69 this is for pi
1510: 6e 67 20 77 68 65 72 65 20 77 65 20 64 6f 6e 27 ng where we don'
1520: 74 20 77 61 6e 74 20 74 6f 20 6e 65 63 65 73 73 t want to necess
1530: 61 72 69 6c 79 20 68 61 76 65 20 73 65 74 20 75 arily have set u
1540: 70 20 6f 75 72 20 6f 77 6e 20 73 65 72 76 65 72 p our own server
1550: 20 79 65 74 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 yet..;;.(define
1560: 20 28 73 65 6e 64 2d 72 65 63 65 69 76 65 20 75 (send-receive u
1570: 64 61 74 61 20 68 6f 73 74 2d 70 6f 72 74 20 63 data host-port c
1580: 6d 64 20 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 md params). (le
1590: 74 2a 20 28 28 68 6f 73 74 2d 70 6f 72 74 2d 6c t* ((host-port-l
15a0: 73 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 st (string-split
15b0: 20 68 6f 73 74 2d 70 6f 72 74 20 22 3a 22 29 29 host-port ":"))
15c0: 0a 09 20 28 68 6f 73 74 20 20 20 20 20 20 20 20 .. (host
15d0: 20 20 28 63 61 72 20 68 6f 73 74 2d 70 6f 72 74 (car host-port
15e0: 2d 6c 73 74 29 29 0a 09 20 28 70 6f 72 74 20 20 -lst)).. (port
15f0: 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
1600: 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 68 6f >number (cadr ho
1610: 73 74 2d 70 6f 72 74 2d 6c 73 74 29 29 29 0a 09 st-port-lst)))..
1620: 20 28 6d 79 2d 68 6f 73 74 2d 70 6f 72 74 20 28 (my-host-port (
1630: 61 6e 64 20 75 64 61 74 61 20 28 75 64 61 74 2d and udata (udat-
1640: 68 6f 73 74 2d 70 6f 72 74 20 75 64 61 74 61 29 host-port udata)
1650: 29 29 20 20 20 20 20 20 20 20 20 20 3b 3b 20 72 )) ;; r
1660: 65 6d 6f 74 65 20 77 69 6c 6c 20 72 65 74 75 72 emote will retur
1670: 6e 20 74 6f 20 74 68 69 73 0a 09 20 28 69 73 6d n to this.. (ism
1680: 65 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c e (equal
1690: 3f 20 68 6f 73 74 2d 70 6f 72 74 20 6d 79 2d 68 ? host-port my-h
16a0: 6f 73 74 2d 70 6f 72 74 29 29 20 3b 3b 20 63 61 ost-port)) ;; ca
16b0: 6c 6c 69 6e 67 20 6d 79 73 65 6c 66 3f 0a 09 20 lling myself?..
16c0: 3b 3b 20 64 61 74 20 69 73 20 61 20 73 65 6c 66 ;; dat is a self
16d0: 2d 63 6f 6e 74 61 69 6e 65 64 20 77 6f 72 6b 20 -contained work
16e0: 62 6c 6f 63 6b 20 74 68 61 74 20 63 61 6e 20 62 block that can b
16f0: 65 20 73 65 6e 74 20 6f 72 20 68 61 6e 64 6c 65 e sent or handle
1700: 64 20 6c 6f 63 61 6c 6c 79 0a 09 20 28 64 61 74 d locally.. (dat
1710: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 (list
1720: 6d 79 2d 68 6f 73 74 2d 70 6f 72 74 20 27 71 72 my-host-port 'qr
1730: 79 6b 65 79 20 63 6d 64 20 70 61 72 61 6d 73 20 ykey cmd params
1740: 23 3b 28 63 6f 6e 73 20 28 63 75 72 72 65 6e 74 #;(cons (current
1750: 2d 73 65 63 6f 6e 64 73 29 28 63 75 72 72 65 6e -seconds)(curren
1760: 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 t-milliseconds))
1770: 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 ))). (cond.
1780: 20 20 20 28 69 73 6d 65 20 28 64 6f 2d 77 6f 72 (isme (do-wor
1790: 6b 20 75 64 61 74 61 20 64 61 74 29 29 20 3b 3b k udata dat)) ;;
17a0: 20 6e 6f 20 74 72 61 6e 73 6d 69 73 73 69 6f 6e no transmission
17b0: 20 6e 65 65 64 65 64 0a 20 20 20 20 20 28 65 6c needed. (el
17c0: 73 65 0a 20 20 20 20 20 20 28 68 61 6e 64 6c 65 se. (handle
17d0: 2d 65 78 63 65 70 74 69 6f 6e 73 20 3b 3b 20 54 -exceptions ;; T
17e0: 4f 44 4f 20 2d 20 4d 41 4b 45 20 54 48 49 53 20 ODO - MAKE THIS
17f0: 45 58 43 45 50 54 49 4f 4e 20 43 4d 44 20 53 50 EXCEPTION CMD SP
1800: 45 43 49 46 49 43 3f 0a 09 20 20 65 78 6e 0a 09 ECIFIC?.. exn..
1810: 20 20 28 6d 65 73 73 61 67 65 20 65 78 6e 29 0a (message exn).
1820: 09 28 62 65 67 69 6e 0a 09 20 20 3b 3b 20 28 6d .(begin.. ;; (m
1830: 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 73 65 6e 64 utex-lock! *send
1840: 2d 6d 75 74 65 78 2a 29 20 3b 3b 20 44 4f 45 53 -mutex*) ;; DOES
1850: 4e 27 54 20 53 45 45 4d 20 54 4f 20 48 45 4c 50 N'T SEEM TO HELP
1860: 0a 09 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 .. (let-values
1870: 28 28 28 69 6e 70 20 6f 75 70 29 28 74 63 70 2d (((inp oup)(tcp-
1880: 63 6f 6e 6e 65 63 74 20 68 6f 73 74 20 70 6f 72 connect host por
1890: 74 29 29 29 0a 09 20 20 20 20 28 6c 65 74 20 28 t))).. (let (
18a0: 28 72 65 73 20 28 69 66 20 28 61 6e 64 20 69 6e (res (if (and in
18b0: 70 20 6f 75 70 29 0a 09 09 09 20 20 20 28 62 65 p oup).... (be
18c0: 67 69 6e 0a 09 09 09 20 20 20 20 20 28 73 65 72 gin.... (ser
18d0: 69 61 6c 69 7a 65 20 64 61 74 20 6f 75 70 29 0a ialize dat oup).
18e0: 09 09 09 20 20 20 20 20 28 63 6c 6f 73 65 2d 6f ... (close-o
18f0: 75 74 70 75 74 2d 70 6f 72 74 20 6f 75 70 29 0a utput-port oup).
1900: 09 09 09 20 20 20 20 20 28 64 65 73 65 72 69 61 ... (deseria
1910: 6c 69 7a 65 20 69 6e 70 29 29 0a 09 09 09 20 20 lize inp))....
1920: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 (begin....
1930: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 73 (print "ERROR: s
1940: 65 6e 64 20 63 61 6c 6c 65 64 20 62 75 74 20 6e end called but n
1950: 6f 20 72 65 63 65 69 76 65 72 20 68 61 73 20 62 o receiver has b
1960: 65 65 6e 20 73 65 74 75 70 2e 20 50 6c 65 61 73 een setup. Pleas
1970: 65 20 63 61 6c 6c 20 73 65 74 75 70 20 66 69 72 e call setup fir
1980: 73 74 21 22 29 0a 09 09 09 20 20 20 20 20 23 66 st!").... #f
1990: 29 29 29 29 0a 09 20 20 20 20 20 20 28 63 6c 6f )))).. (clo
19a0: 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e se-input-port in
19b0: 70 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 6d 75 p).. ;; (mu
19c0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 73 65 6e tex-unlock! *sen
19d0: 64 2d 6d 75 74 65 78 2a 29 20 3b 3b 20 44 4f 45 d-mutex*) ;; DOE
19e0: 53 4e 27 54 20 53 45 45 4d 20 54 4f 20 48 45 4c SN'T SEEM TO HEL
19f0: 50 0a 09 20 20 20 20 20 20 72 65 73 29 29 29 29 P.. res))))
1a00: 29 29 29 29 20 3b 3b 20 72 65 73 20 77 69 6c 6c )))) ;; res will
1a10: 20 61 6c 77 61 79 73 20 62 65 20 27 61 63 6b 20 always be 'ack
1a20: 75 6e 6c 65 73 73 20 72 65 74 75 72 6e 2d 6d 65 unless return-me
1a30: 74 68 6f 64 20 69 73 20 64 69 72 65 63 74 0a 0a thod is direct..
1a40: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
1a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a80: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 77 6f 72 6b ========.;; work
1a90: 20 71 75 65 75 65 73 20 2d 20 74 68 69 73 20 69 queues - this i
1aa0: 73 20 61 6c 6c 20 68 61 70 70 65 6e 69 6e 67 20 s all happening
1ab0: 6f 6e 20 74 68 65 20 6c 69 73 74 65 6e 65 72 20 on the listener
1ac0: 73 69 64 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d side.;;=========
1ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
1b10: 3b 20 6d 6f 76 65 20 74 68 65 20 6c 6f 67 69 63 ; move the logic
1b20: 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 72 to return the r
1b30: 65 73 75 6c 74 20 73 6f 6d 65 77 68 65 72 65 20 esult somewhere
1b40: 65 6c 73 65 3f 0a 3b 3b 0a 28 64 65 66 69 6e 65 else?.;;.(define
1b50: 20 28 64 6f 2d 77 6f 72 6b 20 75 63 6f 6e 6e 20 (do-work uconn
1b60: 72 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 29 rdat). (let* ()
1b70: 20 3b 3b 20 67 65 74 20 69 74 20 65 61 63 68 20 ;; get it each
1b80: 74 69 6d 65 20 2d 20 63 6f 6e 63 65 69 76 65 62 time - conceiveb
1b90: 6c 79 20 69 74 20 63 6f 75 6c 64 20 63 68 61 6e ly it could chan
1ba0: 67 65 0a 20 20 20 20 3b 3b 20 70 75 74 20 74 68 ge. ;; put th
1bb0: 69 73 20 66 6f 6c 6c 6f 77 69 6e 67 20 69 6e 74 is following int
1bc0: 6f 20 61 20 64 6f 2d 77 6f 72 6b 20 70 72 6f 63 o a do-work proc
1bd0: 65 64 75 72 65 0a 20 20 20 20 28 6d 61 74 63 68 edure. (match
1be0: 20 72 64 61 74 0a 20 20 20 20 20 20 28 28 72 65 rdat. ((re
1bf0: 6d 2d 68 6f 73 74 2d 70 6f 72 74 20 71 72 79 6b m-host-port qryk
1c00: 65 79 20 63 6d 64 20 70 61 72 61 6d 73 29 0a 20 ey cmd params).
1c10: 20 20 20 20 20 20 28 63 61 73 65 20 63 6d 64 0a (case cmd.
1c20: 09 20 28 28 70 69 6e 67 29 20 27 70 69 6e 67 2d . ((ping) 'ping-
1c30: 61 63 6b 29 20 3b 3b 20 62 79 70 61 73 73 20 63 ack) ;; bypass c
1c40: 61 6c 6c 69 6e 67 20 74 68 65 20 70 72 6f 63 0a alling the proc.
1c50: 09 20 28 65 6c 73 65 0a 09 20 20 28 6c 65 74 2a . (else.. (let*
1c60: 20 28 28 70 72 6f 63 20 20 20 20 20 20 20 28 75 ((proc (u
1c70: 64 61 74 2d 77 6f 72 6b 2d 70 72 6f 63 20 75 63 dat-work-proc uc
1c80: 6f 6e 6e 29 29 0a 09 09 20 28 73 74 61 72 74 2d onn))... (start-
1c90: 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 6d 69 time (current-mi
1ca0: 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 09 20 lliseconds))...
1cb0: 28 72 65 73 75 6c 74 20 20 20 20 20 28 70 72 6f (result (pro
1cc0: 63 20 72 65 6d 2d 68 6f 73 74 2d 70 6f 72 74 20 c rem-host-port
1cd0: 71 72 79 6b 65 79 20 63 6d 64 20 70 61 72 61 6d qrykey cmd param
1ce0: 73 29 29 0a 09 09 20 28 65 6e 64 2d 74 69 6d 65 s))... (end-time
1cf0: 20 20 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c (current-mill
1d00: 69 73 65 63 6f 6e 64 73 29 29 0a 09 09 20 28 72 iseconds))... (r
1d10: 75 6e 2d 74 69 6d 65 20 20 20 28 2d 20 65 6e 64 un-time (- end
1d20: 2d 74 69 6d 65 20 73 74 61 72 74 2d 74 69 6d 65 -time start-time
1d30: 29 29 29 0a 09 20 20 20 20 72 65 73 75 6c 74 29 ))).. result)
1d40: 29 29 29 0a 20 20 20 20 20 20 28 65 6c 73 65 0a ))). (else.
1d50: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 (print "E
1d60: 52 52 4f 52 3a 20 72 64 61 74 20 22 72 64 61 74 RROR: rdat "rdat
1d70: 22 2c 20 64 69 64 20 6e 6f 74 20 6d 61 74 63 68 ", did not match
1d80: 20 72 65 6d 2d 68 6f 73 74 2d 70 6f 72 74 20 71 rem-host-port q
1d90: 72 79 6b 65 79 20 63 6d 64 20 70 61 72 61 6d 73 rykey cmd params
1da0: 22 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ")))))..;;======
1db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1df0: 0a 3b 3b 20 6d 69 73 63 20 75 74 69 6c 73 0a 3b .;; misc utils.;
1e00: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e40: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
1e50: 20 28 70 70 2d 75 63 6f 6e 6e 20 75 63 6f 6e 6e (pp-uconn uconn
1e60: 29 0a 20 20 28 70 70 20 28 75 64 61 74 2d 3e 61 ). (pp (udat->a
1e70: 6c 69 73 74 20 75 63 6f 6e 6e 29 29 29 0a 0a 3b list uconn)))..;
1e80: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ec0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6e 65 74 77 6f =======.;; netwo
1ed0: 72 6b 20 75 74 69 6c 69 74 69 65 73 0a 3b 3b 3d rk utilities.;;=
1ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f20: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 =====..;; NOTE:
1f30: 4c 6f 6f 6b 20 61 74 20 61 64 64 72 65 73 73 2d Look at address-
1f40: 69 6e 66 6f 20 65 67 67 20 61 73 20 61 6c 74 65 info egg as alte
1f50: 72 6e 61 74 69 76 65 20 74 6f 20 73 6f 6d 65 20 rnative to some
1f60: 6f 66 20 74 68 69 73 0a 0a 28 64 65 66 69 6e 65 of this..(define
1f70: 20 28 72 61 74 65 2d 69 70 20 69 70 61 64 64 72 (rate-ip ipaddr
1f80: 29 0a 20 20 28 72 65 67 65 78 2d 63 61 73 65 20 ). (regex-case
1f90: 69 70 61 64 64 72 0a 20 20 20 20 28 20 22 5e 31 ipaddr. ( "^1
1fa0: 32 37 5c 5c 2e 2e 2a 22 20 5f 20 30 20 29 0a 20 27\\..*" _ 0 ).
1fb0: 20 20 20 28 20 22 5e 28 31 30 5c 5c 2e 30 7c 31 ( "^(10\\.0|1
1fc0: 39 32 5c 5c 2e 31 36 38 29 5c 5c 2e 2e 2a 22 20 92\\.168)\\..*"
1fd0: 5f 20 31 20 29 0a 20 20 20 20 28 20 65 6c 73 65 _ 1 ). ( else
1fe0: 20 32 20 29 20 29 29 0a 0a 3b 3b 20 43 68 61 6e 2 ) ))..;; Chan
1ff0: 67 65 20 74 68 69 73 20 74 6f 20 62 69 61 73 20 ge this to bias
2000: 66 6f 72 20 61 64 64 72 65 73 73 65 73 20 77 69 for addresses wi
2010: 74 68 20 61 20 72 65 61 73 6f 6e 61 62 6c 65 20 th a reasonable
2020: 62 72 6f 61 64 63 61 73 74 20 76 61 6c 75 65 3f broadcast value?
2030: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 69 70 2d .;;.(define (ip-
2040: 70 72 65 66 2d 6c 65 73 73 3f 20 61 20 62 29 0a pref-less? a b).
2050: 20 20 28 3e 20 28 72 61 74 65 2d 69 70 20 61 29 (> (rate-ip a)
2060: 20 28 72 61 74 65 2d 69 70 20 62 29 29 29 0a 0a (rate-ip b)))..
2070: 28 64 65 66 69 6e 65 20 28 67 65 74 2d 6d 79 2d (define (get-my-
2080: 62 65 73 74 2d 61 64 64 72 65 73 73 29 0a 20 20 best-address).
2090: 28 6c 65 74 20 28 28 61 6c 6c 2d 6d 79 2d 61 64 (let ((all-my-ad
20a0: 64 72 65 73 73 65 73 20 28 67 65 74 2d 61 6c 6c dresses (get-all
20b0: 2d 69 70 73 29 29 29 0a 20 20 20 20 28 63 6f 6e -ips))). (con
20c0: 64 0a 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 61 d. ((null? a
20d0: 6c 6c 2d 6d 79 2d 61 64 64 72 65 73 73 65 73 29 ll-my-addresses)
20e0: 0a 20 20 20 20 20 20 28 67 65 74 2d 68 6f 73 74 . (get-host
20f0: 2d 6e 61 6d 65 29 29 20 20 20 20 20 20 20 20 20 -name))
2100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2120: 20 3b 3b 20 6e 6f 20 69 6e 74 65 72 66 61 63 65 ;; no interface
2130: 73 3f 0a 20 20 20 20 20 28 28 65 71 3f 20 28 6c s?. ((eq? (l
2140: 65 6e 67 74 68 20 61 6c 6c 2d 6d 79 2d 61 64 64 ength all-my-add
2150: 72 65 73 73 65 73 29 20 31 29 0a 20 20 20 20 20 resses) 1).
2160: 20 28 63 61 72 20 61 6c 6c 2d 6d 79 2d 61 64 64 (car all-my-add
2170: 72 65 73 73 65 73 29 29 20 20 20 20 20 20 20 20 resses))
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
2190: 20 6f 6e 6c 79 20 6f 6e 65 20 74 6f 20 63 68 6f only one to cho
21a0: 6f 73 65 20 66 72 6f 6d 2c 20 6a 75 73 74 20 67 ose from, just g
21b0: 6f 20 77 69 74 68 20 69 74 0a 20 20 20 20 20 28 o with it. (
21c0: 65 6c 73 65 0a 20 20 20 20 20 20 28 63 61 72 20 else. (car
21d0: 28 73 6f 72 74 20 61 6c 6c 2d 6d 79 2d 61 64 64 (sort all-my-add
21e0: 72 65 73 73 65 73 20 69 70 2d 70 72 65 66 2d 6c resses ip-pref-l
21f0: 65 73 73 3f 29 29 29 29 29 29 0a 0a 28 64 65 66 ess?))))))..(def
2200: 69 6e 65 20 28 67 65 74 2d 61 6c 6c 2d 69 70 73 ine (get-all-ips
2210: 2d 73 6f 72 74 65 64 29 0a 20 20 28 73 6f 72 74 -sorted). (sort
2220: 20 28 67 65 74 2d 61 6c 6c 2d 69 70 73 29 20 69 (get-all-ips) i
2230: 70 2d 70 72 65 66 2d 6c 65 73 73 3f 29 29 0a 0a p-pref-less?))..
2240: 28 64 65 66 69 6e 65 20 28 67 65 74 2d 61 6c 6c (define (get-all
2250: 2d 69 70 73 29 0a 20 20 28 6d 61 70 20 61 64 64 -ips). (map add
2260: 72 65 73 73 2d 69 6e 66 6f 2d 68 6f 73 74 0a 20 ress-info-host.
2270: 20 20 20 20 20 20 28 66 69 6c 74 65 72 20 28 6c (filter (l
2280: 61 6d 62 64 61 20 28 78 29 0a 09 09 20 28 65 71 ambda (x)... (eq
2290: 75 61 6c 3f 20 28 61 64 64 72 65 73 73 2d 69 6e ual? (address-in
22a0: 66 6f 2d 74 79 70 65 20 78 29 20 22 74 63 70 22 fo-type x) "tcp"
22b0: 29 29 0a 09 20 20 20 20 20 20 20 28 61 64 64 72 )).. (addr
22c0: 65 73 73 2d 69 6e 66 6f 73 20 28 67 65 74 2d 68 ess-infos (get-h
22d0: 6f 73 74 2d 6e 61 6d 65 29 29 29 29 29 0a 0a 29 ost-name)))))..)
22e0: 0a .