0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 37 2c right 2006-2017,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;.;;===========
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
0390: 65 20 66 6f 72 6d 61 74 20 74 79 70 65 64 2d 72 e format typed-r
03a0: 65 63 6f 72 64 73 29 20 3b 3b 20 52 41 44 54 20 ecords) ;; RADT
03b0: 3d 3e 20 70 75 72 70 6f 73 65 20 6f 66 20 6a 73 => purpose of js
03c0: 6f 6e 20 66 6f 72 6d 61 74 3f 3f 0a 0a 28 64 65 on format??..(de
03d0: 63 6c 61 72 65 20 28 75 6e 69 74 20 72 6d 74 29 clare (unit rmt)
03e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03f0: 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 65 20 api)).(declare
0400: 28 75 73 65 73 20 68 74 74 70 2d 74 72 61 6e 73 (uses http-trans
0410: 70 6f 72 74 29 29 0a 28 69 6e 63 6c 75 64 65 20 port)).(include
0420: 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e "common_records.
0430: 73 63 6d 22 29 0a 3b 3b 20 28 64 65 63 6c 61 72 scm").;; (declar
0440: 65 20 28 75 73 65 73 20 72 6d 74 6d 6f 64 29 29 e (uses rmtmod))
0450: 0a 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 72 6d 74 ..;; (import rmt
0460: 6d 6f 64 29 0a 0a 3b 3b 0a 3b 3b 20 54 48 45 53 mod)..;;.;; THES
0470: 45 20 41 52 45 20 41 4c 4c 20 43 41 4c 4c 45 44 E ARE ALL CALLED
0480: 20 4f 4e 20 54 48 45 20 43 4c 49 45 4e 54 20 53 ON THE CLIENT S
0490: 49 44 45 21 21 21 0a 3b 3b 0a 0a 3b 3b 20 67 65 IDE!!!.;;..;; ge
04a0: 6e 65 72 61 74 65 20 65 6e 74 72 69 65 73 20 66 nerate entries f
04b0: 6f 72 20 7e 2f 2e 6d 65 67 61 74 65 73 74 72 63 or ~/.megatestrc
04c0: 20 77 69 74 68 20 74 68 65 20 66 6f 6c 6c 6f 77 with the follow
04d0: 69 6e 67 0a 3b 3b 0a 3b 3b 20 20 67 72 65 70 20 ing.;;.;; grep
04e0: 64 65 66 69 6e 65 20 2e 2e 2f 72 6d 74 2e 73 63 define ../rmt.sc
04f0: 6d 20 7c 20 67 72 65 70 20 72 6d 74 3a 20 7c 70 m | grep rmt: |p
0500: 65 72 6c 20 2d 70 69 20 2d 65 20 27 73 2f 5c 28 erl -pi -e 's/\(
0510: 64 65 66 69 6e 65 5c 73 2b 5c 28 28 5c 53 2b 29 define\s+\((\S+)
0520: 5c 57 2e 2a 24 2f 5c 31 2f 27 7c 73 6f 72 74 20 \W.*$/\1/'|sort
0530: 2d 75 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d -u..;;==========
0540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
0580: 20 53 20 55 20 50 20 50 20 4f 20 52 20 54 20 20 S U P P O R T
0590: 20 46 20 55 20 4e 20 43 20 54 20 49 20 4f 20 4e F U N C T I O N
05a0: 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;===========
05b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
05f0: 69 66 20 61 20 73 65 72 76 65 72 20 69 73 20 65 if a server is e
0600: 69 74 68 65 72 20 72 75 6e 6e 69 6e 67 20 6f 72 ither running or
0610: 20 69 6e 20 74 68 65 20 70 72 6f 63 65 73 73 20 in the process
0620: 6f 66 20 73 74 61 72 74 69 6e 67 20 63 61 6c 6c of starting call
0630: 20 63 6c 69 65 6e 74 3a 73 65 74 75 70 0a 3b 3b client:setup.;;
0640: 20 65 6c 73 65 20 72 65 74 75 72 6e 20 23 66 20 else return #f
0650: 74 6f 20 6c 65 74 20 74 68 65 20 63 61 6c 6c 69 to let the calli
0660: 6e 67 20 70 72 6f 63 20 6b 6e 6f 77 20 74 68 61 ng proc know tha
0670: 74 20 74 68 65 72 65 20 69 73 20 6e 6f 20 73 65 t there is no se
0680: 72 76 65 72 20 61 76 61 69 6c 61 62 6c 65 0a 3b rver available.;
0690: 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ;.(define (rmt:g
06a0: 65 74 2d 63 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e et-connection-in
06b0: 66 6f 20 61 72 65 61 70 61 74 68 20 23 21 6b 65 fo areapath #!ke
06c0: 79 20 28 61 72 65 61 2d 64 61 74 20 23 66 29 29 y (area-dat #f))
06d0: 20 3b 3b 20 54 4f 44 4f 3a 20 70 75 73 68 20 61 ;; TODO: push a
06e0: 72 65 61 70 61 74 68 20 64 6f 77 6e 2e 0a 20 20 reapath down..
06f0: 28 6c 65 74 2a 20 28 28 72 75 6e 72 65 6d 6f 74 (let* ((runremot
0700: 65 20 28 6f 72 20 61 72 65 61 2d 64 61 74 20 2a e (or area-dat *
0710: 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 09 20 28 runremote*)).. (
0720: 63 69 6e 66 6f 20 20 20 20 20 28 69 66 20 28 72 cinfo (if (r
0730: 65 6d 6f 74 65 3f 20 72 75 6e 72 65 6d 6f 74 65 emote? runremote
0740: 29 0a 09 09 09 28 72 65 6d 6f 74 65 2d 63 6f 6e )....(remote-con
0750: 6e 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 0a ndat runremote).
0760: 09 09 09 23 66 29 29 29 0a 09 20 20 28 69 66 20 ...#f))).. (if
0770: 63 69 6e 66 6f 0a 09 20 20 20 20 20 20 63 69 6e cinfo.. cin
0780: 66 6f 0a 09 20 20 20 20 20 20 28 69 66 20 28 73 fo.. (if (s
0790: 65 72 76 65 72 3a 63 68 65 63 6b 2d 69 66 2d 72 erver:check-if-r
07a0: 75 6e 6e 69 6e 67 20 61 72 65 61 70 61 74 68 29 unning areapath)
07b0: 0a 09 09 20 20 28 63 6c 69 65 6e 74 3a 73 65 74 ... (client:set
07c0: 75 70 20 61 72 65 61 70 61 74 68 29 0a 09 09 20 up areapath)...
07d0: 20 23 66 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 #f))))..(define
07e0: 20 2a 73 65 6e 64 2d 72 65 63 65 69 76 65 2d 6d *send-receive-m
07f0: 75 74 65 78 2a 20 28 6d 61 6b 65 2d 6d 75 74 65 utex* (make-mute
0800: 78 29 29 20 3b 3b 20 73 68 6f 75 6c 64 20 68 61 x)) ;; should ha
0810: 76 65 20 73 65 70 61 72 61 74 65 20 6d 75 74 65 ve separate mute
0820: 78 20 70 65 72 20 72 75 6e 2d 69 64 0a 0a 3b 3b x per run-id..;;
0830: 20 52 41 20 3d 3e 20 65 2e 67 2e 20 75 73 61 67 RA => e.g. usag
0840: 65 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 e (rmt:send-rece
0850: 69 76 65 20 27 67 65 74 2d 76 61 72 20 23 66 20 ive 'get-var #f
0860: 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 29 29 0a (list varname)).
0870: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a ;;.(define (rmt:
0880: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 63 6d 64 send-receive cmd
0890: 20 72 69 64 20 70 61 72 61 6d 73 20 23 21 6b 65 rid params #!ke
08a0: 79 20 28 61 74 74 65 6d 70 74 6e 75 6d 20 31 29 y (attemptnum 1)
08b0: 28 61 72 65 61 2d 64 61 74 20 23 66 29 29 20 3b (area-dat #f)) ;
08c0: 3b 20 73 74 61 72 74 20 61 74 74 65 6d 70 74 6e ; start attemptn
08d0: 75 6d 20 61 74 20 31 20 73 6f 20 74 68 65 20 6d um at 1 so the m
08e0: 6f 64 75 6c 6f 20 62 65 6c 6f 77 20 77 6f 72 6b odulo below work
08f0: 73 20 61 73 20 65 78 70 65 63 74 65 64 0a 0a 20 s as expected..
0900: 20 23 3b 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d #;(common:telem
0910: 65 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 etry-log (conc "
0920: 72 6d 74 3a 22 28 2d 3e 73 74 72 69 6e 67 20 63 rmt:"(->string c
0930: 6d 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 md)).
0940: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 79 pay
0950: 6c 6f 61 64 3a 20 60 28 28 72 69 64 20 2e 20 2c load: `((rid . ,
0960: 72 69 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 rid).
0970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0980: 20 20 20 20 20 20 20 20 28 70 61 72 61 6d 73 20 (params
0990: 2e 20 2c 70 61 72 61 6d 73 29 29 29 0a 20 20 20 . ,params))).
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09b0: 20 20 20 20 20 20 20 0a 20 20 28 69 66 20 28 3e . (if (>
09c0: 20 61 74 74 65 6d 70 74 6e 75 6d 20 32 29 0a 20 attemptnum 2).
09d0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
09e0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
09f0: 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 61 74 -port* "INFO: at
0a00: 74 65 6d 70 74 6e 75 6d 20 69 6e 20 72 6d 74 3a temptnum in rmt:
0a10: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 69 73 20 send-receive is
0a20: 22 20 61 74 74 65 6d 70 74 6e 75 6d 29 29 0a 20 " attemptnum)).
0a30: 20 20 20 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 . (cond. (
0a40: 28 3e 20 61 74 74 65 6d 70 74 6e 75 6d 20 32 29 (> attemptnum 2)
0a50: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
0a60: 30 2e 30 35 29 29 0a 20 20 20 28 28 3e 20 61 74 0.05)). ((> at
0a70: 74 65 6d 70 74 6e 75 6d 20 31 30 29 20 28 74 68 temptnum 10) (th
0a80: 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 35 29 read-sleep! 0.5)
0a90: 29 0a 20 20 20 28 28 3e 20 61 74 74 65 6d 70 74 ). ((> attempt
0aa0: 6e 75 6d 20 32 30 29 20 28 74 68 72 65 61 64 2d num 20) (thread-
0ab0: 73 6c 65 65 70 21 20 31 29 29 29 0a 20 20 28 69 sleep! 1))). (i
0ac0: 66 20 28 61 6e 64 20 28 3e 20 61 74 74 65 6d 70 f (and (> attemp
0ad0: 74 6e 75 6d 20 35 29 20 28 3d 20 30 20 28 6d 6f tnum 5) (= 0 (mo
0ae0: 64 75 6c 6f 20 61 74 74 65 6d 70 74 6e 75 6d 20 dulo attemptnum
0af0: 31 35 29 29 29 20 20 0a 20 20 20 20 28 62 65 67 15))) . (beg
0b00: 69 6e 20 28 73 65 72 76 65 72 3a 72 75 6e 20 2a in (server:run *
0b10: 74 6f 70 70 61 74 68 2a 29 20 28 74 68 72 65 61 toppath*) (threa
0b20: 64 2d 73 6c 65 65 70 21 20 33 29 29 29 20 0a 20 d-sleep! 3))) .
0b30: 20 0a 20 20 0a 20 20 3b 3b 44 4f 54 20 64 69 67 . . ;;DOT dig
0b40: 72 61 70 68 20 6d 65 67 61 74 65 73 74 5f 73 74 raph megatest_st
0b50: 61 74 65 5f 73 74 61 74 75 73 20 7b 0a 20 20 3b ate_status {. ;
0b60: 3b 44 4f 54 20 20 20 72 61 6e 6b 73 65 70 3d 30 ;DOT ranksep=0
0b70: 3b 0a 20 20 3b 3b 44 4f 54 20 20 20 2f 2f 20 72 ;. ;;DOT // r
0b80: 61 6e 6b 64 69 72 3d 4c 52 3b 0a 20 20 3b 3b 44 ankdir=LR;. ;;D
0b90: 4f 54 20 20 20 6e 6f 64 65 20 5b 73 68 61 70 65 OT node [shape
0ba0: 3d 22 62 6f 78 22 5d 3b 0a 20 20 3b 3b 44 4f 54 ="box"];. ;;DOT
0bb0: 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 "rmt:send-recei
0bc0: 76 65 22 20 2d 3e 20 4d 55 54 45 58 4c 4f 43 4b ve" -> MUTEXLOCK
0bd0: 3b 0a 20 20 3b 3b 44 4f 54 20 7b 20 65 64 67 65 ;. ;;DOT { edge
0be0: 20 5b 73 74 79 6c 65 3d 69 6e 76 69 73 5d 3b 22 [style=invis];"
0bf0: 63 61 73 65 20 31 22 20 2d 3e 20 22 63 61 73 65 case 1" -> "case
0c00: 20 32 22 20 2d 3e 20 22 63 61 73 65 20 33 22 20 2" -> "case 3"
0c10: 2d 3e 20 22 63 61 73 65 20 34 22 20 2d 3e 20 22 -> "case 4" -> "
0c20: 63 61 73 65 20 35 22 20 2d 3e 20 22 63 61 73 65 case 5" -> "case
0c30: 20 36 22 20 2d 3e 20 22 63 61 73 65 20 37 22 20 6" -> "case 7"
0c40: 2d 3e 20 22 63 61 73 65 20 38 22 20 2d 3e 20 22 -> "case 8" -> "
0c50: 63 61 73 65 20 39 22 20 2d 3e 20 22 63 61 73 65 case 9" -> "case
0c60: 20 31 30 22 20 2d 3e 20 22 63 61 73 65 20 31 31 10" -> "case 11
0c70: 22 3b 20 7d 0a 20 20 3b 3b 20 64 6f 20 61 6c 6c "; }. ;; do all
0c80: 20 74 68 65 20 70 72 65 70 20 6c 6f 63 6b 65 64 the prep locked
0c90: 20 75 6e 64 65 72 20 74 68 65 20 72 6d 74 2d 6d under the rmt-m
0ca0: 75 74 65 78 0a 20 20 28 6d 75 74 65 78 2d 6c 6f utex. (mutex-lo
0cb0: 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 ck! *rmt-mutex*)
0cc0: 0a 20 20 0a 20 20 3b 3b 20 31 2e 20 63 68 65 63 . . ;; 1. chec
0cd0: 6b 20 69 66 20 73 65 72 76 65 72 20 69 73 20 73 k if server is s
0ce0: 74 61 72 74 65 64 20 49 46 46 20 63 6d 64 20 69 tarted IFF cmd i
0cf0: 73 20 61 20 77 72 69 74 65 20 4f 52 20 69 66 20 s a write OR if
0d00: 77 65 20 61 72 65 20 6e 6f 74 20 6f 6e 20 74 68 we are not on th
0d10: 65 20 68 6f 6d 65 68 6f 73 74 2c 20 73 74 6f 72 e homehost, stor
0d20: 65 20 69 6e 20 72 75 6e 72 65 6d 6f 74 65 0a 20 e in runremote.
0d30: 20 3b 3b 20 32 2e 20 63 68 65 63 6b 20 74 68 65 ;; 2. check the
0d40: 20 61 67 65 20 6f 66 20 74 68 65 20 63 6f 6e 6e age of the conn
0d50: 65 63 74 69 6f 6e 73 2e 20 72 65 66 72 65 73 68 ections. refresh
0d60: 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 the connection
0d70: 69 66 20 69 74 20 69 73 20 6f 6c 64 65 72 20 74 if it is older t
0d80: 68 61 6e 20 74 69 6d 65 6f 75 74 2d 32 30 20 73 han timeout-20 s
0d90: 65 63 6f 6e 64 73 2e 0a 20 20 3b 3b 20 33 2e 20 econds.. ;; 3.
0da0: 64 6f 20 74 68 65 20 71 75 65 72 79 2c 20 69 66 do the query, if
0db0: 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 20 75 73 65 on homehost use
0dc0: 20 6c 6f 63 61 6c 20 61 63 63 65 73 73 0a 20 20 local access.
0dd0: 3b 3b 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 ;;. (let* ((sta
0de0: 72 74 2d 74 69 6d 65 20 20 20 20 28 63 75 72 72 rt-time (curr
0df0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b ent-seconds)) ;;
0e00: 20 73 6e 61 70 73 68 6f 74 20 74 69 6d 65 20 73 snapshot time s
0e10: 6f 20 61 6c 6c 20 75 73 65 20 63 61 73 65 73 20 o all use cases
0e20: 67 65 74 20 73 61 6d 65 20 76 61 6c 75 65 0a 20 get same value.
0e30: 20 20 20 20 20 20 20 20 28 61 72 65 61 70 61 74 (areapat
0e40: 68 20 20 20 20 20 20 2a 74 6f 70 70 61 74 68 2a h *toppath*
0e50: 29 3b 3b 20 54 4f 44 4f 20 2d 20 72 65 73 6f 6c );; TODO - resol
0e60: 76 65 20 66 72 6f 6d 20 64 62 73 74 72 75 63 74 ve from dbstruct
0e70: 20 74 6f 20 62 65 20 63 6f 6d 70 61 74 69 62 6c to be compatibl
0e80: 65 20 77 69 74 68 20 6d 75 6c 74 69 70 6c 65 20 e with multiple
0e90: 61 72 65 61 73 0a 09 20 28 72 75 6e 72 65 6d 6f areas.. (runremo
0ea0: 74 65 20 20 20 20 20 28 6f 72 20 61 72 65 61 2d te (or area-
0eb0: 64 61 74 0a 09 09 09 20 20 20 20 2a 72 75 6e 72 dat.... *runr
0ec0: 65 6d 6f 74 65 2a 29 29 0a 20 20 20 20 20 20 20 emote*)).
0ed0: 20 20 28 61 74 74 65 6d 70 74 6e 75 6d 20 20 20 (attemptnum
0ee0: 20 28 2b 20 31 20 61 74 74 65 6d 70 74 6e 75 6d (+ 1 attemptnum
0ef0: 29 29 0a 09 20 28 72 65 61 64 6f 6e 6c 79 2d 6d )).. (readonly-m
0f00: 6f 64 65 20 28 72 6d 74 6d 6f 64 3a 63 61 6c 63 ode (rmtmod:calc
0f10: 2d 72 6f 2d 6d 6f 64 65 20 72 75 6e 72 65 6d 6f -ro-mode runremo
0f20: 74 65 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 0a te *toppath*))).
0f30: 0a 20 20 20 20 3b 3b 20 44 4f 54 20 49 4e 49 54 . ;; DOT INIT
0f40: 5f 52 55 4e 52 45 4d 4f 54 45 3b 20 2f 2f 20 6c _RUNREMOTE; // l
0f50: 65 61 76 69 6e 67 20 6f 66 66 20 2d 20 64 6f 65 eaving off - doe
0f60: 73 6e 27 74 20 72 65 61 6c 6c 79 20 61 64 64 20 sn't really add
0f70: 74 6f 20 74 68 65 20 63 6c 61 72 69 74 79 0a 20 to the clarity.
0f80: 20 20 20 3b 3b 20 44 4f 54 20 4d 55 54 45 58 4c ;; DOT MUTEXL
0f90: 4f 43 4b 20 2d 3e 20 49 4e 49 54 5f 52 55 4e 52 OCK -> INIT_RUNR
0fa0: 45 4d 4f 54 45 20 5b 6c 61 62 65 6c 3d 22 6e 6f EMOTE [label="no
0fb0: 20 72 65 6d 6f 74 65 3f 22 5d 3b 0a 20 20 20 20 remote?"];.
0fc0: 3b 3b 20 44 4f 54 20 49 4e 49 54 5f 52 55 4e 52 ;; DOT INIT_RUNR
0fd0: 45 4d 4f 54 45 20 2d 3e 20 4d 55 54 45 58 4c 4f EMOTE -> MUTEXLO
0fe0: 43 4b 3b 0a 20 20 20 20 3b 3b 20 65 6e 73 75 72 CK;. ;; ensur
0ff0: 65 20 77 65 20 68 61 76 65 20 61 20 72 65 63 6f e we have a reco
1000: 72 64 20 66 6f 72 20 6f 75 72 20 63 6f 6e 6e 65 rd for our conne
1010: 63 74 69 6f 6e 20 66 6f 72 20 67 69 76 65 6e 20 ction for given
1020: 61 72 65 61 0a 20 20 20 20 28 69 66 20 28 6e 6f area. (if (no
1030: 74 20 72 75 6e 72 65 6d 6f 74 65 29 20 20 20 20 t runremote)
1040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
1050: 3b 20 63 61 6e 20 72 65 6d 6f 76 65 20 74 68 69 ; can remove thi
1060: 73 20 6f 6e 65 2e 20 73 68 6f 75 6c 64 20 6e 65 s one. should ne
1070: 76 65 72 20 67 65 74 20 68 65 72 65 2e 20 20 20 ver get here.
1080: 20 20 20 20 20 20 0a 09 28 62 65 67 69 6e 0a 09 ..(begin..
1090: 20 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f (set! *runremo
10a0: 74 65 2a 20 28 6d 61 6b 65 2d 72 65 6d 6f 74 65 te* (make-remote
10b0: 29 29 0a 09 20 20 28 73 65 74 21 20 72 75 6e 72 )).. (set! runr
10c0: 65 6d 6f 74 65 20 20 20 2a 72 75 6e 72 65 6d 6f emote *runremo
10d0: 74 65 2a 29 29 29 20 3b 3b 20 6e 65 77 20 72 75 te*))) ;; new ru
10e0: 6e 72 65 6d 6f 74 65 20 77 69 6c 6c 20 63 6f 6d nremote will com
10f0: 65 20 66 72 6f 6d 20 74 68 69 73 20 6f 6e 20 6e e from this on n
1100: 65 78 74 20 69 74 65 72 61 74 69 6f 6e 0a 20 20 ext iteration.
1110: 20 20 0a 20 20 20 20 3b 3b 20 44 4f 54 20 53 45 . ;; DOT SE
1120: 54 5f 48 4f 4d 45 48 4f 53 54 3b 20 2f 2f 20 6c T_HOMEHOST; // l
1130: 65 61 76 69 6e 67 20 6f 66 66 20 2d 20 64 6f 65 eaving off - doe
1140: 73 6e 27 74 20 72 65 61 6c 6c 79 20 61 64 64 20 sn't really add
1150: 74 6f 20 74 68 65 20 63 6c 61 72 69 74 79 0a 20 to the clarity.
1160: 20 20 20 3b 3b 20 44 4f 54 20 4d 55 54 45 58 4c ;; DOT MUTEXL
1170: 4f 43 4b 20 2d 3e 20 53 45 54 5f 48 4f 4d 45 48 OCK -> SET_HOMEH
1180: 4f 53 54 20 5b 6c 61 62 65 6c 3d 22 6e 6f 20 68 OST [label="no h
1190: 6f 6d 65 68 6f 73 74 3f 22 5d 3b 0a 20 20 20 20 omehost?"];.
11a0: 3b 3b 20 44 4f 54 20 53 45 54 5f 48 4f 4d 45 48 ;; DOT SET_HOMEH
11b0: 4f 53 54 20 2d 3e 20 4d 55 54 45 58 4c 4f 43 4b OST -> MUTEXLOCK
11c0: 3b 0a 20 20 20 20 3b 3b 20 65 6e 73 75 72 65 20 ;. ;; ensure
11d0: 77 65 20 68 61 76 65 20 61 20 68 6f 6d 65 68 6f we have a homeho
11e0: 73 74 20 72 65 63 6f 72 64 0a 20 20 20 20 28 69 st record. (i
11f0: 66 20 28 6e 6f 74 20 28 70 61 69 72 3f 20 28 72 f (not (pair? (r
1200: 65 6d 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e emote-hh-dat run
1210: 72 65 6d 6f 74 65 29 29 29 20 20 3b 3b 20 6e 6f remote))) ;; no
1220: 74 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 0a 09 28 t on homehost..(
1230: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e thread-sleep! 0.
1240: 31 29 20 3b 3b 20 73 69 6e 63 65 20 77 65 20 73 1) ;; since we s
1250: 68 6f 75 6c 64 6e 27 74 20 67 65 74 20 68 65 72 houldn't get her
1260: 65 2c 20 64 65 6c 61 79 20 61 20 6c 69 74 74 6c e, delay a littl
1270: 65 0a 09 28 72 65 6d 6f 74 65 2d 68 68 2d 64 61 e..(remote-hh-da
1280: 74 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 t-set! runremote
1290: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 68 6f 6d (common:get-hom
12a0: 65 68 6f 73 74 29 29 29 0a 20 20 20 20 0a 20 20 ehost))). .
12b0: 20 20 3b 3b 28 70 72 69 6e 74 20 22 42 42 3e 20 ;;(print "BB>
12c0: 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 69 73 readonly-mode is
12d0: 20 22 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 22 "readonly-mode"
12e0: 20 64 62 66 69 6c 65 20 69 73 20 22 64 62 66 69 dbfile is "dbfi
12f0: 6c 65 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 le). (cond.
1300: 20 20 20 3b 3b 44 4f 54 20 45 58 49 54 3b 0a 20 ;;DOT EXIT;.
1310: 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c ;;DOT MUTEXL
1320: 4f 43 4b 20 2d 3e 20 45 58 49 54 20 5b 6c 61 62 OCK -> EXIT [lab
1330: 65 6c 3d 22 3e 20 31 35 20 61 74 74 65 6d 70 74 el="> 15 attempt
1340: 73 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 s"]; {rank=same
1350: 22 63 61 73 65 20 31 22 20 22 45 58 49 54 22 20 "case 1" "EXIT"
1360: 7d 0a 20 20 20 20 20 3b 3b 20 67 69 76 65 20 75 }. ;; give u
1370: 70 20 69 66 20 6d 6f 72 65 20 74 68 61 6e 20 31 p if more than 1
1380: 35 30 20 61 74 74 65 6d 70 74 73 0a 20 20 20 20 50 attempts.
1390: 20 28 28 3e 20 61 74 74 65 6d 70 74 6e 75 6d 20 ((> attemptnum
13a0: 31 35 30 29 0a 20 20 20 20 20 20 28 64 65 62 75 150). (debu
13b0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
13c0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 lt-log-port* "ER
13d0: 52 4f 52 3a 20 31 35 30 20 74 72 69 65 73 20 74 ROR: 150 tries t
13e0: 6f 20 73 74 61 72 74 2f 63 6f 6e 6e 65 63 74 20 o start/connect
13f0: 74 6f 20 73 65 72 76 65 72 2e 20 47 69 76 69 6e to server. Givin
1400: 67 20 75 70 2e 22 29 0a 20 20 20 20 20 20 28 65 g up."). (e
1410: 78 69 74 20 31 29 29 0a 0a 20 20 20 20 20 3b 3b xit 1)).. ;;
1420: 44 4f 54 20 43 41 53 45 32 20 5b 6c 61 62 65 6c DOT CASE2 [label
1430: 3d 22 6c 6f 63 61 6c 5c 6e 72 65 61 64 6f 6e 6c ="local\nreadonl
1440: 79 5c 6e 71 75 65 72 79 22 5d 3b 0a 20 20 20 20 y\nquery"];.
1450: 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b ;;DOT MUTEXLOCK
1460: 20 2d 3e 20 43 41 53 45 32 3b 20 7b 72 61 6e 6b -> CASE2; {rank
1470: 3d 73 61 6d 65 20 22 63 61 73 65 20 32 22 20 43 =same "case 2" C
1480: 41 53 45 32 7d 0a 20 20 20 20 20 3b 3b 44 4f 54 ASE2}. ;;DOT
1490: 20 43 41 53 45 32 20 2d 3e 20 22 72 6d 74 3a 6f CASE2 -> "rmt:o
14a0: 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f pen-qry-close-lo
14b0: 63 61 6c 6c 79 22 3b 0a 20 20 20 20 20 3b 3b 20 cally";. ;;
14c0: 72 65 61 64 6f 6e 6c 79 20 6d 6f 64 65 2c 20 72 readonly mode, r
14d0: 65 61 64 20 72 65 71 75 65 73 74 2d 20 20 68 61 ead request- ha
14e0: 6e 64 6c 65 20 69 74 20 2d 20 63 61 73 65 20 32 ndle it - case 2
14f0: 0a 20 20 20 20 20 28 28 61 6e 64 20 72 65 61 64 . ((and read
1500: 6f 6e 6c 79 2d 6d 6f 64 65 0a 20 20 20 20 20 20 only-mode.
1510: 20 20 20 20 20 28 6d 65 6d 62 65 72 20 63 6d 64 (member cmd
1520: 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 api:read-only-q
1530: 75 65 72 69 65 73 29 29 20 0a 20 20 20 20 20 20 ueries)) .
1540: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a (mutex-unlock! *
1550: 72 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 rmt-mutex*).
1560: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
1570: 6e 66 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 2d nfo 12 *default-
1580: 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 log-port* "rmt:s
1590: 65 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 end-receive, cas
15a0: 65 20 32 22 29 0a 20 20 20 20 20 20 28 72 6d 74 e 2"). (rmt
15b0: 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d :open-qry-close-
15c0: 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 30 20 70 61 locally cmd 0 pa
15d0: 72 61 6d 73 29 0a 20 20 20 20 20 20 29 0a 0a 20 rams). )..
15e0: 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 33 20 ;;DOT CASE3
15f0: 5b 6c 61 62 65 6c 3d 22 77 72 69 74 65 20 69 6e [label="write in
1600: 5c 6e 72 65 61 64 2d 6f 6e 6c 79 20 6d 6f 64 65 \nread-only mode
1610: 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d "];. ;;DOT M
1620: 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 UTEXLOCK -> CASE
1630: 33 20 5b 6c 61 62 65 6c 3d 22 72 65 61 64 6f 6e 3 [label="readon
1640: 6c 79 5c 6e 6d 6f 64 65 3f 22 5d 3b 20 7b 72 61 ly\nmode?"]; {ra
1650: 6e 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 33 22 nk=same "case 3"
1660: 20 43 41 53 45 33 7d 0a 20 20 20 20 20 3b 3b 44 CASE3}. ;;D
1670: 4f 54 20 43 41 53 45 33 20 2d 3e 20 22 23 66 22 OT CASE3 -> "#f"
1680: 3b 0a 20 20 20 20 20 3b 3b 20 72 65 61 64 6f 6e ;. ;; readon
1690: 6c 79 20 6d 6f 64 65 2c 20 77 72 69 74 65 20 72 ly mode, write r
16a0: 65 71 75 65 73 74 2e 20 20 44 6f 20 6e 6f 74 68 equest. Do noth
16b0: 69 6e 67 2c 20 72 65 74 75 72 6e 20 23 66 0a 20 ing, return #f.
16c0: 20 20 20 20 28 72 65 61 64 6f 6e 6c 79 2d 6d 6f (readonly-mo
16d0: 64 65 20 28 65 78 74 72 61 73 2d 72 65 61 64 6f de (extras-reado
16e0: 6e 6c 79 2d 6d 6f 64 65 20 2a 72 6d 74 2d 6d 75 nly-mode *rmt-mu
16f0: 74 65 78 2a 20 2a 64 65 66 61 75 6c 74 2d 6c 6f tex* *default-lo
1700: 67 2d 70 6f 72 74 2a 20 63 6d 64 20 70 61 72 61 g-port* cmd para
1710: 6d 73 29 29 0a 0a 20 20 20 20 20 3b 3b 20 54 68 ms)).. ;; Th
1720: 69 73 20 62 6c 6f 63 6b 20 77 61 73 20 66 6f 72 is block was for
1730: 20 70 72 65 2d 65 6d 70 74 69 76 65 6c 79 20 72 pre-emptively r
1740: 65 73 65 74 74 69 6e 67 20 74 68 65 20 63 6f 6e esetting the con
1750: 6e 65 63 74 69 6f 6e 20 69 66 20 74 68 65 72 65 nection if there
1760: 20 68 61 64 20 62 65 65 6e 20 6e 6f 20 63 6f 6d had been no com
1770: 6d 75 6e 69 63 61 74 69 6f 6e 20 66 6f 72 20 73 munication for s
1780: 6f 6d 65 20 74 69 6d 65 2e 0a 20 20 20 20 20 3b ome time.. ;
1790: 3b 20 49 20 64 6f 6e 27 74 20 74 68 69 6e 6b 20 ; I don't think
17a0: 69 74 20 61 64 64 73 20 61 6e 79 20 76 61 6c 75 it adds any valu
17b0: 65 2e 20 49 66 20 74 68 65 20 73 65 72 76 65 72 e. If the server
17c0: 20 69 73 20 6e 6f 74 20 74 68 65 72 65 2c 20 6a is not there, j
17d0: 75 73 74 20 66 61 69 6c 20 61 6e 64 20 73 74 61 ust fail and sta
17e0: 72 74 20 61 20 6e 65 77 20 63 6f 6e 6e 65 63 74 rt a new connect
17f0: 69 6f 6e 2e 0a 20 20 20 20 20 3b 3b 20 61 6c 73 ion.. ;; als
1800: 6f 2c 20 74 68 65 20 65 78 70 69 72 65 2d 74 69 o, the expire-ti
1810: 6d 65 20 63 61 6c 63 75 6c 61 74 69 6f 6e 20 6d me calculation m
1820: 69 67 68 74 20 6e 6f 74 20 62 65 20 63 6f 72 72 ight not be corr
1830: 65 63 74 2e 20 57 65 20 77 61 6e 74 2c 20 74 69 ect. We want, ti
1840: 6d 65 2d 73 69 6e 63 65 2d 6c 61 73 74 2d 73 65 me-since-last-se
1850: 72 76 65 72 2d 61 63 63 65 73 73 20 3e 20 28 73 rver-access > (s
1860: 65 72 76 65 72 3a 67 65 74 2d 74 69 6d 65 6f 75 erver:get-timeou
1870: 74 29 0a 20 20 20 20 20 3b 3b 0a 20 20 20 20 20 t). ;;.
1880: 3b 3b 44 4f 54 20 43 41 53 45 34 20 5b 6c 61 62 ;;DOT CASE4 [lab
1890: 65 6c 3d 22 72 65 73 65 74 5c 6e 63 6f 6e 6e 65 el="reset\nconne
18a0: 63 74 69 6f 6e 22 5d 3b 0a 20 20 20 20 20 3b 3b ction"];. ;;
18b0: 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e DOT MUTEXLOCK ->
18c0: 20 43 41 53 45 34 20 5b 6c 61 62 65 6c 3d 22 68 CASE4 [label="h
18d0: 61 76 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 2c 5c ave connection,\
18e0: 6e 6c 61 73 74 5f 61 63 63 65 73 73 20 3e 20 65 nlast_access > e
18f0: 78 70 69 72 65 5f 74 69 6d 65 22 5d 3b 20 7b 72 xpire_time"]; {r
1900: 61 6e 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 34 ank=same "case 4
1910: 22 20 43 41 53 45 34 7d 0a 20 20 20 20 20 3b 3b " CASE4}. ;;
1920: 44 4f 54 20 43 41 53 45 34 20 2d 3e 20 22 72 6d DOT CASE4 -> "rm
1930: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 22 3b t:send-receive";
1940: 0a 20 20 20 20 20 3b 3b 20 72 65 73 65 74 20 74 . ;; reset t
1950: 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 69 66 he connection if
1960: 20 69 74 20 68 61 73 20 62 65 65 6e 20 75 6e 75 it has been unu
1970: 73 65 64 20 74 6f 6f 20 6c 6f 6e 67 0a 20 20 20 sed too long.
1980: 20 20 28 28 61 6e 64 20 72 75 6e 72 65 6d 6f 74 ((and runremot
1990: 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 72 65 e. (re
19a0: 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 20 72 75 6e mote-conndat run
19b0: 72 65 6d 6f 74 65 29 0a 09 20 20 20 28 3e 20 28 remote).. (> (
19c0: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
19d0: 20 3b 3b 20 69 66 20 69 74 20 68 61 73 20 62 65 ;; if it has be
19e0: 65 6e 20 6d 6f 72 65 20 74 68 61 6e 20 73 65 72 en more than ser
19f0: 76 65 72 2d 74 69 6d 65 6f 75 74 20 73 65 63 6f ver-timeout seco
1a00: 6e 64 73 20 73 69 6e 63 65 20 6c 61 73 74 20 63 nds since last c
1a10: 6f 6e 74 61 63 74 2c 20 63 6c 6f 73 65 20 74 68 ontact, close th
1a20: 69 73 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 61 6e is connection an
1a30: 64 20 73 74 61 72 74 20 61 20 6e 65 77 20 6f 6e d start a new on
1a40: 0a 09 20 20 20 20 20 20 28 2b 20 28 68 74 74 70 .. (+ (http
1a50: 2d 74 72 61 6e 73 70 6f 72 74 3a 73 65 72 76 65 -transport:serve
1a60: 72 2d 64 61 74 2d 67 65 74 2d 6c 61 73 74 2d 61 r-dat-get-last-a
1a70: 63 63 65 73 73 20 28 72 65 6d 6f 74 65 2d 63 6f ccess (remote-co
1a80: 6e 6e 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 nndat runremote)
1a90: 29 0a 09 09 20 28 72 65 6d 6f 74 65 2d 73 65 72 )... (remote-ser
1aa0: 76 65 72 2d 74 69 6d 65 6f 75 74 20 72 75 6e 72 ver-timeout runr
1ab0: 65 6d 6f 74 65 29 29 29 29 0a 20 20 20 20 20 20 emote)))).
1ac0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
1ad0: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
1ae0: 2d 70 6f 72 74 2a 20 22 43 6f 6e 6e 65 63 74 69 -port* "Connecti
1af0: 6f 6e 20 74 6f 20 22 20 28 72 65 6d 6f 74 65 2d on to " (remote-
1b00: 73 65 72 76 65 72 2d 75 72 6c 20 72 75 6e 72 65 server-url runre
1b10: 6d 6f 74 65 29 20 22 20 65 78 70 69 72 65 64 20 mote) " expired
1b20: 64 75 65 20 74 6f 20 6e 6f 20 61 63 63 65 73 73 due to no access
1b30: 65 73 2c 20 66 6f 72 63 69 6e 67 20 6e 65 77 20 es, forcing new
1b40: 63 6f 6e 6e 65 63 74 69 6f 6e 2e 22 29 0a 20 20 connection.").
1b50: 20 20 20 20 28 68 74 74 70 2d 74 72 61 6e 73 70 (http-transp
1b60: 6f 72 74 3a 63 6c 6f 73 65 2d 63 6f 6e 6e 65 63 ort:close-connec
1b70: 74 69 6f 6e 73 20 61 72 65 61 2d 64 61 74 3a 20 tions area-dat:
1b80: 72 75 6e 72 65 6d 6f 74 65 29 0a 20 20 20 20 20 runremote).
1b90: 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 (remote-conndat
1ba0: 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 -set! runremote
1bb0: 23 66 29 20 3b 3b 20 69 6e 76 61 6c 69 64 61 74 #f) ;; invalidat
1bc0: 65 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e e the connection
1bd0: 2c 20 74 68 75 73 20 66 6f 72 63 69 6e 67 20 61 , thus forcing a
1be0: 20 6e 65 77 20 63 6f 6e 6e 65 63 74 69 6f 6e 2e new connection.
1bf0: 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e . (mutex-un
1c00: 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 lock! *rmt-mutex
1c10: 2a 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 73 65 *). (rmt:se
1c20: 6e 64 2d 72 65 63 65 69 76 65 20 63 6d 64 20 72 nd-receive cmd r
1c30: 69 64 20 70 61 72 61 6d 73 20 61 74 74 65 6d 70 id params attemp
1c40: 74 6e 75 6d 3a 20 61 74 74 65 6d 70 74 6e 75 6d tnum: attemptnum
1c50: 29 29 0a 20 20 20 20 20 0a 20 20 20 20 20 3b 3b )). . ;;
1c60: 44 4f 54 20 43 41 53 45 35 20 5b 6c 61 62 65 6c DOT CASE5 [label
1c70: 3d 22 6c 6f 63 61 6c 5c 6e 72 65 61 64 22 5d 3b ="local\nread"];
1c80: 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 . ;;DOT MUTE
1c90: 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 35 20 5b XLOCK -> CASE5 [
1ca0: 6c 61 62 65 6c 3d 22 73 65 72 76 65 72 20 6e 6f label="server no
1cb0: 74 20 72 65 71 75 69 72 65 64 2c 5c 6e 6f 6e 20 t required,\non
1cc0: 68 6f 6d 65 68 6f 73 74 2c 5c 6e 72 65 61 64 2d homehost,\nread-
1cd0: 6f 6e 6c 79 20 71 75 65 72 79 22 5d 3b 20 7b 72 only query"]; {r
1ce0: 61 6e 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 35 ank=same "case 5
1cf0: 22 20 43 41 53 45 35 7d 3b 0a 20 20 20 20 20 3b " CASE5};. ;
1d00: 3b 44 4f 54 20 43 41 53 45 35 20 2d 3e 20 22 72 ;DOT CASE5 -> "r
1d10: 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 mt:open-qry-clos
1d20: 65 2d 6c 6f 63 61 6c 6c 79 22 3b 0a 0a 20 20 20 e-locally";..
1d30: 20 20 3b 3b 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 ;; on homehost
1d40: 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 20 72 and this is a r
1d50: 65 61 64 0a 20 20 20 20 20 28 28 61 6e 64 20 28 ead. ((and (
1d60: 6e 6f 74 20 28 72 65 6d 6f 74 65 2d 66 6f 72 63 not (remote-forc
1d70: 65 2d 73 65 72 76 65 72 20 72 75 6e 72 65 6d 6f e-server runremo
1d80: 74 65 29 29 20 3b 3b 20 68 6f 6e 6f 72 20 66 6f te)) ;; honor fo
1d90: 72 63 65 64 20 75 73 65 20 6f 66 20 73 65 72 76 rced use of serv
1da0: 65 72 2c 20 69 2e 65 2e 20 73 65 72 76 65 72 20 er, i.e. server
1db0: 4e 4f 54 20 72 65 71 75 69 72 65 64 0a 09 20 20 NOT required..
1dc0: 20 28 63 64 72 20 28 72 65 6d 6f 74 65 2d 68 68 (cdr (remote-hh
1dd0: 2d 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 -dat runremote))
1de0: 20 20 20 20 20 20 20 3b 3b 20 6f 6e 20 68 6f 6d ;; on hom
1df0: 65 68 6f 73 74 0a 20 20 20 20 20 20 20 20 20 20 ehost.
1e00: 20 28 6d 65 6d 62 65 72 20 63 6d 64 20 61 70 69 (member cmd api
1e10: 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 :read-only-queri
1e20: 65 73 29 29 20 20 20 3b 3b 20 74 68 69 73 20 69 es)) ;; this i
1e30: 73 20 61 20 72 65 61 64 0a 20 20 20 20 20 20 28 s a read. (
1e40: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 mutex-unlock! *r
1e50: 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 mt-mutex*).
1e60: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
1e70: 66 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 2d 6c fo 12 *default-l
1e80: 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 og-port* "rmt:se
1e90: 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 65 nd-receive, case
1ea0: 20 20 35 22 29 0a 20 20 20 20 20 20 28 72 6d 74 5"). (rmt
1eb0: 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d :open-qry-close-
1ec0: 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 30 20 70 61 locally cmd 0 pa
1ed0: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 3b 3b 44 rams)).. ;;D
1ee0: 4f 54 20 43 41 53 45 36 20 5b 6c 61 62 65 6c 3d OT CASE6 [label=
1ef0: 22 69 6e 69 74 5c 6e 72 65 6d 6f 74 65 22 5d 3b "init\nremote"];
1f00: 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 . ;;DOT MUTE
1f10: 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 36 20 5b XLOCK -> CASE6 [
1f20: 6c 61 62 65 6c 3d 22 6f 6e 20 68 6f 6d 65 68 6f label="on homeho
1f30: 73 74 2c 5c 6e 77 72 69 74 65 20 71 75 65 72 79 st,\nwrite query
1f40: 2c 5c 6e 68 61 76 65 20 73 65 72 76 65 72 2c 5c ,\nhave server,\
1f50: 6e 63 61 6e 27 74 20 72 65 61 63 68 20 69 74 22 ncan't reach it"
1f60: 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 63 ]; {rank=same "c
1f70: 61 73 65 20 36 22 20 43 41 53 45 36 7d 3b 0a 20 ase 6" CASE6};.
1f80: 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 36 20 ;;DOT CASE6
1f90: 2d 3e 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 -> "rmt:send-rec
1fa0: 65 69 76 65 22 3b 0a 20 20 20 20 20 3b 3b 20 6f eive";. ;; o
1fb0: 6e 20 68 6f 6d 65 68 6f 73 74 20 61 6e 64 20 74 n homehost and t
1fc0: 68 69 73 20 69 73 20 61 20 77 72 69 74 65 2c 20 his is a write,
1fd0: 77 65 20 61 6c 72 65 61 64 79 20 68 61 76 65 20 we already have
1fe0: 61 20 73 65 72 76 65 72 2c 20 62 75 74 20 73 65 a server, but se
1ff0: 72 76 65 72 20 68 61 73 20 64 69 65 64 0a 20 20 rver has died.
2000: 20 20 20 28 28 61 6e 64 20 28 63 64 72 20 28 72 ((and (cdr (r
2010: 65 6d 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e emote-hh-dat run
2020: 72 65 6d 6f 74 65 29 29 20 20 20 20 20 20 20 20 remote))
2030: 20 20 20 3b 3b 20 6f 6e 20 68 6f 6d 65 68 6f 73 ;; on homehos
2040: 74 0a 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f t. (no
2050: 74 20 28 6d 65 6d 62 65 72 20 63 6d 64 20 61 70 t (member cmd ap
2060: 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 i:read-only-quer
2070: 69 65 73 29 29 20 20 3b 3b 20 74 68 69 73 20 69 ies)) ;; this i
2080: 73 20 61 20 77 72 69 74 65 0a 20 20 20 20 20 20 s a write.
2090: 20 20 20 20 20 28 72 65 6d 6f 74 65 2d 73 65 72 (remote-ser
20a0: 76 65 72 2d 75 72 6c 20 72 75 6e 72 65 6d 6f 74 ver-url runremot
20b0: 65 29 20 20 20 20 20 20 20 20 20 20 20 20 20 3b e) ;
20c0: 3b 20 68 61 76 65 20 61 20 73 65 72 76 65 72 0a ; have a server.
20d0: 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 (not
20e0: 28 73 65 72 76 65 72 3a 70 69 6e 67 20 28 72 65 (server:ping (re
20f0: 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 6c 20 mote-server-url
2100: 72 75 6e 72 65 6d 6f 74 65 29 29 29 29 20 20 3b runremote)))) ;
2110: 3b 20 73 65 72 76 65 72 20 68 61 73 20 64 69 65 ; server has die
2120: 64 2e 20 4e 4f 54 45 3a 20 74 68 69 73 20 69 73 d. NOTE: this is
2130: 20 6e 6f 74 20 61 20 63 68 65 61 70 20 63 61 6c not a cheap cal
2140: 6c 21 20 4e 65 65 64 20 62 65 74 74 65 72 20 61 l! Need better a
2150: 70 70 72 6f 61 63 68 2e 0a 20 20 20 20 20 20 28 pproach.. (
2160: 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a set! *runremote*
2170: 20 28 6d 61 6b 65 2d 72 65 6d 6f 74 65 29 29 0a (make-remote)).
2180: 20 20 20 20 20 20 28 72 65 6d 6f 74 65 2d 66 6f (remote-fo
2190: 72 63 65 2d 73 65 72 76 65 72 2d 73 65 74 21 20 rce-server-set!
21a0: 72 75 6e 72 65 6d 6f 74 65 20 28 63 6f 6d 6d 6f runremote (commo
21b0: 6e 3a 66 6f 72 63 65 2d 73 65 72 76 65 72 3f 29 n:force-server?)
21c0: 29 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 ). (mutex-u
21d0: 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 nlock! *rmt-mute
21e0: 78 2a 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 x*). (debug
21f0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a :print-info 12 *
2200: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
2210: 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 * "rmt:send-rece
2220: 69 76 65 2c 20 63 61 73 65 20 20 36 22 29 0a 20 ive, case 6").
2230: 20 20 20 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 (rmt:send-r
2240: 65 63 65 69 76 65 20 63 6d 64 20 72 69 64 20 70 eceive cmd rid p
2250: 61 72 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d arams attemptnum
2260: 3a 20 61 74 74 65 6d 70 74 6e 75 6d 29 29 0a 0a : attemptnum))..
2270: 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 37 ;;DOT CASE7
2280: 20 5b 6c 61 62 65 6c 3d 22 68 6f 6d 65 68 6f 73 [label="homehos
2290: 74 5c 6e 77 72 69 74 65 22 5d 3b 0a 20 20 20 20 t\nwrite"];.
22a0: 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b ;;DOT MUTEXLOCK
22b0: 20 2d 3e 20 43 41 53 45 37 20 5b 6c 61 62 65 6c -> CASE7 [label
22c0: 3d 22 73 65 72 76 65 72 20 6e 6f 74 20 72 65 71 ="server not req
22d0: 75 69 72 65 64 2c 5c 6e 6f 6e 20 68 6f 6d 65 68 uired,\non homeh
22e0: 6f 73 74 2c 5c 6e 61 20 77 72 69 74 65 2c 5c 6e ost,\na write,\n
22f0: 68 61 76 65 20 61 20 73 65 72 76 65 72 22 5d 3b have a server"];
2300: 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 63 61 73 {rank=same "cas
2310: 65 20 37 22 20 43 41 53 45 37 7d 3b 0a 20 20 20 e 7" CASE7};.
2320: 20 20 3b 3b 44 4f 54 20 43 41 53 45 37 20 2d 3e ;;DOT CASE7 ->
2330: 20 22 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 "rmt:open-qry-c
2340: 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 22 3b 0a 20 lose-locally";.
2350: 20 20 20 20 3b 3b 20 6f 6e 20 68 6f 6d 65 68 6f ;; on homeho
2360: 73 74 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 st and this is a
2370: 20 77 72 69 74 65 2c 20 77 65 20 61 6c 72 65 61 write, we alrea
2380: 64 79 20 68 61 76 65 20 61 20 73 65 72 76 65 72 dy have a server
2390: 0a 20 20 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 . ((and (not
23a0: 20 28 72 65 6d 6f 74 65 2d 66 6f 72 63 65 2d 73 (remote-force-s
23b0: 65 72 76 65 72 20 72 75 6e 72 65 6d 6f 74 65 29 erver runremote)
23c0: 29 20 20 20 20 20 3b 3b 20 68 6f 6e 6f 72 20 66 ) ;; honor f
23d0: 6f 72 63 65 64 20 75 73 65 20 6f 66 20 73 65 72 orced use of ser
23e0: 76 65 72 2c 20 69 2e 65 2e 20 73 65 72 76 65 72 ver, i.e. server
23f0: 20 4e 4f 54 20 72 65 71 75 69 72 65 64 0a 09 20 NOT required..
2400: 20 20 28 63 64 72 20 28 72 65 6d 6f 74 65 2d 68 (cdr (remote-h
2410: 68 2d 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 h-dat runremote)
2420: 29 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6f ) ;; o
2430: 6e 20 68 6f 6d 65 68 6f 73 74 0a 20 20 20 20 20 n homehost.
2440: 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 (not (memb
2450: 65 72 20 63 6d 64 20 61 70 69 3a 72 65 61 64 2d er cmd api:read-
2460: 6f 6e 6c 79 2d 71 75 65 72 69 65 73 29 29 20 20 only-queries))
2470: 3b 3b 20 74 68 69 73 20 69 73 20 61 20 77 72 69 ;; this is a wri
2480: 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 72 te. (r
2490: 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 6c emote-server-url
24a0: 20 72 75 6e 72 65 6d 6f 74 65 29 29 20 20 20 20 runremote))
24b0: 20 20 20 20 20 20 20 20 3b 3b 20 68 61 76 65 20 ;; have
24c0: 61 20 73 65 72 76 65 72 0a 20 20 20 20 20 20 28 a server. (
24d0: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 mutex-unlock! *r
24e0: 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 mt-mutex*).
24f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
2500: 66 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 2d 6c fo 12 *default-l
2510: 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 og-port* "rmt:se
2520: 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 65 nd-receive, case
2530: 20 20 34 2e 31 22 29 0a 20 20 20 20 20 20 28 72 4.1"). (r
2540: 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 mt:open-qry-clos
2550: 65 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 30 20 e-locally cmd 0
2560: 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 3b params)).. ;
2570: 3b 44 4f 54 20 43 41 53 45 38 20 5b 6c 61 62 65 ;DOT CASE8 [labe
2580: 6c 3d 22 66 6f 72 63 65 5c 6e 73 65 72 76 65 72 l="force\nserver
2590: 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d "];. ;;DOT M
25a0: 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 UTEXLOCK -> CASE
25b0: 38 20 5b 6c 61 62 65 6c 3d 22 73 65 72 76 65 72 8 [label="server
25c0: 20 6e 6f 74 20 72 65 71 75 69 72 65 64 2c 5c 6e not required,\n
25d0: 68 61 76 65 20 68 6f 6d 65 68 6f 73 74 20 69 6e have homehost in
25e0: 66 6f 2c 5c 6e 6e 6f 20 63 6f 6e 6e 65 63 74 69 fo,\nno connecti
25f0: 6f 6e 20 79 65 74 2c 5c 6e 6e 6f 74 20 61 20 72 on yet,\nnot a r
2600: 65 61 64 2d 6f 6e 6c 79 20 71 75 65 72 79 22 5d ead-only query"]
2610: 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 63 61 ; {rank=same "ca
2620: 73 65 20 38 22 20 43 41 53 45 38 7d 3b 0a 20 20 se 8" CASE8};.
2630: 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 38 20 2d ;;DOT CASE8 -
2640: 3e 20 22 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d > "rmt:open-qry-
2650: 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 22 3b 0a close-locally";.
2660: 20 20 20 20 20 3b 3b 20 20 6f 6e 20 68 6f 6d 65 ;; on home
2670: 68 6f 73 74 2c 20 6e 6f 20 73 65 72 76 65 72 20 host, no server
2680: 63 6f 6e 74 61 63 74 20 6d 61 64 65 20 61 6e 64 contact made and
2690: 20 74 68 69 73 20 69 73 20 61 20 77 72 69 74 65 this is a write
26a0: 2c 20 70 61 73 73 69 76 65 6c 79 20 73 74 61 72 , passively star
26b0: 74 20 61 20 73 65 72 76 65 72 20 0a 20 20 20 20 t a server .
26c0: 20 28 28 61 6e 64 20 28 6e 6f 74 20 28 72 65 6d ((and (not (rem
26d0: 6f 74 65 2d 66 6f 72 63 65 2d 73 65 72 76 65 72 ote-force-server
26e0: 20 72 75 6e 72 65 6d 6f 74 65 29 29 20 20 20 20 runremote))
26f0: 20 3b 3b 20 68 6f 6e 6f 72 20 66 6f 72 63 65 64 ;; honor forced
2700: 20 75 73 65 20 6f 66 20 73 65 72 76 65 72 2c 20 use of server,
2710: 69 2e 65 2e 20 73 65 72 76 65 72 20 4e 4f 54 20 i.e. server NOT
2720: 72 65 71 75 69 72 65 64 0a 09 20 20 20 28 63 64 required.. (cd
2730: 72 20 28 72 65 6d 6f 74 65 2d 68 68 2d 64 61 74 r (remote-hh-dat
2740: 20 72 75 6e 72 65 6d 6f 74 65 29 29 20 20 20 20 runremote))
2750: 20 20 20 20 20 20 20 3b 3b 20 68 61 76 65 20 68 ;; have h
2760: 6f 6d 65 68 6f 73 74 0a 20 20 20 20 20 20 20 20 omehost.
2770: 20 20 20 28 6e 6f 74 20 28 72 65 6d 6f 74 65 2d (not (remote-
2780: 73 65 72 76 65 72 2d 75 72 6c 20 72 75 6e 72 65 server-url runre
2790: 6d 6f 74 65 29 29 20 20 20 20 20 20 20 3b 3b 20 mote)) ;;
27a0: 6e 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 79 65 no connection ye
27b0: 74 0a 09 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 t.. (not (memb
27c0: 65 72 20 63 6d 64 20 61 70 69 3a 72 65 61 64 2d er cmd api:read-
27d0: 6f 6e 6c 79 2d 71 75 65 72 69 65 73 29 29 29 20 only-queries)))
27e0: 3b 3b 20 6e 6f 74 20 61 20 72 65 61 64 2d 6f 6e ;; not a read-on
27f0: 6c 79 20 71 75 65 72 79 0a 20 20 20 20 20 20 28 ly query. (
2800: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
2810: 20 31 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 12 *default-log
2820: 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 6e 64 -port* "rmt:send
2830: 2d 72 65 63 65 69 76 65 2c 20 63 61 73 65 20 20 -receive, case
2840: 38 22 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 8"). (let (
2850: 28 73 65 72 76 65 72 2d 75 72 6c 20 20 28 73 65 (server-url (se
2860: 72 76 65 72 3a 63 68 65 63 6b 2d 69 66 2d 72 75 rver:check-if-ru
2870: 6e 6e 69 6e 67 20 2a 74 6f 70 70 61 74 68 2a 29 nning *toppath*)
2880: 29 29 20 3b 3b 20 28 73 65 72 76 65 72 3a 72 65 )) ;; (server:re
2890: 61 64 2d 64 6f 74 73 65 72 76 65 72 2d 3e 75 72 ad-dotserver->ur
28a0: 6c 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 20 3b l *toppath*))) ;
28b0: 3b 20 28 73 65 72 76 65 72 3a 63 68 65 63 6b 2d ; (server:check-
28c0: 69 66 2d 72 75 6e 6e 69 6e 67 20 2a 74 6f 70 70 if-running *topp
28d0: 61 74 68 2a 29 29 29 20 3b 3b 20 44 6f 20 4e 4f ath*))) ;; Do NO
28e0: 54 20 77 61 6e 74 20 74 6f 20 72 75 6e 20 73 65 T want to run se
28f0: 72 76 65 72 3a 63 68 65 63 6b 2d 69 66 2d 72 75 rver:check-if-ru
2900: 6e 6e 69 6e 67 20 2d 20 76 65 72 79 20 65 78 70 nning - very exp
2910: 65 6e 73 69 76 65 20 74 6f 20 64 6f 20 66 6f 72 ensive to do for
2920: 20 65 76 65 72 79 20 77 72 69 74 65 20 63 61 6c every write cal
2930: 6c 0a 09 28 69 66 20 73 65 72 76 65 72 2d 75 72 l..(if server-ur
2940: 6c 0a 09 20 20 20 20 28 72 65 6d 6f 74 65 2d 73 l.. (remote-s
2950: 65 72 76 65 72 2d 75 72 6c 2d 73 65 74 21 20 72 erver-url-set! r
2960: 75 6e 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2d unremote server-
2970: 75 72 6c 29 20 3b 3b 20 74 68 65 20 73 74 72 69 url) ;; the stri
2980: 6e 67 20 63 61 6e 20 62 65 20 63 6f 6e 73 75 6d ng can be consum
2990: 65 64 20 62 79 20 74 68 65 20 63 6c 69 65 6e 74 ed by the client
29a0: 20 73 65 74 75 70 20 69 66 20 6e 65 65 64 65 64 setup if needed
29b0: 0a 09 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f .. (if (commo
29c0: 6e 3a 66 6f 72 63 65 2d 73 65 72 76 65 72 3f 29 n:force-server?)
29d0: 0a 09 09 28 73 65 72 76 65 72 3a 73 74 61 72 74 ...(server:start
29e0: 2d 61 6e 64 2d 77 61 69 74 20 2a 74 6f 70 70 61 -and-wait *toppa
29f0: 74 68 2a 29 0a 09 09 28 73 65 72 76 65 72 3a 6b th*)...(server:k
2a00: 69 6e 64 2d 72 75 6e 20 2a 74 6f 70 70 61 74 68 ind-run *toppath
2a10: 2a 29 29 29 29 0a 20 20 20 20 20 20 28 72 65 6d *)))). (rem
2a20: 6f 74 65 2d 66 6f 72 63 65 2d 73 65 72 76 65 72 ote-force-server
2a30: 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 -set! runremote
2a40: 28 63 6f 6d 6d 6f 6e 3a 66 6f 72 63 65 2d 73 65 (common:force-se
2a50: 72 76 65 72 3f 29 29 0a 20 20 20 20 20 20 28 6d rver?)). (m
2a60: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d utex-unlock! *rm
2a70: 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 t-mutex*).
2a80: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
2a90: 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f o 12 *default-lo
2aa0: 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 6e g-port* "rmt:sen
2ab0: 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 65 20 d-receive, case
2ac0: 20 38 2e 31 22 29 0a 20 20 20 20 20 20 28 72 6d 8.1"). (rm
2ad0: 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 t:open-qry-close
2ae0: 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 30 20 70 -locally cmd 0 p
2af0: 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 3b 3b arams)).. ;;
2b00: 44 4f 54 20 43 41 53 45 39 20 5b 6c 61 62 65 6c DOT CASE9 [label
2b10: 3d 22 66 6f 72 63 65 20 73 65 72 76 65 72 5c 6e ="force server\n
2b20: 6e 6f 74 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 22 not on homehost"
2b30: 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 ];. ;;DOT MU
2b40: 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 39 TEXLOCK -> CASE9
2b50: 20 5b 6c 61 62 65 6c 3d 22 6e 6f 20 63 6f 6e 6e [label="no conn
2b60: 65 63 74 69 6f 6e 5c 6e 61 6e 64 20 65 69 74 68 ection\nand eith
2b70: 65 72 20 72 65 71 75 69 72 65 20 73 65 72 76 65 er require serve
2b80: 72 5c 6e 6f 72 20 6e 6f 74 20 6f 6e 20 68 6f 6d r\nor not on hom
2b90: 65 68 6f 73 74 22 5d 3b 20 7b 72 61 6e 6b 3d 73 ehost"]; {rank=s
2ba0: 61 6d 65 20 22 63 61 73 65 20 39 22 20 43 41 53 ame "case 9" CAS
2bb0: 45 39 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 E9};. ;;DOT
2bc0: 43 41 53 45 39 20 2d 3e 20 22 73 74 61 72 74 5c CASE9 -> "start\
2bd0: 6e 73 65 72 76 65 72 22 20 2d 3e 20 22 72 6d 74 nserver" -> "rmt
2be0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 22 3b 0a :send-receive";.
2bf0: 20 20 20 20 20 28 28 6f 72 20 28 61 6e 64 20 28 ((or (and (
2c00: 72 65 6d 6f 74 65 2d 66 6f 72 63 65 2d 73 65 72 remote-force-ser
2c10: 76 65 72 20 72 75 6e 72 65 6d 6f 74 65 29 20 20 ver runremote)
2c20: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 77 ;; w
2c30: 65 20 61 72 65 20 66 6f 72 63 69 6e 67 20 61 20 e are forcing a
2c40: 73 65 72 76 65 72 20 61 6e 64 20 64 6f 6e 27 74 server and don't
2c50: 20 79 65 74 20 68 61 76 65 20 61 20 63 6f 6e 6e yet have a conn
2c60: 65 63 74 69 6f 6e 20 74 6f 20 6f 6e 65 0a 09 20 ection to one..
2c70: 20 20 20 20 20 20 28 6e 6f 74 20 28 72 65 6d 6f (not (remo
2c80: 74 65 2d 63 6f 6e 6e 64 61 74 20 72 75 6e 72 65 te-conndat runre
2c90: 6d 6f 74 65 29 29 29 0a 09 20 20 28 61 6e 64 20 mote))).. (and
2ca0: 28 6e 6f 74 20 28 63 64 72 20 28 72 65 6d 6f 74 (not (cdr (remot
2cb0: 65 2d 68 68 2d 64 61 74 20 72 75 6e 72 65 6d 6f e-hh-dat runremo
2cc0: 74 65 29 29 29 20 20 20 20 20 20 20 20 3b 3b 20 te))) ;;
2cd0: 6e 6f 74 20 6f 6e 20 61 20 68 6f 6d 65 68 6f 73 not on a homehos
2ce0: 74 20 0a 09 20 20 20 20 20 20 20 28 6e 6f 74 20 t .. (not
2cf0: 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 20 (remote-conndat
2d00: 72 75 6e 72 65 6d 6f 74 65 29 29 29 29 20 20 20 runremote))))
2d10: 20 20 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 6e ;; and n
2d20: 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 20 20 20 o connection.
2d30: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
2d40: 69 6e 66 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 info 12 *default
2d50: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a -log-port* "rmt:
2d60: 73 65 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 61 send-receive, ca
2d70: 73 65 20 39 2c 20 68 68 2d 64 61 74 3a 20 22 20 se 9, hh-dat: "
2d80: 28 72 65 6d 6f 74 65 2d 68 68 2d 64 61 74 20 72 (remote-hh-dat r
2d90: 75 6e 72 65 6d 6f 74 65 29 20 22 20 63 6f 6e 6e unremote) " conn
2da0: 64 61 74 3a 20 22 20 28 72 65 6d 6f 74 65 2d 63 dat: " (remote-c
2db0: 6f 6e 6e 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 onndat runremote
2dc0: 29 29 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d )). (mutex-
2dd0: 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 unlock! *rmt-mut
2de0: 65 78 2a 29 0a 20 20 20 20 20 20 28 69 66 20 28 ex*). (if (
2df0: 6e 6f 74 20 28 73 65 72 76 65 72 3a 63 68 65 63 not (server:chec
2e00: 6b 2d 69 66 2d 72 75 6e 6e 69 6e 67 20 2a 74 6f k-if-running *to
2e10: 70 70 61 74 68 2a 29 29 20 3b 3b 20 77 68 6f 20 ppath*)) ;; who
2e20: 6b 6e 6f 77 73 2c 20 6d 61 79 62 65 20 6f 6e 65 knows, maybe one
2e30: 20 68 61 73 20 73 74 61 72 74 65 64 20 75 70 3f has started up?
2e40: 0a 09 20 20 28 73 65 72 76 65 72 3a 73 74 61 72 .. (server:star
2e50: 74 2d 61 6e 64 2d 77 61 69 74 20 2a 74 6f 70 70 t-and-wait *topp
2e60: 61 74 68 2a 29 29 0a 20 20 20 20 20 20 28 72 65 ath*)). (re
2e70: 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 2d 73 65 74 mote-conndat-set
2e80: 21 20 72 75 6e 72 65 6d 6f 74 65 20 28 72 6d 74 ! runremote (rmt
2e90: 3a 67 65 74 2d 63 6f 6e 6e 65 63 74 69 6f 6e 2d :get-connection-
2ea0: 69 6e 66 6f 20 2a 74 6f 70 70 61 74 68 2a 29 29 info *toppath*))
2eb0: 20 3b 3b 20 63 61 6c 6c 73 20 63 6c 69 65 6e 74 ;; calls client
2ec0: 3a 73 65 74 75 70 20 77 68 69 63 68 20 63 61 6c :setup which cal
2ed0: 6c 73 20 63 6c 69 65 6e 74 3a 73 65 74 75 70 2d ls client:setup-
2ee0: 68 74 74 70 0a 20 20 20 20 20 20 28 72 6d 74 3a http. (rmt:
2ef0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 63 6d 64 send-receive cmd
2f00: 20 72 69 64 20 70 61 72 61 6d 73 20 61 74 74 65 rid params atte
2f10: 6d 70 74 6e 75 6d 3a 20 61 74 74 65 6d 70 74 6e mptnum: attemptn
2f20: 75 6d 29 29 20 3b 3b 20 54 4f 44 4f 3a 20 61 64 um)) ;; TODO: ad
2f30: 64 20 62 61 63 6b 2d 6f 66 66 20 74 69 6d 65 6f d back-off timeo
2f40: 75 74 20 61 73 0a 0a 20 20 20 20 20 3b 3b 44 4f ut as.. ;;DO
2f50: 54 20 43 41 53 45 31 30 20 5b 6c 61 62 65 6c 3d T CASE10 [label=
2f60: 22 6f 6e 20 68 6f 6d 65 68 6f 73 74 22 5d 3b 0a "on homehost"];.
2f70: 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 58 ;;DOT MUTEX
2f80: 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 31 30 20 5b LOCK -> CASE10 [
2f90: 6c 61 62 65 6c 3d 22 73 65 72 76 65 72 20 6e 6f label="server no
2fa0: 74 20 72 65 71 75 69 72 65 64 2c 5c 6e 6f 6e 20 t required,\non
2fb0: 68 6f 6d 65 68 6f 73 74 22 5d 3b 20 7b 72 61 6e homehost"]; {ran
2fc0: 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 31 30 22 k=same "case 10"
2fd0: 20 43 41 53 45 31 30 7d 3b 0a 20 20 20 20 20 3b CASE10};. ;
2fe0: 3b 44 4f 54 20 43 41 53 45 31 30 20 2d 3e 20 22 ;DOT CASE10 -> "
2ff0: 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f rmt:open-qry-clo
3000: 73 65 2d 6c 6f 63 61 6c 6c 79 22 3b 0a 20 20 20 se-locally";.
3010: 20 20 3b 3b 20 61 6c 6c 20 73 65 74 20 75 70 20 ;; all set up
3020: 69 66 20 67 65 74 20 74 68 69 73 20 66 61 72 2c if get this far,
3030: 20 64 69 73 70 61 74 63 68 20 74 68 65 20 71 75 dispatch the qu
3040: 65 72 79 0a 20 20 20 20 20 28 28 61 6e 64 20 28 ery. ((and (
3050: 6e 6f 74 20 28 72 65 6d 6f 74 65 2d 66 6f 72 63 not (remote-forc
3060: 65 2d 73 65 72 76 65 72 20 72 75 6e 72 65 6d 6f e-server runremo
3070: 74 65 29 29 0a 09 20 20 20 28 63 64 72 20 28 72 te)).. (cdr (r
3080: 65 6d 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e emote-hh-dat run
3090: 72 65 6d 6f 74 65 29 29 29 20 3b 3b 20 77 65 20 remote))) ;; we
30a0: 61 72 65 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 0a are on homehost.
30b0: 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c (mutex-unl
30c0: 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a ock! *rmt-mutex*
30d0: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
30e0: 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 rint-info 12 *de
30f0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3100: 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 "rmt:send-receiv
3110: 65 2c 20 63 61 73 65 20 31 30 22 29 0a 20 20 20 e, case 10").
3120: 20 20 20 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 (rmt:open-qry
3130: 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 -close-locally c
3140: 6d 64 20 28 69 66 20 72 69 64 20 72 69 64 20 30 md (if rid rid 0
3150: 29 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 ) params))..
3160: 20 3b 3b 44 4f 54 20 43 41 53 45 31 31 20 5b 6c ;;DOT CASE11 [l
3170: 61 62 65 6c 3d 22 73 65 6e 64 5f 72 65 63 65 69 abel="send_recei
3180: 76 65 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 ve"];. ;;DOT
3190: 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 MUTEXLOCK -> CA
31a0: 53 45 31 31 20 5b 6c 61 62 65 6c 3d 22 65 6c 73 SE11 [label="els
31b0: 65 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 e"]; {rank=same
31c0: 22 63 61 73 65 20 31 31 22 20 43 41 53 45 31 31 "case 11" CASE11
31d0: 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 };. ;;DOT CA
31e0: 53 45 31 31 20 2d 3e 20 22 72 6d 74 3a 73 65 6e SE11 -> "rmt:sen
31f0: 64 2d 72 65 63 65 69 76 65 22 20 5b 6c 61 62 65 d-receive" [labe
3200: 6c 3d 22 63 61 6c 6c 20 66 61 69 6c 65 64 22 5d l="call failed"]
3210: 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 ;. ;;DOT CAS
3220: 45 31 31 20 2d 3e 20 22 52 45 53 55 4c 54 22 20 E11 -> "RESULT"
3230: 5b 6c 61 62 65 6c 3d 22 63 61 6c 6c 20 73 75 63 [label="call suc
3240: 63 65 65 64 65 64 22 5d 3b 0a 20 20 20 20 20 3b ceeded"];. ;
3250: 3b 20 6e 6f 74 20 6f 6e 20 68 6f 6d 65 68 6f 73 ; not on homehos
3260: 74 2c 20 64 6f 20 73 65 72 76 65 72 20 71 75 65 t, do server que
3270: 72 79 0a 20 20 20 20 20 28 65 6c 73 65 20 28 65 ry. (else (e
3280: 78 74 72 61 73 2d 63 61 73 65 2d 31 31 20 2a 64 xtras-case-11 *d
3290: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
32a0: 20 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 20 70 runremote cmd p
32b0: 61 72 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d arams attemptnum
32c0: 20 72 69 64 29 29 29 29 29 0a 20 20 20 20 3b 3b rid))))). ;;
32d0: 44 4f 54 20 7d 0a 0a 3b 3b 20 62 75 6e 63 68 20 DOT }..;; bunch
32e0: 6f 66 20 73 6d 61 6c 6c 20 66 75 6e 63 74 69 6f of small functio
32f0: 6e 73 20 66 61 63 74 6f 72 65 64 20 6f 75 74 20 ns factored out
3300: 6f 66 20 73 65 6e 64 2d 72 65 63 65 69 76 65 20 of send-receive
3310: 74 6f 20 6d 61 6b 65 20 64 65 62 75 67 20 65 61 to make debug ea
3320: 73 69 65 72 0a 3b 3b 0a 0a 28 64 65 66 69 6e 65 sier.;;..(define
3330: 20 28 65 78 74 72 61 73 2d 63 61 73 65 2d 31 31 (extras-case-11
3340: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3350: 72 74 2a 20 72 75 6e 72 65 6d 6f 74 65 20 63 6d rt* runremote cm
3360: 64 20 70 61 72 61 6d 73 20 61 74 74 65 6d 70 74 d params attempt
3370: 6e 75 6d 20 72 69 64 29 0a 20 20 3b 3b 20 28 6d num rid). ;; (m
3380: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d utex-unlock! *rm
3390: 74 2d 6d 75 74 65 78 2a 29 0a 20 20 28 64 65 62 t-mutex*). (deb
33a0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 ug:print-info 12
33b0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
33c0: 72 74 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 rt* "rmt:send-re
33d0: 63 65 69 76 65 2c 20 63 61 73 65 20 20 39 22 29 ceive, case 9")
33e0: 0a 20 20 3b 3b 20 28 6d 75 74 65 78 2d 6c 6f 63 . ;; (mutex-loc
33f0: 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 0a k! *rmt-mutex*).
3400: 20 20 28 6c 65 74 2a 20 28 28 63 6f 6e 6e 69 6e (let* ((connin
3410: 66 6f 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 fo (remote-connd
3420: 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 0a 09 at runremote))..
3430: 20 28 64 61 74 20 20 20 20 20 20 28 63 61 73 65 (dat (case
3440: 20 28 72 65 6d 6f 74 65 2d 74 72 61 6e 73 70 6f (remote-transpo
3450: 72 74 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 09 rt runremote)...
3460: 20 20 20 20 20 28 28 68 74 74 70 29 20 28 63 6f ((http) (co
3470: 6e 64 69 74 69 6f 6e 2d 63 61 73 65 20 3b 3b 20 ndition-case ;;
3480: 68 61 6e 64 6c 69 6e 67 20 68 65 72 65 20 68 61 handling here ha
3490: 73 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 63 s...... ;; c
34a0: 61 75 73 65 64 20 61 20 6c 6f 74 20 6f 66 0a 09 aused a lot of..
34b0: 09 09 09 09 20 20 20 20 20 3b 3b 20 70 72 6f 62 .... ;; prob
34c0: 6c 65 6d 73 2e 20 48 6f 77 65 76 65 72 20 69 74 lems. However it
34d0: 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 69 73 ...... ;; is
34e0: 20 6e 65 65 64 65 64 20 74 6f 20 64 65 61 6c 20 needed to deal
34f0: 77 69 74 68 0a 09 09 09 09 09 20 20 20 20 20 3b with...... ;
3500: 3b 20 61 74 74 65 6d 74 70 65 64 0a 09 09 09 09 ; attemtped.....
3510: 09 20 20 20 20 20 3b 3b 20 63 6f 6d 6d 75 6e 69 . ;; communi
3520: 63 61 74 69 6f 6e 20 74 6f 0a 09 09 09 09 09 20 cation to......
3530: 20 20 20 20 3b 3b 20 73 65 72 76 65 72 73 20 74 ;; servers t
3540: 68 61 74 20 68 61 76 65 20 67 6f 6e 65 0a 09 09 hat have gone...
3550: 09 09 09 20 20 20 20 20 3b 3b 20 61 77 61 79 0a ... ;; away.
3560: 09 09 09 20 20 20 20 20 20 28 68 74 74 70 2d 74 ... (http-t
3570: 72 61 6e 73 70 6f 72 74 3a 63 6c 69 65 6e 74 2d ransport:client-
3580: 61 70 69 2d 73 65 6e 64 2d 72 65 63 65 69 76 65 api-send-receive
3590: 20 30 20 63 6f 6e 6e 69 6e 66 6f 20 63 6d 64 20 0 conninfo cmd
35a0: 70 61 72 61 6d 73 29 0a 09 09 09 20 20 20 20 20 params)....
35b0: 20 28 28 63 6f 6d 6d 66 61 69 6c 29 28 76 65 63 ((commfail)(vec
35c0: 74 6f 72 20 23 66 20 22 63 6f 6d 6d 75 6e 69 63 tor #f "communic
35d0: 61 74 69 6f 6e 73 20 66 61 69 6c 22 29 29 0a 09 ations fail"))..
35e0: 09 09 20 20 20 20 20 20 28 28 65 78 6e 29 28 76 .. ((exn)(v
35f0: 65 63 74 6f 72 20 23 66 20 22 6f 74 68 65 72 20 ector #f "other
3600: 66 61 69 6c 22 20 28 70 72 69 6e 74 2d 63 61 6c fail" (print-cal
3610: 6c 2d 63 68 61 69 6e 29 29 29 29 29 0a 09 09 20 l-chain)))))...
3620: 20 20 20 20 28 65 6c 73 65 0a 09 09 20 20 20 20 (else...
3630: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
3640: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3650: 72 74 2a 20 22 45 52 52 4f 52 3a 20 74 72 61 6e rt* "ERROR: tran
3660: 73 70 6f 72 74 20 22 20 28 72 65 6d 6f 74 65 2d sport " (remote-
3670: 74 72 61 6e 73 70 6f 72 74 20 72 75 6e 72 65 6d transport runrem
3680: 6f 74 65 29 20 22 20 6e 6f 74 20 73 75 70 70 6f ote) " not suppo
3690: 72 74 65 64 22 29 0a 09 09 20 20 20 20 20 20 28 rted")... (
36a0: 65 78 69 74 29 29 29 29 0a 09 20 28 73 75 63 63 exit)))).. (succ
36b0: 65 73 73 20 20 28 69 66 20 28 76 65 63 74 6f 72 ess (if (vector
36c0: 3f 20 64 61 74 29 20 28 76 65 63 74 6f 72 2d 72 ? dat) (vector-r
36d0: 65 66 20 64 61 74 20 30 29 20 23 66 29 29 0a 09 ef dat 0) #f))..
36e0: 20 28 72 65 73 20 20 20 20 20 20 28 69 66 20 28 (res (if (
36f0: 76 65 63 74 6f 72 3f 20 64 61 74 29 20 28 76 65 vector? dat) (ve
3700: 63 74 6f 72 2d 72 65 66 20 64 61 74 20 31 29 20 ctor-ref dat 1)
3710: 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 #f))). (if (a
3720: 6e 64 20 28 76 65 63 74 6f 72 3f 20 63 6f 6e 6e nd (vector? conn
3730: 69 6e 66 6f 29 20 28 3c 20 35 20 28 76 65 63 74 info) (< 5 (vect
3740: 6f 72 2d 6c 65 6e 67 74 68 20 63 6f 6e 6e 69 6e or-length connin
3750: 66 6f 29 29 29 0a 09 28 68 74 74 70 2d 74 72 61 fo)))..(http-tra
3760: 6e 73 70 6f 72 74 3a 73 65 72 76 65 72 2d 64 61 nsport:server-da
3770: 74 2d 75 70 64 61 74 65 2d 6c 61 73 74 2d 61 63 t-update-last-ac
3780: 63 65 73 73 20 63 6f 6e 6e 69 6e 66 6f 29 20 3b cess conninfo) ;
3790: 3b 20 72 65 66 72 65 73 68 20 61 63 63 65 73 73 ; refresh access
37a0: 20 74 69 6d 65 0a 09 28 62 65 67 69 6e 0a 09 20 time..(begin..
37b0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
37c0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
37d0: 74 2a 20 22 49 4e 46 4f 3a 20 53 68 6f 75 6c 64 t* "INFO: Should
37e0: 20 6e 6f 74 20 67 65 74 20 68 65 72 65 21 20 63 not get here! c
37f0: 6f 6e 6e 69 6e 66 6f 3d 22 20 63 6f 6e 6e 69 6e onninfo=" connin
3800: 66 6f 29 0a 09 20 20 28 73 65 74 21 20 63 6f 6e fo).. (set! con
3810: 6e 69 6e 66 6f 20 23 66 29 0a 09 20 20 28 72 65 ninfo #f).. (re
3820: 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 2d 73 65 74 mote-conndat-set
3830: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 23 66 ! *runremote* #f
3840: 29 20 3b 3b 20 4e 4f 54 45 3a 20 2a 72 75 6e 72 ) ;; NOTE: *runr
3850: 65 6d 6f 74 65 2a 20 69 73 20 67 6c 6f 62 61 6c emote* is global
3860: 20 63 6f 70 79 20 6f 66 20 72 75 6e 72 65 6d 6f copy of runremo
3870: 74 65 2e 20 50 75 72 70 6f 73 65 3a 20 66 61 63 te. Purpose: fac
3880: 74 6f 72 20 6f 75 74 20 67 6c 6f 62 61 6c 2e 0a tor out global..
3890: 09 20 20 28 68 74 74 70 2d 74 72 61 6e 73 70 6f . (http-transpo
38a0: 72 74 3a 63 6c 6f 73 65 2d 63 6f 6e 6e 65 63 74 rt:close-connect
38b0: 69 6f 6e 73 20 20 61 72 65 61 2d 64 61 74 3a 20 ions area-dat:
38c0: 72 75 6e 72 65 6d 6f 74 65 29 29 29 0a 20 20 20 runremote))).
38d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
38e0: 66 6f 20 31 33 20 2a 64 65 66 61 75 6c 74 2d 6c fo 13 *default-l
38f0: 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 og-port* "rmt:se
3900: 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 65 nd-receive, case
3910: 20 20 39 2e 20 63 6f 6e 6e 69 6e 66 6f 3d 22 20 9. conninfo="
3920: 63 6f 6e 6e 69 6e 66 6f 20 22 20 64 61 74 3d 22 conninfo " dat="
3930: 20 64 61 74 20 22 20 72 75 6e 72 65 6d 6f 74 65 dat " runremote
3940: 20 3d 20 22 20 72 75 6e 72 65 6d 6f 74 65 29 0a = " runremote).
3950: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
3960: 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 0a k! *rmt-mutex*).
3970: 20 20 20 20 28 69 66 20 73 75 63 63 65 73 73 20 (if success
3980: 3b 3b 20 73 75 63 63 65 73 73 20 6f 6e 6c 79 20 ;; success only
3990: 74 65 6c 6c 73 20 75 73 20 74 68 61 74 20 74 68 tells us that th
39a0: 65 20 74 72 61 6e 73 70 6f 72 74 20 77 61 73 0a e transport was.
39b0: 09 3b 3b 20 73 75 63 63 65 73 73 66 75 6c 2c 20 .;; successful,
39c0: 68 61 76 65 20 74 6f 20 65 78 61 6d 69 6e 65 20 have to examine
39d0: 74 68 65 20 64 61 74 61 20 74 6f 20 73 65 65 20 the data to see
39e0: 69 66 0a 09 3b 3b 20 74 68 65 72 65 20 77 61 73 if..;; there was
39f0: 20 61 20 64 65 74 65 63 74 65 64 20 69 73 73 75 a detected issu
3a00: 65 20 61 74 20 74 68 65 20 6f 74 68 65 72 20 65 e at the other e
3a10: 6e 64 0a 09 28 65 78 74 72 61 73 2d 74 72 61 6e nd..(extras-tran
3a20: 73 70 6f 72 74 2d 73 75 63 63 65 64 65 64 20 2a sport-succeded *
3a30: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
3a40: 2a 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 20 61 74 * *rmt-mutex* at
3a50: 74 65 6d 70 74 6e 75 6d 20 72 75 6e 72 65 6d 6f temptnum runremo
3a60: 74 65 20 72 65 73 20 70 61 72 61 6d 73 20 72 69 te res params ri
3a70: 64 20 63 6d 64 29 0a 09 28 65 78 74 72 61 73 2d d cmd)..(extras-
3a80: 74 72 61 6e 73 70 6f 72 74 2d 66 61 69 6c 65 64 transport-failed
3a90: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3aa0: 72 74 2a 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 20 rt* *rmt-mutex*
3ab0: 61 74 74 65 6d 70 74 6e 75 6d 20 72 75 6e 72 65 attemptnum runre
3ac0: 6d 6f 74 65 20 63 6d 64 20 72 69 64 20 70 61 72 mote cmd rid par
3ad0: 61 6d 73 29 0a 09 29 29 29 0a 0a 3b 3b 20 28 64 ams)..)))..;; (d
3ae0: 65 66 69 6e 65 20 28 72 6d 74 3a 75 70 64 61 74 efine (rmt:updat
3af0: 65 2d 64 62 2d 73 74 61 74 73 20 72 75 6e 2d 69 e-db-stats run-i
3b00: 64 20 72 61 77 63 6d 64 20 70 61 72 61 6d 73 20 d rawcmd params
3b10: 64 75 72 61 74 69 6f 6e 29 0a 3b 3b 20 20 20 28 duration).;; (
3b20: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 2d mutex-lock! *db-
3b30: 73 74 61 74 73 2d 6d 75 74 65 78 2a 29 0a 3b 3b stats-mutex*).;;
3b40: 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 (handle-excep
3b50: 74 69 6f 6e 73 0a 3b 3b 20 20 20 20 65 78 6e 0a tions.;; exn.
3b60: 3b 3b 20 20 20 20 28 62 65 67 69 6e 0a 3b 3b 20 ;; (begin.;;
3b70: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
3b80: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
3b90: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
3ba0: 20 73 74 61 74 73 20 63 6f 6c 6c 65 63 74 69 6f stats collectio
3bb0: 6e 20 66 61 69 6c 65 64 20 69 6e 20 75 70 64 61 n failed in upda
3bc0: 74 65 2d 64 62 2d 73 74 61 74 73 22 29 0a 3b 3b te-db-stats").;;
3bd0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
3be0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
3bf0: 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 g-port* " messag
3c00: 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e e: " ((condition
3c10: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
3c20: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
3c30: 29 20 65 78 6e 29 29 0a 3b 3b 20 20 20 20 20 20 ) exn)).;;
3c40: 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 20 28 63 (print "exn=" (c
3c50: 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 ondition->list e
3c60: 78 6e 29 29 0a 3b 3b 20 20 20 20 20 20 23 66 29 xn)).;; #f)
3c70: 20 3b 3b 20 69 66 20 74 68 69 73 20 66 61 69 6c ;; if this fail
3c80: 73 20 77 65 20 64 6f 6e 27 74 20 63 61 72 65 2c s we don't care,
3c90: 20 69 74 20 69 73 20 6a 75 73 74 20 73 74 61 74 it is just stat
3ca0: 73 0a 3b 3b 20 20 20 20 28 6c 65 74 2a 20 28 28 s.;; (let* ((
3cb0: 63 6d 64 20 20 20 20 20 20 28 63 6f 6e 63 20 22 cmd (conc "
3cc0: 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 20 run-id=" run-id
3cd0: 22 20 22 20 28 69 66 20 28 65 71 3f 20 72 61 77 " " (if (eq? raw
3ce0: 63 6d 64 20 27 67 65 6e 65 72 61 6c 2d 63 61 6c cmd 'general-cal
3cf0: 6c 29 20 28 63 61 72 20 70 61 72 61 6d 73 29 20 l) (car params)
3d00: 72 61 77 63 6d 64 29 29 29 0a 3b 3b 20 09 20 20 rawcmd))).;; .
3d10: 28 73 74 61 74 2d 76 65 63 20 28 68 61 73 68 2d (stat-vec (hash-
3d20: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
3d30: 74 20 2a 64 62 2d 73 74 61 74 73 2a 20 63 6d 64 t *db-stats* cmd
3d40: 20 23 66 29 29 29 0a 3b 3b 20 20 20 20 20 20 28 #f))).;; (
3d50: 69 66 20 28 6e 6f 74 20 28 76 65 63 74 6f 72 3f if (not (vector?
3d60: 20 73 74 61 74 2d 76 65 63 29 29 0a 3b 3b 20 09 stat-vec)).;; .
3d70: 20 28 6c 65 74 20 28 28 6e 65 77 76 65 63 20 28 (let ((newvec (
3d80: 76 65 63 74 6f 72 20 30 20 30 29 29 29 0a 3b 3b vector 0 0))).;;
3d90: 20 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
3da0: 2d 73 65 74 21 20 2a 64 62 2d 73 74 61 74 73 2a -set! *db-stats*
3db0: 20 63 6d 64 20 6e 65 77 76 65 63 29 0a 3b 3b 20 cmd newvec).;;
3dc0: 09 20 20 20 28 73 65 74 21 20 73 74 61 74 2d 76 . (set! stat-v
3dd0: 65 63 20 6e 65 77 76 65 63 29 29 29 0a 3b 3b 20 ec newvec))).;;
3de0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
3df0: 21 20 73 74 61 74 2d 76 65 63 20 30 20 28 2b 20 ! stat-vec 0 (+
3e00: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 74 61 74 (vector-ref stat
3e10: 2d 76 65 63 20 30 29 20 31 29 29 0a 3b 3b 20 20 -vec 0) 1)).;;
3e20: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
3e30: 20 73 74 61 74 2d 76 65 63 20 31 20 28 2b 20 28 stat-vec 1 (+ (
3e40: 76 65 63 74 6f 72 2d 72 65 66 20 73 74 61 74 2d vector-ref stat-
3e50: 76 65 63 20 31 29 20 64 75 72 61 74 69 6f 6e 29 vec 1) duration)
3e60: 29 29 29 0a 3b 3b 20 20 20 28 6d 75 74 65 78 2d ))).;; (mutex-
3e70: 75 6e 6c 6f 63 6b 21 20 2a 64 62 2d 73 74 61 74 unlock! *db-stat
3e80: 73 2d 6d 75 74 65 78 2a 29 29 0a 0a 28 64 65 66 s-mutex*))..(def
3e90: 69 6e 65 20 28 72 6d 74 3a 70 72 69 6e 74 2d 64 ine (rmt:print-d
3ea0: 62 2d 73 74 61 74 73 29 0a 20 20 28 6c 65 74 20 b-stats). (let
3eb0: 28 28 66 6d 74 73 74 72 20 22 7e 34 30 61 7e 37 ((fmtstr "~40a~7
3ec0: 2d 64 7e 39 2d 64 7e 32 30 2c 32 2d 66 22 29 29 -d~9-d~20,2-f"))
3ed0: 20 3b 3b 20 22 7e 32 30 2c 32 2d 66 22 0a 20 20 ;; "~20,2-f".
3ee0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
3ef0: 38 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 8 *default-log-p
3f00: 6f 72 74 2a 20 22 44 42 20 53 74 61 74 73 5c 6e ort* "DB Stats\n
3f10: 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 20 20 20 20 28 ========"). (
3f20: 64 65 62 75 67 3a 70 72 69 6e 74 20 31 38 20 2a debug:print 18 *
3f30: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
3f40: 2a 20 28 66 6f 72 6d 61 74 20 23 66 20 22 7e 34 * (format #f "~4
3f50: 30 61 7e 38 61 7e 31 30 61 7e 31 30 61 22 20 22 0a~8a~10a~10a" "
3f60: 43 6d 64 22 20 22 43 6f 75 6e 74 22 20 22 54 6f Cmd" "Count" "To
3f70: 74 54 69 6d 65 22 20 22 41 76 67 22 29 29 0a 20 tTime" "Avg")).
3f80: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
3f90: 6d 62 64 61 20 28 63 6d 64 29 0a 09 09 28 6c 65 mbda (cmd)...(le
3fa0: 74 20 28 28 63 6d 64 2d 64 61 74 20 28 68 61 73 t ((cmd-dat (has
3fb0: 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 64 62 2d h-table-ref *db-
3fc0: 73 74 61 74 73 2a 20 63 6d 64 29 29 29 0a 09 09 stats* cmd)))...
3fd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
3fe0: 38 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 8 *default-log-p
3ff0: 6f 72 74 2a 20 28 66 6f 72 6d 61 74 20 23 66 20 ort* (format #f
4000: 66 6d 74 73 74 72 20 63 6d 64 20 28 76 65 63 74 fmtstr cmd (vect
4010: 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 20 30 or-ref cmd-dat 0
4020: 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6d ) (vector-ref cm
4030: 64 2d 64 61 74 20 31 29 20 28 2f 20 28 76 65 63 d-dat 1) (/ (vec
4040: 74 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 20 tor-ref cmd-dat
4050: 31 29 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6d 1)(vector-ref cm
4060: 64 2d 64 61 74 20 30 29 29 29 29 29 29 0a 09 20 d-dat 0))))))..
4070: 20 20 20 20 20 28 73 6f 72 74 20 28 68 61 73 68 (sort (hash
4080: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 2a 64 62 2d -table-keys *db-
4090: 73 74 61 74 73 2a 29 0a 09 09 20 20 20 20 28 6c stats*)... (l
40a0: 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 20 20 ambda (a b)...
40b0: 20 20 20 20 28 3e 20 28 76 65 63 74 6f 72 2d 72 (> (vector-r
40c0: 65 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ef (hash-table-r
40d0: 65 66 20 2a 64 62 2d 73 74 61 74 73 2a 20 61 29 ef *db-stats* a)
40e0: 20 30 29 0a 09 09 09 20 28 76 65 63 74 6f 72 2d 0).... (vector-
40f0: 72 65 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ref (hash-table-
4100: 72 65 66 20 2a 64 62 2d 73 74 61 74 73 2a 20 62 ref *db-stats* b
4110: 29 20 30 29 29 29 29 29 29 29 0a 0a 28 64 65 66 ) 0)))))))..(def
4120: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6d 61 78 ine (rmt:get-max
4130: 2d 71 75 65 72 79 2d 61 76 65 72 61 67 65 20 72 -query-average r
4140: 75 6e 2d 69 64 29 0a 20 20 28 6d 75 74 65 78 2d un-id). (mutex-
4150: 6c 6f 63 6b 21 20 2a 64 62 2d 73 74 61 74 73 2d lock! *db-stats-
4160: 6d 75 74 65 78 2a 29 0a 20 20 28 6c 65 74 2a 20 mutex*). (let*
4170: 28 28 72 75 6e 6b 65 79 20 28 63 6f 6e 63 20 22 ((runkey (conc "
4180: 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 20 run-id=" run-id
4190: 22 20 22 29 29 0a 09 20 28 63 6d 64 73 20 20 20 " ")).. (cmds
41a0: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
41b0: 28 78 29 0a 09 09 09 20 20 20 28 73 75 62 73 74 (x).... (subst
41c0: 72 69 6e 67 2d 69 6e 64 65 78 20 72 75 6e 6b 65 ring-index runke
41d0: 79 20 78 29 29 0a 09 09 09 20 28 68 61 73 68 2d y x)).... (hash-
41e0: 74 61 62 6c 65 2d 6b 65 79 73 20 2a 64 62 2d 73 table-keys *db-s
41f0: 74 61 74 73 2a 29 29 29 0a 09 20 28 72 65 73 20 tats*))).. (res
4200: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 6d (if (null? cm
4210: 64 73 29 0a 09 09 20 20 20 20 20 28 63 6f 6e 73 ds)... (cons
4220: 20 27 6e 6f 6e 65 20 30 29 0a 09 09 20 20 20 20 'none 0)...
4230: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6d 64 (let loop ((cmd
4240: 20 28 63 61 72 20 63 6d 64 73 29 29 0a 09 09 09 (car cmds))....
4250: 09 28 74 61 6c 20 28 63 64 72 20 63 6d 64 73 29 .(tal (cdr cmds)
4260: 29 0a 09 09 09 09 28 6d 61 78 2d 63 6d 64 20 28 ).....(max-cmd (
4270: 63 61 72 20 63 6d 64 73 29 29 0a 09 09 09 09 28 car cmds)).....(
4280: 72 65 73 20 30 29 29 0a 09 09 20 20 20 20 20 20 res 0))...
4290: 20 28 6c 65 74 2a 20 28 28 63 6d 64 2d 64 61 74 (let* ((cmd-dat
42a0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
42b0: 20 2a 64 62 2d 73 74 61 74 73 2a 20 63 6d 64 29 *db-stats* cmd)
42c0: 29 0a 09 09 09 20 20 20 20 20 20 28 74 6f 74 20 ).... (tot
42d0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
42e0: 63 6d 64 2d 64 61 74 20 30 29 29 0a 09 09 09 20 cmd-dat 0))....
42f0: 20 20 20 20 20 28 63 75 72 72 61 76 67 20 28 2f (curravg (/
4300: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6d 64 (vector-ref cmd
4310: 2d 64 61 74 20 31 29 20 28 76 65 63 74 6f 72 2d -dat 1) (vector-
4320: 72 65 66 20 63 6d 64 2d 64 61 74 20 30 29 29 29 ref cmd-dat 0)))
4330: 20 3b 3b 20 63 6f 75 6e 74 20 69 73 20 6e 65 76 ;; count is nev
4340: 65 72 20 7a 65 72 6f 20 62 79 20 63 6f 6e 73 74 er zero by const
4350: 72 75 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 ruction....
4360: 20 28 63 75 72 72 6d 61 78 20 28 6d 61 78 20 72 (currmax (max r
4370: 65 73 20 63 75 72 72 61 76 67 29 29 0a 09 09 09 es curravg))....
4380: 20 20 20 20 20 20 28 6e 65 77 6d 61 78 2d 63 6d (newmax-cm
4390: 64 20 28 69 66 20 28 3e 20 63 75 72 72 61 76 67 d (if (> curravg
43a0: 20 72 65 73 29 20 63 6d 64 20 6d 61 78 2d 63 6d res) cmd max-cm
43b0: 64 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 75 d))).... (if (nu
43c0: 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 20 20 20 20 ll? tal)....
43d0: 20 28 69 66 20 28 3e 20 74 6f 74 20 31 30 29 0a (if (> tot 10).
43e0: 09 09 09 09 20 28 63 6f 6e 73 20 6e 65 77 6d 61 .... (cons newma
43f0: 78 2d 63 6d 64 20 63 75 72 72 6d 61 78 29 0a 09 x-cmd currmax)..
4400: 09 09 09 20 28 63 6f 6e 73 20 27 6e 6f 6e 65 20 ... (cons 'none
4410: 30 29 29 0a 09 09 09 20 20 20 20 20 28 6c 6f 6f 0)).... (loo
4420: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
4430: 74 61 6c 29 20 6e 65 77 6d 61 78 2d 63 6d 64 20 tal) newmax-cmd
4440: 63 75 72 72 6d 61 78 29 29 29 29 29 29 29 0a 20 currmax))))))).
4450: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
4460: 21 20 2a 64 62 2d 73 74 61 74 73 2d 6d 75 74 65 ! *db-stats-mute
4470: 78 2a 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 x*). res))..(
4480: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6f 70 65 6e define (rmt:open
4490: 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c -qry-close-local
44a0: 6c 79 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 ly cmd run-id pa
44b0: 72 61 6d 73 20 23 21 6b 65 79 20 28 72 65 6d 72 rams #!key (remr
44c0: 65 74 72 69 65 73 20 35 29 29 0a 20 20 28 6c 65 etries 5)). (le
44d0: 74 2a 20 28 28 71 72 79 2d 69 73 2d 77 72 69 74 t* ((qry-is-writ
44e0: 65 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 e (not (member
44f0: 20 63 6d 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e cmd api:read-on
4500: 6c 79 2d 71 75 65 72 69 65 73 29 29 29 0a 09 20 ly-queries)))..
4510: 28 64 62 2d 66 69 6c 65 2d 70 61 74 68 20 20 20 (db-file-path
4520: 28 64 62 3a 64 62 66 69 6c 65 2d 70 61 74 68 29 (db:dbfile-path)
4530: 29 20 3b 3b 20 20 30 29 29 0a 09 20 28 64 62 73 ) ;; 0)).. (dbs
4540: 74 72 75 63 74 2d 6c 6f 63 61 6c 20 28 64 62 3a truct-local (db:
4550: 73 65 74 75 70 20 23 74 29 29 20 20 3b 3b 20 6d setup #t)) ;; m
4560: 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
4570: 20 70 61 74 68 3a 20 20 64 62 64 69 72 20 6c 6f path: dbdir lo
4580: 63 61 6c 3a 20 23 74 29 29 29 0a 09 20 28 72 65 cal: #t))).. (re
4590: 61 64 2d 6f 6e 6c 79 20 20 20 20 20 20 28 6e 6f ad-only (no
45a0: 74 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 t (file-write-ac
45b0: 63 65 73 73 3f 20 64 62 2d 66 69 6c 65 2d 70 61 cess? db-file-pa
45c0: 74 68 29 29 29 0a 09 20 28 73 74 61 72 74 20 20 th))).. (start
45d0: 20 20 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 (current
45e0: 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a -milliseconds)).
45f0: 09 20 28 72 65 73 64 61 74 20 20 20 20 20 20 20 . (resdat
4600: 20 20 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 (if (not (and
4610: 72 65 61 64 2d 6f 6e 6c 79 20 71 72 79 2d 69 73 read-only qry-is
4620: 2d 77 72 69 74 65 29 29 0a 09 09 09 20 20 20 20 -write))....
4630: 20 28 6c 65 74 20 28 28 76 20 28 61 70 69 3a 65 (let ((v (api:e
4640: 78 65 63 75 74 65 2d 72 65 71 75 65 73 74 73 20 xecute-requests
4650: 64 62 73 74 72 75 63 74 2d 6c 6f 63 61 6c 20 28 dbstruct-local (
4660: 76 65 63 74 6f 72 20 28 73 79 6d 62 6f 6c 2d 3e vector (symbol->
4670: 73 74 72 69 6e 67 20 63 6d 64 29 20 70 61 72 61 string cmd) para
4680: 6d 73 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 ms))))....
4690: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
46a0: 6f 6e 73 20 3b 3b 20 74 68 65 72 65 20 68 61 73 ons ;; there has
46b0: 20 62 65 65 6e 20 61 20 6c 6f 6e 67 20 68 69 73 been a long his
46c0: 74 6f 72 79 20 6f 66 20 72 65 63 65 69 76 69 6e tory of receivin
46d0: 67 20 73 74 72 61 6e 67 65 20 65 72 72 6f 72 73 g strange errors
46e0: 20 66 72 6f 6d 20 76 61 6c 75 65 73 20 72 65 74 from values ret
46f0: 75 72 6e 65 64 20 62 79 20 74 68 65 20 63 6c 69 urned by the cli
4700: 65 6e 74 20 77 68 65 6e 20 74 68 69 6e 67 73 20 ent when things
4710: 67 6f 20 77 72 6f 6e 67 2e 2e 0a 09 09 09 09 65 go wrong.......e
4720: 78 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 xn
4730: 20 3b 3b 20 20 54 68 69 73 20 69 73 20 61 6e 20 ;; This is an
4740: 61 74 74 65 6d 70 74 20 74 6f 20 64 65 74 65 63 attempt to detec
4750: 74 20 74 68 61 74 20 73 69 74 75 61 74 69 6f 6e t that situation
4760: 20 61 6e 64 20 72 65 63 6f 76 65 72 20 67 72 61 and recover gra
4770: 63 65 66 75 6c 6c 79 0a 09 09 09 09 28 62 65 67 cefully.....(beg
4780: 69 6e 0a 09 09 09 09 20 20 28 64 65 62 75 67 3a in..... (debug:
4790: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
47a0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f -log-port* "ERRO
47b0: 52 3a 20 62 61 64 20 64 61 74 61 20 66 72 6f 6d R: bad data from
47c0: 20 73 65 72 76 65 72 20 22 20 76 20 22 20 6d 65 server " v " me
47d0: 73 73 61 67 65 3a 20 22 20 20 28 28 63 6f 6e 64 ssage: " ((cond
47e0: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
47f0: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
4800: 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 ssage) exn))....
4810: 09 20 20 28 76 65 63 74 6f 72 20 23 74 20 27 28 . (vector #t '(
4820: 29 29 29 20 3b 3b 20 73 68 6f 75 6c 64 20 61 6c ))) ;; should al
4830: 77 61 79 73 20 67 65 74 20 61 20 76 65 63 74 6f ways get a vecto
4840: 72 20 62 75 74 20 69 66 20 73 6f 6d 65 74 68 69 r but if somethi
4850: 6e 67 20 67 6f 65 73 20 77 72 6f 6e 67 20 72 65 ng goes wrong re
4860: 74 75 72 6e 20 61 20 64 75 6d 6d 79 0a 09 09 09 turn a dummy....
4870: 09 28 69 66 20 28 61 6e 64 20 28 76 65 63 74 6f .(if (and (vecto
4880: 72 3f 20 76 29 0a 09 09 09 09 09 20 28 3e 20 28 r? v)...... (> (
4890: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 29 vector-length v)
48a0: 20 31 29 29 0a 09 09 09 09 20 20 20 20 28 6c 65 1))..... (le
48b0: 74 20 28 28 6e 65 77 76 65 63 20 28 76 65 63 74 t ((newvec (vect
48c0: 6f 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 or (vector-ref v
48d0: 20 30 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 0)(vector-ref v
48e0: 20 31 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 1)))).....
48f0: 20 6e 65 77 76 65 63 29 20 20 20 20 20 20 20 20 newvec)
4900: 20 20 20 3b 3b 20 62 79 20 63 6f 70 79 69 6e 67 ;; by copying
4910: 20 74 68 65 20 76 65 63 74 6f 72 20 77 68 69 6c the vector whil
4920: 65 20 69 6e 73 69 64 65 20 74 68 65 20 65 72 72 e inside the err
4930: 6f 72 20 68 61 6e 64 6c 65 72 20 77 65 20 73 68 or handler we sh
4940: 6f 75 6c 64 20 66 6f 72 63 65 20 74 68 65 20 64 ould force the d
4950: 65 74 65 63 74 69 6f 6e 20 6f 66 20 61 20 63 6f etection of a co
4960: 72 72 75 70 74 65 64 20 72 65 63 6f 72 64 0a 09 rrupted record..
4970: 09 09 09 20 20 20 20 28 76 65 63 74 6f 72 20 23 ... (vector #
4980: 74 20 27 28 29 29 29 29 29 20 20 3b 3b 20 77 65 t '())))) ;; we
4990: 20 63 6f 75 6c 64 20 61 6c 73 6f 20 63 68 65 63 could also chec
49a0: 6b 20 74 68 61 74 20 74 68 65 20 72 65 74 75 72 k that the retur
49b0: 6e 65 64 20 74 79 70 65 73 20 61 72 65 20 76 61 ned types are va
49c0: 6c 69 64 0a 09 09 09 20 20 20 20 20 28 76 65 63 lid.... (vec
49d0: 74 6f 72 20 23 74 20 27 28 29 29 29 29 0a 09 20 tor #t '())))..
49e0: 28 73 75 63 63 65 73 73 20 20 20 20 20 20 20 20 (success
49f0: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 (vector-ref resd
4a00: 61 74 20 30 29 29 0a 09 20 28 72 65 73 20 20 20 at 0)).. (res
4a10: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
4a20: 2d 72 65 66 20 72 65 73 64 61 74 20 31 29 29 0a -ref resdat 1)).
4a30: 09 20 28 64 75 72 61 74 69 6f 6e 20 20 20 20 20 . (duration
4a40: 20 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 (- (current-mi
4a50: 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 lliseconds) star
4a60: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e t))). (if (an
4a70: 64 20 72 65 61 64 2d 6f 6e 6c 79 20 71 72 79 2d d read-only qry-
4a80: 69 73 2d 77 72 69 74 65 29 0a 20 20 20 20 20 20 is-write).
4a90: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4aa0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4ab0: 72 74 2a 20 22 45 52 52 4f 52 3a 20 61 74 74 65 rt* "ERROR: atte
4ac0: 6d 70 74 20 74 6f 20 77 72 69 74 65 20 74 6f 20 mpt to write to
4ad0: 72 65 61 64 2d 6f 6e 6c 79 20 64 61 74 61 62 61 read-only databa
4ae0: 73 65 20 69 67 6e 6f 72 65 64 2e 20 63 6d 64 3d se ignored. cmd=
4af0: 22 20 63 6d 64 29 29 0a 20 20 20 20 28 69 66 20 " cmd)). (if
4b00: 28 6e 6f 74 20 73 75 63 63 65 73 73 29 0a 09 28 (not success)..(
4b10: 69 66 20 28 3e 20 72 65 6d 72 65 74 72 69 65 73 if (> remretries
4b20: 20 30 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 0).. (begin.
4b30: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
4b40: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
4b50: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4b60: 6c 6f 63 61 6c 20 71 75 65 72 79 20 66 61 69 6c local query fail
4b70: 65 64 2e 20 54 72 79 69 6e 67 20 61 67 61 69 6e ed. Trying again
4b80: 2e 22 29 0a 09 20 20 20 20 20 20 28 74 68 72 65 .").. (thre
4b90: 61 64 2d 73 6c 65 65 70 21 20 28 2f 20 28 72 61 ad-sleep! (/ (ra
4ba0: 6e 64 6f 6d 20 35 30 30 30 29 20 31 30 30 30 29 ndom 5000) 1000)
4bb0: 29 20 3b 3b 20 73 6f 6d 65 20 72 61 6e 64 6f 6d ) ;; some random
4bc0: 20 64 65 6c 61 79 20 0a 09 20 20 20 20 20 20 28 delay .. (
4bd0: 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f rmt:open-qry-clo
4be0: 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 72 se-locally cmd r
4bf0: 75 6e 2d 69 64 20 70 61 72 61 6d 73 20 72 65 6d un-id params rem
4c00: 72 65 74 72 69 65 73 3a 20 28 2d 20 72 65 6d 72 retries: (- remr
4c10: 65 74 72 69 65 73 20 31 29 29 29 0a 09 20 20 20 etries 1)))..
4c20: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
4c30: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
4c40: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
4c50: 2d 70 6f 72 74 2a 20 22 74 6f 6f 20 6d 61 6e 79 -port* "too many
4c60: 20 72 65 74 72 69 65 73 20 69 6e 20 72 6d 74 3a retries in rmt:
4c70: 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c open-qry-close-l
4c80: 6f 63 61 6c 6c 79 2c 20 67 69 76 69 6e 67 20 75 ocally, giving u
4c90: 70 22 29 0a 09 20 20 20 20 20 20 23 66 29 29 0a p").. #f)).
4ca0: 09 28 62 65 67 69 6e 0a 09 20 20 3b 3b 20 28 72 .(begin.. ;; (r
4cb0: 6d 74 3a 75 70 64 61 74 65 2d 64 62 2d 73 74 61 mt:update-db-sta
4cc0: 74 73 20 72 75 6e 2d 69 64 20 63 6d 64 20 70 61 ts run-id cmd pa
4cd0: 72 61 6d 73 20 64 75 72 61 74 69 6f 6e 29 0a 09 rams duration)..
4ce0: 20 20 3b 3b 20 6d 61 72 6b 20 74 68 69 73 20 72 ;; mark this r
4cf0: 75 6e 20 61 73 20 64 69 72 74 79 20 69 66 20 74 un as dirty if t
4d00: 68 69 73 20 77 61 73 20 61 20 77 72 69 74 65 2c his was a write,
4d10: 20 74 68 65 20 77 61 74 63 68 64 6f 67 20 69 73 the watchdog is
4d20: 20 72 65 73 70 6f 6e 73 69 62 6c 65 20 66 6f 72 responsible for
4d30: 20 73 79 6e 63 69 6e 67 20 69 74 0a 09 20 20 28 syncing it.. (
4d40: 69 66 20 71 72 79 2d 69 73 2d 77 72 69 74 65 0a if qry-is-write.
4d50: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 . (let ((st
4d60: 61 72 74 2d 74 69 6d 65 20 28 63 75 72 72 65 6e art-time (curren
4d70: 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 09 28 t-seconds)))...(
4d80: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 2d mutex-lock! *db-
4d90: 6d 75 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 65 78 multi-sync-mutex
4da0: 2a 29 0a 2f 09 09 28 73 65 74 21 20 2a 64 62 2d *)./..(set! *db-
4db0: 6c 61 73 74 2d 61 63 63 65 73 73 2a 20 73 74 61 last-access* sta
4dc0: 72 74 2d 74 69 6d 65 29 20 20 3b 3b 20 54 48 49 rt-time) ;; THI
4dd0: 53 20 49 53 20 50 52 4f 42 41 42 4c 59 20 55 53 S IS PROBABLY US
4de0: 45 4c 45 53 53 3f 20 28 77 65 20 61 72 65 20 6f ELESS? (we are o
4df0: 6e 20 61 20 63 6c 69 65 6e 74 29 0a 20 20 20 20 n a client).
4e00: 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 75 74 (mut
4e10: 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 2d 6d ex-unlock! *db-m
4e20: 75 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 65 78 2a ulti-sync-mutex*
4e30: 29 29 29 29 29 0a 20 20 20 20 72 65 73 29 29 0a ))))). res)).
4e40: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 .(define (rmt:se
4e50: 6e 64 2d 72 65 63 65 69 76 65 2d 6e 6f 2d 61 75 nd-receive-no-au
4e60: 74 6f 2d 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 to-client-setup
4e70: 63 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 connection-info
4e80: 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 72 61 6d cmd run-id param
4e90: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e s). (let* ((run
4ea0: 2d 69 64 20 20 20 28 69 66 20 72 75 6e 2d 69 64 -id (if run-id
4eb0: 20 72 75 6e 2d 69 64 20 30 29 29 0a 09 20 28 72 run-id 0)).. (r
4ec0: 65 73 20 20 09 20 20 20 28 68 61 6e 64 6c 65 2d es . (handle-
4ed0: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 20 20 exceptions...
4ee0: 20 65 78 6e 0a 09 09 20 20 20 20 23 66 0a 09 09 exn... #f...
4ef0: 20 20 20 20 28 68 74 74 70 2d 74 72 61 6e 73 70 (http-transp
4f00: 6f 72 74 3a 63 6c 69 65 6e 74 2d 61 70 69 2d 73 ort:client-api-s
4f10: 65 6e 64 2d 72 65 63 65 69 76 65 20 72 75 6e 2d end-receive run-
4f20: 69 64 20 63 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e id connection-in
4f30: 66 6f 20 63 6d 64 20 70 61 72 61 6d 73 29 29 29 fo cmd params)))
4f40: 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 ). (if (and r
4f50: 65 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 es (vector-ref r
4f60: 65 73 20 30 29 29 0a 09 28 76 65 63 74 6f 72 2d es 0))..(vector-
4f70: 72 65 66 20 72 65 73 20 31 29 20 3b 3b 3b 20 59 ref res 1) ;;; Y
4f80: 45 53 21 21 20 54 48 49 53 20 49 53 20 43 4f 52 ES!! THIS IS COR
4f90: 52 45 43 54 21 21 20 43 48 41 4e 47 45 20 49 54 RECT!! CHANGE IT
4fa0: 20 48 45 52 45 2c 20 54 48 45 4e 20 43 48 41 4e HERE, THEN CHAN
4fb0: 47 45 20 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 GE rmt:send-rece
4fc0: 69 76 65 20 41 4c 53 4f 21 21 21 0a 09 23 66 29 ive ALSO!!!..#f)
4fd0: 29 29 0a 0a 3b 3b 20 3b 3b 20 57 72 61 70 20 6a ))..;; ;; Wrap j
4fe0: 73 6f 6e 20 6c 69 62 72 61 72 79 20 66 6f 72 20 son library for
4ff0: 73 74 72 69 6e 67 73 20 28 77 68 79 20 74 68 65 strings (why the
5000: 20 70 6f 72 74 73 20 63 72 61 70 20 69 6e 20 74 ports crap in t
5010: 68 65 20 66 69 72 73 74 20 70 6c 61 63 65 3f 29 he first place?)
5020: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 72 6d 74 .;; (define (rmt
5030: 3a 64 61 74 2d 3e 6a 73 6f 6e 2d 73 74 72 20 64 :dat->json-str d
5040: 61 74 29 0a 3b 3b 20 20 20 28 77 69 74 68 2d 6f at).;; (with-o
5050: 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 utput-to-string
5060: 0a 3b 3b 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .;; (lambda
5070: 28 29 0a 3b 3b 20 20 20 20 20 20 20 28 6a 73 6f ().;; (jso
5080: 6e 2d 77 72 69 74 65 20 64 61 74 29 29 29 29 0a n-write dat)))).
5090: 3b 3b 20 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 ;; .;; (define (
50a0: 72 6d 74 3a 6a 73 6f 6e 2d 73 74 72 2d 3e 64 61 rmt:json-str->da
50b0: 74 20 6a 73 6f 6e 2d 73 74 72 29 0a 3b 3b 20 20 t json-str).;;
50c0: 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f (with-input-fro
50d0: 6d 2d 73 74 72 69 6e 67 20 6a 73 6f 6e 2d 73 74 m-string json-st
50e0: 72 0a 3b 3b 20 20 20 20 20 28 6c 61 6d 62 64 61 r.;; (lambda
50f0: 20 28 29 0a 3b 3b 20 20 20 20 20 20 20 28 6a 73 ().;; (js
5100: 6f 6e 2d 72 65 61 64 29 29 29 29 0a 0a 3b 3b 3d on-read))))..;;=
5110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5150: 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 41 20 43 20 =====.;;.;; A C
5160: 54 20 55 20 41 20 4c 20 20 20 41 20 50 20 49 20 T U A L A P I
5170: 20 20 43 20 41 20 4c 20 4c 20 53 20 20 0a 3b 3b C A L L S .;;
5180: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d 3d =========..;;===
51d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5210: 3d 3d 3d 0a 3b 3b 20 20 53 20 45 20 52 20 56 20 ===.;; S E R V
5220: 45 20 52 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d E R.;;==========
5230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
5270: 65 66 69 6e 65 20 28 72 6d 74 3a 6b 69 6c 6c 2d efine (rmt:kill-
5280: 73 65 72 76 65 72 20 72 75 6e 2d 69 64 29 0a 20 server run-id).
5290: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
52a0: 76 65 20 27 6b 69 6c 6c 2d 73 65 72 76 65 72 20 ve 'kill-server
52b0: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
52c0: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
52d0: 28 72 6d 74 3a 73 74 61 72 74 2d 73 65 72 76 65 (rmt:start-serve
52e0: 72 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 r run-id). (rmt
52f0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 73 :send-receive 's
5300: 74 61 72 74 2d 73 65 72 76 65 72 20 30 20 28 6c tart-server 0 (l
5310: 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 3b ist run-id)))..;
5320: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5360: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 4d 20 49 20 =======.;; M I
5370: 53 20 43 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S C.;;==========
5380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
53c0: 65 66 69 6e 65 20 28 72 6d 74 3a 6c 6f 67 69 6e efine (rmt:login
53d0: 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a run-id). (rmt:
53e0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6c 6f send-receive 'lo
53f0: 67 69 6e 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 gin run-id (list
5400: 20 2a 74 6f 70 70 61 74 68 2a 20 6d 65 67 61 74 *toppath* megat
5410: 65 73 74 2d 76 65 72 73 69 6f 6e 20 2a 6d 79 2d est-version *my-
5420: 63 6c 69 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 client-signature
5430: 2a 29 29 29 0a 0a 3b 3b 20 54 68 69 73 20 6c 6f *)))..;; This lo
5440: 67 69 6e 20 64 6f 65 73 20 6e 6f 20 72 65 74 72 gin does no retr
5450: 69 65 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f ies under the ho
5460: 6f 64 20 2d 20 69 74 20 61 63 74 73 20 61 20 62 od - it acts a b
5470: 69 74 20 6c 69 6b 65 20 61 20 70 69 6e 67 2e 0a it like a ping..
5480: 3b 3b 20 44 65 70 72 65 63 61 74 65 64 20 66 6f ;; Deprecated fo
5490: 72 20 6e 6d 73 67 2d 74 72 61 6e 73 70 6f 72 74 r nmsg-transport
54a0: 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d ..;;.(define (rm
54b0: 74 3a 6c 6f 67 69 6e 2d 6e 6f 2d 61 75 74 6f 2d t:login-no-auto-
54c0: 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 63 6f 6e client-setup con
54d0: 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 29 0a 20 20 nection-info).
54e0: 28 63 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 (case *transport
54f0: 2d 74 79 70 65 2a 20 3b 3b 20 72 75 6e 2d 69 64 -type* ;; run-id
5500: 20 6f 66 20 30 20 69 73 20 6a 75 73 74 20 61 20 of 0 is just a
5510: 70 6c 61 63 65 68 6f 6c 64 65 72 0a 20 20 20 20 placeholder.
5520: 28 28 68 74 74 70 29 28 72 6d 74 3a 73 65 6e 64 ((http)(rmt:send
5530: 2d 72 65 63 65 69 76 65 2d 6e 6f 2d 61 75 74 6f -receive-no-auto
5540: 2d 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 63 6f -client-setup co
5550: 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 27 6c nnection-info 'l
5560: 6f 67 69 6e 20 30 20 28 6c 69 73 74 20 2a 74 6f ogin 0 (list *to
5570: 70 70 61 74 68 2a 20 6d 65 67 61 74 65 73 74 2d ppath* megatest-
5580: 76 65 72 73 69 6f 6e 20 2a 6d 79 2d 63 6c 69 65 version *my-clie
5590: 6e 74 2d 73 69 67 6e 61 74 75 72 65 2a 29 29 29 nt-signature*)))
55a0: 0a 20 20 20 20 3b 3b 28 28 6e 6d 73 67 29 28 6e . ;;((nmsg)(n
55b0: 6d 73 67 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c msg-transport:cl
55c0: 69 65 6e 74 2d 61 70 69 2d 73 65 6e 64 2d 72 65 ient-api-send-re
55d0: 63 65 69 76 65 20 72 75 6e 2d 69 64 20 63 6f 6e ceive run-id con
55e0: 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 27 6c 6f nection-info 'lo
55f0: 67 69 6e 20 28 6c 69 73 74 20 2a 74 6f 70 70 61 gin (list *toppa
5600: 74 68 2a 20 6d 65 67 61 74 65 73 74 2d 76 65 72 th* megatest-ver
5610: 73 69 6f 6e 20 72 75 6e 2d 69 64 20 2a 6d 79 2d sion run-id *my-
5620: 63 6c 69 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 client-signature
5630: 2a 29 29 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 *))). ))..;;
5640: 68 61 6e 64 20 6f 66 66 20 61 20 63 61 6c 6c 20 hand off a call
5650: 74 6f 20 6f 6e 65 20 6f 66 20 74 68 65 20 64 62 to one of the db
5660: 3a 71 75 65 72 69 65 73 20 73 74 61 74 65 6d 65 :queries stateme
5670: 6e 74 73 0a 3b 3b 20 61 64 64 65 64 20 72 75 6e nts.;; added run
5680: 2d 69 64 20 74 6f 20 6d 61 6b 65 20 6c 6f 6f 6b -id to make look
5690: 69 6e 67 20 75 70 20 74 68 65 20 63 6f 72 72 65 ing up the corre
56a0: 63 74 20 64 62 20 70 6f 73 73 69 62 6c 65 20 0a ct db possible .
56b0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a ;;.(define (rmt:
56c0: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 73 74 6d general-call stm
56d0: 74 6e 61 6d 65 20 72 75 6e 2d 69 64 20 2e 20 70 tname run-id . p
56e0: 61 72 61 6d 73 29 0a 20 20 28 72 6d 74 3a 73 65 arams). (rmt:se
56f0: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 6e 65 nd-receive 'gene
5700: 72 61 6c 2d 63 61 6c 6c 20 72 75 6e 2d 69 64 20 ral-call run-id
5710: 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 73 74 (append (list st
5720: 6d 74 6e 61 6d 65 20 72 75 6e 2d 69 64 29 20 70 mtname run-id) p
5730: 61 72 61 6d 73 29 29 29 0a 0a 0a 3b 3b 20 67 69 arams)))...;; gi
5740: 76 65 6e 20 61 20 68 6f 73 74 6e 61 6d 65 2c 20 ven a hostname,
5750: 72 65 74 75 72 6e 20 61 20 70 61 69 72 20 6f 66 return a pair of
5760: 20 63 70 75 20 6c 6f 61 64 20 61 6e 64 20 75 70 cpu load and up
5770: 64 61 74 65 20 74 69 6d 65 20 72 65 70 72 65 73 date time repres
5780: 65 6e 74 69 6e 67 20 6c 61 74 65 73 74 20 69 6e enting latest in
5790: 74 65 6c 6c 69 67 65 6e 63 65 20 66 72 6f 6d 20 telligence from
57a0: 74 65 73 74 73 20 72 75 6e 6e 69 6e 67 20 6f 6e tests running on
57b0: 20 74 68 61 74 20 68 6f 73 74 0a 28 64 65 66 69 that host.(defi
57c0: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6c 61 74 65 ne (rmt:get-late
57d0: 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 20 68 6f 73 st-host-load hos
57e0: 74 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 tname). (rmt:se
57f0: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
5800: 6c 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 latest-host-load
5810: 20 30 20 28 6c 69 73 74 20 68 6f 73 74 6e 61 6d 0 (list hostnam
5820: 65 29 29 29 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 e)))..;; (define
5830: 20 28 72 6d 74 3a 73 79 6e 63 2d 69 6e 6d 65 6d (rmt:sync-inmem
5840: 2d 3e 64 62 20 72 75 6e 2d 69 64 29 0a 3b 3b 20 ->db run-id).;;
5850: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
5860: 69 76 65 20 27 73 79 6e 63 2d 69 6e 6d 65 6d 2d ive 'sync-inmem-
5870: 3e 64 62 20 72 75 6e 2d 69 64 20 27 28 29 29 29 >db run-id '()))
5880: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 ..(define (rmt:s
5890: 64 62 2d 71 72 79 20 71 72 79 20 76 61 6c 20 72 db-qry qry val r
58a0: 75 6e 2d 69 64 29 0a 20 20 3b 3b 20 61 64 64 20 un-id). ;; add
58b0: 63 61 63 68 69 6e 67 20 69 66 20 71 72 79 20 69 caching if qry i
58c0: 73 20 27 67 65 74 69 64 20 6f 72 20 27 67 65 74 s 'getid or 'get
58d0: 73 74 72 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d str. (rmt:send-
58e0: 72 65 63 65 69 76 65 20 27 73 64 62 2d 71 72 79 receive 'sdb-qry
58f0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 71 72 run-id (list qr
5900: 79 20 76 61 6c 29 29 29 0a 0a 3b 3b 20 4e 4f 54 y val)))..;; NOT
5910: 20 43 4f 4d 50 4c 45 54 45 44 0a 28 64 65 66 69 COMPLETED.(defi
5920: 6e 65 20 28 72 6d 74 3a 72 75 6e 74 65 73 74 73 ne (rmt:runtests
5930: 20 75 73 65 72 20 72 75 6e 2d 69 64 20 74 65 73 user run-id tes
5940: 74 70 61 74 74 20 70 61 72 61 6d 73 29 0a 20 20 tpatt params).
5950: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
5960: 65 20 27 72 75 6e 74 65 73 74 73 20 72 75 6e 2d e 'runtests run-
5970: 69 64 20 74 65 73 74 70 61 74 74 29 29 0a 0a 28 id testpatt))..(
5980: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
5990: 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 20 20 run-record-ids
59a0: 74 61 72 67 65 74 20 72 75 6e 20 6b 65 79 6e 61 target run keyna
59b0: 6d 65 73 20 74 65 73 74 2d 70 61 74 74 29 0a 20 mes test-patt).
59c0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
59d0: 76 65 20 27 67 65 74 2d 72 75 6e 2d 72 65 63 6f ve 'get-run-reco
59e0: 72 64 2d 69 64 73 20 23 66 20 28 6c 69 73 74 20 rd-ids #f (list
59f0: 74 61 72 67 65 74 20 72 75 6e 20 6b 65 79 6e 61 target run keyna
5a00: 6d 65 73 20 74 65 73 74 2d 70 61 74 74 29 29 29 mes test-patt)))
5a10: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
5a20: 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 et-changed-recor
5a30: 64 2d 69 64 73 20 73 69 6e 63 65 2d 74 69 6d 65 d-ids since-time
5a40: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
5a50: 63 65 69 76 65 20 27 67 65 74 2d 63 68 61 6e 67 ceive 'get-chang
5a60: 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 20 23 66 ed-record-ids #f
5a70: 20 28 6c 69 73 74 20 73 69 6e 63 65 2d 74 69 6d (list since-tim
5a80: 65 29 29 20 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d e)) )..;;=======
5a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5ad0: 3b 3b 20 20 54 20 45 20 53 20 54 20 20 20 4d 20 ;; T E S T M
5ae0: 45 20 54 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d E T A .;;=======
5af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5b30: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
5b40: 74 2d 74 65 73 74 73 2d 74 61 67 73 29 0a 20 20 t-tests-tags).
5b50: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
5b60: 65 20 27 67 65 74 2d 74 65 73 74 73 2d 74 61 67 e 'get-tests-tag
5b70: 73 20 23 66 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d s #f '()))..;;==
5b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bc0: 3d 3d 3d 3d 0a 3b 3b 20 20 4b 20 45 20 59 20 53 ====.;; K E Y S
5bd0: 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============
5be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 54 ==========..;; T
5c20: 68 65 73 65 20 72 65 71 75 69 72 65 20 72 75 6e hese require run
5c30: 2d 69 64 20 62 65 63 61 75 73 65 20 74 68 65 20 -id because the
5c40: 76 61 6c 75 65 73 20 63 6f 6d 65 20 66 72 6f 6d values come from
5c50: 20 74 68 65 20 72 75 6e 21 0a 3b 3b 0a 28 64 65 the run!.;;.(de
5c60: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 fine (rmt:get-ke
5c70: 79 2d 76 61 6c 2d 70 61 69 72 73 20 72 75 6e 2d y-val-pairs run-
5c80: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
5c90: 72 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 79 receive 'get-key
5ca0: 2d 76 61 6c 2d 70 61 69 72 73 20 72 75 6e 2d 69 -val-pairs run-i
5cb0: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 d (list run-id))
5cc0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5cd0: 67 65 74 2d 6b 65 79 73 29 0a 20 20 28 69 66 20 get-keys). (if
5ce0: 2a 64 62 2d 6b 65 79 73 2a 20 2a 64 62 2d 6b 65 *db-keys* *db-ke
5cf0: 79 73 2a 20 0a 20 20 20 20 20 28 6c 65 74 20 28 ys* . (let (
5d00: 28 72 65 73 20 28 72 6d 74 3a 73 65 6e 64 2d 72 (res (rmt:send-r
5d10: 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 79 73 eceive 'get-keys
5d20: 20 23 66 20 27 28 29 29 29 29 0a 20 20 20 20 20 #f '()))).
5d30: 20 20 28 73 65 74 21 20 2a 64 62 2d 6b 65 79 73 (set! *db-keys
5d40: 2a 20 72 65 73 29 0a 20 20 20 20 20 20 20 72 65 * res). re
5d50: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 s)))..(define (r
5d60: 6d 74 3a 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 mt:get-keys-writ
5d70: 65 29 20 3b 3b 20 64 75 6d 6d 79 20 71 75 65 72 e) ;; dummy quer
5d80: 79 20 74 6f 20 66 6f 72 63 65 20 73 65 72 76 65 y to force serve
5d90: 72 20 73 74 61 72 74 0a 20 20 28 6c 65 74 20 28 r start. (let (
5da0: 28 72 65 73 20 28 72 6d 74 3a 73 65 6e 64 2d 72 (res (rmt:send-r
5db0: 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 79 73 eceive 'get-keys
5dc0: 2d 77 72 69 74 65 20 23 66 20 27 28 29 29 29 29 -write #f '())))
5dd0: 0a 20 20 20 20 28 73 65 74 21 20 2a 64 62 2d 6b . (set! *db-k
5de0: 65 79 73 2a 20 72 65 73 29 0a 20 20 20 20 72 65 eys* res). re
5df0: 73 29 29 0a 0a 3b 3b 20 77 65 20 64 6f 6e 27 74 s))..;; we don't
5e00: 20 72 65 75 73 65 20 72 75 6e 2d 69 64 27 73 20 reuse run-id's
5e10: 28 65 78 63 65 70 74 20 70 6f 73 73 69 62 6c 79 (except possibly
5e20: 20 2a 61 66 74 65 72 2a 20 61 20 64 62 20 63 6c *after* a db cl
5e30: 65 61 6e 75 70 29 20 73 6f 20 69 74 20 69 73 20 eanup) so it is
5e40: 73 61 66 65 0a 3b 3b 20 74 6f 20 63 61 63 68 65 safe.;; to cache
5e50: 20 74 68 65 20 72 65 73 75 6c 73 20 69 6e 20 61 the resuls in a
5e60: 20 68 61 73 68 0a 3b 3b 0a 28 64 65 66 69 6e 65 hash.;;.(define
5e70: 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 2d 76 61 (rmt:get-key-va
5e80: 6c 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 6f 72 ls run-id). (or
5e90: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
5ea0: 2f 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 61 6c /default *keyval
5eb0: 73 2a 20 72 75 6e 2d 69 64 20 23 66 29 0a 20 20 s* run-id #f).
5ec0: 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 (let ((res (
5ed0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
5ee0: 20 27 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 23 'get-key-vals #
5ef0: 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 f (list run-id))
5f00: 29 29 0a 20 20 20 20 20 20 20 20 28 68 61 73 68 )). (hash
5f10: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 6b 65 79 -table-set! *key
5f20: 76 61 6c 73 2a 20 72 75 6e 2d 69 64 20 72 65 73 vals* run-id res
5f30: 29 0a 20 20 20 20 20 20 20 20 72 65 73 29 29 29 ). res)))
5f40: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
5f50: 65 74 2d 74 61 72 67 65 74 73 29 0a 20 20 28 72 et-targets). (r
5f60: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
5f70: 27 67 65 74 2d 74 61 72 67 65 74 73 20 23 66 20 'get-targets #f
5f80: 27 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 '()))..(define (
5f90: 72 6d 74 3a 67 65 74 2d 74 61 72 67 65 74 20 72 rmt:get-target r
5fa0: 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 un-id). (rmt:se
5fb0: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
5fc0: 74 61 72 67 65 74 20 72 75 6e 2d 69 64 20 28 6c target run-id (l
5fd0: 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 ist run-id)))..(
5fe0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
5ff0: 72 75 6e 2d 74 69 6d 65 73 20 72 75 6e 70 61 74 run-times runpat
6000: 74 20 74 61 72 67 65 74 70 61 74 74 29 0a 20 20 t targetpatt).
6010: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
6020: 65 20 27 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 e 'get-run-times
6030: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 61 74 #f (list runpat
6040: 74 20 74 61 72 67 65 74 70 61 74 74 20 29 29 29 t targetpatt )))
6050: 20 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ...;;==========
6060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
60a0: 20 54 20 45 20 53 20 54 20 53 0a 3b 3b 3d 3d 3d T E S T S.;;===
60b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60f0: 3d 3d 3d 0a 0a 3b 3b 20 4a 75 73 74 20 73 6f 6d ===..;; Just som
6100: 65 20 73 79 6e 74 61 74 69 63 20 73 75 67 61 72 e syntatic sugar
6110: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 72 65 .(define (rmt:re
6120: 67 69 73 74 65 72 2d 74 65 73 74 20 72 75 6e 2d gister-test run-
6130: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
6140: 6d 2d 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 67 m-path). (rmt:g
6150: 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 72 65 67 eneral-call 'reg
6160: 69 73 74 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 ister-test run-i
6170: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 d run-id test-na
6180: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a me item-path))..
6190: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
61a0: 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 -test-id run-id
61b0: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 testname item-pa
61c0: 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d th). (rmt:send-
61d0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 receive 'get-tes
61e0: 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 t-id run-id (lis
61f0: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d t run-id testnam
6200: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a e item-path)))..
6210: 3b 3b 20 72 75 6e 2d 69 64 20 69 73 20 4e 4f 54 ;; run-id is NOT
6220: 20 75 73 65 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 used.;;.(define
6230: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
6240: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
6250: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 69 66 20 test-id). (if
6260: 28 6e 75 6d 62 65 72 3f 20 74 65 73 74 2d 69 64 (number? test-id
6270: 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 73 65 6e ). (rmt:sen
6280: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 d-receive 'get-t
6290: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 est-info-by-id r
62a0: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
62b0: 69 64 20 74 65 73 74 2d 69 64 29 29 0a 20 20 20 id test-id)).
62c0: 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 (begin..(debu
62d0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
62e0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
62f0: 52 4e 49 4e 47 3a 20 42 61 64 20 64 61 74 61 20 RNING: Bad data
6300: 68 61 6e 64 65 64 20 74 6f 20 72 6d 74 3a 67 65 handed to rmt:ge
6310: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
6320: 64 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 d run-id=" run-i
6330: 64 20 22 2c 20 74 65 73 74 2d 69 64 3d 22 20 74 d ", test-id=" t
6340: 65 73 74 2d 69 64 29 0a 09 28 70 72 69 6e 74 2d est-id)..(print-
6350: 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 75 72 72 call-chain (curr
6360: 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 ent-error-port))
6370: 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 ..#f)))..(define
6380: 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d 72 (rmt:test-get-r
6390: 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d undir-from-test-
63a0: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 id run-id test-i
63b0: 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 d). (rmt:send-r
63c0: 65 63 65 69 76 65 20 27 74 65 73 74 2d 67 65 74 eceive 'test-get
63d0: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 -rundir-from-tes
63e0: 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 t-id run-id (lis
63f0: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
6400: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
6410: 74 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 t:open-test-db-b
6420: 79 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 y-test-id run-id
6430: 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 20 28 test-id #!key (
6440: 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 0a 20 work-area #f)).
6450: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 70 61 (let* ((test-pa
6460: 74 68 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 th (if (string?
6470: 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 77 6f work-area)....wo
6480: 72 6b 2d 61 72 65 61 0a 09 09 09 28 72 6d 74 3a rk-area....(rmt:
6490: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d test-get-rundir-
64a0: 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 72 75 6e from-test-id run
64b0: 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 29 0a -id test-id)))).
64c0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
64d0: 20 33 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 3 *default-log-
64e0: 70 6f 72 74 2a 20 22 54 45 53 54 20 50 41 54 48 port* "TEST PATH
64f0: 3a 20 22 20 74 65 73 74 2d 70 61 74 68 29 0a 20 : " test-path).
6500: 20 20 20 28 6f 70 65 6e 2d 74 65 73 74 2d 64 62 (open-test-db
6510: 20 74 65 73 74 2d 70 61 74 68 29 29 29 0a 0a 3b test-path)))..;
6520: 3b 20 57 41 52 4e 49 4e 47 3a 20 54 68 69 73 20 ; WARNING: This
6530: 63 75 72 72 65 6e 74 6c 79 20 62 79 70 61 73 73 currently bypass
6540: 65 73 20 74 68 65 20 74 72 61 6e 73 61 63 74 69 es the transacti
6550: 6f 6e 20 77 72 61 70 70 65 64 20 77 72 69 74 65 on wrapped write
6560: 73 20 73 79 73 74 65 6d 0a 28 64 65 66 69 6e 65 s system.(define
6570: 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 (rmt:test-set-s
6580: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 tate-status-by-i
6590: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 d run-id test-id
65a0: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
65b0: 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 0a tus newcomment).
65c0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
65d0: 69 76 65 20 27 74 65 73 74 2d 73 65 74 2d 73 74 ive 'test-set-st
65e0: 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 ate-status-by-id
65f0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
6600: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e 65 77 n-id test-id new
6610: 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 state newstatus
6620: 6e 65 77 63 6f 6d 6d 65 6e 74 29 29 29 0a 0a 28 newcomment)))..(
6630: 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d define (rmt:set-
6640: 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 tests-state-stat
6650: 75 73 20 72 75 6e 2d 69 64 20 20 20 20 20 20 20 us run-id
6660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
6670: 65 73 74 6e 61 6d 65 73 20 63 75 72 72 73 74 61 estnames currsta
6680: 74 65 20 63 75 72 72 73 74 61 74 75 73 20 6e 65 te currstatus ne
6690: 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 wstate newstatus
66a0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
66b0: 63 65 69 76 65 20 27 73 65 74 2d 74 65 73 74 73 ceive 'set-tests
66c0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 -state-status ru
66d0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
66e0: 64 20 74 65 73 74 6e 61 6d 65 73 20 63 75 72 72 d testnames curr
66f0: 73 74 61 74 65 20 63 75 72 72 73 74 61 74 75 73 state currstatus
6700: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
6710: 74 75 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 tus)))..(define
6720: 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 (rmt:get-tests-f
6730: 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 or-run run-id te
6740: 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 stpatt states st
6750: 61 74 75 73 65 73 20 6f 66 66 73 65 74 20 6c 69 atuses offset li
6760: 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 6f 72 74 2d mit not-in sort-
6770: 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 20 71 72 by sort-order qr
6780: 79 76 61 6c 73 20 6c 61 73 74 2d 75 70 64 61 74 yvals last-updat
6790: 65 20 6d 6f 64 65 29 0a 20 20 3b 3b 20 28 69 66 e mode). ;; (if
67a0: 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 (number? run-id
67b0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
67c0: 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 74 73 ceive 'get-tests
67d0: 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 -for-run run-id
67e0: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 (list run-id tes
67f0: 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 tpatt states sta
6800: 74 75 73 65 73 20 6f 66 66 73 65 74 20 6c 69 6d tuses offset lim
6810: 69 74 20 6e 6f 74 2d 69 6e 20 73 6f 72 74 2d 62 it not-in sort-b
6820: 79 20 73 6f 72 74 2d 6f 72 64 65 72 20 71 72 79 y sort-order qry
6830: 76 61 6c 73 20 6c 61 73 74 2d 75 70 64 61 74 65 vals last-update
6840: 20 6d 6f 64 65 29 29 29 0a 20 20 3b 3b 20 20 20 mode))). ;;
6850: 20 28 62 65 67 69 6e 0a 20 20 3b 3b 09 28 64 65 (begin. ;;.(de
6860: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
6870: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
6880: 6f 72 74 2a 20 22 72 6d 74 3a 67 65 74 2d 74 65 ort* "rmt:get-te
6890: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 63 61 6c 6c sts-for-run call
68a0: 65 64 20 77 69 74 68 20 62 61 64 20 72 75 6e 2d ed with bad run-
68b0: 69 64 3d 22 20 72 75 6e 2d 69 64 29 0a 20 20 3b id=" run-id). ;
68c0: 3b 09 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 ;.(print-call-ch
68d0: 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 ain (current-err
68e0: 6f 72 2d 70 6f 72 74 29 29 0a 20 20 3b 3b 09 27 or-port)). ;;.'
68f0: 28 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ())))..(define (
6900: 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f rmt:get-tests-fo
6910: 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 r-run-state-stat
6920: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 us run-id testpa
6930: 74 74 20 6c 61 73 74 2d 75 70 64 61 74 65 29 0a tt last-update).
6940: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
6950: 69 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 66 ive 'get-tests-f
6960: 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 or-run-state-sta
6970: 74 75 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 tus run-id (list
6980: 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 run-id testpatt
6990: 20 6c 61 73 74 2d 75 70 64 61 74 65 29 29 29 0a last-update))).
69a0: 0a 3b 3b 20 67 65 74 20 73 74 75 66 66 20 76 69 .;; get stuff vi
69b0: 61 20 73 79 6e 63 68 61 73 68 20 0a 28 64 65 66 a synchash .(def
69c0: 69 6e 65 20 28 72 6d 74 3a 73 79 6e 63 68 61 73 ine (rmt:synchas
69d0: 68 2d 67 65 74 20 72 75 6e 2d 69 64 20 70 72 6f h-get run-id pro
69e0: 63 20 73 79 6e 63 6b 65 79 20 6b 65 79 6e 75 6d c synckey keynum
69f0: 20 70 61 72 61 6d 73 29 0a 20 20 28 72 6d 74 3a params). (rmt:
6a00: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 73 79 send-receive 'sy
6a10: 6e 63 68 61 73 68 2d 67 65 74 20 72 75 6e 2d 69 nchash-get run-i
6a20: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 70 d (list run-id p
6a30: 72 6f 63 20 73 79 6e 63 6b 65 79 20 6b 65 79 6e roc synckey keyn
6a40: 75 6d 20 70 61 72 61 6d 73 29 29 29 0a 0a 28 64 um params)))..(d
6a50: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 efine (rmt:get-t
6a60: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e ests-for-run-min
6a70: 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 data run-id test
6a80: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
6a90: 75 73 20 6e 6f 74 2d 69 6e 29 0a 20 20 28 72 6d us not-in). (rm
6aa0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
6ab0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
6ac0: 6e 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 n-mindata run-id
6ad0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
6ae0: 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 stpatt states st
6af0: 61 74 75 73 20 6e 6f 74 2d 69 6e 29 29 29 0a 20 atus not-in))).
6b00: 20 0a 3b 3b 20 49 44 45 41 3a 20 54 68 72 65 61 .;; IDEA: Threa
6b10: 64 69 66 79 20 74 68 65 73 65 20 2d 20 74 68 65 dify these - the
6b20: 79 20 73 70 65 6e 64 20 61 20 6c 6f 74 20 6f 66 y spend a lot of
6b30: 20 74 69 6d 65 20 77 61 69 74 69 6e 67 20 2e 2e time waiting ..
6b40: 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d ..;;.(define (rm
6b50: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
6b60: 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 6e runs-mindata run
6b70: 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 74 -ids testpatt st
6b80: 61 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 2d ates status not-
6b90: 69 6e 29 0a 20 20 28 6c 65 74 20 28 28 6d 75 6c in). (let ((mul
6ba0: 74 69 2d 72 75 6e 2d 6d 75 74 65 78 20 28 6d 61 ti-run-mutex (ma
6bb0: 6b 65 2d 6d 75 74 65 78 29 29 0a 09 28 72 75 6e ke-mutex))..(run
6bc0: 2d 69 64 2d 6c 69 73 74 20 28 69 66 20 72 75 6e -id-list (if run
6bd0: 2d 69 64 73 0a 09 09 09 20 72 75 6e 2d 69 64 73 -ids.... run-ids
6be0: 0a 09 09 09 20 28 72 6d 74 3a 67 65 74 2d 61 6c .... (rmt:get-al
6bf0: 6c 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 28 72 l-run-ids)))..(r
6c00: 65 73 75 6c 74 20 20 20 20 20 20 27 28 29 29 29 esult '()))
6c10: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
6c20: 72 75 6e 2d 69 64 2d 6c 69 73 74 29 0a 09 27 28 run-id-list)..'(
6c30: 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 )..(let loop ((h
6c40: 65 64 20 20 20 20 20 28 63 61 72 20 72 75 6e 2d ed (car run-
6c50: 69 64 2d 6c 69 73 74 29 29 0a 09 09 20 20 20 28 id-list))... (
6c60: 74 61 6c 20 20 20 20 20 28 63 64 72 20 72 75 6e tal (cdr run
6c70: 2d 69 64 2d 6c 69 73 74 29 29 0a 09 09 20 20 20 -id-list))...
6c80: 28 74 68 72 65 61 64 73 20 27 28 29 29 29 0a 09 (threads '()))..
6c90: 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 (if (> (length
6ca0: 20 74 68 72 65 61 64 73 29 20 35 29 0a 09 20 20 threads) 5)..
6cb0: 20 20 20 20 28 6c 6f 6f 70 20 68 65 64 20 74 61 (loop hed ta
6cc0: 6c 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 l (filter (lambd
6cd0: 61 20 28 74 68 29 28 6e 6f 74 20 28 6d 65 6d 62 a (th)(not (memb
6ce0: 65 72 20 28 74 68 72 65 61 64 2d 73 74 61 74 65 er (thread-state
6cf0: 20 74 68 29 20 27 28 74 65 72 6d 69 6e 61 74 65 th) '(terminate
6d00: 64 20 64 65 61 64 29 29 29 29 20 74 68 72 65 61 d dead)))) threa
6d10: 64 73 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 ds)).. (let
6d20: 2a 20 28 28 6e 65 77 74 68 72 65 61 64 20 28 6d * ((newthread (m
6d30: 61 6b 65 2d 74 68 72 65 61 64 0a 09 09 09 09 20 ake-thread.....
6d40: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 (lambda ().....
6d50: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 72 6d (let ((res (rm
6d60: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
6d70: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
6d80: 6e 2d 6d 69 6e 64 61 74 61 20 68 65 64 20 28 6c n-mindata hed (l
6d90: 69 73 74 20 68 65 64 20 74 65 73 74 70 61 74 74 ist hed testpatt
6da0: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 6e states status n
6db0: 6f 74 2d 69 6e 29 29 29 29 0a 09 09 09 09 20 20 ot-in)))).....
6dc0: 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 72 65 (if (list? re
6dd0: 73 29 0a 09 09 09 09 09 20 28 62 65 67 69 6e 0a s)...... (begin.
6de0: 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 2d 6c ..... (mutex-l
6df0: 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 75 6e 2d 6d ock! multi-run-m
6e00: 75 74 65 78 29 0a 09 09 09 09 09 20 20 20 28 73 utex)...... (s
6e10: 65 74 21 20 72 65 73 75 6c 74 20 28 61 70 70 65 et! result (appe
6e20: 6e 64 20 72 65 73 75 6c 74 20 72 65 73 29 29 0a nd result res)).
6e30: 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 2d 75 ..... (mutex-u
6e40: 6e 6c 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 75 6e nlock! multi-run
6e50: 2d 6d 75 74 65 78 29 29 0a 09 09 09 09 09 20 28 -mutex))...... (
6e60: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
6e70: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
6e80: 2d 70 6f 72 74 2a 20 22 67 65 74 2d 74 65 73 74 -port* "get-test
6e90: 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 s-for-run-mindat
6ea0: 61 20 66 61 69 6c 65 64 20 66 6f 72 20 72 75 6e a failed for run
6eb0: 2d 69 64 20 22 20 68 65 64 20 22 2c 20 74 65 73 -id " hed ", tes
6ec0: 74 70 61 74 74 20 22 20 74 65 73 74 70 61 74 74 tpatt " testpatt
6ed0: 20 22 2c 20 73 74 61 74 65 73 20 22 20 73 74 61 ", states " sta
6ee0: 74 65 73 20 22 2c 20 73 74 61 74 75 73 20 22 20 tes ", status "
6ef0: 73 74 61 74 75 73 20 22 2c 20 6e 6f 74 2d 69 6e status ", not-in
6f00: 20 22 20 6e 6f 74 2d 69 6e 29 29 29 29 0a 09 09 " not-in))))...
6f10: 09 09 20 28 63 6f 6e 63 20 22 6d 75 6c 74 69 2d .. (conc "multi-
6f20: 72 75 6e 2d 74 68 72 65 61 64 20 66 6f 72 20 72 run-thread for r
6f30: 75 6e 2d 69 64 20 22 20 68 65 64 29 29 29 0a 09 un-id " hed)))..
6f40: 09 20 20 20 20 20 28 6e 65 77 74 68 72 65 61 64 . (newthread
6f50: 73 20 28 63 6f 6e 73 20 6e 65 77 74 68 72 65 61 s (cons newthrea
6f60: 64 20 74 68 72 65 61 64 73 29 29 29 0a 09 09 28 d threads)))...(
6f70: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 6e 65 thread-start! ne
6f80: 77 74 68 72 65 61 64 29 0a 09 09 28 74 68 72 65 wthread)...(thre
6f90: 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 35 29 20 ad-sleep! 0.05)
6fa0: 3b 3b 20 67 69 76 65 20 74 68 61 74 20 74 68 72 ;; give that thr
6fb0: 65 61 64 20 73 6f 6d 65 20 74 69 6d 65 20 74 6f ead some time to
6fc0: 20 73 74 61 72 74 0a 09 09 28 69 66 20 28 6e 75 start...(if (nu
6fd0: 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 20 20 6e ll? tal)... n
6fe0: 65 77 74 68 72 65 61 64 73 0a 09 09 20 20 20 20 ewthreads...
6ff0: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
7000: 63 64 72 20 74 61 6c 29 20 6e 65 77 74 68 72 65 cdr tal) newthre
7010: 61 64 73 29 29 29 29 29 29 0a 20 20 20 20 72 65 ads)))))). re
7020: 73 75 6c 74 29 29 0a 0a 3b 3b 20 3b 3b 20 49 44 sult))..;; ;; ID
7030: 45 41 3a 20 54 68 72 65 61 64 69 66 79 20 74 68 EA: Threadify th
7040: 65 73 65 20 2d 20 74 68 65 79 20 73 70 65 6e 64 ese - they spend
7050: 20 61 20 6c 6f 74 20 6f 66 20 74 69 6d 65 20 77 a lot of time w
7060: 61 69 74 69 6e 67 20 2e 2e 2e 0a 3b 3b 20 3b 3b aiting ....;; ;;
7070: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 72 6d 74 .;; (define (rmt
7080: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
7090: 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d uns-mindata run-
70a0: 69 64 73 20 74 65 73 74 70 61 74 74 20 73 74 61 ids testpatt sta
70b0: 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 tes status not-i
70c0: 6e 29 0a 3b 3b 20 20 20 28 6c 65 74 20 28 28 72 n).;; (let ((r
70d0: 75 6e 2d 69 64 2d 6c 69 73 74 20 28 69 66 20 72 un-id-list (if r
70e0: 75 6e 2d 69 64 73 0a 3b 3b 20 09 09 09 20 72 75 un-ids.;; ... ru
70f0: 6e 2d 69 64 73 0a 3b 3b 20 09 09 09 20 28 72 6d n-ids.;; ... (rm
7100: 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 t:get-all-run-id
7110: 73 29 29 29 29 0a 3b 3b 20 20 20 20 20 28 61 70 s)))).;; (ap
7120: 70 6c 79 20 61 70 70 65 6e 64 20 28 6d 61 70 20 ply append (map
7130: 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 (lambda (run-id)
7140: 0a 3b 3b 20 09 09 09 20 28 72 6d 74 3a 73 65 6e .;; ... (rmt:sen
7150: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 d-receive 'get-t
7160: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e ests-for-run-min
7170: 64 61 74 61 20 72 75 6e 2d 69 64 20 28 6c 69 73 data run-id (lis
7180: 74 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 t run-ids testpa
7190: 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 tt states status
71a0: 20 6e 6f 74 2d 69 6e 29 29 29 0a 3b 3b 20 09 09 not-in))).;; ..
71b0: 20 20 20 20 20 20 20 72 75 6e 2d 69 64 2d 6c 69 run-id-li
71c0: 73 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 st))))..(define
71d0: 28 72 6d 74 3a 64 65 6c 65 74 65 2d 74 65 73 74 (rmt:delete-test
71e0: 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 -records run-id
71f0: 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a test-id). (rmt:
7200: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 send-receive 'de
7210: 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 lete-test-record
7220: 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 s run-id (list r
7230: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 un-id test-id)))
7240: 0a 0a 3b 3b 20 54 68 69 73 20 69 73 20 6e 6f 74 ..;; This is not
7250: 20 6e 65 65 64 65 64 20 61 73 20 74 65 73 74 20 needed as test
7260: 73 74 65 70 73 20 61 72 65 20 64 65 6c 65 74 65 steps are delete
7270: 64 20 6f 6e 20 74 65 73 74 20 64 65 6c 65 74 65 d on test delete
7280: 20 63 61 6c 6c 0a 3b 3b 0a 3b 3b 20 28 64 65 66 call.;;.;; (def
7290: 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d ine (rmt:delete-
72a0: 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 test-step-record
72b0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
72c0: 29 0a 3b 3b 20 20 20 28 72 6d 74 3a 73 65 6e 64 ).;; (rmt:send
72d0: 2d 72 65 63 65 69 76 65 20 27 64 65 6c 65 74 65 -receive 'delete
72e0: 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 -test-step-recor
72f0: 64 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 ds run-id (list
7300: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 run-id test-id))
7310: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
7320: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
7330: 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 tatus run-id tes
7340: 74 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 75 t-id state statu
7350: 73 20 6d 73 67 29 0a 20 20 28 72 6d 74 3a 73 65 s msg). (rmt:se
7360: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
7370: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
7380: 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 s run-id (list r
7390: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
73a0: 61 74 65 20 73 74 61 74 75 73 20 6d 73 67 29 29 ate status msg))
73b0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
73c0: 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 test-toplevel-nu
73d0: 6d 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 m-items run-id t
73e0: 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 72 6d 74 est-name). (rmt
73f0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
7400: 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d est-toplevel-num
7410: 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 28 6c -items run-id (l
7420: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
7430: 6e 61 6d 65 29 29 29 0a 0a 3b 3b 20 28 64 65 66 name)))..;; (def
7440: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 ine (rmt:get-pre
7450: 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 vious-test-run-r
7460: 65 63 6f 72 64 20 72 75 6e 2d 69 64 20 74 65 73 ecord run-id tes
7470: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
7480: 29 0a 3b 3b 20 20 20 28 72 6d 74 3a 73 65 6e 64 ).;; (rmt:send
7490: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 70 72 -receive 'get-pr
74a0: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
74b0: 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 20 28 6c record run-id (l
74c0: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
74d0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
74e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
74f0: 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d 70 72 65 get-matching-pre
7500: 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 vious-test-run-r
7510: 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 74 65 ecords run-id te
7520: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
7530: 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 h). (rmt:send-r
7540: 65 63 65 69 76 65 20 27 67 65 74 2d 6d 61 74 63 eceive 'get-matc
7550: 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 hing-previous-te
7560: 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 72 st-run-records r
7570: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
7580: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
7590: 6d 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 m-path)))..(defi
75a0: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 ne (rmt:test-get
75b0: 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 72 75 -logfile-info ru
75c0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a n-id test-name).
75d0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
75e0: 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d 6c 6f ive 'test-get-lo
75f0: 67 66 69 6c 65 2d 69 6e 66 6f 20 72 75 6e 2d 69 gfile-info run-i
7600: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
7610: 65 73 74 2d 6e 61 6d 65 29 29 29 0a 0a 28 64 65 est-name)))..(de
7620: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 fine (rmt:test-g
7630: 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 et-records-for-i
7640: 6e 64 65 78 2d 66 69 6c 65 20 72 75 6e 2d 69 64 ndex-file run-id
7650: 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 72 test-name). (r
7660: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
7670: 27 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 'test-get-record
7680: 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 s-for-index-file
7690: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
76a0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 n-id test-name))
76b0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
76c0: 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 get-testinfo-sta
76d0: 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 te-status run-id
76e0: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 test-id). (rmt
76f0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
7700: 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 et-testinfo-stat
7710: 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 e-status run-id
7720: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 (list run-id tes
7730: 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 t-id)))..(define
7740: 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c (rmt:test-set-l
7750: 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d og! run-id test-
7760: 69 64 20 6c 6f 67 66 29 0a 20 20 28 69 66 20 28 id logf). (if (
7770: 73 74 72 69 6e 67 3f 20 6c 6f 67 66 29 28 72 6d string? logf)(rm
7780: 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 t:general-call '
7790: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 20 72 75 6e test-set-log run
77a0: 2d 69 64 20 6c 6f 67 66 20 74 65 73 74 2d 69 64 -id logf test-id
77b0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
77c0: 74 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 t:test-set-top-p
77d0: 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 rocess-pid run-i
77e0: 64 20 74 65 73 74 2d 69 64 20 70 69 64 29 0a 20 d test-id pid).
77f0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7800: 76 65 20 27 74 65 73 74 2d 73 65 74 2d 74 6f 70 ve 'test-set-top
7810: 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e -process-pid run
7820: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
7830: 20 74 65 73 74 2d 69 64 20 70 69 64 29 29 29 0a test-id pid))).
7840: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 .(define (rmt:te
7850: 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 st-get-top-proce
7860: 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 65 ss-pid run-id te
7870: 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 st-id). (rmt:se
7880: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
7890: 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -get-top-process
78a0: 2d 70 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 -pid run-id (lis
78b0: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
78c0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
78d0: 74 3a 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 t:get-run-ids-ma
78e0: 74 63 68 69 6e 67 2d 74 61 72 67 65 74 20 6b 65 tching-target ke
78f0: 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 72 65 ynames target re
7900: 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 70 61 s runname testpa
7910: 74 74 20 73 74 61 74 65 70 61 74 74 20 73 74 61 tt statepatt sta
7920: 74 75 73 70 61 74 74 29 0a 20 20 28 72 6d 74 3a tuspatt). (rmt:
7930: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
7940: 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 t-run-ids-matchi
7950: 6e 67 2d 74 61 72 67 65 74 20 23 66 20 28 6c 69 ng-target #f (li
7960: 73 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 st keynames targ
7970: 65 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 74 et res runname t
7980: 65 73 74 70 61 74 74 20 73 74 61 74 65 70 61 74 estpatt statepat
7990: 74 20 73 74 61 74 75 73 70 61 74 74 29 29 29 0a t statuspatt))).
79a0: 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 69 73 20 77 .;; NOTE: This w
79b0: 69 6c 6c 20 6f 70 65 6e 20 61 6e 64 20 61 63 63 ill open and acc
79c0: 65 73 73 20 41 4c 4c 20 72 75 6e 20 64 61 74 61 ess ALL run data
79d0: 62 61 73 65 73 2e 20 0a 3b 3b 0a 28 64 65 66 69 bases. .;;.(defi
79e0: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 ne (rmt:test-get
79f0: 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d -paths-matching-
7a00: 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d keynames-target-
7a10: 6e 65 77 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 new keynames tar
7a20: 67 65 74 20 72 65 73 20 74 65 73 74 70 61 74 74 get res testpatt
7a30: 20 73 74 61 74 65 70 61 74 74 20 73 74 61 74 75 statepatt statu
7a40: 73 70 61 74 74 20 72 75 6e 6e 61 6d 65 29 0a 20 spatt runname).
7a50: 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 73 20 (let ((run-ids
7a60: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 64 73 (rmt:get-run-ids
7a70: 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 -matching-target
7a80: 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 keynames target
7a90: 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 res runname tes
7aa0: 74 70 61 74 74 20 73 74 61 74 65 70 61 74 74 20 tpatt statepatt
7ab0: 73 74 61 74 75 73 70 61 74 74 29 29 29 0a 20 20 statuspatt))).
7ac0: 20 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 20 (apply append
7ad0: 0a 09 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 .. (map (lambd
7ae0: 61 20 28 72 75 6e 2d 69 64 29 0a 09 09 20 20 28 a (run-id)... (
7af0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7b00: 20 27 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 'test-get-paths
7b10: 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d -matching-keynam
7b20: 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 20 72 75 es-target-new ru
7b30: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
7b40: 64 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 d keynames targe
7b50: 74 20 72 65 73 20 74 65 73 74 70 61 74 74 20 73 t res testpatt s
7b60: 74 61 74 65 70 61 74 74 20 73 74 61 74 75 73 70 tatepatt statusp
7b70: 61 74 74 20 72 75 6e 6e 61 6d 65 29 29 29 0a 09 att runname)))..
7b80: 20 20 20 72 75 6e 2d 69 64 73 29 29 29 29 0a 0a run-ids))))..
7b90: 3b 3b 20 28 64 65 66 69 6e 65 20 28 72 6d 74 3a ;; (define (rmt:
7ba0: 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 get-run-ids-matc
7bb0: 68 69 6e 67 20 6b 65 79 6e 61 6d 65 73 20 74 61 hing keynames ta
7bc0: 72 67 65 74 20 72 65 73 29 0a 3b 3b 20 20 20 28 rget res).;; (
7bd0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7be0: 20 23 66 20 27 67 65 74 2d 72 75 6e 2d 69 64 73 #f 'get-run-ids
7bf0: 2d 6d 61 74 63 68 69 6e 67 20 28 6c 69 73 74 20 -matching (list
7c00: 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 keynames target
7c10: 72 65 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 res)))..(define
7c20: 28 72 6d 74 3a 67 65 74 2d 70 72 65 72 65 71 73 (rmt:get-prereqs
7c30: 2d 6e 6f 74 2d 6d 65 74 20 72 75 6e 2d 69 64 20 -not-met run-id
7c40: 77 61 69 74 6f 6e 73 20 72 65 66 2d 74 65 73 74 waitons ref-test
7c50: 2d 6e 61 6d 65 20 72 65 66 2d 69 74 65 6d 2d 70 -name ref-item-p
7c60: 61 74 68 20 23 21 6b 65 79 20 28 6d 6f 64 65 20 ath #!key (mode
7c70: 27 28 6e 6f 72 6d 61 6c 29 29 28 69 74 65 6d 6d '(normal))(itemm
7c80: 61 70 73 20 23 66 29 29 0a 20 20 28 72 6d 74 3a aps #f)). (rmt:
7c90: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
7ca0: 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 t-prereqs-not-me
7cb0: 74 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 t run-id (list r
7cc0: 75 6e 2d 69 64 20 77 61 69 74 6f 6e 73 20 72 65 un-id waitons re
7cd0: 66 2d 74 65 73 74 2d 6e 61 6d 65 20 72 65 66 2d f-test-name ref-
7ce0: 69 74 65 6d 2d 70 61 74 68 20 6d 6f 64 65 20 69 item-path mode i
7cf0: 74 65 6d 6d 61 70 73 29 29 29 0a 0a 28 64 65 66 temmaps)))..(def
7d00: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 ine (rmt:get-cou
7d10: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
7d20: 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 72 75 6e 2d -for-run-id run-
7d30: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
7d40: 72 65 63 65 69 76 65 20 27 67 65 74 2d 63 6f 75 receive 'get-cou
7d50: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
7d60: 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 72 75 6e 2d -for-run-id run-
7d70: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 id (list run-id)
7d80: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
7d90: 3a 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 :get-not-complet
7da0: 65 64 2d 63 6e 74 20 72 75 6e 2d 69 64 29 0a 20 ed-cnt run-id).
7db0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7dc0: 76 65 20 27 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 ve 'get-not-comp
7dd0: 6c 65 74 65 64 2d 63 6e 74 20 72 75 6e 2d 69 64 leted-cnt run-id
7de0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
7df0: 0a 0a 0a 3b 3b 20 53 74 61 74 69 73 74 69 63 61 ...;; Statistica
7e00: 6c 20 71 75 65 72 69 65 73 0a 0a 28 64 65 66 69 l queries..(defi
7e10: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e ne (rmt:get-coun
7e20: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 20 t-tests-running
7e30: 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 run-id). (rmt:s
7e40: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
7e50: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
7e60: 6e 69 6e 67 20 72 75 6e 2d 69 64 20 28 6c 69 73 ning run-id (lis
7e70: 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 t run-id)))..(de
7e80: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f fine (rmt:get-co
7e90: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
7ea0: 67 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 20 72 g-for-testname r
7eb0: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 29 0a un-id testname).
7ec0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
7ed0: 69 76 65 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 ive 'get-count-t
7ee0: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 ests-running-for
7ef0: 2d 74 65 73 74 6e 61 6d 65 20 72 75 6e 2d 69 64 -testname run-id
7f00: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
7f10: 73 74 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 stname)))..(defi
7f20: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e ne (rmt:get-coun
7f30: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d t-tests-running-
7f40: 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 72 75 6e 2d in-jobgroup run-
7f50: 69 64 20 6a 6f 62 67 72 6f 75 70 29 0a 20 20 28 id jobgroup). (
7f60: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7f70: 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 'get-count-test
7f80: 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 s-running-in-job
7f90: 67 72 6f 75 70 20 72 75 6e 2d 69 64 20 28 6c 69 group run-id (li
7fa0: 73 74 20 72 75 6e 2d 69 64 20 6a 6f 62 67 72 6f st run-id jobgro
7fb0: 75 70 29 29 29 0a 0a 3b 3b 20 73 74 61 74 65 20 up)))..;; state
7fc0: 61 6e 64 20 73 74 61 74 75 73 20 61 72 65 20 65 and status are e
7fd0: 78 74 72 61 20 68 69 6e 74 73 20 6e 6f 74 20 75 xtra hints not u
7fe0: 73 75 61 6c 6c 79 20 75 73 65 64 20 69 6e 20 74 sually used in t
7ff0: 68 65 20 63 61 6c 63 75 6c 61 74 69 6f 6e 0a 3b he calculation.;
8000: 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 ;.(define (rmt:s
8010: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
8020: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d and-roll-up-item
8030: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 s run-id test-na
8040: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 me item-path sta
8050: 74 65 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e te status commen
8060: 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 t). (rmt:send-r
8070: 65 63 65 69 76 65 20 27 73 65 74 2d 73 74 61 74 eceive 'set-stat
8080: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
8090: 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e 2d 69 l-up-items run-i
80a0: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
80b0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
80c0: 74 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20 th state status
80d0: 63 6f 6d 6d 65 6e 74 29 29 29 0a 0a 28 64 65 66 comment)))..(def
80e0: 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 ine (rmt:set-sta
80f0: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
8100: 6c 6c 2d 75 70 2d 72 75 6e 20 72 75 6e 2d 69 64 ll-up-run run-id
8110: 20 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 20 state status).
8120: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
8130: 76 65 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 ve 'set-state-st
8140: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
8150: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 28 6c 69 73 -run run-id (lis
8160: 74 20 72 75 6e 2d 69 64 20 73 74 61 74 65 20 73 t run-id state s
8170: 74 61 74 75 73 29 29 29 0a 0a 0a 28 64 65 66 69 tatus)))...(defi
8180: 6e 65 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 70 ne (rmt:update-p
8190: 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 ass-fail-counts
81a0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
81b0: 29 0a 20 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c ). (rmt:general
81c0: 2d 63 61 6c 6c 20 27 75 70 64 61 74 65 2d 70 61 -call 'update-pa
81d0: 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 ss-fail-counts r
81e0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
81f0: 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e test-name test-n
8200: 61 6d 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ame))..(define (
8210: 72 6d 74 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 rmt:top-test-set
8220: 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 72 -per-pf-counts r
8230: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 un-id test-name)
8240: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
8250: 65 69 76 65 20 27 74 6f 70 2d 74 65 73 74 2d 73 eive 'top-test-s
8260: 65 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 et-per-pf-counts
8270: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
8280: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 n-id test-name))
8290: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
82a0: 67 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 get-raw-run-stat
82b0: 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 s run-id). (rmt
82c0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
82d0: 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 et-raw-run-stats
82e0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
82f0: 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 n-id)))..(define
8300: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 74 (rmt:get-test-t
8310: 69 6d 65 73 20 72 75 6e 6e 61 6d 65 20 74 61 72 imes runname tar
8320: 67 65 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 get). (rmt:send
8330: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 -receive 'get-te
8340: 73 74 2d 74 69 6d 65 73 20 23 66 20 28 6c 69 73 st-times #f (lis
8350: 74 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 t runname target
8360: 20 29 29 29 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ))) ..;;=======
8370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
83b0: 3b 3b 20 20 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d ;; R U N S.;;==
83c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8400: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 ====..(define (r
8410: 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 mt:get-run-info
8420: 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 run-id). (rmt:s
8430: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
8440: 2d 72 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 -run-info run-id
8450: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
8460: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
8470: 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 72 75 6e 70 et-num-runs runp
8480: 61 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 att). (rmt:send
8490: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6e 75 -receive 'get-nu
84a0: 6d 2d 72 75 6e 73 20 23 66 20 28 6c 69 73 74 20 m-runs #f (list
84b0: 72 75 6e 70 61 74 74 29 29 29 0a 0a 28 64 65 66 runpatt)))..(def
84c0: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ine (rmt:get-run
84d0: 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 72 75 s-cnt-by-patt ru
84e0: 6e 70 61 74 74 20 74 61 72 67 65 74 70 61 74 74 npatt targetpatt
84f0: 20 6b 65 79 73 29 0a 20 20 28 72 6d 74 3a 73 65 keys). (rmt:se
8500: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
8510: 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 runs-cnt-by-patt
8520: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 61 74 #f (list runpat
8530: 74 20 20 74 61 72 67 65 74 70 61 74 74 20 6b 65 t targetpatt ke
8540: 79 73 29 29 29 0a 0a 3b 3b 20 55 73 65 20 74 68 ys)))..;; Use th
8550: 65 20 73 70 65 63 69 61 6c 20 72 75 6e 2d 69 64 e special run-id
8560: 20 3d 3d 20 23 66 20 73 63 65 6e 61 72 69 6f 20 == #f scenario
8570: 68 65 72 65 20 73 69 6e 63 65 20 74 68 65 72 65 here since there
8580: 20 69 73 20 6e 6f 20 72 75 6e 20 79 65 74 0a 28 is no run yet.(
8590: 64 65 66 69 6e 65 20 28 72 6d 74 3a 72 65 67 69 define (rmt:regi
85a0: 73 74 65 72 2d 72 75 6e 20 6b 65 79 76 61 6c 73 ster-run keyvals
85b0: 20 72 75 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 runname state s
85c0: 74 61 74 75 73 20 75 73 65 72 20 63 6f 6e 74 6f tatus user conto
85d0: 75 72 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ur). (rmt:send-
85e0: 72 65 63 65 69 76 65 20 27 72 65 67 69 73 74 65 receive 'registe
85f0: 72 2d 72 75 6e 20 23 66 20 28 6c 69 73 74 20 6b r-run #f (list k
8600: 65 79 76 61 6c 73 20 72 75 6e 6e 61 6d 65 20 73 eyvals runname s
8610: 74 61 74 65 20 73 74 61 74 75 73 20 75 73 65 72 tate status user
8620: 20 63 6f 6e 74 6f 75 72 29 29 29 0a 20 20 20 20 contour))).
8630: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
8640: 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d t-run-name-from-
8650: 69 64 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d id run-id). (rm
8660: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
8670: 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f get-run-name-fro
8680: 6d 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 m-id run-id (lis
8690: 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 t run-id)))..(de
86a0: 66 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 fine (rmt:delete
86b0: 2d 72 75 6e 20 72 75 6e 2d 69 64 29 0a 20 20 28 -run run-id). (
86c0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
86d0: 20 27 64 65 6c 65 74 65 2d 72 75 6e 20 72 75 6e 'delete-run run
86e0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
86f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
8700: 74 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 t:update-run-sta
8710: 74 73 20 72 75 6e 2d 69 64 20 73 74 61 74 73 29 ts run-id stats)
8720: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
8730: 65 69 76 65 20 27 75 70 64 61 74 65 2d 72 75 6e eive 'update-run
8740: 2d 73 74 61 74 73 20 23 66 20 28 6c 69 73 74 20 -stats #f (list
8750: 72 75 6e 2d 69 64 20 73 74 61 74 73 29 29 29 0a run-id stats))).
8760: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 .(define (rmt:de
8770: 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 lete-old-deleted
8780: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 29 0a 20 -test-records).
8790: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
87a0: 76 65 20 27 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 ve 'delete-old-d
87b0: 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 63 6f eleted-test-reco
87c0: 72 64 73 20 23 66 20 27 28 29 29 29 0a 0a 28 64 rds #f '()))..(d
87d0: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 efine (rmt:get-r
87e0: 75 6e 73 20 72 75 6e 70 61 74 74 20 63 6f 75 6e uns runpatt coun
87f0: 74 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74 74 t offset keypatt
8800: 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 s). (rmt:send-r
8810: 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e 73 eceive 'get-runs
8820: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 61 74 #f (list runpat
8830: 74 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 6b t count offset k
8840: 65 79 70 61 74 74 73 29 29 29 0a 0a 28 64 65 66 eypatts)))..(def
8850: 69 6e 65 20 28 72 6d 74 3a 73 69 6d 70 6c 65 2d ine (rmt:simple-
8860: 67 65 74 2d 72 75 6e 73 20 72 75 6e 70 61 74 74 get-runs runpatt
8870: 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 74 61 count offset ta
8880: 72 67 65 74 20 6c 61 73 74 2d 75 70 64 61 74 65 rget last-update
8890: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
88a0: 63 65 69 76 65 20 27 73 69 6d 70 6c 65 2d 67 65 ceive 'simple-ge
88b0: 74 2d 72 75 6e 73 20 23 66 20 28 6c 69 73 74 20 t-runs #f (list
88c0: 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f 66 runpatt count of
88d0: 66 73 65 74 20 74 61 72 67 65 74 20 6c 61 73 74 fset target last
88e0: 2d 75 70 64 61 74 65 29 29 29 0a 0a 28 64 65 66 -update)))..(def
88f0: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 61 6c 6c ine (rmt:get-all
8900: 2d 72 75 6e 2d 69 64 73 29 0a 20 20 28 72 6d 74 -run-ids). (rmt
8910: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
8920: 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 23 et-all-run-ids #
8930: 66 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 f '()))..(define
8940: 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 (rmt:get-prev-r
8950: 75 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 0a 20 un-ids run-id).
8960: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
8970: 76 65 20 27 67 65 74 2d 70 72 65 76 2d 72 75 6e ve 'get-prev-run
8980: 2d 69 64 73 20 23 66 20 28 6c 69 73 74 20 72 75 -ids #f (list ru
8990: 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 n-id)))..(define
89a0: 20 28 72 6d 74 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 (rmt:lock/unloc
89b0: 6b 2d 72 75 6e 20 72 75 6e 2d 69 64 20 6c 6f 63 k-run run-id loc
89c0: 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 72 29 0a 20 k unlock user).
89d0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
89e0: 76 65 20 27 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d ve 'lock/unlock-
89f0: 72 75 6e 20 23 66 20 28 6c 69 73 74 20 72 75 6e run #f (list run
8a00: 2d 69 64 20 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 -id lock unlock
8a10: 75 73 65 72 29 29 29 0a 0a 3b 3b 20 73 65 74 2f user)))..;; set/
8a20: 67 65 74 20 73 74 61 74 75 73 0a 28 64 65 66 69 get status.(defi
8a30: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d ne (rmt:get-run-
8a40: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 0a 20 status run-id).
8a50: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
8a60: 76 65 20 27 67 65 74 2d 72 75 6e 2d 73 74 61 74 ve 'get-run-stat
8a70: 75 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d us #f (list run-
8a80: 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 id)))..(define (
8a90: 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 rmt:get-run-stat
8aa0: 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 e run-id). (rmt
8ab0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
8ac0: 65 74 2d 72 75 6e 2d 73 74 61 74 65 20 23 66 20 et-run-state #f
8ad0: 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a (list run-id))).
8ae0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 ..(define (rmt:s
8af0: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 75 et-run-status ru
8b00: 6e 2d 69 64 20 72 75 6e 2d 73 74 61 74 75 73 20 n-id run-status
8b10: 23 21 6b 65 79 20 28 6d 73 67 20 23 66 29 29 0a #!key (msg #f)).
8b20: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
8b30: 69 76 65 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 ive 'set-run-sta
8b40: 74 75 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e tus #f (list run
8b50: 2d 69 64 20 72 75 6e 2d 73 74 61 74 75 73 20 6d -id run-status m
8b60: 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 sg)))..(define (
8b70: 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 rmt:set-run-stat
8b80: 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 e-status run-id
8b90: 73 74 61 74 65 20 73 74 61 74 75 73 20 29 0a 20 state status ).
8ba0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
8bb0: 76 65 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 74 ve 'set-run-stat
8bc0: 65 2d 73 74 61 74 75 73 20 23 66 20 28 6c 69 73 e-status #f (lis
8bd0: 74 20 72 75 6e 2d 69 64 20 73 74 61 74 65 20 73 t run-id state s
8be0: 74 61 74 75 73 29 29 29 0a 0a 0a 28 64 65 66 69 tatus)))...(defi
8bf0: 6e 65 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 72 ne (rmt:update-r
8c00: 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 72 75 un-event_time ru
8c10: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
8c20: 64 2d 72 65 63 65 69 76 65 20 27 75 70 64 61 74 d-receive 'updat
8c30: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 e-run-event_time
8c40: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 #f (list run-id
8c50: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
8c60: 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 t:get-runs-by-pa
8c70: 74 74 20 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 tt keys runname
8c80: 70 61 74 74 20 74 61 72 67 70 61 74 74 20 6f 66 patt targpatt of
8c90: 66 73 65 74 20 6c 69 6d 69 74 20 66 69 65 6c 64 fset limit field
8ca0: 73 20 6c 61 73 74 2d 72 75 6e 73 2d 75 70 64 61 s last-runs-upda
8cb0: 74 65 20 20 23 21 6b 65 79 20 20 28 73 6f 72 74 te #!key (sort
8cc0: 2d 6f 72 64 65 72 20 22 61 73 63 22 29 29 20 3b -order "asc")) ;
8cd0: 3b 20 66 69 65 6c 64 73 20 6f 66 20 23 66 20 75 ; fields of #f u
8ce0: 73 65 73 20 64 65 66 61 75 6c 74 0a 20 20 28 72 ses default. (r
8cf0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8d00: 27 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 'get-runs-by-pat
8d10: 74 20 23 66 20 28 6c 69 73 74 20 6b 65 79 73 20 t #f (list keys
8d20: 72 75 6e 6e 61 6d 65 70 61 74 74 20 74 61 72 67 runnamepatt targ
8d30: 70 61 74 74 20 6f 66 66 73 65 74 20 6c 69 6d 69 patt offset limi
8d40: 74 20 66 69 65 6c 64 73 20 6c 61 73 74 2d 72 75 t fields last-ru
8d50: 6e 73 2d 75 70 64 61 74 65 20 73 6f 72 74 2d 6f ns-update sort-o
8d60: 72 64 65 72 29 29 29 0a 0a 28 64 65 66 69 6e 65 rder)))..(define
8d70: 20 28 72 6d 74 3a 66 69 6e 64 2d 61 6e 64 2d 6d (rmt:find-and-m
8d80: 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 72 ark-incomplete r
8d90: 75 6e 2d 69 64 20 6f 76 72 2d 64 65 61 64 74 69 un-id ovr-deadti
8da0: 6d 65 29 0a 20 20 3b 3b 20 28 69 66 20 28 72 6d me). ;; (if (rm
8db0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
8dc0: 68 61 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 have-incompletes
8dd0: 3f 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 ? run-id (list r
8de0: 75 6e 2d 69 64 20 6f 76 72 2d 64 65 61 64 74 69 un-id ovr-deadti
8df0: 6d 65 29 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 me)). (rmt:send
8e00: 2d 72 65 63 65 69 76 65 20 27 6d 61 72 6b 2d 69 -receive 'mark-i
8e10: 6e 63 6f 6d 70 6c 65 74 65 20 72 75 6e 2d 69 64 ncomplete run-id
8e20: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 6f 76 (list run-id ov
8e30: 72 2d 64 65 61 64 74 69 6d 65 29 29 29 20 3b 3b r-deadtime))) ;;
8e40: 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 )..(define (rmt
8e50: 3a 67 65 74 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 :get-main-run-st
8e60: 61 74 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 ats run-id). (r
8e70: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8e80: 27 67 65 74 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 'get-main-run-st
8e90: 61 74 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e ats #f (list run
8ea0: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
8eb0: 28 72 6d 74 3a 67 65 74 2d 76 61 72 20 76 61 72 (rmt:get-var var
8ec0: 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e name). (rmt:sen
8ed0: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 76 d-receive 'get-v
8ee0: 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 72 6e ar #f (list varn
8ef0: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
8f00: 28 72 6d 74 3a 64 65 6c 2d 76 61 72 20 76 61 72 (rmt:del-var var
8f10: 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e name). (rmt:sen
8f20: 64 2d 72 65 63 65 69 76 65 20 27 64 65 6c 2d 76 d-receive 'del-v
8f30: 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 72 6e ar #f (list varn
8f40: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
8f50: 28 72 6d 74 3a 73 65 74 2d 76 61 72 20 76 61 72 (rmt:set-var var
8f60: 6e 61 6d 65 20 76 61 6c 75 65 29 0a 20 20 28 72 name value). (r
8f70: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8f80: 27 73 65 74 2d 76 61 72 20 23 66 20 28 6c 69 73 'set-var #f (lis
8f90: 74 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 29 t varname value)
8fa0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
8fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
8ff0: 4d 20 55 20 4c 20 54 20 49 20 52 20 55 20 4e 20 M U L T I R U N
9000: 20 20 51 20 55 20 45 20 52 20 49 20 45 20 53 0a Q U E R I E S.
9010: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9050: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 65 65 ========..;; Nee
9060: 64 20 74 6f 20 6d 6f 76 65 20 74 68 69 73 20 74 d to move this t
9070: 6f 20 6d 75 6c 74 69 2d 72 75 6e 20 73 65 63 74 o multi-run sect
9080: 69 6f 6e 20 61 6e 64 20 6d 61 6b 65 20 61 73 73 ion and make ass
9090: 6f 63 69 61 74 65 64 20 63 68 61 6e 67 65 73 0a ociated changes.
90a0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e (define (rmt:fin
90b0: 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d d-and-mark-incom
90c0: 70 6c 65 74 65 2d 61 6c 6c 2d 72 75 6e 73 20 23 plete-all-runs #
90d0: 21 6b 65 79 20 28 6f 76 72 2d 64 65 61 64 74 69 !key (ovr-deadti
90e0: 6d 65 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 me #f)). (let (
90f0: 28 72 75 6e 2d 69 64 73 20 28 72 6d 74 3a 67 65 (run-ids (rmt:ge
9100: 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 t-all-run-ids)))
9110: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
9120: 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a lambda (run-id).
9130: 09 20 20 20 20 20 20 20 28 72 6d 74 3a 66 69 6e . (rmt:fin
9140: 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d d-and-mark-incom
9150: 70 6c 65 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 plete run-id ovr
9160: 2d 64 65 61 64 74 69 6d 65 29 29 0a 09 20 20 20 -deadtime))..
9170: 20 20 72 75 6e 2d 69 64 73 29 29 29 0a 0a 3b 3b run-ids)))..;;
9180: 20 67 65 74 20 74 68 65 20 70 72 65 76 69 6f 75 get the previou
9190: 73 20 72 65 63 6f 72 64 20 66 6f 72 20 77 68 65 s record for whe
91a0: 6e 20 74 68 69 73 20 74 65 73 74 20 77 61 73 20 n this test was
91b0: 72 75 6e 20 77 68 65 72 65 20 61 6c 6c 20 6b 65 run where all ke
91c0: 79 73 20 6d 61 74 63 68 20 62 75 74 20 72 75 6e ys match but run
91d0: 6e 61 6d 65 0a 3b 3b 20 72 65 74 75 72 6e 73 20 name.;; returns
91e0: 23 66 20 69 66 20 6e 6f 20 73 75 63 68 20 74 65 #f if no such te
91f0: 73 74 20 66 6f 75 6e 64 2c 20 72 65 74 75 72 6e st found, return
9200: 73 20 61 20 73 69 6e 67 6c 65 20 74 65 73 74 20 s a single test
9210: 72 65 63 6f 72 64 20 69 66 20 66 6f 75 6e 64 0a record if found.
9220: 3b 3b 20 0a 3b 3b 20 52 75 6e 20 74 68 69 73 20 ;; .;; Run this
9230: 61 74 20 74 68 65 20 63 6c 69 65 6e 74 20 65 6e at the client en
9240: 64 20 73 69 6e 63 65 20 77 65 20 68 61 76 65 20 d since we have
9250: 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 6d 75 to connect to mu
9260: 6c 74 69 70 6c 65 20 72 75 6e 2d 69 64 20 64 62 ltiple run-id db
9270: 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d s.;;.(define (rm
9280: 74 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 t:get-previous-t
9290: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 72 est-run-record r
92a0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
92b0: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 item-path). (le
92c0: 74 2a 20 28 28 6b 65 79 76 61 6c 73 20 28 72 6d t* ((keyvals (rm
92d0: 74 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 t:get-key-val-pa
92e0: 69 72 73 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 irs run-id)).. (
92f0: 6b 65 79 73 20 20 20 20 28 72 6d 74 3a 67 65 74 keys (rmt:get
9300: 2d 6b 65 79 73 29 29 0a 09 20 28 73 65 6c 73 74 -keys)).. (selst
9310: 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 r (string-inter
9320: 73 70 65 72 73 65 20 20 6b 65 79 73 20 22 2c 22 sperse keys ","
9330: 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 28 73 )).. (qrystr (s
9340: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
9350: 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 e (map (lambda (
9360: 78 29 28 63 6f 6e 63 20 78 20 22 3d 3f 22 29 29 x)(conc x "=?"))
9370: 20 6b 65 79 73 29 20 22 20 41 4e 44 20 22 29 29 keys) " AND "))
9380: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6b ). (if (not k
9390: 65 79 76 61 6c 73 29 0a 09 23 66 0a 09 28 6c 65 eyvals)..#f..(le
93a0: 74 20 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 t ((prev-run-ids
93b0: 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 (rmt:get-prev-r
93c0: 75 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 29 29 un-ids run-id)))
93d0: 0a 09 20 20 3b 3b 20 66 6f 72 20 65 61 63 68 20 .. ;; for each
93e0: 72 75 6e 20 73 74 61 72 74 69 6e 67 20 77 69 74 run starting wit
93f0: 68 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e h the most recen
9400: 74 20 6c 6f 6f 6b 20 74 6f 20 73 65 65 20 69 66 t look to see if
9410: 20 74 68 65 72 65 20 69 73 20 61 20 6d 61 74 63 there is a matc
9420: 68 69 6e 67 20 74 65 73 74 0a 09 20 20 3b 3b 20 hing test.. ;;
9430: 69 66 20 66 6f 75 6e 64 20 74 68 65 6e 20 72 65 if found then re
9440: 74 75 72 6e 20 74 68 61 74 20 6d 61 74 63 68 69 turn that matchi
9450: 6e 67 20 74 65 73 74 20 72 65 63 6f 72 64 0a 09 ng test record..
9460: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
9470: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
9480: 72 74 2a 20 22 73 65 6c 73 74 72 3a 20 22 20 73 rt* "selstr: " s
9490: 65 6c 73 74 72 20 22 2c 20 71 72 79 73 74 72 3a elstr ", qrystr:
94a0: 20 22 20 71 72 79 73 74 72 20 22 2c 20 6b 65 79 " qrystr ", key
94b0: 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 vals: " keyvals
94c0: 22 2c 20 70 72 65 76 69 6f 75 73 20 72 75 6e 20 ", previous run
94d0: 69 64 73 20 66 6f 75 6e 64 3a 20 22 20 70 72 65 ids found: " pre
94e0: 76 2d 72 75 6e 2d 69 64 73 29 0a 09 20 20 28 69 v-run-ids).. (i
94f0: 66 20 28 6e 75 6c 6c 3f 20 70 72 65 76 2d 72 75 f (null? prev-ru
9500: 6e 2d 69 64 73 29 20 23 66 0a 09 20 20 20 20 20 n-ids) #f..
9510: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
9520: 20 28 63 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 (car prev-run-i
9530: 64 73 29 29 0a 09 09 09 20 28 74 61 6c 20 28 63 ds)).... (tal (c
9540: 64 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 dr prev-run-ids)
9550: 29 29 0a 09 09 28 6c 65 74 20 28 28 72 65 73 75 ))...(let ((resu
9560: 6c 74 73 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 lts (rmt:get-tes
9570: 74 73 2d 66 6f 72 2d 72 75 6e 20 68 65 64 20 28 ts-for-run hed (
9580: 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 conc test-name "
9590: 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 20 27 28 /" item-path) '(
95a0: 29 20 27 28 29 20 3b 3b 20 72 75 6e 2d 69 64 20 ) '() ;; run-id
95b0: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
95c0: 73 74 61 74 75 73 65 73 0a 09 09 09 09 09 09 20 statuses.......
95d0: 20 20 20 20 20 23 66 20 23 66 20 23 66 20 20 20 #f #f #f
95e0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6f ;; o
95f0: 66 66 73 65 74 20 6c 69 6d 69 74 20 6e 6f 74 2d ffset limit not-
9600: 69 6e 20 68 69 64 65 2f 6e 6f 74 2d 68 69 64 65 in hide/not-hide
9610: 0a 09 09 09 09 09 09 20 20 20 20 20 20 23 66 20 ....... #f
9620: 23 66 20 23 66 20 23 66 20 27 6e 6f 72 6d 61 6c #f #f #f 'normal
9630: 29 29 29 20 3b 3b 20 73 6f 72 74 2d 62 79 20 73 ))) ;; sort-by s
9640: 6f 72 74 2d 6f 72 64 65 72 20 71 72 79 76 61 6c ort-order qryval
9650: 73 20 6c 61 73 74 2d 75 70 64 61 74 65 20 6d 6f s last-update mo
9660: 64 65 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 de... (debug:pr
9670: 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c int 4 *default-l
9680: 6f 67 2d 70 6f 72 74 2a 20 22 47 6f 74 20 74 65 og-port* "Got te
9690: 73 74 73 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 sts for run-id "
96a0: 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d run-id ", test-
96b0: 6e 61 6d 65 20 22 20 74 65 73 74 2d 6e 61 6d 65 name " test-name
96c0: 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 22 20 ", item-path "
96d0: 69 74 65 6d 2d 70 61 74 68 20 22 3a 20 22 20 72 item-path ": " r
96e0: 65 73 75 6c 74 73 29 0a 09 09 20 20 28 69 66 20 esults)... (if
96f0: 28 61 6e 64 20 28 6e 75 6c 6c 3f 20 72 65 73 75 (and (null? resu
9700: 6c 74 73 29 0a 09 09 09 20 20 20 28 6e 6f 74 20 lts).... (not
9710: 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 09 (null? tal)))...
9720: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
9730: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 0a tal)(cdr tal)).
9740: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c .. (if (nul
9750: 6c 3f 20 72 65 73 75 6c 74 73 29 20 23 66 0a 09 l? results) #f..
9760: 09 09 20 20 28 63 61 72 20 72 65 73 75 6c 74 73 .. (car results
9770: 29 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 ))))))))))..(def
9780: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ine (rmt:get-run
9790: 2d 73 74 61 74 73 29 0a 20 20 28 72 6d 74 3a 73 -stats). (rmt:s
97a0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
97b0: 2d 72 75 6e 2d 73 74 61 74 73 20 23 66 20 27 28 -run-stats #f '(
97c0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
97d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
9810: 20 20 53 20 54 20 45 20 50 20 53 0a 3b 3b 3d 3d S T E P S.;;==
9820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9860: 3d 3d 3d 3d 0a 0a 3b 3b 20 47 65 74 74 69 6e 67 ====..;; Getting
9870: 20 73 74 65 70 73 20 69 73 20 6d 6f 72 65 20 63 steps is more c
9880: 6f 6d 70 6c 69 63 61 74 65 64 2e 0a 3b 3b 0a 3b omplicated..;;.;
9890: 3b 20 49 66 20 67 69 76 65 6e 20 77 6f 72 6b 20 ; If given work
98a0: 61 72 65 61 20 0a 3b 3b 20 20 31 2e 20 46 69 6e area .;; 1. Fin
98b0: 64 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 d the testdat.db
98c0: 20 66 69 6c 65 0a 3b 3b 20 20 32 2e 20 4f 70 65 file.;; 2. Ope
98d0: 6e 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 n the testdat.db
98e0: 20 66 69 6c 65 20 61 6e 64 20 64 6f 20 74 68 65 file and do the
98f0: 20 71 75 65 72 79 0a 3b 3b 20 49 66 20 6e 6f 74 query.;; If not
9900: 20 67 69 76 65 6e 20 74 68 65 20 77 6f 72 6b 20 given the work
9910: 61 72 65 61 0a 3b 3b 20 20 31 2e 20 44 6f 20 61 area.;; 1. Do a
9920: 20 72 65 6d 6f 74 65 20 63 61 6c 6c 20 74 6f 20 remote call to
9930: 67 65 74 20 74 68 65 20 74 65 73 74 20 70 61 74 get the test pat
9940: 68 0a 3b 3b 20 20 32 2e 20 43 6f 6e 74 69 6e 75 h.;; 2. Continu
9950: 65 20 61 73 20 61 62 6f 76 65 0a 3b 3b 20 0a 3b e as above.;; .;
9960: 3b 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 ;(define (rmt:ge
9970: 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 t-steps-for-test
9980: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
9990: 0a 3b 3b 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 .;; (rmt:send-r
99a0: 65 63 65 69 76 65 20 27 67 65 74 2d 73 74 65 70 eceive 'get-step
99b0: 73 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 28 6c s-data run-id (l
99c0: 69 73 74 20 74 65 73 74 2d 69 64 29 29 29 0a 0a ist test-id)))..
99d0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 (define (rmt:tes
99e0: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
99f0: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
9a00: 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 teststep-name s
9a10: 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 tate-in status-i
9a20: 6e 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c n comment logfil
9a30: 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 e). (let* ((sta
9a40: 74 65 20 20 20 20 20 28 69 74 65 6d 73 3a 63 68 te (items:ch
9a50: 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 eck-valid-items
9a60: 22 73 74 61 74 65 22 20 73 74 61 74 65 2d 69 6e "state" state-in
9a70: 29 29 0a 09 20 28 73 74 61 74 75 73 20 20 20 20 )).. (status
9a80: 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d 76 61 6c (items:check-val
9a90: 69 64 2d 69 74 65 6d 73 20 22 73 74 61 74 75 73 id-items "status
9aa0: 22 20 73 74 61 74 75 73 2d 69 6e 29 29 29 0a 20 " status-in))).
9ab0: 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 (if (or (not
9ac0: 73 74 61 74 65 29 28 6e 6f 74 20 73 74 61 74 75 state)(not statu
9ad0: 73 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e s))..(debug:prin
9ae0: 74 20 33 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 3 *default-log
9af0: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
9b00: 20 49 6e 76 61 6c 69 64 20 22 20 28 69 66 20 73 Invalid " (if s
9b10: 74 61 74 75 73 20 22 73 74 61 74 75 73 22 20 22 tatus "status" "
9b20: 73 74 61 74 65 22 29 0a 09 09 20 20 20 20 20 22 state")... "
9b30: 20 76 61 6c 75 65 20 5c 22 22 20 28 69 66 20 73 value \"" (if s
9b40: 74 61 74 75 73 20 73 74 61 74 65 2d 69 6e 20 73 tatus state-in s
9b50: 74 61 74 75 73 2d 69 6e 29 20 22 5c 22 2c 20 75 tatus-in) "\", u
9b60: 70 64 61 74 65 20 79 6f 75 72 20 76 61 6c 69 64 pdate your valid
9b70: 76 61 6c 75 65 73 20 73 65 63 74 69 6f 6e 20 69 values section i
9b80: 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 n megatest.confi
9b90: 67 22 29 29 0a 20 20 20 20 28 72 6d 74 3a 73 65 g")). (rmt:se
9ba0: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
9bb0: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
9bc0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
9bd0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
9be0: 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 74 65 tstep-name state
9bf0: 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 63 6f -in status-in co
9c00: 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 29 29 29 mment logfile)))
9c10: 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 )...(define (rmt
9c20: 3a 64 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f :delete-steps-fo
9c30: 72 2d 74 65 73 74 21 20 72 75 6e 2d 69 64 20 74 r-test! run-id t
9c40: 65 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 est-id). (rmt:s
9c50: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 6c end-receive 'del
9c60: 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 ete-steps-for-te
9c70: 73 74 21 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 st! run-id (list
9c80: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
9c90: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
9ca0: 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 :get-steps-for-t
9cb0: 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d est run-id test-
9cc0: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
9cd0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 73 74 65 receive 'get-ste
9ce0: 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e 2d ps-for-test run-
9cf0: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 id (list run-id
9d00: 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 test-id)))..(def
9d10: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 73 74 65 ine (rmt:get-ste
9d20: 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 74 65 ps-info-by-id te
9d30: 73 74 2d 73 74 65 70 2d 69 64 29 0a 20 20 28 72 st-step-id). (r
9d40: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
9d50: 27 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 'get-steps-info-
9d60: 62 79 2d 69 64 20 23 66 20 28 6c 69 73 74 20 74 by-id #f (list t
9d70: 65 73 74 2d 73 74 65 70 2d 69 64 29 29 29 0a 0a est-step-id)))..
9d80: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9dc0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 54 20 45 ========.;; T E
9dd0: 20 53 20 54 20 20 20 44 20 41 20 54 20 41 20 0a S T D A T A .
9de0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e20: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin
9e30: 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 65 73 74 e (rmt:read-test
9e40: 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 -data run-id tes
9e50: 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 74 t-id categorypat
9e60: 74 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 72 t #!key (work-ar
9e70: 65 61 20 23 66 29 29 20 0a 20 20 28 72 6d 74 3a ea #f)) . (rmt:
9e80: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 72 65 send-receive 're
9e90: 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 75 6e ad-test-data run
9ea0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
9eb0: 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 test-id categor
9ec0: 79 70 61 74 74 29 29 29 0a 28 64 65 66 69 6e 65 ypatt))).(define
9ed0: 20 28 72 6d 74 3a 72 65 61 64 2d 74 65 73 74 2d (rmt:read-test-
9ee0: 64 61 74 61 2a 20 72 75 6e 2d 69 64 20 74 65 73 data* run-id tes
9ef0: 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 74 t-id categorypat
9f00: 74 20 76 61 72 70 61 74 74 20 23 21 6b 65 79 20 t varpatt #!key
9f10: 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 20 (work-area #f))
9f20: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
9f30: 65 69 76 65 20 27 72 65 61 64 2d 74 65 73 74 2d eive 'read-test-
9f40: 64 61 74 61 2a 20 72 75 6e 2d 69 64 20 28 6c 69 data* run-id (li
9f50: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
9f60: 64 20 63 61 74 65 67 6f 72 79 70 61 74 74 20 76 d categorypatt v
9f70: 61 72 70 61 74 74 29 29 29 0a 0a 28 64 65 66 69 arpatt)))..(defi
9f80: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 64 61 74 61 ne (rmt:get-data
9f90: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 74 65 73 74 -info-by-id test
9fa0: 2d 64 61 74 61 2d 69 64 29 0a 20 20 20 28 72 6d -data-id). (rm
9fb0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
9fc0: 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 79 get-data-info-by
9fd0: 2d 69 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 -id #f (list tes
9fe0: 74 2d 64 61 74 61 2d 69 64 29 29 29 0a 0a 28 64 t-data-id)))..(d
9ff0: 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 6d efine (rmt:testm
a000: 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 20 74 eta-add-record t
a010: 65 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a estname). (rmt:
a020: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 send-receive 'te
a030: 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 stmeta-add-recor
a040: 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 74 6e d #f (list testn
a050: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
a060: 28 72 6d 74 3a 74 65 73 74 6d 65 74 61 2d 67 65 (rmt:testmeta-ge
a070: 74 2d 72 65 63 6f 72 64 20 74 65 73 74 6e 61 6d t-record testnam
a080: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
a090: 65 63 65 69 76 65 20 27 74 65 73 74 6d 65 74 61 eceive 'testmeta
a0a0: 2d 67 65 74 2d 72 65 63 6f 72 64 20 23 66 20 28 -get-record #f (
a0b0: 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 29 29 list testname)))
a0c0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
a0d0: 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 estmeta-update-f
a0e0: 69 65 6c 64 20 74 65 73 74 2d 6e 61 6d 65 20 66 ield test-name f
a0f0: 6c 64 20 76 61 6c 29 0a 20 20 28 72 6d 74 3a 73 ld val). (rmt:s
a100: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 end-receive 'tes
a110: 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 tmeta-update-fie
a120: 6c 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 74 ld #f (list test
a130: 2d 6e 61 6d 65 20 66 6c 64 20 76 61 6c 29 29 29 -name fld val)))
a140: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
a150: 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 est-data-rollup
a160: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
a170: 74 61 74 75 73 29 0a 20 20 28 72 6d 74 3a 73 65 tatus). (rmt:se
a180: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
a190: 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 72 75 6e -data-rollup run
a1a0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
a1b0: 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73 29 test-id status)
a1c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
a1d0: 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 :csv->test-data
a1e0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 63 run-id test-id c
a1f0: 73 76 64 61 74 61 29 0a 20 20 28 72 6d 74 3a 73 svdata). (rmt:s
a200: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 63 73 76 end-receive 'csv
a210: 2d 3e 74 65 73 74 2d 64 61 74 61 20 72 75 6e 2d ->test-data run-
a220: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 id (list run-id
a230: 74 65 73 74 2d 69 64 20 63 73 76 64 61 74 61 29 test-id csvdata)
a240: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
a250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
a290: 20 54 20 41 20 53 20 4b 20 53 0a 3b 3b 3d 3d 3d T A S K S.;;===
a2a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a2b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a2c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a2d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a2e0: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d ===..(define (rm
a2f0: 74 3a 74 61 73 6b 73 2d 66 69 6e 64 2d 74 61 73 t:tasks-find-tas
a300: 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 20 k-queue-records
a310: 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 20 target run-name
a320: 74 65 73 74 2d 70 61 74 74 20 73 74 61 74 65 2d test-patt state-
a330: 70 61 74 74 20 61 63 74 69 6f 6e 2d 70 61 74 74 patt action-patt
a340: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
a350: 63 65 69 76 65 20 27 66 69 6e 64 2d 74 61 73 6b ceive 'find-task
a360: 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 20 23 -queue-records #
a370: 66 20 28 6c 69 73 74 20 74 61 72 67 65 74 20 72 f (list target r
a380: 75 6e 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 un-name test-pat
a390: 74 20 73 74 61 74 65 2d 70 61 74 74 20 61 63 74 t state-patt act
a3a0: 69 6f 6e 2d 70 61 74 74 29 29 29 0a 0a 28 64 65 ion-patt)))..(de
a3b0: 66 69 6e 65 20 28 72 6d 74 3a 74 61 73 6b 73 2d fine (rmt:tasks-
a3c0: 61 64 64 20 61 63 74 69 6f 6e 20 6f 77 6e 65 72 add action owner
a3d0: 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 target runname
a3e0: 74 65 73 74 70 61 74 74 20 70 61 72 61 6d 73 29 testpatt params)
a3f0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
a400: 65 69 76 65 20 27 74 61 73 6b 73 2d 61 64 64 20 eive 'tasks-add
a410: 23 66 20 28 6c 69 73 74 20 61 63 74 69 6f 6e 20 #f (list action
a420: 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 75 6e owner target run
a430: 6e 61 6d 65 20 74 65 73 74 70 61 74 74 20 70 61 name testpatt pa
a440: 72 61 6d 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 rams)))..(define
a450: 20 28 72 6d 74 3a 74 61 73 6b 73 2d 73 65 74 2d (rmt:tasks-set-
a460: 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 state-given-para
a470: 6d 2d 6b 65 79 20 70 61 72 61 6d 2d 6b 65 79 20 m-key param-key
a480: 6e 65 77 2d 73 74 61 74 65 29 0a 20 20 28 72 6d new-state). (rm
a490: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
a4a0: 74 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d tasks-set-state-
a4b0: 67 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 20 given-param-key
a4c0: 23 66 20 28 6c 69 73 74 20 20 70 61 72 61 6d 2d #f (list param-
a4d0: 6b 65 79 20 6e 65 77 2d 73 74 61 74 65 29 29 29 key new-state)))
a4e0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
a4f0: 61 73 6b 73 2d 67 65 74 2d 6c 61 73 74 20 74 61 asks-get-last ta
a500: 72 67 65 74 20 72 75 6e 6e 61 6d 65 29 0a 20 20 rget runname).
a510: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
a520: 65 20 27 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 e 'tasks-get-las
a530: 74 20 23 66 20 28 6c 69 73 74 20 74 61 72 67 65 t #f (list targe
a540: 74 20 72 75 6e 6e 61 6d 65 29 29 29 0a 0a 3b 3b t runname)))..;;
a550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a590: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 20 4f 20 20 20 ======.;; N O
a5a0: 53 20 59 20 4e 20 43 20 20 20 44 20 42 20 0a 3b S Y N C D B .;
a5b0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
a5c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a5d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a5e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a5f0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
a600: 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 73 65 (rmt:no-sync-se
a610: 74 20 76 61 72 20 76 61 6c 29 0a 20 20 28 72 6d t var val). (rm
a620: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
a630: 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 23 66 20 60 no-sync-set #f `
a640: 28 2c 76 61 72 20 2c 76 61 6c 29 29 29 0a 0a 28 (,var ,val)))..(
a650: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 define (rmt:no-s
a660: 79 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c 74 20 ync-get/default
a670: 76 61 72 20 64 65 66 61 75 6c 74 29 0a 20 20 28 var default). (
a680: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
a690: 20 27 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 'no-sync-get/de
a6a0: 66 61 75 6c 74 20 23 66 20 60 28 2c 76 61 72 20 fault #f `(,var
a6b0: 2c 64 65 66 61 75 6c 74 29 29 29 0a 0a 28 64 65 ,default)))..(de
a6c0: 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e fine (rmt:no-syn
a6d0: 63 2d 64 65 6c 21 20 76 61 72 29 0a 20 20 28 72 c-del! var). (r
a6e0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
a6f0: 27 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 23 66 'no-sync-del! #f
a700: 20 60 28 2c 76 61 72 29 29 29 0a 0a 28 64 65 66 `(,var)))..(def
a710: 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 ine (rmt:no-sync
a720: 2d 67 65 74 2d 6c 6f 63 6b 20 6b 65 79 6e 61 6d -get-lock keynam
a730: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
a740: 65 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d eceive 'no-sync-
a750: 67 65 74 2d 6c 6f 63 6b 20 23 66 20 60 28 2c 6b get-lock #f `(,k
a760: 65 79 6e 61 6d 65 29 29 29 0a 0a 3b 3b 3d 3d 3d eyname)))..;;===
a770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7b0: 3d 3d 3d 0a 3b 3b 20 41 20 52 20 43 20 48 20 49 ===.;; A R C H I
a7c0: 20 56 20 45 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d V E S.;;=======
a7d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
a810: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 61 72 .(define (rmt:ar
a820: 63 68 69 76 65 2d 67 65 74 2d 61 6c 6c 6f 63 61 chive-get-alloca
a830: 74 69 6f 6e 73 20 20 74 65 73 74 6e 61 6d 65 20 tions testname
a840: 69 74 65 6d 70 61 74 68 20 64 6e 65 65 64 65 64 itempath dneeded
a850: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
a860: 63 65 69 76 65 20 27 61 72 63 68 69 76 65 2d 67 ceive 'archive-g
a870: 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 20 23 et-allocations #
a880: 66 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 f (list testname
a890: 20 69 74 65 6d 70 61 74 68 20 64 6e 65 65 64 65 itempath dneede
a8a0: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
a8b0: 6d 74 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 mt:archive-regis
a8c0: 74 65 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 62 ter-block-name b
a8d0: 64 69 73 6b 2d 69 64 20 61 72 63 68 69 76 65 2d disk-id archive-
a8e0: 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e path). (rmt:sen
a8f0: 64 2d 72 65 63 65 69 76 65 20 27 61 72 63 68 69 d-receive 'archi
a900: 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 ve-register-bloc
a910: 6b 2d 6e 61 6d 65 20 23 66 20 28 6c 69 73 74 20 k-name #f (list
a920: 62 64 69 73 6b 2d 69 64 20 61 72 63 68 69 76 65 bdisk-id archive
a930: 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e -path)))..(defin
a940: 65 20 28 72 6d 74 3a 61 72 63 68 69 76 65 2d 61 e (rmt:archive-a
a950: 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74 llocate-testsuit
a960: 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 20 e/area-to-block
a970: 62 6c 6f 63 6b 2d 69 64 20 74 65 73 74 73 75 69 block-id testsui
a980: 74 65 2d 6e 61 6d 65 20 61 72 65 61 6b 65 79 29 te-name areakey)
a990: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
a9a0: 65 69 76 65 20 27 61 72 63 68 69 76 65 2d 61 6c eive 'archive-al
a9b0: 6c 6f 63 61 74 65 2d 74 65 73 74 2d 74 6f 2d 62 locate-test-to-b
a9c0: 6c 6f 63 6b 20 23 66 20 28 6c 69 73 74 20 20 62 lock #f (list b
a9d0: 6c 6f 63 6b 2d 69 64 20 74 65 73 74 73 75 69 74 lock-id testsuit
a9e0: 65 2d 6e 61 6d 65 20 61 72 65 61 6b 65 79 29 29 e-name areakey))
a9f0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
aa00: 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 archive-register
aa10: 2d 64 69 73 6b 20 62 64 69 73 6b 2d 6e 61 6d 65 -disk bdisk-name
aa20: 20 62 64 69 73 6b 2d 70 61 74 68 20 64 66 29 0a bdisk-path df).
aa30: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
aa40: 69 76 65 20 27 61 72 63 68 69 76 65 2d 72 65 67 ive 'archive-reg
aa50: 69 73 74 65 72 2d 64 69 73 6b 20 23 66 20 28 6c ister-disk #f (l
aa60: 69 73 74 20 62 64 69 73 6b 2d 6e 61 6d 65 20 62 ist bdisk-name b
aa70: 64 69 73 6b 2d 70 61 74 68 20 64 66 29 29 29 0a disk-path df))).
aa80: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 .(define (rmt:te
aa90: 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 2d 62 st-set-archive-b
aaa0: 6c 6f 63 6b 2d 69 64 20 72 75 6e 2d 69 64 20 74 lock-id run-id t
aab0: 65 73 74 2d 69 64 20 61 72 63 68 69 76 65 2d 62 est-id archive-b
aac0: 6c 6f 63 6b 2d 69 64 29 0a 20 20 28 72 6d 74 3a lock-id). (rmt:
aad0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 send-receive 'te
aae0: 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 2d 62 st-set-archive-b
aaf0: 6c 6f 63 6b 2d 69 64 20 72 75 6e 2d 69 64 20 28 lock-id run-id (
ab00: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
ab10: 2d 69 64 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 -id archive-bloc
ab20: 6b 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 k-id)))..(define
ab30: 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d 61 (rmt:test-get-a
ab40: 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 rchive-block-inf
ab50: 6f 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d o archive-block-
ab60: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
ab70: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 67 65 receive 'test-ge
ab80: 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d t-archive-block-
ab90: 69 6e 66 6f 20 23 66 20 28 6c 69 73 74 20 61 72 info #f (list ar
aba0: 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 29 chive-block-id))
abb0: 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 )...(define (rmt
abc0: 6d 6f 64 3a 63 61 6c 63 2d 72 6f 2d 6d 6f 64 65 mod:calc-ro-mode
abd0: 20 72 75 6e 72 65 6d 6f 74 65 20 2a 74 6f 70 70 runremote *topp
abe0: 61 74 68 2a 29 0a 20 20 28 69 66 20 28 61 6e 64 ath*). (if (and
abf0: 20 72 75 6e 72 65 6d 6f 74 65 0a 09 20 20 20 28 runremote.. (
ac00: 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 63 remote-ro-mode-c
ac10: 68 65 63 6b 65 64 20 72 75 6e 72 65 6d 6f 74 65 hecked runremote
ac20: 29 29 0a 20 20 20 20 20 20 28 72 65 6d 6f 74 65 )). (remote
ac30: 2d 72 6f 2d 6d 6f 64 65 20 72 75 6e 72 65 6d 6f -ro-mode runremo
ac40: 74 65 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 te). (let*
ac50: 28 28 64 62 66 69 6c 65 20 20 28 63 6f 6e 63 20 ((dbfile (conc
ac60: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 *toppath* "/mega
ac70: 74 65 73 74 2e 64 62 22 29 29 0a 09 20 20 20 20 test.db"))..
ac80: 20 28 72 6f 2d 6d 6f 64 65 20 28 6e 6f 74 20 28 (ro-mode (not (
ac90: 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 file-write-acces
aca0: 73 3f 20 64 62 66 69 6c 65 29 29 29 29 20 3b 3b s? dbfile)))) ;;
acb0: 20 54 4f 44 4f 3a 20 75 73 65 20 64 62 73 74 72 TODO: use dbstr
acc0: 75 63 74 20 6f 72 20 72 75 6e 72 65 6d 6f 74 65 uct or runremote
acd0: 20 74 6f 20 66 69 67 75 72 65 20 74 68 69 73 20 to figure this
ace0: 6f 75 74 20 69 6e 20 66 75 74 75 72 65 0a 09 28 out in future..(
acf0: 69 66 20 72 75 6e 72 65 6d 6f 74 65 0a 09 20 20 if runremote..
ad00: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
ad10: 28 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d (remote-ro-mode-
ad20: 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 72 set! runremote r
ad30: 6f 2d 6d 6f 64 65 29 0a 09 20 20 20 20 20 20 28 o-mode).. (
ad40: 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 63 remote-ro-mode-c
ad50: 68 65 63 6b 65 64 2d 73 65 74 21 20 72 75 6e 72 hecked-set! runr
ad60: 65 6d 6f 74 65 20 23 74 29 0a 09 20 20 20 20 20 emote #t)..
ad70: 20 72 6f 2d 6d 6f 64 65 29 0a 09 20 20 20 20 72 ro-mode).. r
ad80: 6f 2d 6d 6f 64 65 29 29 29 29 0a 0a 28 64 65 66 o-mode))))..(def
ad90: 69 6e 65 20 28 65 78 74 72 61 73 2d 72 65 61 64 ine (extras-read
ada0: 6f 6e 6c 79 2d 6d 6f 64 65 20 72 6d 74 2d 6d 75 only-mode rmt-mu
adb0: 74 65 78 20 6c 6f 67 2d 70 6f 72 74 20 63 6d 64 tex log-port cmd
adc0: 20 70 61 72 61 6d 73 29 0a 20 20 28 6d 75 74 65 params). (mute
add0: 78 2d 75 6e 6c 6f 63 6b 21 20 72 6d 74 2d 6d 75 x-unlock! rmt-mu
ade0: 74 65 78 29 0a 20 20 28 64 65 62 75 67 3a 70 72 tex). (debug:pr
adf0: 69 6e 74 2d 69 6e 66 6f 20 31 32 20 6c 6f 67 2d int-info 12 log-
ae00: 70 6f 72 74 20 22 72 6d 74 3a 73 65 6e 64 2d 72 port "rmt:send-r
ae10: 65 63 65 69 76 65 2c 20 63 61 73 65 20 33 22 29 eceive, case 3")
ae20: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
ae30: 30 20 6c 6f 67 2d 70 6f 72 74 20 22 57 41 52 4e 0 log-port "WARN
ae40: 49 4e 47 3a 20 77 72 69 74 65 20 74 72 61 6e 73 ING: write trans
ae50: 61 63 74 69 6f 6e 20 72 65 71 75 65 73 74 65 64 action requested
ae60: 20 6f 6e 20 61 20 72 65 61 64 6f 6e 6c 79 20 61 on a readonly a
ae70: 72 65 61 2e 20 20 63 6d 64 3d 22 63 6d 64 22 20 rea. cmd="cmd"
ae80: 70 61 72 61 6d 73 3d 22 70 61 72 61 6d 73 29 0a params="params).
ae90: 20 20 23 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 #f)..(define (
aea0: 65 78 74 72 61 73 2d 74 72 61 6e 73 70 6f 72 74 extras-transport
aeb0: 2d 66 61 69 6c 65 64 20 2a 64 65 66 61 75 6c 74 -failed *default
aec0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 2a 72 6d 74 2d -log-port* *rmt-
aed0: 6d 75 74 65 78 2a 20 61 74 74 65 6d 70 74 6e 75 mutex* attemptnu
aee0: 6d 20 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 20 m runremote cmd
aef0: 72 69 64 20 70 61 72 61 6d 73 29 0a 20 20 28 64 rid params). (d
af00: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
af10: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
af20: 22 57 41 52 4e 49 4e 47 3a 20 63 6f 6d 6d 75 6e "WARNING: commun
af30: 69 63 61 74 69 6f 6e 20 66 61 69 6c 65 64 2e 20 ication failed.
af40: 54 72 79 69 6e 67 20 61 67 61 69 6e 2c 20 74 72 Trying again, tr
af50: 79 20 6e 75 6d 3a 20 22 20 61 74 74 65 6d 70 74 y num: " attempt
af60: 6e 75 6d 29 0a 20 20 28 6d 75 74 65 78 2d 6c 6f num). (mutex-lo
af70: 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 ck! *rmt-mutex*)
af80: 0a 20 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 . (remote-connd
af90: 61 74 2d 73 65 74 21 20 20 20 20 72 75 6e 72 65 at-set! runre
afa0: 6d 6f 74 65 20 23 66 29 0a 20 20 28 68 74 74 70 mote #f). (http
afb0: 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c 6f 73 65 -transport:close
afc0: 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 61 72 65 -connections are
afd0: 61 2d 64 61 74 3a 20 72 75 6e 72 65 6d 6f 74 65 a-dat: runremote
afe0: 29 0a 20 20 28 72 65 6d 6f 74 65 2d 73 65 72 76 ). (remote-serv
aff0: 65 72 2d 75 72 6c 2d 73 65 74 21 20 72 75 6e 72 er-url-set! runr
b000: 65 6d 6f 74 65 20 23 66 29 0a 20 20 28 6d 75 74 emote #f). (mut
b010: 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d ex-unlock! *rmt-
b020: 6d 75 74 65 78 2a 29 0a 20 20 28 64 65 62 75 67 mutex*). (debug
b030: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a :print-info 12 *
b040: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
b050: 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 * "rmt:send-rece
b060: 69 76 65 2c 20 63 61 73 65 20 20 39 2e 31 22 29 ive, case 9.1")
b070: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
b080: 65 69 76 65 20 63 6d 64 20 72 69 64 20 70 61 72 eive cmd rid par
b090: 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d 3a 20 ams attemptnum:
b0a0: 28 2b 20 61 74 74 65 6d 70 74 6e 75 6d 20 31 29 (+ attemptnum 1)
b0b0: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 65 )). .(define (e
b0c0: 78 74 72 61 73 2d 74 72 61 6e 73 70 6f 72 74 2d xtras-transport-
b0d0: 73 75 63 63 65 64 65 64 20 2a 64 65 66 61 75 6c succeded *defaul
b0e0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 2a 72 6d 74 t-log-port* *rmt
b0f0: 2d 6d 75 74 65 78 2a 20 61 74 74 65 6d 70 74 6e -mutex* attemptn
b100: 75 6d 20 72 75 6e 72 65 6d 6f 74 65 20 72 65 73 um runremote res
b110: 20 70 61 72 61 6d 73 20 72 69 64 20 63 6d 64 29 params rid cmd)
b120: 0a 20 20 28 69 66 20 28 61 6e 64 20 28 76 65 63 . (if (and (vec
b130: 74 6f 72 3f 20 72 65 73 29 0a 09 20 20 20 28 65 tor? res).. (e
b140: 71 3f 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 q? (vector-lengt
b150: 68 20 72 65 73 29 20 32 29 0a 09 20 20 20 28 65 h res) 2).. (e
b160: 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 q? (vector-ref r
b170: 65 73 20 31 29 20 27 6f 76 65 72 6c 6f 61 64 65 es 1) 'overloade
b180: 64 29 29 20 3b 3b 20 73 69 6e 63 65 20 77 65 20 d)) ;; since we
b190: 61 72 65 0a 09 09 09 09 09 09 20 3b 3b 20 6c 6f are....... ;; lo
b1a0: 6f 6b 69 6e 67 20 61 74 20 74 68 65 0a 09 09 09 oking at the....
b1b0: 09 09 09 20 3b 3b 20 64 61 74 61 20 74 6f 20 63 ... ;; data to c
b1c0: 61 72 72 79 20 74 68 65 0a 09 09 09 09 09 09 20 arry the.......
b1d0: 3b 3b 20 65 72 72 6f 72 20 77 65 27 6c 6c 20 75 ;; error we'll u
b1e0: 73 65 20 61 0a 09 09 09 09 09 09 20 3b 3b 20 66 se a....... ;; f
b1f0: 61 69 72 6c 79 20 6f 62 74 75 73 65 0a 09 09 09 airly obtuse....
b200: 09 09 09 20 3b 3b 20 63 6f 6d 62 6f 20 74 6f 20 ... ;; combo to
b210: 6d 69 6e 69 6d 69 73 65 0a 09 09 09 09 09 09 20 minimise.......
b220: 3b 3b 20 74 68 65 20 63 68 61 6e 63 65 73 20 6f ;; the chances o
b230: 66 0a 09 09 09 09 09 09 20 3b 3b 20 73 6f 6d 65 f....... ;; some
b240: 20 73 6f 72 74 20 6f 66 0a 09 09 09 09 09 09 20 sort of.......
b250: 3b 3b 20 63 6f 6c 6c 69 73 69 6f 6e 2e 20 20 74 ;; collision. t
b260: 68 69 73 0a 09 09 09 09 09 09 20 3b 3b 20 69 73 his....... ;; is
b270: 20 74 68 65 20 63 61 73 65 20 77 68 65 72 65 0a the case where.
b280: 09 09 09 09 09 09 20 3b 3b 20 74 68 65 20 72 65 ...... ;; the re
b290: 74 75 72 6e 65 64 20 64 61 74 61 0a 09 09 09 09 turned data.....
b2a0: 09 09 20 3b 3b 20 69 73 20 62 61 64 20 6f 72 20 .. ;; is bad or
b2b0: 74 68 65 0a 09 09 09 09 09 09 20 3b 3b 20 73 65 the....... ;; se
b2c0: 72 76 65 72 20 69 73 0a 09 09 09 09 09 09 20 3b rver is....... ;
b2d0: 3b 20 6f 76 65 72 6c 6f 61 64 65 64 20 61 6e 64 ; overloaded and
b2e0: 20 77 65 0a 09 09 09 09 09 09 20 3b 3b 20 77 61 we....... ;; wa
b2f0: 6e 74 20 74 6f 20 65 61 73 65 20 6f 66 66 0a 09 nt to ease off..
b300: 09 09 09 09 09 20 3b 3b 20 74 68 65 20 71 75 65 ..... ;; the que
b310: 72 69 65 73 0a 20 20 20 20 20 20 28 6c 65 74 20 ries. (let
b320: 28 28 77 61 69 74 2d 64 65 6c 61 79 20 28 2b 20 ((wait-delay (+
b330: 61 74 74 65 6d 70 74 6e 75 6d 20 28 2a 20 61 74 attemptnum (* at
b340: 74 65 6d 70 74 6e 75 6d 20 31 30 29 29 29 29 0a temptnum 10)))).
b350: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
b360: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
b370: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 73 65 72 t* "WARNING: ser
b380: 76 65 72 20 69 73 20 6f 76 65 72 6c 6f 61 64 65 ver is overloade
b390: 64 2e 20 44 65 6c 61 79 69 6e 67 20 22 20 77 61 d. Delaying " wa
b3a0: 69 74 2d 64 65 6c 61 79 20 22 20 73 65 63 6f 6e it-delay " secon
b3b0: 64 73 20 61 6e 64 20 74 72 79 69 6e 67 20 63 61 ds and trying ca
b3c0: 6c 6c 20 61 67 61 69 6e 2e 22 29 0a 09 28 6d 75 ll again.")..(mu
b3d0: 74 65 78 2d 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d tex-lock! *rmt-m
b3e0: 75 74 65 78 2a 29 0a 09 28 68 74 74 70 2d 74 72 utex*)..(http-tr
b3f0: 61 6e 73 70 6f 72 74 3a 63 6c 6f 73 65 2d 63 6f ansport:close-co
b400: 6e 6e 65 63 74 69 6f 6e 73 20 61 72 65 61 2d 64 nnections area-d
b410: 61 74 3a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 at: runremote)..
b420: 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 (set! *runremote
b430: 2a 20 23 66 29 20 3b 3b 20 66 6f 72 63 65 20 73 * #f) ;; force s
b440: 74 61 72 74 69 6e 67 20 6f 76 65 72 0a 09 28 6d tarting over..(m
b450: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d utex-unlock! *rm
b460: 74 2d 6d 75 74 65 78 2a 29 0a 09 28 74 68 72 65 t-mutex*)..(thre
b470: 61 64 2d 73 6c 65 65 70 21 20 77 61 69 74 2d 64 ad-sleep! wait-d
b480: 65 6c 61 79 29 0a 09 28 72 6d 74 3a 73 65 6e 64 elay)..(rmt:send
b490: 2d 72 65 63 65 69 76 65 20 63 6d 64 20 72 69 64 -receive cmd rid
b4a0: 20 70 61 72 61 6d 73 20 61 74 74 65 6d 70 74 6e params attemptn
b4b0: 75 6d 3a 20 28 2b 20 61 74 74 65 6d 70 74 6e 75 um: (+ attemptnu
b4c0: 6d 20 31 29 29 29 0a 20 20 20 20 20 20 72 65 73 m 1))). res
b4d0: 29 29 20 3b 3b 20 41 6c 6c 20 67 6f 6f 64 2c 20 )) ;; All good,
b4e0: 72 65 74 75 72 6e 20 72 65 73 0a 0a 23 3b 28 73 return res..#;(s
b4f0: 65 74 2d 66 75 6e 63 74 69 6f 6e 73 20 72 6d 74 et-functions rmt
b500: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 20 20 :send-receive
b510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b520: 20 20 20 20 72 65 6d 6f 74 65 2d 73 65 72 76 65 remote-serve
b530: 72 2d 75 72 6c 2d 73 65 74 21 0a 09 20 20 20 20 r-url-set!..
b540: 20 20 20 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 http-transpor
b550: 74 3a 63 6c 6f 73 65 2d 63 6f 6e 6e 65 63 74 69 t:close-connecti
b560: 6f 6e 73 09 20 20 20 20 20 20 72 65 6d 6f 74 65 ons. remote
b570: 2d 63 6f 6e 6e 64 61 74 2d 73 65 74 21 0a 09 20 -conndat-set!..
b580: 20 20 20 20 20 20 64 65 62 75 67 3a 70 72 69 6e debug:prin
b590: 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t
b5a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 64 65 62 deb
b5b0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 0a 09 20 ug:print-info..
b5c0: 20 20 20 20 20 20 72 65 6d 6f 74 65 2d 72 6f 2d remote-ro-
b5d0: 6d 6f 64 65 20 20 20 20 20 20 20 20 20 20 20 20 mode
b5e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 6d rem
b5f0: 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 73 65 74 21 ote-ro-mode-set!
b600: 0a 09 20 20 20 20 20 20 20 72 65 6d 6f 74 65 2d .. remote-
b610: 72 6f 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 64 2d ro-mode-checked-
b620: 73 65 74 21 20 20 20 20 20 20 20 20 20 20 20 20 set!
b630: 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 63 remote-ro-mode-c
b640: 68 65 63 6b 65 64 29 0a hecked).