Artifact
d8fa8155752705e1ad97442bb80ad4a24f19a617:
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 64 65 62 75 67 70 72 69 6e 74 29 29 0a 28 64 debugprint)).(d
0400: 65 63 6c 61 72 65 20 28 75 73 65 73 20 61 70 69 eclare (uses api
0410: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0420: 73 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 64 s commonmod)).(d
0430: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 66 eclare (uses dbf
0440: 69 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 20 28 ile)).(declare (
0450: 75 73 65 73 20 64 62 6d 6f 64 29 29 0a 28 64 65 uses dbmod)).(de
0460: 63 6c 61 72 65 20 28 75 73 65 73 20 74 63 70 2d clare (uses tcp-
0470: 74 72 61 6e 73 70 6f 72 74 6d 6f 64 29 29 0a 28 transportmod)).(
0480: 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f include "common_
0490: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 64 records.scm").(d
04a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 72 6d 74 eclare (uses rmt
04b0: 6d 6f 64 29 29 0a 0a 3b 3b 20 75 73 65 64 20 62 mod))..;; used b
04c0: 79 20 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 y http-transport
04d0: 0a 28 69 6d 70 6f 72 74 20 64 62 66 69 6c 65 0a .(import dbfile.
04e0: 09 72 6d 74 6d 6f 64 0a 09 63 6f 6d 6d 6f 6e 6d .rmtmod..commonm
04f0: 6f 64 0a 09 64 65 62 75 67 70 72 69 6e 74 0a 3b od..debugprint.;
0500: 3b 20 09 64 62 6d 65 6d 6d 6f 64 0a 09 64 62 66 ; .dbmemmod..dbf
0510: 69 6c 65 0a 09 64 62 6d 6f 64 0a 09 74 63 70 2d ile..dbmod..tcp-
0520: 74 72 61 6e 73 70 6f 72 74 6d 6f 64 29 0a 0a 3b transportmod)..;
0530: 3b 0a 3b 3b 20 54 48 45 53 45 20 41 52 45 20 41 ;.;; THESE ARE A
0540: 4c 4c 20 43 41 4c 4c 45 44 20 4f 4e 20 54 48 45 LL CALLED ON THE
0550: 20 43 4c 49 45 4e 54 20 53 49 44 45 21 21 21 0a CLIENT SIDE!!!.
0560: 3b 3b 0a 0a 3b 3b 20 67 65 6e 65 72 61 74 65 20 ;;..;; generate
0570: 65 6e 74 72 69 65 73 20 66 6f 72 20 7e 2f 2e 6d entries for ~/.m
0580: 65 67 61 74 65 73 74 72 63 20 77 69 74 68 20 74 egatestrc with t
0590: 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 0a 3b 3b 0a he following.;;.
05a0: 3b 3b 20 20 67 72 65 70 20 64 65 66 69 6e 65 20 ;; grep define
05b0: 2e 2e 2f 72 6d 74 2e 73 63 6d 20 7c 20 67 72 65 ../rmt.scm | gre
05c0: 70 20 72 6d 74 3a 20 7c 70 65 72 6c 20 2d 70 69 p rmt: |perl -pi
05d0: 20 2d 65 20 27 73 2f 5c 28 64 65 66 69 6e 65 5c -e 's/\(define\
05e0: 73 2b 5c 28 28 5c 53 2b 29 5c 57 2e 2a 24 2f 5c s+\((\S+)\W.*$/\
05f0: 31 2f 27 7c 73 6f 72 74 20 2d 75 0a 0a 3b 3b 3d 1/'|sort -u..;;=
0600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0640: 3d 3d 3d 3d 3d 0a 3b 3b 20 20 53 20 55 20 50 20 =====.;; S U P
0650: 50 20 4f 20 52 20 54 20 20 20 46 20 55 20 4e 20 P O R T F U N
0660: 43 20 54 20 49 20 4f 20 4e 20 53 0a 3b 3b 3d 3d C T I O N S.;;==
0670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06b0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 ====..(define (r
06c0: 6d 74 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 74 3f 20 mt:on-homehost?
06d0: 72 75 6e 72 65 6d 6f 74 65 29 0a 20 20 28 6c 65 runremote). (le
06e0: 74 2a 20 28 28 68 68 2d 64 61 74 20 28 72 65 6d t* ((hh-dat (rem
06f0: 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e 72 65 ote-hh-dat runre
0700: 6d 6f 74 65 29 29 29 0a 20 20 20 20 28 69 66 20 mote))). (if
0710: 28 70 61 69 72 3f 20 68 68 2d 64 61 74 29 0a 09 (pair? hh-dat)..
0720: 28 63 64 72 20 68 68 2d 64 61 74 29 0a 09 28 62 (cdr hh-dat)..(b
0730: 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
0740: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
0750: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
0760: 68 68 2d 64 61 74 3d 22 68 68 2d 64 61 74 29 0a hh-dat="hh-dat).
0770: 09 20 20 23 66 29 29 29 29 0a 0a 28 64 65 66 69 . #f))))..(defi
0780: 6e 65 20 28 6d 61 6b 65 2d 61 6e 64 2d 69 6e 69 ne (make-and-ini
0790: 74 2d 72 65 6d 6f 74 65 20 61 72 65 61 70 61 74 t-remote areapat
07a0: 68 29 0a 20 20 20 28 63 61 73 65 20 28 72 6d 74 h). (case (rmt
07b0: 3a 74 72 61 6e 73 70 6f 72 74 2d 6d 6f 64 65 29 :transport-mode)
07c0: 0a 20 20 20 20 20 28 28 68 74 74 70 29 28 6d 61 . ((http)(ma
07d0: 6b 65 2d 72 65 6d 6f 74 65 29 29 0a 20 20 20 20 ke-remote)).
07e0: 20 28 28 74 63 70 29 20 28 74 74 3a 6d 61 6b 65 ((tcp) (tt:make
07f0: 2d 72 65 6d 6f 74 65 20 61 72 65 61 70 61 74 68 -remote areapath
0800: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 20 23 66 )). (else #f
0810: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
0820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
0860: 64 65 66 69 6e 65 20 2a 73 65 6e 64 2d 72 65 63 define *send-rec
0870: 65 69 76 65 2d 6d 75 74 65 78 2a 20 28 6d 61 6b eive-mutex* (mak
0880: 65 2d 6d 75 74 65 78 29 29 20 3b 3b 20 73 68 6f e-mutex)) ;; sho
0890: 75 6c 64 20 68 61 76 65 20 73 65 70 61 72 61 74 uld have separat
08a0: 65 20 6d 75 74 65 78 20 70 65 72 20 72 75 6e 2d e mutex per run-
08b0: 69 64 0a 28 64 65 66 69 6e 65 20 2a 74 74 64 61 id.(define *ttda
08c0: 74 2a 20 23 66 29 0a 3b 3b 20 68 6f 77 20 74 6f t* #f).;; how to
08d0: 20 6d 61 6b 65 20 61 72 65 61 2d 64 61 74 0a 28 make area-dat.(
08e0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d define (rmt:set-
08f0: 74 74 64 61 74 20 61 72 65 61 70 61 74 68 20 74 ttdat areapath t
0900: 74 64 61 74 29 0a 20 20 28 69 66 20 74 74 64 61 tdat). (if ttda
0910: 74 0a 20 20 20 20 74 74 64 61 74 0a 20 20 20 20 t. ttdat.
0920: 28 69 66 20 2a 74 74 64 61 74 2a 0a 20 20 20 20 (if *ttdat*.
0930: 20 20 20 2a 74 74 64 61 74 2a 0a 20 20 20 20 20 *ttdat*.
0940: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
0950: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
0960: 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 2 *default-l
0970: 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 og-port* "rmt:se
0980: 74 2d 74 74 64 61 74 3a 20 49 6e 69 74 69 61 6c t-ttdat: Initial
0990: 69 7a 65 20 6e 65 77 20 74 74 64 61 74 22 29 0a ize new ttdat").
09a0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
09b0: 28 6e 65 77 72 65 6d 6f 74 65 20 20 28 6d 61 6b (newremote (mak
09c0: 65 2d 61 6e 64 2d 69 6e 69 74 2d 72 65 6d 6f 74 e-and-init-remot
09d0: 65 20 61 72 65 61 70 61 74 68 29 29 29 0a 20 20 e areapath))).
09e0: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 2a (set! *
09f0: 74 74 64 61 74 2a 20 6e 65 77 72 65 6d 6f 74 65 ttdat* newremote
0a00: 29 0a 09 20 20 20 6e 65 77 72 65 6d 6f 74 65 0a ).. newremote.
0a10: 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 ).
0a20: 20 20 29 0a 20 20 20 20 20 29 0a 20 20 20 29 0a ). ). ).
0a30: 29 0a 0a 3b 3b 20 4e 42 2f 2f 20 61 72 65 61 2d )..;; NB// area-
0a40: 64 61 74 20 72 65 70 6c 61 63 65 64 20 62 79 20 dat replaced by
0a50: 74 74 64 61 74 0a 3b 3b 20 0a 28 64 65 66 69 6e ttdat.;; .(defin
0a60: 65 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 e (rmt:send-rece
0a70: 69 76 65 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 ive cmd run-id p
0a80: 61 72 61 6d 73 20 23 21 6b 65 79 20 28 61 74 74 arams #!key (att
0a90: 65 6d 70 74 6e 75 6d 20 31 29 28 74 74 64 61 74 emptnum 1)(ttdat
0aa0: 20 23 66 29 29 0a 20 20 28 61 73 73 65 72 74 20 #f)). (assert
0ab0: 28 6f 72 20 28 6e 6f 74 20 72 75 6e 2d 69 64 29 (or (not run-id)
0ac0: 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 (number? run-id
0ad0: 29 29 20 22 46 41 54 41 4c 3a 20 72 75 6e 2d 69 )) "FATAL: run-i
0ae0: 64 20 69 73 20 72 65 71 75 69 72 65 64 20 74 6f d is required to
0af0: 20 62 65 20 61 20 6e 75 6d 62 65 72 20 6f 72 20 be a number or
0b00: 23 66 22 29 0a 20 20 28 61 73 73 65 72 74 20 2a #f"). (assert *
0b10: 74 6f 70 70 61 74 68 2a 20 22 46 41 54 41 4c 3a toppath* "FATAL:
0b20: 20 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 rmt:send-receiv
0b30: 65 20 63 61 6c 6c 65 64 20 77 69 74 68 20 2a 74 e called with *t
0b40: 6f 70 70 61 74 68 2a 20 6e 6f 74 20 73 65 74 2e oppath* not set.
0b50: 22 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 72 65 "). (let* ((are
0b60: 61 70 61 74 68 20 20 20 20 20 20 2a 74 6f 70 70 apath *topp
0b70: 61 74 68 2a 29 20 3b 3b 20 54 4f 44 4f 20 2d 20 ath*) ;; TODO -
0b80: 72 65 73 6f 6c 76 65 20 66 72 6f 6d 20 64 62 73 resolve from dbs
0b90: 74 72 75 63 74 20 74 6f 20 62 65 20 63 6f 6d 70 truct to be comp
0ba0: 61 74 69 62 6c 65 20 77 69 74 68 20 6d 75 6c 74 atible with mult
0bb0: 69 70 6c 65 20 61 72 65 61 73 0a 09 20 28 72 65 iple areas.. (re
0bc0: 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 28 72 6d 74 adonly-mode (rmt
0bd0: 6d 6f 64 3a 63 61 6c 63 2d 72 6f 2d 6d 6f 64 65 mod:calc-ro-mode
0be0: 20 74 74 64 61 74 20 2a 74 6f 70 70 61 74 68 2a ttdat *toppath*
0bf0: 29 29 0a 09 20 28 74 65 73 74 73 75 69 74 65 20 )).. (testsuite
0c00: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d (common:get-
0c10: 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 testsuite-name))
0c20: 0a 09 20 28 64 62 66 6e 61 6d 65 20 20 20 20 20 .. (dbfname
0c30: 20 20 28 63 6f 6e 63 20 28 64 62 66 69 6c 65 3a (conc (dbfile:
0c40: 72 75 6e 2d 69 64 2d 3e 64 62 6e 75 6d 20 72 75 run-id->dbnum ru
0c50: 6e 2d 69 64 29 22 2e 64 62 22 29 29 0a 09 20 28 n-id)".db")).. (
0c60: 64 62 64 69 72 20 20 20 20 20 20 20 20 20 28 63 dbdir (c
0c70: 6f 6e 63 20 61 72 65 61 70 61 74 68 20 22 2f 2e onc areapath "/.
0c80: 6d 74 64 62 22 29 29 0a 20 20 20 20 20 20 20 20 mtdb")).
0c90: 20 28 6a 6f 75 72 6e 61 6c 2d 63 68 65 63 6b 20 (journal-check
0ca0: 23 66 29 29 20 3b 3b 20 64 69 73 61 62 6c 69 6e #f)) ;; disablin
0cb0: 67 20 6a 6f 75 72 6e 61 6c 20 63 68 65 63 6b 20 g journal check
0cc0: 66 6f 72 20 6e 6f 77 2c 20 73 69 6e 63 65 20 6a for now, since j
0cd0: 6f 75 72 6e 61 6c 20 66 69 6c 65 73 20 61 72 65 ournal files are
0ce0: 20 6f 6e 6c 79 20 70 6f 73 73 69 62 6c 65 20 6f only possible o
0cf0: 6e 20 74 68 65 20 4e 46 53 20 64 62 73 2e 0a 0a n the NFS dbs...
0d00: 20 20 20 20 28 69 66 20 28 61 6e 64 20 6a 6f 75 (if (and jou
0d10: 72 6e 61 6c 2d 63 68 65 63 6b 20 28 6e 6f 74 20 rnal-check (not
0d20: 2a 6a 6f 75 72 6e 61 6c 2d 73 74 61 74 73 2a 29 *journal-stats*)
0d30: 0a 09 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 .. (file-exi
0d40: 73 74 73 3f 20 64 62 64 69 72 29 29 0a 09 28 74 sts? dbdir))..(t
0d50: 74 3a 73 74 61 72 74 2d 73 74 61 74 73 20 64 62 t:start-stats db
0d60: 64 69 72 29 29 20 3b 3b 20 66 69 78 6d 65 20 2d dir)) ;; fixme -
0d70: 20 66 69 6e 64 20 74 68 65 20 72 69 67 68 74 20 find the right
0d80: 63 61 6c 6c 20 74 6f 20 67 65 74 20 74 68 65 20 call to get the
0d90: 64 62 20 64 69 72 65 63 74 6f 72 79 0a 20 20 20 db directory.
0da0: 20 0a 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 74 . ;; check t
0db0: 68 65 20 6c 6f 61 64 20 6f 6e 20 64 62 66 6e 61 he load on dbfna
0dc0: 6d 65 20 61 6e 64 20 61 64 64 20 73 6f 6d 65 20 me and add some
0dd0: 64 65 6c 61 79 20 75 73 69 6e 67 20 61 20 64 72 delay using a dr
0de0: 6f 6f 70 20 63 75 72 76 65 20 6f 66 20 73 6f 72 oop curve of sor
0df0: 74 73 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 ts. (if (and
0e00: 6a 6f 75 72 6e 61 6c 2d 63 68 65 63 6b 20 2a 6a journal-check *j
0e10: 6f 75 72 6e 61 6c 2d 73 74 61 74 73 2a 29 0a 09 ournal-stats*)..
0e20: 28 6c 65 74 2a 20 28 28 6c 6f 61 64 20 20 28 74 (let* ((load (t
0e30: 74 3a 67 65 74 2d 6a 6f 75 72 6e 61 6c 2d 73 74 t:get-journal-st
0e40: 61 74 73 20 64 62 66 6e 61 6d 65 29 29 29 0a 09 ats dbfname)))..
0e50: 20 20 28 69 66 20 28 3e 20 6c 6f 61 64 20 30 2e (if (> load 0.
0e60: 31 29 20 3b 3b 20 73 74 61 72 74 20 61 63 74 69 1) ;; start acti
0e70: 76 61 74 69 6e 67 20 64 65 6c 61 79 20 61 74 20 vating delay at
0e80: 31 30 25 20 6a 6f 75 72 6e 61 6c 20 6c 6f 61 64 10% journal load
0e90: 20 74 69 6d 65 0a 09 20 20 20 20 20 20 28 6c 65 time.. (le
0ea0: 74 20 28 28 64 65 6c 79 20 28 2a 20 35 30 20 28 t ((dely (* 50 (
0eb0: 2a 20 6c 6f 61 64 20 6c 6f 61 64 29 29 29 29 20 * load load))))
0ec0: 3b 3b 20 31 30 30 25 20 6a 6f 75 72 6e 61 6c 20 ;; 100% journal
0ed0: 74 69 6d 65 3d 35 30 73 65 63 20 64 65 6c 61 79 time=50sec delay
0ee0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
0ef0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
0f00: 6f 72 74 2a 20 22 4a 6f 75 72 6e 61 6c 20 6c 6f ort* "Journal lo
0f10: 61 64 20 22 6c 6f 61 64 22 20 6f 6e 20 22 64 62 ad "load" on "db
0f20: 66 6e 61 6d 65 22 20 64 65 6c 61 79 69 6e 67 20 fname" delaying
0f30: 71 75 65 72 69 65 73 20 22 64 65 6c 79 22 73 2e queries "dely"s.
0f40: 22 29 0a 09 09 28 74 68 72 65 61 64 2d 73 6c 65 ")...(thread-sle
0f50: 65 70 21 20 64 65 6c 79 29 29 29 29 29 0a 09 0a ep! dely)))))...
0f60: 20 20 20 20 28 63 61 73 65 20 28 72 6d 74 3a 74 (case (rmt:t
0f70: 72 61 6e 73 70 6f 72 74 2d 6d 6f 64 65 29 0a 20 ransport-mode).
0f80: 20 20 20 20 20 28 28 74 63 70 29 0a 20 20 20 20 ((tcp).
0f90: 20 20 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 (let* ((start
0fa0: 2d 74 69 6d 65 20 20 20 20 28 63 75 72 72 65 6e -time (curren
0fb0: 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b 20 73 t-seconds)) ;; s
0fc0: 6e 61 70 73 68 6f 74 20 74 69 6d 65 20 73 6f 20 napshot time so
0fd0: 61 6c 6c 20 75 73 65 20 63 61 73 65 73 20 67 65 all use cases ge
0fe0: 74 20 73 61 6d 65 20 76 61 6c 75 65 0a 09 20 20 t same value..
0ff0: 20 20 20 20 28 61 74 74 65 6d 70 74 6e 75 6d 20 (attemptnum
1000: 20 20 20 28 2b 20 31 20 61 74 74 65 6d 70 74 6e (+ 1 attemptn
1010: 75 6d 29 29 0a 09 20 20 20 20 20 20 28 6d 74 65 um)).. (mte
1020: 78 65 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d xe (comm
1030: 6f 6e 3a 66 69 6e 64 2d 6c 6f 63 61 6c 2d 6d 65 on:find-local-me
1040: 67 61 74 65 73 74 29 29 0a 09 20 20 20 20 20 20 gatest))..
1050: 28 74 74 64 61 74 20 20 20 20 20 20 20 20 20 28 (ttdat (
1060: 72 6d 74 3a 73 65 74 2d 74 74 64 61 74 20 61 72 rmt:set-ttdat ar
1070: 65 61 70 61 74 68 20 74 74 64 61 74 29 29 0a 09 eapath ttdat))..
1080: 20 20 20 20 20 20 28 63 6f 6e 6e 20 20 20 20 20 (conn
1090: 20 20 20 20 20 28 74 74 3a 67 65 74 2d 63 6f 6e (tt:get-con
10a0: 6e 20 74 74 64 61 74 20 64 62 66 6e 61 6d 65 29 n ttdat dbfname)
10b0: 29 0a 09 20 20 20 20 20 20 28 69 73 2d 6d 61 69 ).. (is-mai
10c0: 6e 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 n (equal?
10d0: 64 62 66 6e 61 6d 65 20 22 6d 61 69 6e 2e 64 62 dbfname "main.db
10e0: 22 29 29 20 3b 3b 20 77 68 79 20 6e 6f 74 20 28 ")) ;; why not (
10f0: 6e 6f 74 20 72 75 6e 2d 69 64 29 20 3f 0a 09 20 not run-id) ?..
1100: 20 20 20 20 20 28 73 65 72 76 65 72 2d 73 74 61 (server-sta
1110: 72 74 2d 70 72 6f 63 20 28 69 66 20 69 73 2d 6d rt-proc (if is-m
1120: 61 69 6e 0a 09 09 09 09 20 20 20 20 20 23 66 0a ain..... #f.
1130: 09 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 .... (lambda
1140: 20 28 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b ()..... ;
1150: 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ; (debug:print-i
1160: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
1170: 6f 67 2d 70 6f 72 74 2a 20 22 73 74 61 72 74 69 og-port* "starti
1180: 6e 67 20 73 65 72 76 65 72 20 66 6f 72 20 64 62 ng server for db
1190: 66 6e 61 6d 65 3a 20 22 64 62 66 6e 61 6d 65 29 fname: "dbfname)
11a0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 72 6d 74 ..... (rmt
11b0: 3a 73 74 61 72 74 2d 73 65 72 76 65 72 20 3b 3b :start-server ;;
11c0: 20 74 74 3a 73 65 72 76 65 72 2d 70 72 6f 63 65 tt:server-proce
11d0: 73 73 2d 72 75 6e 0a 09 09 09 09 09 61 72 65 61 ss-run......area
11e0: 70 61 74 68 0a 09 09 09 09 09 74 65 73 74 73 75 path......testsu
11f0: 69 74 65 20 3b 3b 20 28 64 62 66 69 6c 65 3a 74 ite ;; (dbfile:t
1200: 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 0a 09 estsuite-name)..
1210: 09 09 09 09 6d 74 65 78 65 0a 09 09 09 09 09 72 ....mtexe......r
1220: 75 6e 2d 69 64 29 29 29 29 29 0a 09 20 3b 3b 20 un-id))))).. ;;
1230: 68 65 72 65 20 77 65 20 6c 6f 6f 6b 20 61 74 20 here we look at
1240: 74 74 64 61 74 2c 20 69 66 20 64 62 66 6e 61 6d ttdat, if dbfnam
1250: 65 20 69 73 20 4e 4f 54 20 6d 61 69 6e 2e 64 62 e is NOT main.db
1260: 20 77 65 20 63 68 65 63 6b 20 74 68 61 74 20 61 we check that a
1270: 20 63 6f 6e 6e 20 65 78 69 73 74 73 20 66 6f 72 conn exists for
1280: 20 69 74 0a 09 20 3b 3b 20 61 6e 64 20 69 66 20 it.. ;; and if
1290: 74 68 65 72 65 20 69 73 20 6e 6f 20 63 6f 6e 6e there is no conn
12a0: 20 77 65 20 66 69 72 73 74 20 73 65 6e 64 20 61 we first send a
12b0: 20 72 65 71 75 65 73 74 20 74 6f 20 74 68 65 20 request to the
12c0: 6d 61 69 6e 2e 64 62 20 73 65 72 76 65 72 20 74 main.db server t
12d0: 6f 20 73 74 61 72 74 20 61 0a 09 20 3b 3b 20 73 o start a.. ;; s
12e0: 65 72 76 65 72 20 66 6f 72 20 74 68 65 20 64 62 erver for the db
12f0: 66 6e 61 6d 65 2e 0a 09 20 23 3b 28 69 66 20 28 fname... #;(if (
1300: 61 6e 64 20 28 6e 6f 74 20 69 73 2d 6d 61 69 6e and (not is-main
1310: 29 28 6e 6f 74 20 63 6f 6e 6e 29 29 20 3b 3b 20 )(not conn)) ;;
1320: 6e 6f 20 65 78 69 73 74 69 6e 67 20 63 6f 6e 6e no existing conn
1330: 65 63 74 69 6f 6e 20 74 6f 20 6e 6f 6e 2d 6d 61 ection to non-ma
1340: 69 6e 20 73 65 72 76 65 72 2c 20 63 61 6c 6c 20 in server, call
1350: 69 6e 20 61 20 73 74 61 72 74 20 75 70 20 72 65 in a start up re
1360: 71 75 65 73 74 0a 09 20 28 62 65 67 69 6e 0a 09 quest.. (begin..
1370: 20 28 73 65 72 76 65 72 2d 73 74 61 72 74 2d 70 (server-start-p
1380: 72 6f 63 29 0a 09 20 28 74 68 72 65 61 64 2d 73 roc).. (thread-s
1390: 6c 65 65 70 21 20 31 29 29 29 0a 09 20 28 74 74 leep! 1))).. (tt
13a0: 3a 68 61 6e 64 6c 65 72 20 74 74 64 61 74 20 63 :handler ttdat c
13b0: 6d 64 20 72 75 6e 2d 69 64 20 70 61 72 61 6d 73 md run-id params
13c0: 20 61 74 74 65 6d 70 74 6e 75 6d 20 72 65 61 64 attemptnum read
13d0: 6f 6e 6c 79 2d 6d 6f 64 65 20 64 62 66 6e 61 6d only-mode dbfnam
13e0: 65 20 74 65 73 74 73 75 69 74 65 20 6d 74 65 78 e testsuite mtex
13f0: 65 20 73 65 72 76 65 72 2d 73 74 61 72 74 2d 70 e server-start-p
1400: 72 6f 63 29 29 29 0a 20 20 20 20 20 20 28 28 6e roc))). ((n
1410: 66 73 29 0a 20 20 20 20 20 20 20 28 6e 66 73 2d fs). (nfs-
1420: 74 72 61 6e 73 70 6f 72 74 2d 68 61 6e 64 6c 65 transport-handle
1430: 72 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 72 r cmd run-id par
1440: 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d 20 61 ams attemptnum a
1450: 72 65 61 70 61 74 68 20 72 65 61 64 6f 6e 6c 79 reapath readonly
1460: 2d 6d 6f 64 65 20 74 65 73 74 73 75 69 74 65 29 -mode testsuite)
1470: 29 0a 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 ). (else.
1480: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
1490: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
14a0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 t-log-port* "rmt
14b0: 3a 74 72 61 6e 73 70 6f 72 74 2d 6d 6f 64 65 20 :transport-mode
14c0: 69 73 20 22 28 72 6d 74 3a 74 72 61 6e 73 70 6f is "(rmt:transpo
14d0: 72 74 2d 6d 6f 64 65 29 29 0a 20 20 20 20 20 20 rt-mode)).
14e0: 20 28 61 73 73 65 72 74 20 23 66 20 22 46 41 54 (assert #f "FAT
14f0: 41 4c 3a 20 72 6d 74 3a 74 72 61 6e 73 70 6f 72 AL: rmt:transpor
1500: 74 2d 6d 6f 64 65 20 73 65 74 20 74 6f 20 69 6e t-mode set to in
1510: 76 61 6c 69 64 20 76 61 6c 75 65 2e 22 29 29 29 valid value.")))
1520: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6e 66 73 ))..(define (nfs
1530: 2d 74 72 61 6e 73 70 6f 72 74 2d 68 61 6e 64 6c -transport-handl
1540: 65 72 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 er cmd run-id pa
1550: 72 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d 20 rams attemptnum
1560: 61 72 65 61 70 61 74 68 20 72 65 61 64 6f 6e 6c areapath readonl
1570: 79 2d 6d 6f 64 65 20 74 65 73 74 73 75 69 74 65 y-mode testsuite
1580: 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 ). (let* ((keys
1590: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 (common:get
15a0: 2d 66 69 65 6c 64 73 20 2a 63 6f 6e 66 69 67 64 -fields *configd
15b0: 61 74 2a 29 29 0a 09 20 28 64 62 73 74 72 75 63 at*)).. (dbstruc
15c0: 74 20 28 64 62 6d 6f 64 3a 6e 66 73 2d 67 65 74 t (dbmod:nfs-get
15d0: 2d 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 -dbstruct run-id
15e0: 20 6b 65 79 73 20 28 64 62 66 69 6c 65 3a 64 62 keys (dbfile:db
15f0: 2d 69 6e 69 74 2d 70 72 6f 63 29 20 61 72 65 61 -init-proc) area
1600: 70 61 74 68 29 29 29 0a 20 20 20 20 28 61 70 69 path))). (api
1610: 3a 64 69 73 70 61 74 63 68 2d 72 65 71 75 65 73 :dispatch-reques
1620: 74 20 64 62 73 74 72 75 63 74 20 63 6d 64 20 72 t dbstruct cmd r
1630: 75 6e 2d 69 64 20 70 61 72 61 6d 73 29 29 29 0a un-id params))).
1640: 09 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
1650: 65 74 2d 6d 61 78 2d 71 75 65 72 79 2d 61 76 65 et-max-query-ave
1660: 72 61 67 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 rage run-id). (
1670: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 2d mutex-lock! *db-
1680: 73 74 61 74 73 2d 6d 75 74 65 78 2a 29 0a 20 20 stats-mutex*).
1690: 28 6c 65 74 2a 20 28 28 72 75 6e 6b 65 79 20 28 (let* ((runkey (
16a0: 63 6f 6e 63 20 22 72 75 6e 2d 69 64 3d 22 20 72 conc "run-id=" r
16b0: 75 6e 2d 69 64 20 22 20 22 29 29 0a 09 20 28 63 un-id " ")).. (c
16c0: 6d 64 73 20 20 20 28 66 69 6c 74 65 72 20 28 6c mds (filter (l
16d0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 ambda (x)....
16e0: 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 (substring-index
16f0: 20 72 75 6e 6b 65 79 20 78 29 29 0a 09 09 09 20 runkey x))....
1700: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
1710: 20 2a 64 62 2d 73 74 61 74 73 2a 29 29 29 0a 09 *db-stats*)))..
1720: 20 28 72 65 73 20 20 20 20 28 69 66 20 28 6e 75 (res (if (nu
1730: 6c 6c 3f 20 63 6d 64 73 29 0a 09 09 20 20 20 20 ll? cmds)...
1740: 20 28 63 6f 6e 73 20 27 6e 6f 6e 65 20 30 29 0a (cons 'none 0).
1750: 09 09 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 .. (let loop
1760: 20 28 28 63 6d 64 20 28 63 61 72 20 63 6d 64 73 ((cmd (car cmds
1770: 29 29 0a 09 09 09 09 28 74 61 6c 20 28 63 64 72 )).....(tal (cdr
1780: 20 63 6d 64 73 29 29 0a 09 09 09 09 28 6d 61 78 cmds)).....(max
1790: 2d 63 6d 64 20 28 63 61 72 20 63 6d 64 73 29 29 -cmd (car cmds))
17a0: 0a 09 09 09 09 28 72 65 73 20 30 29 29 0a 09 09 .....(res 0))...
17b0: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 (let* ((c
17c0: 6d 64 2d 64 61 74 20 28 68 61 73 68 2d 74 61 62 md-dat (hash-tab
17d0: 6c 65 2d 72 65 66 20 2a 64 62 2d 73 74 61 74 73 le-ref *db-stats
17e0: 2a 20 63 6d 64 29 29 0a 09 09 09 20 20 20 20 20 * cmd))....
17f0: 20 28 74 6f 74 20 20 20 20 20 28 76 65 63 74 6f (tot (vecto
1800: 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 20 30 29 r-ref cmd-dat 0)
1810: 29 0a 09 09 09 20 20 20 20 20 20 28 63 75 72 72 ).... (curr
1820: 61 76 67 20 28 2f 20 28 76 65 63 74 6f 72 2d 72 avg (/ (vector-r
1830: 65 66 20 63 6d 64 2d 64 61 74 20 31 29 20 28 76 ef cmd-dat 1) (v
1840: 65 63 74 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 ector-ref cmd-da
1850: 74 20 30 29 29 29 20 3b 3b 20 63 6f 75 6e 74 20 t 0))) ;; count
1860: 69 73 20 6e 65 76 65 72 20 7a 65 72 6f 20 62 79 is never zero by
1870: 20 63 6f 6e 73 74 72 75 63 74 69 6f 6e 0a 09 09 construction...
1880: 09 20 20 20 20 20 20 28 63 75 72 72 6d 61 78 20 . (currmax
1890: 28 6d 61 78 20 72 65 73 20 63 75 72 72 61 76 67 (max res curravg
18a0: 29 29 0a 09 09 09 20 20 20 20 20 20 28 6e 65 77 )).... (new
18b0: 6d 61 78 2d 63 6d 64 20 28 69 66 20 28 3e 20 63 max-cmd (if (> c
18c0: 75 72 72 61 76 67 20 72 65 73 29 20 63 6d 64 20 urravg res) cmd
18d0: 6d 61 78 2d 63 6d 64 29 29 29 0a 09 09 09 20 28 max-cmd))).... (
18e0: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 if (null? tal)..
18f0: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 74 6f .. (if (> to
1900: 74 20 31 30 29 0a 09 09 09 09 20 28 63 6f 6e 73 t 10)..... (cons
1910: 20 6e 65 77 6d 61 78 2d 63 6d 64 20 63 75 72 72 newmax-cmd curr
1920: 6d 61 78 29 0a 09 09 09 09 20 28 63 6f 6e 73 20 max)..... (cons
1930: 27 6e 6f 6e 65 20 30 29 29 0a 09 09 09 20 20 20 'none 0))....
1940: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
1950: 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 6d 61 )(cdr tal) newma
1960: 78 2d 63 6d 64 20 63 75 72 72 6d 61 78 29 29 29 x-cmd currmax)))
1970: 29 29 29 29 0a 20 20 20 20 28 6d 75 74 65 78 2d )))). (mutex-
1980: 75 6e 6c 6f 63 6b 21 20 2a 64 62 2d 73 74 61 74 unlock! *db-stat
1990: 73 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 72 65 s-mutex*). re
19a0: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d s))..(define (rm
19b0: 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 t:open-qry-close
19c0: 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 72 75 6e -locally cmd run
19d0: 2d 69 64 20 70 61 72 61 6d 73 20 23 21 6b 65 79 -id params #!key
19e0: 20 28 72 65 6d 72 65 74 72 69 65 73 20 35 29 29 (remretries 5))
19f0: 0a 20 20 28 6c 65 74 2a 20 28 28 71 72 79 2d 69 . (let* ((qry-i
1a00: 73 2d 77 72 69 74 65 20 20 20 20 28 6e 6f 74 20 s-write (not
1a10: 28 6d 65 6d 62 65 72 20 63 6d 64 20 61 70 69 3a (member cmd api:
1a20: 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 read-only-querie
1a30: 73 29 29 29 0a 09 20 28 64 62 2d 66 69 6c 65 2d s))).. (db-file-
1a40: 70 61 74 68 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a path (common:
1a50: 6d 61 6b 65 2d 74 6d 70 64 69 72 2d 6e 61 6d 65 make-tmpdir-name
1a60: 20 2a 74 6f 70 70 61 74 68 2a 20 22 22 29 29 20 *toppath* ""))
1a70: 3b 3b 20 20 30 29 29 0a 09 20 28 64 62 73 74 72 ;; 0)).. (dbstr
1a80: 75 63 74 73 2d 6c 6f 63 61 6c 20 28 64 62 3a 73 ucts-local (db:s
1a90: 65 74 75 70 29 29 0a 09 20 28 72 65 61 64 2d 6f etup)).. (read-o
1aa0: 6e 6c 79 20 20 20 20 20 20 20 28 6e 6f 74 20 28 nly (not (
1ab0: 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 file-write-acces
1ac0: 73 3f 20 64 62 2d 66 69 6c 65 2d 70 61 74 68 29 s? db-file-path)
1ad0: 29 29 0a 09 20 28 73 74 61 72 74 20 20 20 20 20 )).. (start
1ae0: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 6d (current-m
1af0: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 20 illiseconds))..
1b00: 28 72 65 73 64 61 74 20 20 20 20 20 20 20 20 20 (resdat
1b10: 20 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 72 (if (not (and r
1b20: 65 61 64 2d 6f 6e 6c 79 20 71 72 79 2d 69 73 2d ead-only qry-is-
1b30: 77 72 69 74 65 29 29 0a 09 09 09 20 20 20 20 20 write))....
1b40: 20 28 6c 65 74 20 28 28 76 20 28 61 70 69 3a 65 (let ((v (api:e
1b50: 78 65 63 75 74 65 2d 72 65 71 75 65 73 74 73 20 xecute-requests
1b60: 64 62 73 74 72 75 63 74 73 2d 6c 6f 63 61 6c 20 dbstructs-local
1b70: 28 76 65 63 74 6f 72 20 28 73 79 6d 62 6f 6c 2d (vector (symbol-
1b80: 3e 73 74 72 69 6e 67 20 63 6d 64 29 20 70 61 72 >string cmd) par
1b90: 61 6d 73 29 29 29 29 0a 09 09 09 3b 3b 09 28 68 ams))))....;;.(h
1ba0: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
1bb0: 20 3b 3b 20 74 68 65 72 65 20 68 61 73 20 62 65 ;; there has be
1bc0: 65 6e 20 61 20 6c 6f 6e 67 20 68 69 73 74 6f 72 en a long histor
1bd0: 79 20 6f 66 20 72 65 63 65 69 76 69 6e 67 20 73 y of receiving s
1be0: 74 72 61 6e 67 65 20 65 72 72 6f 72 73 20 66 72 trange errors fr
1bf0: 6f 6d 20 76 61 6c 75 65 73 20 72 65 74 75 72 6e om values return
1c00: 65 64 20 62 79 20 74 68 65 20 63 6c 69 65 6e 74 ed by the client
1c10: 20 77 68 65 6e 20 74 68 69 6e 67 73 20 67 6f 20 when things go
1c20: 77 72 6f 6e 67 2e 2e 0a 09 09 09 3b 3b 09 20 65 wrong......;;. e
1c30: 78 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 xn
1c40: 20 3b 3b 20 20 54 68 69 73 20 69 73 20 61 6e 20 ;; This is an
1c50: 61 74 74 65 6d 70 74 20 74 6f 20 64 65 74 65 63 attempt to detec
1c60: 74 20 74 68 61 74 20 73 69 74 75 61 74 69 6f 6e t that situation
1c70: 20 61 6e 64 20 72 65 63 6f 76 65 72 20 67 72 61 and recover gra
1c80: 63 65 66 75 6c 6c 79 0a 09 09 09 3b 3b 09 20 28 cefully....;;. (
1c90: 62 65 67 69 6e 0a 09 09 09 3b 3b 09 20 20 20 28 begin....;;. (
1ca0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
1cb0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1cc0: 20 22 45 52 52 4f 52 3a 20 62 61 64 20 64 61 74 "ERROR: bad dat
1cd0: 61 20 66 72 6f 6d 20 73 65 72 76 65 72 20 22 20 a from server "
1ce0: 76 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 20 v " message: "
1cf0: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
1d00: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
1d10: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
1d20: 29 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a ) ", exn=" exn).
1d30: 09 09 09 3b 3b 09 20 20 20 28 76 65 63 74 6f 72 ...;;. (vector
1d40: 20 23 74 20 27 28 29 29 29 20 3b 3b 20 73 68 6f #t '())) ;; sho
1d50: 75 6c 64 20 61 6c 77 61 79 73 20 67 65 74 20 61 uld always get a
1d60: 20 76 65 63 74 6f 72 20 62 75 74 20 69 66 20 73 vector but if s
1d70: 6f 6d 65 74 68 69 6e 67 20 67 6f 65 73 20 77 72 omething goes wr
1d80: 6f 6e 67 20 72 65 74 75 72 6e 20 61 20 64 75 6d ong return a dum
1d90: 6d 79 0a 09 09 09 09 20 28 69 66 20 28 61 6e 64 my..... (if (and
1da0: 20 28 76 65 63 74 6f 72 3f 20 76 29 0a 09 09 09 (vector? v)....
1db0: 09 09 20 20 28 3e 20 28 76 65 63 74 6f 72 2d 6c .. (> (vector-l
1dc0: 65 6e 67 74 68 20 76 29 20 31 29 29 0a 09 09 09 ength v) 1))....
1dd0: 09 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 . (let ((new
1de0: 76 65 63 20 28 76 65 63 74 6f 72 20 28 76 65 63 vec (vector (vec
1df0: 74 6f 72 2d 72 65 66 20 76 20 30 29 28 76 65 63 tor-ref v 0)(vec
1e00: 74 6f 72 2d 72 65 66 20 76 20 31 29 29 29 29 0a tor-ref v 1)))).
1e10: 09 09 09 09 20 20 20 20 20 20 20 6e 65 77 76 65 .... newve
1e20: 63 29 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 c) ;;
1e30: 62 79 20 63 6f 70 79 69 6e 67 20 74 68 65 20 76 by copying the v
1e40: 65 63 74 6f 72 20 77 68 69 6c 65 20 69 6e 73 69 ector while insi
1e50: 64 65 20 74 68 65 20 65 72 72 6f 72 20 68 61 6e de the error han
1e60: 64 6c 65 72 20 77 65 20 73 68 6f 75 6c 64 20 66 dler we should f
1e70: 6f 72 63 65 20 74 68 65 20 64 65 74 65 63 74 69 orce the detecti
1e80: 6f 6e 20 6f 66 20 61 20 63 6f 72 72 75 70 74 65 on of a corrupte
1e90: 64 20 72 65 63 6f 72 64 0a 09 09 09 09 20 20 20 d record.....
1ea0: 20 20 28 76 65 63 74 6f 72 20 23 74 20 27 28 29 (vector #t '()
1eb0: 29 29 29 20 3b 3b 20 29 20 20 3b 3b 20 77 65 20 ))) ;; ) ;; we
1ec0: 63 6f 75 6c 64 20 61 6c 73 6f 20 63 68 65 63 6b could also check
1ed0: 20 74 68 61 74 20 74 68 65 20 72 65 74 75 72 6e that the return
1ee0: 65 64 20 74 79 70 65 73 20 61 72 65 20 76 61 6c ed types are val
1ef0: 69 64 0a 09 09 09 20 20 20 20 20 20 28 76 65 63 id.... (vec
1f00: 74 6f 72 20 23 74 20 27 28 29 29 29 29 0a 09 20 tor #t '())))..
1f10: 28 73 75 63 63 65 73 73 20 20 20 20 20 20 20 20 (success
1f20: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 (vector-ref resd
1f30: 61 74 20 30 29 29 0a 09 20 28 72 65 73 20 20 20 at 0)).. (res
1f40: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
1f50: 2d 72 65 66 20 72 65 73 64 61 74 20 31 29 29 0a -ref resdat 1)).
1f60: 09 20 28 64 75 72 61 74 69 6f 6e 20 20 20 20 20 . (duration
1f70: 20 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 (- (current-mi
1f80: 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 lliseconds) star
1f90: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e t))). (if (an
1fa0: 64 20 72 65 61 64 2d 6f 6e 6c 79 20 71 72 79 2d d read-only qry-
1fb0: 69 73 2d 77 72 69 74 65 29 0a 20 20 20 20 20 20 is-write).
1fc0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
1fd0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
1fe0: 72 74 2a 20 22 45 52 52 4f 52 3a 20 61 74 74 65 rt* "ERROR: atte
1ff0: 6d 70 74 20 74 6f 20 77 72 69 74 65 20 74 6f 20 mpt to write to
2000: 72 65 61 64 2d 6f 6e 6c 79 20 64 61 74 61 62 61 read-only databa
2010: 73 65 20 69 67 6e 6f 72 65 64 2e 20 63 6d 64 3d se ignored. cmd=
2020: 22 20 63 6d 64 29 29 0a 20 20 20 20 28 69 66 20 " cmd)). (if
2030: 28 6e 6f 74 20 73 75 63 63 65 73 73 29 0a 09 28 (not success)..(
2040: 69 66 20 28 3e 20 72 65 6d 72 65 74 72 69 65 73 if (> remretries
2050: 20 30 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 0).. (begin.
2060: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
2070: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
2080: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
2090: 6c 6f 63 61 6c 20 71 75 65 72 79 20 66 61 69 6c local query fail
20a0: 65 64 2e 20 54 72 79 69 6e 67 20 61 67 61 69 6e ed. Trying again
20b0: 2e 22 29 0a 09 20 20 20 20 20 20 28 74 68 72 65 .").. (thre
20c0: 61 64 2d 73 6c 65 65 70 21 20 28 2f 20 28 72 61 ad-sleep! (/ (ra
20d0: 6e 64 6f 6d 20 35 30 30 30 29 20 31 30 30 30 29 ndom 5000) 1000)
20e0: 29 20 3b 3b 20 73 6f 6d 65 20 72 61 6e 64 6f 6d ) ;; some random
20f0: 20 64 65 6c 61 79 20 0a 09 20 20 20 20 20 20 28 delay .. (
2100: 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f rmt:open-qry-clo
2110: 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 72 se-locally cmd r
2120: 75 6e 2d 69 64 20 70 61 72 61 6d 73 20 72 65 6d un-id params rem
2130: 72 65 74 72 69 65 73 3a 20 28 2d 20 72 65 6d 72 retries: (- remr
2140: 65 74 72 69 65 73 20 31 29 29 29 0a 09 20 20 20 etries 1)))..
2150: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
2160: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
2170: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
2180: 2d 70 6f 72 74 2a 20 22 74 6f 6f 20 6d 61 6e 79 -port* "too many
2190: 20 72 65 74 72 69 65 73 20 69 6e 20 72 6d 74 3a retries in rmt:
21a0: 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c open-qry-close-l
21b0: 6f 63 61 6c 6c 79 2c 20 67 69 76 69 6e 67 20 75 ocally, giving u
21c0: 70 22 29 0a 09 20 20 20 20 20 20 23 66 29 29 0a p").. #f)).
21d0: 09 28 62 65 67 69 6e 0a 09 20 20 3b 3b 20 28 72 .(begin.. ;; (r
21e0: 6d 74 3a 75 70 64 61 74 65 2d 64 62 2d 73 74 61 mt:update-db-sta
21f0: 74 73 20 72 75 6e 2d 69 64 20 63 6d 64 20 70 61 ts run-id cmd pa
2200: 72 61 6d 73 20 64 75 72 61 74 69 6f 6e 29 0a 09 rams duration)..
2210: 20 20 3b 3b 20 6d 61 72 6b 20 74 68 69 73 20 72 ;; mark this r
2220: 75 6e 20 61 73 20 64 69 72 74 79 20 69 66 20 74 un as dirty if t
2230: 68 69 73 20 77 61 73 20 61 20 77 72 69 74 65 2c his was a write,
2240: 20 74 68 65 20 77 61 74 63 68 64 6f 67 20 69 73 the watchdog is
2250: 20 72 65 73 70 6f 6e 73 69 62 6c 65 20 66 6f 72 responsible for
2260: 20 73 79 6e 63 69 6e 67 20 69 74 0a 09 20 20 28 syncing it.. (
2270: 69 66 20 71 72 79 2d 69 73 2d 77 72 69 74 65 0a if qry-is-write.
2280: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 . (let ((st
2290: 61 72 74 2d 74 69 6d 65 20 28 63 75 72 72 65 6e art-time (curren
22a0: 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 09 28 t-seconds)))...(
22b0: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 2d mutex-lock! *db-
22c0: 6d 75 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 65 78 multi-sync-mutex
22d0: 2a 29 0a 09 09 28 73 65 74 21 20 2a 64 62 2d 6c *)...(set! *db-l
22e0: 61 73 74 2d 61 63 63 65 73 73 2a 20 73 74 61 72 ast-access* star
22f0: 74 2d 74 69 6d 65 29 20 20 3b 3b 20 54 48 49 53 t-time) ;; THIS
2300: 20 49 53 20 50 52 4f 42 41 42 4c 59 20 55 53 45 IS PROBABLY USE
2310: 4c 45 53 53 3f 20 28 77 65 20 61 72 65 20 6f 6e LESS? (we are on
2320: 20 61 20 63 6c 69 65 6e 74 29 0a 20 20 20 20 20 a client).
2330: 20 20 20 20 20 20 20 20 20 20 20 28 6d 75 74 65 (mute
2340: 78 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 2d 6d 75 x-unlock! *db-mu
2350: 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 65 78 2a 29 lti-sync-mutex*)
2360: 29 29 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a )))). res))..
2370: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23b0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 41 ========.;;.;; A
23c0: 20 43 20 54 20 55 20 41 20 4c 20 20 20 41 20 50 C T U A L A P
23d0: 20 49 20 20 20 43 20 41 20 4c 20 4c 20 53 20 20 I C A L L S
23e0: 0a 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;.;;==========
23f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
2430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2470: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 53 20 45 20 52 ======.;; S E R
2480: 20 56 20 45 20 52 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d V E R.;;=======
2490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
24d0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6b 69 .(define (rmt:ki
24e0: 6c 6c 2d 73 65 72 76 65 72 20 72 75 6e 2d 69 64 ll-server run-id
24f0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
2500: 63 65 69 76 65 20 27 6b 69 6c 6c 2d 73 65 72 76 ceive 'kill-serv
2510: 65 72 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 er run-id (list
2520: 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 run-id)))..(defi
2530: 6e 65 20 28 72 6d 74 3a 73 74 61 72 74 2d 73 65 ne (rmt:start-se
2540: 72 76 65 72 20 61 72 65 61 70 61 74 68 20 74 65 rver areapath te
2550: 73 74 73 75 69 74 65 20 6d 74 65 78 65 20 72 75 stsuite mtexe ru
2560: 6e 2d 69 64 29 20 3b 3b 20 72 75 6e 20 6f 6e 20 n-id) ;; run on
2570: 6d 61 69 6e 2e 64 62 20 73 65 72 76 65 72 0a 20 main.db server.
2580: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
2590: 76 65 20 27 73 74 61 72 74 2d 73 65 72 76 65 72 ve 'start-server
25a0: 20 23 66 20 28 6c 69 73 74 20 61 72 65 61 70 61 #f (list areapa
25b0: 74 68 20 74 65 73 74 73 75 69 74 65 20 6d 74 65 th testsuite mte
25c0: 78 65 20 72 75 6e 2d 69 64 29 29 29 0a 0a 3b 3b xe run-id)))..;;
25d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2610: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 4d 20 49 20 53 ======.;; M I S
2620: 20 43 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d C.;;===========
2630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
2670: 66 69 6e 65 20 28 72 6d 74 3a 6c 6f 67 69 6e 20 fine (rmt:login
2680: 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 run-id). (rmt:s
2690: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6c 6f 67 end-receive 'log
26a0: 69 6e 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 in run-id (list
26b0: 2a 74 6f 70 70 61 74 68 2a 20 6d 65 67 61 74 65 *toppath* megate
26c0: 73 74 2d 76 65 72 73 69 6f 6e 20 28 63 6c 69 65 st-version (clie
26d0: 6e 74 3a 67 65 74 2d 73 69 67 6e 61 74 75 72 65 nt:get-signature
26e0: 29 29 29 29 0a 0a 3b 3b 20 54 68 69 73 20 6c 6f ))))..;; This lo
26f0: 67 69 6e 20 64 6f 65 73 20 6e 6f 20 72 65 74 72 gin does no retr
2700: 69 65 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f ies under the ho
2710: 6f 64 20 2d 20 69 74 20 61 63 74 73 20 61 20 62 od - it acts a b
2720: 69 74 20 6c 69 6b 65 20 61 20 70 69 6e 67 2e 0a it like a ping..
2730: 3b 3b 20 44 65 70 72 65 63 61 74 65 64 20 66 6f ;; Deprecated fo
2740: 72 20 6e 6d 73 67 2d 74 72 61 6e 73 70 6f 72 74 r nmsg-transport
2750: 2e 0a 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 20 ..;;.;; (define
2760: 28 72 6d 74 3a 6c 6f 67 69 6e 2d 6e 6f 2d 61 75 (rmt:login-no-au
2770: 74 6f 2d 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 to-client-setup
2780: 72 75 6e 72 65 6d 6f 74 65 29 0a 3b 3b 20 20 20 runremote).;;
2790: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
27a0: 65 2d 6e 6f 2d 61 75 74 6f 2d 63 6c 69 65 6e 74 e-no-auto-client
27b0: 2d 73 65 74 75 70 20 72 75 6e 72 65 6d 6f 74 65 -setup runremote
27c0: 20 27 6c 6f 67 69 6e 20 23 66 20 28 6c 69 73 74 'login #f (list
27d0: 20 2a 74 6f 70 70 61 74 68 2a 20 6d 65 67 61 74 *toppath* megat
27e0: 65 73 74 2d 76 65 72 73 69 6f 6e 20 28 63 6c 69 est-version (cli
27f0: 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61 74 75 72 ent:get-signatur
2800: 65 29 29 29 29 0a 0a 0a 3b 3b 20 67 69 76 65 6e e))))...;; given
2810: 20 61 20 68 6f 73 74 6e 61 6d 65 2c 20 72 65 74 a hostname, ret
2820: 75 72 6e 20 61 20 70 61 69 72 20 6f 66 20 63 70 urn a pair of cp
2830: 75 20 6c 6f 61 64 20 61 6e 64 20 75 70 64 61 74 u load and updat
2840: 65 20 74 69 6d 65 20 72 65 70 72 65 73 65 6e 74 e time represent
2850: 69 6e 67 20 6c 61 74 65 73 74 20 69 6e 74 65 6c ing latest intel
2860: 6c 69 67 65 6e 63 65 20 66 72 6f 6d 20 74 65 73 ligence from tes
2870: 74 73 20 72 75 6e 6e 69 6e 67 20 6f 6e 20 74 68 ts running on th
2880: 61 74 20 68 6f 73 74 0a 28 64 65 66 69 6e 65 20 at host.(define
2890: 28 72 6d 74 3a 67 65 74 2d 6c 61 74 65 73 74 2d (rmt:get-latest-
28a0: 68 6f 73 74 2d 6c 6f 61 64 20 68 6f 73 74 6e 61 host-load hostna
28b0: 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d me). (rmt:send-
28c0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 6c 61 74 receive 'get-lat
28d0: 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 20 23 66 est-host-load #f
28e0: 20 28 6c 69 73 74 20 68 6f 73 74 6e 61 6d 65 29 (list hostname)
28f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
2900: 3a 73 64 62 2d 71 72 79 20 71 72 79 20 76 61 6c :sdb-qry qry val
2910: 20 72 75 6e 2d 69 64 29 0a 20 20 3b 3b 20 61 64 run-id). ;; ad
2920: 64 20 63 61 63 68 69 6e 67 20 69 66 20 71 72 79 d caching if qry
2930: 20 69 73 20 27 67 65 74 69 64 20 6f 72 20 27 67 is 'getid or 'g
2940: 65 74 73 74 72 0a 20 20 28 72 6d 74 3a 73 65 6e etstr. (rmt:sen
2950: 64 2d 72 65 63 65 69 76 65 20 27 73 64 62 2d 71 d-receive 'sdb-q
2960: 72 79 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 ry run-id (list
2970: 71 72 79 20 76 61 6c 29 29 29 0a 0a 3b 3b 20 4e qry val)))..;; N
2980: 4f 54 20 43 4f 4d 50 4c 45 54 45 44 0a 28 64 65 OT COMPLETED.(de
2990: 66 69 6e 65 20 28 72 6d 74 3a 72 75 6e 74 65 73 fine (rmt:runtes
29a0: 74 73 20 75 73 65 72 20 72 75 6e 2d 69 64 20 74 ts user run-id t
29b0: 65 73 74 70 61 74 74 20 70 61 72 61 6d 73 29 0a estpatt params).
29c0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
29d0: 69 76 65 20 27 72 75 6e 74 65 73 74 73 20 72 75 ive 'runtests ru
29e0: 6e 2d 69 64 20 74 65 73 74 70 61 74 74 29 29 0a n-id testpatt)).
29f0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
2a00: 74 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 t-run-record-ids
2a10: 20 20 74 61 72 67 65 74 20 72 75 6e 20 6b 65 79 target run key
2a20: 6e 61 6d 65 73 20 29 0a 20 20 28 72 6d 74 3a 73 names ). (rmt:s
2a30: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
2a40: 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 20 -run-record-ids
2a50: 23 66 20 28 6c 69 73 74 20 74 61 72 67 65 74 20 #f (list target
2a60: 72 75 6e 20 6b 65 79 6e 61 6d 65 73 20 29 29 29 run keynames )))
2a70: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
2a80: 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 et-changed-recor
2a90: 64 2d 69 64 73 20 73 69 6e 63 65 2d 74 69 6d 65 d-ids since-time
2aa0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
2ab0: 63 65 69 76 65 20 27 67 65 74 2d 63 68 61 6e 67 ceive 'get-chang
2ac0: 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 20 23 66 ed-record-ids #f
2ad0: 20 28 6c 69 73 74 20 73 69 6e 63 65 2d 74 69 6d (list since-tim
2ae0: 65 29 29 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 e)) )..(define (
2af0: 72 6d 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 69 rmt:get-all-runi
2b00: 64 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ds). (rmt:send-
2b10: 72 65 63 65 69 76 65 20 27 67 65 74 2d 61 6c 6c receive 'get-all
2b20: 2d 72 75 6e 2d 69 64 73 20 23 66 20 27 28 29 29 -run-ids #f '())
2b30: 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 )..(define (rmt
2b40: 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 :get-changed-rec
2b50: 6f 72 64 2d 72 75 6e 2d 69 64 73 20 73 69 6e 63 ord-run-ids sinc
2b60: 65 2d 74 69 6d 65 29 0a 20 20 28 72 6d 74 3a 73 e-time). (rmt:s
2b70: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
2b80: 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d -changed-record-
2b90: 72 75 6e 2d 69 64 73 20 23 66 20 28 6c 69 73 74 run-ids #f (list
2ba0: 20 73 69 6e 63 65 2d 74 69 6d 65 29 29 29 0a 0a since-time)))..
2bb0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
2bc0: 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d -changed-record-
2bd0: 74 65 73 74 2d 69 64 73 20 72 75 6e 2d 69 64 20 test-ids run-id
2be0: 73 69 6e 63 65 2d 74 69 6d 65 29 0a 20 20 28 72 since-time). (r
2bf0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
2c00: 27 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 'get-changed-rec
2c10: 6f 72 64 2d 74 65 73 74 2d 69 64 73 20 72 75 6e ord-test-ids run
2c20: 2d 69 64 20 28 6c 69 73 74 20 73 69 6e 63 65 2d -id (list since-
2c30: 74 69 6d 65 20 72 75 6e 2d 69 64 29 29 29 0a 0a time run-id)))..
2c40: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 ..(define (rmt:d
2c50: 72 6f 70 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 rop-all-triggers
2c60: 29 0a 20 20 20 20 20 28 72 6d 74 3a 73 65 6e 64 ). (rmt:send
2c70: 2d 72 65 63 65 69 76 65 20 27 64 72 6f 70 2d 61 -receive 'drop-a
2c80: 6c 6c 2d 74 72 69 67 67 65 72 73 20 23 66 20 27 ll-triggers #f '
2c90: 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 ()))..(define (r
2ca0: 6d 74 3a 63 72 65 61 74 65 2d 61 6c 6c 2d 74 72 mt:create-all-tr
2cb0: 69 67 67 65 72 73 29 0a 20 20 20 20 20 28 72 6d iggers). (rm
2cc0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
2cd0: 63 72 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67 67 create-all-trigg
2ce0: 65 72 73 20 23 66 20 27 28 29 29 29 0a 0a 3b 3b ers #f '()))..;;
2cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d30: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 54 20 45 20 53 ======.;; T E S
2d40: 20 54 20 20 20 4d 20 45 20 54 20 41 20 0a 3b 3b T M E T A .;;
2d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d90: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
2da0: 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 74 (rmt:get-tests-t
2db0: 61 67 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ags). (rmt:send
2dc0: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 -receive 'get-te
2dd0: 73 74 73 2d 74 61 67 73 20 23 66 20 27 28 29 29 sts-tags #f '())
2de0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
2df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
2e30: 4b 20 45 20 59 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d K E Y S .;;=====
2e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e80: 3d 0a 0a 3b 3b 20 54 68 65 73 65 20 72 65 71 75 =..;; These requ
2e90: 69 72 65 20 72 75 6e 2d 69 64 20 62 65 63 61 75 ire run-id becau
2ea0: 73 65 20 74 68 65 20 76 61 6c 75 65 73 20 63 6f se the values co
2eb0: 6d 65 20 66 72 6f 6d 20 74 68 65 20 72 75 6e 21 me from the run!
2ec0: 0a 3b 3b 20 68 6f 77 65 76 65 72 20 74 68 65 20 .;; however the
2ed0: 71 75 65 72 79 20 6d 75 73 74 20 73 74 69 6c 6c query must still
2ee0: 20 61 70 70 6c 79 20 74 6f 20 6d 61 69 6e 2e 64 apply to main.d
2ef0: 62 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d b.;;.(define (rm
2f00: 74 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 t:get-key-val-pa
2f10: 69 72 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 irs run-id). (r
2f20: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
2f30: 27 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 'get-key-val-pai
2f40: 72 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d rs #f (list run-
2f50: 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 id)))..(define (
2f60: 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 0a 20 20 rmt:get-keys).
2f70: 28 69 66 20 2a 64 62 2d 6b 65 79 73 2a 20 2a 64 (if *db-keys* *d
2f80: 62 2d 6b 65 79 73 2a 20 0a 20 20 20 20 20 28 6c b-keys* . (l
2f90: 65 74 20 28 28 72 65 73 20 28 72 6d 74 3a 73 65 et ((res (rmt:se
2fa0: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
2fb0: 6b 65 79 73 20 23 66 20 27 28 29 29 29 29 0a 20 keys #f '()))).
2fc0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 62 2d (set! *db-
2fd0: 6b 65 79 73 2a 20 72 65 73 29 0a 20 20 20 20 20 keys* res).
2fe0: 20 20 72 65 73 29 29 29 0a 0a 28 64 65 66 69 6e res)))..(defin
2ff0: 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 2d e (rmt:get-keys-
3000: 77 72 69 74 65 29 20 3b 3b 20 64 75 6d 6d 79 20 write) ;; dummy
3010: 71 75 65 72 79 20 74 6f 20 66 6f 72 63 65 20 73 query to force s
3020: 65 72 76 65 72 20 73 74 61 72 74 0a 20 20 28 6c erver start. (l
3030: 65 74 20 28 28 72 65 73 20 28 72 6d 74 3a 73 65 et ((res (rmt:se
3040: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
3050: 6b 65 79 73 2d 77 72 69 74 65 20 23 66 20 27 28 keys-write #f '(
3060: 29 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 2a )))). (set! *
3070: 64 62 2d 6b 65 79 73 2a 20 72 65 73 29 0a 20 20 db-keys* res).
3080: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 77 65 20 64 res))..;; we d
3090: 6f 6e 27 74 20 72 65 75 73 65 20 72 75 6e 2d 69 on't reuse run-i
30a0: 64 27 73 20 28 65 78 63 65 70 74 20 70 6f 73 73 d's (except poss
30b0: 69 62 6c 79 20 2a 61 66 74 65 72 2a 20 61 20 64 ibly *after* a d
30c0: 62 20 63 6c 65 61 6e 75 70 29 20 73 6f 20 69 74 b cleanup) so it
30d0: 20 69 73 20 73 61 66 65 0a 3b 3b 20 74 6f 20 63 is safe.;; to c
30e0: 61 63 68 65 20 74 68 65 20 72 65 73 75 6c 73 20 ache the resuls
30f0: 69 6e 20 61 20 68 61 73 68 0a 3b 3b 0a 28 64 65 in a hash.;;.(de
3100: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 fine (rmt:get-ke
3110: 79 2d 76 61 6c 73 20 72 75 6e 2d 69 64 29 0a 20 y-vals run-id).
3120: 20 28 6f 72 20 28 68 61 73 68 2d 74 61 62 6c 65 (or (hash-table
3130: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 6b 65 -ref/default *ke
3140: 79 76 61 6c 73 2a 20 72 75 6e 2d 69 64 20 23 66 yvals* run-id #f
3150: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 ). (let ((r
3160: 65 73 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 es (rmt:send-rec
3170: 65 69 76 65 20 27 67 65 74 2d 6b 65 79 2d 76 61 eive 'get-key-va
3180: 6c 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d ls #f (list run-
3190: 69 64 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 id)))). (
31a0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
31b0: 2a 6b 65 79 76 61 6c 73 2a 20 72 75 6e 2d 69 64 *keyvals* run-id
31c0: 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 72 65 res). re
31d0: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 s)))..(define (r
31e0: 6d 74 3a 67 65 74 2d 74 61 72 67 65 74 73 29 0a mt:get-targets).
31f0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
3200: 69 76 65 20 27 67 65 74 2d 74 61 72 67 65 74 73 ive 'get-targets
3210: 20 23 66 20 27 28 29 29 29 0a 0a 28 64 65 66 69 #f '()))..(defi
3220: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 61 72 67 ne (rmt:get-targ
3230: 65 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 et run-id). (as
3240: 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 sert (number? ru
3250: 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 n-id) "FATAL: Ru
3260: 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 n id required.")
3270: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
3280: 65 69 76 65 20 27 67 65 74 2d 74 61 72 67 65 74 eive 'get-target
3290: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 #f (list run-id
32a0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
32b0: 74 3a 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 20 t:get-run-times
32c0: 72 75 6e 70 61 74 74 20 74 61 72 67 65 74 70 61 runpatt targetpa
32d0: 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d tt). (rmt:send-
32e0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e receive 'get-run
32f0: 2d 74 69 6d 65 73 20 23 66 20 28 6c 69 73 74 20 -times #f (list
3300: 72 75 6e 70 61 74 74 20 74 61 72 67 65 74 70 61 runpatt targetpa
3310: 74 74 20 29 29 29 20 0a 0a 0a 3b 3b 3d 3d 3d 3d tt ))) ...;;====
3320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3360: 3d 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 53 ==.;; T E S T S
3370: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 49 44 =========..;; ID
33c0: 45 41 3a 20 54 68 72 65 61 64 69 66 79 20 74 68 EA: Threadify th
33d0: 65 73 65 20 2d 20 74 68 65 79 20 73 70 65 6e 64 ese - they spend
33e0: 20 61 20 6c 6f 74 20 6f 66 20 74 69 6d 65 20 77 a lot of time w
33f0: 61 69 74 69 6e 67 20 2e 2e 2e 0a 3b 3b 0a 28 64 aiting ....;;.(d
3400: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 efine (rmt:get-t
3410: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 ests-for-runs-mi
3420: 6e 64 61 74 61 20 72 75 6e 2d 69 64 73 20 74 65 ndata run-ids te
3430: 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 stpatt states st
3440: 61 74 75 73 20 6e 6f 74 2d 69 6e 29 0a 20 20 28 atus not-in). (
3450: 6c 65 74 20 28 28 6d 75 6c 74 69 2d 72 75 6e 2d let ((multi-run-
3460: 6d 75 74 65 78 20 28 6d 61 6b 65 2d 6d 75 74 65 mutex (make-mute
3470: 78 29 29 0a 09 28 72 75 6e 2d 69 64 2d 6c 69 73 x))..(run-id-lis
3480: 74 20 28 69 66 20 72 75 6e 2d 69 64 73 0a 09 09 t (if run-ids...
3490: 09 20 72 75 6e 2d 69 64 73 0a 09 09 09 20 28 72 . run-ids.... (r
34a0: 6d 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 mt:get-all-run-i
34b0: 64 73 29 29 29 0a 09 28 72 65 73 75 6c 74 20 20 ds)))..(result
34c0: 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 28 69 '())). (i
34d0: 66 20 28 6e 75 6c 6c 3f 20 72 75 6e 2d 69 64 2d f (null? run-id-
34e0: 6c 69 73 74 29 0a 09 27 28 29 0a 09 28 6c 65 74 list)..'()..(let
34f0: 20 6c 6f 6f 70 20 28 28 68 65 64 20 20 20 20 20 loop ((hed
3500: 28 63 61 72 20 72 75 6e 2d 69 64 2d 6c 69 73 74 (car run-id-list
3510: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 20 20 ))... (tal
3520: 20 28 63 64 72 20 72 75 6e 2d 69 64 2d 6c 69 73 (cdr run-id-lis
3530: 74 29 29 0a 09 09 20 20 20 28 74 68 72 65 61 64 t))... (thread
3540: 73 20 27 28 29 29 29 0a 09 20 20 28 69 66 20 28 s '())).. (if (
3550: 3e 20 28 6c 65 6e 67 74 68 20 74 68 72 65 61 64 > (length thread
3560: 73 29 20 35 29 0a 09 20 20 20 20 20 20 28 6c 6f s) 5).. (lo
3570: 6f 70 20 68 65 64 20 74 61 6c 20 28 66 69 6c 74 op hed tal (filt
3580: 65 72 20 28 6c 61 6d 62 64 61 20 28 74 68 29 28 er (lambda (th)(
3590: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 28 74 68 72 not (member (thr
35a0: 65 61 64 2d 73 74 61 74 65 20 74 68 29 20 27 28 ead-state th) '(
35b0: 74 65 72 6d 69 6e 61 74 65 64 20 64 65 61 64 29 terminated dead)
35c0: 29 29 29 20 74 68 72 65 61 64 73 29 29 0a 09 20 ))) threads))..
35d0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 65 77 (let* ((new
35e0: 74 68 72 65 61 64 20 28 6d 61 6b 65 2d 74 68 72 thread (make-thr
35f0: 65 61 64 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 ead..... (lambda
3600: 20 28 29 0a 09 09 09 09 20 20 20 28 6c 65 74 20 ()..... (let
3610: 28 28 72 65 73 20 28 72 6d 74 3a 73 65 6e 64 2d ((res (rmt:send-
3620: 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 receive 'get-tes
3630: 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 ts-for-run-minda
3640: 74 61 20 68 65 64 20 28 6c 69 73 74 20 68 65 64 ta hed (list hed
3650: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 testpatt states
3660: 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 29 status not-in))
3670: 29 29 0a 09 09 09 09 20 20 20 20 20 28 69 66 20 ))..... (if
3680: 28 6c 69 73 74 3f 20 72 65 73 29 0a 09 09 09 09 (list? res).....
3690: 09 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 . (begin......
36a0: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 75 (mutex-lock! mu
36b0: 6c 74 69 2d 72 75 6e 2d 6d 75 74 65 78 29 0a 09 lti-run-mutex)..
36c0: 09 09 09 09 20 20 20 28 73 65 74 21 20 72 65 73 .... (set! res
36d0: 75 6c 74 20 28 61 70 70 65 6e 64 20 72 65 73 75 ult (append resu
36e0: 6c 74 20 72 65 73 29 29 0a 09 09 09 09 09 20 20 lt res))......
36f0: 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
3700: 6d 75 6c 74 69 2d 72 75 6e 2d 6d 75 74 65 78 29 multi-run-mutex)
3710: 29 0a 09 09 09 09 09 20 28 64 65 62 75 67 3a 70 )...... (debug:p
3720: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
3730: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3740: 22 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 "get-tests-for-r
3750: 75 6e 2d 6d 69 6e 64 61 74 61 20 66 61 69 6c 65 un-mindata faile
3760: 64 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 68 d for run-id " h
3770: 65 64 20 22 2c 20 74 65 73 74 70 61 74 74 20 22 ed ", testpatt "
3780: 20 74 65 73 74 70 61 74 74 20 22 2c 20 73 74 61 testpatt ", sta
3790: 74 65 73 20 22 20 73 74 61 74 65 73 20 22 2c 20 tes " states ",
37a0: 73 74 61 74 75 73 20 22 20 73 74 61 74 75 73 20 status " status
37b0: 22 2c 20 6e 6f 74 2d 69 6e 20 22 20 6e 6f 74 2d ", not-in " not-
37c0: 69 6e 29 29 29 29 0a 09 09 09 09 20 28 63 6f 6e in))))..... (con
37d0: 63 20 22 6d 75 6c 74 69 2d 72 75 6e 2d 74 68 72 c "multi-run-thr
37e0: 65 61 64 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 ead for run-id "
37f0: 20 68 65 64 29 29 29 0a 09 09 20 20 20 20 20 28 hed)))... (
3800: 6e 65 77 74 68 72 65 61 64 73 20 28 63 6f 6e 73 newthreads (cons
3810: 20 6e 65 77 74 68 72 65 61 64 20 74 68 72 65 61 newthread threa
3820: 64 73 29 29 29 0a 09 09 28 74 68 72 65 61 64 2d ds)))...(thread-
3830: 73 74 61 72 74 21 20 6e 65 77 74 68 72 65 61 64 start! newthread
3840: 29 0a 09 09 28 74 68 72 65 61 64 2d 73 6c 65 65 )...(thread-slee
3850: 70 21 20 30 2e 30 35 29 20 3b 3b 20 67 69 76 65 p! 0.05) ;; give
3860: 20 74 68 61 74 20 74 68 72 65 61 64 20 73 6f 6d that thread som
3870: 65 20 74 69 6d 65 20 74 6f 20 73 74 61 72 74 0a e time to start.
3880: 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c ..(if (null? tal
3890: 29 0a 09 09 20 20 20 20 6e 65 77 74 68 72 65 61 )... newthrea
38a0: 64 73 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 ds... (loop (
38b0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
38c0: 29 20 6e 65 77 74 68 72 65 61 64 73 29 29 29 29 ) newthreads))))
38d0: 29 29 0a 20 20 20 20 72 65 73 75 6c 74 29 29 0a )). result)).
38e0: 0a 3b 3b 20 3b 3b 20 49 44 45 41 3a 20 54 68 72 .;; ;; IDEA: Thr
38f0: 65 61 64 69 66 79 20 74 68 65 73 65 20 2d 20 74 eadify these - t
3900: 68 65 79 20 73 70 65 6e 64 20 61 20 6c 6f 74 20 hey spend a lot
3910: 6f 66 20 74 69 6d 65 20 77 61 69 74 69 6e 67 20 of time waiting
3920: 2e 2e 2e 0a 3b 3b 20 3b 3b 0a 3b 3b 20 28 64 65 ....;; ;;.;; (de
3930: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 fine (rmt:get-te
3940: 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e sts-for-runs-min
3950: 64 61 74 61 20 72 75 6e 2d 69 64 73 20 74 65 73 data run-ids tes
3960: 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 tpatt states sta
3970: 74 75 73 20 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 tus not-in).;;
3980: 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 2d 6c (let ((run-id-l
3990: 69 73 74 20 28 69 66 20 72 75 6e 2d 69 64 73 0a ist (if run-ids.
39a0: 3b 3b 20 09 09 09 20 72 75 6e 2d 69 64 73 0a 3b ;; ... run-ids.;
39b0: 3b 20 09 09 09 20 28 72 6d 74 3a 67 65 74 2d 61 ; ... (rmt:get-a
39c0: 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 29 0a 3b ll-run-ids)))).;
39d0: 3b 20 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 ; (apply app
39e0: 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 end (map (lambda
39f0: 20 28 72 75 6e 2d 69 64 29 0a 3b 3b 20 09 09 09 (run-id).;; ...
3a00: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
3a10: 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 66 6f ve 'get-tests-fo
3a20: 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 72 75 r-run-mindata ru
3a30: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
3a40: 64 73 20 74 65 73 74 70 61 74 74 20 73 74 61 74 ds testpatt stat
3a50: 65 73 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e es status not-in
3a60: 29 29 29 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 ))).;; ..
3a70: 72 75 6e 2d 69 64 2d 6c 69 73 74 29 29 29 29 0a run-id-list)))).
3a80: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 .(define (rmt:de
3a90: 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 lete-test-record
3aa0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
3ab0: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
3ac0: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
3ad0: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
3ae0: 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 ired."). (rmt:s
3af0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 6c end-receive 'del
3b00: 65 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 ete-test-records
3b10: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
3b20: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 0a n-id test-id))).
3b30: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 .(define (rmt:te
3b40: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
3b50: 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d tus run-id test-
3b60: 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73 20 id state status
3b70: 6d 73 67 29 0a 20 20 28 61 73 73 65 72 74 20 28 msg). (assert (
3b80: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
3b90: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
3ba0: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
3bb0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
3bc0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
3bd0: 74 61 74 75 73 20 72 75 6e 2d 69 64 20 28 6c 69 tatus run-id (li
3be0: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
3bf0: 64 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6d d state status m
3c00: 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 sg)))..(define (
3c10: 72 6d 74 3a 74 65 73 74 2d 74 6f 70 6c 65 76 65 rmt:test-topleve
3c20: 6c 2d 6e 75 6d 2d 69 74 65 6d 73 20 72 75 6e 2d l-num-items run-
3c30: 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 id test-name).
3c40: 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f (assert (number?
3c50: 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a run-id) "FATAL:
3c60: 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 Run id required
3c70: 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ."). (rmt:send-
3c80: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 74 6f receive 'test-to
3c90: 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 plevel-num-items
3ca0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
3cb0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 n-id test-name))
3cc0: 29 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 72 )..;; (define (r
3cd0: 6d 74 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d mt:get-previous-
3ce0: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 test-run-record
3cf0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
3d00: 20 69 74 65 6d 2d 70 61 74 68 29 0a 3b 3b 20 20 item-path).;;
3d10: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
3d20: 76 65 20 27 67 65 74 2d 70 72 65 76 69 6f 75 73 ve 'get-previous
3d30: 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 -test-run-record
3d40: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
3d50: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
3d60: 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 tem-path)))..(de
3d70: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6d 61 fine (rmt:get-ma
3d80: 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d tching-previous-
3d90: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 test-run-records
3da0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
3db0: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
3dc0: 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 assert (number?
3dd0: 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 run-id) "FATAL:
3de0: 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e Run id required.
3df0: 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 "). (rmt:send-r
3e00: 65 63 65 69 76 65 20 27 67 65 74 2d 6d 61 74 63 eceive 'get-matc
3e10: 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 hing-previous-te
3e20: 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 72 st-run-records r
3e30: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
3e40: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
3e50: 6d 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 m-path)))..(defi
3e60: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 ne (rmt:test-get
3e70: 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 72 75 -logfile-info ru
3e80: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a n-id test-name).
3e90: 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 (assert (numbe
3ea0: 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 r? run-id) "FATA
3eb0: 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 L: Run id requir
3ec0: 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e ed."). (rmt:sen
3ed0: 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 2d d-receive 'test-
3ee0: 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f get-logfile-info
3ef0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
3f00: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 n-id test-name))
3f10: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
3f20: 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 test-get-records
3f30: 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 -for-index-file
3f40: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
3f50: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
3f60: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
3f70: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
3f80: 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 ired."). (rmt:s
3f90: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 end-receive 'tes
3fa0: 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f t-get-records-fo
3fb0: 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 72 75 6e r-index-file run
3fc0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
3fd0: 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 0a 28 test-name)))..(
3fe0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
3ff0: 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 testinfo-state-s
4000: 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 tatus run-id tes
4010: 74 2d 69 64 29 0a 20 20 28 61 73 73 65 72 74 20 t-id). (assert
4020: 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 (number? run-id)
4030: 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 "FATAL: Run id
4040: 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 required."). (r
4050: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
4060: 27 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 'get-testinfo-st
4070: 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 ate-status run-i
4080: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
4090: 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 est-id)))..(defi
40a0: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 ne (rmt:test-set
40b0: 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 -log! run-id tes
40c0: 74 2d 69 64 20 6c 6f 67 66 29 0a 20 20 28 61 73 t-id logf). (as
40d0: 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 sert (number? ru
40e0: 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 n-id) "FATAL: Ru
40f0: 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 n id required.")
4100: 0a 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 . (if (string?
4110: 6c 6f 67 66 29 28 72 6d 74 3a 67 65 6e 65 72 61 logf)(rmt:genera
4120: 6c 2d 63 61 6c 6c 20 27 74 65 73 74 2d 73 65 74 l-call 'test-set
4130: 2d 6c 6f 67 20 72 75 6e 2d 69 64 20 6c 6f 67 66 -log run-id logf
4140: 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 test-id)))..(de
4150: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 fine (rmt:test-s
4160: 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 et-top-process-p
4170: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 id run-id test-i
4180: 64 20 70 69 64 29 0a 20 20 28 61 73 73 65 72 74 d pid). (assert
4190: 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 (number? run-id
41a0: 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 ) "FATAL: Run id
41b0: 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 required."). (
41c0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
41d0: 20 27 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 'test-set-top-p
41e0: 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 rocess-pid run-i
41f0: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
4200: 65 73 74 2d 69 64 20 70 69 64 29 29 29 0a 0a 28 est-id pid)))..(
4210: 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 define (rmt:test
4220: 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -get-top-process
4230: 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 -pid run-id test
4240: 2d 69 64 29 0a 20 20 28 61 73 73 65 72 74 20 28 -id). (assert (
4250: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
4260: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
4270: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
4280: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
4290: 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f test-get-top-pro
42a0: 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 cess-pid run-id
42b0: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 (list run-id tes
42c0: 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 t-id)))..(define
42d0: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 64 (rmt:get-run-id
42e0: 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 s-matching-targe
42f0: 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 t keynames targe
4300: 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 74 65 t res runname te
4310: 73 74 70 61 74 74 20 73 74 61 74 65 70 61 74 74 stpatt statepatt
4320: 20 73 74 61 74 75 73 70 61 74 74 29 0a 20 20 28 statuspatt). (
4330: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
4340: 20 27 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 'get-run-ids-ma
4350: 74 63 68 69 6e 67 2d 74 61 72 67 65 74 20 23 66 tching-target #f
4360: 20 28 6c 69 73 74 20 6b 65 79 6e 61 6d 65 73 20 (list keynames
4370: 74 61 72 67 65 74 20 72 65 73 20 72 75 6e 6e 61 target res runna
4380: 6d 65 20 74 65 73 74 70 61 74 74 20 73 74 61 74 me testpatt stat
4390: 65 70 61 74 74 20 73 74 61 74 75 73 70 61 74 74 epatt statuspatt
43a0: 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 )))..;; NOTE: Th
43b0: 69 73 20 77 69 6c 6c 20 6f 70 65 6e 20 61 6e 64 is will open and
43c0: 20 61 63 63 65 73 73 20 41 4c 4c 20 72 75 6e 20 access ALL run
43d0: 64 61 74 61 62 61 73 65 73 2e 20 0a 3b 3b 0a 28 databases. .;;.(
43e0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 define (rmt:test
43f0: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
4400: 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 ing-keynames-tar
4410: 67 65 74 2d 6e 65 77 20 6b 65 79 6e 61 6d 65 73 get-new keynames
4420: 20 74 61 72 67 65 74 20 72 65 73 20 74 65 73 74 target res test
4430: 70 61 74 74 20 73 74 61 74 65 70 61 74 74 20 73 patt statepatt s
4440: 74 61 74 75 73 70 61 74 74 20 72 75 6e 6e 61 6d tatuspatt runnam
4450: 65 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 2d e). (let ((run-
4460: 69 64 73 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ids (rmt:get-run
4470: 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 -ids-matching-ta
4480: 72 67 65 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 rget keynames ta
4490: 72 67 65 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 rget res runname
44a0: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 70 testpatt statep
44b0: 61 74 74 20 73 74 61 74 75 73 70 61 74 74 29 29 att statuspatt))
44c0: 29 0a 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 ). (apply app
44d0: 65 6e 64 20 0a 09 20 20 20 28 6d 61 70 20 28 6c end .. (map (l
44e0: 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 ambda (run-id)..
44f0: 09 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
4500: 65 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d 70 eive 'test-get-p
4510: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 aths-matching-ke
4520: 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 ynames-target-ne
4530: 77 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 w run-id (list r
4540: 75 6e 2d 69 64 20 6b 65 79 6e 61 6d 65 73 20 74 un-id keynames t
4550: 61 72 67 65 74 20 72 65 73 20 74 65 73 74 70 61 arget res testpa
4560: 74 74 20 73 74 61 74 65 70 61 74 74 20 73 74 61 tt statepatt sta
4570: 74 75 73 70 61 74 74 20 72 75 6e 6e 61 6d 65 29 tuspatt runname)
4580: 29 29 0a 09 20 20 20 72 75 6e 2d 69 64 73 29 29 )).. run-ids))
4590: 29 29 0a 0a 0a 0a 28 64 65 66 69 6e 65 20 28 72 ))....(define (r
45a0: 6d 74 3a 67 65 74 2d 70 72 65 72 65 71 73 2d 6e mt:get-prereqs-n
45b0: 6f 74 2d 6d 65 74 20 72 75 6e 2d 69 64 20 77 61 ot-met run-id wa
45c0: 69 74 6f 6e 73 20 72 65 66 2d 74 65 73 74 2d 6e itons ref-test-n
45d0: 61 6d 65 20 72 65 66 2d 69 74 65 6d 2d 70 61 74 ame ref-item-pat
45e0: 68 20 23 21 6b 65 79 20 28 6d 6f 64 65 20 27 28 h #!key (mode '(
45f0: 6e 6f 72 6d 61 6c 29 29 28 69 74 65 6d 6d 61 70 normal))(itemmap
4600: 73 20 23 66 29 29 0a 20 20 28 61 73 73 65 72 74 s #f)). (assert
4610: 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 (number? run-id
4620: 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 ) "FATAL: Run id
4630: 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 required."). (
4640: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
4650: 20 27 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f 'get-prereqs-no
4660: 74 2d 6d 65 74 20 72 75 6e 2d 69 64 20 28 6c 69 t-met run-id (li
4670: 73 74 20 72 75 6e 2d 69 64 20 77 61 69 74 6f 6e st run-id waiton
4680: 73 20 72 65 66 2d 74 65 73 74 2d 6e 61 6d 65 20 s ref-test-name
4690: 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 6d 6f ref-item-path mo
46a0: 64 65 20 69 74 65 6d 6d 61 70 73 29 29 29 0a 0a de itemmaps)))..
46b0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
46c0: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
46d0: 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 ning-for-run-id
46e0: 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 65 72 run-id). (asser
46f0: 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 t (number? run-i
4700: 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 d) "FATAL: Run i
4710: 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 d required.").
4720: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
4730: 65 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 e 'get-count-tes
4740: 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 ts-running-for-r
4750: 75 6e 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 un-id run-id (li
4760: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
4770: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6e efine (rmt:get-n
4780: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 ot-completed-cnt
4790: 20 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 65 run-id). (asse
47a0: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
47b0: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
47c0: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
47d0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
47e0: 76 65 20 27 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 ve 'get-not-comp
47f0: 6c 65 74 65 64 2d 63 6e 74 20 72 75 6e 2d 69 64 leted-cnt run-id
4800: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
4810: 0a 0a 0a 3b 3b 20 53 74 61 74 69 73 74 69 63 61 ...;; Statistica
4820: 6c 20 71 75 65 72 69 65 73 0a 0a 28 64 65 66 69 l queries..(defi
4830: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e ne (rmt:get-coun
4840: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 20 t-tests-running
4850: 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 65 72 run-id). (asser
4860: 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 t (number? run-i
4870: 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 d) "FATAL: Run i
4880: 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 d required.").
4890: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
48a0: 65 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 e 'get-count-tes
48b0: 74 73 2d 72 75 6e 6e 69 6e 67 20 72 75 6e 2d 69 ts-running run-i
48c0: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 d (list run-id))
48d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
48e0: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
48f0: 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 74 65 73 74 running-for-test
4900: 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 74 name run-id test
4910: 6e 61 6d 65 29 0a 20 20 28 61 73 73 65 72 74 20 name). (assert
4920: 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 (number? run-id)
4930: 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 "FATAL: Run id
4940: 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 required."). (r
4950: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
4960: 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 'get-count-tests
4970: 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 74 65 73 -running-for-tes
4980: 74 6e 61 6d 65 20 72 75 6e 2d 69 64 20 28 6c 69 tname run-id (li
4990: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 st run-id testna
49a0: 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 me)))..(define (
49b0: 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 rmt:get-count-te
49c0: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a sts-running-in-j
49d0: 6f 62 67 72 6f 75 70 20 72 75 6e 2d 69 64 20 6a obgroup run-id j
49e0: 6f 62 67 72 6f 75 70 29 0a 20 20 28 61 73 73 65 obgroup). (asse
49f0: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
4a00: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
4a10: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
4a20: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
4a30: 76 65 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 ve 'get-count-te
4a40: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a sts-running-in-j
4a50: 6f 62 67 72 6f 75 70 20 72 75 6e 2d 69 64 20 28 obgroup run-id (
4a60: 6c 69 73 74 20 72 75 6e 2d 69 64 20 6a 6f 62 67 list run-id jobg
4a70: 72 6f 75 70 29 29 29 0a 0a 28 64 65 66 69 6e 65 roup)))..(define
4a80: 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 65 2d (rmt:set-state-
4a90: 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d status-and-roll-
4aa0: 75 70 2d 72 75 6e 20 72 75 6e 2d 69 64 20 73 74 up-run run-id st
4ab0: 61 74 65 20 73 74 61 74 75 73 29 0a 20 20 28 61 ate status). (a
4ac0: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
4ad0: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
4ae0: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
4af0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
4b00: 63 65 69 76 65 20 27 73 65 74 2d 73 74 61 74 65 ceive 'set-state
4b10: 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c -status-and-roll
4b20: 2d 75 70 2d 72 75 6e 20 72 75 6e 2d 69 64 20 28 -up-run run-id (
4b30: 6c 69 73 74 20 72 75 6e 2d 69 64 20 73 74 61 74 list run-id stat
4b40: 65 20 73 74 61 74 75 73 29 29 29 0a 0a 0a 28 64 e status)))...(d
4b50: 65 66 69 6e 65 20 28 72 6d 74 3a 75 70 64 61 74 efine (rmt:updat
4b60: 65 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e e-pass-fail-coun
4b70: 74 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e ts run-id test-n
4b80: 61 6d 65 29 0a 20 20 28 61 73 73 65 72 74 20 28 ame). (assert (
4b90: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
4ba0: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
4bb0: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
4bc0: 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 t:general-call '
4bd0: 75 70 64 61 74 65 2d 70 61 73 73 2d 66 61 69 6c update-pass-fail
4be0: 2d 63 6f 75 6e 74 73 20 72 75 6e 2d 69 64 20 74 -counts run-id t
4bf0: 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 est-name test-na
4c00: 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 29 0a 0a me test-name))..
4c10: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 6f 70 (define (rmt:top
4c20: 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 66 -test-set-per-pf
4c30: 2d 63 6f 75 6e 74 73 20 72 75 6e 2d 69 64 20 74 -counts run-id t
4c40: 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 61 73 73 est-name). (ass
4c50: 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e ert (number? run
4c60: 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e -id) "FATAL: Run
4c70: 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a id required.").
4c80: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
4c90: 69 76 65 20 27 74 6f 70 2d 74 65 73 74 2d 73 65 ive 'top-test-se
4ca0: 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 t-per-pf-counts
4cb0: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
4cc0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 -id test-name)))
4cd0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
4ce0: 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 et-raw-run-stats
4cf0: 20 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 65 run-id). (asse
4d00: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
4d10: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
4d20: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
4d30: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
4d40: 76 65 20 27 67 65 74 2d 72 61 77 2d 72 75 6e 2d ve 'get-raw-run-
4d50: 73 74 61 74 73 20 72 75 6e 2d 69 64 20 28 6c 69 stats run-id (li
4d60: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
4d70: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 efine (rmt:get-t
4d80: 65 73 74 2d 74 69 6d 65 73 20 72 75 6e 6e 61 6d est-times runnam
4d90: 65 20 74 61 72 67 65 74 29 0a 20 20 28 72 6d 74 e target). (rmt
4da0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
4db0: 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 20 23 66 et-test-times #f
4dc0: 20 28 6c 69 73 74 20 72 75 6e 6e 61 6d 65 20 74 (list runname t
4dd0: 61 72 67 65 74 20 29 29 29 20 0a 0a 3b 3b 3d 3d arget ))) ..;;==
4de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e20: 3d 3d 3d 3d 0a 3b 3b 20 20 52 20 55 20 4e 20 53 ====.;; R U N S
4e30: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 42 55 =========..;; BU
4e80: 47 20 2d 20 4c 4f 4f 4b 20 41 54 20 48 4f 57 20 G - LOOK AT HOW
4e90: 54 48 49 53 20 57 4f 52 4b 53 21 21 21 0a 3b 3b THIS WORKS!!!.;;
4ea0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
4eb0: 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 t-run-info run-i
4ec0: 64 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 d). (assert (nu
4ed0: 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 mber? run-id) "F
4ee0: 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 ATAL: Run id req
4ef0: 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a uired."). (rmt:
4f00: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
4f10: 74 2d 72 75 6e 2d 69 6e 66 6f 20 23 66 20 28 6c t-run-info #f (l
4f20: 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 ist run-id)))..(
4f30: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
4f40: 6e 75 6d 2d 72 75 6e 73 20 72 75 6e 70 61 74 74 num-runs runpatt
4f50: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
4f60: 63 65 69 76 65 20 27 67 65 74 2d 6e 75 6d 2d 72 ceive 'get-num-r
4f70: 75 6e 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e uns #f (list run
4f80: 70 61 74 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 patt)))..(define
4f90: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 63 (rmt:get-runs-c
4fa0: 6e 74 2d 62 79 2d 70 61 74 74 20 72 75 6e 70 61 nt-by-patt runpa
4fb0: 74 74 20 74 61 72 67 65 74 70 61 74 74 20 6b 65 tt targetpatt ke
4fc0: 79 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ys). (rmt:send-
4fd0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e receive 'get-run
4fe0: 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 23 66 s-cnt-by-patt #f
4ff0: 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 20 20 (list runpatt
5000: 74 61 72 67 65 74 70 61 74 74 20 6b 65 79 73 29 targetpatt keys)
5010: 29 29 0a 0a 3b 3b 20 55 73 65 20 74 68 65 20 73 ))..;; Use the s
5020: 70 65 63 69 61 6c 20 72 75 6e 2d 69 64 20 3d 3d pecial run-id ==
5030: 20 23 66 20 73 63 65 6e 61 72 69 6f 20 68 65 72 #f scenario her
5040: 65 20 73 69 6e 63 65 20 74 68 65 72 65 20 69 73 e since there is
5050: 20 6e 6f 20 72 75 6e 20 79 65 74 0a 28 64 65 66 no run yet.(def
5060: 69 6e 65 20 28 72 6d 74 3a 72 65 67 69 73 74 65 ine (rmt:registe
5070: 72 2d 72 75 6e 20 6b 65 79 76 61 6c 73 20 72 75 r-run keyvals ru
5080: 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 nname state stat
5090: 75 73 20 75 73 65 72 20 63 6f 6e 74 6f 75 72 29 us user contour)
50a0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
50b0: 65 69 76 65 20 27 72 65 67 69 73 74 65 72 2d 72 eive 'register-r
50c0: 75 6e 20 23 66 20 28 6c 69 73 74 20 6b 65 79 76 un #f (list keyv
50d0: 61 6c 73 20 72 75 6e 6e 61 6d 65 20 73 74 61 74 als runname stat
50e0: 65 20 73 74 61 74 75 73 20 75 73 65 72 20 63 6f e status user co
50f0: 6e 74 6f 75 72 29 29 29 0a 20 20 20 20 0a 28 64 ntour))). .(d
5100: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 efine (rmt:get-r
5110: 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 un-name-from-id
5120: 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 65 72 run-id). (asser
5130: 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 t (number? run-i
5140: 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 d) "FATAL: Run i
5150: 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 d required.").
5160: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
5170: 65 20 27 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d e 'get-run-name-
5180: 66 72 6f 6d 2d 69 64 20 23 66 20 28 6c 69 73 74 from-id #f (list
5190: 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 run-id)))..(def
51a0: 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d ine (rmt:delete-
51b0: 72 75 6e 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 run run-id). (r
51c0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
51d0: 27 64 65 6c 65 74 65 2d 72 75 6e 20 23 66 20 28 'delete-run #f (
51e0: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a list run-id)))..
51f0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 75 70 64 (define (rmt:upd
5200: 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 ate-run-stats ru
5210: 6e 2d 69 64 20 73 74 61 74 73 29 0a 20 20 28 72 n-id stats). (r
5220: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
5230: 27 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 'update-run-stat
5240: 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 s #f (list run-i
5250: 64 20 73 74 61 74 73 29 29 29 0a 0a 28 64 65 66 d stats)))..(def
5260: 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d ine (rmt:delete-
5270: 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 old-deleted-test
5280: 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 29 -records run-id)
5290: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
52a0: 65 69 76 65 20 27 64 65 6c 65 74 65 2d 6f 6c 64 eive 'delete-old
52b0: 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 -deleted-test-re
52c0: 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 28 6c 69 cords run-id (li
52d0: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
52e0: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 efine (rmt:get-r
52f0: 75 6e 73 20 72 75 6e 70 61 74 74 20 63 6f 75 6e uns runpatt coun
5300: 74 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74 74 t offset keypatt
5310: 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 s). (rmt:send-r
5320: 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e 73 eceive 'get-runs
5330: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 61 74 #f (list runpat
5340: 74 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 6b t count offset k
5350: 65 79 70 61 74 74 73 29 29 29 0a 0a 28 64 65 66 eypatts)))..(def
5360: 69 6e 65 20 28 72 6d 74 3a 73 69 6d 70 6c 65 2d ine (rmt:simple-
5370: 67 65 74 2d 72 75 6e 73 20 72 75 6e 70 61 74 74 get-runs runpatt
5380: 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 74 61 count offset ta
5390: 72 67 65 74 20 6c 61 73 74 2d 75 70 64 61 74 65 rget last-update
53a0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
53b0: 63 65 69 76 65 20 27 73 69 6d 70 6c 65 2d 67 65 ceive 'simple-ge
53c0: 74 2d 72 75 6e 73 20 23 66 20 28 6c 69 73 74 20 t-runs #f (list
53d0: 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f 66 runpatt count of
53e0: 66 73 65 74 20 74 61 72 67 65 74 20 6c 61 73 74 fset target last
53f0: 2d 75 70 64 61 74 65 29 29 29 0a 0a 28 64 65 66 -update)))..(def
5400: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 61 6c 6c ine (rmt:get-all
5410: 2d 72 75 6e 2d 69 64 73 29 0a 20 20 28 72 6d 74 -run-ids). (rmt
5420: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
5430: 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 23 et-all-run-ids #
5440: 66 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 f '()))..(define
5450: 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 (rmt:get-prev-r
5460: 75 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 0a 20 un-ids run-id).
5470: 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 (assert (number
5480: 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c ? run-id) "FATAL
5490: 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 : Run id require
54a0: 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 d."). (rmt:send
54b0: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 70 72 -receive 'get-pr
54c0: 65 76 2d 72 75 6e 2d 69 64 73 20 23 66 20 28 6c ev-run-ids #f (l
54d0: 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 ist run-id)))..(
54e0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6c 6f 63 6b define (rmt:lock
54f0: 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 72 75 6e 2d /unlock-run run-
5500: 69 64 20 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 id lock unlock u
5510: 73 65 72 29 0a 20 20 28 61 73 73 65 72 74 20 28 ser). (assert (
5520: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
5530: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
5540: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
5550: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
5560: 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 lock/unlock-run
5570: 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 #f (list run-id
5580: 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 72 lock unlock user
5590: 29 29 29 0a 0a 3b 3b 20 73 65 74 2f 67 65 74 20 )))..;; set/get
55a0: 73 74 61 74 75 73 0a 28 64 65 66 69 6e 65 20 28 status.(define (
55b0: 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 rmt:get-run-stat
55c0: 75 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 us run-id). (as
55d0: 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 sert (number? ru
55e0: 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 n-id) "FATAL: Ru
55f0: 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 n id required.")
5600: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
5610: 65 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 73 74 eive 'get-run-st
5620: 61 74 75 73 20 23 66 20 28 6c 69 73 74 20 72 75 atus #f (list ru
5630: 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 n-id)))..(define
5640: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 (rmt:get-run-st
5650: 61 74 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 61 ate run-id). (a
5660: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
5670: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
5680: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
5690: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
56a0: 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 73 ceive 'get-run-s
56b0: 74 61 74 65 20 23 66 20 28 6c 69 73 74 20 72 75 tate #f (list ru
56c0: 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 n-id)))..(define
56d0: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 (rmt:get-run-st
56e0: 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 ate-status run-i
56f0: 64 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 d). (assert (nu
5700: 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 mber? run-id) "F
5710: 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 ATAL: Run id req
5720: 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a uired."). (rmt:
5730: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
5740: 74 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 t-run-state-stat
5750: 75 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d us #f (list run-
5760: 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 id)))..(define (
5770: 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 rmt:set-run-stat
5780: 75 73 20 72 75 6e 2d 69 64 20 72 75 6e 2d 73 74 us run-id run-st
5790: 61 74 75 73 20 23 21 6b 65 79 20 28 6d 73 67 20 atus #!key (msg
57a0: 23 66 29 29 0a 20 20 28 61 73 73 65 72 74 20 28 #f)). (assert (
57b0: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
57c0: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
57d0: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
57e0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
57f0: 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 23 set-run-status #
5800: 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 72 f (list run-id r
5810: 75 6e 2d 73 74 61 74 75 73 20 6d 73 67 29 29 29 un-status msg)))
5820: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 ..(define (rmt:s
5830: 65 74 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 et-run-state-sta
5840: 74 75 73 20 72 75 6e 2d 69 64 20 73 74 61 74 65 tus run-id state
5850: 20 73 74 61 74 75 73 20 29 0a 20 20 28 61 73 73 status ). (ass
5860: 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e ert (number? run
5870: 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e -id) "FATAL: Run
5880: 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a id required.").
5890: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
58a0: 69 76 65 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 ive 'set-run-sta
58b0: 74 65 2d 73 74 61 74 75 73 20 23 66 20 28 6c 69 te-status #f (li
58c0: 73 74 20 72 75 6e 2d 69 64 20 73 74 61 74 65 20 st run-id state
58d0: 73 74 61 74 75 73 29 29 29 0a 0a 28 64 65 66 69 status)))..(defi
58e0: 6e 65 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 74 ne (rmt:update-t
58f0: 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 esdata-on-repilc
5900: 61 74 65 2d 64 62 20 6f 6c 64 2d 6c 74 20 6e 65 ate-db old-lt ne
5910: 77 2d 6c 74 29 0a 28 72 6d 74 3a 73 65 6e 64 2d w-lt).(rmt:send-
5920: 72 65 63 65 69 76 65 20 27 75 70 64 61 74 65 2d receive 'update-
5930: 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c tesdata-on-repil
5940: 63 61 74 65 2d 64 62 20 23 66 20 28 6c 69 73 74 cate-db #f (list
5950: 20 6f 6c 64 2d 6c 74 20 6e 65 77 2d 6c 74 29 29 old-lt new-lt))
5960: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5970: 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 update-run-event
5980: 5f 74 69 6d 65 20 72 75 6e 2d 69 64 29 0a 20 20 _time run-id).
5990: 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f (assert (number?
59a0: 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a run-id) "FATAL:
59b0: 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 Run id required
59c0: 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ."). (rmt:send-
59d0: 72 65 63 65 69 76 65 20 27 75 70 64 61 74 65 2d receive 'update-
59e0: 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 23 run-event_time #
59f0: 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 f (list run-id))
5a00: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5a10: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
5a20: 20 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 keys runnamepa
5a30: 74 74 20 74 61 72 67 70 61 74 74 20 6f 66 66 73 tt targpatt offs
5a40: 65 74 20 6c 69 6d 69 74 20 66 69 65 6c 64 73 20 et limit fields
5a50: 6c 61 73 74 2d 72 75 6e 73 2d 75 70 64 61 74 65 last-runs-update
5a60: 20 20 23 21 6b 65 79 20 20 28 73 6f 72 74 2d 6f #!key (sort-o
5a70: 72 64 65 72 20 22 61 73 63 22 29 29 20 3b 3b 20 rder "asc")) ;;
5a80: 66 69 65 6c 64 73 20 6f 66 20 23 66 20 75 73 65 fields of #f use
5a90: 73 20 64 65 66 61 75 6c 74 0a 20 20 28 72 6d 74 s default. (rmt
5aa0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
5ab0: 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 et-runs-by-patt
5ac0: 23 66 20 28 6c 69 73 74 20 6b 65 79 73 20 72 75 #f (list keys ru
5ad0: 6e 6e 61 6d 65 70 61 74 74 20 74 61 72 67 70 61 nnamepatt targpa
5ae0: 74 74 20 6f 66 66 73 65 74 20 6c 69 6d 69 74 20 tt offset limit
5af0: 66 69 65 6c 64 73 20 6c 61 73 74 2d 72 75 6e 73 fields last-runs
5b00: 2d 75 70 64 61 74 65 20 73 6f 72 74 2d 6f 72 64 -update sort-ord
5b10: 65 72 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 er)))..(define (
5b20: 72 6d 74 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 rmt:find-and-mar
5b30: 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 72 75 6e k-incomplete run
5b40: 2d 69 64 20 6f 76 72 2d 64 65 61 64 74 69 6d 65 -id ovr-deadtime
5b50: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
5b60: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
5b70: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
5b80: 69 72 65 64 2e 22 29 0a 20 20 3b 3b 20 28 69 66 ired."). ;; (if
5b90: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
5ba0: 76 65 20 27 68 61 76 65 2d 69 6e 63 6f 6d 70 6c ve 'have-incompl
5bb0: 65 74 65 73 3f 20 72 75 6e 2d 69 64 20 28 6c 69 etes? run-id (li
5bc0: 73 74 20 72 75 6e 2d 69 64 20 6f 76 72 2d 64 65 st run-id ovr-de
5bd0: 61 64 74 69 6d 65 29 29 0a 20 20 28 72 6d 74 3a adtime)). (rmt:
5be0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6d 61 send-receive 'ma
5bf0: 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 72 75 rk-incomplete ru
5c00: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
5c10: 64 20 6f 76 72 2d 64 65 61 64 74 69 6d 65 29 29 d ovr-deadtime))
5c20: 29 20 3b 3b 20 29 0a 0a 28 64 65 66 69 6e 65 20 ) ;; )..(define
5c30: 28 72 6d 74 3a 67 65 74 2d 6d 61 69 6e 2d 72 75 (rmt:get-main-ru
5c40: 6e 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 29 0a n-stats run-id).
5c50: 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 (assert (numbe
5c60: 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 r? run-id) "FATA
5c70: 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 L: Run id requir
5c80: 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e ed."). (rmt:sen
5c90: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6d d-receive 'get-m
5ca0: 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 20 23 66 ain-run-stats #f
5cb0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
5cc0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
5cd0: 65 74 2d 76 61 72 20 76 61 72 6e 61 6d 65 29 0a et-var varname).
5ce0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
5cf0: 69 76 65 20 27 67 65 74 2d 76 61 72 20 23 66 20 ive 'get-var #f
5d00: 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 29 29 29 (list varname)))
5d10: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 ..(define (rmt:d
5d20: 65 6c 2d 76 61 72 20 76 61 72 6e 61 6d 65 29 0a el-var varname).
5d30: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
5d40: 69 76 65 20 27 64 65 6c 2d 76 61 72 20 23 66 20 ive 'del-var #f
5d50: 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 29 29 29 (list varname)))
5d60: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 ..(define (rmt:s
5d70: 65 74 2d 76 61 72 20 76 61 72 6e 61 6d 65 20 76 et-var varname v
5d80: 61 6c 75 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e alue). (rmt:sen
5d90: 64 2d 72 65 63 65 69 76 65 20 27 73 65 74 2d 76 d-receive 'set-v
5da0: 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 72 6e ar #f (list varn
5db0: 61 6d 65 20 76 61 6c 75 65 29 29 29 0a 0a 28 64 ame value)))..(d
5dc0: 65 66 69 6e 65 20 28 72 6d 74 3a 69 6e 63 2d 76 efine (rmt:inc-v
5dd0: 61 72 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 ar varname). (r
5de0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
5df0: 27 69 6e 63 2d 76 61 72 20 23 66 20 28 6c 69 73 'inc-var #f (lis
5e00: 74 20 76 61 72 6e 61 6d 65 29 29 29 0a 0a 28 64 t varname)))..(d
5e10: 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 63 2d 76 efine (rmt:dec-v
5e20: 61 72 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 ar varname). (r
5e30: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
5e40: 27 64 65 63 2d 76 61 72 20 23 66 20 28 6c 69 73 'dec-var #f (lis
5e50: 74 20 76 61 72 6e 61 6d 65 29 29 29 0a 0a 28 64 t varname)))..(d
5e60: 65 66 69 6e 65 20 28 72 6d 74 3a 61 64 64 2d 76 efine (rmt:add-v
5e70: 61 72 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 ar varname value
5e80: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
5e90: 63 65 69 76 65 20 27 61 64 64 2d 76 61 72 20 23 ceive 'add-var #
5ea0: 66 20 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 20 f (list varname
5eb0: 76 61 6c 75 65 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d value)))..;;====
5ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f00: 3d 3d 0a 3b 3b 20 4d 20 55 20 4c 20 54 20 49 20 ==.;; M U L T I
5f10: 52 20 55 20 4e 20 20 20 51 20 55 20 45 20 52 20 R U N Q U E R
5f20: 49 20 45 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d I E S.;;========
5f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
5f70: 3b 3b 20 4e 65 65 64 20 74 6f 20 6d 6f 76 65 20 ;; Need to move
5f80: 74 68 69 73 20 74 6f 20 6d 75 6c 74 69 2d 72 75 this to multi-ru
5f90: 6e 20 73 65 63 74 69 6f 6e 20 61 6e 64 20 6d 61 n section and ma
5fa0: 6b 65 20 61 73 73 6f 63 69 61 74 65 64 20 63 68 ke associated ch
5fb0: 61 6e 67 65 73 0a 28 64 65 66 69 6e 65 20 28 72 anges.(define (r
5fc0: 6d 74 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b mt:find-and-mark
5fd0: 2d 69 6e 63 6f 6d 70 6c 65 74 65 2d 61 6c 6c 2d -incomplete-all-
5fe0: 72 75 6e 73 20 23 21 6b 65 79 20 28 6f 76 72 2d runs #!key (ovr-
5ff0: 64 65 61 64 74 69 6d 65 20 23 66 29 29 0a 20 20 deadtime #f)).
6000: 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 73 20 28 (let ((run-ids (
6010: 72 6d 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d rmt:get-all-run-
6020: 69 64 73 29 29 29 0a 20 20 20 20 28 66 6f 72 2d ids))). (for-
6030: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 each (lambda (ru
6040: 6e 2d 69 64 29 0a 09 20 20 20 20 20 20 20 28 72 n-id).. (r
6050: 6d 74 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b mt:find-and-mark
6060: 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 72 75 6e 2d -incomplete run-
6070: 69 64 20 6f 76 72 2d 64 65 61 64 74 69 6d 65 29 id ovr-deadtime)
6080: 29 0a 09 20 20 20 20 20 72 75 6e 2d 69 64 73 29 ).. run-ids)
6090: 29 29 0a 0a 3b 3b 20 67 65 74 20 74 68 65 20 70 ))..;; get the p
60a0: 72 65 76 69 6f 75 73 20 72 65 63 6f 72 64 20 66 revious record f
60b0: 6f 72 20 77 68 65 6e 20 74 68 69 73 20 74 65 73 or when this tes
60c0: 74 20 77 61 73 20 72 75 6e 20 77 68 65 72 65 20 t was run where
60d0: 61 6c 6c 20 6b 65 79 73 20 6d 61 74 63 68 20 62 all keys match b
60e0: 75 74 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 72 65 ut runname.;; re
60f0: 74 75 72 6e 73 20 23 66 20 69 66 20 6e 6f 20 73 turns #f if no s
6100: 75 63 68 20 74 65 73 74 20 66 6f 75 6e 64 2c 20 uch test found,
6110: 72 65 74 75 72 6e 73 20 61 20 73 69 6e 67 6c 65 returns a single
6120: 20 74 65 73 74 20 72 65 63 6f 72 64 20 69 66 20 test record if
6130: 66 6f 75 6e 64 0a 3b 3b 20 0a 3b 3b 20 52 75 6e found.;; .;; Run
6140: 20 74 68 69 73 20 61 74 20 74 68 65 20 63 6c 69 this at the cli
6150: 65 6e 74 20 65 6e 64 20 73 69 6e 63 65 20 77 65 ent end since we
6160: 20 68 61 76 65 20 74 6f 20 63 6f 6e 6e 65 63 74 have to connect
6170: 20 74 6f 20 6d 75 6c 74 69 70 6c 65 20 72 75 6e to multiple run
6180: 2d 69 64 20 64 62 73 0a 3b 3b 0a 28 64 65 66 69 -id dbs.;;.(defi
6190: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 ne (rmt:get-prev
61a0: 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 ious-test-run-re
61b0: 63 6f 72 64 20 72 75 6e 2d 69 64 20 74 65 73 74 cord run-id test
61c0: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
61d0: 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 76 61 . (let* ((keyva
61e0: 6c 73 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 2d ls (rmt:get-key-
61f0: 76 61 6c 2d 70 61 69 72 73 20 72 75 6e 2d 69 64 val-pairs run-id
6200: 29 29 0a 09 20 28 6b 65 79 73 20 20 20 20 28 72 )).. (keys (r
6210: 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 20 mt:get-keys))..
6220: 28 73 65 6c 73 74 72 20 20 28 73 74 72 69 6e 67 (selstr (string
6230: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 20 6b 65 -intersperse ke
6240: 79 73 20 22 2c 22 29 29 0a 09 20 28 71 72 79 73 ys ",")).. (qrys
6250: 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 tr (string-inte
6260: 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 rsperse (map (la
6270: 6d 62 64 61 20 28 78 29 28 63 6f 6e 63 20 78 20 mbda (x)(conc x
6280: 22 3d 3f 22 29 29 20 6b 65 79 73 29 20 22 20 41 "=?")) keys) " A
6290: 4e 44 20 22 29 29 29 0a 20 20 20 20 28 69 66 20 ND "))). (if
62a0: 28 6e 6f 74 20 6b 65 79 76 61 6c 73 29 0a 09 23 (not keyvals)..#
62b0: 66 0a 09 28 6c 65 74 20 28 28 70 72 65 76 2d 72 f..(let ((prev-r
62c0: 75 6e 2d 69 64 73 20 28 72 6d 74 3a 67 65 74 2d un-ids (rmt:get-
62d0: 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 72 75 6e prev-run-ids run
62e0: 2d 69 64 29 29 29 0a 09 20 20 3b 3b 20 66 6f 72 -id))).. ;; for
62f0: 20 65 61 63 68 20 72 75 6e 20 73 74 61 72 74 69 each run starti
6300: 6e 67 20 77 69 74 68 20 74 68 65 20 6d 6f 73 74 ng with the most
6310: 20 72 65 63 65 6e 74 20 6c 6f 6f 6b 20 74 6f 20 recent look to
6320: 73 65 65 20 69 66 20 74 68 65 72 65 20 69 73 20 see if there is
6330: 61 20 6d 61 74 63 68 69 6e 67 20 74 65 73 74 0a a matching test.
6340: 09 20 20 3b 3b 20 69 66 20 66 6f 75 6e 64 20 74 . ;; if found t
6350: 68 65 6e 20 72 65 74 75 72 6e 20 74 68 61 74 20 hen return that
6360: 6d 61 74 63 68 69 6e 67 20 74 65 73 74 20 72 65 matching test re
6370: 63 6f 72 64 0a 09 20 20 28 64 65 62 75 67 3a 70 cord.. (debug:p
6380: 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d rint 4 *default-
6390: 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 65 6c 73 74 log-port* "selst
63a0: 72 3a 20 22 20 73 65 6c 73 74 72 20 22 2c 20 71 r: " selstr ", q
63b0: 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 rystr: " qrystr
63c0: 22 2c 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 ", keyvals: " ke
63d0: 79 76 61 6c 73 20 22 2c 20 70 72 65 76 69 6f 75 yvals ", previou
63e0: 73 20 72 75 6e 20 69 64 73 20 66 6f 75 6e 64 3a s run ids found:
63f0: 20 22 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 " prev-run-ids)
6400: 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 .. (if (null? p
6410: 72 65 76 2d 72 75 6e 2d 69 64 73 29 20 23 66 0a rev-run-ids) #f.
6420: 09 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 . (let loop
6430: 20 28 28 68 65 64 20 28 63 61 72 20 70 72 65 76 ((hed (car prev
6440: 2d 72 75 6e 2d 69 64 73 29 29 0a 09 09 09 20 28 -run-ids)).... (
6450: 74 61 6c 20 28 63 64 72 20 70 72 65 76 2d 72 75 tal (cdr prev-ru
6460: 6e 2d 69 64 73 29 29 29 0a 09 09 28 6c 65 74 20 n-ids)))...(let
6470: 28 28 72 65 73 75 6c 74 73 20 28 72 6d 74 3a 67 ((results (rmt:g
6480: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
6490: 20 68 65 64 20 28 63 6f 6e 63 20 74 65 73 74 2d hed (conc test-
64a0: 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 name "/" item-pa
64b0: 74 68 29 20 27 28 29 20 27 28 29 20 3b 3b 20 72 th) '() '() ;; r
64c0: 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 73 un-id testpatt s
64d0: 74 61 74 65 73 20 73 74 61 74 75 73 65 73 0a 09 tates statuses..
64e0: 09 09 09 09 09 20 20 20 20 20 20 23 66 20 23 66 ..... #f #f
64f0: 20 23 66 20 20 20 20 20 20 20 20 20 20 20 20 20 #f
6500: 20 20 3b 3b 20 6f 66 66 73 65 74 20 6c 69 6d 69 ;; offset limi
6510: 74 20 6e 6f 74 2d 69 6e 20 68 69 64 65 2f 6e 6f t not-in hide/no
6520: 74 2d 68 69 64 65 0a 09 09 09 09 09 09 20 20 20 t-hide.......
6530: 20 20 20 23 66 20 23 66 20 23 66 20 23 66 20 27 #f #f #f #f '
6540: 6e 6f 72 6d 61 6c 29 29 29 20 3b 3b 20 73 6f 72 normal))) ;; sor
6550: 74 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 20 t-by sort-order
6560: 71 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 70 64 qryvals last-upd
6570: 61 74 65 20 6d 6f 64 65 0a 09 09 20 20 28 64 65 ate mode... (de
6580: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 bug:print 4 *def
6590: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
65a0: 47 6f 74 20 74 65 73 74 73 20 66 6f 72 20 72 75 Got tests for ru
65b0: 6e 2d 69 64 20 22 20 72 75 6e 2d 69 64 20 22 2c n-id " run-id ",
65c0: 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 74 65 73 test-name " tes
65d0: 74 2d 6e 61 6d 65 20 22 2c 20 69 74 65 6d 2d 70 t-name ", item-p
65e0: 61 74 68 20 22 20 69 74 65 6d 2d 70 61 74 68 20 ath " item-path
65f0: 22 3a 20 22 20 72 65 73 75 6c 74 73 29 0a 09 09 ": " results)...
6600: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 75 6c 6c (if (and (null
6610: 3f 20 72 65 73 75 6c 74 73 29 0a 09 09 09 20 20 ? results)....
6620: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c (not (null? tal
6630: 29 29 29 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f )))... (loo
6640: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
6650: 74 61 6c 29 29 0a 09 09 20 20 20 20 20 20 28 69 tal))... (i
6660: 66 20 28 6e 75 6c 6c 3f 20 72 65 73 75 6c 74 73 f (null? results
6670: 29 20 23 66 0a 09 09 09 20 20 28 63 61 72 20 72 ) #f.... (car r
6680: 65 73 75 6c 74 73 29 29 29 29 29 29 29 29 29 29 esults))))))))))
6690: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
66a0: 65 74 2d 72 75 6e 2d 73 74 61 74 73 29 0a 20 20 et-run-stats).
66b0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
66c0: 65 20 27 67 65 74 2d 72 75 6e 2d 73 74 61 74 73 e 'get-run-stats
66d0: 20 23 66 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d 3d #f '()))..;;===
66e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6720: 3d 3d 3d 0a 3b 3b 20 20 53 20 54 20 45 20 50 20 ===.;; S T E P
6730: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
6740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 47 ==========..;; G
6780: 65 74 74 69 6e 67 20 73 74 65 70 73 20 69 73 20 etting steps is
6790: 6d 6f 72 65 20 63 6f 6d 70 6c 69 63 61 74 65 64 more complicated
67a0: 2e 0a 3b 3b 0a 3b 3b 20 49 66 20 67 69 76 65 6e ..;;.;; If given
67b0: 20 77 6f 72 6b 20 61 72 65 61 20 0a 3b 3b 20 20 work area .;;
67c0: 31 2e 20 46 69 6e 64 20 74 68 65 20 74 65 73 74 1. Find the test
67d0: 64 61 74 2e 64 62 20 66 69 6c 65 0a 3b 3b 20 20 dat.db file.;;
67e0: 32 2e 20 4f 70 65 6e 20 74 68 65 20 74 65 73 74 2. Open the test
67f0: 64 61 74 2e 64 62 20 66 69 6c 65 20 61 6e 64 20 dat.db file and
6800: 64 6f 20 74 68 65 20 71 75 65 72 79 0a 3b 3b 20 do the query.;;
6810: 49 66 20 6e 6f 74 20 67 69 76 65 6e 20 74 68 65 If not given the
6820: 20 77 6f 72 6b 20 61 72 65 61 0a 3b 3b 20 20 31 work area.;; 1
6830: 2e 20 44 6f 20 61 20 72 65 6d 6f 74 65 20 63 61 . Do a remote ca
6840: 6c 6c 20 74 6f 20 67 65 74 20 74 68 65 20 74 65 ll to get the te
6850: 73 74 20 70 61 74 68 0a 3b 3b 20 20 32 2e 20 43 st path.;; 2. C
6860: 6f 6e 74 69 6e 75 65 20 61 73 20 61 62 6f 76 65 ontinue as above
6870: 0a 3b 3b 20 0a 3b 3b 28 64 65 66 69 6e 65 20 28 .;; .;;(define (
6880: 72 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f rmt:get-steps-fo
6890: 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 r-test run-id te
68a0: 73 74 2d 69 64 29 0a 3b 3b 20 20 28 72 6d 74 3a st-id).;; (rmt:
68b0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
68c0: 74 2d 73 74 65 70 73 2d 64 61 74 61 20 72 75 6e t-steps-data run
68d0: 2d 69 64 20 28 6c 69 73 74 20 74 65 73 74 2d 69 -id (list test-i
68e0: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
68f0: 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d mt:teststep-set-
6900: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
6910: 65 73 74 2d 69 64 20 74 65 73 74 73 74 65 70 2d est-id teststep-
6920: 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 74 name state-in st
6930: 61 74 75 73 2d 69 6e 20 63 6f 6d 6d 65 6e 74 20 atus-in comment
6940: 6c 6f 67 66 69 6c 65 29 0a 20 20 28 61 73 73 65 logfile). (asse
6950: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
6960: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
6970: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
6980: 20 28 6c 65 74 2a 20 28 28 73 74 61 74 65 20 20 (let* ((state
6990: 20 20 20 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d (items:check-
69a0: 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 61 valid-items "sta
69b0: 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 0a 09 te" state-in))..
69c0: 20 28 73 74 61 74 75 73 20 20 20 20 28 69 74 65 (status (ite
69d0: 6d 73 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 ms:check-valid-i
69e0: 74 65 6d 73 20 22 73 74 61 74 75 73 22 20 73 74 tems "status" st
69f0: 61 74 75 73 2d 69 6e 29 29 29 0a 20 20 20 20 28 atus-in))). (
6a00: 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 if (or (not stat
6a10: 65 29 28 6e 6f 74 20 73 74 61 74 75 73 29 29 0a e)(not status)).
6a20: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 .(debug:print 3
6a30: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
6a40: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 49 6e 76 t* "WARNING: Inv
6a50: 61 6c 69 64 20 22 20 28 69 66 20 73 74 61 74 75 alid " (if statu
6a60: 73 20 22 73 74 61 74 75 73 22 20 22 73 74 61 74 s "status" "stat
6a70: 65 22 29 0a 09 09 20 20 20 20 20 22 20 76 61 6c e")... " val
6a80: 75 65 20 5c 22 22 20 28 69 66 20 73 74 61 74 75 ue \"" (if statu
6a90: 73 20 73 74 61 74 65 2d 69 6e 20 73 74 61 74 75 s state-in statu
6aa0: 73 2d 69 6e 29 20 22 5c 22 2c 20 75 70 64 61 74 s-in) "\", updat
6ab0: 65 20 79 6f 75 72 20 76 61 6c 69 64 76 61 6c 75 e your validvalu
6ac0: 65 73 20 73 65 63 74 69 6f 6e 20 69 6e 20 6d 65 es section in me
6ad0: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 gatest.config"))
6ae0: 0a 20 20 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 . (rmt:send-r
6af0: 65 63 65 69 76 65 20 27 74 65 73 74 73 74 65 70 eceive 'teststep
6b00: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
6b10: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
6b20: 20 74 65 73 74 2d 69 64 20 74 65 73 74 73 74 65 test-id testste
6b30: 70 2d 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e 20 p-name state-in
6b40: 73 74 61 74 75 73 2d 69 6e 20 63 6f 6d 6d 65 6e status-in commen
6b50: 74 20 6c 6f 67 66 69 6c 65 29 29 29 29 0a 0a 0a t logfile))))...
6b60: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 6c (define (rmt:del
6b70: 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 ete-steps-for-te
6b80: 73 74 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d st! run-id test-
6b90: 69 64 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e id). (assert (n
6ba0: 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 umber? run-id) "
6bb0: 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 FATAL: Run id re
6bc0: 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 quired."). (rmt
6bd0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 :send-receive 'd
6be0: 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 2d elete-steps-for-
6bf0: 74 65 73 74 21 20 72 75 6e 2d 69 64 20 28 6c 69 test! run-id (li
6c00: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
6c10: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
6c20: 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 mt:get-steps-for
6c30: 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 -test run-id tes
6c40: 74 2d 69 64 29 0a 20 20 28 61 73 73 65 72 74 20 t-id). (assert
6c50: 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 (number? run-id)
6c60: 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 "FATAL: Run id
6c70: 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 required."). (r
6c80: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
6c90: 27 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 'get-steps-for-t
6ca0: 65 73 74 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 est run-id (list
6cb0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
6cc0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
6cd0: 3a 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 6f 2d :get-steps-info-
6ce0: 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 by-id run-id tes
6cf0: 74 2d 73 74 65 70 2d 69 64 29 0a 20 20 28 61 73 t-step-id). (as
6d00: 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 sert (number? ru
6d10: 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 n-id) "FATAL: Ru
6d20: 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 n id required.")
6d30: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
6d40: 65 69 76 65 20 27 67 65 74 2d 73 74 65 70 73 2d eive 'get-steps-
6d50: 69 6e 66 6f 2d 62 79 2d 69 64 20 23 66 20 28 6c info-by-id #f (l
6d60: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
6d70: 73 74 65 70 2d 69 64 29 29 29 0a 0a 3b 3b 3d 3d step-id)))..;;==
6d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6dc0: 3d 3d 3d 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 ====.;; T E S T
6dd0: 20 20 20 44 20 41 20 54 20 41 20 0a 3b 3b 3d 3d D A T A .;;==
6de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e20: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 ====..(define (r
6e30: 6d 74 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74 mt:read-test-dat
6e40: 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 a run-id test-id
6e50: 20 63 61 74 65 67 6f 72 79 70 61 74 74 20 23 21 categorypatt #!
6e60: 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 key (work-area #
6e70: 66 29 29 20 0a 20 20 28 61 73 73 65 72 74 20 28 f)) . (assert (
6e80: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
6e90: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
6ea0: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
6eb0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
6ec0: 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 read-test-data r
6ed0: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
6ee0: 69 64 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 id test-id categ
6ef0: 6f 72 79 70 61 74 74 29 29 29 0a 0a 28 64 65 66 orypatt)))..(def
6f00: 69 6e 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 65 ine (rmt:read-te
6f10: 73 74 2d 64 61 74 61 2d 76 61 72 70 61 74 74 20 st-data-varpatt
6f20: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 63 run-id test-id c
6f30: 61 74 65 67 6f 72 79 70 61 74 74 20 76 61 72 70 ategorypatt varp
6f40: 61 74 74 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d att #!key (work-
6f50: 61 72 65 61 20 23 66 29 29 20 0a 20 20 28 61 73 area #f)) . (as
6f60: 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 sert (number? ru
6f70: 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 n-id) "FATAL: Ru
6f80: 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 n id required.")
6f90: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
6fa0: 65 69 76 65 20 27 72 65 61 64 2d 74 65 73 74 2d eive 'read-test-
6fb0: 64 61 74 61 2d 76 61 72 70 61 74 74 20 72 75 6e data-varpatt run
6fc0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
6fd0: 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 test-id categor
6fe0: 79 70 61 74 74 20 76 61 72 70 61 74 74 29 29 29 ypatt varpatt)))
6ff0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
7000: 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 79 2d et-data-info-by-
7010: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 64 id run-id test-d
7020: 61 74 61 2d 69 64 29 0a 20 20 28 61 73 73 65 72 ata-id). (asser
7030: 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 t (number? run-i
7040: 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 d) "FATAL: Run i
7050: 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 d required.").
7060: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7070: 76 65 20 27 67 65 74 2d 64 61 74 61 2d 69 6e 66 ve 'get-data-inf
7080: 6f 2d 62 79 2d 69 64 20 23 66 20 28 6c 69 73 74 o-by-id #f (list
7090: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 64 61 74 run-id test-dat
70a0: 61 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 a-id)))..(define
70b0: 20 28 72 6d 74 3a 74 65 73 74 6d 65 74 61 2d 61 (rmt:testmeta-a
70c0: 64 64 2d 72 65 63 6f 72 64 20 74 65 73 74 6e 61 dd-record testna
70d0: 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d me). (rmt:send-
70e0: 72 65 63 65 69 76 65 20 27 74 65 73 74 6d 65 74 receive 'testmet
70f0: 61 2d 61 64 64 2d 72 65 63 6f 72 64 20 23 66 20 a-add-record #f
7100: 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 29 (list testname))
7110: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
7120: 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 testmeta-get-rec
7130: 6f 72 64 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 ord testname).
7140: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
7150: 65 20 27 74 65 73 74 6d 65 74 61 2d 67 65 74 2d e 'testmeta-get-
7160: 72 65 63 6f 72 64 20 23 66 20 28 6c 69 73 74 20 record #f (list
7170: 74 65 73 74 6e 61 6d 65 29 29 29 0a 0a 28 64 65 testname)))..(de
7180: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 6d 65 fine (rmt:testme
7190: 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 20 ta-update-field
71a0: 74 65 73 74 2d 6e 61 6d 65 20 66 6c 64 20 76 61 test-name fld va
71b0: 6c 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 l). (rmt:send-r
71c0: 65 63 65 69 76 65 20 27 74 65 73 74 6d 65 74 61 eceive 'testmeta
71d0: 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 20 23 66 -update-field #f
71e0: 20 28 6c 69 73 74 20 74 65 73 74 2d 6e 61 6d 65 (list test-name
71f0: 20 66 6c 64 20 76 61 6c 29 29 29 0a 0a 28 64 65 fld val)))..(de
7200: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 64 fine (rmt:test-d
7210: 61 74 61 2d 72 6f 6c 6c 75 70 20 72 75 6e 2d 69 ata-rollup run-i
7220: 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73 d test-id status
7230: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
7240: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
7250: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
7260: 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 ired."). (rmt:s
7270: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 end-receive 'tes
7280: 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 72 75 t-data-rollup ru
7290: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
72a0: 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73 d test-id status
72b0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
72c0: 74 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 t:csv->test-data
72d0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
72e0: 63 73 76 64 61 74 61 29 0a 20 20 28 61 73 73 65 csvdata). (asse
72f0: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
7300: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
7310: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
7320: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7330: 76 65 20 27 63 73 76 2d 3e 74 65 73 74 2d 64 61 ve 'csv->test-da
7340: 74 61 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 ta run-id (list
7350: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 63 run-id test-id c
7360: 73 76 64 61 74 61 29 29 29 0a 0a 3b 3b 3d 3d 3d svdata)))..;;===
7370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73b0: 3d 3d 3d 0a 3b 3b 20 20 54 20 41 20 53 20 4b 20 ===.;; T A S K
73c0: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
73d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
7410: 69 6e 65 20 28 72 6d 74 3a 74 61 73 6b 73 2d 66 ine (rmt:tasks-f
7420: 69 6e 64 2d 74 61 73 6b 2d 71 75 65 75 65 2d 72 ind-task-queue-r
7430: 65 63 6f 72 64 73 20 74 61 72 67 65 74 20 72 75 ecords target ru
7440: 6e 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 74 n-name test-patt
7450: 20 73 74 61 74 65 2d 70 61 74 74 20 61 63 74 69 state-patt acti
7460: 6f 6e 2d 70 61 74 74 29 0a 20 20 28 72 6d 74 3a on-patt). (rmt:
7470: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 66 69 send-receive 'fi
7480: 6e 64 2d 74 61 73 6b 2d 71 75 65 75 65 2d 72 65 nd-task-queue-re
7490: 63 6f 72 64 73 20 23 66 20 28 6c 69 73 74 20 74 cords #f (list t
74a0: 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 20 74 arget run-name t
74b0: 65 73 74 2d 70 61 74 74 20 73 74 61 74 65 2d 70 est-patt state-p
74c0: 61 74 74 20 61 63 74 69 6f 6e 2d 70 61 74 74 29 att action-patt)
74d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
74e0: 3a 74 61 73 6b 73 2d 61 64 64 20 61 63 74 69 6f :tasks-add actio
74f0: 6e 20 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 n owner target r
7500: 75 6e 6e 61 6d 65 20 74 65 73 74 70 61 74 74 20 unname testpatt
7510: 70 61 72 61 6d 73 29 0a 20 20 28 72 6d 74 3a 73 params). (rmt:s
7520: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 61 73 end-receive 'tas
7530: 6b 73 2d 61 64 64 20 23 66 20 28 6c 69 73 74 20 ks-add #f (list
7540: 61 63 74 69 6f 6e 20 6f 77 6e 65 72 20 74 61 72 action owner tar
7550: 67 65 74 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 get runname test
7560: 70 61 74 74 20 70 61 72 61 6d 73 29 29 29 0a 0a patt params)))..
7570: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 61 73 (define (rmt:tas
7580: 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 69 76 ks-set-state-giv
7590: 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 20 70 61 72 en-param-key par
75a0: 61 6d 2d 6b 65 79 20 6e 65 77 2d 73 74 61 74 65 am-key new-state
75b0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
75c0: 63 65 69 76 65 20 27 74 61 73 6b 73 2d 73 65 74 ceive 'tasks-set
75d0: 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 -state-given-par
75e0: 61 6d 2d 6b 65 79 20 23 66 20 28 6c 69 73 74 20 am-key #f (list
75f0: 20 70 61 72 61 6d 2d 6b 65 79 20 6e 65 77 2d 73 param-key new-s
7600: 74 61 74 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 tate)))..(define
7610: 20 28 72 6d 74 3a 74 61 73 6b 73 2d 67 65 74 2d (rmt:tasks-get-
7620: 6c 61 73 74 20 74 61 72 67 65 74 20 72 75 6e 6e last target runn
7630: 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ame). (rmt:send
7640: 2d 72 65 63 65 69 76 65 20 27 74 61 73 6b 73 2d -receive 'tasks-
7650: 67 65 74 2d 6c 61 73 74 20 23 66 20 28 6c 69 73 get-last #f (lis
7660: 74 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 t target runname
7670: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
7680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
76c0: 20 4e 20 4f 20 20 20 53 20 59 20 4e 20 43 20 20 N O S Y N C
76d0: 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d D B .;;========
76e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
7720: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d (define (rmt:no-
7730: 73 79 6e 63 2d 73 65 74 20 76 61 72 20 76 61 6c sync-set var val
7740: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
7750: 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d 73 ceive 'no-sync-s
7760: 65 74 20 23 66 20 60 28 2c 76 61 72 20 2c 76 61 et #f `(,var ,va
7770: 6c 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 l)))..(define (r
7780: 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 mt:no-sync-get/d
7790: 65 66 61 75 6c 74 20 76 61 72 20 64 65 66 61 75 efault var defau
77a0: 6c 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d lt). (rmt:send-
77b0: 72 65 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 receive 'no-sync
77c0: 2d 67 65 74 2f 64 65 66 61 75 6c 74 20 23 66 20 -get/default #f
77d0: 60 28 2c 76 61 72 20 2c 64 65 66 61 75 6c 74 29 `(,var ,default)
77e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
77f0: 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 76 61 :no-sync-del! va
7800: 72 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 r). (rmt:send-r
7810: 65 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d eceive 'no-sync-
7820: 64 65 6c 21 20 23 66 20 60 28 2c 76 61 72 29 29 del! #f `(,var))
7830: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
7840: 6e 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b no-sync-get-lock
7850: 20 6b 65 79 6e 61 6d 65 29 0a 20 20 28 72 6d 74 keyname). (rmt
7860: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6e :send-receive 'n
7870: 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 o-sync-get-lock
7880: 23 66 20 60 28 2c 6b 65 79 6e 61 6d 65 29 29 29 #f `(,keyname)))
7890: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e ..(define (rmt:n
78a0: 6f 2d 73 79 6e 63 2d 61 64 64 2d 6a 6f 62 20 68 o-sync-add-job h
78b0: 6f 73 74 2d 74 79 70 65 20 76 61 72 73 2d 6c 69 ost-type vars-li
78c0: 73 74 20 65 78 65 6b 65 79 20 63 6d 64 6c 69 6e st exekey cmdlin
78d0: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
78e0: 65 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d eceive 'no-sync-
78f0: 61 64 64 2d 6a 6f 62 20 23 66 20 60 28 2c 68 6f add-job #f `(,ho
7900: 73 74 2d 74 79 70 65 20 2c 76 61 72 73 2d 6c 69 st-type ,vars-li
7910: 73 74 20 2c 65 78 65 6b 65 79 20 2c 63 6d 64 6c st ,exekey ,cmdl
7920: 69 6e 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ine)))..(define
7930: 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 74 61 6b (rmt:no-sync-tak
7940: 65 2d 6a 6f 62 20 68 6f 73 74 2d 74 79 70 65 29 e-job host-type)
7950: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
7960: 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d 74 61 eive 'no-sync-ta
7970: 6b 65 2d 6a 6f 62 20 23 66 20 60 28 2c 68 6f 73 ke-job #f `(,hos
7980: 74 2d 74 79 70 65 29 29 29 0a 0a 28 64 65 66 69 t-type)))..(defi
7990: 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d ne (rmt:no-sync-
79a0: 6a 6f 62 2d 72 65 63 6f 72 64 73 2d 63 6c 65 61 job-records-clea
79b0: 6e 29 0a 20 20 28 72 6d 74 3a 73 65 74 2d 72 65 n). (rmt:set-re
79c0: 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d 6a ceive 'no-sync-j
79d0: 6f 62 2d 72 65 63 6f 72 64 73 2d 63 6c 65 61 6e ob-records-clean
79e0: 20 23 66 20 27 28 29 29 29 0a 0a 3b 3b 20 70 72 #f '()))..;; pr
79f0: 6f 63 65 73 73 20 72 65 67 69 73 74 72 61 74 69 ocess registrati
7a00: 6f 6e 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 on..(define (rmt
7a10: 3a 72 65 67 69 73 74 65 72 2d 70 72 6f 63 65 73 :register-proces
7a20: 73 20 68 6f 73 74 20 70 6f 72 74 20 70 69 64 20 s host port pid
7a30: 73 74 61 72 74 74 69 6d 65 20 73 74 61 74 75 73 starttime status
7a40: 20 70 75 72 70 6f 73 65 20 64 62 6e 61 6d 65 20 purpose dbname
7a50: 6d 74 76 65 72 73 69 6f 6e 29 0a 20 20 28 72 6d mtversion). (rm
7a60: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
7a70: 72 65 67 69 73 74 65 72 2d 70 72 6f 63 65 73 73 register-process
7a80: 20 23 66 20 28 6c 69 73 74 20 68 6f 73 74 20 70 #f (list host p
7a90: 6f 72 74 20 70 69 64 20 73 74 61 72 74 74 69 6d ort pid starttim
7aa0: 65 20 73 74 61 74 75 73 20 70 75 72 70 6f 73 65 e status purpose
7ab0: 20 64 62 6e 61 6d 65 20 6d 74 76 65 72 73 69 6f dbname mtversio
7ac0: 6e 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 n)))..(define (r
7ad0: 6d 74 3a 73 65 74 2d 70 72 6f 63 65 73 73 2d 64 mt:set-process-d
7ae0: 6f 6e 65 20 68 6f 73 74 20 70 69 64 20 72 65 61 one host pid rea
7af0: 73 6f 6e 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 son). (rmt:send
7b00: 2d 72 65 63 65 69 76 65 20 27 73 65 74 2d 70 72 -receive 'set-pr
7b10: 6f 63 65 73 73 2d 64 6f 6e 65 20 23 66 20 28 6c ocess-done #f (l
7b20: 69 73 74 20 68 6f 73 74 20 70 69 64 20 72 65 61 ist host pid rea
7b30: 73 6f 6e 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 son)))..(define
7b40: 28 72 6d 74 3a 73 65 74 2d 70 72 6f 63 65 73 73 (rmt:set-process
7b50: 2d 73 74 61 74 75 73 20 68 6f 73 74 20 70 69 64 -status host pid
7b60: 20 6e 65 77 73 74 61 74 75 73 29 0a 20 20 28 72 newstatus). (r
7b70: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
7b80: 27 73 65 74 2d 70 72 6f 63 65 73 73 2d 73 74 61 'set-process-sta
7b90: 74 75 73 20 23 66 20 28 6c 69 73 74 20 68 6f 73 tus #f (list hos
7ba0: 74 20 70 69 64 20 6e 65 77 73 74 61 74 75 73 29 t pid newstatus)
7bb0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
7bc0: 3a 67 65 74 2d 70 72 6f 63 65 73 73 2d 6f 70 74 :get-process-opt
7bd0: 69 6f 6e 73 20 70 75 72 70 6f 73 65 20 64 62 6e ions purpose dbn
7be0: 61 6d 65 29 0a 20 20 28 72 6d 74 3a 67 65 74 2d ame). (rmt:get-
7bf0: 70 72 6f 63 65 73 73 2d 6f 70 74 69 6f 6e 73 20 process-options
7c00: 27 67 65 74 2d 70 72 6f 63 65 73 73 2d 6f 70 74 'get-process-opt
7c10: 69 6f 6e 73 20 23 66 20 28 6c 69 73 74 20 70 75 ions #f (list pu
7c20: 72 70 6f 73 65 20 64 62 6e 61 6d 65 29 29 29 0a rpose dbname))).
7c30: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
7c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 52 =========.;; A R
7c80: 20 43 20 48 20 49 20 56 20 45 20 53 0a 3b 3b 3d C H I V E S.;;=
7c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7cd0: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
7ce0: 72 6d 74 3a 61 72 63 68 69 76 65 2d 67 65 74 2d rmt:archive-get-
7cf0: 61 6c 6c 6f 63 61 74 69 6f 6e 73 20 20 74 65 73 allocations tes
7d00: 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 20 64 tname itempath d
7d10: 6e 65 65 64 65 64 29 0a 20 20 28 72 6d 74 3a 73 needed). (rmt:s
7d20: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 61 72 63 end-receive 'arc
7d30: 68 69 76 65 2d 67 65 74 2d 61 6c 6c 6f 63 61 74 hive-get-allocat
7d40: 69 6f 6e 73 20 23 66 20 28 6c 69 73 74 20 74 65 ions #f (list te
7d50: 73 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 20 stname itempath
7d60: 64 6e 65 65 64 65 64 29 29 29 0a 0a 28 64 65 66 dneeded)))..(def
7d70: 69 6e 65 20 28 72 6d 74 3a 61 72 63 68 69 76 65 ine (rmt:archive
7d80: 2d 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 6b 2d -register-block-
7d90: 6e 61 6d 65 20 62 64 69 73 6b 2d 69 64 20 61 72 name bdisk-id ar
7da0: 63 68 69 76 65 2d 70 61 74 68 29 0a 20 20 28 72 chive-path). (r
7db0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
7dc0: 27 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 'archive-registe
7dd0: 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 23 66 20 r-block-name #f
7de0: 28 6c 69 73 74 20 62 64 69 73 6b 2d 69 64 20 61 (list bdisk-id a
7df0: 72 63 68 69 76 65 2d 70 61 74 68 29 29 29 0a 0a rchive-path)))..
7e00: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 61 72 63 (define (rmt:arc
7e10: 68 69 76 65 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 hive-allocate-te
7e20: 73 74 73 75 69 74 65 2f 61 72 65 61 2d 74 6f 2d stsuite/area-to-
7e30: 62 6c 6f 63 6b 20 62 6c 6f 63 6b 2d 69 64 20 74 block block-id t
7e40: 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 20 61 72 estsuite-name ar
7e50: 65 61 6b 65 79 29 0a 20 20 28 72 6d 74 3a 73 65 eakey). (rmt:se
7e60: 6e 64 2d 72 65 63 65 69 76 65 20 27 61 72 63 68 nd-receive 'arch
7e70: 69 76 65 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 73 ive-allocate-tes
7e80: 74 2d 74 6f 2d 62 6c 6f 63 6b 20 23 66 20 28 6c t-to-block #f (l
7e90: 69 73 74 20 20 62 6c 6f 63 6b 2d 69 64 20 74 65 ist block-id te
7ea0: 73 74 73 75 69 74 65 2d 6e 61 6d 65 20 61 72 65 stsuite-name are
7eb0: 61 6b 65 79 29 29 29 0a 0a 28 64 65 66 69 6e 65 akey)))..(define
7ec0: 20 28 72 6d 74 3a 61 72 63 68 69 76 65 2d 72 65 (rmt:archive-re
7ed0: 67 69 73 74 65 72 2d 64 69 73 6b 20 62 64 69 73 gister-disk bdis
7ee0: 6b 2d 6e 61 6d 65 20 62 64 69 73 6b 2d 70 61 74 k-name bdisk-pat
7ef0: 68 20 64 66 29 0a 20 20 28 72 6d 74 3a 73 65 6e h df). (rmt:sen
7f00: 64 2d 72 65 63 65 69 76 65 20 27 61 72 63 68 69 d-receive 'archi
7f10: 76 65 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b ve-register-disk
7f20: 20 23 66 20 28 6c 69 73 74 20 62 64 69 73 6b 2d #f (list bdisk-
7f30: 6e 61 6d 65 20 62 64 69 73 6b 2d 70 61 74 68 20 name bdisk-path
7f40: 64 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 df)))..(define (
7f50: 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 61 72 63 rmt:test-set-arc
7f60: 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 20 72 75 hive-block-id ru
7f70: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 61 72 63 n-id test-id arc
7f80: 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 0a 20 hive-block-id).
7f90: 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 (assert (number
7fa0: 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c ? run-id) "FATAL
7fb0: 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 : Run id require
7fc0: 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 d."). (rmt:send
7fd0: 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 73 -receive 'test-s
7fe0: 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b et-archive-block
7ff0: 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 -id run-id (list
8000: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
8010: 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 archive-block-id
8020: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
8030: 74 3a 74 65 73 74 2d 67 65 74 2d 61 72 63 68 69 t:test-get-archi
8040: 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f 20 61 72 ve-block-info ar
8050: 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 0a chive-block-id).
8060: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
8070: 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d 61 72 ive 'test-get-ar
8080: 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f chive-block-info
8090: 20 23 66 20 28 6c 69 73 74 20 61 72 63 68 69 76 #f (list archiv
80a0: 65 2d 62 6c 6f 63 6b 2d 69 64 29 29 29 0a 0a 28 e-block-id)))..(
80b0: 64 65 66 69 6e 65 20 28 72 6d 74 6d 6f 64 3a 63 define (rmtmod:c
80c0: 61 6c 63 2d 72 6f 2d 6d 6f 64 65 20 72 75 6e 72 alc-ro-mode runr
80d0: 65 6d 6f 74 65 20 2a 74 6f 70 70 61 74 68 2a 29 emote *toppath*)
80e0: 0a 20 20 28 63 61 73 65 20 28 72 6d 74 3a 74 72 . (case (rmt:tr
80f0: 61 6e 73 70 6f 72 74 2d 6d 6f 64 65 29 0a 20 20 ansport-mode).
8100: 20 20 28 28 68 74 74 70 29 0a 20 20 20 20 20 28 ((http). (
8110: 69 66 20 28 61 6e 64 20 72 75 6e 72 65 6d 6f 74 if (and runremot
8120: 65 0a 09 20 20 20 20 20 20 28 72 65 6d 6f 74 65 e.. (remote
8130: 2d 72 6f 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 64 -ro-mode-checked
8140: 20 72 75 6e 72 65 6d 6f 74 65 29 29 0a 09 20 28 runremote)).. (
8150: 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 20 72 remote-ro-mode r
8160: 75 6e 72 65 6d 6f 74 65 29 0a 09 20 28 6c 65 74 unremote).. (let
8170: 2a 20 28 28 6d 74 63 66 67 66 69 6c 65 20 20 28 * ((mtcfgfile (
8180: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
8190: 2f 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 /megatest.config
81a0: 22 29 29 0a 09 09 28 72 6f 2d 6d 6f 64 65 20 28 "))...(ro-mode (
81b0: 6e 6f 74 20 28 66 69 6c 65 2d 77 72 69 74 65 2d not (file-write-
81c0: 61 63 63 65 73 73 3f 20 6d 74 63 66 67 66 69 6c access? mtcfgfil
81d0: 65 29 29 29 29 20 3b 3b 20 54 4f 44 4f 3a 20 75 e)))) ;; TODO: u
81e0: 73 65 20 64 62 73 74 72 75 63 74 20 6f 72 20 72 se dbstruct or r
81f0: 75 6e 72 65 6d 6f 74 65 20 74 6f 20 66 69 67 75 unremote to figu
8200: 72 65 20 74 68 69 73 20 6f 75 74 20 69 6e 20 66 re this out in f
8210: 75 74 75 72 65 0a 09 20 20 20 28 69 66 20 72 75 uture.. (if ru
8220: 6e 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 20 nremote..
8230: 28 62 65 67 69 6e 0a 09 09 20 28 72 65 6d 6f 74 (begin... (remot
8240: 65 2d 72 6f 2d 6d 6f 64 65 2d 73 65 74 21 20 72 e-ro-mode-set! r
8250: 75 6e 72 65 6d 6f 74 65 20 72 6f 2d 6d 6f 64 65 unremote ro-mode
8260: 29 0a 09 09 20 28 72 65 6d 6f 74 65 2d 72 6f 2d )... (remote-ro-
8270: 6d 6f 64 65 2d 63 68 65 63 6b 65 64 2d 73 65 74 mode-checked-set
8280: 21 20 72 75 6e 72 65 6d 6f 74 65 20 23 74 29 0a ! runremote #t).
8290: 09 09 20 72 6f 2d 6d 6f 64 65 29 0a 09 20 20 20 .. ro-mode)..
82a0: 20 20 20 20 72 6f 2d 6d 6f 64 65 29 29 29 29 0a ro-mode)))).
82b0: 20 20 20 20 28 28 74 63 70 29 0a 20 20 20 20 20 ((tcp).
82c0: 28 69 66 20 28 61 6e 64 20 72 75 6e 72 65 6d 6f (if (and runremo
82d0: 74 65 0a 09 20 20 20 20 20 20 28 74 74 2d 72 6f te.. (tt-ro
82e0: 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 64 20 72 75 -mode-checked ru
82f0: 6e 72 65 6d 6f 74 65 29 29 0a 09 20 28 74 74 2d nremote)).. (tt-
8300: 72 6f 2d 6d 6f 64 65 20 72 75 6e 72 65 6d 6f 74 ro-mode runremot
8310: 65 29 0a 09 20 28 6c 65 74 2a 20 28 28 6d 74 63 e).. (let* ((mtc
8320: 66 67 66 69 6c 65 20 20 28 63 6f 6e 63 20 2a 74 fgfile (conc *t
8330: 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 oppath* "/megate
8340: 73 74 2e 63 6f 6e 66 69 67 22 29 29 0a 09 09 28 st.config"))...(
8350: 72 6f 2d 6d 6f 64 65 20 28 6e 6f 74 20 28 66 69 ro-mode (not (fi
8360: 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f le-write-access?
8370: 20 6d 74 63 66 67 66 69 6c 65 29 29 29 29 20 3b mtcfgfile)))) ;
8380: 3b 20 54 4f 44 4f 3a 20 75 73 65 20 64 62 73 74 ; TODO: use dbst
8390: 72 75 63 74 20 6f 72 20 72 75 6e 72 65 6d 6f 74 ruct or runremot
83a0: 65 20 74 6f 20 66 69 67 75 72 65 20 74 68 69 73 e to figure this
83b0: 20 6f 75 74 20 69 6e 20 66 75 74 75 72 65 0a 09 out in future..
83c0: 20 20 20 28 69 66 20 72 75 6e 72 65 6d 6f 74 65 (if runremote
83d0: 0a 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a .. (begin.
83e0: 09 09 20 28 74 74 2d 72 6f 2d 6d 6f 64 65 2d 73 .. (tt-ro-mode-s
83f0: 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 72 6f et! runremote ro
8400: 2d 6d 6f 64 65 29 0a 09 09 20 28 74 74 2d 72 6f -mode)... (tt-ro
8410: 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 64 2d 73 65 -mode-checked-se
8420: 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 23 74 29 t! runremote #t)
8430: 0a 09 09 20 72 6f 2d 6d 6f 64 65 29 0a 09 20 20 ... ro-mode)..
8440: 20 20 20 20 20 72 6f 2d 6d 6f 64 65 29 29 29 29 ro-mode))))
8450: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
8460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
84a0: 4d 61 69 6e 74 65 6e 61 6e 63 65 0a 3b 3b 3d 3d Maintenance.;;==
84b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84f0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 ====..(define (r
8500: 6d 74 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b mt:find-and-mark
8510: 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 72 75 6e 2d -incomplete run-
8520: 69 64 20 6f 76 72 2d 64 65 61 64 74 69 6d 65 29 id ovr-deadtime)
8530: 0a 20 20 28 6c 65 74 2a 20 28 28 63 66 67 2d 64 . (let* ((cfg-d
8540: 65 61 64 74 69 6d 65 20 20 20 20 20 20 20 20 20 eadtime
8550: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (configf:loo
8560: 6b 75 70 2d 6e 75 6d 62 65 72 20 2a 63 6f 6e 66 kup-number *conf
8570: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
8580: 64 65 61 64 74 69 6d 65 22 29 29 0a 09 20 28 74 deadtime")).. (t
8590: 65 73 74 2d 73 74 61 74 73 2d 75 70 64 61 74 65 est-stats-update
85a0: 2d 70 65 72 69 6f 64 20 28 63 6f 6e 66 69 67 66 -period (configf
85b0: 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 20 2a :lookup-number *
85c0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
85d0: 70 22 20 22 74 65 73 74 2d 73 74 61 74 73 2d 75 p" "test-stats-u
85e0: 70 64 61 74 65 2d 70 65 72 69 6f 64 22 29 29 29 pdate-period")))
85f0: 0a 20 20 20 28 72 6d 74 3a 66 69 6e 64 2d 61 6e . (rmt:find-an
8600: 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 d-mark-incomplet
8610: 65 2d 65 6e 67 69 6e 65 20 72 75 6e 2d 69 64 20 e-engine run-id
8620: 6f 76 72 2d 64 65 61 64 74 69 6d 65 20 63 66 67 ovr-deadtime cfg
8630: 2d 64 65 61 64 74 69 6d 65 20 74 65 73 74 2d 73 -deadtime test-s
8640: 74 61 74 73 2d 75 70 64 61 74 65 2d 70 65 72 69 tats-update-peri
8650: 6f 64 29 0a 20 20 20 3b 3b 63 61 6c 6c 20 65 6e od). ;;call en
8660: 64 20 6f 66 20 65 75 64 20 6f 66 20 72 75 6e 20 d of eud of run
8670: 64 65 74 65 63 74 69 6f 6e 20 66 6f 72 20 70 6f detection for po
8680: 73 74 68 6f 6f 6b 0a 20 20 20 28 6c 61 75 6e 63 sthook. (launc
8690: 68 3a 65 6e 64 2d 6f 66 2d 72 75 6e 2d 63 68 65 h:end-of-run-che
86a0: 63 6b 20 72 75 6e 2d 69 64 29 29 29 0a 0a 3b 3b ck run-id)))..;;
86b0: 20 6f 72 70 68 61 6e 65 64 20 66 72 6f 6d 20 63 orphaned from c
86c0: 68 65 72 72 79 70 69 63 6b 20 6d 65 72 67 65 0a herrypick merge.
86d0: 3b 3b 20 20 20 20 20 20 20 20 20 28 64 65 62 75 ;; (debu
86e0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
86f0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e lt-log-port* "In
8700: 73 65 72 74 69 6e 67 20 22 20 28 6c 65 6e 67 74 serting " (lengt
8710: 68 20 74 65 73 74 73 2d 64 61 74 61 29 20 22 20 h tests-data) "
8720: 74 65 73 74 73 20 69 6e 20 72 75 6e 20 22 20 72 tests in run " r
8730: 75 6e 6e 61 6d 65 29 0a unname).