0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 37 2c right 2006-2017,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;.;;===========
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
0390: 65 20 66 6f 72 6d 61 74 20 74 79 70 65 64 2d 72 e format typed-r
03a0: 65 63 6f 72 64 73 29 20 3b 3b 20 52 41 44 54 20 ecords) ;; RADT
03b0: 3d 3e 20 70 75 72 70 6f 73 65 20 6f 66 20 6a 73 => purpose of js
03c0: 6f 6e 20 66 6f 72 6d 61 74 3f 3f 0a 0a 28 64 65 on format??..(de
03d0: 63 6c 61 72 65 20 28 75 6e 69 74 20 72 6d 74 29 clare (unit rmt)
03e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03f0: 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 65 20 api)).(declare
0400: 28 75 73 65 73 20 68 74 74 70 2d 74 72 61 6e 73 (uses http-trans
0410: 70 6f 72 74 29 29 0a 28 69 6e 63 6c 75 64 65 20 port)).(include
0420: 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e "common_records.
0430: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0440: 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 db_records.scm")
0450: 0a 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 ..;; (declare (u
0460: 73 65 73 20 72 6d 74 6d 6f 64 29 29 0a 0a 3b 3b ses rmtmod))..;;
0470: 20 28 69 6d 70 6f 72 74 20 72 6d 74 6d 6f 64 29 (import rmtmod)
0480: 0a 0a 3b 3b 0a 3b 3b 20 54 48 45 53 45 20 41 52 ..;;.;; THESE AR
0490: 45 20 41 4c 4c 20 43 41 4c 4c 45 44 20 4f 4e 20 E ALL CALLED ON
04a0: 54 48 45 20 43 4c 49 45 4e 54 20 53 49 44 45 21 THE CLIENT SIDE!
04b0: 21 21 0a 3b 3b 0a 0a 3b 3b 20 67 65 6e 65 72 61 !!.;;..;; genera
04c0: 74 65 20 65 6e 74 72 69 65 73 20 66 6f 72 20 7e te entries for ~
04d0: 2f 2e 6d 65 67 61 74 65 73 74 72 63 20 77 69 74 /.megatestrc wit
04e0: 68 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 0a h the following.
04f0: 3b 3b 0a 3b 3b 20 20 67 72 65 70 20 64 65 66 69 ;;.;; grep defi
0500: 6e 65 20 2e 2e 2f 72 6d 74 2e 73 63 6d 20 7c 20 ne ../rmt.scm |
0510: 67 72 65 70 20 72 6d 74 3a 20 7c 70 65 72 6c 20 grep rmt: |perl
0520: 2d 70 69 20 2d 65 20 27 73 2f 5c 28 64 65 66 69 -pi -e 's/\(defi
0530: 6e 65 5c 73 2b 5c 28 28 5c 53 2b 29 5c 57 2e 2a ne\s+\((\S+)\W.*
0540: 24 2f 5c 31 2f 27 7c 73 6f 72 74 20 2d 75 0a 0a $/\1/'|sort -u..
0550: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0590: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 53 20 55 ========.;; S U
05a0: 20 50 20 50 20 4f 20 52 20 54 20 20 20 46 20 55 P P O R T F U
05b0: 20 4e 20 43 20 54 20 49 20 4f 20 4e 20 53 0a 3b N C T I O N S.;
05c0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
05d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0600: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 69 66 20 61 =======..;; if a
0610: 20 73 65 72 76 65 72 20 69 73 20 65 69 74 68 65 server is eithe
0620: 72 20 72 75 6e 6e 69 6e 67 20 6f 72 20 69 6e 20 r running or in
0630: 74 68 65 20 70 72 6f 63 65 73 73 20 6f 66 20 73 the process of s
0640: 74 61 72 74 69 6e 67 20 63 61 6c 6c 20 63 6c 69 tarting call cli
0650: 65 6e 74 3a 73 65 74 75 70 0a 3b 3b 20 65 6c 73 ent:setup.;; els
0660: 65 20 72 65 74 75 72 6e 20 23 66 20 74 6f 20 6c e return #f to l
0670: 65 74 20 74 68 65 20 63 61 6c 6c 69 6e 67 20 70 et the calling p
0680: 72 6f 63 20 6b 6e 6f 77 20 74 68 61 74 20 74 68 roc know that th
0690: 65 72 65 20 69 73 20 6e 6f 20 73 65 72 76 65 72 ere is no server
06a0: 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 0a 28 64 available.;;.(d
06b0: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 efine (rmt:get-c
06c0: 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 61 onnection-info a
06d0: 72 65 61 70 61 74 68 20 23 21 6b 65 79 20 28 61 reapath #!key (a
06e0: 72 65 61 2d 64 61 74 20 23 66 29 29 20 3b 3b 20 rea-dat #f)) ;;
06f0: 54 4f 44 4f 3a 20 70 75 73 68 20 61 72 65 61 70 TODO: push areap
0700: 61 74 68 20 64 6f 77 6e 2e 0a 20 20 28 6c 65 74 ath down.. (let
0710: 2a 20 28 28 72 75 6e 72 65 6d 6f 74 65 20 28 6f * ((runremote (o
0720: 72 20 61 72 65 61 2d 64 61 74 20 2a 72 75 6e 72 r area-dat *runr
0730: 65 6d 6f 74 65 2a 29 29 0a 09 20 28 63 69 6e 66 emote*)).. (cinf
0740: 6f 20 20 20 20 20 28 69 66 20 28 72 65 6d 6f 74 o (if (remot
0750: 65 3f 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 09 e? runremote)...
0760: 09 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 .(remote-conndat
0770: 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 09 09 23 runremote)....#
0780: 66 29 29 29 0a 09 20 20 28 69 66 20 63 69 6e 66 f))).. (if cinf
0790: 6f 0a 09 20 20 20 20 20 20 63 69 6e 66 6f 0a 09 o.. cinfo..
07a0: 20 20 20 20 20 20 28 69 66 20 28 73 65 72 76 65 (if (serve
07b0: 72 3a 63 68 65 63 6b 2d 69 66 2d 72 75 6e 6e 69 r:check-if-runni
07c0: 6e 67 20 61 72 65 61 70 61 74 68 29 0a 09 09 20 ng areapath)...
07d0: 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 20 61 (client:setup a
07e0: 72 65 61 70 61 74 68 29 0a 09 09 20 20 23 66 29 reapath)... #f)
07f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 73 65 )))..(define *se
0800: 6e 64 2d 72 65 63 65 69 76 65 2d 6d 75 74 65 78 nd-receive-mutex
0810: 2a 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 20 * (make-mutex))
0820: 3b 3b 20 73 68 6f 75 6c 64 20 68 61 76 65 20 73 ;; should have s
0830: 65 70 61 72 61 74 65 20 6d 75 74 65 78 20 70 65 eparate mutex pe
0840: 72 20 72 75 6e 2d 69 64 0a 0a 28 64 65 66 69 6e r run-id..(defin
0850: 65 20 2a 72 6d 74 2d 71 75 65 72 79 2d 6c 61 73 e *rmt-query-las
0860: 74 2d 63 61 6c 6c 2d 74 69 6d 65 2a 20 30 29 0a t-call-time* 0).
0870: 28 64 65 66 69 6e 65 20 2a 72 6d 74 2d 71 75 65 (define *rmt-que
0880: 72 79 2d 6c 61 73 74 2d 72 65 73 74 2d 74 69 6d ry-last-rest-tim
0890: 65 2a 20 30 29 20 3b 3b 20 6c 61 73 74 20 74 69 e* 0) ;; last ti
08a0: 6d 65 20 74 68 65 72 65 20 77 61 73 20 61 74 20 me there was at
08b0: 6c 65 61 73 74 20 61 20 31 2f 32 20 73 65 63 6f least a 1/2 seco
08c0: 6e 64 20 72 65 73 74 20 2d 20 67 69 76 69 6e 67 nd rest - giving
08d0: 20 6f 74 68 65 72 20 70 72 6f 63 65 73 73 65 73 other processes
08e0: 20 61 63 63 65 73 73 20 74 6f 20 74 68 65 20 64 access to the d
08f0: 62 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 69 73 b..;; NOTE: This
0900: 20 71 75 65 72 79 20 72 65 73 74 20 61 6c 67 6f query rest algo
0910: 72 79 74 68 6d 20 77 69 6c 6c 20 6e 6f 74 20 61 rythm will not a
0920: 64 61 70 74 20 74 6f 20 6c 6f 6e 67 20 71 75 65 dapt to long que
0930: 72 79 20 74 69 6d 65 73 2e 20 52 45 44 45 53 49 ry times. REDESI
0940: 47 4e 20 4e 45 45 44 45 44 2e 20 54 4f 44 4f 2e GN NEEDED. TODO.
0950: 20 46 49 58 4d 45 2e 0a 3b 3b 0a 28 64 65 66 69 FIXME..;;.(defi
0960: 6e 65 20 28 72 6d 74 3a 71 75 65 72 79 2d 72 65 ne (rmt:query-re
0970: 73 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 6e 6f st). (let* ((no
0980: 77 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 w (current-milli
0990: 73 65 63 6f 6e 64 73 29 29 29 0a 20 20 20 20 28 seconds))). (
09a0: 63 6f 6e 64 0a 20 20 20 20 20 28 28 3e 20 28 2d cond. ((> (-
09b0: 20 6e 6f 77 20 2a 72 6d 74 2d 71 75 65 72 79 2d now *rmt-query-
09c0: 6c 61 73 74 2d 63 61 6c 6c 2d 74 69 6d 65 2a 29 last-call-time*)
09d0: 20 35 30 30 29 20 20 3b 3b 20 69 74 27 73 20 62 500) ;; it's b
09e0: 65 65 6e 20 61 20 77 68 69 6c 65 20 73 69 6e 63 een a while sinc
09f0: 65 20 6c 61 73 74 20 71 75 65 72 79 20 2d 20 6e e last query - n
0a00: 6f 20 6e 65 65 64 20 74 6f 20 72 65 73 74 0a 20 o need to rest.
0a10: 20 20 20 20 20 28 73 65 74 21 20 2a 72 6d 74 2d (set! *rmt-
0a20: 71 75 65 72 79 2d 6c 61 73 74 2d 72 65 73 74 2d query-last-rest-
0a30: 74 69 6d 65 2a 20 20 6e 6f 77 29 0a 20 20 20 20 time* now).
0a40: 20 20 28 73 65 74 21 20 2a 72 6d 74 2d 71 75 65 (set! *rmt-que
0a50: 72 79 2d 6c 61 73 74 2d 63 61 6c 6c 2d 74 69 6d ry-last-call-tim
0a60: 65 2a 20 20 6e 6f 77 29 29 0a 20 20 20 20 20 28 e* now)). (
0a70: 28 3e 20 28 2d 20 6e 6f 77 20 2a 72 6d 74 2d 71 (> (- now *rmt-q
0a80: 75 65 72 79 2d 6c 61 73 74 2d 72 65 73 74 2d 74 uery-last-rest-t
0a90: 69 6d 65 2a 29 20 35 30 30 30 29 20 3b 3b 20 6e ime*) 5000) ;; n
0aa0: 6f 20 6e 61 74 75 72 61 6c 20 72 65 73 74 73 20 o natural rests
0ab0: 68 61 76 65 20 68 61 70 70 65 6e 65 64 0a 20 20 have happened.
0ac0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0ad0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
0ae0: 70 6f 72 74 2a 20 22 71 75 65 72 79 20 72 65 73 port* "query res
0af0: 74 20 6e 65 65 64 65 64 2e 20 62 6c 6f 63 6b 69 t needed. blocki
0b00: 6e 67 20 66 6f 72 20 31 2f 32 20 73 65 63 6f 6e ng for 1/2 secon
0b10: 64 2e 22 29 0a 20 20 20 20 20 20 28 74 68 72 65 d."). (thre
0b20: 61 64 2d 73 6c 65 65 70 21 20 30 2e 35 29 20 3b ad-sleep! 0.5) ;
0b30: 3b 20 66 6f 72 63 65 20 61 20 72 65 73 74 20 6f ; force a rest o
0b40: 66 20 61 20 68 61 6c 66 20 73 65 63 6f 6e 64 0a f a half second.
0b50: 20 20 20 20 20 20 28 73 65 74 21 20 2a 72 6d 74 (set! *rmt
0b60: 2d 71 75 65 72 79 2d 6c 61 73 74 2d 72 65 73 74 -query-last-rest
0b70: 2d 74 69 6d 65 2a 20 6e 6f 77 29 0a 20 20 20 20 -time* now).
0b80: 20 20 28 73 65 74 21 20 2a 72 6d 74 2d 71 75 65 (set! *rmt-que
0b90: 72 79 2d 6c 61 73 74 2d 63 61 6c 6c 2d 74 69 6d ry-last-call-tim
0ba0: 65 2a 20 6e 6f 77 29 29 0a 20 20 20 20 20 28 65 e* now)). (e
0bb0: 6c 73 65 20 3b 3b 20 73 75 66 66 69 63 69 65 6e lse ;; sufficien
0bc0: 74 20 72 65 73 74 73 20 68 61 76 65 20 6f 63 63 t rests have occ
0bd0: 75 72 72 65 64 2c 20 6a 75 73 74 20 72 65 63 6f urred, just reco
0be0: 72 64 20 74 68 65 20 6c 61 73 74 20 71 75 65 72 rd the last quer
0bf0: 79 20 74 69 6d 65 0a 20 20 20 20 20 20 28 73 65 y time. (se
0c00: 74 21 20 2a 72 6d 74 2d 71 75 65 72 79 2d 6c 61 t! *rmt-query-la
0c10: 73 74 2d 63 61 6c 6c 2d 74 69 6d 65 2a 20 6e 6f st-call-time* no
0c20: 77 29 29 29 29 29 0a 0a 3b 3b 20 52 41 20 3d 3e w)))))..;; RA =>
0c30: 20 65 2e 67 2e 20 75 73 61 67 65 20 28 72 6d 74 e.g. usage (rmt
0c40: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
0c50: 65 74 2d 76 61 72 20 23 66 20 28 6c 69 73 74 20 et-var #f (list
0c60: 76 61 72 6e 61 6d 65 29 29 0a 3b 3b 0a 28 64 65 varname)).;;.(de
0c70: 66 69 6e 65 20 28 72 6d 74 3a 73 65 6e 64 2d 72 fine (rmt:send-r
0c80: 65 63 65 69 76 65 20 63 6d 64 20 72 69 64 20 70 eceive cmd rid p
0c90: 61 72 61 6d 73 20 23 21 6b 65 79 20 28 61 74 74 arams #!key (att
0ca0: 65 6d 70 74 6e 75 6d 20 31 29 28 61 72 65 61 2d emptnum 1)(area-
0cb0: 64 61 74 20 23 66 29 29 20 3b 3b 20 73 74 61 72 dat #f)) ;; star
0cc0: 74 20 61 74 74 65 6d 70 74 6e 75 6d 20 61 74 20 t attemptnum at
0cd0: 31 20 73 6f 20 74 68 65 20 6d 6f 64 75 6c 6f 20 1 so the modulo
0ce0: 62 65 6c 6f 77 20 77 6f 72 6b 73 20 61 73 20 65 below works as e
0cf0: 78 70 65 63 74 65 64 0a 0a 20 20 23 3b 28 63 6f xpected.. #;(co
0d00: 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c mmon:telemetry-l
0d10: 6f 67 20 28 63 6f 6e 63 20 22 72 6d 74 3a 22 28 og (conc "rmt:"(
0d20: 2d 3e 73 74 72 69 6e 67 20 63 6d 64 29 29 0a 20 ->string cmd)).
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d40: 20 20 20 20 20 20 20 70 61 79 6c 6f 61 64 3a 20 payload:
0d50: 60 28 28 72 69 64 20 2e 20 2c 72 69 64 29 0a 20 `((rid . ,rid).
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 20 20 28 70 61 72 61 6d 73 20 2e 20 2c 70 61 72 (params . ,par
0d90: 61 6d 73 29 29 29 0a 20 20 28 69 66 20 28 6e 6f ams))). (if (no
0da0: 74 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e 66 69 t (equal? (confi
0db0: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
0dc0: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 71 gdat* "setup" "q
0dd0: 75 65 72 79 2d 72 65 73 74 22 29 20 22 6e 6f 22 uery-rest") "no"
0de0: 29 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 71 75 )). (rmt:qu
0df0: 65 72 79 2d 72 65 73 74 29 29 0a 20 20 0a 20 20 ery-rest)). .
0e00: 28 69 66 20 28 3e 20 61 74 74 65 6d 70 74 6e 75 (if (> attemptnu
0e10: 6d 20 32 29 0a 20 20 20 20 20 20 28 64 65 62 75 m 2). (debu
0e20: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
0e30: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e lt-log-port* "IN
0e40: 46 4f 3a 20 61 74 74 65 6d 70 74 6e 75 6d 20 69 FO: attemptnum i
0e50: 6e 20 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 n rmt:send-recei
0e60: 76 65 20 69 73 20 22 20 61 74 74 65 6d 70 74 6e ve is " attemptn
0e70: 75 6d 29 29 0a 20 20 20 20 0a 20 20 28 63 6f 6e um)). . (con
0e80: 64 0a 20 20 20 28 28 3e 20 61 74 74 65 6d 70 74 d. ((> attempt
0e90: 6e 75 6d 20 32 29 20 28 74 68 72 65 61 64 2d 73 num 2) (thread-s
0ea0: 6c 65 65 70 21 20 30 2e 30 35 29 29 0a 20 20 20 leep! 0.05)).
0eb0: 28 28 3e 20 61 74 74 65 6d 70 74 6e 75 6d 20 31 ((> attemptnum 1
0ec0: 30 29 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 0) (thread-sleep
0ed0: 21 20 30 2e 35 29 29 0a 20 20 20 28 28 3e 20 61 ! 0.5)). ((> a
0ee0: 74 74 65 6d 70 74 6e 75 6d 20 32 30 29 20 28 74 ttemptnum 20) (t
0ef0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 29 hread-sleep! 1))
0f00: 29 0a 20 20 28 69 66 20 28 61 6e 64 20 28 3e 20 ). (if (and (>
0f10: 61 74 74 65 6d 70 74 6e 75 6d 20 35 29 20 28 3d attemptnum 5) (=
0f20: 20 30 20 28 6d 6f 64 75 6c 6f 20 61 74 74 65 6d 0 (modulo attem
0f30: 70 74 6e 75 6d 20 31 35 29 29 29 20 20 0a 20 20 ptnum 15))) .
0f40: 20 20 28 62 65 67 69 6e 20 28 73 65 72 76 65 72 (begin (server
0f50: 3a 72 75 6e 20 2a 74 6f 70 70 61 74 68 2a 29 20 :run *toppath*)
0f60: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 33 (thread-sleep! 3
0f70: 29 29 29 20 0a 20 20 0a 20 20 0a 20 20 3b 3b 44 ))) . . . ;;D
0f80: 4f 54 20 64 69 67 72 61 70 68 20 6d 65 67 61 74 OT digraph megat
0f90: 65 73 74 5f 73 74 61 74 65 5f 73 74 61 74 75 73 est_state_status
0fa0: 20 7b 0a 20 20 3b 3b 44 4f 54 20 20 20 72 61 6e {. ;;DOT ran
0fb0: 6b 73 65 70 3d 30 3b 0a 20 20 3b 3b 44 4f 54 20 ksep=0;. ;;DOT
0fc0: 20 20 2f 2f 20 72 61 6e 6b 64 69 72 3d 4c 52 3b // rankdir=LR;
0fd0: 0a 20 20 3b 3b 44 4f 54 20 20 20 6e 6f 64 65 20 . ;;DOT node
0fe0: 5b 73 68 61 70 65 3d 22 62 6f 78 22 5d 3b 0a 20 [shape="box"];.
0ff0: 20 3b 3b 44 4f 54 20 22 72 6d 74 3a 73 65 6e 64 ;;DOT "rmt:send
1000: 2d 72 65 63 65 69 76 65 22 20 2d 3e 20 4d 55 54 -receive" -> MUT
1010: 45 58 4c 4f 43 4b 3b 0a 20 20 3b 3b 44 4f 54 20 EXLOCK;. ;;DOT
1020: 7b 20 65 64 67 65 20 5b 73 74 79 6c 65 3d 69 6e { edge [style=in
1030: 76 69 73 5d 3b 22 63 61 73 65 20 31 22 20 2d 3e vis];"case 1" ->
1040: 20 22 63 61 73 65 20 32 22 20 2d 3e 20 22 63 61 "case 2" -> "ca
1050: 73 65 20 33 22 20 2d 3e 20 22 63 61 73 65 20 34 se 3" -> "case 4
1060: 22 20 2d 3e 20 22 63 61 73 65 20 35 22 20 2d 3e " -> "case 5" ->
1070: 20 22 63 61 73 65 20 36 22 20 2d 3e 20 22 63 61 "case 6" -> "ca
1080: 73 65 20 37 22 20 2d 3e 20 22 63 61 73 65 20 38 se 7" -> "case 8
1090: 22 20 2d 3e 20 22 63 61 73 65 20 39 22 20 2d 3e " -> "case 9" ->
10a0: 20 22 63 61 73 65 20 31 30 22 20 2d 3e 20 22 63 "case 10" -> "c
10b0: 61 73 65 20 31 31 22 3b 20 7d 0a 20 20 3b 3b 20 ase 11"; }. ;;
10c0: 64 6f 20 61 6c 6c 20 74 68 65 20 70 72 65 70 20 do all the prep
10d0: 6c 6f 63 6b 65 64 20 75 6e 64 65 72 20 74 68 65 locked under the
10e0: 20 72 6d 74 2d 6d 75 74 65 78 0a 20 20 28 6d 75 rmt-mutex. (mu
10f0: 74 65 78 2d 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d tex-lock! *rmt-m
1100: 75 74 65 78 2a 29 0a 20 20 0a 20 20 3b 3b 20 31 utex*). . ;; 1
1110: 2e 20 63 68 65 63 6b 20 69 66 20 73 65 72 76 65 . check if serve
1120: 72 20 69 73 20 73 74 61 72 74 65 64 20 49 46 46 r is started IFF
1130: 20 63 6d 64 20 69 73 20 61 20 77 72 69 74 65 20 cmd is a write
1140: 4f 52 20 69 66 20 77 65 20 61 72 65 20 6e 6f 74 OR if we are not
1150: 20 6f 6e 20 74 68 65 20 68 6f 6d 65 68 6f 73 74 on the homehost
1160: 2c 20 73 74 6f 72 65 20 69 6e 20 72 75 6e 72 65 , store in runre
1170: 6d 6f 74 65 0a 20 20 3b 3b 20 32 2e 20 63 68 65 mote. ;; 2. che
1180: 63 6b 20 74 68 65 20 61 67 65 20 6f 66 20 74 68 ck the age of th
1190: 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 2e 20 72 e connections. r
11a0: 65 66 72 65 73 68 20 74 68 65 20 63 6f 6e 6e 65 efresh the conne
11b0: 63 74 69 6f 6e 20 69 66 20 69 74 20 69 73 20 6f ction if it is o
11c0: 6c 64 65 72 20 74 68 61 6e 20 74 69 6d 65 6f 75 lder than timeou
11d0: 74 2d 32 30 20 73 65 63 6f 6e 64 73 2e 0a 20 20 t-20 seconds..
11e0: 3b 3b 20 33 2e 20 64 6f 20 74 68 65 20 71 75 65 ;; 3. do the que
11f0: 72 79 2c 20 69 66 20 6f 6e 20 68 6f 6d 65 68 6f ry, if on homeho
1200: 73 74 20 75 73 65 20 6c 6f 63 61 6c 20 61 63 63 st use local acc
1210: 65 73 73 0a 20 20 3b 3b 0a 20 20 28 6c 65 74 2a ess. ;;. (let*
1220: 20 28 28 73 74 61 72 74 2d 74 69 6d 65 20 20 20 ((start-time
1230: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
1240: 73 29 29 20 3b 3b 20 73 6e 61 70 73 68 6f 74 20 s)) ;; snapshot
1250: 74 69 6d 65 20 73 6f 20 61 6c 6c 20 75 73 65 20 time so all use
1260: 63 61 73 65 73 20 67 65 74 20 73 61 6d 65 20 76 cases get same v
1270: 61 6c 75 65 0a 20 20 20 20 20 20 20 20 20 28 61 alue. (a
1280: 72 65 61 70 61 74 68 20 20 20 20 20 20 2a 74 6f reapath *to
1290: 70 70 61 74 68 2a 29 3b 3b 20 54 4f 44 4f 20 2d ppath*);; TODO -
12a0: 20 72 65 73 6f 6c 76 65 20 66 72 6f 6d 20 64 62 resolve from db
12b0: 73 74 72 75 63 74 20 74 6f 20 62 65 20 63 6f 6d struct to be com
12c0: 70 61 74 69 62 6c 65 20 77 69 74 68 20 6d 75 6c patible with mul
12d0: 74 69 70 6c 65 20 61 72 65 61 73 0a 09 20 28 72 tiple areas.. (r
12e0: 75 6e 72 65 6d 6f 74 65 20 20 20 20 20 28 6f 72 unremote (or
12f0: 20 61 72 65 61 2d 64 61 74 0a 09 09 09 20 20 20 area-dat....
1300: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 20 *runremote*)).
1310: 20 20 20 20 20 20 20 20 28 61 74 74 65 6d 70 74 (attempt
1320: 6e 75 6d 20 20 20 20 28 2b 20 31 20 61 74 74 65 num (+ 1 atte
1330: 6d 70 74 6e 75 6d 29 29 0a 09 20 28 72 65 61 64 mptnum)).. (read
1340: 6f 6e 6c 79 2d 6d 6f 64 65 20 28 72 6d 74 6d 6f only-mode (rmtmo
1350: 64 3a 63 61 6c 63 2d 72 6f 2d 6d 6f 64 65 20 72 d:calc-ro-mode r
1360: 75 6e 72 65 6d 6f 74 65 20 2a 74 6f 70 70 61 74 unremote *toppat
1370: 68 2a 29 29 29 0a 0a 20 20 20 20 3b 3b 20 44 4f h*))).. ;; DO
1380: 54 20 49 4e 49 54 5f 52 55 4e 52 45 4d 4f 54 45 T INIT_RUNREMOTE
1390: 3b 20 2f 2f 20 6c 65 61 76 69 6e 67 20 6f 66 66 ; // leaving off
13a0: 20 2d 20 64 6f 65 73 6e 27 74 20 72 65 61 6c 6c - doesn't reall
13b0: 79 20 61 64 64 20 74 6f 20 74 68 65 20 63 6c 61 y add to the cla
13c0: 72 69 74 79 0a 20 20 20 20 3b 3b 20 44 4f 54 20 rity. ;; DOT
13d0: 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 49 4e 49 MUTEXLOCK -> INI
13e0: 54 5f 52 55 4e 52 45 4d 4f 54 45 20 5b 6c 61 62 T_RUNREMOTE [lab
13f0: 65 6c 3d 22 6e 6f 20 72 65 6d 6f 74 65 3f 22 5d el="no remote?"]
1400: 3b 0a 20 20 20 20 3b 3b 20 44 4f 54 20 49 4e 49 ;. ;; DOT INI
1410: 54 5f 52 55 4e 52 45 4d 4f 54 45 20 2d 3e 20 4d T_RUNREMOTE -> M
1420: 55 54 45 58 4c 4f 43 4b 3b 0a 20 20 20 20 3b 3b UTEXLOCK;. ;;
1430: 20 65 6e 73 75 72 65 20 77 65 20 68 61 76 65 20 ensure we have
1440: 61 20 72 65 63 6f 72 64 20 66 6f 72 20 6f 75 72 a record for our
1450: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 66 6f 72 20 connection for
1460: 67 69 76 65 6e 20 61 72 65 61 0a 20 20 20 20 28 given area. (
1470: 69 66 20 28 6e 6f 74 20 72 75 6e 72 65 6d 6f 74 if (not runremot
1480: 65 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e)
1490: 20 20 20 20 20 3b 3b 20 63 61 6e 20 72 65 6d 6f ;; can remo
14a0: 76 65 20 74 68 69 73 20 6f 6e 65 2e 20 73 68 6f ve this one. sho
14b0: 75 6c 64 20 6e 65 76 65 72 20 67 65 74 20 68 65 uld never get he
14c0: 72 65 2e 20 20 20 20 20 20 20 20 20 0a 09 28 62 re. ..(b
14d0: 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 2a 72 egin.. (set! *r
14e0: 75 6e 72 65 6d 6f 74 65 2a 20 28 6d 61 6b 65 2d unremote* (make-
14f0: 72 65 6d 6f 74 65 29 29 0a 09 20 20 28 73 65 74 remote)).. (set
1500: 21 20 72 75 6e 72 65 6d 6f 74 65 20 20 20 2a 72 ! runremote *r
1510: 75 6e 72 65 6d 6f 74 65 2a 29 29 29 20 3b 3b 20 unremote*))) ;;
1520: 6e 65 77 20 72 75 6e 72 65 6d 6f 74 65 20 77 69 new runremote wi
1530: 6c 6c 20 63 6f 6d 65 20 66 72 6f 6d 20 74 68 69 ll come from thi
1540: 73 20 6f 6e 20 6e 65 78 74 20 69 74 65 72 61 74 s on next iterat
1550: 69 6f 6e 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 ion. . ;;
1560: 44 4f 54 20 53 45 54 5f 48 4f 4d 45 48 4f 53 54 DOT SET_HOMEHOST
1570: 3b 20 2f 2f 20 6c 65 61 76 69 6e 67 20 6f 66 66 ; // leaving off
1580: 20 2d 20 64 6f 65 73 6e 27 74 20 72 65 61 6c 6c - doesn't reall
1590: 79 20 61 64 64 20 74 6f 20 74 68 65 20 63 6c 61 y add to the cla
15a0: 72 69 74 79 0a 20 20 20 20 3b 3b 20 44 4f 54 20 rity. ;; DOT
15b0: 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 53 45 54 MUTEXLOCK -> SET
15c0: 5f 48 4f 4d 45 48 4f 53 54 20 5b 6c 61 62 65 6c _HOMEHOST [label
15d0: 3d 22 6e 6f 20 68 6f 6d 65 68 6f 73 74 3f 22 5d ="no homehost?"]
15e0: 3b 0a 20 20 20 20 3b 3b 20 44 4f 54 20 53 45 54 ;. ;; DOT SET
15f0: 5f 48 4f 4d 45 48 4f 53 54 20 2d 3e 20 4d 55 54 _HOMEHOST -> MUT
1600: 45 58 4c 4f 43 4b 3b 0a 20 20 20 20 3b 3b 20 65 EXLOCK;. ;; e
1610: 6e 73 75 72 65 20 77 65 20 68 61 76 65 20 61 20 nsure we have a
1620: 68 6f 6d 65 68 6f 73 74 20 72 65 63 6f 72 64 0a homehost record.
1630: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 70 61 (if (not (pa
1640: 69 72 3f 20 28 72 65 6d 6f 74 65 2d 68 68 2d 64 ir? (remote-hh-d
1650: 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 29 20 at runremote)))
1660: 20 3b 3b 20 6e 6f 74 20 6f 6e 20 68 6f 6d 65 68 ;; not on homeh
1670: 6f 73 74 0a 09 28 74 68 72 65 61 64 2d 73 6c 65 ost..(thread-sle
1680: 65 70 21 20 30 2e 31 29 20 3b 3b 20 73 69 6e 63 ep! 0.1) ;; sinc
1690: 65 20 77 65 20 73 68 6f 75 6c 64 6e 27 74 20 67 e we shouldn't g
16a0: 65 74 20 68 65 72 65 2c 20 64 65 6c 61 79 20 61 et here, delay a
16b0: 20 6c 69 74 74 6c 65 0a 09 28 72 65 6d 6f 74 65 little..(remote
16c0: 2d 68 68 2d 64 61 74 2d 73 65 74 21 20 72 75 6e -hh-dat-set! run
16d0: 72 65 6d 6f 74 65 20 28 63 6f 6d 6d 6f 6e 3a 67 remote (common:g
16e0: 65 74 2d 68 6f 6d 65 68 6f 73 74 29 29 29 0a 20 et-homehost))).
16f0: 20 20 20 0a 20 20 20 20 3b 3b 28 70 72 69 6e 74 . ;;(print
1700: 20 22 42 42 3e 20 72 65 61 64 6f 6e 6c 79 2d 6d "BB> readonly-m
1710: 6f 64 65 20 69 73 20 22 72 65 61 64 6f 6e 6c 79 ode is "readonly
1720: 2d 6d 6f 64 65 22 20 64 62 66 69 6c 65 20 69 73 -mode" dbfile is
1730: 20 22 64 62 66 69 6c 65 29 0a 20 20 20 20 28 63 "dbfile). (c
1740: 6f 6e 64 0a 20 20 20 20 20 3b 3b 44 4f 54 20 45 ond. ;;DOT E
1750: 58 49 54 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 XIT;. ;;DOT
1760: 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 45 58 49 MUTEXLOCK -> EXI
1770: 54 20 5b 6c 61 62 65 6c 3d 22 3e 20 31 35 20 61 T [label="> 15 a
1780: 74 74 65 6d 70 74 73 22 5d 3b 20 7b 72 61 6e 6b ttempts"]; {rank
1790: 3d 73 61 6d 65 20 22 63 61 73 65 20 31 22 20 22 =same "case 1" "
17a0: 45 58 49 54 22 20 7d 0a 20 20 20 20 20 3b 3b 20 EXIT" }. ;;
17b0: 67 69 76 65 20 75 70 20 69 66 20 6d 6f 72 65 20 give up if more
17c0: 74 68 61 6e 20 31 35 30 20 61 74 74 65 6d 70 74 than 150 attempt
17d0: 73 0a 20 20 20 20 20 28 28 3e 20 61 74 74 65 6d s. ((> attem
17e0: 70 74 6e 75 6d 20 31 35 30 29 0a 20 20 20 20 20 ptnum 150).
17f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
1800: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
1810: 74 2a 20 22 45 52 52 4f 52 3a 20 31 35 30 20 74 t* "ERROR: 150 t
1820: 72 69 65 73 20 74 6f 20 73 74 61 72 74 2f 63 6f ries to start/co
1830: 6e 6e 65 63 74 20 74 6f 20 73 65 72 76 65 72 2e nnect to server.
1840: 20 47 69 76 69 6e 67 20 75 70 2e 22 29 0a 20 20 Giving up.").
1850: 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 0a 20 (exit 1))..
1860: 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 32 20 ;;DOT CASE2
1870: 5b 6c 61 62 65 6c 3d 22 6c 6f 63 61 6c 5c 6e 72 [label="local\nr
1880: 65 61 64 6f 6e 6c 79 5c 6e 71 75 65 72 79 22 5d eadonly\nquery"]
1890: 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 ;. ;;DOT MUT
18a0: 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 32 3b EXLOCK -> CASE2;
18b0: 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 63 61 73 {rank=same "cas
18c0: 65 20 32 22 20 43 41 53 45 32 7d 0a 20 20 20 20 e 2" CASE2}.
18d0: 20 3b 3b 44 4f 54 20 43 41 53 45 32 20 2d 3e 20 ;;DOT CASE2 ->
18e0: 22 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c "rmt:open-qry-cl
18f0: 6f 73 65 2d 6c 6f 63 61 6c 6c 79 22 3b 0a 20 20 ose-locally";.
1900: 20 20 20 3b 3b 20 72 65 61 64 6f 6e 6c 79 20 6d ;; readonly m
1910: 6f 64 65 2c 20 72 65 61 64 20 72 65 71 75 65 73 ode, read reques
1920: 74 2d 20 20 68 61 6e 64 6c 65 20 69 74 20 2d 20 t- handle it -
1930: 63 61 73 65 20 32 0a 20 20 20 20 20 28 28 61 6e case 2. ((an
1940: 64 20 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 0a d readonly-mode.
1950: 20 20 20 20 20 20 20 20 20 20 20 28 6d 65 6d 62 (memb
1960: 65 72 20 63 6d 64 20 61 70 69 3a 72 65 61 64 2d er cmd api:read-
1970: 6f 6e 6c 79 2d 71 75 65 72 69 65 73 29 29 20 0a only-queries)) .
1980: 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c (mutex-unl
1990: 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a ock! *rmt-mutex*
19a0: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
19b0: 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 rint-info 12 *de
19c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
19d0: 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 "rmt:send-receiv
19e0: 65 2c 20 63 61 73 65 20 32 22 29 0a 20 20 20 20 e, case 2").
19f0: 20 20 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d (rmt:open-qry-
1a00: 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 6d close-locally cm
1a10: 64 20 30 20 70 61 72 61 6d 73 29 0a 20 20 20 20 d 0 params).
1a20: 20 20 29 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 20 ).. ;;DOT
1a30: 43 41 53 45 33 20 5b 6c 61 62 65 6c 3d 22 77 72 CASE3 [label="wr
1a40: 69 74 65 20 69 6e 5c 6e 72 65 61 64 2d 6f 6e 6c ite in\nread-onl
1a50: 79 20 6d 6f 64 65 22 5d 3b 0a 20 20 20 20 20 3b y mode"];. ;
1a60: 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d ;DOT MUTEXLOCK -
1a70: 3e 20 43 41 53 45 33 20 5b 6c 61 62 65 6c 3d 22 > CASE3 [label="
1a80: 72 65 61 64 6f 6e 6c 79 5c 6e 6d 6f 64 65 3f 22 readonly\nmode?"
1a90: 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 63 ]; {rank=same "c
1aa0: 61 73 65 20 33 22 20 43 41 53 45 33 7d 0a 20 20 ase 3" CASE3}.
1ab0: 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 33 20 2d ;;DOT CASE3 -
1ac0: 3e 20 22 23 66 22 3b 0a 20 20 20 20 20 3b 3b 20 > "#f";. ;;
1ad0: 72 65 61 64 6f 6e 6c 79 20 6d 6f 64 65 2c 20 77 readonly mode, w
1ae0: 72 69 74 65 20 72 65 71 75 65 73 74 2e 20 20 44 rite request. D
1af0: 6f 20 6e 6f 74 68 69 6e 67 2c 20 72 65 74 75 72 o nothing, retur
1b00: 6e 20 23 66 0a 20 20 20 20 20 28 72 65 61 64 6f n #f. (reado
1b10: 6e 6c 79 2d 6d 6f 64 65 20 28 65 78 74 72 61 73 nly-mode (extras
1b20: 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 2a -readonly-mode *
1b30: 72 6d 74 2d 6d 75 74 65 78 2a 20 2a 64 65 66 61 rmt-mutex* *defa
1b40: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 63 6d ult-log-port* cm
1b50: 64 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 d params))..
1b60: 20 3b 3b 20 54 68 69 73 20 62 6c 6f 63 6b 20 77 ;; This block w
1b70: 61 73 20 66 6f 72 20 70 72 65 2d 65 6d 70 74 69 as for pre-empti
1b80: 76 65 6c 79 20 72 65 73 65 74 74 69 6e 67 20 74 vely resetting t
1b90: 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 69 66 he connection if
1ba0: 20 74 68 65 72 65 20 68 61 64 20 62 65 65 6e 20 there had been
1bb0: 6e 6f 20 63 6f 6d 6d 75 6e 69 63 61 74 69 6f 6e no communication
1bc0: 20 66 6f 72 20 73 6f 6d 65 20 74 69 6d 65 2e 0a for some time..
1bd0: 20 20 20 20 20 3b 3b 20 49 20 64 6f 6e 27 74 20 ;; I don't
1be0: 74 68 69 6e 6b 20 69 74 20 61 64 64 73 20 61 6e think it adds an
1bf0: 79 20 76 61 6c 75 65 2e 20 49 66 20 74 68 65 20 y value. If the
1c00: 73 65 72 76 65 72 20 69 73 20 6e 6f 74 20 74 68 server is not th
1c10: 65 72 65 2c 20 6a 75 73 74 20 66 61 69 6c 20 61 ere, just fail a
1c20: 6e 64 20 73 74 61 72 74 20 61 20 6e 65 77 20 63 nd start a new c
1c30: 6f 6e 6e 65 63 74 69 6f 6e 2e 0a 20 20 20 20 20 onnection..
1c40: 3b 3b 20 61 6c 73 6f 2c 20 74 68 65 20 65 78 70 ;; also, the exp
1c50: 69 72 65 2d 74 69 6d 65 20 63 61 6c 63 75 6c 61 ire-time calcula
1c60: 74 69 6f 6e 20 6d 69 67 68 74 20 6e 6f 74 20 62 tion might not b
1c70: 65 20 63 6f 72 72 65 63 74 2e 20 57 65 20 77 61 e correct. We wa
1c80: 6e 74 2c 20 74 69 6d 65 2d 73 69 6e 63 65 2d 6c nt, time-since-l
1c90: 61 73 74 2d 73 65 72 76 65 72 2d 61 63 63 65 73 ast-server-acces
1ca0: 73 20 3e 20 28 73 65 72 76 65 72 3a 67 65 74 2d s > (server:get-
1cb0: 74 69 6d 65 6f 75 74 29 0a 20 20 20 20 20 3b 3b timeout). ;;
1cc0: 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 . ;;DOT CASE
1cd0: 34 20 5b 6c 61 62 65 6c 3d 22 72 65 73 65 74 5c 4 [label="reset\
1ce0: 6e 63 6f 6e 6e 65 63 74 69 6f 6e 22 5d 3b 0a 20 nconnection"];.
1cf0: 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c ;;DOT MUTEXL
1d00: 4f 43 4b 20 2d 3e 20 43 41 53 45 34 20 5b 6c 61 OCK -> CASE4 [la
1d10: 62 65 6c 3d 22 68 61 76 65 20 63 6f 6e 6e 65 63 bel="have connec
1d20: 74 69 6f 6e 2c 5c 6e 6c 61 73 74 5f 61 63 63 65 tion,\nlast_acce
1d30: 73 73 20 3e 20 65 78 70 69 72 65 5f 74 69 6d 65 ss > expire_time
1d40: 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 "]; {rank=same "
1d50: 63 61 73 65 20 34 22 20 43 41 53 45 34 7d 0a 20 case 4" CASE4}.
1d60: 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 34 20 ;;DOT CASE4
1d70: 2d 3e 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 -> "rmt:send-rec
1d80: 65 69 76 65 22 3b 0a 20 20 20 20 20 3b 3b 20 72 eive";. ;; r
1d90: 65 73 65 74 20 74 68 65 20 63 6f 6e 6e 65 63 74 eset the connect
1da0: 69 6f 6e 20 69 66 20 69 74 20 68 61 73 20 62 65 ion if it has be
1db0: 65 6e 20 75 6e 75 73 65 64 20 74 6f 6f 20 6c 6f en unused too lo
1dc0: 6e 67 0a 20 20 20 20 20 28 28 61 6e 64 20 72 75 ng. ((and ru
1dd0: 6e 72 65 6d 6f 74 65 0a 20 20 20 20 20 20 20 20 nremote.
1de0: 20 20 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 (remote-connd
1df0: 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 20 at runremote)..
1e00: 20 20 28 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 (> (current-se
1e10: 63 6f 6e 64 73 29 20 3b 3b 20 69 66 20 69 74 20 conds) ;; if it
1e20: 68 61 73 20 62 65 65 6e 20 6d 6f 72 65 20 74 68 has been more th
1e30: 61 6e 20 73 65 72 76 65 72 2d 74 69 6d 65 6f 75 an server-timeou
1e40: 74 20 73 65 63 6f 6e 64 73 20 73 69 6e 63 65 20 t seconds since
1e50: 6c 61 73 74 20 63 6f 6e 74 61 63 74 2c 20 63 6c last contact, cl
1e60: 6f 73 65 20 74 68 69 73 20 63 6f 6e 6e 65 63 74 ose this connect
1e70: 69 6f 6e 20 61 6e 64 20 73 74 61 72 74 20 61 20 ion and start a
1e80: 6e 65 77 20 6f 6e 0a 09 20 20 20 20 20 20 28 2b new on.. (+
1e90: 20 28 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 (http-transport
1ea0: 3a 73 65 72 76 65 72 2d 64 61 74 2d 67 65 74 2d :server-dat-get-
1eb0: 6c 61 73 74 2d 61 63 63 65 73 73 20 28 72 65 6d last-access (rem
1ec0: 6f 74 65 2d 63 6f 6e 6e 64 61 74 20 72 75 6e 72 ote-conndat runr
1ed0: 65 6d 6f 74 65 29 29 0a 09 09 20 28 72 65 6d 6f emote))... (remo
1ee0: 74 65 2d 73 65 72 76 65 72 2d 74 69 6d 65 6f 75 te-server-timeou
1ef0: 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 29 29 0a t runremote)))).
1f00: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
1f10: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
1f20: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6f lt-log-port* "Co
1f30: 6e 6e 65 63 74 69 6f 6e 20 74 6f 20 22 20 28 72 nnection to " (r
1f40: 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 6c emote-server-url
1f50: 20 72 75 6e 72 65 6d 6f 74 65 29 20 22 20 65 78 runremote) " ex
1f60: 70 69 72 65 64 20 64 75 65 20 74 6f 20 6e 6f 20 pired due to no
1f70: 61 63 63 65 73 73 65 73 2c 20 66 6f 72 63 69 6e accesses, forcin
1f80: 67 20 6e 65 77 20 63 6f 6e 6e 65 63 74 69 6f 6e g new connection
1f90: 2e 22 29 0a 20 20 20 20 20 20 28 68 74 74 70 2d ."). (http-
1fa0: 74 72 61 6e 73 70 6f 72 74 3a 63 6c 6f 73 65 2d transport:close-
1fb0: 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 61 72 65 61 connections area
1fc0: 2d 64 61 74 3a 20 72 75 6e 72 65 6d 6f 74 65 29 -dat: runremote)
1fd0: 0a 20 20 20 20 20 20 28 72 65 6d 6f 74 65 2d 63 . (remote-c
1fe0: 6f 6e 6e 64 61 74 2d 73 65 74 21 20 72 75 6e 72 onndat-set! runr
1ff0: 65 6d 6f 74 65 20 23 66 29 20 3b 3b 20 69 6e 76 emote #f) ;; inv
2000: 61 6c 69 64 61 74 65 20 74 68 65 20 63 6f 6e 6e alidate the conn
2010: 65 63 74 69 6f 6e 2c 20 74 68 75 73 20 66 6f 72 ection, thus for
2020: 63 69 6e 67 20 61 20 6e 65 77 20 63 6f 6e 6e 65 cing a new conne
2030: 63 74 69 6f 6e 2e 0a 20 20 20 20 20 20 28 6d 75 ction.. (mu
2040: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 tex-unlock! *rmt
2050: 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 28 -mutex*). (
2060: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
2070: 20 63 6d 64 20 72 69 64 20 70 61 72 61 6d 73 20 cmd rid params
2080: 61 74 74 65 6d 70 74 6e 75 6d 3a 20 61 74 74 65 attemptnum: atte
2090: 6d 70 74 6e 75 6d 29 29 0a 20 20 20 20 20 0a 20 mptnum)). .
20a0: 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 35 20 ;;DOT CASE5
20b0: 5b 6c 61 62 65 6c 3d 22 6c 6f 63 61 6c 5c 6e 72 [label="local\nr
20c0: 65 61 64 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f ead"];. ;;DO
20d0: 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 T MUTEXLOCK -> C
20e0: 41 53 45 35 20 5b 6c 61 62 65 6c 3d 22 73 65 72 ASE5 [label="ser
20f0: 76 65 72 20 6e 6f 74 20 72 65 71 75 69 72 65 64 ver not required
2100: 2c 5c 6e 6f 6e 20 68 6f 6d 65 68 6f 73 74 2c 5c ,\non homehost,\
2110: 6e 72 65 61 64 2d 6f 6e 6c 79 20 71 75 65 72 79 nread-only query
2120: 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 "]; {rank=same "
2130: 63 61 73 65 20 35 22 20 43 41 53 45 35 7d 3b 0a case 5" CASE5};.
2140: 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 35 ;;DOT CASE5
2150: 20 2d 3e 20 22 72 6d 74 3a 6f 70 65 6e 2d 71 72 -> "rmt:open-qr
2160: 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 22 y-close-locally"
2170: 3b 0a 0a 20 20 20 20 20 3b 3b 20 6f 6e 20 68 6f ;.. ;; on ho
2180: 6d 65 68 6f 73 74 20 61 6e 64 20 74 68 69 73 20 mehost and this
2190: 69 73 20 61 20 72 65 61 64 0a 20 20 20 20 20 28 is a read. (
21a0: 28 61 6e 64 20 28 6e 6f 74 20 28 72 65 6d 6f 74 (and (not (remot
21b0: 65 2d 66 6f 72 63 65 2d 73 65 72 76 65 72 20 72 e-force-server r
21c0: 75 6e 72 65 6d 6f 74 65 29 29 20 3b 3b 20 68 6f unremote)) ;; ho
21d0: 6e 6f 72 20 66 6f 72 63 65 64 20 75 73 65 20 6f nor forced use o
21e0: 66 20 73 65 72 76 65 72 2c 20 69 2e 65 2e 20 73 f server, i.e. s
21f0: 65 72 76 65 72 20 4e 4f 54 20 72 65 71 75 69 72 erver NOT requir
2200: 65 64 0a 09 20 20 20 28 63 64 72 20 28 72 65 6d ed.. (cdr (rem
2210: 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e 72 65 ote-hh-dat runre
2220: 6d 6f 74 65 29 29 20 20 20 20 20 20 20 3b 3b 20 mote)) ;;
2230: 6f 6e 20 68 6f 6d 65 68 6f 73 74 0a 20 20 20 20 on homehost.
2240: 20 20 20 20 20 20 20 28 6d 65 6d 62 65 72 20 63 (member c
2250: 6d 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 md api:read-only
2260: 2d 71 75 65 72 69 65 73 29 29 20 20 20 3b 3b 20 -queries)) ;;
2270: 74 68 69 73 20 69 73 20 61 20 72 65 61 64 0a 20 this is a read.
2280: 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f (mutex-unlo
2290: 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 ck! *rmt-mutex*)
22a0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
22b0: 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 66 int-info 12 *def
22c0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
22d0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
22e0: 2c 20 63 61 73 65 20 20 35 22 29 0a 20 20 20 20 , case 5").
22f0: 20 20 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d (rmt:open-qry-
2300: 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 6d close-locally cm
2310: 64 20 30 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 d 0 params))..
2320: 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 36 20 5b ;;DOT CASE6 [
2330: 6c 61 62 65 6c 3d 22 69 6e 69 74 5c 6e 72 65 6d label="init\nrem
2340: 6f 74 65 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f ote"];. ;;DO
2350: 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 T MUTEXLOCK -> C
2360: 41 53 45 36 20 5b 6c 61 62 65 6c 3d 22 6f 6e 20 ASE6 [label="on
2370: 68 6f 6d 65 68 6f 73 74 2c 5c 6e 77 72 69 74 65 homehost,\nwrite
2380: 20 71 75 65 72 79 2c 5c 6e 68 61 76 65 20 73 65 query,\nhave se
2390: 72 76 65 72 2c 5c 6e 63 61 6e 27 74 20 72 65 61 rver,\ncan't rea
23a0: 63 68 20 69 74 22 5d 3b 20 7b 72 61 6e 6b 3d 73 ch it"]; {rank=s
23b0: 61 6d 65 20 22 63 61 73 65 20 36 22 20 43 41 53 ame "case 6" CAS
23c0: 45 36 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 E6};. ;;DOT
23d0: 43 41 53 45 36 20 2d 3e 20 22 72 6d 74 3a 73 65 CASE6 -> "rmt:se
23e0: 6e 64 2d 72 65 63 65 69 76 65 22 3b 0a 20 20 20 nd-receive";.
23f0: 20 20 3b 3b 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 ;; on homehost
2400: 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 20 77 and this is a w
2410: 72 69 74 65 2c 20 77 65 20 61 6c 72 65 61 64 79 rite, we already
2420: 20 68 61 76 65 20 61 20 73 65 72 76 65 72 2c 20 have a server,
2430: 62 75 74 20 73 65 72 76 65 72 20 68 61 73 20 64 but server has d
2440: 69 65 64 0a 20 20 20 20 20 28 28 61 6e 64 20 28 ied. ((and (
2450: 63 64 72 20 28 72 65 6d 6f 74 65 2d 68 68 2d 64 cdr (remote-hh-d
2460: 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 20 20 at runremote))
2470: 20 20 20 20 20 20 20 20 20 3b 3b 20 6f 6e 20 68 ;; on h
2480: 6f 6d 65 68 6f 73 74 0a 20 20 20 20 20 20 20 20 omehost.
2490: 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 (not (member
24a0: 63 6d 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c cmd api:read-onl
24b0: 79 2d 71 75 65 72 69 65 73 29 29 20 20 3b 3b 20 y-queries)) ;;
24c0: 74 68 69 73 20 69 73 20 61 20 77 72 69 74 65 0a this is a write.
24d0: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 6d 6f (remo
24e0: 74 65 2d 73 65 72 76 65 72 2d 75 72 6c 20 72 75 te-server-url ru
24f0: 6e 72 65 6d 6f 74 65 29 20 20 20 20 20 20 20 20 nremote)
2500: 20 20 20 20 20 3b 3b 20 68 61 76 65 20 61 20 73 ;; have a s
2510: 65 72 76 65 72 0a 20 20 20 20 20 20 20 20 20 20 erver.
2520: 20 28 6e 6f 74 20 28 73 65 72 76 65 72 3a 70 69 (not (server:pi
2530: 6e 67 20 28 72 65 6d 6f 74 65 2d 73 65 72 76 65 ng (remote-serve
2540: 72 2d 75 72 6c 20 72 75 6e 72 65 6d 6f 74 65 29 r-url runremote)
2550: 29 29 29 20 20 3b 3b 20 73 65 72 76 65 72 20 68 ))) ;; server h
2560: 61 73 20 64 69 65 64 2e 20 4e 4f 54 45 3a 20 74 as died. NOTE: t
2570: 68 69 73 20 69 73 20 6e 6f 74 20 61 20 63 68 65 his is not a che
2580: 61 70 20 63 61 6c 6c 21 20 4e 65 65 64 20 62 65 ap call! Need be
2590: 74 74 65 72 20 61 70 70 72 6f 61 63 68 2e 0a 20 tter approach..
25a0: 20 20 20 20 20 28 73 65 74 21 20 2a 72 75 6e 72 (set! *runr
25b0: 65 6d 6f 74 65 2a 20 28 6d 61 6b 65 2d 72 65 6d emote* (make-rem
25c0: 6f 74 65 29 29 0a 20 20 20 20 20 20 28 72 65 6d ote)). (rem
25d0: 6f 74 65 2d 66 6f 72 63 65 2d 73 65 72 76 65 72 ote-force-server
25e0: 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 -set! runremote
25f0: 28 63 6f 6d 6d 6f 6e 3a 66 6f 72 63 65 2d 73 65 (common:force-se
2600: 72 76 65 72 3f 29 29 0a 20 20 20 20 20 20 28 6d rver?)). (m
2610: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d utex-unlock! *rm
2620: 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 t-mutex*).
2630: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
2640: 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f o 12 *default-lo
2650: 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 6e g-port* "rmt:sen
2660: 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 65 20 d-receive, case
2670: 20 36 22 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 6"). (rmt:
2680: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 63 6d 64 send-receive cmd
2690: 20 72 69 64 20 70 61 72 61 6d 73 20 61 74 74 65 rid params atte
26a0: 6d 70 74 6e 75 6d 3a 20 61 74 74 65 6d 70 74 6e mptnum: attemptn
26b0: 75 6d 29 29 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 um)).. ;;DOT
26c0: 20 43 41 53 45 37 20 5b 6c 61 62 65 6c 3d 22 68 CASE7 [label="h
26d0: 6f 6d 65 68 6f 73 74 5c 6e 77 72 69 74 65 22 5d omehost\nwrite"]
26e0: 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 ;. ;;DOT MUT
26f0: 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 37 20 EXLOCK -> CASE7
2700: 5b 6c 61 62 65 6c 3d 22 73 65 72 76 65 72 20 6e [label="server n
2710: 6f 74 20 72 65 71 75 69 72 65 64 2c 5c 6e 6f 6e ot required,\non
2720: 20 68 6f 6d 65 68 6f 73 74 2c 5c 6e 61 20 77 72 homehost,\na wr
2730: 69 74 65 2c 5c 6e 68 61 76 65 20 61 20 73 65 72 ite,\nhave a ser
2740: 76 65 72 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d ver"]; {rank=sam
2750: 65 20 22 63 61 73 65 20 37 22 20 43 41 53 45 37 e "case 7" CASE7
2760: 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 };. ;;DOT CA
2770: 53 45 37 20 2d 3e 20 22 72 6d 74 3a 6f 70 65 6e SE7 -> "rmt:open
2780: 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c -qry-close-local
2790: 6c 79 22 3b 0a 20 20 20 20 20 3b 3b 20 6f 6e 20 ly";. ;; on
27a0: 68 6f 6d 65 68 6f 73 74 20 61 6e 64 20 74 68 69 homehost and thi
27b0: 73 20 69 73 20 61 20 77 72 69 74 65 2c 20 77 65 s is a write, we
27c0: 20 61 6c 72 65 61 64 79 20 68 61 76 65 20 61 20 already have a
27d0: 73 65 72 76 65 72 0a 20 20 20 20 20 28 28 61 6e server. ((an
27e0: 64 20 28 6e 6f 74 20 28 72 65 6d 6f 74 65 2d 66 d (not (remote-f
27f0: 6f 72 63 65 2d 73 65 72 76 65 72 20 72 75 6e 72 orce-server runr
2800: 65 6d 6f 74 65 29 29 20 20 20 20 20 3b 3b 20 68 emote)) ;; h
2810: 6f 6e 6f 72 20 66 6f 72 63 65 64 20 75 73 65 20 onor forced use
2820: 6f 66 20 73 65 72 76 65 72 2c 20 69 2e 65 2e 20 of server, i.e.
2830: 73 65 72 76 65 72 20 4e 4f 54 20 72 65 71 75 69 server NOT requi
2840: 72 65 64 0a 09 20 20 20 28 63 64 72 20 28 72 65 red.. (cdr (re
2850: 6d 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e 72 mote-hh-dat runr
2860: 65 6d 6f 74 65 29 29 20 20 20 20 20 20 20 20 20 emote))
2870: 20 20 3b 3b 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 ;; on homehost
2880: 0a 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 . (not
2890: 20 28 6d 65 6d 62 65 72 20 63 6d 64 20 61 70 69 (member cmd api
28a0: 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 :read-only-queri
28b0: 65 73 29 29 20 20 3b 3b 20 74 68 69 73 20 69 73 es)) ;; this is
28c0: 20 61 20 77 72 69 74 65 0a 20 20 20 20 20 20 20 a write.
28d0: 20 20 20 20 28 72 65 6d 6f 74 65 2d 73 65 72 76 (remote-serv
28e0: 65 72 2d 75 72 6c 20 72 75 6e 72 65 6d 6f 74 65 er-url runremote
28f0: 29 29 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b )) ;;
2900: 20 68 61 76 65 20 61 20 73 65 72 76 65 72 0a 20 have a server.
2910: 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f (mutex-unlo
2920: 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 ck! *rmt-mutex*)
2930: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
2940: 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 66 int-info 12 *def
2950: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
2960: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
2970: 2c 20 63 61 73 65 20 20 34 2e 31 22 29 0a 20 20 , case 4.1").
2980: 20 20 20 20 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 (rmt:open-qr
2990: 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 y-close-locally
29a0: 63 6d 64 20 30 20 70 61 72 61 6d 73 29 29 0a 0a cmd 0 params))..
29b0: 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 38 ;;DOT CASE8
29c0: 20 5b 6c 61 62 65 6c 3d 22 66 6f 72 63 65 5c 6e [label="force\n
29d0: 73 65 72 76 65 72 22 5d 3b 0a 20 20 20 20 20 3b server"];. ;
29e0: 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d ;DOT MUTEXLOCK -
29f0: 3e 20 43 41 53 45 38 20 5b 6c 61 62 65 6c 3d 22 > CASE8 [label="
2a00: 73 65 72 76 65 72 20 6e 6f 74 20 72 65 71 75 69 server not requi
2a10: 72 65 64 2c 5c 6e 68 61 76 65 20 68 6f 6d 65 68 red,\nhave homeh
2a20: 6f 73 74 20 69 6e 66 6f 2c 5c 6e 6e 6f 20 63 6f ost info,\nno co
2a30: 6e 6e 65 63 74 69 6f 6e 20 79 65 74 2c 5c 6e 6e nnection yet,\nn
2a40: 6f 74 20 61 20 72 65 61 64 2d 6f 6e 6c 79 20 71 ot a read-only q
2a50: 75 65 72 79 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 uery"]; {rank=sa
2a60: 6d 65 20 22 63 61 73 65 20 38 22 20 43 41 53 45 me "case 8" CASE
2a70: 38 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 8};. ;;DOT C
2a80: 41 53 45 38 20 2d 3e 20 22 72 6d 74 3a 6f 70 65 ASE8 -> "rmt:ope
2a90: 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 n-qry-close-loca
2aa0: 6c 6c 79 22 3b 0a 20 20 20 20 20 3b 3b 20 20 6f lly";. ;; o
2ab0: 6e 20 68 6f 6d 65 68 6f 73 74 2c 20 6e 6f 20 73 n homehost, no s
2ac0: 65 72 76 65 72 20 63 6f 6e 74 61 63 74 20 6d 61 erver contact ma
2ad0: 64 65 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 de and this is a
2ae0: 20 77 72 69 74 65 2c 20 70 61 73 73 69 76 65 6c write, passivel
2af0: 79 20 73 74 61 72 74 20 61 20 73 65 72 76 65 72 y start a server
2b00: 20 0a 20 20 20 20 20 28 28 61 6e 64 20 28 6e 6f . ((and (no
2b10: 74 20 28 72 65 6d 6f 74 65 2d 66 6f 72 63 65 2d t (remote-force-
2b20: 73 65 72 76 65 72 20 72 75 6e 72 65 6d 6f 74 65 server runremote
2b30: 29 29 20 20 20 20 20 3b 3b 20 68 6f 6e 6f 72 20 )) ;; honor
2b40: 66 6f 72 63 65 64 20 75 73 65 20 6f 66 20 73 65 forced use of se
2b50: 72 76 65 72 2c 20 69 2e 65 2e 20 73 65 72 76 65 rver, i.e. serve
2b60: 72 20 4e 4f 54 20 72 65 71 75 69 72 65 64 0a 09 r NOT required..
2b70: 20 20 20 28 63 64 72 20 28 72 65 6d 6f 74 65 2d (cdr (remote-
2b80: 68 68 2d 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 hh-dat runremote
2b90: 29 29 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 )) ;;
2ba0: 68 61 76 65 20 68 6f 6d 65 68 6f 73 74 0a 20 20 have homehost.
2bb0: 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 72 (not (r
2bc0: 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 6c emote-server-url
2bd0: 20 72 75 6e 72 65 6d 6f 74 65 29 29 20 20 20 20 runremote))
2be0: 20 20 20 3b 3b 20 6e 6f 20 63 6f 6e 6e 65 63 74 ;; no connect
2bf0: 69 6f 6e 20 79 65 74 0a 09 20 20 20 28 6e 6f 74 ion yet.. (not
2c00: 20 28 6d 65 6d 62 65 72 20 63 6d 64 20 61 70 69 (member cmd api
2c10: 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 :read-only-queri
2c20: 65 73 29 29 29 20 3b 3b 20 6e 6f 74 20 61 20 72 es))) ;; not a r
2c30: 65 61 64 2d 6f 6e 6c 79 20 71 75 65 72 79 0a 20 ead-only query.
2c40: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
2c50: 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 66 61 75 t-info 12 *defau
2c60: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d lt-log-port* "rm
2c70: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 2c 20 t:send-receive,
2c80: 63 61 73 65 20 20 38 22 29 0a 20 20 20 20 20 20 case 8").
2c90: 28 6c 65 74 20 28 28 73 65 72 76 65 72 2d 75 72 (let ((server-ur
2ca0: 6c 20 20 28 73 65 72 76 65 72 3a 63 68 65 63 6b l (server:check
2cb0: 2d 69 66 2d 72 75 6e 6e 69 6e 67 20 2a 74 6f 70 -if-running *top
2cc0: 70 61 74 68 2a 29 29 29 20 3b 3b 20 28 73 65 72 path*))) ;; (ser
2cd0: 76 65 72 3a 72 65 61 64 2d 64 6f 74 73 65 72 76 ver:read-dotserv
2ce0: 65 72 2d 3e 75 72 6c 20 2a 74 6f 70 70 61 74 68 er->url *toppath
2cf0: 2a 29 29 29 20 3b 3b 20 28 73 65 72 76 65 72 3a *))) ;; (server:
2d00: 63 68 65 63 6b 2d 69 66 2d 72 75 6e 6e 69 6e 67 check-if-running
2d10: 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 20 3b 3b *toppath*))) ;;
2d20: 20 44 6f 20 4e 4f 54 20 77 61 6e 74 20 74 6f 20 Do NOT want to
2d30: 72 75 6e 20 73 65 72 76 65 72 3a 63 68 65 63 6b run server:check
2d40: 2d 69 66 2d 72 75 6e 6e 69 6e 67 20 2d 20 76 65 -if-running - ve
2d50: 72 79 20 65 78 70 65 6e 73 69 76 65 20 74 6f 20 ry expensive to
2d60: 64 6f 20 66 6f 72 20 65 76 65 72 79 20 77 72 69 do for every wri
2d70: 74 65 20 63 61 6c 6c 0a 09 28 69 66 20 73 65 72 te call..(if ser
2d80: 76 65 72 2d 75 72 6c 0a 09 20 20 20 20 28 72 65 ver-url.. (re
2d90: 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 6c 2d mote-server-url-
2da0: 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 73 set! runremote s
2db0: 65 72 76 65 72 2d 75 72 6c 29 20 3b 3b 20 74 68 erver-url) ;; th
2dc0: 65 20 73 74 72 69 6e 67 20 63 61 6e 20 62 65 20 e string can be
2dd0: 63 6f 6e 73 75 6d 65 64 20 62 79 20 74 68 65 20 consumed by the
2de0: 63 6c 69 65 6e 74 20 73 65 74 75 70 20 69 66 20 client setup if
2df0: 6e 65 65 64 65 64 0a 09 20 20 20 20 28 69 66 20 needed.. (if
2e00: 28 63 6f 6d 6d 6f 6e 3a 66 6f 72 63 65 2d 73 65 (common:force-se
2e10: 72 76 65 72 3f 29 0a 09 09 28 73 65 72 76 65 72 rver?)...(server
2e20: 3a 73 74 61 72 74 2d 61 6e 64 2d 77 61 69 74 20 :start-and-wait
2e30: 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 28 73 65 *toppath*)...(se
2e40: 72 76 65 72 3a 6b 69 6e 64 2d 72 75 6e 20 2a 74 rver:kind-run *t
2e50: 6f 70 70 61 74 68 2a 29 29 29 29 0a 20 20 20 20 oppath*)))).
2e60: 20 20 28 72 65 6d 6f 74 65 2d 66 6f 72 63 65 2d (remote-force-
2e70: 73 65 72 76 65 72 2d 73 65 74 21 20 72 75 6e 72 server-set! runr
2e80: 65 6d 6f 74 65 20 28 63 6f 6d 6d 6f 6e 3a 66 6f emote (common:fo
2e90: 72 63 65 2d 73 65 72 76 65 72 3f 29 29 0a 20 20 rce-server?)).
2ea0: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
2eb0: 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 0a k! *rmt-mutex*).
2ec0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2ed0: 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 66 61 nt-info 12 *defa
2ee0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 ult-log-port* "r
2ef0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 2c mt:send-receive,
2f00: 20 63 61 73 65 20 20 38 2e 31 22 29 0a 20 20 20 case 8.1").
2f10: 20 20 20 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 (rmt:open-qry
2f20: 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 -close-locally c
2f30: 6d 64 20 30 20 70 61 72 61 6d 73 29 29 0a 0a 20 md 0 params))..
2f40: 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 39 20 ;;DOT CASE9
2f50: 5b 6c 61 62 65 6c 3d 22 66 6f 72 63 65 20 73 65 [label="force se
2f60: 72 76 65 72 5c 6e 6e 6f 74 20 6f 6e 20 68 6f 6d rver\nnot on hom
2f70: 65 68 6f 73 74 22 5d 3b 0a 20 20 20 20 20 3b 3b ehost"];. ;;
2f80: 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e DOT MUTEXLOCK ->
2f90: 20 43 41 53 45 39 20 5b 6c 61 62 65 6c 3d 22 6e CASE9 [label="n
2fa0: 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 5c 6e 61 6e o connection\nan
2fb0: 64 20 65 69 74 68 65 72 20 72 65 71 75 69 72 65 d either require
2fc0: 20 73 65 72 76 65 72 5c 6e 6f 72 20 6e 6f 74 20 server\nor not
2fd0: 6f 6e 20 68 6f 6d 65 68 6f 73 74 22 5d 3b 20 7b on homehost"]; {
2fe0: 72 61 6e 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 rank=same "case
2ff0: 39 22 20 43 41 53 45 39 7d 3b 0a 20 20 20 20 20 9" CASE9};.
3000: 3b 3b 44 4f 54 20 43 41 53 45 39 20 2d 3e 20 22 ;;DOT CASE9 -> "
3010: 73 74 61 72 74 5c 6e 73 65 72 76 65 72 22 20 2d start\nserver" -
3020: 3e 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 > "rmt:send-rece
3030: 69 76 65 22 3b 0a 20 20 20 20 20 28 28 6f 72 20 ive";. ((or
3040: 28 61 6e 64 20 28 72 65 6d 6f 74 65 2d 66 6f 72 (and (remote-for
3050: 63 65 2d 73 65 72 76 65 72 20 72 75 6e 72 65 6d ce-server runrem
3060: 6f 74 65 29 20 20 20 20 20 20 20 20 20 20 20 20 ote)
3070: 20 20 3b 3b 20 77 65 20 61 72 65 20 66 6f 72 63 ;; we are forc
3080: 69 6e 67 20 61 20 73 65 72 76 65 72 20 61 6e 64 ing a server and
3090: 20 64 6f 6e 27 74 20 79 65 74 20 68 61 76 65 20 don't yet have
30a0: 61 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 74 6f 20 a connection to
30b0: 6f 6e 65 0a 09 20 20 20 20 20 20 20 28 6e 6f 74 one.. (not
30c0: 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 (remote-conndat
30d0: 20 72 75 6e 72 65 6d 6f 74 65 29 29 29 0a 09 20 runremote)))..
30e0: 20 28 61 6e 64 20 28 6e 6f 74 20 28 63 64 72 20 (and (not (cdr
30f0: 28 72 65 6d 6f 74 65 2d 68 68 2d 64 61 74 20 72 (remote-hh-dat r
3100: 75 6e 72 65 6d 6f 74 65 29 29 29 20 20 20 20 20 unremote)))
3110: 20 20 20 3b 3b 20 6e 6f 74 20 6f 6e 20 61 20 68 ;; not on a h
3120: 6f 6d 65 68 6f 73 74 20 0a 09 20 20 20 20 20 20 omehost ..
3130: 20 28 6e 6f 74 20 28 72 65 6d 6f 74 65 2d 63 6f (not (remote-co
3140: 6e 6e 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 nndat runremote)
3150: 29 29 29 20 20 20 20 20 20 20 20 20 20 20 3b 3b ))) ;;
3160: 20 61 6e 64 20 6e 6f 20 63 6f 6e 6e 65 63 74 69 and no connecti
3170: 6f 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a on. (debug:
3180: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 print-info 12 *d
3190: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
31a0: 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 "rmt:send-recei
31b0: 76 65 2c 20 63 61 73 65 20 39 2c 20 68 68 2d 64 ve, case 9, hh-d
31c0: 61 74 3a 20 22 20 28 72 65 6d 6f 74 65 2d 68 68 at: " (remote-hh
31d0: 2d 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 20 -dat runremote)
31e0: 22 20 63 6f 6e 6e 64 61 74 3a 20 22 20 28 72 65 " conndat: " (re
31f0: 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 20 72 75 6e mote-conndat run
3200: 72 65 6d 6f 74 65 29 29 0a 20 20 20 20 20 20 28 remote)). (
3210: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 mutex-unlock! *r
3220: 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 mt-mutex*).
3230: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 72 76 65 (if (not (serve
3240: 72 3a 63 68 65 63 6b 2d 69 66 2d 72 75 6e 6e 69 r:check-if-runni
3250: 6e 67 20 2a 74 6f 70 70 61 74 68 2a 29 29 20 3b ng *toppath*)) ;
3260: 3b 20 77 68 6f 20 6b 6e 6f 77 73 2c 20 6d 61 79 ; who knows, may
3270: 62 65 20 6f 6e 65 20 68 61 73 20 73 74 61 72 74 be one has start
3280: 65 64 20 75 70 3f 0a 09 20 20 28 73 65 72 76 65 ed up?.. (serve
3290: 72 3a 73 74 61 72 74 2d 61 6e 64 2d 77 61 69 74 r:start-and-wait
32a0: 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a 20 20 20 *toppath*)).
32b0: 20 20 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 (remote-connd
32c0: 61 74 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 at-set! runremot
32d0: 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 6e 6e 65 e (rmt:get-conne
32e0: 63 74 69 6f 6e 2d 69 6e 66 6f 20 2a 74 6f 70 70 ction-info *topp
32f0: 61 74 68 2a 29 29 20 3b 3b 20 63 61 6c 6c 73 20 ath*)) ;; calls
3300: 63 6c 69 65 6e 74 3a 73 65 74 75 70 20 77 68 69 client:setup whi
3310: 63 68 20 63 61 6c 6c 73 20 63 6c 69 65 6e 74 3a ch calls client:
3320: 73 65 74 75 70 2d 68 74 74 70 0a 20 20 20 20 20 setup-http.
3330: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
3340: 76 65 20 63 6d 64 20 72 69 64 20 70 61 72 61 6d ve cmd rid param
3350: 73 20 61 74 74 65 6d 70 74 6e 75 6d 3a 20 61 74 s attemptnum: at
3360: 74 65 6d 70 74 6e 75 6d 29 29 20 3b 3b 20 54 4f temptnum)) ;; TO
3370: 44 4f 3a 20 61 64 64 20 62 61 63 6b 2d 6f 66 66 DO: add back-off
3380: 20 74 69 6d 65 6f 75 74 20 61 73 0a 0a 20 20 20 timeout as..
3390: 20 20 3b 3b 44 4f 54 20 43 41 53 45 31 30 20 5b ;;DOT CASE10 [
33a0: 6c 61 62 65 6c 3d 22 6f 6e 20 68 6f 6d 65 68 6f label="on homeho
33b0: 73 74 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 st"];. ;;DOT
33c0: 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 MUTEXLOCK -> CA
33d0: 53 45 31 30 20 5b 6c 61 62 65 6c 3d 22 73 65 72 SE10 [label="ser
33e0: 76 65 72 20 6e 6f 74 20 72 65 71 75 69 72 65 64 ver not required
33f0: 2c 5c 6e 6f 6e 20 68 6f 6d 65 68 6f 73 74 22 5d ,\non homehost"]
3400: 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 63 61 ; {rank=same "ca
3410: 73 65 20 31 30 22 20 43 41 53 45 31 30 7d 3b 0a se 10" CASE10};.
3420: 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 31 ;;DOT CASE1
3430: 30 20 2d 3e 20 22 72 6d 74 3a 6f 70 65 6e 2d 71 0 -> "rmt:open-q
3440: 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 ry-close-locally
3450: 22 3b 0a 20 20 20 20 20 3b 3b 20 61 6c 6c 20 73 ";. ;; all s
3460: 65 74 20 75 70 20 69 66 20 67 65 74 20 74 68 69 et up if get thi
3470: 73 20 66 61 72 2c 20 64 69 73 70 61 74 63 68 20 s far, dispatch
3480: 74 68 65 20 71 75 65 72 79 0a 20 20 20 20 20 28 the query. (
3490: 28 61 6e 64 20 28 6e 6f 74 20 28 72 65 6d 6f 74 (and (not (remot
34a0: 65 2d 66 6f 72 63 65 2d 73 65 72 76 65 72 20 72 e-force-server r
34b0: 75 6e 72 65 6d 6f 74 65 29 29 0a 09 20 20 20 28 unremote)).. (
34c0: 63 64 72 20 28 72 65 6d 6f 74 65 2d 68 68 2d 64 cdr (remote-hh-d
34d0: 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 29 20 at runremote)))
34e0: 3b 3b 20 77 65 20 61 72 65 20 6f 6e 20 68 6f 6d ;; we are on hom
34f0: 65 68 6f 73 74 0a 20 20 20 20 20 20 28 6d 75 74 ehost. (mut
3500: 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d ex-unlock! *rmt-
3510: 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 28 64 mutex*). (d
3520: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
3530: 31 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 12 *default-log-
3540: 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 6e 64 2d port* "rmt:send-
3550: 72 65 63 65 69 76 65 2c 20 63 61 73 65 20 31 30 receive, case 10
3560: 22 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 6f 70 "). (rmt:op
3570: 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 en-qry-close-loc
3580: 61 6c 6c 79 20 63 6d 64 20 28 69 66 20 72 69 64 ally cmd (if rid
3590: 20 72 69 64 20 30 29 20 70 61 72 61 6d 73 29 29 rid 0) params))
35a0: 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 .. ;;DOT CAS
35b0: 45 31 31 20 5b 6c 61 62 65 6c 3d 22 73 65 6e 64 E11 [label="send
35c0: 5f 72 65 63 65 69 76 65 22 5d 3b 0a 20 20 20 20 _receive"];.
35d0: 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b ;;DOT MUTEXLOCK
35e0: 20 2d 3e 20 43 41 53 45 31 31 20 5b 6c 61 62 65 -> CASE11 [labe
35f0: 6c 3d 22 65 6c 73 65 22 5d 3b 20 7b 72 61 6e 6b l="else"]; {rank
3600: 3d 73 61 6d 65 20 22 63 61 73 65 20 31 31 22 20 =same "case 11"
3610: 43 41 53 45 31 31 7d 3b 0a 20 20 20 20 20 3b 3b CASE11};. ;;
3620: 44 4f 54 20 43 41 53 45 31 31 20 2d 3e 20 22 72 DOT CASE11 -> "r
3630: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 22 mt:send-receive"
3640: 20 5b 6c 61 62 65 6c 3d 22 63 61 6c 6c 20 66 61 [label="call fa
3650: 69 6c 65 64 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 iled"];. ;;D
3660: 4f 54 20 43 41 53 45 31 31 20 2d 3e 20 22 52 45 OT CASE11 -> "RE
3670: 53 55 4c 54 22 20 5b 6c 61 62 65 6c 3d 22 63 61 SULT" [label="ca
3680: 6c 6c 20 73 75 63 63 65 65 64 65 64 22 5d 3b 0a ll succeeded"];.
3690: 20 20 20 20 20 3b 3b 20 6e 6f 74 20 6f 6e 20 68 ;; not on h
36a0: 6f 6d 65 68 6f 73 74 2c 20 64 6f 20 73 65 72 76 omehost, do serv
36b0: 65 72 20 71 75 65 72 79 0a 20 20 20 20 20 28 65 er query. (e
36c0: 6c 73 65 20 28 65 78 74 72 61 73 2d 63 61 73 65 lse (extras-case
36d0: 2d 31 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 -11 *default-log
36e0: 2d 70 6f 72 74 2a 20 72 75 6e 72 65 6d 6f 74 65 -port* runremote
36f0: 20 63 6d 64 20 70 61 72 61 6d 73 20 61 74 74 65 cmd params atte
3700: 6d 70 74 6e 75 6d 20 72 69 64 29 29 29 29 29 0a mptnum rid))))).
3710: 20 20 20 20 3b 3b 44 4f 54 20 7d 0a 0a 3b 3b 20 ;;DOT }..;;
3720: 62 75 6e 63 68 20 6f 66 20 73 6d 61 6c 6c 20 66 bunch of small f
3730: 75 6e 63 74 69 6f 6e 73 20 66 61 63 74 6f 72 65 unctions factore
3740: 64 20 6f 75 74 20 6f 66 20 73 65 6e 64 2d 72 65 d out of send-re
3750: 63 65 69 76 65 20 74 6f 20 6d 61 6b 65 20 64 65 ceive to make de
3760: 62 75 67 20 65 61 73 69 65 72 0a 3b 3b 0a 0a 28 bug easier.;;..(
3770: 64 65 66 69 6e 65 20 28 65 78 74 72 61 73 2d 63 define (extras-c
3780: 61 73 65 2d 31 31 20 2a 64 65 66 61 75 6c 74 2d ase-11 *default-
3790: 6c 6f 67 2d 70 6f 72 74 2a 20 72 75 6e 72 65 6d log-port* runrem
37a0: 6f 74 65 20 63 6d 64 20 70 61 72 61 6d 73 20 61 ote cmd params a
37b0: 74 74 65 6d 70 74 6e 75 6d 20 72 69 64 29 0a 20 ttemptnum rid).
37c0: 20 3b 3b 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 ;; (mutex-unloc
37d0: 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 0a k! *rmt-mutex*).
37e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
37f0: 6e 66 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 2d nfo 12 *default-
3800: 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 log-port* "rmt:s
3810: 65 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 end-receive, cas
3820: 65 20 20 39 22 29 0a 20 20 3b 3b 20 28 6d 75 74 e 9"). ;; (mut
3830: 65 78 2d 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 ex-lock! *rmt-mu
3840: 74 65 78 2a 29 0a 20 20 28 6c 65 74 2a 20 28 28 tex*). (let* ((
3850: 63 6f 6e 6e 69 6e 66 6f 20 28 72 65 6d 6f 74 65 conninfo (remote
3860: 2d 63 6f 6e 6e 64 61 74 20 72 75 6e 72 65 6d 6f -conndat runremo
3870: 74 65 29 29 0a 09 20 28 64 61 74 2d 69 6e 20 20 te)).. (dat-in
3880: 20 20 20 20 28 63 61 73 65 20 28 72 65 6d 6f 74 (case (remot
3890: 65 2d 74 72 61 6e 73 70 6f 72 74 20 72 75 6e 72 e-transport runr
38a0: 65 6d 6f 74 65 29 0a 09 09 20 20 20 20 20 28 28 emote)... ((
38b0: 68 74 74 70 29 20 28 63 6f 6e 64 69 74 69 6f 6e http) (condition
38c0: 2d 63 61 73 65 20 3b 3b 20 68 61 6e 64 6c 69 6e -case ;; handlin
38d0: 67 20 68 65 72 65 20 68 61 73 0a 09 09 09 09 09 g here has......
38e0: 20 20 20 20 20 3b 3b 20 63 61 75 73 65 64 20 61 ;; caused a
38f0: 20 6c 6f 74 20 6f 66 0a 09 09 09 09 09 20 20 20 lot of......
3900: 20 20 3b 3b 20 70 72 6f 62 6c 65 6d 73 2e 20 48 ;; problems. H
3910: 6f 77 65 76 65 72 20 69 74 0a 09 09 09 09 09 20 owever it......
3920: 20 20 20 20 3b 3b 20 69 73 20 6e 65 65 64 65 64 ;; is needed
3930: 20 74 6f 20 64 65 61 6c 20 77 69 74 68 0a 09 09 to deal with...
3940: 09 09 09 20 20 20 20 20 3b 3b 20 61 74 74 65 6d ... ;; attem
3950: 74 70 65 64 0a 09 09 09 09 09 20 20 20 20 20 3b tped...... ;
3960: 3b 20 63 6f 6d 6d 75 6e 69 63 61 74 69 6f 6e 20 ; communication
3970: 74 6f 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 to...... ;;
3980: 73 65 72 76 65 72 73 20 74 68 61 74 20 68 61 76 servers that hav
3990: 65 20 67 6f 6e 65 0a 09 09 09 09 09 20 20 20 20 e gone......
39a0: 20 3b 3b 20 61 77 61 79 0a 09 09 09 20 20 20 20 ;; away....
39b0: 20 20 28 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 (http-transpor
39c0: 74 3a 63 6c 69 65 6e 74 2d 61 70 69 2d 73 65 6e t:client-api-sen
39d0: 64 2d 72 65 63 65 69 76 65 20 30 20 63 6f 6e 6e d-receive 0 conn
39e0: 69 6e 66 6f 20 63 6d 64 20 70 61 72 61 6d 73 29 info cmd params)
39f0: 0a 09 09 09 20 20 20 20 20 20 28 28 63 6f 6d 6d .... ((comm
3a00: 66 61 69 6c 29 28 76 65 63 74 6f 72 20 23 66 20 fail)(vector #f
3a10: 22 63 6f 6d 6d 75 6e 69 63 61 74 69 6f 6e 73 20 "communications
3a20: 66 61 69 6c 22 29 29 0a 09 09 09 20 20 20 20 20 fail"))....
3a30: 20 28 28 65 78 6e 29 28 76 65 63 74 6f 72 20 23 ((exn)(vector #
3a40: 66 20 22 6f 74 68 65 72 20 66 61 69 6c 22 20 28 f "other fail" (
3a50: 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e print-call-chain
3a60: 29 29 29 29 29 0a 09 09 20 20 20 20 20 28 65 6c )))))... (el
3a70: 73 65 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 se... (debu
3a80: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
3a90: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 lt-log-port* "ER
3aa0: 52 4f 52 3a 20 74 72 61 6e 73 70 6f 72 74 20 22 ROR: transport "
3ab0: 20 28 72 65 6d 6f 74 65 2d 74 72 61 6e 73 70 6f (remote-transpo
3ac0: 72 74 20 72 75 6e 72 65 6d 6f 74 65 29 20 22 20 rt runremote) "
3ad0: 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 22 29 0a not supported").
3ae0: 09 09 20 20 20 20 20 20 28 65 78 69 74 29 29 29 .. (exit)))
3af0: 29 0a 0a 3b 3b 20 4e 6f 20 54 69 74 6c 65 20 0a )..;; No Title .
3b00: 3b 3b 20 45 72 72 6f 72 3a 20 28 76 65 63 74 6f ;; Error: (vecto
3b10: 72 2d 72 65 66 29 20 6f 75 74 20 6f 66 20 72 61 r-ref) out of ra
3b20: 6e 67 65 0a 3b 3b 20 23 28 23 3c 63 6f 6e 64 69 nge.;; #(#<condi
3b30: 74 69 6f 6e 3a 20 28 65 78 6e 20 74 79 70 65 29 tion: (exn type)
3b40: 3e 20 28 23 28 22 64 62 2e 73 63 6d 3a 33 37 34 > (#("db.scm:374
3b50: 30 3a 20 72 65 67 65 78 23 72 65 67 65 78 70 22 0: regex#regexp"
3b60: 20 23 66 20 23 66 29 20 23 28 22 64 62 2e 73 63 #f #f) #("db.sc
3b70: 6d 3a 33 37 33 39 3a 20 72 65 67 65 78 23 73 74 m:3739: regex#st
3b80: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 22 ring-substitute"
3b90: 20 23 66 20 23 66 29 20 23 28 22 64 62 2e 73 63 #f #f) #("db.sc
3ba0: 6d 3a 33 37 33 38 3a 20 62 61 73 65 36 34 23 62 m:3738: base64#b
3bb0: 61 73 65 36 34 2d 64 65 63 6f 64 65 22 20 23 66 ase64-decode" #f
3bc0: 20 23 66 29 20 23 28 22 64 62 2e 73 63 6d 3a 33 #f) #("db.scm:3
3bd0: 37 33 37 3a 20 7a 33 23 7a 33 3a 64 65 63 6f 64 737: z3#z3:decod
3be0: 65 2d 62 75 66 66 65 72 22 20 23 66 20 23 66 29 e-buffer" #f #f)
3bf0: 20 23 28 22 64 62 2e 73 63 6d 3a 33 37 33 36 3a #("db.scm:3736:
3c00: 20 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d with-input-from
3c10: 2d 73 74 72 69 6e 67 22 20 23 66 20 23 66 29 20 -string" #f #f)
3c20: 23 28 22 64 62 2e 73 63 6d 3a 33 37 34 31 3a 20 #("db.scm:3741:
3c30: 73 31 31 6e 23 64 65 73 65 72 69 61 6c 69 7a 65 s11n#deserialize
3c40: 22 20 23 66 20 23 66 29 20 23 28 22 61 70 69 2e " #f #f) #("api.
3c50: 73 63 6d 3a 33 37 34 3a 20 61 70 69 3a 65 78 65 scm:374: api:exe
3c60: 63 75 74 65 2d 72 65 71 75 65 73 74 73 22 20 23 cute-requests" #
3c70: 66 20 23 66 29 20 23 28 22 61 70 69 2e 73 63 6d f #f) #("api.scm
3c80: 3a 31 33 39 3a 20 63 61 6c 6c 2d 77 69 74 68 2d :139: call-with-
3c90: 63 75 72 72 65 6e 74 2d 63 6f 6e 74 69 6e 75 61 current-continua
3ca0: 74 69 6f 6e 22 20 23 66 20 23 66 29 20 23 28 22 tion" #f #f) #("
3cb0: 61 70 69 2e 73 63 6d 3a 31 33 39 3a 20 77 69 74 api.scm:139: wit
3cc0: 68 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 h-exception-hand
3cd0: 6c 65 72 22 20 23 66 20 23 66 29 20 23 28 22 61 ler" #f #f) #("a
3ce0: 70 69 2e 73 63 6d 3a 31 33 39 3a 20 23 23 73 79 pi.scm:139: ##sy
3cf0: 73 23 63 61 6c 6c 2d 77 69 74 68 2d 76 61 6c 75 s#call-with-valu
3d00: 65 73 22 20 23 66 20 23 66 29 20 23 28 22 61 70 es" #f #f) #("ap
3d10: 69 2e 73 63 6d 3a 31 35 38 3a 20 73 74 72 69 6e i.scm:158: strin
3d20: 67 2d 3e 73 79 6d 62 6f 6c 22 20 23 66 20 23 66 g->symbol" #f #f
3d30: 29 20 23 28 22 61 70 69 2e 73 63 6d 3a 31 36 30 ) #("api.scm:160
3d40: 3a 20 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 : current-millis
3d50: 65 63 6f 6e 64 73 22 20 23 66 20 23 66 29 20 23 econds" #f #f) #
3d60: 28 22 61 70 69 2e 73 63 6d 3a 31 36 31 3a 20 64 ("api.scm:161: d
3d70: 62 72 3a 64 62 73 74 72 75 63 74 2d 72 65 61 64 br:dbstruct-read
3d80: 2d 6f 6e 6c 79 22 20 23 66 20 23 66 29 20 23 28 -only" #f #f) #(
3d90: 22 61 70 69 2e 73 63 6d 3a 31 33 39 3a 20 6b 31 "api.scm:139: k1
3da0: 35 22 20 23 66 20 23 66 29 20 23 28 22 61 70 69 5" #f #f) #("api
3db0: 2e 73 63 6d 3a 31 33 39 3a 20 67 31 39 22 20 23 .scm:139: g19" #
3dc0: 66 20 23 66 29 20 23 28 22 61 70 69 2e 73 63 6d f #f) #("api.scm
3dd0: 3a 31 34 32 3a 20 67 65 74 2d 63 61 6c 6c 2d 63 :142: get-call-c
3de0: 68 61 69 6e 22 20 23 66 20 23 66 29 29 20 23 28 hain" #f #f)) #(
3df0: 22 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 "get-test-info-b
3e00: 79 2d 69 64 22 20 28 31 31 30 32 20 35 30 37 32 y-id" (1102 5072
3e10: 39 39 29 29 29 0a 3b 3b 20 36 0a 3b 3b 20 0a 3b 99))).;; 6.;; .;
3e20: 3b 20 09 43 61 6c 6c 20 68 69 73 74 6f 72 79 3a ; .Call history:
3e30: 0a 3b 3b 20 0a 3b 3b 20 09 68 74 74 70 2d 74 72 .;; .;; .http-tr
3e40: 61 6e 73 70 6f 72 74 2e 73 63 6d 3a 33 30 36 3a ansport.scm:306:
3e50: 20 74 68 72 65 61 64 2d 74 65 72 6d 69 6e 61 74 thread-terminat
3e60: 65 21 09 20 20 0a 3b 3b 20 09 68 74 74 70 2d 74 e!. .;; .http-t
3e70: 72 61 6e 73 70 6f 72 74 2e 73 63 6d 3a 33 30 37 ransport.scm:307
3e80: 3a 20 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e : debug:print-in
3e90: 66 6f 09 20 20 0a 3b 3b 20 09 63 6f 6d 6d 6f 6e fo. .;; .common
3ea0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 3a 32 33 35 _records.scm:235
3eb0: 3a 20 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f : debug:debug-mo
3ec0: 64 65 09 20 20 0a 3b 3b 20 09 72 6d 74 2e 73 63 de. .;; .rmt.sc
3ed0: 6d 3a 32 35 39 3a 20 6b 35 38 37 09 20 20 0a 3b m:259: k587. .;
3ee0: 3b 20 09 72 6d 74 2e 73 63 6d 3a 32 35 39 3a 20 ; .rmt.scm:259:
3ef0: 67 35 39 31 09 20 20 0a 3b 3b 20 09 72 6d 74 2e g591. .;; .rmt.
3f00: 73 63 6d 3a 32 37 36 3a 20 68 74 74 70 2d 74 72 scm:276: http-tr
3f10: 61 6e 73 70 6f 72 74 3a 73 65 72 76 65 72 2d 64 ansport:server-d
3f20: 61 74 2d 75 70 64 61 74 65 2d 6c 61 73 74 2d 61 at-update-last-a
3f30: 63 63 65 73 73 09 20 20 0a 3b 3b 20 09 68 74 74 ccess. .;; .htt
3f40: 70 2d 74 72 61 6e 73 70 6f 72 74 2e 73 63 6d 3a p-transport.scm:
3f50: 33 36 34 3a 20 63 75 72 72 65 6e 74 2d 73 65 63 364: current-sec
3f60: 6f 6e 64 73 09 20 20 0a 3b 3b 20 09 72 6d 74 2e onds. .;; .rmt.
3f70: 73 63 6d 3a 32 38 32 3a 20 64 65 62 75 67 3a 70 scm:282: debug:p
3f80: 72 69 6e 74 2d 69 6e 66 6f 09 20 20 0a 3b 3b 20 rint-info. .;;
3f90: 09 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e .common_records.
3fa0: 73 63 6d 3a 32 33 35 3a 20 64 65 62 75 67 3a 64 scm:235: debug:d
3fb0: 65 62 75 67 2d 6d 6f 64 65 09 20 20 0a 3b 3b 20 ebug-mode. .;;
3fc0: 09 72 6d 74 2e 73 63 6d 3a 32 38 33 3a 20 6d 75 .rmt.scm:283: mu
3fd0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 09 20 20 0a 3b tex-unlock!. .;
3fe0: 3b 20 09 72 6d 74 2e 73 63 6d 3a 32 38 37 3a 20 ; .rmt.scm:287:
3ff0: 65 78 74 72 61 73 2d 74 72 61 6e 73 70 6f 72 74 extras-transport
4000: 2d 73 75 63 63 65 64 65 64 09 20 20 09 3c 2d 2d -succeded. .<--
4010: 0a 3b 3b 20 2b 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d .;; +-----------
4020: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
4030: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
4040: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
4050: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
4060: 2d 2d 2b 0a 3b 3b 20 7c 20 45 78 69 74 20 53 74 --+.;; | Exit St
4070: 61 74 75 73 20 20 20 20 3a 20 37 30 20 20 0a 3b atus : 70 .;
4080: 3b 20 20 0a 0a 09 20 28 64 61 74 20 20 20 20 20 ; ... (dat
4090: 20 28 69 66 20 28 61 6e 64 20 28 76 65 63 74 6f (if (and (vecto
40a0: 72 3f 20 64 61 74 2d 69 6e 29 20 3b 3b 20 2e 2e r? dat-in) ;; ..
40b0: 2e 20 63 68 65 63 6b 20 69 74 20 69 73 20 61 20 . check it is a
40c0: 63 6f 72 72 65 63 74 20 73 69 7a 65 0a 09 09 09 correct size....
40d0: 20 20 20 20 28 3e 20 28 76 65 63 74 6f 72 2d 6c (> (vector-l
40e0: 65 6e 67 74 68 20 64 61 74 2d 69 6e 29 20 31 29 ength dat-in) 1)
40f0: 29 0a 09 09 20 20 20 20 20 20 20 64 61 74 2d 69 )... dat-i
4100: 6e 0a 09 09 20 20 20 20 20 20 20 28 76 65 63 74 n... (vect
4110: 6f 72 20 23 66 20 28 63 6f 6e 63 20 22 63 6f 6d or #f (conc "com
4120: 6d 75 6e 69 63 61 74 69 6f 6e 73 20 66 61 69 6c munications fail
4130: 20 28 74 79 70 65 20 32 29 2c 20 64 61 74 2d 69 (type 2), dat-i
4140: 6e 3d 22 20 64 61 74 2d 69 6e 29 29 29 29 0a 09 n=" dat-in))))..
4150: 20 28 73 75 63 63 65 73 73 20 20 28 69 66 20 28 (success (if (
4160: 76 65 63 74 6f 72 3f 20 64 61 74 29 20 28 76 65 vector? dat) (ve
4170: 63 74 6f 72 2d 72 65 66 20 64 61 74 20 30 29 20 ctor-ref dat 0)
4180: 23 66 29 29 0a 09 20 28 72 65 73 20 20 20 20 20 #f)).. (res
4190: 20 28 69 66 20 28 76 65 63 74 6f 72 3f 20 64 61 (if (vector? da
41a0: 74 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 t) (vector-ref d
41b0: 61 74 20 31 29 20 23 66 29 29 29 0a 20 20 20 20 at 1) #f))).
41c0: 28 69 66 20 28 61 6e 64 20 28 76 65 63 74 6f 72 (if (and (vector
41d0: 3f 20 63 6f 6e 6e 69 6e 66 6f 29 20 28 3c 20 35 ? conninfo) (< 5
41e0: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
41f0: 63 6f 6e 6e 69 6e 66 6f 29 29 29 0a 09 28 68 74 conninfo)))..(ht
4200: 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 73 65 72 tp-transport:ser
4210: 76 65 72 2d 64 61 74 2d 75 70 64 61 74 65 2d 6c ver-dat-update-l
4220: 61 73 74 2d 61 63 63 65 73 73 20 63 6f 6e 6e 69 ast-access conni
4230: 6e 66 6f 29 20 3b 3b 20 72 65 66 72 65 73 68 20 nfo) ;; refresh
4240: 61 63 63 65 73 73 20 74 69 6d 65 0a 09 28 62 65 access time..(be
4250: 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 gin.. (debug:pr
4260: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
4270: 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 og-port* "INFO:
4280: 53 68 6f 75 6c 64 20 6e 6f 74 20 67 65 74 20 68 Should not get h
4290: 65 72 65 21 20 63 6f 6e 6e 69 6e 66 6f 3d 22 20 ere! conninfo="
42a0: 63 6f 6e 6e 69 6e 66 6f 29 0a 09 20 20 28 73 65 conninfo).. (se
42b0: 74 21 20 63 6f 6e 6e 69 6e 66 6f 20 23 66 29 0a t! conninfo #f).
42c0: 09 20 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 . (remote-connd
42d0: 61 74 2d 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f at-set! *runremo
42e0: 74 65 2a 20 23 66 29 20 3b 3b 20 4e 4f 54 45 3a te* #f) ;; NOTE:
42f0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 69 73 20 *runremote* is
4300: 67 6c 6f 62 61 6c 20 63 6f 70 79 20 6f 66 20 72 global copy of r
4310: 75 6e 72 65 6d 6f 74 65 2e 20 50 75 72 70 6f 73 unremote. Purpos
4320: 65 3a 20 66 61 63 74 6f 72 20 6f 75 74 20 67 6c e: factor out gl
4330: 6f 62 61 6c 2e 0a 09 20 20 28 68 74 74 70 2d 74 obal... (http-t
4340: 72 61 6e 73 70 6f 72 74 3a 63 6c 6f 73 65 2d 63 ransport:close-c
4350: 6f 6e 6e 65 63 74 69 6f 6e 73 20 20 61 72 65 61 onnections area
4360: 2d 64 61 74 3a 20 72 75 6e 72 65 6d 6f 74 65 29 -dat: runremote)
4370: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
4380: 69 6e 74 2d 69 6e 66 6f 20 31 33 20 2a 64 65 66 int-info 13 *def
4390: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
43a0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
43b0: 2c 20 63 61 73 65 20 20 39 2e 20 63 6f 6e 6e 69 , case 9. conni
43c0: 6e 66 6f 3d 22 20 63 6f 6e 6e 69 6e 66 6f 20 22 nfo=" conninfo "
43d0: 20 64 61 74 3d 22 20 64 61 74 20 22 20 72 75 6e dat=" dat " run
43e0: 72 65 6d 6f 74 65 20 3d 20 22 20 72 75 6e 72 65 remote = " runre
43f0: 6d 6f 74 65 29 0a 20 20 20 20 28 6d 75 74 65 78 mote). (mutex
4400: 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 -unlock! *rmt-mu
4410: 74 65 78 2a 29 0a 20 20 20 20 28 69 66 20 73 75 tex*). (if su
4420: 63 63 65 73 73 20 3b 3b 20 73 75 63 63 65 73 73 ccess ;; success
4430: 20 6f 6e 6c 79 20 74 65 6c 6c 73 20 75 73 20 74 only tells us t
4440: 68 61 74 20 74 68 65 20 74 72 61 6e 73 70 6f 72 hat the transpor
4450: 74 20 77 61 73 0a 09 3b 3b 20 73 75 63 63 65 73 t was..;; succes
4460: 73 66 75 6c 2c 20 68 61 76 65 20 74 6f 20 65 78 sful, have to ex
4470: 61 6d 69 6e 65 20 74 68 65 20 64 61 74 61 20 74 amine the data t
4480: 6f 20 73 65 65 20 69 66 0a 09 3b 3b 20 74 68 65 o see if..;; the
4490: 72 65 20 77 61 73 20 61 20 64 65 74 65 63 74 65 re was a detecte
44a0: 64 20 69 73 73 75 65 20 61 74 20 74 68 65 20 6f d issue at the o
44b0: 74 68 65 72 20 65 6e 64 0a 09 28 65 78 74 72 61 ther end..(extra
44c0: 73 2d 74 72 61 6e 73 70 6f 72 74 2d 73 75 63 63 s-transport-succ
44d0: 65 64 65 64 20 2a 64 65 66 61 75 6c 74 2d 6c 6f eded *default-lo
44e0: 67 2d 70 6f 72 74 2a 20 2a 72 6d 74 2d 6d 75 74 g-port* *rmt-mut
44f0: 65 78 2a 20 61 74 74 65 6d 70 74 6e 75 6d 20 72 ex* attemptnum r
4500: 75 6e 72 65 6d 6f 74 65 20 72 65 73 20 70 61 72 unremote res par
4510: 61 6d 73 20 72 69 64 20 63 6d 64 29 0a 09 28 65 ams rid cmd)..(e
4520: 78 74 72 61 73 2d 74 72 61 6e 73 70 6f 72 74 2d xtras-transport-
4530: 66 61 69 6c 65 64 20 2a 64 65 66 61 75 6c 74 2d failed *default-
4540: 6c 6f 67 2d 70 6f 72 74 2a 20 2a 72 6d 74 2d 6d log-port* *rmt-m
4550: 75 74 65 78 2a 20 61 74 74 65 6d 70 74 6e 75 6d utex* attemptnum
4560: 20 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 20 72 runremote cmd r
4570: 69 64 20 70 61 72 61 6d 73 29 0a 09 29 29 29 0a id params)..))).
4580: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 70 72 .(define (rmt:pr
4590: 69 6e 74 2d 64 62 2d 73 74 61 74 73 29 0a 20 20 int-db-stats).
45a0: 28 6c 65 74 20 28 28 66 6d 74 73 74 72 20 22 7e (let ((fmtstr "~
45b0: 34 30 61 7e 37 2d 64 7e 39 2d 64 7e 32 30 2c 32 40a~7-d~9-d~20,2
45c0: 2d 66 22 29 29 20 3b 3b 20 22 7e 32 30 2c 32 2d -f")) ;; "~20,2-
45d0: 66 22 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 f". (debug:pr
45e0: 69 6e 74 20 31 38 20 2a 64 65 66 61 75 6c 74 2d int 18 *default-
45f0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 44 42 20 53 74 log-port* "DB St
4600: 61 74 73 5c 6e 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a ats\n========").
4610: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4620: 20 31 38 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 18 *default-log
4630: 2d 70 6f 72 74 2a 20 28 66 6f 72 6d 61 74 20 23 -port* (format #
4640: 66 20 22 7e 34 30 61 7e 38 61 7e 31 30 61 7e 31 f "~40a~8a~10a~1
4650: 30 61 22 20 22 43 6d 64 22 20 22 43 6f 75 6e 74 0a" "Cmd" "Count
4660: 22 20 22 54 6f 74 54 69 6d 65 22 20 22 41 76 67 " "TotTime" "Avg
4670: 22 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ")). (for-eac
4680: 68 20 28 6c 61 6d 62 64 61 20 28 63 6d 64 29 0a h (lambda (cmd).
4690: 09 09 28 6c 65 74 20 28 28 63 6d 64 2d 64 61 74 ..(let ((cmd-dat
46a0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
46b0: 20 2a 64 62 2d 73 74 61 74 73 2a 20 63 6d 64 29 *db-stats* cmd)
46c0: 29 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 ))... (debug:pr
46d0: 69 6e 74 20 31 38 20 2a 64 65 66 61 75 6c 74 2d int 18 *default-
46e0: 6c 6f 67 2d 70 6f 72 74 2a 20 28 66 6f 72 6d 61 log-port* (forma
46f0: 74 20 23 66 20 66 6d 74 73 74 72 20 63 6d 64 20 t #f fmtstr cmd
4700: 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6d 64 2d (vector-ref cmd-
4710: 64 61 74 20 30 29 20 28 76 65 63 74 6f 72 2d 72 dat 0) (vector-r
4720: 65 66 20 63 6d 64 2d 64 61 74 20 31 29 20 28 2f ef cmd-dat 1) (/
4730: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6d 64 (vector-ref cmd
4740: 2d 64 61 74 20 31 29 28 76 65 63 74 6f 72 2d 72 -dat 1)(vector-r
4750: 65 66 20 63 6d 64 2d 64 61 74 20 30 29 29 29 29 ef cmd-dat 0))))
4760: 29 29 0a 09 20 20 20 20 20 20 28 73 6f 72 74 20 )).. (sort
4770: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
4780: 20 2a 64 62 2d 73 74 61 74 73 2a 29 0a 09 09 20 *db-stats*)...
4790: 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 (lambda (a b)
47a0: 0a 09 09 20 20 20 20 20 20 28 3e 20 28 76 65 63 ... (> (vec
47b0: 74 6f 72 2d 72 65 66 20 28 68 61 73 68 2d 74 61 tor-ref (hash-ta
47c0: 62 6c 65 2d 72 65 66 20 2a 64 62 2d 73 74 61 74 ble-ref *db-stat
47d0: 73 2a 20 61 29 20 30 29 0a 09 09 09 20 28 76 65 s* a) 0).... (ve
47e0: 63 74 6f 72 2d 72 65 66 20 28 68 61 73 68 2d 74 ctor-ref (hash-t
47f0: 61 62 6c 65 2d 72 65 66 20 2a 64 62 2d 73 74 61 able-ref *db-sta
4800: 74 73 2a 20 62 29 20 30 29 29 29 29 29 29 29 0a ts* b) 0))))))).
4810: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
4820: 74 2d 6d 61 78 2d 71 75 65 72 79 2d 61 76 65 72 t-max-query-aver
4830: 61 67 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 6d age run-id). (m
4840: 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 2d 73 utex-lock! *db-s
4850: 74 61 74 73 2d 6d 75 74 65 78 2a 29 0a 20 20 28 tats-mutex*). (
4860: 6c 65 74 2a 20 28 28 72 75 6e 6b 65 79 20 28 63 let* ((runkey (c
4870: 6f 6e 63 20 22 72 75 6e 2d 69 64 3d 22 20 72 75 onc "run-id=" ru
4880: 6e 2d 69 64 20 22 20 22 29 29 0a 09 20 28 63 6d n-id " ")).. (cm
4890: 64 73 20 20 20 28 66 69 6c 74 65 72 20 28 6c 61 ds (filter (la
48a0: 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 28 mbda (x).... (
48b0: 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 substring-index
48c0: 72 75 6e 6b 65 79 20 78 29 29 0a 09 09 09 20 28 runkey x)).... (
48d0: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
48e0: 2a 64 62 2d 73 74 61 74 73 2a 29 29 29 0a 09 20 *db-stats*)))..
48f0: 28 72 65 73 20 20 20 20 28 69 66 20 28 6e 75 6c (res (if (nul
4900: 6c 3f 20 63 6d 64 73 29 0a 09 09 20 20 20 20 20 l? cmds)...
4910: 28 63 6f 6e 73 20 27 6e 6f 6e 65 20 30 29 0a 09 (cons 'none 0)..
4920: 09 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 . (let loop
4930: 28 28 63 6d 64 20 28 63 61 72 20 63 6d 64 73 29 ((cmd (car cmds)
4940: 29 0a 09 09 09 09 28 74 61 6c 20 28 63 64 72 20 ).....(tal (cdr
4950: 63 6d 64 73 29 29 0a 09 09 09 09 28 6d 61 78 2d cmds)).....(max-
4960: 63 6d 64 20 28 63 61 72 20 63 6d 64 73 29 29 0a cmd (car cmds)).
4970: 09 09 09 09 28 72 65 73 20 30 29 29 0a 09 09 20 ....(res 0))...
4980: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d (let* ((cm
4990: 64 2d 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c d-dat (hash-tabl
49a0: 65 2d 72 65 66 20 2a 64 62 2d 73 74 61 74 73 2a e-ref *db-stats*
49b0: 20 63 6d 64 29 29 0a 09 09 09 20 20 20 20 20 20 cmd))....
49c0: 28 74 6f 74 20 20 20 20 20 28 76 65 63 74 6f 72 (tot (vector
49d0: 2d 72 65 66 20 63 6d 64 2d 64 61 74 20 30 29 29 -ref cmd-dat 0))
49e0: 0a 09 09 09 20 20 20 20 20 20 28 63 75 72 72 61 .... (curra
49f0: 76 67 20 28 2f 20 28 76 65 63 74 6f 72 2d 72 65 vg (/ (vector-re
4a00: 66 20 63 6d 64 2d 64 61 74 20 31 29 20 28 76 65 f cmd-dat 1) (ve
4a10: 63 74 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 ctor-ref cmd-dat
4a20: 20 30 29 29 29 20 3b 3b 20 63 6f 75 6e 74 20 69 0))) ;; count i
4a30: 73 20 6e 65 76 65 72 20 7a 65 72 6f 20 62 79 20 s never zero by
4a40: 63 6f 6e 73 74 72 75 63 74 69 6f 6e 0a 09 09 09 construction....
4a50: 20 20 20 20 20 20 28 63 75 72 72 6d 61 78 20 28 (currmax (
4a60: 6d 61 78 20 72 65 73 20 63 75 72 72 61 76 67 29 max res curravg)
4a70: 29 0a 09 09 09 20 20 20 20 20 20 28 6e 65 77 6d ).... (newm
4a80: 61 78 2d 63 6d 64 20 28 69 66 20 28 3e 20 63 75 ax-cmd (if (> cu
4a90: 72 72 61 76 67 20 72 65 73 29 20 63 6d 64 20 6d rravg res) cmd m
4aa0: 61 78 2d 63 6d 64 29 29 29 0a 09 09 09 20 28 69 ax-cmd))).... (i
4ab0: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
4ac0: 09 20 20 20 20 20 28 69 66 20 28 3e 20 74 6f 74 . (if (> tot
4ad0: 20 31 30 29 0a 09 09 09 09 20 28 63 6f 6e 73 20 10)..... (cons
4ae0: 6e 65 77 6d 61 78 2d 63 6d 64 20 63 75 72 72 6d newmax-cmd currm
4af0: 61 78 29 0a 09 09 09 09 20 28 63 6f 6e 73 20 27 ax)..... (cons '
4b00: 6e 6f 6e 65 20 30 29 29 0a 09 09 09 20 20 20 20 none 0))....
4b10: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
4b20: 28 63 64 72 20 74 61 6c 29 20 6e 65 77 6d 61 78 (cdr tal) newmax
4b30: 2d 63 6d 64 20 63 75 72 72 6d 61 78 29 29 29 29 -cmd currmax))))
4b40: 29 29 29 0a 20 20 20 20 28 6d 75 74 65 78 2d 75 ))). (mutex-u
4b50: 6e 6c 6f 63 6b 21 20 2a 64 62 2d 73 74 61 74 73 nlock! *db-stats
4b60: 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 72 65 73 -mutex*). res
4b70: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
4b80: 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d :open-qry-close-
4b90: 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 72 75 6e 2d locally cmd run-
4ba0: 69 64 20 70 61 72 61 6d 73 20 23 21 6b 65 79 20 id params #!key
4bb0: 28 72 65 6d 72 65 74 72 69 65 73 20 35 29 29 0a (remretries 5)).
4bc0: 20 20 28 6c 65 74 2a 20 28 28 71 72 79 2d 69 73 (let* ((qry-is
4bd0: 2d 77 72 69 74 65 20 20 20 28 6e 6f 74 20 28 6d -write (not (m
4be0: 65 6d 62 65 72 20 63 6d 64 20 61 70 69 3a 72 65 ember cmd api:re
4bf0: 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 73 29 ad-only-queries)
4c00: 29 29 0a 09 20 28 64 62 2d 66 69 6c 65 2d 70 61 )).. (db-file-pa
4c10: 74 68 20 20 20 28 64 62 3a 64 62 66 69 6c 65 2d th (db:dbfile-
4c20: 70 61 74 68 29 29 20 3b 3b 20 20 30 29 29 0a 09 path)) ;; 0))..
4c30: 20 28 64 62 73 74 72 75 63 74 2d 6c 6f 63 61 6c (dbstruct-local
4c40: 20 28 64 62 3a 73 65 74 75 70 20 23 74 29 29 20 (db:setup #t))
4c50: 20 3b 3b 20 6d 61 6b 65 2d 64 62 72 3a 64 62 73 ;; make-dbr:dbs
4c60: 74 72 75 63 74 20 70 61 74 68 3a 20 20 64 62 64 truct path: dbd
4c70: 69 72 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 0a ir local: #t))).
4c80: 09 20 28 72 65 61 64 2d 6f 6e 6c 79 20 20 20 20 . (read-only
4c90: 20 20 28 6e 6f 74 20 28 66 69 6c 65 2d 77 72 69 (not (file-wri
4ca0: 74 65 2d 61 63 63 65 73 73 3f 20 64 62 2d 66 69 te-access? db-fi
4cb0: 6c 65 2d 70 61 74 68 29 29 29 0a 09 20 28 73 74 le-path))).. (st
4cc0: 61 72 74 20 20 20 20 20 20 20 20 20 20 28 63 75 art (cu
4cd0: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
4ce0: 64 73 29 29 0a 09 20 28 72 65 73 64 61 74 20 20 ds)).. (resdat
4cf0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
4d00: 28 61 6e 64 20 72 65 61 64 2d 6f 6e 6c 79 20 71 (and read-only q
4d10: 72 79 2d 69 73 2d 77 72 69 74 65 29 29 0a 09 09 ry-is-write))...
4d20: 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 20 28 . (let ((v (
4d30: 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 api:execute-requ
4d40: 65 73 74 73 20 64 62 73 74 72 75 63 74 2d 6c 6f ests dbstruct-lo
4d50: 63 61 6c 20 28 76 65 63 74 6f 72 20 28 73 79 6d cal (vector (sym
4d60: 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 63 6d 64 29 bol->string cmd)
4d70: 20 70 61 72 61 6d 73 29 29 29 29 0a 09 09 09 20 params))))....
4d80: 20 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 (handle-ex
4d90: 63 65 70 74 69 6f 6e 73 20 3b 3b 20 74 68 65 72 ceptions ;; ther
4da0: 65 20 68 61 73 20 62 65 65 6e 20 61 20 6c 6f 6e e has been a lon
4db0: 67 20 68 69 73 74 6f 72 79 20 6f 66 20 72 65 63 g history of rec
4dc0: 65 69 76 69 6e 67 20 73 74 72 61 6e 67 65 20 65 eiving strange e
4dd0: 72 72 6f 72 73 20 66 72 6f 6d 20 76 61 6c 75 65 rrors from value
4de0: 73 20 72 65 74 75 72 6e 65 64 20 62 79 20 74 68 s returned by th
4df0: 65 20 63 6c 69 65 6e 74 20 77 68 65 6e 20 74 68 e client when th
4e00: 69 6e 67 73 20 67 6f 20 77 72 6f 6e 67 2e 2e 0a ings go wrong...
4e10: 09 09 09 09 65 78 6e 20 20 20 20 20 20 20 20 20 ....exn
4e20: 20 20 20 20 20 20 3b 3b 20 20 54 68 69 73 20 69 ;; This i
4e30: 73 20 61 6e 20 61 74 74 65 6d 70 74 20 74 6f 20 s an attempt to
4e40: 64 65 74 65 63 74 20 74 68 61 74 20 73 69 74 75 detect that situ
4e50: 61 74 69 6f 6e 20 61 6e 64 20 72 65 63 6f 76 65 ation and recove
4e60: 72 20 67 72 61 63 65 66 75 6c 6c 79 0a 09 09 09 r gracefully....
4e70: 09 28 62 65 67 69 6e 0a 09 09 09 09 20 20 28 64 .(begin..... (d
4e80: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
4e90: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4ea0: 22 45 52 52 4f 52 3a 20 62 61 64 20 64 61 74 61 "ERROR: bad data
4eb0: 20 66 72 6f 6d 20 73 65 72 76 65 72 20 22 20 76 from server " v
4ec0: 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 20 28 " message: " (
4ed0: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
4ee0: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
4ef0: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
4f00: 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a 09 ", exn=" exn)..
4f10: 09 09 09 20 20 28 76 65 63 74 6f 72 20 23 74 20 ... (vector #t
4f20: 27 28 29 29 29 20 3b 3b 20 73 68 6f 75 6c 64 20 '())) ;; should
4f30: 61 6c 77 61 79 73 20 67 65 74 20 61 20 76 65 63 always get a vec
4f40: 74 6f 72 20 62 75 74 20 69 66 20 73 6f 6d 65 74 tor but if somet
4f50: 68 69 6e 67 20 67 6f 65 73 20 77 72 6f 6e 67 20 hing goes wrong
4f60: 72 65 74 75 72 6e 20 61 20 64 75 6d 6d 79 0a 09 return a dummy..
4f70: 09 09 09 28 69 66 20 28 61 6e 64 20 28 76 65 63 ...(if (and (vec
4f80: 74 6f 72 3f 20 76 29 0a 09 09 09 09 09 20 28 3e tor? v)...... (>
4f90: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
4fa0: 76 29 20 31 29 29 0a 09 09 09 09 20 20 20 20 28 v) 1))..... (
4fb0: 6c 65 74 20 28 28 6e 65 77 76 65 63 20 28 76 65 let ((newvec (ve
4fc0: 63 74 6f 72 20 28 76 65 63 74 6f 72 2d 72 65 66 ctor (vector-ref
4fd0: 20 76 20 30 29 28 76 65 63 74 6f 72 2d 72 65 66 v 0)(vector-ref
4fe0: 20 76 20 31 29 29 29 29 0a 09 09 09 09 20 20 20 v 1)))).....
4ff0: 20 20 20 6e 65 77 76 65 63 29 20 20 20 20 20 20 newvec)
5000: 20 20 20 20 20 3b 3b 20 62 79 20 63 6f 70 79 69 ;; by copyi
5010: 6e 67 20 74 68 65 20 76 65 63 74 6f 72 20 77 68 ng the vector wh
5020: 69 6c 65 20 69 6e 73 69 64 65 20 74 68 65 20 65 ile inside the e
5030: 72 72 6f 72 20 68 61 6e 64 6c 65 72 20 77 65 20 rror handler we
5040: 73 68 6f 75 6c 64 20 66 6f 72 63 65 20 74 68 65 should force the
5050: 20 64 65 74 65 63 74 69 6f 6e 20 6f 66 20 61 20 detection of a
5060: 63 6f 72 72 75 70 74 65 64 20 72 65 63 6f 72 64 corrupted record
5070: 0a 09 09 09 09 20 20 20 20 28 76 65 63 74 6f 72 ..... (vector
5080: 20 23 74 20 27 28 29 29 29 29 29 20 20 3b 3b 20 #t '())))) ;;
5090: 77 65 20 63 6f 75 6c 64 20 61 6c 73 6f 20 63 68 we could also ch
50a0: 65 63 6b 20 74 68 61 74 20 74 68 65 20 72 65 74 eck that the ret
50b0: 75 72 6e 65 64 20 74 79 70 65 73 20 61 72 65 20 urned types are
50c0: 76 61 6c 69 64 0a 09 09 09 20 20 20 20 20 28 76 valid.... (v
50d0: 65 63 74 6f 72 20 23 74 20 27 28 29 29 29 29 0a ector #t '()))).
50e0: 09 20 28 73 75 63 63 65 73 73 20 20 20 20 20 20 . (success
50f0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 (vector-ref re
5100: 73 64 61 74 20 30 29 29 0a 09 20 28 72 65 73 20 sdat 0)).. (res
5110: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
5120: 6f 72 2d 72 65 66 20 72 65 73 64 61 74 20 31 29 or-ref resdat 1)
5130: 29 0a 09 20 28 64 75 72 61 74 69 6f 6e 20 20 20 ).. (duration
5140: 20 20 20 20 28 2d 20 28 63 75 72 72 65 6e 74 2d (- (current-
5150: 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 milliseconds) st
5160: 61 72 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 art))). (if (
5170: 61 6e 64 20 72 65 61 64 2d 6f 6e 6c 79 20 71 72 and read-only qr
5180: 79 2d 69 73 2d 77 72 69 74 65 29 0a 20 20 20 20 y-is-write).
5190: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
51a0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
51b0: 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 61 74 port* "ERROR: at
51c0: 74 65 6d 70 74 20 74 6f 20 77 72 69 74 65 20 74 tempt to write t
51d0: 6f 20 72 65 61 64 2d 6f 6e 6c 79 20 64 61 74 61 o read-only data
51e0: 62 61 73 65 20 69 67 6e 6f 72 65 64 2e 20 63 6d base ignored. cm
51f0: 64 3d 22 20 63 6d 64 29 29 0a 20 20 20 20 28 69 d=" cmd)). (i
5200: 66 20 28 6e 6f 74 20 73 75 63 63 65 73 73 29 0a f (not success).
5210: 09 28 69 66 20 28 3e 20 72 65 6d 72 65 74 72 69 .(if (> remretri
5220: 65 73 20 30 29 0a 09 20 20 20 20 28 62 65 67 69 es 0).. (begi
5230: 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a n.. (debug:
5240: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
5250: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
5260: 20 22 6c 6f 63 61 6c 20 71 75 65 72 79 20 66 61 "local query fa
5270: 69 6c 65 64 2e 20 54 72 79 69 6e 67 20 61 67 61 iled. Trying aga
5280: 69 6e 2e 22 29 0a 09 20 20 20 20 20 20 28 74 68 in.").. (th
5290: 72 65 61 64 2d 73 6c 65 65 70 21 20 28 2f 20 28 read-sleep! (/ (
52a0: 72 61 6e 64 6f 6d 20 35 30 30 30 29 20 31 30 30 random 5000) 100
52b0: 30 29 29 20 3b 3b 20 73 6f 6d 65 20 72 61 6e 64 0)) ;; some rand
52c0: 6f 6d 20 64 65 6c 61 79 20 0a 09 20 20 20 20 20 om delay ..
52d0: 20 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 (rmt:open-qry-c
52e0: 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 lose-locally cmd
52f0: 20 72 75 6e 2d 69 64 20 70 61 72 61 6d 73 20 72 run-id params r
5300: 65 6d 72 65 74 72 69 65 73 3a 20 28 2d 20 72 65 emretries: (- re
5310: 6d 72 65 74 72 69 65 73 20 31 29 29 29 0a 09 20 mretries 1)))..
5320: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
5330: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
5340: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
5350: 6f 67 2d 70 6f 72 74 2a 20 22 74 6f 6f 20 6d 61 og-port* "too ma
5360: 6e 79 20 72 65 74 72 69 65 73 20 69 6e 20 72 6d ny retries in rm
5370: 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 t:open-qry-close
5380: 2d 6c 6f 63 61 6c 6c 79 2c 20 67 69 76 69 6e 67 -locally, giving
5390: 20 75 70 22 29 0a 09 20 20 20 20 20 20 23 66 29 up").. #f)
53a0: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 3b 3b 20 )..(begin.. ;;
53b0: 28 72 6d 74 3a 75 70 64 61 74 65 2d 64 62 2d 73 (rmt:update-db-s
53c0: 74 61 74 73 20 72 75 6e 2d 69 64 20 63 6d 64 20 tats run-id cmd
53d0: 70 61 72 61 6d 73 20 64 75 72 61 74 69 6f 6e 29 params duration)
53e0: 0a 09 20 20 3b 3b 20 6d 61 72 6b 20 74 68 69 73 .. ;; mark this
53f0: 20 72 75 6e 20 61 73 20 64 69 72 74 79 20 69 66 run as dirty if
5400: 20 74 68 69 73 20 77 61 73 20 61 20 77 72 69 74 this was a writ
5410: 65 2c 20 74 68 65 20 77 61 74 63 68 64 6f 67 20 e, the watchdog
5420: 69 73 20 72 65 73 70 6f 6e 73 69 62 6c 65 20 66 is responsible f
5430: 6f 72 20 73 79 6e 63 69 6e 67 20 69 74 0a 09 20 or syncing it..
5440: 20 28 69 66 20 71 72 79 2d 69 73 2d 77 72 69 74 (if qry-is-writ
5450: 65 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 e.. (let ((
5460: 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 72 start-time (curr
5470: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 ent-seconds)))..
5480: 09 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 .(mutex-lock! *d
5490: 62 2d 6d 75 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 b-multi-sync-mut
54a0: 65 78 2a 29 0a 2f 09 09 28 73 65 74 21 20 2a 64 ex*)./..(set! *d
54b0: 62 2d 6c 61 73 74 2d 61 63 63 65 73 73 2a 20 73 b-last-access* s
54c0: 74 61 72 74 2d 74 69 6d 65 29 20 20 3b 3b 20 54 tart-time) ;; T
54d0: 48 49 53 20 49 53 20 50 52 4f 42 41 42 4c 59 20 HIS IS PROBABLY
54e0: 55 53 45 4c 45 53 53 3f 20 28 77 65 20 61 72 65 USELESS? (we are
54f0: 20 6f 6e 20 61 20 63 6c 69 65 6e 74 29 0a 20 20 on a client).
5500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
5510: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 utex-unlock! *db
5520: 2d 6d 75 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 65 -multi-sync-mute
5530: 78 2a 29 29 29 29 29 0a 20 20 20 20 72 65 73 29 x*))))). res)
5540: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5550: 73 65 6e 64 2d 72 65 63 65 69 76 65 2d 6e 6f 2d send-receive-no-
5560: 61 75 74 6f 2d 63 6c 69 65 6e 74 2d 73 65 74 75 auto-client-setu
5570: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 p connection-inf
5580: 6f 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 72 o cmd run-id par
5590: 61 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 ams). (let* ((r
55a0: 75 6e 2d 69 64 20 20 20 28 69 66 20 72 75 6e 2d un-id (if run-
55b0: 69 64 20 72 75 6e 2d 69 64 20 30 29 29 0a 09 20 id run-id 0))..
55c0: 28 72 65 73 20 20 09 20 20 20 28 68 61 6e 64 6c (res . (handl
55d0: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 e-exceptions...
55e0: 20 20 20 20 20 20 65 78 6e 0a 09 09 20 20 20 20 exn...
55f0: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
5600: 20 28 70 72 69 6e 74 20 22 74 72 61 6e 73 70 6f (print "transpo
5610: 72 74 20 66 61 69 6c 65 64 2e 20 65 78 6e 3d 22 rt failed. exn="
5620: 20 65 78 6e 29 0a 09 09 20 20 20 20 20 20 20 23 exn)... #
5630: 66 29 0a 09 09 20 20 20 20 20 28 68 74 74 70 2d f)... (http-
5640: 74 72 61 6e 73 70 6f 72 74 3a 63 6c 69 65 6e 74 transport:client
5650: 2d 61 70 69 2d 73 65 6e 64 2d 72 65 63 65 69 76 -api-send-receiv
5660: 65 20 72 75 6e 2d 69 64 20 63 6f 6e 6e 65 63 74 e run-id connect
5670: 69 6f 6e 2d 69 6e 66 6f 20 63 6d 64 20 70 61 72 ion-info cmd par
5680: 61 6d 73 29 29 29 29 0a 20 20 20 20 28 69 66 20 ams)))). (if
5690: 28 61 6e 64 20 72 65 73 20 28 76 65 63 74 6f 72 (and res (vector
56a0: 2d 72 65 66 20 72 65 73 20 30 29 29 0a 09 28 76 -ref res 0))..(v
56b0: 65 63 74 6f 72 2d 72 65 66 20 72 65 73 20 31 29 ector-ref res 1)
56c0: 20 3b 3b 3b 20 59 45 53 21 21 20 54 48 49 53 20 ;;; YES!! THIS
56d0: 49 53 20 43 4f 52 52 45 43 54 21 21 20 43 48 41 IS CORRECT!! CHA
56e0: 4e 47 45 20 49 54 20 48 45 52 45 2c 20 54 48 45 NGE IT HERE, THE
56f0: 4e 20 43 48 41 4e 47 45 20 72 6d 74 3a 73 65 6e N CHANGE rmt:sen
5700: 64 2d 72 65 63 65 69 76 65 20 41 4c 53 4f 21 21 d-receive ALSO!!
5710: 21 0a 09 23 66 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d !..#f)))..;;====
5720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5760: 3d 3d 0a 3b 3b 0a 3b 3b 20 41 20 43 20 54 20 55 ==.;;.;; A C T U
5770: 20 41 20 4c 20 20 20 41 20 50 20 49 20 20 20 43 A L A P I C
5780: 20 41 20 4c 20 4c 20 53 20 20 0a 3b 3b 0a 3b 3b A L L S .;;.;;
5790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57d0: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ======..;;======
57e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5820: 0a 3b 3b 20 20 53 20 45 20 52 20 56 20 45 20 52 .;; S E R V E R
5830: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
5880: 6e 65 20 28 72 6d 74 3a 6b 69 6c 6c 2d 73 65 72 ne (rmt:kill-ser
5890: 76 65 72 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 ver run-id). (r
58a0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
58b0: 27 6b 69 6c 6c 2d 73 65 72 76 65 72 20 72 75 6e 'kill-server run
58c0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
58d0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
58e0: 74 3a 73 74 61 72 74 2d 73 65 72 76 65 72 20 72 t:start-server r
58f0: 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 un-id). (rmt:se
5900: 6e 64 2d 72 65 63 65 69 76 65 20 27 73 74 61 72 nd-receive 'star
5910: 74 2d 73 65 72 76 65 72 20 30 20 28 6c 69 73 74 t-server 0 (list
5920: 20 72 75 6e 2d 69 64 29 29 29 0a 0a 3b 3b 3d 3d run-id)))..;;==
5930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5970: 3d 3d 3d 3d 0a 3b 3b 20 20 4d 20 49 20 53 20 43 ====.;; M I S C
5980: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
59d0: 6e 65 20 28 72 6d 74 3a 6c 6f 67 69 6e 20 72 75 ne (rmt:login ru
59e0: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
59f0: 64 2d 72 65 63 65 69 76 65 20 27 6c 6f 67 69 6e d-receive 'login
5a00: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 2a 74 run-id (list *t
5a10: 6f 70 70 61 74 68 2a 20 6d 65 67 61 74 65 73 74 oppath* megatest
5a20: 2d 76 65 72 73 69 6f 6e 20 2a 6d 79 2d 63 6c 69 -version *my-cli
5a30: 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 2a 29 29 ent-signature*))
5a40: 29 0a 0a 3b 3b 20 54 68 69 73 20 6c 6f 67 69 6e )..;; This login
5a50: 20 64 6f 65 73 20 6e 6f 20 72 65 74 72 69 65 73 does no retries
5a60: 20 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 20 under the hood
5a70: 2d 20 69 74 20 61 63 74 73 20 61 20 62 69 74 20 - it acts a bit
5a80: 6c 69 6b 65 20 61 20 70 69 6e 67 2e 0a 3b 3b 20 like a ping..;;
5a90: 44 65 70 72 65 63 61 74 65 64 20 66 6f 72 20 6e Deprecated for n
5aa0: 6d 73 67 2d 74 72 61 6e 73 70 6f 72 74 2e 0a 3b msg-transport..;
5ab0: 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6c ;.(define (rmt:l
5ac0: 6f 67 69 6e 2d 6e 6f 2d 61 75 74 6f 2d 63 6c 69 ogin-no-auto-cli
5ad0: 65 6e 74 2d 73 65 74 75 70 20 63 6f 6e 6e 65 63 ent-setup connec
5ae0: 74 69 6f 6e 2d 69 6e 66 6f 29 0a 20 20 28 63 61 tion-info). (ca
5af0: 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 se *transport-ty
5b00: 70 65 2a 20 3b 3b 20 72 75 6e 2d 69 64 20 6f 66 pe* ;; run-id of
5b10: 20 30 20 69 73 20 6a 75 73 74 20 61 20 70 6c 61 0 is just a pla
5b20: 63 65 68 6f 6c 64 65 72 0a 20 20 20 20 28 28 68 ceholder. ((h
5b30: 74 74 70 29 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ttp)(rmt:send-re
5b40: 63 65 69 76 65 2d 6e 6f 2d 61 75 74 6f 2d 63 6c ceive-no-auto-cl
5b50: 69 65 6e 74 2d 73 65 74 75 70 20 63 6f 6e 6e 65 ient-setup conne
5b60: 63 74 69 6f 6e 2d 69 6e 66 6f 20 27 6c 6f 67 69 ction-info 'logi
5b70: 6e 20 30 20 28 6c 69 73 74 20 2a 74 6f 70 70 61 n 0 (list *toppa
5b80: 74 68 2a 20 6d 65 67 61 74 65 73 74 2d 76 65 72 th* megatest-ver
5b90: 73 69 6f 6e 20 2a 6d 79 2d 63 6c 69 65 6e 74 2d sion *my-client-
5ba0: 73 69 67 6e 61 74 75 72 65 2a 29 29 29 0a 20 20 signature*))).
5bb0: 20 20 3b 3b 28 28 6e 6d 73 67 29 28 6e 6d 73 67 ;;((nmsg)(nmsg
5bc0: 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c 69 65 6e -transport:clien
5bd0: 74 2d 61 70 69 2d 73 65 6e 64 2d 72 65 63 65 69 t-api-send-recei
5be0: 76 65 20 72 75 6e 2d 69 64 20 63 6f 6e 6e 65 63 ve run-id connec
5bf0: 74 69 6f 6e 2d 69 6e 66 6f 20 27 6c 6f 67 69 6e tion-info 'login
5c00: 20 28 6c 69 73 74 20 2a 74 6f 70 70 61 74 68 2a (list *toppath*
5c10: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
5c20: 6e 20 72 75 6e 2d 69 64 20 2a 6d 79 2d 63 6c 69 n run-id *my-cli
5c30: 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 2a 29 29 ent-signature*))
5c40: 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 68 61 6e ). ))..;; han
5c50: 64 20 6f 66 66 20 61 20 63 61 6c 6c 20 74 6f 20 d off a call to
5c60: 6f 6e 65 20 6f 66 20 74 68 65 20 64 62 3a 71 75 one of the db:qu
5c70: 65 72 69 65 73 20 73 74 61 74 65 6d 65 6e 74 73 eries statements
5c80: 0a 3b 3b 20 61 64 64 65 64 20 72 75 6e 2d 69 64 .;; added run-id
5c90: 20 74 6f 20 6d 61 6b 65 20 6c 6f 6f 6b 69 6e 67 to make looking
5ca0: 20 75 70 20 74 68 65 20 63 6f 72 72 65 63 74 20 up the correct
5cb0: 64 62 20 70 6f 73 73 69 62 6c 65 20 0a 3b 3b 0a db possible .;;.
5cc0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 6e (define (rmt:gen
5cd0: 65 72 61 6c 2d 63 61 6c 6c 20 73 74 6d 74 6e 61 eral-call stmtna
5ce0: 6d 65 20 72 75 6e 2d 69 64 20 2e 20 70 61 72 61 me run-id . para
5cf0: 6d 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ms). (rmt:send-
5d00: 72 65 63 65 69 76 65 20 27 67 65 6e 65 72 61 6c receive 'general
5d10: 2d 63 61 6c 6c 20 72 75 6e 2d 69 64 20 28 61 70 -call run-id (ap
5d20: 70 65 6e 64 20 28 6c 69 73 74 20 73 74 6d 74 6e pend (list stmtn
5d30: 61 6d 65 20 72 75 6e 2d 69 64 29 20 70 61 72 61 ame run-id) para
5d40: 6d 73 29 29 29 0a 0a 0a 3b 3b 20 67 69 76 65 6e ms)))...;; given
5d50: 20 61 20 68 6f 73 74 6e 61 6d 65 2c 20 72 65 74 a hostname, ret
5d60: 75 72 6e 20 61 20 70 61 69 72 20 6f 66 20 63 70 urn a pair of cp
5d70: 75 20 6c 6f 61 64 20 61 6e 64 20 75 70 64 61 74 u load and updat
5d80: 65 20 74 69 6d 65 20 72 65 70 72 65 73 65 6e 74 e time represent
5d90: 69 6e 67 20 6c 61 74 65 73 74 20 69 6e 74 65 6c ing latest intel
5da0: 6c 69 67 65 6e 63 65 20 66 72 6f 6d 20 74 65 73 ligence from tes
5db0: 74 73 20 72 75 6e 6e 69 6e 67 20 6f 6e 20 74 68 ts running on th
5dc0: 61 74 20 68 6f 73 74 0a 28 64 65 66 69 6e 65 20 at host.(define
5dd0: 28 72 6d 74 3a 67 65 74 2d 6c 61 74 65 73 74 2d (rmt:get-latest-
5de0: 68 6f 73 74 2d 6c 6f 61 64 20 68 6f 73 74 6e 61 host-load hostna
5df0: 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d me). (rmt:send-
5e00: 72 65 63 65 69 76 65 20 27 67 65 74 2d 6c 61 74 receive 'get-lat
5e10: 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 20 30 20 est-host-load 0
5e20: 28 6c 69 73 74 20 68 6f 73 74 6e 61 6d 65 29 29 (list hostname))
5e30: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5e40: 73 64 62 2d 71 72 79 20 71 72 79 20 76 61 6c 20 sdb-qry qry val
5e50: 72 75 6e 2d 69 64 29 0a 20 20 3b 3b 20 61 64 64 run-id). ;; add
5e60: 20 63 61 63 68 69 6e 67 20 69 66 20 71 72 79 20 caching if qry
5e70: 69 73 20 27 67 65 74 69 64 20 6f 72 20 27 67 65 is 'getid or 'ge
5e80: 74 73 74 72 0a 20 20 28 72 6d 74 3a 73 65 6e 64 tstr. (rmt:send
5e90: 2d 72 65 63 65 69 76 65 20 27 73 64 62 2d 71 72 -receive 'sdb-qr
5ea0: 79 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 71 y run-id (list q
5eb0: 72 79 20 76 61 6c 29 29 29 0a 0a 3b 3b 20 4e 4f ry val)))..;; NO
5ec0: 54 20 43 4f 4d 50 4c 45 54 45 44 0a 28 64 65 66 T COMPLETED.(def
5ed0: 69 6e 65 20 28 72 6d 74 3a 72 75 6e 74 65 73 74 ine (rmt:runtest
5ee0: 73 20 75 73 65 72 20 72 75 6e 2d 69 64 20 74 65 s user run-id te
5ef0: 73 74 70 61 74 74 20 70 61 72 61 6d 73 29 0a 20 stpatt params).
5f00: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
5f10: 76 65 20 27 72 75 6e 74 65 73 74 73 20 72 75 6e ve 'runtests run
5f20: 2d 69 64 20 74 65 73 74 70 61 74 74 29 29 0a 0a -id testpatt))..
5f30: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
5f40: 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 20 -run-record-ids
5f50: 20 74 61 72 67 65 74 20 72 75 6e 20 6b 65 79 6e target run keyn
5f60: 61 6d 65 73 20 74 65 73 74 2d 70 61 74 74 29 0a ames test-patt).
5f70: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
5f80: 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 72 65 63 ive 'get-run-rec
5f90: 6f 72 64 2d 69 64 73 20 23 66 20 28 6c 69 73 74 ord-ids #f (list
5fa0: 20 74 61 72 67 65 74 20 72 75 6e 20 6b 65 79 6e target run keyn
5fb0: 61 6d 65 73 20 74 65 73 74 2d 70 61 74 74 29 29 ames test-patt))
5fc0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5fd0: 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f get-changed-reco
5fe0: 72 64 2d 69 64 73 20 73 69 6e 63 65 2d 74 69 6d rd-ids since-tim
5ff0: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
6000: 65 63 65 69 76 65 20 27 67 65 74 2d 63 68 61 6e eceive 'get-chan
6010: 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 20 23 ged-record-ids #
6020: 66 20 28 6c 69 73 74 20 73 69 6e 63 65 2d 74 69 f (list since-ti
6030: 6d 65 29 29 20 29 0a 0a 28 64 65 66 69 6e 65 20 me)) )..(define
6040: 28 72 6d 74 3a 64 72 6f 70 2d 61 6c 6c 2d 74 72 (rmt:drop-all-tr
6050: 69 67 67 65 72 73 29 0a 20 20 20 20 20 28 72 6d iggers). (rm
6060: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
6070: 64 72 6f 70 2d 61 6c 6c 2d 74 72 69 67 67 65 72 drop-all-trigger
6080: 73 20 23 66 20 27 28 29 29 29 0a 0a 28 64 65 66 s #f '()))..(def
6090: 69 6e 65 20 28 72 6d 74 3a 63 72 65 61 74 65 2d ine (rmt:create-
60a0: 61 6c 6c 2d 74 72 69 67 67 65 72 73 29 0a 20 20 all-triggers).
60b0: 20 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 (rmt:send-rec
60c0: 65 69 76 65 20 27 63 72 65 61 74 65 2d 61 6c 6c eive 'create-all
60d0: 2d 74 72 69 67 67 65 72 73 20 23 66 20 27 28 29 -triggers #f '()
60e0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
60f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
6130: 20 54 20 45 20 53 20 54 20 20 20 4d 20 45 20 54 T E S T M E T
6140: 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d A .;;==========
6150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
6190: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 efine (rmt:get-t
61a0: 65 73 74 73 2d 74 61 67 73 29 0a 20 20 28 72 6d ests-tags). (rm
61b0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
61c0: 67 65 74 2d 74 65 73 74 73 2d 74 61 67 73 20 23 get-tests-tags #
61d0: 66 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d f '()))..;;=====
61e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6220: 3d 0a 3b 3b 20 20 4b 20 45 20 59 20 53 20 0a 3b =.;; K E Y S .;
6230: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
6240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6270: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 54 68 65 73 =======..;; Thes
6280: 65 20 72 65 71 75 69 72 65 20 72 75 6e 2d 69 64 e require run-id
6290: 20 62 65 63 61 75 73 65 20 74 68 65 20 76 61 6c because the val
62a0: 75 65 73 20 63 6f 6d 65 20 66 72 6f 6d 20 74 68 ues come from th
62b0: 65 20 72 75 6e 21 0a 3b 3b 0a 28 64 65 66 69 6e e run!.;;.(defin
62c0: 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 2d 76 e (rmt:get-key-v
62d0: 61 6c 2d 70 61 69 72 73 20 72 75 6e 2d 69 64 29 al-pairs run-id)
62e0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
62f0: 65 69 76 65 20 27 67 65 74 2d 6b 65 79 2d 76 61 eive 'get-key-va
6300: 6c 2d 70 61 69 72 73 20 72 75 6e 2d 69 64 20 28 l-pairs run-id (
6310: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a list run-id)))..
6320: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
6330: 2d 6b 65 79 73 29 0a 20 20 28 69 66 20 2a 64 62 -keys). (if *db
6340: 2d 6b 65 79 73 2a 20 2a 64 62 2d 6b 65 79 73 2a -keys* *db-keys*
6350: 20 0a 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 . (let ((re
6360: 73 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 s (rmt:send-rece
6370: 69 76 65 20 27 67 65 74 2d 6b 65 79 73 20 23 66 ive 'get-keys #f
6380: 20 27 28 29 29 29 29 0a 20 20 20 20 20 20 20 28 '()))). (
6390: 73 65 74 21 20 2a 64 62 2d 6b 65 79 73 2a 20 72 set! *db-keys* r
63a0: 65 73 29 0a 20 20 20 20 20 20 20 72 65 73 29 29 es). res))
63b0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
63c0: 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 65 29 20 get-keys-write)
63d0: 3b 3b 20 64 75 6d 6d 79 20 71 75 65 72 79 20 74 ;; dummy query t
63e0: 6f 20 66 6f 72 63 65 20 73 65 72 76 65 72 20 73 o force server s
63f0: 74 61 72 74 0a 20 20 28 6c 65 74 20 28 28 72 65 tart. (let ((re
6400: 73 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 s (rmt:send-rece
6410: 69 76 65 20 27 67 65 74 2d 6b 65 79 73 2d 77 72 ive 'get-keys-wr
6420: 69 74 65 20 23 66 20 27 28 29 29 29 29 0a 20 20 ite #f '()))).
6430: 20 20 28 73 65 74 21 20 2a 64 62 2d 6b 65 79 73 (set! *db-keys
6440: 2a 20 72 65 73 29 0a 20 20 20 20 72 65 73 29 29 * res). res))
6450: 0a 0a 3b 3b 20 77 65 20 64 6f 6e 27 74 20 72 65 ..;; we don't re
6460: 75 73 65 20 72 75 6e 2d 69 64 27 73 20 28 65 78 use run-id's (ex
6470: 63 65 70 74 20 70 6f 73 73 69 62 6c 79 20 2a 61 cept possibly *a
6480: 66 74 65 72 2a 20 61 20 64 62 20 63 6c 65 61 6e fter* a db clean
6490: 75 70 29 20 73 6f 20 69 74 20 69 73 20 73 61 66 up) so it is saf
64a0: 65 0a 3b 3b 20 74 6f 20 63 61 63 68 65 20 74 68 e.;; to cache th
64b0: 65 20 72 65 73 75 6c 73 20 69 6e 20 61 20 68 61 e resuls in a ha
64c0: 73 68 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 sh.;;.(define (r
64d0: 6d 74 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 mt:get-key-vals
64e0: 72 75 6e 2d 69 64 29 0a 20 20 28 6f 72 20 28 68 run-id). (or (h
64f0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6500: 66 61 75 6c 74 20 2a 6b 65 79 76 61 6c 73 2a 20 fault *keyvals*
6510: 72 75 6e 2d 69 64 20 23 66 29 0a 20 20 20 20 20 run-id #f).
6520: 20 28 6c 65 74 20 28 28 72 65 73 20 28 72 6d 74 (let ((res (rmt
6530: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
6540: 65 74 2d 6b 65 79 2d 76 61 6c 73 20 23 66 20 28 et-key-vals #f (
6550: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 29 0a list run-id)))).
6560: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
6570: 62 6c 65 2d 73 65 74 21 20 2a 6b 65 79 76 61 6c ble-set! *keyval
6580: 73 2a 20 72 75 6e 2d 69 64 20 72 65 73 29 0a 20 s* run-id res).
6590: 20 20 20 20 20 20 20 72 65 73 29 29 29 0a 0a 28 res)))..(
65a0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
65b0: 74 61 72 67 65 74 73 29 0a 20 20 28 72 6d 74 3a targets). (rmt:
65c0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
65d0: 74 2d 74 61 72 67 65 74 73 20 23 66 20 27 28 29 t-targets #f '()
65e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
65f0: 3a 67 65 74 2d 74 61 72 67 65 74 20 72 75 6e 2d :get-target run-
6600: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
6610: 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 61 72 receive 'get-tar
6620: 67 65 74 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 get run-id (list
6630: 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 run-id)))..(def
6640: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ine (rmt:get-run
6650: 2d 74 69 6d 65 73 20 72 75 6e 70 61 74 74 20 74 -times runpatt t
6660: 61 72 67 65 74 70 61 74 74 29 0a 20 20 28 72 6d argetpatt). (rm
6670: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
6680: 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 20 23 66 get-run-times #f
6690: 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 20 74 (list runpatt t
66a0: 61 72 67 65 74 70 61 74 74 20 29 29 29 20 0a 0a argetpatt ))) ..
66b0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
66c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 20 54 20 =========.;; T
6700: 45 20 53 20 54 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d E S T S.;;======
6710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6750: 0a 0a 3b 3b 20 4a 75 73 74 20 73 6f 6d 65 20 73 ..;; Just some s
6760: 79 6e 74 61 74 69 63 20 73 75 67 61 72 0a 28 64 yntatic sugar.(d
6770: 65 66 69 6e 65 20 28 72 6d 74 3a 72 65 67 69 73 efine (rmt:regis
6780: 74 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 ter-test run-id
6790: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p
67a0: 61 74 68 29 0a 20 20 28 72 6d 74 3a 67 65 6e 65 ath). (rmt:gene
67b0: 72 61 6c 2d 63 61 6c 6c 20 27 72 65 67 69 73 74 ral-call 'regist
67c0: 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 72 er-test run-id r
67d0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
67e0: 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 item-path))..(de
67f0: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 fine (rmt:get-te
6800: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 st-id run-id tes
6810: 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 tname item-path)
6820: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
6830: 65 69 76 65 20 27 67 65 74 2d 74 65 73 74 2d 69 eive 'get-test-i
6840: 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 d run-id (list r
6850: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
6860: 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 3b 3b 20 tem-path)))..;;
6870: 72 75 6e 2d 69 64 20 69 73 20 4e 4f 54 20 75 73 run-id is NOT us
6880: 65 64 20 2d 20 62 75 74 20 69 74 20 77 69 6c 6c ed - but it will
6890: 20 62 65 21 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 be! .;;.(define
68a0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
68b0: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
68c0: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 69 66 20 test-id). (if
68d0: 28 6e 75 6d 62 65 72 3f 20 74 65 73 74 2d 69 64 (number? test-id
68e0: 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ). (let* ((
68f0: 74 65 73 74 64 61 74 20 20 28 72 6d 74 3a 73 65 testdat (rmt:se
6900: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
6910: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 test-info-by-id
6920: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
6930: 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 0a 09 -id test-id)))..
6940: 20 20 20 20 20 28 74 72 75 6e 64 61 74 66 20 28 (trundatf (
6950: 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 conc (db:test-ge
6960: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 64 61 74 t-rundir testdat
6970: 29 20 22 2f 2e 6d 74 5f 64 61 74 61 2f 74 65 73 ) "/.mt_data/tes
6980: 74 2d 72 75 6e 2e 64 61 74 22 29 29 29 0a 09 3b t-run.dat")))..;
6990: 3b 20 6e 6f 77 20 77 65 20 63 61 6e 20 75 70 64 ; now we can upd
69a0: 61 74 65 20 61 20 63 6f 75 70 6c 65 20 66 69 65 ate a couple fie
69b0: 6c 64 73 20 66 72 6f 6d 20 74 68 65 20 66 69 6c lds from the fil
69c0: 65 73 79 73 74 65 6d 0a 09 28 69 66 20 28 61 6e esystem..(if (an
69d0: 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 d (db:test-get-r
69e0: 75 6e 64 69 72 20 74 65 73 74 64 61 74 29 0a 09 undir testdat)..
69f0: 09 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 . (file-exists?
6a00: 74 72 75 6e 64 61 74 66 29 29 0a 09 20 20 20 20 trundatf))..
6a10: 28 6c 65 74 2a 20 28 28 64 75 72 61 74 69 6f 6e (let* ((duration
6a20: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
6a30: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
6a40: 74 64 61 74 29 29 0a 09 09 20 20 20 28 65 76 65 tdat))... (eve
6a50: 6e 74 2d 74 69 6d 65 20 28 64 62 3a 74 65 73 74 nt-time (db:test
6a60: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
6a70: 20 20 74 65 73 74 64 61 74 29 29 0a 09 09 20 20 testdat))...
6a80: 20 28 6c 61 73 74 2d 74 6f 75 63 68 20 28 66 69 (last-touch (fi
6a90: 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
6aa0: 74 69 6d 65 20 74 72 75 6e 64 61 74 66 29 29 29 time trundatf)))
6ab0: 0a 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 .. (db:test
6ac0: 2d 73 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -set-run_duratio
6ad0: 6e 21 20 74 65 73 74 64 61 74 20 28 6d 61 78 20 n! testdat (max
6ae0: 64 75 72 61 74 69 6f 6e 20 28 2d 20 6c 61 73 74 duration (- last
6af0: 2d 74 6f 75 63 68 20 65 76 65 6e 74 2d 74 69 6d -touch event-tim
6b00: 65 29 29 29 29 29 0a 09 74 65 73 74 64 61 74 29 e)))))..testdat)
6b10: 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 . (begin..(
6b20: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
6b30: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
6b40: 20 22 57 41 52 4e 49 4e 47 3a 20 42 61 64 20 64 "WARNING: Bad d
6b50: 61 74 61 20 68 61 6e 64 65 64 20 74 6f 20 72 6d ata handed to rm
6b60: 74 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d t:get-test-info-
6b70: 62 79 2d 69 64 20 72 75 6e 2d 69 64 3d 22 20 72 by-id run-id=" r
6b80: 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d 69 64 un-id ", test-id
6b90: 3d 22 20 74 65 73 74 2d 69 64 29 0a 09 28 70 72 =" test-id)..(pr
6ba0: 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 int-call-chain (
6bb0: 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f current-error-po
6bc0: 72 74 29 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 rt))..#f)))..(de
6bd0: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 fine (rmt:test-g
6be0: 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 et-rundir-from-t
6bf0: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 est-id run-id te
6c00: 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 st-id). (rmt:se
6c10: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
6c20: 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d -get-rundir-from
6c30: 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 -test-id run-id
6c40: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 (list run-id tes
6c50: 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 t-id)))..(define
6c60: 20 28 72 6d 74 3a 6f 70 65 6e 2d 74 65 73 74 2d (rmt:open-test-
6c70: 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 72 75 db-by-test-id ru
6c80: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 23 21 6b n-id test-id #!k
6c90: 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 ey (work-area #f
6ca0: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 )). (let* ((tes
6cb0: 74 2d 70 61 74 68 20 28 69 66 20 28 73 74 72 69 t-path (if (stri
6cc0: 6e 67 3f 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 ng? work-area)..
6cd0: 09 09 77 6f 72 6b 2d 61 72 65 61 0a 09 09 09 28 ..work-area....(
6ce0: 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e rmt:test-get-run
6cf0: 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 dir-from-test-id
6d00: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
6d10: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
6d20: 72 69 6e 74 20 33 20 2a 64 65 66 61 75 6c 74 2d rint 3 *default-
6d30: 6c 6f 67 2d 70 6f 72 74 2a 20 22 54 45 53 54 20 log-port* "TEST
6d40: 50 41 54 48 3a 20 22 20 74 65 73 74 2d 70 61 74 PATH: " test-pat
6d50: 68 29 0a 20 20 20 20 28 6f 70 65 6e 2d 74 65 73 h). (open-tes
6d60: 74 2d 64 62 20 74 65 73 74 2d 70 61 74 68 29 29 t-db test-path))
6d70: 29 0a 0a 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 54 )..;; WARNING: T
6d80: 68 69 73 20 63 75 72 72 65 6e 74 6c 79 20 62 79 his currently by
6d90: 70 61 73 73 65 73 20 74 68 65 20 74 72 61 6e 73 passes the trans
6da0: 61 63 74 69 6f 6e 20 77 72 61 70 70 65 64 20 77 action wrapped w
6db0: 72 69 74 65 73 20 73 79 73 74 65 6d 0a 28 64 65 rites system.(de
6dc0: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 fine (rmt:test-s
6dd0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
6de0: 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 by-id run-id tes
6df0: 74 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e 65 t-id newstate ne
6e00: 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 wstatus newcomme
6e10: 6e 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d nt). (rmt:send-
6e20: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 receive 'test-se
6e30: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 t-state-status-b
6e40: 79 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 y-id run-id (lis
6e50: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
6e60: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
6e70: 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 29 tus newcomment))
6e80: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
6e90: 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d set-tests-state-
6ea0: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 20 20 status run-id
6eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ec0: 20 20 20 74 65 73 74 6e 61 6d 65 73 20 63 75 72 testnames cur
6ed0: 72 73 74 61 74 65 20 63 75 72 72 73 74 61 74 75 rstate currstatu
6ee0: 73 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 s newstate newst
6ef0: 61 74 75 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e atus). (rmt:sen
6f00: 64 2d 72 65 63 65 69 76 65 20 27 73 65 74 2d 74 d-receive 'set-t
6f10: 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 ests-state-statu
6f20: 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 s run-id (list r
6f30: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 73 20 un-id testnames
6f40: 63 75 72 72 73 74 61 74 65 20 63 75 72 72 73 74 currstate currst
6f50: 61 74 75 73 20 6e 65 77 73 74 61 74 65 20 6e 65 atus newstate ne
6f60: 77 73 74 61 74 75 73 29 29 29 0a 0a 28 64 65 66 wstatus)))..(def
6f70: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 ine (rmt:get-tes
6f80: 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 ts-for-run run-i
6f90: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 d testpatt state
6fa0: 73 20 73 74 61 74 75 73 65 73 20 6f 66 66 73 65 s statuses offse
6fb0: 74 20 6c 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 t limit not-in s
6fc0: 6f 72 74 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 ort-by sort-orde
6fd0: 72 20 71 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 r qryvals last-u
6fe0: 70 64 61 74 65 20 6d 6f 64 65 29 0a 20 20 3b 3b pdate mode). ;;
6ff0: 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 72 75 (if (number? ru
7000: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
7010: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 d-receive 'get-t
7020: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e ests-for-run run
7030: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
7040: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 testpatt states
7050: 20 73 74 61 74 75 73 65 73 20 6f 66 66 73 65 74 statuses offset
7060: 20 6c 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 6f limit not-in so
7070: 72 74 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 rt-by sort-order
7080: 20 71 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 70 qryvals last-up
7090: 64 61 74 65 20 6d 6f 64 65 29 29 29 0a 20 20 3b date mode))). ;
70a0: 3b 20 20 20 20 28 62 65 67 69 6e 0a 20 20 3b 3b ; (begin. ;;
70b0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
70c0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
70d0: 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 67 65 og-port* "rmt:ge
70e0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
70f0: 63 61 6c 6c 65 64 20 77 69 74 68 20 62 61 64 20 called with bad
7100: 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 29 run-id=" run-id)
7110: 0a 20 20 3b 3b 09 28 70 72 69 6e 74 2d 63 61 6c . ;;.(print-cal
7120: 6c 2d 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 l-chain (current
7130: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 0a 20 20 -error-port)).
7140: 3b 3b 09 27 28 29 29 29 29 0a 0a 28 64 65 66 69 ;;.'())))..(defi
7150: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 ne (rmt:get-test
7160: 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d s-for-run-state-
7170: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 status run-id te
7180: 73 74 70 61 74 74 20 6c 61 73 74 2d 75 70 64 61 stpatt last-upda
7190: 74 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d te). (rmt:send-
71a0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 receive 'get-tes
71b0: 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 ts-for-run-state
71c0: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 28 -status run-id (
71d0: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
71e0: 70 61 74 74 20 6c 61 73 74 2d 75 70 64 61 74 65 patt last-update
71f0: 29 29 29 0a 0a 3b 3b 20 67 65 74 20 73 74 75 66 )))..;; get stuf
7200: 66 20 76 69 61 20 73 79 6e 63 68 61 73 68 20 0a f via synchash .
7210: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 79 6e (define (rmt:syn
7220: 63 68 61 73 68 2d 67 65 74 20 72 75 6e 2d 69 64 chash-get run-id
7230: 20 70 72 6f 63 20 73 79 6e 63 6b 65 79 20 6b 65 proc synckey ke
7240: 79 6e 75 6d 20 70 61 72 61 6d 73 29 0a 20 20 28 ynum params). (
7250: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7260: 20 27 73 79 6e 63 68 61 73 68 2d 67 65 74 20 72 'synchash-get r
7270: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
7280: 69 64 20 70 72 6f 63 20 73 79 6e 63 6b 65 79 20 id proc synckey
7290: 6b 65 79 6e 75 6d 20 70 61 72 61 6d 73 29 29 29 keynum params)))
72a0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
72b0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
72c0: 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 20 -mindata run-id
72d0: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
72e0: 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 0a 20 status not-in).
72f0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7300: 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 66 6f ve 'get-tests-fo
7310: 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 72 75 r-run-mindata ru
7320: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
7330: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 d testpatt state
7340: 73 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 s status not-in)
7350: 29 29 0a 20 20 0a 3b 3b 20 49 44 45 41 3a 20 54 )). .;; IDEA: T
7360: 68 72 65 61 64 69 66 79 20 74 68 65 73 65 20 2d hreadify these -
7370: 20 74 68 65 79 20 73 70 65 6e 64 20 61 20 6c 6f they spend a lo
7380: 74 20 6f 66 20 74 69 6d 65 20 77 61 69 74 69 6e t of time waitin
7390: 67 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 g ....;;.(define
73a0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
73b0: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 for-runs-mindata
73c0: 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 run-ids testpat
73d0: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 t states status
73e0: 6e 6f 74 2d 69 6e 29 0a 20 20 28 6c 65 74 20 28 not-in). (let (
73f0: 28 6d 75 6c 74 69 2d 72 75 6e 2d 6d 75 74 65 78 (multi-run-mutex
7400: 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 09 (make-mutex))..
7410: 28 72 75 6e 2d 69 64 2d 6c 69 73 74 20 28 69 66 (run-id-list (if
7420: 20 72 75 6e 2d 69 64 73 0a 09 09 09 20 72 75 6e run-ids.... run
7430: 2d 69 64 73 0a 09 09 09 20 28 72 6d 74 3a 67 65 -ids.... (rmt:ge
7440: 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 t-all-run-ids)))
7450: 0a 09 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 ..(result '
7460: 28 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 ())). (if (nu
7470: 6c 6c 3f 20 72 75 6e 2d 69 64 2d 6c 69 73 74 29 ll? run-id-list)
7480: 0a 09 27 28 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 ..'()..(let loop
7490: 20 28 28 68 65 64 20 20 20 20 20 28 63 61 72 20 ((hed (car
74a0: 72 75 6e 2d 69 64 2d 6c 69 73 74 29 29 0a 09 09 run-id-list))...
74b0: 20 20 20 28 74 61 6c 20 20 20 20 20 28 63 64 72 (tal (cdr
74c0: 20 72 75 6e 2d 69 64 2d 6c 69 73 74 29 29 0a 09 run-id-list))..
74d0: 09 20 20 20 28 74 68 72 65 61 64 73 20 27 28 29 . (threads '()
74e0: 29 29 0a 09 20 20 28 69 66 20 28 3e 20 28 6c 65 )).. (if (> (le
74f0: 6e 67 74 68 20 74 68 72 65 61 64 73 29 20 35 29 ngth threads) 5)
7500: 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 68 65 .. (loop he
7510: 64 20 74 61 6c 20 28 66 69 6c 74 65 72 20 28 6c d tal (filter (l
7520: 61 6d 62 64 61 20 28 74 68 29 28 6e 6f 74 20 28 ambda (th)(not (
7530: 6d 65 6d 62 65 72 20 28 74 68 72 65 61 64 2d 73 member (thread-s
7540: 74 61 74 65 20 74 68 29 20 27 28 74 65 72 6d 69 tate th) '(termi
7550: 6e 61 74 65 64 20 64 65 61 64 29 29 29 29 20 74 nated dead)))) t
7560: 68 72 65 61 64 73 29 29 0a 09 20 20 20 20 20 20 hreads))..
7570: 28 6c 65 74 2a 20 28 28 6e 65 77 74 68 72 65 61 (let* ((newthrea
7580: 64 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 0a 09 d (make-thread..
7590: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 ... (lambda ()..
75a0: 09 09 09 20 20 20 28 6c 65 74 20 28 28 72 65 73 ... (let ((res
75b0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
75c0: 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 66 6f ve 'get-tests-fo
75d0: 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 68 65 r-run-mindata he
75e0: 64 20 28 6c 69 73 74 20 68 65 64 20 74 65 73 74 d (list hed test
75f0: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
7600: 75 73 20 6e 6f 74 2d 69 6e 29 29 29 29 0a 09 09 us not-in))))...
7610: 09 09 20 20 20 20 20 28 69 66 20 28 6c 69 73 74 .. (if (list
7620: 3f 20 72 65 73 29 0a 09 09 09 09 09 20 28 62 65 ? res)...... (be
7630: 67 69 6e 0a 09 09 09 09 09 20 20 20 28 6d 75 74 gin...... (mut
7640: 65 78 2d 6c 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 ex-lock! multi-r
7650: 75 6e 2d 6d 75 74 65 78 29 0a 09 09 09 09 09 20 un-mutex)......
7660: 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 (set! result (
7670: 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 72 65 append result re
7680: 73 29 29 0a 09 09 09 09 09 20 20 20 28 6d 75 74 s))...... (mut
7690: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 75 6c 74 69 ex-unlock! multi
76a0: 2d 72 75 6e 2d 6d 75 74 65 78 29 29 0a 09 09 09 -run-mutex))....
76b0: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
76c0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
76d0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 67 65 74 2d -log-port* "get-
76e0: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 tests-for-run-mi
76f0: 6e 64 61 74 61 20 66 61 69 6c 65 64 20 66 6f 72 ndata failed for
7700: 20 72 75 6e 2d 69 64 20 22 20 68 65 64 20 22 2c run-id " hed ",
7710: 20 74 65 73 74 70 61 74 74 20 22 20 74 65 73 74 testpatt " test
7720: 70 61 74 74 20 22 2c 20 73 74 61 74 65 73 20 22 patt ", states "
7730: 20 73 74 61 74 65 73 20 22 2c 20 73 74 61 74 75 states ", statu
7740: 73 20 22 20 73 74 61 74 75 73 20 22 2c 20 6e 6f s " status ", no
7750: 74 2d 69 6e 20 22 20 6e 6f 74 2d 69 6e 29 29 29 t-in " not-in)))
7760: 29 0a 09 09 09 09 20 28 63 6f 6e 63 20 22 6d 75 )..... (conc "mu
7770: 6c 74 69 2d 72 75 6e 2d 74 68 72 65 61 64 20 66 lti-run-thread f
7780: 6f 72 20 72 75 6e 2d 69 64 20 22 20 68 65 64 29 or run-id " hed)
7790: 29 29 0a 09 09 20 20 20 20 20 28 6e 65 77 74 68 ))... (newth
77a0: 72 65 61 64 73 20 28 63 6f 6e 73 20 6e 65 77 74 reads (cons newt
77b0: 68 72 65 61 64 20 74 68 72 65 61 64 73 29 29 29 hread threads)))
77c0: 0a 09 09 28 74 68 72 65 61 64 2d 73 74 61 72 74 ...(thread-start
77d0: 21 20 6e 65 77 74 68 72 65 61 64 29 0a 09 09 28 ! newthread)...(
77e0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e thread-sleep! 0.
77f0: 30 35 29 20 3b 3b 20 67 69 76 65 20 74 68 61 74 05) ;; give that
7800: 20 74 68 72 65 61 64 20 73 6f 6d 65 20 74 69 6d thread some tim
7810: 65 20 74 6f 20 73 74 61 72 74 0a 09 09 28 69 66 e to start...(if
7820: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 (null? tal)...
7830: 20 20 20 6e 65 77 74 68 72 65 61 64 73 0a 09 09 newthreads...
7840: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t
7850: 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 al)(cdr tal) new
7860: 74 68 72 65 61 64 73 29 29 29 29 29 29 0a 20 20 threads)))))).
7870: 20 20 72 65 73 75 6c 74 29 29 0a 0a 3b 3b 20 3b result))..;; ;
7880: 3b 20 49 44 45 41 3a 20 54 68 72 65 61 64 69 66 ; IDEA: Threadif
7890: 79 20 74 68 65 73 65 20 2d 20 74 68 65 79 20 73 y these - they s
78a0: 70 65 6e 64 20 61 20 6c 6f 74 20 6f 66 20 74 69 pend a lot of ti
78b0: 6d 65 20 77 61 69 74 69 6e 67 20 2e 2e 2e 0a 3b me waiting ....;
78c0: 3b 20 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 20 ; ;;.;; (define
78d0: 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 (rmt:get-tests-f
78e0: 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 or-runs-mindata
78f0: 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74 run-ids testpatt
7900: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 6e states status n
7910: 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 28 6c 65 74 ot-in).;; (let
7920: 20 28 28 72 75 6e 2d 69 64 2d 6c 69 73 74 20 28 ((run-id-list (
7930: 69 66 20 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 09 if run-ids.;; ..
7940: 09 20 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 09 09 . run-ids.;; ...
7950: 20 28 72 6d 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 (rmt:get-all-ru
7960: 6e 2d 69 64 73 29 29 29 29 0a 3b 3b 20 20 20 20 n-ids)))).;;
7970: 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 20 28 (apply append (
7980: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e map (lambda (run
7990: 2d 69 64 29 0a 3b 3b 20 09 09 09 20 28 72 6d 74 -id).;; ... (rmt
79a0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
79b0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
79c0: 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 20 -mindata run-id
79d0: 28 6c 69 73 74 20 72 75 6e 2d 69 64 73 20 74 65 (list run-ids te
79e0: 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 stpatt states st
79f0: 61 74 75 73 20 6e 6f 74 2d 69 6e 29 29 29 0a 3b atus not-in))).;
7a00: 3b 20 09 09 20 20 20 20 20 20 20 72 75 6e 2d 69 ; .. run-i
7a10: 64 2d 6c 69 73 74 29 29 29 29 0a 0a 28 64 65 66 d-list))))..(def
7a20: 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d ine (rmt:delete-
7a30: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 72 75 6e test-records run
7a40: 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 -id test-id). (
7a50: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7a60: 20 27 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 'delete-test-re
7a70: 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 28 6c 69 cords run-id (li
7a80: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
7a90: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
7aa0: 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 mt:test-set-stat
7ab0: 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 e-status run-id
7ac0: 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 73 74 test-id state st
7ad0: 61 74 75 73 20 6d 73 67 29 0a 20 20 28 72 6d 74 atus msg). (rmt
7ae0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
7af0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
7b00: 61 74 75 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 atus run-id (lis
7b10: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
7b20: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6d 73 state status ms
7b30: 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 g)))..(define (r
7b40: 6d 74 3a 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c mt:test-toplevel
7b50: 2d 6e 75 6d 2d 69 74 65 6d 73 20 72 75 6e 2d 69 -num-items run-i
7b60: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 d test-name). (
7b70: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7b80: 20 27 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 'test-toplevel-
7b90: 6e 75 6d 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 num-items run-id
7ba0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
7bb0: 73 74 2d 6e 61 6d 65 29 29 29 0a 0a 3b 3b 20 28 st-name)))..;; (
7bc0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
7bd0: 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 previous-test-ru
7be0: 6e 2d 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 20 n-record run-id
7bf0: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p
7c00: 61 74 68 29 0a 3b 3b 20 20 20 28 72 6d 74 3a 73 ath).;; (rmt:s
7c10: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
7c20: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
7c30: 75 6e 2d 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 un-record run-id
7c40: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
7c50: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
7c60: 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 h)))..(define (r
7c70: 6d 74 3a 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d mt:get-matching-
7c80: 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 previous-test-ru
7c90: 6e 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 n-records run-id
7ca0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
7cb0: 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e path). (rmt:sen
7cc0: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6d d-receive 'get-m
7cd0: 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 atching-previous
7ce0: 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 -test-run-record
7cf0: 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 s run-id (list r
7d00: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
7d10: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 28 64 item-path)))..(d
7d20: 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d efine (rmt:test-
7d30: 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f get-logfile-info
7d40: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
7d50: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
7d60: 65 63 65 69 76 65 20 27 74 65 73 74 2d 67 65 74 eceive 'test-get
7d70: 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 72 75 -logfile-info ru
7d80: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
7d90: 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 0a d test-name)))..
7da0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 (define (rmt:tes
7db0: 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f t-get-records-fo
7dc0: 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 72 75 6e r-index-file run
7dd0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 -id test-name).
7de0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7df0: 76 65 20 27 74 65 73 74 2d 67 65 74 2d 72 65 63 ve 'test-get-rec
7e00: 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 ords-for-index-f
7e10: 69 6c 65 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 ile run-id (list
7e20: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
7e30: 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 e)))..(define (r
7e40: 6d 74 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d mt:get-testinfo-
7e50: 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e state-status run
7e60: 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 -id test-id). (
7e70: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7e80: 20 27 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 'get-testinfo-s
7e90: 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d tate-status run-
7ea0: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 id (list run-id
7eb0: 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 test-id)))..(def
7ec0: 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 ine (rmt:test-se
7ed0: 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 t-log! run-id te
7ee0: 73 74 2d 69 64 20 6c 6f 67 66 29 0a 20 20 28 69 st-id logf). (i
7ef0: 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 29 f (string? logf)
7f00: 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c (rmt:general-cal
7f10: 6c 20 27 74 65 73 74 2d 73 65 74 2d 6c 6f 67 20 l 'test-set-log
7f20: 72 75 6e 2d 69 64 20 6c 6f 67 66 20 74 65 73 74 run-id logf test
7f30: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
7f40: 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 74 6f (rmt:test-set-to
7f50: 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 p-process-pid ru
7f60: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 64 n-id test-id pid
7f70: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
7f80: 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 74 2d ceive 'test-set-
7f90: 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 top-process-pid
7fa0: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
7fb0: 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 64 29 -id test-id pid)
7fc0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
7fd0: 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 :test-get-top-pr
7fe0: 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 ocess-pid run-id
7ff0: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 test-id). (rmt
8000: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
8010: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
8020: 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 28 ess-pid run-id (
8030: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
8040: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
8050: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 64 73 (rmt:get-run-ids
8060: 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 -matching-target
8070: 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 keynames target
8080: 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 res runname tes
8090: 74 70 61 74 74 20 73 74 61 74 65 70 61 74 74 20 tpatt statepatt
80a0: 73 74 61 74 75 73 70 61 74 74 29 0a 20 20 28 72 statuspatt). (r
80b0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
80c0: 27 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 'get-run-ids-mat
80d0: 63 68 69 6e 67 2d 74 61 72 67 65 74 20 23 66 20 ching-target #f
80e0: 28 6c 69 73 74 20 6b 65 79 6e 61 6d 65 73 20 74 (list keynames t
80f0: 61 72 67 65 74 20 72 65 73 20 72 75 6e 6e 61 6d arget res runnam
8100: 65 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 e testpatt state
8110: 70 61 74 74 20 73 74 61 74 75 73 70 61 74 74 29 patt statuspatt)
8120: 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 69 ))..;; NOTE: Thi
8130: 73 20 77 69 6c 6c 20 6f 70 65 6e 20 61 6e 64 20 s will open and
8140: 61 63 63 65 73 73 20 41 4c 4c 20 72 75 6e 20 64 access ALL run d
8150: 61 74 61 62 61 73 65 73 2e 20 0a 3b 3b 0a 28 64 atabases. .;;.(d
8160: 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d efine (rmt:test-
8170: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
8180: 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 ng-keynames-targ
8190: 65 74 2d 6e 65 77 20 6b 65 79 6e 61 6d 65 73 20 et-new keynames
81a0: 74 61 72 67 65 74 20 72 65 73 20 74 65 73 74 70 target res testp
81b0: 61 74 74 20 73 74 61 74 65 70 61 74 74 20 73 74 att statepatt st
81c0: 61 74 75 73 70 61 74 74 20 72 75 6e 6e 61 6d 65 atuspatt runname
81d0: 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 ). (let ((run-i
81e0: 64 73 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d ds (rmt:get-run-
81f0: 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 ids-matching-tar
8200: 67 65 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 get keynames tar
8210: 67 65 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 get res runname
8220: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 70 61 testpatt statepa
8230: 74 74 20 73 74 61 74 75 73 70 61 74 74 29 29 29 tt statuspatt)))
8240: 0a 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 65 . (apply appe
8250: 6e 64 20 0a 09 20 20 20 28 6d 61 70 20 28 6c 61 nd .. (map (la
8260: 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 09 mbda (run-id)...
8270: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
8280: 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d 70 61 ive 'test-get-pa
8290: 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 ths-matching-key
82a0: 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 names-target-new
82b0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
82c0: 6e 2d 69 64 20 6b 65 79 6e 61 6d 65 73 20 74 61 n-id keynames ta
82d0: 72 67 65 74 20 72 65 73 20 74 65 73 74 70 61 74 rget res testpat
82e0: 74 20 73 74 61 74 65 70 61 74 74 20 73 74 61 74 t statepatt stat
82f0: 75 73 70 61 74 74 20 72 75 6e 6e 61 6d 65 29 29 uspatt runname))
8300: 29 0a 09 20 20 20 72 75 6e 2d 69 64 73 29 29 29 ).. run-ids)))
8310: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
8320: 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d get-prereqs-not-
8330: 6d 65 74 20 72 75 6e 2d 69 64 20 77 61 69 74 6f met run-id waito
8340: 6e 73 20 72 65 66 2d 74 65 73 74 2d 6e 61 6d 65 ns ref-test-name
8350: 20 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 23 ref-item-path #
8360: 21 6b 65 79 20 28 6d 6f 64 65 20 27 28 6e 6f 72 !key (mode '(nor
8370: 6d 61 6c 29 29 28 69 74 65 6d 6d 61 70 73 20 23 mal))(itemmaps #
8380: 66 29 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d f)). (rmt:send-
8390: 72 65 63 65 69 76 65 20 27 67 65 74 2d 70 72 65 receive 'get-pre
83a0: 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 6e reqs-not-met run
83b0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
83c0: 20 77 61 69 74 6f 6e 73 20 72 65 66 2d 74 65 73 waitons ref-tes
83d0: 74 2d 6e 61 6d 65 20 72 65 66 2d 69 74 65 6d 2d t-name ref-item-
83e0: 70 61 74 68 20 6d 6f 64 65 20 69 74 65 6d 6d 61 path mode itemma
83f0: 70 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ps)))..(define (
8400: 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 rmt:get-count-te
8410: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d sts-running-for-
8420: 72 75 6e 2d 69 64 20 72 75 6e 2d 69 64 20 66 61 run-id run-id fa
8430: 73 74 6d 6f 64 65 29 0a 20 20 28 72 6d 74 3a 73 stmode). (rmt:s
8440: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
8450: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
8460: 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 ning-for-run-id
8470: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
8480: 2d 69 64 20 66 61 73 74 6d 6f 64 65 29 29 29 0a -id fastmode))).
8490: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
84a0: 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d t-not-completed-
84b0: 63 6e 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 cnt run-id). (r
84c0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
84d0: 27 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 'get-not-complet
84e0: 65 64 2d 63 6e 74 20 72 75 6e 2d 69 64 20 28 6c ed-cnt run-id (l
84f0: 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 0a ist run-id)))...
8500: 3b 3b 20 53 74 61 74 69 73 74 69 63 61 6c 20 71 ;; Statistical q
8510: 75 65 72 69 65 73 0a 0a 28 64 65 66 69 6e 65 20 ueries..(define
8520: 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 (rmt:get-count-t
8530: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 20 72 75 6e ests-running run
8540: 2d 69 64 20 66 61 73 74 6d 6f 64 65 29 0a 20 20 -id fastmode).
8550: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
8560: 65 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 e 'get-count-tes
8570: 74 73 2d 72 75 6e 6e 69 6e 67 20 72 75 6e 2d 69 ts-running run-i
8580: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 66 d (list run-id f
8590: 61 73 74 6d 6f 64 65 29 29 29 0a 0a 28 64 65 66 astmode)))..(def
85a0: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 ine (rmt:get-cou
85b0: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
85c0: 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 20 72 75 -for-testname ru
85d0: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 29 0a 20 n-id testname).
85e0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
85f0: 76 65 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 ve 'get-count-te
8600: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d sts-running-for-
8610: 74 65 73 74 6e 61 6d 65 20 72 75 6e 2d 69 64 20 testname run-id
8620: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 (list run-id tes
8630: 74 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e tname)))..(defin
8640: 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 e (rmt:get-count
8650: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 -tests-running-i
8660: 6e 2d 6a 6f 62 67 72 6f 75 70 20 72 75 6e 2d 69 n-jobgroup run-i
8670: 64 20 6a 6f 62 67 72 6f 75 70 29 0a 20 20 28 72 d jobgroup). (r
8680: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8690: 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 'get-count-tests
86a0: 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 -running-in-jobg
86b0: 72 6f 75 70 20 72 75 6e 2d 69 64 20 28 6c 69 73 roup run-id (lis
86c0: 74 20 72 75 6e 2d 69 64 20 6a 6f 62 67 72 6f 75 t run-id jobgrou
86d0: 70 29 29 29 0a 0a 3b 3b 20 73 74 61 74 65 20 61 p)))..;; state a
86e0: 6e 64 20 73 74 61 74 75 73 20 61 72 65 20 65 78 nd status are ex
86f0: 74 72 61 20 68 69 6e 74 73 20 6e 6f 74 20 75 73 tra hints not us
8700: 75 61 6c 6c 79 20 75 73 65 64 20 69 6e 20 74 68 ually used in th
8710: 65 20 63 61 6c 63 75 6c 61 74 69 6f 6e 0a 3b 3b e calculation.;;
8720: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 .(define (rmt:se
8730: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 t-state-status-a
8740: 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 nd-roll-up-items
8750: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
8760: 65 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 e item-path stat
8770: 65 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 e status comment
8780: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
8790: 63 65 69 76 65 20 27 73 65 74 2d 73 74 61 74 65 ceive 'set-state
87a0: 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c -status-and-roll
87b0: 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 -up-items run-id
87c0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
87d0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
87e0: 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20 63 h state status c
87f0: 6f 6d 6d 65 6e 74 29 29 29 0a 0a 28 64 65 66 69 omment)))..(defi
8800: 6e 65 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 ne (rmt:set-stat
8810: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
8820: 6c 2d 75 70 2d 72 75 6e 20 72 75 6e 2d 69 64 20 l-up-run run-id
8830: 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 20 20 state status).
8840: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
8850: 65 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 e 'set-state-sta
8860: 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d tus-and-roll-up-
8870: 72 75 6e 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 run run-id (list
8880: 20 72 75 6e 2d 69 64 20 73 74 61 74 65 20 73 74 run-id state st
8890: 61 74 75 73 29 29 29 0a 0a 0a 28 64 65 66 69 6e atus)))...(defin
88a0: 65 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 70 61 e (rmt:update-pa
88b0: 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 ss-fail-counts r
88c0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 un-id test-name)
88d0: 0a 20 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d . (rmt:general-
88e0: 63 61 6c 6c 20 27 75 70 64 61 74 65 2d 70 61 73 call 'update-pas
88f0: 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 s-fail-counts ru
8900: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 74 n-id test-name t
8910: 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 est-name test-na
8920: 6d 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 me))..(define (r
8930: 6d 74 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d mt:top-test-set-
8940: 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 72 75 per-pf-counts ru
8950: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a n-id test-name).
8960: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
8970: 69 76 65 20 27 74 6f 70 2d 74 65 73 74 2d 73 65 ive 'top-test-se
8980: 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 t-per-pf-counts
8990: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
89a0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 -id test-name)))
89b0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
89c0: 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 et-raw-run-stats
89d0: 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a run-id). (rmt:
89e0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
89f0: 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 t-raw-run-stats
8a00: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
8a10: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
8a20: 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 74 69 (rmt:get-test-ti
8a30: 6d 65 73 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 mes runname targ
8a40: 65 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d et). (rmt:send-
8a50: 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 receive 'get-tes
8a60: 74 2d 74 69 6d 65 73 20 23 66 20 28 6c 69 73 74 t-times #f (list
8a70: 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 20 runname target
8a80: 29 29 29 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))) ..;;========
8a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
8ad0: 3b 20 20 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d ; R U N S.;;===
8ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b20: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d ===..(define (rm
8b30: 74 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 t:get-run-info r
8b40: 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 un-id). (rmt:se
8b50: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
8b60: 72 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 run-info run-id
8b70: 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a (list run-id))).
8b80: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
8b90: 74 2d 6e 75 6d 2d 72 75 6e 73 20 72 75 6e 70 61 t-num-runs runpa
8ba0: 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d tt). (rmt:send-
8bb0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 6e 75 6d receive 'get-num
8bc0: 2d 72 75 6e 73 20 23 66 20 28 6c 69 73 74 20 72 -runs #f (list r
8bd0: 75 6e 70 61 74 74 29 29 29 0a 0a 28 64 65 66 69 unpatt)))..(defi
8be0: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 ne (rmt:get-runs
8bf0: 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 72 75 6e -cnt-by-patt run
8c00: 70 61 74 74 20 74 61 72 67 65 74 70 61 74 74 20 patt targetpatt
8c10: 6b 65 79 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e keys). (rmt:sen
8c20: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 d-receive 'get-r
8c30: 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 uns-cnt-by-patt
8c40: 23 66 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 #f (list runpatt
8c50: 20 20 74 61 72 67 65 74 70 61 74 74 20 6b 65 79 targetpatt key
8c60: 73 29 29 29 0a 0a 3b 3b 20 55 73 65 20 74 68 65 s)))..;; Use the
8c70: 20 73 70 65 63 69 61 6c 20 72 75 6e 2d 69 64 20 special run-id
8c80: 3d 3d 20 23 66 20 73 63 65 6e 61 72 69 6f 20 68 == #f scenario h
8c90: 65 72 65 20 73 69 6e 63 65 20 74 68 65 72 65 20 ere since there
8ca0: 69 73 20 6e 6f 20 72 75 6e 20 79 65 74 0a 28 64 is no run yet.(d
8cb0: 65 66 69 6e 65 20 28 72 6d 74 3a 72 65 67 69 73 efine (rmt:regis
8cc0: 74 65 72 2d 72 75 6e 20 6b 65 79 76 61 6c 73 20 ter-run keyvals
8cd0: 72 75 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 74 runname state st
8ce0: 61 74 75 73 20 75 73 65 72 20 63 6f 6e 74 6f 75 atus user contou
8cf0: 72 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 r). (rmt:send-r
8d00: 65 63 65 69 76 65 20 27 72 65 67 69 73 74 65 72 eceive 'register
8d10: 2d 72 75 6e 20 23 66 20 28 6c 69 73 74 20 6b 65 -run #f (list ke
8d20: 79 76 61 6c 73 20 72 75 6e 6e 61 6d 65 20 73 74 yvals runname st
8d30: 61 74 65 20 73 74 61 74 75 73 20 75 73 65 72 20 ate status user
8d40: 63 6f 6e 74 6f 75 72 29 29 29 0a 20 20 20 20 0a contour))). .
8d50: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
8d60: 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 -run-name-from-i
8d70: 64 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 d run-id). (rmt
8d80: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
8d90: 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d et-run-name-from
8da0: 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 -id run-id (list
8db0: 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 run-id)))..(def
8dc0: 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d ine (rmt:delete-
8dd0: 72 75 6e 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 run run-id). (r
8de0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8df0: 27 64 65 6c 65 74 65 2d 72 75 6e 20 72 75 6e 2d 'delete-run run-
8e00: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 id (list run-id)
8e10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
8e20: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 :update-run-stat
8e30: 73 20 72 75 6e 2d 69 64 20 73 74 61 74 73 29 0a s run-id stats).
8e40: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
8e50: 69 76 65 20 27 75 70 64 61 74 65 2d 72 75 6e 2d ive 'update-run-
8e60: 73 74 61 74 73 20 23 66 20 28 6c 69 73 74 20 72 stats #f (list r
8e70: 75 6e 2d 69 64 20 73 74 61 74 73 29 29 29 0a 0a un-id stats)))..
8e80: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 6c (define (rmt:del
8e90: 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d ete-old-deleted-
8ea0: 74 65 73 74 2d 72 65 63 6f 72 64 73 29 0a 20 20 test-records).
8eb0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
8ec0: 65 20 27 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 e 'delete-old-de
8ed0: 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 leted-test-recor
8ee0: 64 73 20 23 66 20 27 28 29 29 29 0a 0a 28 64 65 ds #f '()))..(de
8ef0: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 fine (rmt:get-ru
8f00: 6e 73 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 ns runpatt count
8f10: 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 offset keypatts
8f20: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
8f30: 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e 73 20 ceive 'get-runs
8f40: 23 66 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 #f (list runpatt
8f50: 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 6b 65 count offset ke
8f60: 79 70 61 74 74 73 29 29 29 0a 0a 28 64 65 66 69 ypatts)))..(defi
8f70: 6e 65 20 28 72 6d 74 3a 73 69 6d 70 6c 65 2d 67 ne (rmt:simple-g
8f80: 65 74 2d 72 75 6e 73 20 72 75 6e 70 61 74 74 20 et-runs runpatt
8f90: 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 74 61 72 count offset tar
8fa0: 67 65 74 20 6c 61 73 74 2d 75 70 64 61 74 65 29 get last-update)
8fb0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
8fc0: 65 69 76 65 20 27 73 69 6d 70 6c 65 2d 67 65 74 eive 'simple-get
8fd0: 2d 72 75 6e 73 20 23 66 20 28 6c 69 73 74 20 72 -runs #f (list r
8fe0: 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f 66 66 unpatt count off
8ff0: 73 65 74 20 74 61 72 67 65 74 20 6c 61 73 74 2d set target last-
9000: 75 70 64 61 74 65 29 29 29 0a 0a 28 64 65 66 69 update)))..(defi
9010: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 61 6c 6c 2d ne (rmt:get-all-
9020: 72 75 6e 2d 69 64 73 29 0a 20 20 28 72 6d 74 3a run-ids). (rmt:
9030: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
9040: 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 23 66 t-all-run-ids #f
9050: 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 '()))..(define
9060: 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 75 (rmt:get-prev-ru
9070: 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 0a 20 20 n-ids run-id).
9080: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
9090: 65 20 27 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d e 'get-prev-run-
90a0: 69 64 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e ids #f (list run
90b0: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
90c0: 28 72 6d 74 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b (rmt:lock/unlock
90d0: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 6c 6f 63 6b -run run-id lock
90e0: 20 75 6e 6c 6f 63 6b 20 75 73 65 72 29 0a 20 20 unlock user).
90f0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
9100: 65 20 27 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 e 'lock/unlock-r
9110: 75 6e 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d un #f (list run-
9120: 69 64 20 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 id lock unlock u
9130: 73 65 72 29 29 29 0a 0a 3b 3b 20 73 65 74 2f 67 ser)))..;; set/g
9140: 65 74 20 73 74 61 74 75 73 0a 28 64 65 66 69 6e et status.(defin
9150: 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 e (rmt:get-run-s
9160: 74 61 74 75 73 20 72 75 6e 2d 69 64 29 0a 20 20 tatus run-id).
9170: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
9180: 65 20 27 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 e 'get-run-statu
9190: 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 s #f (list run-i
91a0: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
91b0: 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 65 mt:get-run-state
91c0: 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a run-id). (rmt:
91d0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
91e0: 74 2d 72 75 6e 2d 73 74 61 74 65 20 23 66 20 28 t-run-state #f (
91f0: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a list run-id)))..
9200: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 .(define (rmt:se
9210: 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 75 6e t-run-status run
9220: 2d 69 64 20 72 75 6e 2d 73 74 61 74 75 73 20 23 -id run-status #
9230: 21 6b 65 79 20 28 6d 73 67 20 23 66 29 29 0a 20 !key (msg #f)).
9240: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
9250: 76 65 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 74 ve 'set-run-stat
9260: 75 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d us #f (list run-
9270: 69 64 20 72 75 6e 2d 73 74 61 74 75 73 20 6d 73 id run-status ms
9280: 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 g)))..(define (r
9290: 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 65 mt:set-run-state
92a0: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 73 -status run-id s
92b0: 74 61 74 65 20 73 74 61 74 75 73 20 29 0a 20 20 tate status ).
92c0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
92d0: 65 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 74 65 e 'set-run-state
92e0: 2d 73 74 61 74 75 73 20 23 66 20 28 6c 69 73 74 -status #f (list
92f0: 20 72 75 6e 2d 69 64 20 73 74 61 74 65 20 73 74 run-id state st
9300: 61 74 75 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 atus)))..(define
9310: 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 74 65 73 (rmt:update-tes
9320: 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 data-on-repilcat
9330: 65 2d 64 62 20 6f 6c 64 2d 6c 74 20 6e 65 77 2d e-db old-lt new-
9340: 6c 74 29 0a 28 72 6d 74 3a 73 65 6e 64 2d 72 65 lt).(rmt:send-re
9350: 63 65 69 76 65 20 27 75 70 64 61 74 65 2d 74 65 ceive 'update-te
9360: 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 sdata-on-repilca
9370: 74 65 2d 64 62 20 23 66 20 28 6c 69 73 74 20 6f te-db #f (list o
9380: 6c 64 2d 6c 74 20 6e 65 77 2d 6c 74 29 29 29 0a ld-lt new-lt))).
9390: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 75 70 .(define (rmt:up
93a0: 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 date-run-event_t
93b0: 69 6d 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 ime run-id). (r
93c0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
93d0: 27 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 'update-run-even
93e0: 74 5f 74 69 6d 65 20 23 66 20 28 6c 69 73 74 20 t_time #f (list
93f0: 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 run-id)))..(defi
9400: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 ne (rmt:get-runs
9410: 2d 62 79 2d 70 61 74 74 20 20 6b 65 79 73 20 72 -by-patt keys r
9420: 75 6e 6e 61 6d 65 70 61 74 74 20 74 61 72 67 70 unnamepatt targp
9430: 61 74 74 20 6f 66 66 73 65 74 20 6c 69 6d 69 74 att offset limit
9440: 20 66 69 65 6c 64 73 20 6c 61 73 74 2d 72 75 6e fields last-run
9450: 73 2d 75 70 64 61 74 65 20 20 23 21 6b 65 79 20 s-update #!key
9460: 20 28 73 6f 72 74 2d 6f 72 64 65 72 20 22 61 73 (sort-order "as
9470: 63 22 29 29 20 3b 3b 20 66 69 65 6c 64 73 20 6f c")) ;; fields o
9480: 66 20 23 66 20 75 73 65 73 20 64 65 66 61 75 6c f #f uses defaul
9490: 74 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 t. (rmt:send-re
94a0: 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e 73 2d ceive 'get-runs-
94b0: 62 79 2d 70 61 74 74 20 23 66 20 28 6c 69 73 74 by-patt #f (list
94c0: 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 74 keys runnamepat
94d0: 74 20 74 61 72 67 70 61 74 74 20 6f 66 66 73 65 t targpatt offse
94e0: 74 20 6c 69 6d 69 74 20 66 69 65 6c 64 73 20 6c t limit fields l
94f0: 61 73 74 2d 72 75 6e 73 2d 75 70 64 61 74 65 20 ast-runs-update
9500: 73 6f 72 74 2d 6f 72 64 65 72 29 29 29 0a 0a 28 sort-order)))..(
9510: 64 65 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e 64 define (rmt:find
9520: 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 -and-mark-incomp
9530: 6c 65 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 2d lete run-id ovr-
9540: 64 65 61 64 74 69 6d 65 29 0a 20 20 3b 3b 20 28 deadtime). ;; (
9550: 69 66 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 if (rmt:send-rec
9560: 65 69 76 65 20 27 68 61 76 65 2d 69 6e 63 6f 6d eive 'have-incom
9570: 70 6c 65 74 65 73 3f 20 72 75 6e 2d 69 64 20 28 pletes? run-id (
9580: 6c 69 73 74 20 72 75 6e 2d 69 64 20 6f 76 72 2d list run-id ovr-
9590: 64 65 61 64 74 69 6d 65 29 29 0a 20 20 28 72 6d deadtime)). (rm
95a0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
95b0: 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 mark-incomplete
95c0: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
95d0: 2d 69 64 20 6f 76 72 2d 64 65 61 64 74 69 6d 65 -id ovr-deadtime
95e0: 29 29 29 20 3b 3b 20 29 0a 0a 28 64 65 66 69 6e ))) ;; )..(defin
95f0: 65 20 28 72 6d 74 3a 67 65 74 2d 6d 61 69 6e 2d e (rmt:get-main-
9600: 72 75 6e 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 run-stats run-id
9610: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
9620: 63 65 69 76 65 20 27 67 65 74 2d 6d 61 69 6e 2d ceive 'get-main-
9630: 72 75 6e 2d 73 74 61 74 73 20 23 66 20 28 6c 69 run-stats #f (li
9640: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
9650: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 76 efine (rmt:get-v
9660: 61 72 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 ar varname). (r
9670: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
9680: 27 67 65 74 2d 76 61 72 20 23 66 20 28 6c 69 73 'get-var #f (lis
9690: 74 20 76 61 72 6e 61 6d 65 29 29 29 0a 0a 28 64 t varname)))..(d
96a0: 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 6c 2d 76 efine (rmt:del-v
96b0: 61 72 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 ar varname). (r
96c0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
96d0: 27 64 65 6c 2d 76 61 72 20 23 66 20 28 6c 69 73 'del-var #f (lis
96e0: 74 20 76 61 72 6e 61 6d 65 29 29 29 0a 0a 28 64 t varname)))..(d
96f0: 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d 76 efine (rmt:set-v
9700: 61 72 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 ar varname value
9710: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
9720: 63 65 69 76 65 20 27 73 65 74 2d 76 61 72 20 23 ceive 'set-var #
9730: 66 20 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 20 f (list varname
9740: 76 61 6c 75 65 29 29 29 0a 0a 28 64 65 66 69 6e value)))..(defin
9750: 65 20 28 72 6d 74 3a 69 6e 63 2d 76 61 72 20 76 e (rmt:inc-var v
9760: 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 arname). (rmt:s
9770: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 69 6e 63 end-receive 'inc
9780: 2d 76 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 -var #f (list va
9790: 72 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e rname)))..(defin
97a0: 65 20 28 72 6d 74 3a 64 65 63 2d 76 61 72 20 76 e (rmt:dec-var v
97b0: 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 arname). (rmt:s
97c0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 63 end-receive 'dec
97d0: 2d 76 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 -var #f (list va
97e0: 72 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e rname)))..(defin
97f0: 65 20 28 72 6d 74 3a 61 64 64 2d 76 61 72 20 76 e (rmt:add-var v
9800: 61 72 6e 61 6d 65 20 76 61 6c 75 65 29 0a 20 20 arname value).
9810: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
9820: 65 20 27 61 64 64 2d 76 61 72 20 23 66 20 28 6c e 'add-var #f (l
9830: 69 73 74 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 ist varname valu
9840: 65 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d e)))..;;========
9850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
9890: 3b 20 4d 20 55 20 4c 20 54 20 49 20 52 20 55 20 ; M U L T I R U
98a0: 4e 20 20 20 51 20 55 20 45 20 52 20 49 20 45 20 N Q U E R I E
98b0: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
98c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e ==========..;; N
9900: 65 65 64 20 74 6f 20 6d 6f 76 65 20 74 68 69 73 eed to move this
9910: 20 74 6f 20 6d 75 6c 74 69 2d 72 75 6e 20 73 65 to multi-run se
9920: 63 74 69 6f 6e 20 61 6e 64 20 6d 61 6b 65 20 61 ction and make a
9930: 73 73 6f 63 69 61 74 65 64 20 63 68 61 6e 67 65 ssociated change
9940: 73 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 66 s.(define (rmt:f
9950: 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 ind-and-mark-inc
9960: 6f 6d 70 6c 65 74 65 2d 61 6c 6c 2d 72 75 6e 73 omplete-all-runs
9970: 20 23 21 6b 65 79 20 28 6f 76 72 2d 64 65 61 64 #!key (ovr-dead
9980: 74 69 6d 65 20 23 66 29 29 0a 20 20 28 6c 65 74 time #f)). (let
9990: 20 28 28 72 75 6e 2d 69 64 73 20 28 72 6d 74 3a ((run-ids (rmt:
99a0: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 get-all-run-ids)
99b0: 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 )). (for-each
99c0: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 (lambda (run-id
99d0: 29 0a 09 20 20 20 20 20 20 20 28 72 6d 74 3a 66 ).. (rmt:f
99e0: 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 ind-and-mark-inc
99f0: 6f 6d 70 6c 65 74 65 20 72 75 6e 2d 69 64 20 6f omplete run-id o
9a00: 76 72 2d 64 65 61 64 74 69 6d 65 29 29 0a 09 20 vr-deadtime))..
9a10: 20 20 20 20 72 75 6e 2d 69 64 73 29 29 29 0a 0a run-ids)))..
9a20: 3b 3b 20 67 65 74 20 74 68 65 20 70 72 65 76 69 ;; get the previ
9a30: 6f 75 73 20 72 65 63 6f 72 64 20 66 6f 72 20 77 ous record for w
9a40: 68 65 6e 20 74 68 69 73 20 74 65 73 74 20 77 61 hen this test wa
9a50: 73 20 72 75 6e 20 77 68 65 72 65 20 61 6c 6c 20 s run where all
9a60: 6b 65 79 73 20 6d 61 74 63 68 20 62 75 74 20 72 keys match but r
9a70: 75 6e 6e 61 6d 65 0a 3b 3b 20 72 65 74 75 72 6e unname.;; return
9a80: 73 20 23 66 20 69 66 20 6e 6f 20 73 75 63 68 20 s #f if no such
9a90: 74 65 73 74 20 66 6f 75 6e 64 2c 20 72 65 74 75 test found, retu
9aa0: 72 6e 73 20 61 20 73 69 6e 67 6c 65 20 74 65 73 rns a single tes
9ab0: 74 20 72 65 63 6f 72 64 20 69 66 20 66 6f 75 6e t record if foun
9ac0: 64 0a 3b 3b 20 0a 3b 3b 20 52 75 6e 20 74 68 69 d.;; .;; Run thi
9ad0: 73 20 61 74 20 74 68 65 20 63 6c 69 65 6e 74 20 s at the client
9ae0: 65 6e 64 20 73 69 6e 63 65 20 77 65 20 68 61 76 end since we hav
9af0: 65 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 e to connect to
9b00: 6d 75 6c 74 69 70 6c 65 20 72 75 6e 2d 69 64 20 multiple run-id
9b10: 64 62 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 dbs.;;.(define (
9b20: 72 6d 74 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 rmt:get-previous
9b30: 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 -test-run-record
9b40: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
9b50: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
9b60: 6c 65 74 2a 20 28 28 6b 65 79 76 61 6c 73 20 28 let* ((keyvals (
9b70: 72 6d 74 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d rmt:get-key-val-
9b80: 70 61 69 72 73 20 72 75 6e 2d 69 64 29 29 0a 09 pairs run-id))..
9b90: 20 28 6b 65 79 73 20 20 20 20 28 72 6d 74 3a 67 (keys (rmt:g
9ba0: 65 74 2d 6b 65 79 73 29 29 0a 09 20 28 73 65 6c et-keys)).. (sel
9bb0: 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 str (string-int
9bc0: 65 72 73 70 65 72 73 65 20 20 6b 65 79 73 20 22 ersperse keys "
9bd0: 2c 22 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 ,")).. (qrystr
9be0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
9bf0: 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 rse (map (lambda
9c00: 20 28 78 29 28 63 6f 6e 63 20 78 20 22 3d 3f 22 (x)(conc x "=?"
9c10: 29 29 20 6b 65 79 73 29 20 22 20 41 4e 44 20 22 )) keys) " AND "
9c20: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ))). (if (not
9c30: 20 6b 65 79 76 61 6c 73 29 0a 09 23 66 0a 09 28 keyvals)..#f..(
9c40: 6c 65 74 20 28 28 70 72 65 76 2d 72 75 6e 2d 69 let ((prev-run-i
9c50: 64 73 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 ds (rmt:get-prev
9c60: 2d 72 75 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 -run-ids run-id)
9c70: 29 29 0a 09 20 20 3b 3b 20 66 6f 72 20 65 61 63 )).. ;; for eac
9c80: 68 20 72 75 6e 20 73 74 61 72 74 69 6e 67 20 77 h run starting w
9c90: 69 74 68 20 74 68 65 20 6d 6f 73 74 20 72 65 63 ith the most rec
9ca0: 65 6e 74 20 6c 6f 6f 6b 20 74 6f 20 73 65 65 20 ent look to see
9cb0: 69 66 20 74 68 65 72 65 20 69 73 20 61 20 6d 61 if there is a ma
9cc0: 74 63 68 69 6e 67 20 74 65 73 74 0a 09 20 20 3b tching test.. ;
9cd0: 3b 20 69 66 20 66 6f 75 6e 64 20 74 68 65 6e 20 ; if found then
9ce0: 72 65 74 75 72 6e 20 74 68 61 74 20 6d 61 74 63 return that matc
9cf0: 68 69 6e 67 20 74 65 73 74 20 72 65 63 6f 72 64 hing test record
9d00: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
9d10: 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
9d20: 70 6f 72 74 2a 20 22 73 65 6c 73 74 72 3a 20 22 port* "selstr: "
9d30: 20 73 65 6c 73 74 72 20 22 2c 20 71 72 79 73 74 selstr ", qryst
9d40: 72 3a 20 22 20 71 72 79 73 74 72 20 22 2c 20 6b r: " qrystr ", k
9d50: 65 79 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c eyvals: " keyval
9d60: 73 20 22 2c 20 70 72 65 76 69 6f 75 73 20 72 75 s ", previous ru
9d70: 6e 20 69 64 73 20 66 6f 75 6e 64 3a 20 22 20 70 n ids found: " p
9d80: 72 65 76 2d 72 75 6e 2d 69 64 73 29 0a 09 20 20 rev-run-ids)..
9d90: 28 69 66 20 28 6e 75 6c 6c 3f 20 70 72 65 76 2d (if (null? prev-
9da0: 72 75 6e 2d 69 64 73 29 20 23 66 0a 09 20 20 20 run-ids) #f..
9db0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 (let loop ((h
9dc0: 65 64 20 28 63 61 72 20 70 72 65 76 2d 72 75 6e ed (car prev-run
9dd0: 2d 69 64 73 29 29 0a 09 09 09 20 28 74 61 6c 20 -ids)).... (tal
9de0: 28 63 64 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 (cdr prev-run-id
9df0: 73 29 29 29 0a 09 09 28 6c 65 74 20 28 28 72 65 s)))...(let ((re
9e00: 73 75 6c 74 73 20 28 72 6d 74 3a 67 65 74 2d 74 sults (rmt:get-t
9e10: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 68 65 64 ests-for-run hed
9e20: 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 (conc test-name
9e30: 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 20 "/" item-path)
9e40: 27 28 29 20 27 28 29 20 3b 3b 20 72 75 6e 2d 69 '() '() ;; run-i
9e50: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 d testpatt state
9e60: 73 20 73 74 61 74 75 73 65 73 0a 09 09 09 09 09 s statuses......
9e70: 09 20 20 20 20 20 20 23 66 20 23 66 20 23 66 20 . #f #f #f
9e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
9e90: 20 6f 66 66 73 65 74 20 6c 69 6d 69 74 20 6e 6f offset limit no
9ea0: 74 2d 69 6e 20 68 69 64 65 2f 6e 6f 74 2d 68 69 t-in hide/not-hi
9eb0: 64 65 0a 09 09 09 09 09 09 20 20 20 20 20 20 23 de....... #
9ec0: 66 20 23 66 20 23 66 20 23 66 20 27 6e 6f 72 6d f #f #f #f 'norm
9ed0: 61 6c 29 29 29 20 3b 3b 20 73 6f 72 74 2d 62 79 al))) ;; sort-by
9ee0: 20 73 6f 72 74 2d 6f 72 64 65 72 20 71 72 79 76 sort-order qryv
9ef0: 61 6c 73 20 6c 61 73 74 2d 75 70 64 61 74 65 20 als last-update
9f00: 6d 6f 64 65 0a 09 09 20 20 28 64 65 62 75 67 3a mode... (debug:
9f10: 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 print 4 *default
9f20: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 47 6f 74 20 -log-port* "Got
9f30: 74 65 73 74 73 20 66 6f 72 20 72 75 6e 2d 69 64 tests for run-id
9f40: 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 " run-id ", tes
9f50: 74 2d 6e 61 6d 65 20 22 20 74 65 73 74 2d 6e 61 t-name " test-na
9f60: 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 me ", item-path
9f70: 22 20 69 74 65 6d 2d 70 61 74 68 20 22 3a 20 22 " item-path ": "
9f80: 20 72 65 73 75 6c 74 73 29 0a 09 09 20 20 28 69 results)... (i
9f90: 66 20 28 61 6e 64 20 28 6e 75 6c 6c 3f 20 72 65 f (and (null? re
9fa0: 73 75 6c 74 73 29 0a 09 09 09 20 20 20 28 6e 6f sults).... (no
9fb0: 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 0a t (null? tal))).
9fc0: 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 .. (loop (c
9fd0: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
9fe0: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e )... (if (n
9ff0: 75 6c 6c 3f 20 72 65 73 75 6c 74 73 29 20 23 66 ull? results) #f
a000: 0a 09 09 09 20 20 28 63 61 72 20 72 65 73 75 6c .... (car resul
a010: 74 73 29 29 29 29 29 29 29 29 29 29 0a 0a 28 64 ts))))))))))..(d
a020: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 efine (rmt:get-r
a030: 75 6e 2d 73 74 61 74 73 29 0a 20 20 28 72 6d 74 un-stats). (rmt
a040: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
a050: 65 74 2d 72 75 6e 2d 73 74 61 74 73 20 23 66 20 et-run-stats #f
a060: 27 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d '()))..;;=======
a070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
a0b0: 3b 3b 20 20 53 20 54 20 45 20 50 20 53 0a 3b 3b ;; S T E P S.;;
a0c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a100: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 47 65 74 74 69 ======..;; Getti
a110: 6e 67 20 73 74 65 70 73 20 69 73 20 6d 6f 72 65 ng steps is more
a120: 20 63 6f 6d 70 6c 69 63 61 74 65 64 2e 0a 3b 3b complicated..;;
a130: 0a 3b 3b 20 49 66 20 67 69 76 65 6e 20 77 6f 72 .;; If given wor
a140: 6b 20 61 72 65 61 20 0a 3b 3b 20 20 31 2e 20 46 k area .;; 1. F
a150: 69 6e 64 20 74 68 65 20 74 65 73 74 64 61 74 2e ind the testdat.
a160: 64 62 20 66 69 6c 65 0a 3b 3b 20 20 32 2e 20 4f db file.;; 2. O
a170: 70 65 6e 20 74 68 65 20 74 65 73 74 64 61 74 2e pen the testdat.
a180: 64 62 20 66 69 6c 65 20 61 6e 64 20 64 6f 20 74 db file and do t
a190: 68 65 20 71 75 65 72 79 0a 3b 3b 20 49 66 20 6e he query.;; If n
a1a0: 6f 74 20 67 69 76 65 6e 20 74 68 65 20 77 6f 72 ot given the wor
a1b0: 6b 20 61 72 65 61 0a 3b 3b 20 20 31 2e 20 44 6f k area.;; 1. Do
a1c0: 20 61 20 72 65 6d 6f 74 65 20 63 61 6c 6c 20 74 a remote call t
a1d0: 6f 20 67 65 74 20 74 68 65 20 74 65 73 74 20 70 o get the test p
a1e0: 61 74 68 0a 3b 3b 20 20 32 2e 20 43 6f 6e 74 69 ath.;; 2. Conti
a1f0: 6e 75 65 20 61 73 20 61 62 6f 76 65 0a 3b 3b 20 nue as above.;;
a200: 0a 3b 3b 28 64 65 66 69 6e 65 20 28 72 6d 74 3a .;;(define (rmt:
a210: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
a220: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
a230: 64 29 0a 3b 3b 20 20 28 72 6d 74 3a 73 65 6e 64 d).;; (rmt:send
a240: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 73 74 -receive 'get-st
a250: 65 70 73 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 eps-data run-id
a260: 28 6c 69 73 74 20 74 65 73 74 2d 69 64 29 29 29 (list test-id)))
a270: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
a280: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
a290: 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d us! run-id test-
a2a0: 69 64 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 id teststep-name
a2b0: 20 73 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 state-in status
a2c0: 2d 69 6e 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 -in comment logf
a2d0: 69 6c 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 ile). (let* ((s
a2e0: 74 61 74 65 20 20 20 20 20 28 69 74 65 6d 73 3a tate (items:
a2f0: 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d check-valid-item
a300: 73 20 22 73 74 61 74 65 22 20 73 74 61 74 65 2d s "state" state-
a310: 69 6e 29 29 0a 09 20 28 73 74 61 74 75 73 20 20 in)).. (status
a320: 20 20 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d 76 (items:check-v
a330: 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 61 74 alid-items "stat
a340: 75 73 22 20 73 74 61 74 75 73 2d 69 6e 29 29 29 us" status-in)))
a350: 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f . (if (or (no
a360: 74 20 73 74 61 74 65 29 28 6e 6f 74 20 73 74 61 t state)(not sta
a370: 74 75 73 29 29 0a 09 28 64 65 62 75 67 3a 70 72 tus))..(debug:pr
a380: 69 6e 74 20 33 20 2a 64 65 66 61 75 6c 74 2d 6c int 3 *default-l
a390: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
a3a0: 47 3a 20 49 6e 76 61 6c 69 64 20 22 20 28 69 66 G: Invalid " (if
a3b0: 20 73 74 61 74 75 73 20 22 73 74 61 74 75 73 22 status "status"
a3c0: 20 22 73 74 61 74 65 22 29 0a 09 09 20 20 20 20 "state")...
a3d0: 20 22 20 76 61 6c 75 65 20 5c 22 22 20 28 69 66 " value \"" (if
a3e0: 20 73 74 61 74 75 73 20 73 74 61 74 65 2d 69 6e status state-in
a3f0: 20 73 74 61 74 75 73 2d 69 6e 29 20 22 5c 22 2c status-in) "\",
a400: 20 75 70 64 61 74 65 20 79 6f 75 72 20 76 61 6c update your val
a410: 69 64 76 61 6c 75 65 73 20 73 65 63 74 69 6f 6e idvalues section
a420: 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e in megatest.con
a430: 66 69 67 22 29 29 0a 20 20 20 20 28 72 6d 74 3a fig")). (rmt:
a440: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 send-receive 'te
a450: 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
a460: 73 21 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 s! run-id (list
a470: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 run-id test-id t
a480: 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 eststep-name sta
a490: 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 te-in status-in
a4a0: 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 29 comment logfile)
a4b0: 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 72 )))...(define (r
a4c0: 6d 74 3a 64 65 6c 65 74 65 2d 73 74 65 70 73 2d mt:delete-steps-
a4d0: 66 6f 72 2d 74 65 73 74 21 20 72 75 6e 2d 69 64 for-test! run-id
a4e0: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 test-id). (rmt
a4f0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 :send-receive 'd
a500: 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 2d elete-steps-for-
a510: 74 65 73 74 21 20 72 75 6e 2d 69 64 20 28 6c 69 test! run-id (li
a520: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
a530: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
a540: 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 mt:get-steps-for
a550: 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 -test run-id tes
a560: 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e t-id). (rmt:sen
a570: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 73 d-receive 'get-s
a580: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 teps-for-test ru
a590: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
a5a0: 64 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 d test-id)))..(d
a5b0: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 73 efine (rmt:get-s
a5c0: 74 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 teps-info-by-id
a5d0: 74 65 73 74 2d 73 74 65 70 2d 69 64 29 0a 20 20 test-step-id).
a5e0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
a5f0: 65 20 27 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 e 'get-steps-inf
a600: 6f 2d 62 79 2d 69 64 20 23 66 20 28 6c 69 73 74 o-by-id #f (list
a610: 20 74 65 73 74 2d 73 74 65 70 2d 69 64 29 29 29 test-step-id)))
a620: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
a630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 54 ==========.;; T
a670: 20 45 20 53 20 54 20 20 20 44 20 41 20 54 20 41 E S T D A T A
a680: 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============
a690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a6a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a6b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a6c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
a6d0: 69 6e 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 65 ine (rmt:read-te
a6e0: 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 74 st-data run-id t
a6f0: 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 est-id categoryp
a700: 61 74 74 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d att #!key (work-
a710: 61 72 65 61 20 23 66 29 29 20 0a 20 20 28 72 6d area #f)) . (rm
a720: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
a730: 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 read-test-data r
a740: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
a750: 69 64 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 id test-id categ
a760: 6f 72 79 70 61 74 74 29 29 29 0a 28 64 65 66 69 orypatt))).(defi
a770: 6e 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 65 73 ne (rmt:read-tes
a780: 74 2d 64 61 74 61 2a 20 72 75 6e 2d 69 64 20 74 t-data* run-id t
a790: 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 est-id categoryp
a7a0: 61 74 74 20 76 61 72 70 61 74 74 20 23 21 6b 65 att varpatt #!ke
a7b0: 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 y (work-area #f)
a7c0: 29 20 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 ) . (rmt:send-r
a7d0: 65 63 65 69 76 65 20 27 72 65 61 64 2d 74 65 73 eceive 'read-tes
a7e0: 74 2d 64 61 74 61 2a 20 72 75 6e 2d 69 64 20 28 t-data* run-id (
a7f0: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
a800: 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 74 74 -id categorypatt
a810: 20 76 61 72 70 61 74 74 29 29 29 0a 0a 28 64 65 varpatt)))..(de
a820: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 64 61 fine (rmt:get-da
a830: 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 74 65 ta-info-by-id te
a840: 73 74 2d 64 61 74 61 2d 69 64 29 0a 20 20 20 28 st-data-id). (
a850: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
a860: 20 27 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 'get-data-info-
a870: 62 79 2d 69 64 20 23 66 20 28 6c 69 73 74 20 74 by-id #f (list t
a880: 65 73 74 2d 64 61 74 61 2d 69 64 29 29 29 0a 0a est-data-id)))..
a890: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 (define (rmt:tes
a8a0: 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 tmeta-add-record
a8b0: 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d testname). (rm
a8c0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
a8d0: 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 testmeta-add-rec
a8e0: 6f 72 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 ord #f (list tes
a8f0: 74 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e tname)))..(defin
a900: 65 20 28 72 6d 74 3a 74 65 73 74 6d 65 74 61 2d e (rmt:testmeta-
a910: 67 65 74 2d 72 65 63 6f 72 64 20 74 65 73 74 6e get-record testn
a920: 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ame). (rmt:send
a930: 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 6d 65 -receive 'testme
a940: 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 23 66 ta-get-record #f
a950: 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 (list testname)
a960: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
a970: 3a 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 :testmeta-update
a980: 2d 66 69 65 6c 64 20 74 65 73 74 2d 6e 61 6d 65 -field test-name
a990: 20 66 6c 64 20 76 61 6c 29 0a 20 20 28 72 6d 74 fld val). (rmt
a9a0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
a9b0: 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 estmeta-update-f
a9c0: 69 65 6c 64 20 23 66 20 28 6c 69 73 74 20 74 65 ield #f (list te
a9d0: 73 74 2d 6e 61 6d 65 20 66 6c 64 20 76 61 6c 29 st-name fld val)
a9e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
a9f0: 3a 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 :test-data-rollu
aa00: 70 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 p run-id test-id
aa10: 20 73 74 61 74 75 73 29 0a 20 20 28 72 6d 74 3a status). (rmt:
aa20: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 send-receive 'te
aa30: 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 72 st-data-rollup r
aa40: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
aa50: 69 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 id test-id statu
aa60: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 s)))..(define (r
aa70: 6d 74 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 mt:csv->test-dat
aa80: 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 a run-id test-id
aa90: 20 63 73 76 64 61 74 61 29 0a 20 20 28 72 6d 74 csvdata). (rmt
aaa0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 63 :send-receive 'c
aab0: 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 72 75 sv->test-data ru
aac0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
aad0: 64 20 74 65 73 74 2d 69 64 20 63 73 76 64 61 74 d test-id csvdat
aae0: 61 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a)))..;;========
aaf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
ab30: 3b 20 20 54 20 41 20 53 20 4b 20 53 0a 3b 3b 3d ; T A S K S.;;=
ab40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab80: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
ab90: 72 6d 74 3a 74 61 73 6b 73 2d 66 69 6e 64 2d 74 rmt:tasks-find-t
aba0: 61 73 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 ask-queue-record
abb0: 73 20 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d s target run-nam
abc0: 65 20 74 65 73 74 2d 70 61 74 74 20 73 74 61 74 e test-patt stat
abd0: 65 2d 70 61 74 74 20 61 63 74 69 6f 6e 2d 70 61 e-patt action-pa
abe0: 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d tt). (rmt:send-
abf0: 72 65 63 65 69 76 65 20 27 66 69 6e 64 2d 74 61 receive 'find-ta
ac00: 73 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 sk-queue-records
ac10: 20 23 66 20 28 6c 69 73 74 20 74 61 72 67 65 74 #f (list target
ac20: 20 72 75 6e 2d 6e 61 6d 65 20 74 65 73 74 2d 70 run-name test-p
ac30: 61 74 74 20 73 74 61 74 65 2d 70 61 74 74 20 61 att state-patt a
ac40: 63 74 69 6f 6e 2d 70 61 74 74 29 29 29 0a 0a 28 ction-patt)))..(
ac50: 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 61 73 6b define (rmt:task
ac60: 73 2d 61 64 64 20 61 63 74 69 6f 6e 20 6f 77 6e s-add action own
ac70: 65 72 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d er target runnam
ac80: 65 20 74 65 73 74 70 61 74 74 20 70 61 72 61 6d e testpatt param
ac90: 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 s). (rmt:send-r
aca0: 65 63 65 69 76 65 20 27 74 61 73 6b 73 2d 61 64 eceive 'tasks-ad
acb0: 64 20 23 66 20 28 6c 69 73 74 20 61 63 74 69 6f d #f (list actio
acc0: 6e 20 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 n owner target r
acd0: 75 6e 6e 61 6d 65 20 74 65 73 74 70 61 74 74 20 unname testpatt
ace0: 70 61 72 61 6d 73 29 29 29 0a 0a 28 64 65 66 69 params)))..(defi
acf0: 6e 65 20 28 72 6d 74 3a 74 61 73 6b 73 2d 73 65 ne (rmt:tasks-se
ad00: 74 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 t-state-given-pa
ad10: 72 61 6d 2d 6b 65 79 20 70 61 72 61 6d 2d 6b 65 ram-key param-ke
ad20: 79 20 6e 65 77 2d 73 74 61 74 65 29 0a 20 20 28 y new-state). (
ad30: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
ad40: 20 27 74 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 'tasks-set-stat
ad50: 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 e-given-param-ke
ad60: 79 20 23 66 20 28 6c 69 73 74 20 20 70 61 72 61 y #f (list para
ad70: 6d 2d 6b 65 79 20 6e 65 77 2d 73 74 61 74 65 29 m-key new-state)
ad80: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
ad90: 3a 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 74 20 :tasks-get-last
ada0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 29 0a target runname).
adb0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
adc0: 69 76 65 20 27 74 61 73 6b 73 2d 67 65 74 2d 6c ive 'tasks-get-l
add0: 61 73 74 20 23 66 20 28 6c 69 73 74 20 74 61 72 ast #f (list tar
ade0: 67 65 74 20 72 75 6e 6e 61 6d 65 29 29 29 0a 0a get runname)))..
adf0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
ae00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ae10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ae20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ae30: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 20 4f 20 ========.;; N O
ae40: 20 20 53 20 59 20 4e 20 43 20 20 20 44 20 42 20 S Y N C D B
ae50: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
ae60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ae70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ae80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ae90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
aea0: 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d ne (rmt:no-sync-
aeb0: 73 65 74 20 76 61 72 20 76 61 6c 29 0a 20 20 28 set var val). (
aec0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
aed0: 20 27 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 23 66 'no-sync-set #f
aee0: 20 60 28 2c 76 61 72 20 2c 76 61 6c 29 29 29 0a `(,var ,val))).
aef0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f .(define (rmt:no
af00: 2d 73 79 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c -sync-get/defaul
af10: 74 20 76 61 72 20 64 65 66 61 75 6c 74 29 0a 20 t var default).
af20: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
af30: 76 65 20 27 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f ve 'no-sync-get/
af40: 64 65 66 61 75 6c 74 20 23 66 20 60 28 2c 76 61 default #f `(,va
af50: 72 20 2c 64 65 66 61 75 6c 74 29 29 29 0a 0a 28 r ,default)))..(
af60: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 define (rmt:no-s
af70: 79 6e 63 2d 64 65 6c 21 20 76 61 72 29 0a 20 20 ync-del! var).
af80: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
af90: 65 20 27 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 e 'no-sync-del!
afa0: 23 66 20 60 28 2c 76 61 72 29 29 29 0a 0a 28 64 #f `(,var)))..(d
afb0: 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 efine (rmt:no-sy
afc0: 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6b 65 79 6e nc-get-lock keyn
afd0: 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ame). (rmt:send
afe0: 2d 72 65 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e -receive 'no-syn
aff0: 63 2d 67 65 74 2d 6c 6f 63 6b 20 23 66 20 60 28 c-get-lock #f `(
b000: 2c 6b 65 79 6e 61 6d 65 29 29 29 0a 0a 28 64 65 ,keyname)))..(de
b010: 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e fine (rmt:no-syn
b020: 63 2d 61 64 64 2d 6a 6f 62 20 68 6f 73 74 2d 74 c-add-job host-t
b030: 79 70 65 20 76 61 72 73 2d 6c 69 73 74 20 65 78 ype vars-list ex
b040: 65 6b 65 79 20 63 6d 64 6c 69 6e 65 29 0a 20 20 ekey cmdline).
b050: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
b060: 65 20 27 6e 6f 2d 73 79 6e 63 2d 61 64 64 2d 6a e 'no-sync-add-j
b070: 6f 62 20 23 66 20 60 28 2c 68 6f 73 74 2d 74 79 ob #f `(,host-ty
b080: 70 65 20 2c 76 61 72 73 2d 6c 69 73 74 20 2c 65 pe ,vars-list ,e
b090: 78 65 6b 65 79 20 2c 63 6d 64 6c 69 6e 65 29 29 xekey ,cmdline))
b0a0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
b0b0: 6e 6f 2d 73 79 6e 63 2d 74 61 6b 65 2d 6a 6f 62 no-sync-take-job
b0c0: 20 68 6f 73 74 2d 74 79 70 65 29 0a 20 20 28 72 host-type). (r
b0d0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
b0e0: 27 6e 6f 2d 73 79 6e 63 2d 74 61 6b 65 2d 6a 6f 'no-sync-take-jo
b0f0: 62 20 23 66 20 60 28 2c 68 6f 73 74 2d 74 79 70 b #f `(,host-typ
b100: 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 e)))..(define (r
b110: 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 6a 6f 62 2d 72 mt:no-sync-job-r
b120: 65 63 6f 72 64 73 2d 63 6c 65 61 6e 29 0a 20 20 ecords-clean).
b130: 28 72 6d 74 3a 73 65 74 2d 72 65 63 65 69 76 65 (rmt:set-receive
b140: 20 27 6e 6f 2d 73 79 6e 63 2d 6a 6f 62 2d 72 65 'no-sync-job-re
b150: 63 6f 72 64 73 2d 63 6c 65 61 6e 20 23 66 20 27 cords-clean #f '
b160: 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ()))..;;========
b170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b1a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
b1b0: 3b 20 41 20 52 20 43 20 48 20 49 20 56 20 45 20 ; A R C H I V E
b1c0: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
b1d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b1e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b1f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
b210: 69 6e 65 20 28 72 6d 74 3a 61 72 63 68 69 76 65 ine (rmt:archive
b220: 2d 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 -get-allocations
b230: 20 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 70 testname itemp
b240: 61 74 68 20 64 6e 65 65 64 65 64 29 0a 20 20 28 ath dneeded). (
b250: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
b260: 20 27 61 72 63 68 69 76 65 2d 67 65 74 2d 61 6c 'archive-get-al
b270: 6c 6f 63 61 74 69 6f 6e 73 20 23 66 20 28 6c 69 locations #f (li
b280: 73 74 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d st testname item
b290: 70 61 74 68 20 64 6e 65 65 64 65 64 29 29 29 0a path dneeded))).
b2a0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 61 72 .(define (rmt:ar
b2b0: 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 62 chive-register-b
b2c0: 6c 6f 63 6b 2d 6e 61 6d 65 20 62 64 69 73 6b 2d lock-name bdisk-
b2d0: 69 64 20 61 72 63 68 69 76 65 2d 70 61 74 68 29 id archive-path)
b2e0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
b2f0: 65 69 76 65 20 27 61 72 63 68 69 76 65 2d 72 65 eive 'archive-re
b300: 67 69 73 74 65 72 2d 62 6c 6f 63 6b 2d 6e 61 6d gister-block-nam
b310: 65 20 23 66 20 28 6c 69 73 74 20 62 64 69 73 6b e #f (list bdisk
b320: 2d 69 64 20 61 72 63 68 69 76 65 2d 70 61 74 68 -id archive-path
b330: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
b340: 74 3a 61 72 63 68 69 76 65 2d 61 6c 6c 6f 63 61 t:archive-alloca
b350: 74 65 2d 74 65 73 74 73 75 69 74 65 2f 61 72 65 te-testsuite/are
b360: 61 2d 74 6f 2d 62 6c 6f 63 6b 20 62 6c 6f 63 6b a-to-block block
b370: 2d 69 64 20 74 65 73 74 73 75 69 74 65 2d 6e 61 -id testsuite-na
b380: 6d 65 20 61 72 65 61 6b 65 79 29 0a 20 20 28 72 me areakey). (r
b390: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
b3a0: 27 61 72 63 68 69 76 65 2d 61 6c 6c 6f 63 61 74 'archive-allocat
b3b0: 65 2d 74 65 73 74 2d 74 6f 2d 62 6c 6f 63 6b 20 e-test-to-block
b3c0: 23 66 20 28 6c 69 73 74 20 20 62 6c 6f 63 6b 2d #f (list block-
b3d0: 69 64 20 74 65 73 74 73 75 69 74 65 2d 6e 61 6d id testsuite-nam
b3e0: 65 20 61 72 65 61 6b 65 79 29 29 29 0a 0a 28 64 e areakey)))..(d
b3f0: 65 66 69 6e 65 20 28 72 6d 74 3a 61 72 63 68 69 efine (rmt:archi
b400: 76 65 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b ve-register-disk
b410: 20 62 64 69 73 6b 2d 6e 61 6d 65 20 62 64 69 73 bdisk-name bdis
b420: 6b 2d 70 61 74 68 20 64 66 29 0a 20 20 28 72 6d k-path df). (rm
b430: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
b440: 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 archive-register
b450: 2d 64 69 73 6b 20 23 66 20 28 6c 69 73 74 20 62 -disk #f (list b
b460: 64 69 73 6b 2d 6e 61 6d 65 20 62 64 69 73 6b 2d disk-name bdisk-
b470: 70 61 74 68 20 64 66 29 29 29 0a 0a 28 64 65 66 path df)))..(def
b480: 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 ine (rmt:test-se
b490: 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d t-archive-block-
b4a0: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 id run-id test-i
b4b0: 64 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d d archive-block-
b4c0: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
b4d0: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 receive 'test-se
b4e0: 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d t-archive-block-
b4f0: 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 id run-id (list
b500: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 61 run-id test-id a
b510: 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 rchive-block-id)
b520: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
b530: 3a 74 65 73 74 2d 67 65 74 2d 61 72 63 68 69 76 :test-get-archiv
b540: 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f 20 61 72 63 e-block-info arc
b550: 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 0a 20 hive-block-id).
b560: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
b570: 76 65 20 27 74 65 73 74 2d 67 65 74 2d 61 72 63 ve 'test-get-arc
b580: 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f 20 hive-block-info
b590: 23 66 20 28 6c 69 73 74 20 61 72 63 68 69 76 65 #f (list archive
b5a0: 2d 62 6c 6f 63 6b 2d 69 64 29 29 29 0a 0a 0a 28 -block-id)))...(
b5b0: 64 65 66 69 6e 65 20 28 72 6d 74 6d 6f 64 3a 63 define (rmtmod:c
b5c0: 61 6c 63 2d 72 6f 2d 6d 6f 64 65 20 72 75 6e 72 alc-ro-mode runr
b5d0: 65 6d 6f 74 65 20 2a 74 6f 70 70 61 74 68 2a 29 emote *toppath*)
b5e0: 0a 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e 72 . (if (and runr
b5f0: 65 6d 6f 74 65 0a 09 20 20 20 28 72 65 6d 6f 74 emote.. (remot
b600: 65 2d 72 6f 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 e-ro-mode-checke
b610: 64 20 72 75 6e 72 65 6d 6f 74 65 29 29 0a 20 20 d runremote)).
b620: 20 20 20 20 28 72 65 6d 6f 74 65 2d 72 6f 2d 6d (remote-ro-m
b630: 6f 64 65 20 72 75 6e 72 65 6d 6f 74 65 29 0a 20 ode runremote).
b640: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 66 (let* ((dbf
b650: 69 6c 65 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 ile (conc *topp
b660: 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e ath* "/megatest.
b670: 64 62 22 29 29 0a 09 20 20 20 20 20 28 72 6f 2d db")).. (ro-
b680: 6d 6f 64 65 20 28 6e 6f 74 20 28 66 69 6c 65 2d mode (not (file-
b690: 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 64 62 write-access? db
b6a0: 66 69 6c 65 29 29 29 29 20 3b 3b 20 54 4f 44 4f file)))) ;; TODO
b6b0: 3a 20 75 73 65 20 64 62 73 74 72 75 63 74 20 6f : use dbstruct o
b6c0: 72 20 72 75 6e 72 65 6d 6f 74 65 20 74 6f 20 66 r runremote to f
b6d0: 69 67 75 72 65 20 74 68 69 73 20 6f 75 74 20 69 igure this out i
b6e0: 6e 20 66 75 74 75 72 65 0a 09 28 69 66 20 72 75 n future..(if ru
b6f0: 6e 72 65 6d 6f 74 65 0a 09 20 20 20 20 28 62 65 nremote.. (be
b700: 67 69 6e 0a 09 20 20 20 20 20 20 28 72 65 6d 6f gin.. (remo
b710: 74 65 2d 72 6f 2d 6d 6f 64 65 2d 73 65 74 21 20 te-ro-mode-set!
b720: 72 75 6e 72 65 6d 6f 74 65 20 72 6f 2d 6d 6f 64 runremote ro-mod
b730: 65 29 0a 09 20 20 20 20 20 20 28 72 65 6d 6f 74 e).. (remot
b740: 65 2d 72 6f 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 e-ro-mode-checke
b750: 64 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 d-set! runremote
b760: 20 23 74 29 0a 09 20 20 20 20 20 20 72 6f 2d 6d #t).. ro-m
b770: 6f 64 65 29 0a 09 20 20 20 20 72 6f 2d 6d 6f 64 ode).. ro-mod
b780: 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 e))))..(define (
b790: 65 78 74 72 61 73 2d 72 65 61 64 6f 6e 6c 79 2d extras-readonly-
b7a0: 6d 6f 64 65 20 72 6d 74 2d 6d 75 74 65 78 20 6c mode rmt-mutex l
b7b0: 6f 67 2d 70 6f 72 74 20 63 6d 64 20 70 61 72 61 og-port cmd para
b7c0: 6d 73 29 0a 20 20 28 6d 75 74 65 78 2d 75 6e 6c ms). (mutex-unl
b7d0: 6f 63 6b 21 20 72 6d 74 2d 6d 75 74 65 78 29 0a ock! rmt-mutex).
b7e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
b7f0: 6e 66 6f 20 31 32 20 6c 6f 67 2d 70 6f 72 74 20 nfo 12 log-port
b800: 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 "rmt:send-receiv
b810: 65 2c 20 63 61 73 65 20 33 22 29 0a 20 20 28 64 e, case 3"). (d
b820: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 6c 6f 67 ebug:print 0 log
b830: 2d 70 6f 72 74 20 22 57 41 52 4e 49 4e 47 3a 20 -port "WARNING:
b840: 77 72 69 74 65 20 74 72 61 6e 73 61 63 74 69 6f write transactio
b850: 6e 20 72 65 71 75 65 73 74 65 64 20 6f 6e 20 61 n requested on a
b860: 20 72 65 61 64 6f 6e 6c 79 20 61 72 65 61 2e 20 readonly area.
b870: 20 63 6d 64 3d 22 63 6d 64 22 20 70 61 72 61 6d cmd="cmd" param
b880: 73 3d 22 70 61 72 61 6d 73 29 0a 20 20 23 66 29 s="params). #f)
b890: 0a 0a 28 64 65 66 69 6e 65 20 28 65 78 74 72 61 ..(define (extra
b8a0: 73 2d 74 72 61 6e 73 70 6f 72 74 2d 66 61 69 6c s-transport-fail
b8b0: 65 64 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d ed *default-log-
b8c0: 70 6f 72 74 2a 20 2a 72 6d 74 2d 6d 75 74 65 78 port* *rmt-mutex
b8d0: 2a 20 61 74 74 65 6d 70 74 6e 75 6d 20 72 75 6e * attemptnum run
b8e0: 72 65 6d 6f 74 65 20 63 6d 64 20 72 69 64 20 70 remote cmd rid p
b8f0: 61 72 61 6d 73 29 0a 20 20 28 64 65 62 75 67 3a arams). (debug:
b900: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
b910: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
b920: 49 4e 47 3a 20 63 6f 6d 6d 75 6e 69 63 61 74 69 ING: communicati
b930: 6f 6e 20 66 61 69 6c 65 64 2e 20 54 72 79 69 6e on failed. Tryin
b940: 67 20 61 67 61 69 6e 2c 20 74 72 79 20 6e 75 6d g again, try num
b950: 3a 20 22 20 61 74 74 65 6d 70 74 6e 75 6d 29 0a : " attemptnum).
b960: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a (mutex-lock! *
b970: 72 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 28 72 rmt-mutex*). (r
b980: 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 2d 73 65 emote-conndat-se
b990: 74 21 20 20 20 20 72 75 6e 72 65 6d 6f 74 65 20 t! runremote
b9a0: 23 66 29 0a 20 20 28 68 74 74 70 2d 74 72 61 6e #f). (http-tran
b9b0: 73 70 6f 72 74 3a 63 6c 6f 73 65 2d 63 6f 6e 6e sport:close-conn
b9c0: 65 63 74 69 6f 6e 73 20 61 72 65 61 2d 64 61 74 ections area-dat
b9d0: 3a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 20 20 28 : runremote). (
b9e0: 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 remote-server-ur
b9f0: 6c 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 l-set! runremote
ba00: 20 23 66 29 0a 20 20 28 6d 75 74 65 78 2d 75 6e #f). (mutex-un
ba10: 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 lock! *rmt-mutex
ba20: 2a 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e *). (debug:prin
ba30: 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 66 61 75 t-info 12 *defau
ba40: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d lt-log-port* "rm
ba50: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 2c 20 t:send-receive,
ba60: 63 61 73 65 20 20 39 2e 31 22 29 0a 20 20 28 72 case 9.1"). (r
ba70: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
ba80: 63 6d 64 20 72 69 64 20 70 61 72 61 6d 73 20 61 cmd rid params a
ba90: 74 74 65 6d 70 74 6e 75 6d 3a 20 28 2b 20 61 74 ttemptnum: (+ at
baa0: 74 65 6d 70 74 6e 75 6d 20 31 29 29 29 0a 20 20 temptnum 1))).
bab0: 0a 28 64 65 66 69 6e 65 20 28 65 78 74 72 61 73 .(define (extras
bac0: 2d 74 72 61 6e 73 70 6f 72 74 2d 73 75 63 63 65 -transport-succe
bad0: 64 65 64 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 ded *default-log
bae0: 2d 70 6f 72 74 2a 20 2a 72 6d 74 2d 6d 75 74 65 -port* *rmt-mute
baf0: 78 2a 20 61 74 74 65 6d 70 74 6e 75 6d 20 72 75 x* attemptnum ru
bb00: 6e 72 65 6d 6f 74 65 20 72 65 73 20 70 61 72 61 nremote res para
bb10: 6d 73 20 72 69 64 20 63 6d 64 29 0a 20 20 28 69 ms rid cmd). (i
bb20: 66 20 28 61 6e 64 20 28 76 65 63 74 6f 72 3f 20 f (and (vector?
bb30: 72 65 73 29 0a 09 20 20 20 28 65 71 3f 20 28 76 res).. (eq? (v
bb40: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 72 65 73 ector-length res
bb50: 29 20 32 29 0a 09 20 20 20 28 65 71 3f 20 28 76 ) 2).. (eq? (v
bb60: 65 63 74 6f 72 2d 72 65 66 20 72 65 73 20 31 29 ector-ref res 1)
bb70: 20 27 6f 76 65 72 6c 6f 61 64 65 64 29 29 20 3b 'overloaded)) ;
bb80: 3b 20 73 69 6e 63 65 20 77 65 20 61 72 65 0a 09 ; since we are..
bb90: 09 09 09 09 09 20 3b 3b 20 6c 6f 6f 6b 69 6e 67 ..... ;; looking
bba0: 20 61 74 20 74 68 65 0a 09 09 09 09 09 09 20 3b at the....... ;
bbb0: 3b 20 64 61 74 61 20 74 6f 20 63 61 72 72 79 20 ; data to carry
bbc0: 74 68 65 0a 09 09 09 09 09 09 20 3b 3b 20 65 72 the....... ;; er
bbd0: 72 6f 72 20 77 65 27 6c 6c 20 75 73 65 20 61 0a ror we'll use a.
bbe0: 09 09 09 09 09 09 20 3b 3b 20 66 61 69 72 6c 79 ...... ;; fairly
bbf0: 20 6f 62 74 75 73 65 0a 09 09 09 09 09 09 20 3b obtuse....... ;
bc00: 3b 20 63 6f 6d 62 6f 20 74 6f 20 6d 69 6e 69 6d ; combo to minim
bc10: 69 73 65 0a 09 09 09 09 09 09 20 3b 3b 20 74 68 ise....... ;; th
bc20: 65 20 63 68 61 6e 63 65 73 20 6f 66 0a 09 09 09 e chances of....
bc30: 09 09 09 20 3b 3b 20 73 6f 6d 65 20 73 6f 72 74 ... ;; some sort
bc40: 20 6f 66 0a 09 09 09 09 09 09 20 3b 3b 20 63 6f of....... ;; co
bc50: 6c 6c 69 73 69 6f 6e 2e 20 20 74 68 69 73 0a 09 llision. this..
bc60: 09 09 09 09 09 20 3b 3b 20 69 73 20 74 68 65 20 ..... ;; is the
bc70: 63 61 73 65 20 77 68 65 72 65 0a 09 09 09 09 09 case where......
bc80: 09 20 3b 3b 20 74 68 65 20 72 65 74 75 72 6e 65 . ;; the returne
bc90: 64 20 64 61 74 61 0a 09 09 09 09 09 09 20 3b 3b d data....... ;;
bca0: 20 69 73 20 62 61 64 20 6f 72 20 74 68 65 0a 09 is bad or the..
bcb0: 09 09 09 09 09 20 3b 3b 20 73 65 72 76 65 72 20 ..... ;; server
bcc0: 69 73 0a 09 09 09 09 09 09 20 3b 3b 20 6f 76 65 is....... ;; ove
bcd0: 72 6c 6f 61 64 65 64 20 61 6e 64 20 77 65 0a 09 rloaded and we..
bce0: 09 09 09 09 09 20 3b 3b 20 77 61 6e 74 20 74 6f ..... ;; want to
bcf0: 20 65 61 73 65 20 6f 66 66 0a 09 09 09 09 09 09 ease off.......
bd00: 20 3b 3b 20 74 68 65 20 71 75 65 72 69 65 73 0a ;; the queries.
bd10: 20 20 20 20 20 20 28 6c 65 74 20 28 28 77 61 69 (let ((wai
bd20: 74 2d 64 65 6c 61 79 20 28 2b 20 61 74 74 65 6d t-delay (+ attem
bd30: 70 74 6e 75 6d 20 28 2a 20 61 74 74 65 6d 70 74 ptnum (* attempt
bd40: 6e 75 6d 20 31 30 29 29 29 29 0a 09 28 64 65 62 num 10))))..(deb
bd50: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
bd60: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
bd70: 41 52 4e 49 4e 47 3a 20 73 65 72 76 65 72 20 69 ARNING: server i
bd80: 73 20 6f 76 65 72 6c 6f 61 64 65 64 2e 20 44 65 s overloaded. De
bd90: 6c 61 79 69 6e 67 20 22 20 77 61 69 74 2d 64 65 laying " wait-de
bda0: 6c 61 79 20 22 20 73 65 63 6f 6e 64 73 20 61 6e lay " seconds an
bdb0: 64 20 74 72 79 69 6e 67 20 63 61 6c 6c 20 61 67 d trying call ag
bdc0: 61 69 6e 2e 22 29 0a 09 28 6d 75 74 65 78 2d 6c ain.")..(mutex-l
bdd0: 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a ock! *rmt-mutex*
bde0: 29 0a 09 28 68 74 74 70 2d 74 72 61 6e 73 70 6f )..(http-transpo
bdf0: 72 74 3a 63 6c 6f 73 65 2d 63 6f 6e 6e 65 63 74 rt:close-connect
be00: 69 6f 6e 73 20 61 72 65 61 2d 64 61 74 3a 20 72 ions area-dat: r
be10: 75 6e 72 65 6d 6f 74 65 29 0a 09 28 73 65 74 21 unremote)..(set!
be20: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 23 66 29 *runremote* #f)
be30: 20 3b 3b 20 66 6f 72 63 65 20 73 74 61 72 74 69 ;; force starti
be40: 6e 67 20 6f 76 65 72 0a 09 28 6d 75 74 65 78 2d ng over..(mutex-
be50: 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 unlock! *rmt-mut
be60: 65 78 2a 29 0a 09 28 74 68 72 65 61 64 2d 73 6c ex*)..(thread-sl
be70: 65 65 70 21 20 77 61 69 74 2d 64 65 6c 61 79 29 eep! wait-delay)
be80: 0a 09 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 ..(rmt:send-rece
be90: 69 76 65 20 63 6d 64 20 72 69 64 20 70 61 72 61 ive cmd rid para
bea0: 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d 3a 20 28 ms attemptnum: (
beb0: 2b 20 61 74 74 65 6d 70 74 6e 75 6d 20 31 29 29 + attemptnum 1))
bec0: 29 0a 20 20 20 20 20 20 72 65 73 29 29 20 3b 3b ). res)) ;;
bed0: 20 41 6c 6c 20 67 6f 6f 64 2c 20 72 65 74 75 72 All good, retur
bee0: 6e 20 72 65 73 0a 0a 23 3b 28 73 65 74 2d 66 75 n res..#;(set-fu
bef0: 6e 63 74 69 6f 6e 73 20 72 6d 74 3a 73 65 6e 64 nctions rmt:send
bf00: 2d 72 65 63 65 69 76 65 20 20 20 20 20 20 20 20 -receive
bf10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
bf20: 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 6c emote-server-url
bf30: 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 68 74 -set!.. ht
bf40: 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c 6f tp-transport:clo
bf50: 73 65 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 09 20 se-connections.
bf60: 20 20 20 20 20 72 65 6d 6f 74 65 2d 63 6f 6e 6e remote-conn
bf70: 64 61 74 2d 73 65 74 21 0a 09 20 20 20 20 20 20 dat-set!..
bf80: 20 64 65 62 75 67 3a 70 72 69 6e 74 20 20 20 20 debug:print
bf90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfa0: 20 20 20 20 20 20 20 20 64 65 62 75 67 3a 70 72 debug:pr
bfb0: 69 6e 74 2d 69 6e 66 6f 0a 09 20 20 20 20 20 20 int-info..
bfc0: 20 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 20 remote-ro-mode
bfd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfe0: 20 20 20 20 20 20 20 20 72 65 6d 6f 74 65 2d 72 remote-r
bff0: 6f 2d 6d 6f 64 65 2d 73 65 74 21 0a 09 20 20 20 o-mode-set!..
c000: 20 20 20 20 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f remote-ro-mo
c010: 64 65 2d 63 68 65 63 6b 65 64 2d 73 65 74 21 20 de-checked-set!
c020: 20 20 20 20 20 20 20 20 20 20 20 72 65 6d 6f 74 remot
c030: 65 2d 72 6f 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 e-ro-mode-checke
c040: 64 29 0a d).