0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 37 2c right 2006-2017,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;.;;===========
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
0390: 65 20 66 6f 72 6d 61 74 20 74 79 70 65 64 2d 72 e format typed-r
03a0: 65 63 6f 72 64 73 29 20 3b 3b 20 52 41 44 54 20 ecords) ;; RADT
03b0: 3d 3e 20 70 75 72 70 6f 73 65 20 6f 66 20 6a 73 => purpose of js
03c0: 6f 6e 20 66 6f 72 6d 61 74 3f 3f 0a 0a 28 64 65 on format??..(de
03d0: 63 6c 61 72 65 20 28 75 6e 69 74 20 72 6d 74 29 clare (unit rmt)
03e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03f0: 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 65 20 api)).(declare
0400: 28 75 73 65 73 20 68 74 74 70 2d 74 72 61 6e 73 (uses http-trans
0410: 70 6f 72 74 29 29 0a 28 69 6e 63 6c 75 64 65 20 port)).(include
0420: 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e "common_records.
0430: 73 63 6d 22 29 0a 3b 3b 20 28 64 65 63 6c 61 72 scm").;; (declar
0440: 65 20 28 75 73 65 73 20 72 6d 74 6d 6f 64 29 29 e (uses rmtmod))
0450: 0a 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 72 6d 74 ..;; (import rmt
0460: 6d 6f 64 29 0a 0a 3b 3b 0a 3b 3b 20 54 48 45 53 mod)..;;.;; THES
0470: 45 20 41 52 45 20 41 4c 4c 20 43 41 4c 4c 45 44 E ARE ALL CALLED
0480: 20 4f 4e 20 54 48 45 20 43 4c 49 45 4e 54 20 53 ON THE CLIENT S
0490: 49 44 45 21 21 21 0a 3b 3b 0a 0a 3b 3b 20 67 65 IDE!!!.;;..;; ge
04a0: 6e 65 72 61 74 65 20 65 6e 74 72 69 65 73 20 66 nerate entries f
04b0: 6f 72 20 7e 2f 2e 6d 65 67 61 74 65 73 74 72 63 or ~/.megatestrc
04c0: 20 77 69 74 68 20 74 68 65 20 66 6f 6c 6c 6f 77 with the follow
04d0: 69 6e 67 0a 3b 3b 0a 3b 3b 20 20 67 72 65 70 20 ing.;;.;; grep
04e0: 64 65 66 69 6e 65 20 2e 2e 2f 72 6d 74 2e 73 63 define ../rmt.sc
04f0: 6d 20 7c 20 67 72 65 70 20 72 6d 74 3a 20 7c 70 m | grep rmt: |p
0500: 65 72 6c 20 2d 70 69 20 2d 65 20 27 73 2f 5c 28 erl -pi -e 's/\(
0510: 64 65 66 69 6e 65 5c 73 2b 5c 28 28 5c 53 2b 29 define\s+\((\S+)
0520: 5c 57 2e 2a 24 2f 5c 31 2f 27 7c 73 6f 72 74 20 \W.*$/\1/'|sort
0530: 2d 75 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d -u..;;==========
0540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
0580: 20 53 20 55 20 50 20 50 20 4f 20 52 20 54 20 20 S U P P O R T
0590: 20 46 20 55 20 4e 20 43 20 54 20 49 20 4f 20 4e F U N C T I O N
05a0: 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;===========
05b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
05f0: 69 66 20 61 20 73 65 72 76 65 72 20 69 73 20 65 if a server is e
0600: 69 74 68 65 72 20 72 75 6e 6e 69 6e 67 20 6f 72 ither running or
0610: 20 69 6e 20 74 68 65 20 70 72 6f 63 65 73 73 20 in the process
0620: 6f 66 20 73 74 61 72 74 69 6e 67 20 63 61 6c 6c of starting call
0630: 20 63 6c 69 65 6e 74 3a 73 65 74 75 70 0a 3b 3b client:setup.;;
0640: 20 65 6c 73 65 20 72 65 74 75 72 6e 20 23 66 20 else return #f
0650: 74 6f 20 6c 65 74 20 74 68 65 20 63 61 6c 6c 69 to let the calli
0660: 6e 67 20 70 72 6f 63 20 6b 6e 6f 77 20 74 68 61 ng proc know tha
0670: 74 20 74 68 65 72 65 20 69 73 20 6e 6f 20 73 65 t there is no se
0680: 72 76 65 72 20 61 76 61 69 6c 61 62 6c 65 0a 3b rver available.;
0690: 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ;.(define (rmt:g
06a0: 65 74 2d 63 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e et-connection-in
06b0: 66 6f 20 61 72 65 61 70 61 74 68 20 23 21 6b 65 fo areapath #!ke
06c0: 79 20 28 61 72 65 61 2d 64 61 74 20 23 66 29 29 y (area-dat #f))
06d0: 20 3b 3b 20 54 4f 44 4f 3a 20 70 75 73 68 20 61 ;; TODO: push a
06e0: 72 65 61 70 61 74 68 20 64 6f 77 6e 2e 0a 20 20 reapath down..
06f0: 28 6c 65 74 2a 20 28 28 72 75 6e 72 65 6d 6f 74 (let* ((runremot
0700: 65 20 28 6f 72 20 61 72 65 61 2d 64 61 74 20 2a e (or area-dat *
0710: 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 09 20 28 runremote*)).. (
0720: 63 69 6e 66 6f 20 20 20 20 20 28 69 66 20 28 72 cinfo (if (r
0730: 65 6d 6f 74 65 3f 20 72 75 6e 72 65 6d 6f 74 65 emote? runremote
0740: 29 0a 09 09 09 28 72 65 6d 6f 74 65 2d 63 6f 6e )....(remote-con
0750: 6e 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 0a ndat runremote).
0760: 09 09 09 23 66 29 29 29 0a 09 20 20 28 69 66 20 ...#f))).. (if
0770: 63 69 6e 66 6f 0a 09 20 20 20 20 20 20 63 69 6e cinfo.. cin
0780: 66 6f 0a 09 20 20 20 20 20 20 28 69 66 20 28 73 fo.. (if (s
0790: 65 72 76 65 72 3a 63 68 65 63 6b 2d 69 66 2d 72 erver:check-if-r
07a0: 75 6e 6e 69 6e 67 20 61 72 65 61 70 61 74 68 29 unning areapath)
07b0: 0a 09 09 20 20 28 63 6c 69 65 6e 74 3a 73 65 74 ... (client:set
07c0: 75 70 20 61 72 65 61 70 61 74 68 29 0a 09 09 20 up areapath)...
07d0: 20 23 66 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 #f))))..(define
07e0: 20 2a 73 65 6e 64 2d 72 65 63 65 69 76 65 2d 6d *send-receive-m
07f0: 75 74 65 78 2a 20 28 6d 61 6b 65 2d 6d 75 74 65 utex* (make-mute
0800: 78 29 29 20 3b 3b 20 73 68 6f 75 6c 64 20 68 61 x)) ;; should ha
0810: 76 65 20 73 65 70 61 72 61 74 65 20 6d 75 74 65 ve separate mute
0820: 78 20 70 65 72 20 72 75 6e 2d 69 64 0a 0a 28 64 x per run-id..(d
0830: 65 66 69 6e 65 20 2a 72 6d 74 2d 71 75 65 72 79 efine *rmt-query
0840: 2d 6c 61 73 74 2d 63 61 6c 6c 2d 74 69 6d 65 2a -last-call-time*
0850: 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 72 6d 74 0).(define *rmt
0860: 2d 71 75 65 72 79 2d 6c 61 73 74 2d 72 65 73 74 -query-last-rest
0870: 2d 74 69 6d 65 2a 20 30 29 20 3b 3b 20 6c 61 73 -time* 0) ;; las
0880: 74 20 74 69 6d 65 20 74 68 65 72 65 20 77 61 73 t time there was
0890: 20 61 74 20 6c 65 61 73 74 20 61 20 31 2f 32 20 at least a 1/2
08a0: 73 65 63 6f 6e 64 20 72 65 73 74 20 2d 20 67 69 second rest - gi
08b0: 76 69 6e 67 20 6f 74 68 65 72 20 70 72 6f 63 65 ving other proce
08c0: 73 73 65 73 20 61 63 63 65 73 73 20 74 6f 20 74 sses access to t
08d0: 68 65 20 64 62 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 he db..;; NOTE:
08e0: 54 68 69 73 20 71 75 65 72 79 20 72 65 73 74 20 This query rest
08f0: 61 6c 67 6f 72 79 74 68 6d 20 77 69 6c 6c 20 6e algorythm will n
0900: 6f 74 20 61 64 61 70 74 20 74 6f 20 6c 6f 6e 67 ot adapt to long
0910: 20 71 75 65 72 79 20 74 69 6d 65 73 2e 20 52 45 query times. RE
0920: 44 45 53 49 47 4e 20 4e 45 45 44 45 44 2e 20 54 DESIGN NEEDED. T
0930: 4f 44 4f 2e 20 46 49 58 4d 45 2e 0a 3b 3b 0a 28 ODO. FIXME..;;.(
0940: 64 65 66 69 6e 65 20 28 72 6d 74 3a 71 75 65 72 define (rmt:quer
0950: 79 2d 72 65 73 74 29 0a 20 20 28 6c 65 74 2a 20 y-rest). (let*
0960: 28 28 6e 6f 77 20 28 63 75 72 72 65 6e 74 2d 6d ((now (current-m
0970: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 29 0a 20 illiseconds))).
0980: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 (cond. ((
0990: 3e 20 28 2d 20 6e 6f 77 20 2a 72 6d 74 2d 71 75 > (- now *rmt-qu
09a0: 65 72 79 2d 6c 61 73 74 2d 63 61 6c 6c 2d 74 69 ery-last-call-ti
09b0: 6d 65 2a 29 20 35 30 30 29 20 20 3b 3b 20 69 74 me*) 500) ;; it
09c0: 27 73 20 62 65 65 6e 20 61 20 77 68 69 6c 65 20 's been a while
09d0: 73 69 6e 63 65 20 6c 61 73 74 20 71 75 65 72 79 since last query
09e0: 20 2d 20 6e 6f 20 6e 65 65 64 20 74 6f 20 72 65 - no need to re
09f0: 73 74 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a st. (set! *
0a00: 72 6d 74 2d 71 75 65 72 79 2d 6c 61 73 74 2d 72 rmt-query-last-r
0a10: 65 73 74 2d 74 69 6d 65 2a 20 20 6e 6f 77 29 0a est-time* now).
0a20: 20 20 20 20 20 20 28 73 65 74 21 20 2a 72 6d 74 (set! *rmt
0a30: 2d 71 75 65 72 79 2d 6c 61 73 74 2d 63 61 6c 6c -query-last-call
0a40: 2d 74 69 6d 65 2a 20 20 6e 6f 77 29 29 0a 20 20 -time* now)).
0a50: 20 20 20 28 28 3e 20 28 2d 20 6e 6f 77 20 2a 72 ((> (- now *r
0a60: 6d 74 2d 71 75 65 72 79 2d 6c 61 73 74 2d 72 65 mt-query-last-re
0a70: 73 74 2d 74 69 6d 65 2a 29 20 35 30 30 30 29 20 st-time*) 5000)
0a80: 3b 3b 20 6e 6f 20 6e 61 74 75 72 61 6c 20 72 65 ;; no natural re
0a90: 73 74 73 20 68 61 76 65 20 68 61 70 70 65 6e 65 sts have happene
0aa0: 64 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 d. (debug:p
0ab0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
0ac0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 71 75 65 72 79 log-port* "query
0ad0: 20 72 65 73 74 20 6e 65 65 64 65 64 2e 20 62 6c rest needed. bl
0ae0: 6f 63 6b 69 6e 67 20 66 6f 72 20 31 2f 32 20 73 ocking for 1/2 s
0af0: 65 63 6f 6e 64 2e 22 29 0a 20 20 20 20 20 20 28 econd."). (
0b00: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e thread-sleep! 0.
0b10: 35 29 20 3b 3b 20 66 6f 72 63 65 20 61 20 72 65 5) ;; force a re
0b20: 73 74 20 6f 66 20 61 20 68 61 6c 66 20 73 65 63 st of a half sec
0b30: 6f 6e 64 0a 20 20 20 20 20 20 28 73 65 74 21 20 ond. (set!
0b40: 2a 72 6d 74 2d 71 75 65 72 79 2d 6c 61 73 74 2d *rmt-query-last-
0b50: 72 65 73 74 2d 74 69 6d 65 2a 20 6e 6f 77 29 0a rest-time* now).
0b60: 20 20 20 20 20 20 28 73 65 74 21 20 2a 72 6d 74 (set! *rmt
0b70: 2d 71 75 65 72 79 2d 6c 61 73 74 2d 63 61 6c 6c -query-last-call
0b80: 2d 74 69 6d 65 2a 20 6e 6f 77 29 29 0a 20 20 20 -time* now)).
0b90: 20 20 28 65 6c 73 65 20 3b 3b 20 73 75 66 66 69 (else ;; suffi
0ba0: 63 69 65 6e 74 20 72 65 73 74 73 20 68 61 76 65 cient rests have
0bb0: 20 6f 63 63 75 72 72 65 64 2c 20 6a 75 73 74 20 occurred, just
0bc0: 72 65 63 6f 72 64 20 74 68 65 20 6c 61 73 74 20 record the last
0bd0: 71 75 65 72 79 20 74 69 6d 65 0a 20 20 20 20 20 query time.
0be0: 20 28 73 65 74 21 20 2a 72 6d 74 2d 71 75 65 72 (set! *rmt-quer
0bf0: 79 2d 6c 61 73 74 2d 63 61 6c 6c 2d 74 69 6d 65 y-last-call-time
0c00: 2a 20 6e 6f 77 29 29 29 29 29 0a 0a 3b 3b 20 52 * now)))))..;; R
0c10: 41 20 3d 3e 20 65 2e 67 2e 20 75 73 61 67 65 20 A => e.g. usage
0c20: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
0c30: 65 20 27 67 65 74 2d 76 61 72 20 23 66 20 28 6c e 'get-var #f (l
0c40: 69 73 74 20 76 61 72 6e 61 6d 65 29 29 0a 3b 3b ist varname)).;;
0c50: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 .(define (rmt:se
0c60: 6e 64 2d 72 65 63 65 69 76 65 20 63 6d 64 20 72 nd-receive cmd r
0c70: 69 64 20 70 61 72 61 6d 73 20 23 21 6b 65 79 20 id params #!key
0c80: 28 61 74 74 65 6d 70 74 6e 75 6d 20 31 29 28 61 (attemptnum 1)(a
0c90: 72 65 61 2d 64 61 74 20 23 66 29 29 20 3b 3b 20 rea-dat #f)) ;;
0ca0: 73 74 61 72 74 20 61 74 74 65 6d 70 74 6e 75 6d start attemptnum
0cb0: 20 61 74 20 31 20 73 6f 20 74 68 65 20 6d 6f 64 at 1 so the mod
0cc0: 75 6c 6f 20 62 65 6c 6f 77 20 77 6f 72 6b 73 20 ulo below works
0cd0: 61 73 20 65 78 70 65 63 74 65 64 0a 0a 20 20 23 as expected.. #
0ce0: 3b 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 ;(common:telemet
0cf0: 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 72 6d ry-log (conc "rm
0d00: 74 3a 22 28 2d 3e 73 74 72 69 6e 67 20 63 6d 64 t:"(->string cmd
0d10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0d20: 20 20 20 20 20 20 20 20 20 20 20 70 61 79 6c 6f paylo
0d30: 61 64 3a 20 60 28 28 72 69 64 20 2e 20 2c 72 69 ad: `((rid . ,ri
0d40: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d60: 20 20 20 20 20 20 28 70 61 72 61 6d 73 20 2e 20 (params .
0d70: 2c 70 61 72 61 6d 73 29 29 29 0a 20 20 28 69 66 ,params))). (if
0d80: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 63 (not (equal? (c
0d90: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 onfigf:lookup *c
0da0: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
0db0: 22 20 22 71 75 65 72 79 2d 72 65 73 74 22 29 20 " "query-rest")
0dc0: 22 6e 6f 22 29 29 0a 20 20 20 20 20 20 28 72 6d "no")). (rm
0dd0: 74 3a 71 75 65 72 79 2d 72 65 73 74 29 29 0a 20 t:query-rest)).
0de0: 20 0a 20 20 28 69 66 20 28 3e 20 61 74 74 65 6d . (if (> attem
0df0: 70 74 6e 75 6d 20 32 29 0a 20 20 20 20 20 20 28 ptnum 2). (
0e00: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
0e10: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
0e20: 20 22 49 4e 46 4f 3a 20 61 74 74 65 6d 70 74 6e "INFO: attemptn
0e30: 75 6d 20 69 6e 20 72 6d 74 3a 73 65 6e 64 2d 72 um in rmt:send-r
0e40: 65 63 65 69 76 65 20 69 73 20 22 20 61 74 74 65 eceive is " atte
0e50: 6d 70 74 6e 75 6d 29 29 0a 20 20 20 20 0a 20 20 mptnum)). .
0e60: 28 63 6f 6e 64 0a 20 20 20 28 28 3e 20 61 74 74 (cond. ((> att
0e70: 65 6d 70 74 6e 75 6d 20 32 29 20 28 74 68 72 65 emptnum 2) (thre
0e80: 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 35 29 29 ad-sleep! 0.05))
0e90: 0a 20 20 20 28 28 3e 20 61 74 74 65 6d 70 74 6e . ((> attemptn
0ea0: 75 6d 20 31 30 29 20 28 74 68 72 65 61 64 2d 73 um 10) (thread-s
0eb0: 6c 65 65 70 21 20 30 2e 35 29 29 0a 20 20 20 28 leep! 0.5)). (
0ec0: 28 3e 20 61 74 74 65 6d 70 74 6e 75 6d 20 32 30 (> attemptnum 20
0ed0: 29 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ) (thread-sleep!
0ee0: 20 31 29 29 29 0a 20 20 28 69 66 20 28 61 6e 64 1))). (if (and
0ef0: 20 28 3e 20 61 74 74 65 6d 70 74 6e 75 6d 20 35 (> attemptnum 5
0f00: 29 20 28 3d 20 30 20 28 6d 6f 64 75 6c 6f 20 61 ) (= 0 (modulo a
0f10: 74 74 65 6d 70 74 6e 75 6d 20 31 35 29 29 29 20 ttemptnum 15)))
0f20: 20 0a 20 20 20 20 28 62 65 67 69 6e 20 28 73 65 . (begin (se
0f30: 72 76 65 72 3a 72 75 6e 20 2a 74 6f 70 70 61 74 rver:run *toppat
0f40: 68 2a 29 20 28 74 68 72 65 61 64 2d 73 6c 65 65 h*) (thread-slee
0f50: 70 21 20 33 29 29 29 20 0a 20 20 0a 20 20 0a 20 p! 3))) . . .
0f60: 20 3b 3b 44 4f 54 20 64 69 67 72 61 70 68 20 6d ;;DOT digraph m
0f70: 65 67 61 74 65 73 74 5f 73 74 61 74 65 5f 73 74 egatest_state_st
0f80: 61 74 75 73 20 7b 0a 20 20 3b 3b 44 4f 54 20 20 atus {. ;;DOT
0f90: 20 72 61 6e 6b 73 65 70 3d 30 3b 0a 20 20 3b 3b ranksep=0;. ;;
0fa0: 44 4f 54 20 20 20 2f 2f 20 72 61 6e 6b 64 69 72 DOT // rankdir
0fb0: 3d 4c 52 3b 0a 20 20 3b 3b 44 4f 54 20 20 20 6e =LR;. ;;DOT n
0fc0: 6f 64 65 20 5b 73 68 61 70 65 3d 22 62 6f 78 22 ode [shape="box"
0fd0: 5d 3b 0a 20 20 3b 3b 44 4f 54 20 22 72 6d 74 3a ];. ;;DOT "rmt:
0fe0: 73 65 6e 64 2d 72 65 63 65 69 76 65 22 20 2d 3e send-receive" ->
0ff0: 20 4d 55 54 45 58 4c 4f 43 4b 3b 0a 20 20 3b 3b MUTEXLOCK;. ;;
1000: 44 4f 54 20 7b 20 65 64 67 65 20 5b 73 74 79 6c DOT { edge [styl
1010: 65 3d 69 6e 76 69 73 5d 3b 22 63 61 73 65 20 31 e=invis];"case 1
1020: 22 20 2d 3e 20 22 63 61 73 65 20 32 22 20 2d 3e " -> "case 2" ->
1030: 20 22 63 61 73 65 20 33 22 20 2d 3e 20 22 63 61 "case 3" -> "ca
1040: 73 65 20 34 22 20 2d 3e 20 22 63 61 73 65 20 35 se 4" -> "case 5
1050: 22 20 2d 3e 20 22 63 61 73 65 20 36 22 20 2d 3e " -> "case 6" ->
1060: 20 22 63 61 73 65 20 37 22 20 2d 3e 20 22 63 61 "case 7" -> "ca
1070: 73 65 20 38 22 20 2d 3e 20 22 63 61 73 65 20 39 se 8" -> "case 9
1080: 22 20 2d 3e 20 22 63 61 73 65 20 31 30 22 20 2d " -> "case 10" -
1090: 3e 20 22 63 61 73 65 20 31 31 22 3b 20 7d 0a 20 > "case 11"; }.
10a0: 20 3b 3b 20 64 6f 20 61 6c 6c 20 74 68 65 20 70 ;; do all the p
10b0: 72 65 70 20 6c 6f 63 6b 65 64 20 75 6e 64 65 72 rep locked under
10c0: 20 74 68 65 20 72 6d 74 2d 6d 75 74 65 78 0a 20 the rmt-mutex.
10d0: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 72 (mutex-lock! *r
10e0: 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 0a 20 20 mt-mutex*). .
10f0: 3b 3b 20 31 2e 20 63 68 65 63 6b 20 69 66 20 73 ;; 1. check if s
1100: 65 72 76 65 72 20 69 73 20 73 74 61 72 74 65 64 erver is started
1110: 20 49 46 46 20 63 6d 64 20 69 73 20 61 20 77 72 IFF cmd is a wr
1120: 69 74 65 20 4f 52 20 69 66 20 77 65 20 61 72 65 ite OR if we are
1130: 20 6e 6f 74 20 6f 6e 20 74 68 65 20 68 6f 6d 65 not on the home
1140: 68 6f 73 74 2c 20 73 74 6f 72 65 20 69 6e 20 72 host, store in r
1150: 75 6e 72 65 6d 6f 74 65 0a 20 20 3b 3b 20 32 2e unremote. ;; 2.
1160: 20 63 68 65 63 6b 20 74 68 65 20 61 67 65 20 6f check the age o
1170: 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e f the connection
1180: 73 2e 20 72 65 66 72 65 73 68 20 74 68 65 20 63 s. refresh the c
1190: 6f 6e 6e 65 63 74 69 6f 6e 20 69 66 20 69 74 20 onnection if it
11a0: 69 73 20 6f 6c 64 65 72 20 74 68 61 6e 20 74 69 is older than ti
11b0: 6d 65 6f 75 74 2d 32 30 20 73 65 63 6f 6e 64 73 meout-20 seconds
11c0: 2e 0a 20 20 3b 3b 20 33 2e 20 64 6f 20 74 68 65 .. ;; 3. do the
11d0: 20 71 75 65 72 79 2c 20 69 66 20 6f 6e 20 68 6f query, if on ho
11e0: 6d 65 68 6f 73 74 20 75 73 65 20 6c 6f 63 61 6c mehost use local
11f0: 20 61 63 63 65 73 73 0a 20 20 3b 3b 0a 20 20 28 access. ;;. (
1200: 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 74 69 6d let* ((start-tim
1210: 65 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 e (current-se
1220: 63 6f 6e 64 73 29 29 20 3b 3b 20 73 6e 61 70 73 conds)) ;; snaps
1230: 68 6f 74 20 74 69 6d 65 20 73 6f 20 61 6c 6c 20 hot time so all
1240: 75 73 65 20 63 61 73 65 73 20 67 65 74 20 73 61 use cases get sa
1250: 6d 65 20 76 61 6c 75 65 0a 20 20 20 20 20 20 20 me value.
1260: 20 20 28 61 72 65 61 70 61 74 68 20 20 20 20 20 (areapath
1270: 20 2a 74 6f 70 70 61 74 68 2a 29 3b 3b 20 54 4f *toppath*);; TO
1280: 44 4f 20 2d 20 72 65 73 6f 6c 76 65 20 66 72 6f DO - resolve fro
1290: 6d 20 64 62 73 74 72 75 63 74 20 74 6f 20 62 65 m dbstruct to be
12a0: 20 63 6f 6d 70 61 74 69 62 6c 65 20 77 69 74 68 compatible with
12b0: 20 6d 75 6c 74 69 70 6c 65 20 61 72 65 61 73 0a multiple areas.
12c0: 09 20 28 72 75 6e 72 65 6d 6f 74 65 20 20 20 20 . (runremote
12d0: 20 28 6f 72 20 61 72 65 61 2d 64 61 74 0a 09 09 (or area-dat...
12e0: 09 20 20 20 20 2a 72 75 6e 72 65 6d 6f 74 65 2a . *runremote*
12f0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 61 74 74 )). (att
1300: 65 6d 70 74 6e 75 6d 20 20 20 20 28 2b 20 31 20 emptnum (+ 1
1310: 61 74 74 65 6d 70 74 6e 75 6d 29 29 0a 09 20 28 attemptnum)).. (
1320: 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 28 72 readonly-mode (r
1330: 6d 74 6d 6f 64 3a 63 61 6c 63 2d 72 6f 2d 6d 6f mtmod:calc-ro-mo
1340: 64 65 20 72 75 6e 72 65 6d 6f 74 65 20 2a 74 6f de runremote *to
1350: 70 70 61 74 68 2a 29 29 29 0a 0a 20 20 20 20 3b ppath*))).. ;
1360: 3b 20 44 4f 54 20 49 4e 49 54 5f 52 55 4e 52 45 ; DOT INIT_RUNRE
1370: 4d 4f 54 45 3b 20 2f 2f 20 6c 65 61 76 69 6e 67 MOTE; // leaving
1380: 20 6f 66 66 20 2d 20 64 6f 65 73 6e 27 74 20 72 off - doesn't r
1390: 65 61 6c 6c 79 20 61 64 64 20 74 6f 20 74 68 65 eally add to the
13a0: 20 63 6c 61 72 69 74 79 0a 20 20 20 20 3b 3b 20 clarity. ;;
13b0: 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e DOT MUTEXLOCK ->
13c0: 20 49 4e 49 54 5f 52 55 4e 52 45 4d 4f 54 45 20 INIT_RUNREMOTE
13d0: 5b 6c 61 62 65 6c 3d 22 6e 6f 20 72 65 6d 6f 74 [label="no remot
13e0: 65 3f 22 5d 3b 0a 20 20 20 20 3b 3b 20 44 4f 54 e?"];. ;; DOT
13f0: 20 49 4e 49 54 5f 52 55 4e 52 45 4d 4f 54 45 20 INIT_RUNREMOTE
1400: 2d 3e 20 4d 55 54 45 58 4c 4f 43 4b 3b 0a 20 20 -> MUTEXLOCK;.
1410: 20 20 3b 3b 20 65 6e 73 75 72 65 20 77 65 20 68 ;; ensure we h
1420: 61 76 65 20 61 20 72 65 63 6f 72 64 20 66 6f 72 ave a record for
1430: 20 6f 75 72 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 our connection
1440: 66 6f 72 20 67 69 76 65 6e 20 61 72 65 61 0a 20 for given area.
1450: 20 20 20 28 69 66 20 28 6e 6f 74 20 72 75 6e 72 (if (not runr
1460: 65 6d 6f 74 65 29 20 20 20 20 20 20 20 20 20 20 emote)
1470: 20 20 20 20 20 20 20 20 20 3b 3b 20 63 61 6e 20 ;; can
1480: 72 65 6d 6f 76 65 20 74 68 69 73 20 6f 6e 65 2e remove this one.
1490: 20 73 68 6f 75 6c 64 20 6e 65 76 65 72 20 67 65 should never ge
14a0: 74 20 68 65 72 65 2e 20 20 20 20 20 20 20 20 20 t here.
14b0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74 ..(begin.. (set
14c0: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 6d ! *runremote* (m
14d0: 61 6b 65 2d 72 65 6d 6f 74 65 29 29 0a 09 20 20 ake-remote))..
14e0: 28 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 (set! runremote
14f0: 20 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 29 29 *runremote*)))
1500: 20 3b 3b 20 6e 65 77 20 72 75 6e 72 65 6d 6f 74 ;; new runremot
1510: 65 20 77 69 6c 6c 20 63 6f 6d 65 20 66 72 6f 6d e will come from
1520: 20 74 68 69 73 20 6f 6e 20 6e 65 78 74 20 69 74 this on next it
1530: 65 72 61 74 69 6f 6e 0a 20 20 20 20 0a 20 20 20 eration. .
1540: 20 3b 3b 20 44 4f 54 20 53 45 54 5f 48 4f 4d 45 ;; DOT SET_HOME
1550: 48 4f 53 54 3b 20 2f 2f 20 6c 65 61 76 69 6e 67 HOST; // leaving
1560: 20 6f 66 66 20 2d 20 64 6f 65 73 6e 27 74 20 72 off - doesn't r
1570: 65 61 6c 6c 79 20 61 64 64 20 74 6f 20 74 68 65 eally add to the
1580: 20 63 6c 61 72 69 74 79 0a 20 20 20 20 3b 3b 20 clarity. ;;
1590: 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e DOT MUTEXLOCK ->
15a0: 20 53 45 54 5f 48 4f 4d 45 48 4f 53 54 20 5b 6c SET_HOMEHOST [l
15b0: 61 62 65 6c 3d 22 6e 6f 20 68 6f 6d 65 68 6f 73 abel="no homehos
15c0: 74 3f 22 5d 3b 0a 20 20 20 20 3b 3b 20 44 4f 54 t?"];. ;; DOT
15d0: 20 53 45 54 5f 48 4f 4d 45 48 4f 53 54 20 2d 3e SET_HOMEHOST ->
15e0: 20 4d 55 54 45 58 4c 4f 43 4b 3b 0a 20 20 20 20 MUTEXLOCK;.
15f0: 3b 3b 20 65 6e 73 75 72 65 20 77 65 20 68 61 76 ;; ensure we hav
1600: 65 20 61 20 68 6f 6d 65 68 6f 73 74 20 72 65 63 e a homehost rec
1610: 6f 72 64 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ord. (if (not
1620: 20 28 70 61 69 72 3f 20 28 72 65 6d 6f 74 65 2d (pair? (remote-
1630: 68 68 2d 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 hh-dat runremote
1640: 29 29 29 20 20 3b 3b 20 6e 6f 74 20 6f 6e 20 68 ))) ;; not on h
1650: 6f 6d 65 68 6f 73 74 0a 09 28 74 68 72 65 61 64 omehost..(thread
1660: 2d 73 6c 65 65 70 21 20 30 2e 31 29 20 3b 3b 20 -sleep! 0.1) ;;
1670: 73 69 6e 63 65 20 77 65 20 73 68 6f 75 6c 64 6e since we shouldn
1680: 27 74 20 67 65 74 20 68 65 72 65 2c 20 64 65 6c 't get here, del
1690: 61 79 20 61 20 6c 69 74 74 6c 65 0a 09 28 72 65 ay a little..(re
16a0: 6d 6f 74 65 2d 68 68 2d 64 61 74 2d 73 65 74 21 mote-hh-dat-set!
16b0: 20 72 75 6e 72 65 6d 6f 74 65 20 28 63 6f 6d 6d runremote (comm
16c0: 6f 6e 3a 67 65 74 2d 68 6f 6d 65 68 6f 73 74 29 on:get-homehost)
16d0: 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 28 70 )). . ;;(p
16e0: 72 69 6e 74 20 22 42 42 3e 20 72 65 61 64 6f 6e rint "BB> readon
16f0: 6c 79 2d 6d 6f 64 65 20 69 73 20 22 72 65 61 64 ly-mode is "read
1700: 6f 6e 6c 79 2d 6d 6f 64 65 22 20 64 62 66 69 6c only-mode" dbfil
1710: 65 20 69 73 20 22 64 62 66 69 6c 65 29 0a 20 20 e is "dbfile).
1720: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 3b 3b 44 (cond. ;;D
1730: 4f 54 20 45 58 49 54 3b 0a 20 20 20 20 20 3b 3b OT EXIT;. ;;
1740: 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e DOT MUTEXLOCK ->
1750: 20 45 58 49 54 20 5b 6c 61 62 65 6c 3d 22 3e 20 EXIT [label=">
1760: 31 35 20 61 74 74 65 6d 70 74 73 22 5d 3b 20 7b 15 attempts"]; {
1770: 72 61 6e 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 rank=same "case
1780: 31 22 20 22 45 58 49 54 22 20 7d 0a 20 20 20 20 1" "EXIT" }.
1790: 20 3b 3b 20 67 69 76 65 20 75 70 20 69 66 20 6d ;; give up if m
17a0: 6f 72 65 20 74 68 61 6e 20 31 35 30 20 61 74 74 ore than 150 att
17b0: 65 6d 70 74 73 0a 20 20 20 20 20 28 28 3e 20 61 empts. ((> a
17c0: 74 74 65 6d 70 74 6e 75 6d 20 31 35 30 29 0a 20 ttemptnum 150).
17d0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
17e0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
17f0: 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 31 -port* "ERROR: 1
1800: 35 30 20 74 72 69 65 73 20 74 6f 20 73 74 61 72 50 tries to star
1810: 74 2f 63 6f 6e 6e 65 63 74 20 74 6f 20 73 65 72 t/connect to ser
1820: 76 65 72 2e 20 47 69 76 69 6e 67 20 75 70 2e 22 ver. Giving up."
1830: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 ). (exit 1)
1840: 29 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 ).. ;;DOT CA
1850: 53 45 32 20 5b 6c 61 62 65 6c 3d 22 6c 6f 63 61 SE2 [label="loca
1860: 6c 5c 6e 72 65 61 64 6f 6e 6c 79 5c 6e 71 75 65 l\nreadonly\nque
1870: 72 79 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 ry"];. ;;DOT
1880: 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 MUTEXLOCK -> CA
1890: 53 45 32 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 SE2; {rank=same
18a0: 22 63 61 73 65 20 32 22 20 43 41 53 45 32 7d 0a "case 2" CASE2}.
18b0: 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 32 ;;DOT CASE2
18c0: 20 2d 3e 20 22 72 6d 74 3a 6f 70 65 6e 2d 71 72 -> "rmt:open-qr
18d0: 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 22 y-close-locally"
18e0: 3b 0a 20 20 20 20 20 3b 3b 20 72 65 61 64 6f 6e ;. ;; readon
18f0: 6c 79 20 6d 6f 64 65 2c 20 72 65 61 64 20 72 65 ly mode, read re
1900: 71 75 65 73 74 2d 20 20 68 61 6e 64 6c 65 20 69 quest- handle i
1910: 74 20 2d 20 63 61 73 65 20 32 0a 20 20 20 20 20 t - case 2.
1920: 28 28 61 6e 64 20 72 65 61 64 6f 6e 6c 79 2d 6d ((and readonly-m
1930: 6f 64 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 ode. (
1940: 6d 65 6d 62 65 72 20 63 6d 64 20 61 70 69 3a 72 member cmd api:r
1950: 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 73 ead-only-queries
1960: 29 29 20 0a 20 20 20 20 20 20 28 6d 75 74 65 78 )) . (mutex
1970: 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 -unlock! *rmt-mu
1980: 74 65 78 2a 29 0a 20 20 20 20 20 20 28 64 65 62 tex*). (deb
1990: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 ug:print-info 12
19a0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
19b0: 72 74 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 rt* "rmt:send-re
19c0: 63 65 69 76 65 2c 20 63 61 73 65 20 32 22 29 0a ceive, case 2").
19d0: 20 20 20 20 20 20 28 72 6d 74 3a 6f 70 65 6e 2d (rmt:open-
19e0: 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c qry-close-locall
19f0: 79 20 63 6d 64 20 30 20 70 61 72 61 6d 73 29 0a y cmd 0 params).
1a00: 20 20 20 20 20 20 29 0a 0a 20 20 20 20 20 3b 3b ).. ;;
1a10: 44 4f 54 20 43 41 53 45 33 20 5b 6c 61 62 65 6c DOT CASE3 [label
1a20: 3d 22 77 72 69 74 65 20 69 6e 5c 6e 72 65 61 64 ="write in\nread
1a30: 2d 6f 6e 6c 79 20 6d 6f 64 65 22 5d 3b 0a 20 20 -only mode"];.
1a40: 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f ;;DOT MUTEXLO
1a50: 43 4b 20 2d 3e 20 43 41 53 45 33 20 5b 6c 61 62 CK -> CASE3 [lab
1a60: 65 6c 3d 22 72 65 61 64 6f 6e 6c 79 5c 6e 6d 6f el="readonly\nmo
1a70: 64 65 3f 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d de?"]; {rank=sam
1a80: 65 20 22 63 61 73 65 20 33 22 20 43 41 53 45 33 e "case 3" CASE3
1a90: 7d 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 }. ;;DOT CAS
1aa0: 45 33 20 2d 3e 20 22 23 66 22 3b 0a 20 20 20 20 E3 -> "#f";.
1ab0: 20 3b 3b 20 72 65 61 64 6f 6e 6c 79 20 6d 6f 64 ;; readonly mod
1ac0: 65 2c 20 77 72 69 74 65 20 72 65 71 75 65 73 74 e, write request
1ad0: 2e 20 20 44 6f 20 6e 6f 74 68 69 6e 67 2c 20 72 . Do nothing, r
1ae0: 65 74 75 72 6e 20 23 66 0a 20 20 20 20 20 28 72 eturn #f. (r
1af0: 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 28 65 78 eadonly-mode (ex
1b00: 74 72 61 73 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f tras-readonly-mo
1b10: 64 65 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 20 2a de *rmt-mutex* *
1b20: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
1b30: 2a 20 63 6d 64 20 70 61 72 61 6d 73 29 29 0a 0a * cmd params))..
1b40: 20 20 20 20 20 3b 3b 20 54 68 69 73 20 62 6c 6f ;; This blo
1b50: 63 6b 20 77 61 73 20 66 6f 72 20 70 72 65 2d 65 ck was for pre-e
1b60: 6d 70 74 69 76 65 6c 79 20 72 65 73 65 74 74 69 mptively resetti
1b70: 6e 67 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f ng the connectio
1b80: 6e 20 69 66 20 74 68 65 72 65 20 68 61 64 20 62 n if there had b
1b90: 65 65 6e 20 6e 6f 20 63 6f 6d 6d 75 6e 69 63 61 een no communica
1ba0: 74 69 6f 6e 20 66 6f 72 20 73 6f 6d 65 20 74 69 tion for some ti
1bb0: 6d 65 2e 0a 20 20 20 20 20 3b 3b 20 49 20 64 6f me.. ;; I do
1bc0: 6e 27 74 20 74 68 69 6e 6b 20 69 74 20 61 64 64 n't think it add
1bd0: 73 20 61 6e 79 20 76 61 6c 75 65 2e 20 49 66 20 s any value. If
1be0: 74 68 65 20 73 65 72 76 65 72 20 69 73 20 6e 6f the server is no
1bf0: 74 20 74 68 65 72 65 2c 20 6a 75 73 74 20 66 61 t there, just fa
1c00: 69 6c 20 61 6e 64 20 73 74 61 72 74 20 61 20 6e il and start a n
1c10: 65 77 20 63 6f 6e 6e 65 63 74 69 6f 6e 2e 0a 20 ew connection..
1c20: 20 20 20 20 3b 3b 20 61 6c 73 6f 2c 20 74 68 65 ;; also, the
1c30: 20 65 78 70 69 72 65 2d 74 69 6d 65 20 63 61 6c expire-time cal
1c40: 63 75 6c 61 74 69 6f 6e 20 6d 69 67 68 74 20 6e culation might n
1c50: 6f 74 20 62 65 20 63 6f 72 72 65 63 74 2e 20 57 ot be correct. W
1c60: 65 20 77 61 6e 74 2c 20 74 69 6d 65 2d 73 69 6e e want, time-sin
1c70: 63 65 2d 6c 61 73 74 2d 73 65 72 76 65 72 2d 61 ce-last-server-a
1c80: 63 63 65 73 73 20 3e 20 28 73 65 72 76 65 72 3a ccess > (server:
1c90: 67 65 74 2d 74 69 6d 65 6f 75 74 29 0a 20 20 20 get-timeout).
1ca0: 20 20 3b 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 ;;. ;;DOT
1cb0: 43 41 53 45 34 20 5b 6c 61 62 65 6c 3d 22 72 65 CASE4 [label="re
1cc0: 73 65 74 5c 6e 63 6f 6e 6e 65 63 74 69 6f 6e 22 set\nconnection"
1cd0: 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 ];. ;;DOT MU
1ce0: 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 34 TEXLOCK -> CASE4
1cf0: 20 5b 6c 61 62 65 6c 3d 22 68 61 76 65 20 63 6f [label="have co
1d00: 6e 6e 65 63 74 69 6f 6e 2c 5c 6e 6c 61 73 74 5f nnection,\nlast_
1d10: 61 63 63 65 73 73 20 3e 20 65 78 70 69 72 65 5f access > expire_
1d20: 74 69 6d 65 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 time"]; {rank=sa
1d30: 6d 65 20 22 63 61 73 65 20 34 22 20 43 41 53 45 me "case 4" CASE
1d40: 34 7d 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 4}. ;;DOT CA
1d50: 53 45 34 20 2d 3e 20 22 72 6d 74 3a 73 65 6e 64 SE4 -> "rmt:send
1d60: 2d 72 65 63 65 69 76 65 22 3b 0a 20 20 20 20 20 -receive";.
1d70: 3b 3b 20 72 65 73 65 74 20 74 68 65 20 63 6f 6e ;; reset the con
1d80: 6e 65 63 74 69 6f 6e 20 69 66 20 69 74 20 68 61 nection if it ha
1d90: 73 20 62 65 65 6e 20 75 6e 75 73 65 64 20 74 6f s been unused to
1da0: 6f 20 6c 6f 6e 67 0a 20 20 20 20 20 28 28 61 6e o long. ((an
1db0: 64 20 72 75 6e 72 65 6d 6f 74 65 0a 20 20 20 20 d runremote.
1dc0: 20 20 20 20 20 20 20 28 72 65 6d 6f 74 65 2d 63 (remote-c
1dd0: 6f 6e 6e 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 onndat runremote
1de0: 29 0a 09 20 20 20 28 3e 20 28 63 75 72 72 65 6e ).. (> (curren
1df0: 74 2d 73 65 63 6f 6e 64 73 29 20 3b 3b 20 69 66 t-seconds) ;; if
1e00: 20 69 74 20 68 61 73 20 62 65 65 6e 20 6d 6f 72 it has been mor
1e10: 65 20 74 68 61 6e 20 73 65 72 76 65 72 2d 74 69 e than server-ti
1e20: 6d 65 6f 75 74 20 73 65 63 6f 6e 64 73 20 73 69 meout seconds si
1e30: 6e 63 65 20 6c 61 73 74 20 63 6f 6e 74 61 63 74 nce last contact
1e40: 2c 20 63 6c 6f 73 65 20 74 68 69 73 20 63 6f 6e , close this con
1e50: 6e 65 63 74 69 6f 6e 20 61 6e 64 20 73 74 61 72 nection and star
1e60: 74 20 61 20 6e 65 77 20 6f 6e 0a 09 20 20 20 20 t a new on..
1e70: 20 20 28 2b 20 28 68 74 74 70 2d 74 72 61 6e 73 (+ (http-trans
1e80: 70 6f 72 74 3a 73 65 72 76 65 72 2d 64 61 74 2d port:server-dat-
1e90: 67 65 74 2d 6c 61 73 74 2d 61 63 63 65 73 73 20 get-last-access
1ea0: 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 20 (remote-conndat
1eb0: 72 75 6e 72 65 6d 6f 74 65 29 29 0a 09 09 20 28 runremote))... (
1ec0: 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 74 69 remote-server-ti
1ed0: 6d 65 6f 75 74 20 72 75 6e 72 65 6d 6f 74 65 29 meout runremote)
1ee0: 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 ))). (debug
1ef0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
1f00: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1f10: 20 22 43 6f 6e 6e 65 63 74 69 6f 6e 20 74 6f 20 "Connection to
1f20: 22 20 28 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 " (remote-server
1f30: 2d 75 72 6c 20 72 75 6e 72 65 6d 6f 74 65 29 20 -url runremote)
1f40: 22 20 65 78 70 69 72 65 64 20 64 75 65 20 74 6f " expired due to
1f50: 20 6e 6f 20 61 63 63 65 73 73 65 73 2c 20 66 6f no accesses, fo
1f60: 72 63 69 6e 67 20 6e 65 77 20 63 6f 6e 6e 65 63 rcing new connec
1f70: 74 69 6f 6e 2e 22 29 0a 20 20 20 20 20 20 28 68 tion."). (h
1f80: 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c ttp-transport:cl
1f90: 6f 73 65 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 ose-connections
1fa0: 61 72 65 61 2d 64 61 74 3a 20 72 75 6e 72 65 6d area-dat: runrem
1fb0: 6f 74 65 29 0a 20 20 20 20 20 20 28 72 65 6d 6f ote). (remo
1fc0: 74 65 2d 63 6f 6e 6e 64 61 74 2d 73 65 74 21 20 te-conndat-set!
1fd0: 72 75 6e 72 65 6d 6f 74 65 20 23 66 29 20 3b 3b runremote #f) ;;
1fe0: 20 69 6e 76 61 6c 69 64 61 74 65 20 74 68 65 20 invalidate the
1ff0: 63 6f 6e 6e 65 63 74 69 6f 6e 2c 20 74 68 75 73 connection, thus
2000: 20 66 6f 72 63 69 6e 67 20 61 20 6e 65 77 20 63 forcing a new c
2010: 6f 6e 6e 65 63 74 69 6f 6e 2e 0a 20 20 20 20 20 onnection..
2020: 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
2030: 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 *rmt-mutex*).
2040: 20 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 (rmt:send-rec
2050: 65 69 76 65 20 63 6d 64 20 72 69 64 20 70 61 72 eive cmd rid par
2060: 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d 3a 20 ams attemptnum:
2070: 61 74 74 65 6d 70 74 6e 75 6d 29 29 0a 20 20 20 attemptnum)).
2080: 20 20 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 . ;;DOT CA
2090: 53 45 35 20 5b 6c 61 62 65 6c 3d 22 6c 6f 63 61 SE5 [label="loca
20a0: 6c 5c 6e 72 65 61 64 22 5d 3b 0a 20 20 20 20 20 l\nread"];.
20b0: 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 ;;DOT MUTEXLOCK
20c0: 2d 3e 20 43 41 53 45 35 20 5b 6c 61 62 65 6c 3d -> CASE5 [label=
20d0: 22 73 65 72 76 65 72 20 6e 6f 74 20 72 65 71 75 "server not requ
20e0: 69 72 65 64 2c 5c 6e 6f 6e 20 68 6f 6d 65 68 6f ired,\non homeho
20f0: 73 74 2c 5c 6e 72 65 61 64 2d 6f 6e 6c 79 20 71 st,\nread-only q
2100: 75 65 72 79 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 uery"]; {rank=sa
2110: 6d 65 20 22 63 61 73 65 20 35 22 20 43 41 53 45 me "case 5" CASE
2120: 35 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 5};. ;;DOT C
2130: 41 53 45 35 20 2d 3e 20 22 72 6d 74 3a 6f 70 65 ASE5 -> "rmt:ope
2140: 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 n-qry-close-loca
2150: 6c 6c 79 22 3b 0a 0a 20 20 20 20 20 3b 3b 20 6f lly";.. ;; o
2160: 6e 20 68 6f 6d 65 68 6f 73 74 20 61 6e 64 20 74 n homehost and t
2170: 68 69 73 20 69 73 20 61 20 72 65 61 64 0a 20 20 his is a read.
2180: 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 28 72 ((and (not (r
2190: 65 6d 6f 74 65 2d 66 6f 72 63 65 2d 73 65 72 76 emote-force-serv
21a0: 65 72 20 72 75 6e 72 65 6d 6f 74 65 29 29 20 3b er runremote)) ;
21b0: 3b 20 68 6f 6e 6f 72 20 66 6f 72 63 65 64 20 75 ; honor forced u
21c0: 73 65 20 6f 66 20 73 65 72 76 65 72 2c 20 69 2e se of server, i.
21d0: 65 2e 20 73 65 72 76 65 72 20 4e 4f 54 20 72 65 e. server NOT re
21e0: 71 75 69 72 65 64 0a 09 20 20 20 28 63 64 72 20 quired.. (cdr
21f0: 28 72 65 6d 6f 74 65 2d 68 68 2d 64 61 74 20 72 (remote-hh-dat r
2200: 75 6e 72 65 6d 6f 74 65 29 29 20 20 20 20 20 20 unremote))
2210: 20 3b 3b 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 0a ;; on homehost.
2220: 20 20 20 20 20 20 20 20 20 20 20 28 6d 65 6d 62 (memb
2230: 65 72 20 63 6d 64 20 61 70 69 3a 72 65 61 64 2d er cmd api:read-
2240: 6f 6e 6c 79 2d 71 75 65 72 69 65 73 29 29 20 20 only-queries))
2250: 20 3b 3b 20 74 68 69 73 20 69 73 20 61 20 72 65 ;; this is a re
2260: 61 64 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d ad. (mutex-
2270: 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 unlock! *rmt-mut
2280: 65 78 2a 29 0a 20 20 20 20 20 20 28 64 65 62 75 ex*). (debu
2290: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 g:print-info 12
22a0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
22b0: 74 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 t* "rmt:send-rec
22c0: 65 69 76 65 2c 20 63 61 73 65 20 20 35 22 29 0a eive, case 5").
22d0: 20 20 20 20 20 20 28 72 6d 74 3a 6f 70 65 6e 2d (rmt:open-
22e0: 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c qry-close-locall
22f0: 79 20 63 6d 64 20 30 20 70 61 72 61 6d 73 29 29 y cmd 0 params))
2300: 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 .. ;;DOT CAS
2310: 45 36 20 5b 6c 61 62 65 6c 3d 22 69 6e 69 74 5c E6 [label="init\
2320: 6e 72 65 6d 6f 74 65 22 5d 3b 0a 20 20 20 20 20 nremote"];.
2330: 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 ;;DOT MUTEXLOCK
2340: 2d 3e 20 43 41 53 45 36 20 5b 6c 61 62 65 6c 3d -> CASE6 [label=
2350: 22 6f 6e 20 68 6f 6d 65 68 6f 73 74 2c 5c 6e 77 "on homehost,\nw
2360: 72 69 74 65 20 71 75 65 72 79 2c 5c 6e 68 61 76 rite query,\nhav
2370: 65 20 73 65 72 76 65 72 2c 5c 6e 63 61 6e 27 74 e server,\ncan't
2380: 20 72 65 61 63 68 20 69 74 22 5d 3b 20 7b 72 61 reach it"]; {ra
2390: 6e 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 36 22 nk=same "case 6"
23a0: 20 43 41 53 45 36 7d 3b 0a 20 20 20 20 20 3b 3b CASE6};. ;;
23b0: 44 4f 54 20 43 41 53 45 36 20 2d 3e 20 22 72 6d DOT CASE6 -> "rm
23c0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 22 3b t:send-receive";
23d0: 0a 20 20 20 20 20 3b 3b 20 6f 6e 20 68 6f 6d 65 . ;; on home
23e0: 68 6f 73 74 20 61 6e 64 20 74 68 69 73 20 69 73 host and this is
23f0: 20 61 20 77 72 69 74 65 2c 20 77 65 20 61 6c 72 a write, we alr
2400: 65 61 64 79 20 68 61 76 65 20 61 20 73 65 72 76 eady have a serv
2410: 65 72 2c 20 62 75 74 20 73 65 72 76 65 72 20 68 er, but server h
2420: 61 73 20 64 69 65 64 0a 20 20 20 20 20 28 28 61 as died. ((a
2430: 6e 64 20 28 63 64 72 20 28 72 65 6d 6f 74 65 2d nd (cdr (remote-
2440: 68 68 2d 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 hh-dat runremote
2450: 29 29 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 )) ;;
2460: 6f 6e 20 68 6f 6d 65 68 6f 73 74 0a 20 20 20 20 on homehost.
2470: 20 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d (not (mem
2480: 62 65 72 20 63 6d 64 20 61 70 69 3a 72 65 61 64 ber cmd api:read
2490: 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 73 29 29 20 -only-queries))
24a0: 20 3b 3b 20 74 68 69 73 20 69 73 20 61 20 77 72 ;; this is a wr
24b0: 69 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 ite. (
24c0: 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 remote-server-ur
24d0: 6c 20 72 75 6e 72 65 6d 6f 74 65 29 20 20 20 20 l runremote)
24e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 68 61 76 65 ;; have
24f0: 20 61 20 73 65 72 76 65 72 0a 20 20 20 20 20 20 a server.
2500: 20 20 20 20 20 28 6e 6f 74 20 28 73 65 72 76 65 (not (serve
2510: 72 3a 70 69 6e 67 20 28 72 65 6d 6f 74 65 2d 73 r:ping (remote-s
2520: 65 72 76 65 72 2d 75 72 6c 20 72 75 6e 72 65 6d erver-url runrem
2530: 6f 74 65 29 29 29 29 20 20 3b 3b 20 73 65 72 76 ote)))) ;; serv
2540: 65 72 20 68 61 73 20 64 69 65 64 2e 20 4e 4f 54 er has died. NOT
2550: 45 3a 20 74 68 69 73 20 69 73 20 6e 6f 74 20 61 E: this is not a
2560: 20 63 68 65 61 70 20 63 61 6c 6c 21 20 4e 65 65 cheap call! Nee
2570: 64 20 62 65 74 74 65 72 20 61 70 70 72 6f 61 63 d better approac
2580: 68 2e 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a h.. (set! *
2590: 72 75 6e 72 65 6d 6f 74 65 2a 20 28 6d 61 6b 65 runremote* (make
25a0: 2d 72 65 6d 6f 74 65 29 29 0a 20 20 20 20 20 20 -remote)).
25b0: 28 72 65 6d 6f 74 65 2d 66 6f 72 63 65 2d 73 65 (remote-force-se
25c0: 72 76 65 72 2d 73 65 74 21 20 72 75 6e 72 65 6d rver-set! runrem
25d0: 6f 74 65 20 28 63 6f 6d 6d 6f 6e 3a 66 6f 72 63 ote (common:forc
25e0: 65 2d 73 65 72 76 65 72 3f 29 29 0a 20 20 20 20 e-server?)).
25f0: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
2600: 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 *rmt-mutex*).
2610: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
2620: 2d 69 6e 66 6f 20 31 32 20 2a 64 65 66 61 75 6c -info 12 *defaul
2630: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 t-log-port* "rmt
2640: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 :send-receive, c
2650: 61 73 65 20 20 36 22 29 0a 20 20 20 20 20 20 28 ase 6"). (
2660: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
2670: 20 63 6d 64 20 72 69 64 20 70 61 72 61 6d 73 20 cmd rid params
2680: 61 74 74 65 6d 70 74 6e 75 6d 3a 20 61 74 74 65 attemptnum: atte
2690: 6d 70 74 6e 75 6d 29 29 0a 0a 20 20 20 20 20 3b mptnum)).. ;
26a0: 3b 44 4f 54 20 43 41 53 45 37 20 5b 6c 61 62 65 ;DOT CASE7 [labe
26b0: 6c 3d 22 68 6f 6d 65 68 6f 73 74 5c 6e 77 72 69 l="homehost\nwri
26c0: 74 65 22 5d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 te"];. ;;DOT
26d0: 20 4d 55 54 45 58 4c 4f 43 4b 20 2d 3e 20 43 41 MUTEXLOCK -> CA
26e0: 53 45 37 20 5b 6c 61 62 65 6c 3d 22 73 65 72 76 SE7 [label="serv
26f0: 65 72 20 6e 6f 74 20 72 65 71 75 69 72 65 64 2c er not required,
2700: 5c 6e 6f 6e 20 68 6f 6d 65 68 6f 73 74 2c 5c 6e \non homehost,\n
2710: 61 20 77 72 69 74 65 2c 5c 6e 68 61 76 65 20 61 a write,\nhave a
2720: 20 73 65 72 76 65 72 22 5d 3b 20 7b 72 61 6e 6b server"]; {rank
2730: 3d 73 61 6d 65 20 22 63 61 73 65 20 37 22 20 43 =same "case 7" C
2740: 41 53 45 37 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f ASE7};. ;;DO
2750: 54 20 43 41 53 45 37 20 2d 3e 20 22 72 6d 74 3a T CASE7 -> "rmt:
2760: 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c open-qry-close-l
2770: 6f 63 61 6c 6c 79 22 3b 0a 20 20 20 20 20 3b 3b ocally";. ;;
2780: 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 20 61 6e 64 on homehost and
2790: 20 74 68 69 73 20 69 73 20 61 20 77 72 69 74 65 this is a write
27a0: 2c 20 77 65 20 61 6c 72 65 61 64 79 20 68 61 76 , we already hav
27b0: 65 20 61 20 73 65 72 76 65 72 0a 20 20 20 20 20 e a server.
27c0: 28 28 61 6e 64 20 28 6e 6f 74 20 28 72 65 6d 6f ((and (not (remo
27d0: 74 65 2d 66 6f 72 63 65 2d 73 65 72 76 65 72 20 te-force-server
27e0: 72 75 6e 72 65 6d 6f 74 65 29 29 20 20 20 20 20 runremote))
27f0: 3b 3b 20 68 6f 6e 6f 72 20 66 6f 72 63 65 64 20 ;; honor forced
2800: 75 73 65 20 6f 66 20 73 65 72 76 65 72 2c 20 69 use of server, i
2810: 2e 65 2e 20 73 65 72 76 65 72 20 4e 4f 54 20 72 .e. server NOT r
2820: 65 71 75 69 72 65 64 0a 09 20 20 20 28 63 64 72 equired.. (cdr
2830: 20 28 72 65 6d 6f 74 65 2d 68 68 2d 64 61 74 20 (remote-hh-dat
2840: 72 75 6e 72 65 6d 6f 74 65 29 29 20 20 20 20 20 runremote))
2850: 20 20 20 20 20 20 3b 3b 20 6f 6e 20 68 6f 6d 65 ;; on home
2860: 68 6f 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 host.
2870: 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 63 6d 64 (not (member cmd
2880: 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 api:read-only-q
2890: 75 65 72 69 65 73 29 29 20 20 3b 3b 20 74 68 69 ueries)) ;; thi
28a0: 73 20 69 73 20 61 20 77 72 69 74 65 0a 20 20 20 s is a write.
28b0: 20 20 20 20 20 20 20 20 28 72 65 6d 6f 74 65 2d (remote-
28c0: 73 65 72 76 65 72 2d 75 72 6c 20 72 75 6e 72 65 server-url runre
28d0: 6d 6f 74 65 29 29 20 20 20 20 20 20 20 20 20 20 mote))
28e0: 20 20 3b 3b 20 68 61 76 65 20 61 20 73 65 72 76 ;; have a serv
28f0: 65 72 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d er. (mutex-
2900: 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 unlock! *rmt-mut
2910: 65 78 2a 29 0a 20 20 20 20 20 20 28 64 65 62 75 ex*). (debu
2920: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 g:print-info 12
2930: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
2940: 74 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 t* "rmt:send-rec
2950: 65 69 76 65 2c 20 63 61 73 65 20 20 34 2e 31 22 eive, case 4.1"
2960: 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 6f 70 65 ). (rmt:ope
2970: 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 n-qry-close-loca
2980: 6c 6c 79 20 63 6d 64 20 30 20 70 61 72 61 6d 73 lly cmd 0 params
2990: 29 29 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 )).. ;;DOT C
29a0: 41 53 45 38 20 5b 6c 61 62 65 6c 3d 22 66 6f 72 ASE8 [label="for
29b0: 63 65 5c 6e 73 65 72 76 65 72 22 5d 3b 0a 20 20 ce\nserver"];.
29c0: 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f ;;DOT MUTEXLO
29d0: 43 4b 20 2d 3e 20 43 41 53 45 38 20 5b 6c 61 62 CK -> CASE8 [lab
29e0: 65 6c 3d 22 73 65 72 76 65 72 20 6e 6f 74 20 72 el="server not r
29f0: 65 71 75 69 72 65 64 2c 5c 6e 68 61 76 65 20 68 equired,\nhave h
2a00: 6f 6d 65 68 6f 73 74 20 69 6e 66 6f 2c 5c 6e 6e omehost info,\nn
2a10: 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 79 65 74 o connection yet
2a20: 2c 5c 6e 6e 6f 74 20 61 20 72 65 61 64 2d 6f 6e ,\nnot a read-on
2a30: 6c 79 20 71 75 65 72 79 22 5d 3b 20 7b 72 61 6e ly query"]; {ran
2a40: 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 38 22 20 k=same "case 8"
2a50: 43 41 53 45 38 7d 3b 0a 20 20 20 20 20 3b 3b 44 CASE8};. ;;D
2a60: 4f 54 20 43 41 53 45 38 20 2d 3e 20 22 72 6d 74 OT CASE8 -> "rmt
2a70: 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d :open-qry-close-
2a80: 6c 6f 63 61 6c 6c 79 22 3b 0a 20 20 20 20 20 3b locally";. ;
2a90: 3b 20 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 2c 20 ; on homehost,
2aa0: 6e 6f 20 73 65 72 76 65 72 20 63 6f 6e 74 61 63 no server contac
2ab0: 74 20 6d 61 64 65 20 61 6e 64 20 74 68 69 73 20 t made and this
2ac0: 69 73 20 61 20 77 72 69 74 65 2c 20 70 61 73 73 is a write, pass
2ad0: 69 76 65 6c 79 20 73 74 61 72 74 20 61 20 73 65 ively start a se
2ae0: 72 76 65 72 20 0a 20 20 20 20 20 28 28 61 6e 64 rver . ((and
2af0: 20 28 6e 6f 74 20 28 72 65 6d 6f 74 65 2d 66 6f (not (remote-fo
2b00: 72 63 65 2d 73 65 72 76 65 72 20 72 75 6e 72 65 rce-server runre
2b10: 6d 6f 74 65 29 29 20 20 20 20 20 3b 3b 20 68 6f mote)) ;; ho
2b20: 6e 6f 72 20 66 6f 72 63 65 64 20 75 73 65 20 6f nor forced use o
2b30: 66 20 73 65 72 76 65 72 2c 20 69 2e 65 2e 20 73 f server, i.e. s
2b40: 65 72 76 65 72 20 4e 4f 54 20 72 65 71 75 69 72 erver NOT requir
2b50: 65 64 0a 09 20 20 20 28 63 64 72 20 28 72 65 6d ed.. (cdr (rem
2b60: 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e 72 65 ote-hh-dat runre
2b70: 6d 6f 74 65 29 29 20 20 20 20 20 20 20 20 20 20 mote))
2b80: 20 3b 3b 20 68 61 76 65 20 68 6f 6d 65 68 6f 73 ;; have homehos
2b90: 74 0a 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f t. (no
2ba0: 74 20 28 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 t (remote-server
2bb0: 2d 75 72 6c 20 72 75 6e 72 65 6d 6f 74 65 29 29 -url runremote))
2bc0: 20 20 20 20 20 20 20 3b 3b 20 6e 6f 20 63 6f 6e ;; no con
2bd0: 6e 65 63 74 69 6f 6e 20 79 65 74 0a 09 20 20 20 nection yet..
2be0: 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 63 6d 64 (not (member cmd
2bf0: 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 api:read-only-q
2c00: 75 65 72 69 65 73 29 29 29 20 3b 3b 20 6e 6f 74 ueries))) ;; not
2c10: 20 61 20 72 65 61 64 2d 6f 6e 6c 79 20 71 75 65 a read-only que
2c20: 72 79 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a ry. (debug:
2c30: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 print-info 12 *d
2c40: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
2c50: 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 "rmt:send-recei
2c60: 76 65 2c 20 63 61 73 65 20 20 38 22 29 0a 20 20 ve, case 8").
2c70: 20 20 20 20 28 6c 65 74 20 28 28 73 65 72 76 65 (let ((serve
2c80: 72 2d 75 72 6c 20 20 28 73 65 72 76 65 72 3a 63 r-url (server:c
2c90: 68 65 63 6b 2d 69 66 2d 72 75 6e 6e 69 6e 67 20 heck-if-running
2ca0: 2a 74 6f 70 70 61 74 68 2a 29 29 29 20 3b 3b 20 *toppath*))) ;;
2cb0: 28 73 65 72 76 65 72 3a 72 65 61 64 2d 64 6f 74 (server:read-dot
2cc0: 73 65 72 76 65 72 2d 3e 75 72 6c 20 2a 74 6f 70 server->url *top
2cd0: 70 61 74 68 2a 29 29 29 20 3b 3b 20 28 73 65 72 path*))) ;; (ser
2ce0: 76 65 72 3a 63 68 65 63 6b 2d 69 66 2d 72 75 6e ver:check-if-run
2cf0: 6e 69 6e 67 20 2a 74 6f 70 70 61 74 68 2a 29 29 ning *toppath*))
2d00: 29 20 3b 3b 20 44 6f 20 4e 4f 54 20 77 61 6e 74 ) ;; Do NOT want
2d10: 20 74 6f 20 72 75 6e 20 73 65 72 76 65 72 3a 63 to run server:c
2d20: 68 65 63 6b 2d 69 66 2d 72 75 6e 6e 69 6e 67 20 heck-if-running
2d30: 2d 20 76 65 72 79 20 65 78 70 65 6e 73 69 76 65 - very expensive
2d40: 20 74 6f 20 64 6f 20 66 6f 72 20 65 76 65 72 79 to do for every
2d50: 20 77 72 69 74 65 20 63 61 6c 6c 0a 09 28 69 66 write call..(if
2d60: 20 73 65 72 76 65 72 2d 75 72 6c 0a 09 20 20 20 server-url..
2d70: 20 28 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d (remote-server-
2d80: 75 72 6c 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f url-set! runremo
2d90: 74 65 20 73 65 72 76 65 72 2d 75 72 6c 29 20 3b te server-url) ;
2da0: 3b 20 74 68 65 20 73 74 72 69 6e 67 20 63 61 6e ; the string can
2db0: 20 62 65 20 63 6f 6e 73 75 6d 65 64 20 62 79 20 be consumed by
2dc0: 74 68 65 20 63 6c 69 65 6e 74 20 73 65 74 75 70 the client setup
2dd0: 20 69 66 20 6e 65 65 64 65 64 0a 09 20 20 20 20 if needed..
2de0: 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 6f 72 63 (if (common:forc
2df0: 65 2d 73 65 72 76 65 72 3f 29 0a 09 09 28 73 65 e-server?)...(se
2e00: 72 76 65 72 3a 73 74 61 72 74 2d 61 6e 64 2d 77 rver:start-and-w
2e10: 61 69 74 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 ait *toppath*)..
2e20: 09 28 73 65 72 76 65 72 3a 6b 69 6e 64 2d 72 75 .(server:kind-ru
2e30: 6e 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 29 0a n *toppath*)))).
2e40: 20 20 20 20 20 20 28 72 65 6d 6f 74 65 2d 66 6f (remote-fo
2e50: 72 63 65 2d 73 65 72 76 65 72 2d 73 65 74 21 20 rce-server-set!
2e60: 72 75 6e 72 65 6d 6f 74 65 20 28 63 6f 6d 6d 6f runremote (commo
2e70: 6e 3a 66 6f 72 63 65 2d 73 65 72 76 65 72 3f 29 n:force-server?)
2e80: 29 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 ). (mutex-u
2e90: 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 nlock! *rmt-mute
2ea0: 78 2a 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 x*). (debug
2eb0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a :print-info 12 *
2ec0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
2ed0: 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 * "rmt:send-rece
2ee0: 69 76 65 2c 20 63 61 73 65 20 20 38 2e 31 22 29 ive, case 8.1")
2ef0: 0a 20 20 20 20 20 20 28 72 6d 74 3a 6f 70 65 6e . (rmt:open
2f00: 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c -qry-close-local
2f10: 6c 79 20 63 6d 64 20 30 20 70 61 72 61 6d 73 29 ly cmd 0 params)
2f20: 29 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 ).. ;;DOT CA
2f30: 53 45 39 20 5b 6c 61 62 65 6c 3d 22 66 6f 72 63 SE9 [label="forc
2f40: 65 20 73 65 72 76 65 72 5c 6e 6e 6f 74 20 6f 6e e server\nnot on
2f50: 20 68 6f 6d 65 68 6f 73 74 22 5d 3b 0a 20 20 20 homehost"];.
2f60: 20 20 3b 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 ;;DOT MUTEXLOC
2f70: 4b 20 2d 3e 20 43 41 53 45 39 20 5b 6c 61 62 65 K -> CASE9 [labe
2f80: 6c 3d 22 6e 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e l="no connection
2f90: 5c 6e 61 6e 64 20 65 69 74 68 65 72 20 72 65 71 \nand either req
2fa0: 75 69 72 65 20 73 65 72 76 65 72 5c 6e 6f 72 20 uire server\nor
2fb0: 6e 6f 74 20 6f 6e 20 68 6f 6d 65 68 6f 73 74 22 not on homehost"
2fc0: 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 20 22 63 ]; {rank=same "c
2fd0: 61 73 65 20 39 22 20 43 41 53 45 39 7d 3b 0a 20 ase 9" CASE9};.
2fe0: 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 39 20 ;;DOT CASE9
2ff0: 2d 3e 20 22 73 74 61 72 74 5c 6e 73 65 72 76 65 -> "start\nserve
3000: 72 22 20 2d 3e 20 22 72 6d 74 3a 73 65 6e 64 2d r" -> "rmt:send-
3010: 72 65 63 65 69 76 65 22 3b 0a 20 20 20 20 20 28 receive";. (
3020: 28 6f 72 20 28 61 6e 64 20 28 72 65 6d 6f 74 65 (or (and (remote
3030: 2d 66 6f 72 63 65 2d 73 65 72 76 65 72 20 72 75 -force-server ru
3040: 6e 72 65 6d 6f 74 65 29 20 20 20 20 20 20 20 20 nremote)
3050: 20 20 20 20 20 20 3b 3b 20 77 65 20 61 72 65 20 ;; we are
3060: 66 6f 72 63 69 6e 67 20 61 20 73 65 72 76 65 72 forcing a server
3070: 20 61 6e 64 20 64 6f 6e 27 74 20 79 65 74 20 68 and don't yet h
3080: 61 76 65 20 61 20 63 6f 6e 6e 65 63 74 69 6f 6e ave a connection
3090: 20 74 6f 20 6f 6e 65 0a 09 20 20 20 20 20 20 20 to one..
30a0: 28 6e 6f 74 20 28 72 65 6d 6f 74 65 2d 63 6f 6e (not (remote-con
30b0: 6e 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 ndat runremote))
30c0: 29 0a 09 20 20 28 61 6e 64 20 28 6e 6f 74 20 28 ).. (and (not (
30d0: 63 64 72 20 28 72 65 6d 6f 74 65 2d 68 68 2d 64 cdr (remote-hh-d
30e0: 61 74 20 72 75 6e 72 65 6d 6f 74 65 29 29 29 20 at runremote)))
30f0: 20 20 20 20 20 20 20 3b 3b 20 6e 6f 74 20 6f 6e ;; not on
3100: 20 61 20 68 6f 6d 65 68 6f 73 74 20 0a 09 20 20 a homehost ..
3110: 20 20 20 20 20 28 6e 6f 74 20 28 72 65 6d 6f 74 (not (remot
3120: 65 2d 63 6f 6e 6e 64 61 74 20 72 75 6e 72 65 6d e-conndat runrem
3130: 6f 74 65 29 29 29 29 20 20 20 20 20 20 20 20 20 ote))))
3140: 20 20 3b 3b 20 61 6e 64 20 6e 6f 20 63 6f 6e 6e ;; and no conn
3150: 65 63 74 69 6f 6e 0a 20 20 20 20 20 20 28 64 65 ection. (de
3160: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
3170: 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
3180: 6f 72 74 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 ort* "rmt:send-r
3190: 65 63 65 69 76 65 2c 20 63 61 73 65 20 39 2c 20 eceive, case 9,
31a0: 68 68 2d 64 61 74 3a 20 22 20 28 72 65 6d 6f 74 hh-dat: " (remot
31b0: 65 2d 68 68 2d 64 61 74 20 72 75 6e 72 65 6d 6f e-hh-dat runremo
31c0: 74 65 29 20 22 20 63 6f 6e 6e 64 61 74 3a 20 22 te) " conndat: "
31d0: 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 (remote-conndat
31e0: 20 72 75 6e 72 65 6d 6f 74 65 29 29 0a 20 20 20 runremote)).
31f0: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
3200: 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 ! *rmt-mutex*).
3210: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 (if (not (s
3220: 65 72 76 65 72 3a 63 68 65 63 6b 2d 69 66 2d 72 erver:check-if-r
3230: 75 6e 6e 69 6e 67 20 2a 74 6f 70 70 61 74 68 2a unning *toppath*
3240: 29 29 20 3b 3b 20 77 68 6f 20 6b 6e 6f 77 73 2c )) ;; who knows,
3250: 20 6d 61 79 62 65 20 6f 6e 65 20 68 61 73 20 73 maybe one has s
3260: 74 61 72 74 65 64 20 75 70 3f 0a 09 20 20 28 73 tarted up?.. (s
3270: 65 72 76 65 72 3a 73 74 61 72 74 2d 61 6e 64 2d erver:start-and-
3280: 77 61 69 74 20 2a 74 6f 70 70 61 74 68 2a 29 29 wait *toppath*))
3290: 0a 20 20 20 20 20 20 28 72 65 6d 6f 74 65 2d 63 . (remote-c
32a0: 6f 6e 6e 64 61 74 2d 73 65 74 21 20 72 75 6e 72 onndat-set! runr
32b0: 65 6d 6f 74 65 20 28 72 6d 74 3a 67 65 74 2d 63 emote (rmt:get-c
32c0: 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 2a onnection-info *
32d0: 74 6f 70 70 61 74 68 2a 29 29 20 3b 3b 20 63 61 toppath*)) ;; ca
32e0: 6c 6c 73 20 63 6c 69 65 6e 74 3a 73 65 74 75 70 lls client:setup
32f0: 20 77 68 69 63 68 20 63 61 6c 6c 73 20 63 6c 69 which calls cli
3300: 65 6e 74 3a 73 65 74 75 70 2d 68 74 74 70 0a 20 ent:setup-http.
3310: 20 20 20 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 (rmt:send-r
3320: 65 63 65 69 76 65 20 63 6d 64 20 72 69 64 20 70 eceive cmd rid p
3330: 61 72 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d arams attemptnum
3340: 3a 20 61 74 74 65 6d 70 74 6e 75 6d 29 29 20 3b : attemptnum)) ;
3350: 3b 20 54 4f 44 4f 3a 20 61 64 64 20 62 61 63 6b ; TODO: add back
3360: 2d 6f 66 66 20 74 69 6d 65 6f 75 74 20 61 73 0a -off timeout as.
3370: 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 41 53 45 . ;;DOT CASE
3380: 31 30 20 5b 6c 61 62 65 6c 3d 22 6f 6e 20 68 6f 10 [label="on ho
3390: 6d 65 68 6f 73 74 22 5d 3b 0a 20 20 20 20 20 3b mehost"];. ;
33a0: 3b 44 4f 54 20 4d 55 54 45 58 4c 4f 43 4b 20 2d ;DOT MUTEXLOCK -
33b0: 3e 20 43 41 53 45 31 30 20 5b 6c 61 62 65 6c 3d > CASE10 [label=
33c0: 22 73 65 72 76 65 72 20 6e 6f 74 20 72 65 71 75 "server not requ
33d0: 69 72 65 64 2c 5c 6e 6f 6e 20 68 6f 6d 65 68 6f ired,\non homeho
33e0: 73 74 22 5d 3b 20 7b 72 61 6e 6b 3d 73 61 6d 65 st"]; {rank=same
33f0: 20 22 63 61 73 65 20 31 30 22 20 43 41 53 45 31 "case 10" CASE1
3400: 30 7d 3b 0a 20 20 20 20 20 3b 3b 44 4f 54 20 43 0};. ;;DOT C
3410: 41 53 45 31 30 20 2d 3e 20 22 72 6d 74 3a 6f 70 ASE10 -> "rmt:op
3420: 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 en-qry-close-loc
3430: 61 6c 6c 79 22 3b 0a 20 20 20 20 20 3b 3b 20 61 ally";. ;; a
3440: 6c 6c 20 73 65 74 20 75 70 20 69 66 20 67 65 74 ll set up if get
3450: 20 74 68 69 73 20 66 61 72 2c 20 64 69 73 70 61 this far, dispa
3460: 74 63 68 20 74 68 65 20 71 75 65 72 79 0a 20 20 tch the query.
3470: 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 28 72 ((and (not (r
3480: 65 6d 6f 74 65 2d 66 6f 72 63 65 2d 73 65 72 76 emote-force-serv
3490: 65 72 20 72 75 6e 72 65 6d 6f 74 65 29 29 0a 09 er runremote))..
34a0: 20 20 20 28 63 64 72 20 28 72 65 6d 6f 74 65 2d (cdr (remote-
34b0: 68 68 2d 64 61 74 20 72 75 6e 72 65 6d 6f 74 65 hh-dat runremote
34c0: 29 29 29 20 3b 3b 20 77 65 20 61 72 65 20 6f 6e ))) ;; we are on
34d0: 20 68 6f 6d 65 68 6f 73 74 0a 20 20 20 20 20 20 homehost.
34e0: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a (mutex-unlock! *
34f0: 72 6d 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 rmt-mutex*).
3500: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
3510: 6e 66 6f 20 31 32 20 2a 64 65 66 61 75 6c 74 2d nfo 12 *default-
3520: 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 log-port* "rmt:s
3530: 65 6e 64 2d 72 65 63 65 69 76 65 2c 20 63 61 73 end-receive, cas
3540: 65 20 31 30 22 29 0a 20 20 20 20 20 20 28 72 6d e 10"). (rm
3550: 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c 6f 73 65 t:open-qry-close
3560: 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 28 69 66 -locally cmd (if
3570: 20 72 69 64 20 72 69 64 20 30 29 20 70 61 72 61 rid rid 0) para
3580: 6d 73 29 29 0a 0a 20 20 20 20 20 3b 3b 44 4f 54 ms)).. ;;DOT
3590: 20 43 41 53 45 31 31 20 5b 6c 61 62 65 6c 3d 22 CASE11 [label="
35a0: 73 65 6e 64 5f 72 65 63 65 69 76 65 22 5d 3b 0a send_receive"];.
35b0: 20 20 20 20 20 3b 3b 44 4f 54 20 4d 55 54 45 58 ;;DOT MUTEX
35c0: 4c 4f 43 4b 20 2d 3e 20 43 41 53 45 31 31 20 5b LOCK -> CASE11 [
35d0: 6c 61 62 65 6c 3d 22 65 6c 73 65 22 5d 3b 20 7b label="else"]; {
35e0: 72 61 6e 6b 3d 73 61 6d 65 20 22 63 61 73 65 20 rank=same "case
35f0: 31 31 22 20 43 41 53 45 31 31 7d 3b 0a 20 20 20 11" CASE11};.
3600: 20 20 3b 3b 44 4f 54 20 43 41 53 45 31 31 20 2d ;;DOT CASE11 -
3610: 3e 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 > "rmt:send-rece
3620: 69 76 65 22 20 5b 6c 61 62 65 6c 3d 22 63 61 6c ive" [label="cal
3630: 6c 20 66 61 69 6c 65 64 22 5d 3b 0a 20 20 20 20 l failed"];.
3640: 20 3b 3b 44 4f 54 20 43 41 53 45 31 31 20 2d 3e ;;DOT CASE11 ->
3650: 20 22 52 45 53 55 4c 54 22 20 5b 6c 61 62 65 6c "RESULT" [label
3660: 3d 22 63 61 6c 6c 20 73 75 63 63 65 65 64 65 64 ="call succeeded
3670: 22 5d 3b 0a 20 20 20 20 20 3b 3b 20 6e 6f 74 20 "];. ;; not
3680: 6f 6e 20 68 6f 6d 65 68 6f 73 74 2c 20 64 6f 20 on homehost, do
3690: 73 65 72 76 65 72 20 71 75 65 72 79 0a 20 20 20 server query.
36a0: 20 20 28 65 6c 73 65 20 28 65 78 74 72 61 73 2d (else (extras-
36b0: 63 61 73 65 2d 31 31 20 2a 64 65 66 61 75 6c 74 case-11 *default
36c0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 72 75 6e 72 65 -log-port* runre
36d0: 6d 6f 74 65 20 63 6d 64 20 70 61 72 61 6d 73 20 mote cmd params
36e0: 61 74 74 65 6d 70 74 6e 75 6d 20 72 69 64 29 29 attemptnum rid))
36f0: 29 29 29 0a 20 20 20 20 3b 3b 44 4f 54 20 7d 0a ))). ;;DOT }.
3700: 0a 3b 3b 20 62 75 6e 63 68 20 6f 66 20 73 6d 61 .;; bunch of sma
3710: 6c 6c 20 66 75 6e 63 74 69 6f 6e 73 20 66 61 63 ll functions fac
3720: 74 6f 72 65 64 20 6f 75 74 20 6f 66 20 73 65 6e tored out of sen
3730: 64 2d 72 65 63 65 69 76 65 20 74 6f 20 6d 61 6b d-receive to mak
3740: 65 20 64 65 62 75 67 20 65 61 73 69 65 72 0a 3b e debug easier.;
3750: 3b 0a 0a 28 64 65 66 69 6e 65 20 28 65 78 74 72 ;..(define (extr
3760: 61 73 2d 63 61 73 65 2d 31 31 20 2a 64 65 66 61 as-case-11 *defa
3770: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 72 75 ult-log-port* ru
3780: 6e 72 65 6d 6f 74 65 20 63 6d 64 20 70 61 72 61 nremote cmd para
3790: 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d 20 72 69 ms attemptnum ri
37a0: 64 29 0a 20 20 3b 3b 20 28 6d 75 74 65 78 2d 75 d). ;; (mutex-u
37b0: 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 nlock! *rmt-mute
37c0: 78 2a 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 x*). (debug:pri
37d0: 6e 74 2d 69 6e 66 6f 20 31 32 20 2a 64 65 66 61 nt-info 12 *defa
37e0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 ult-log-port* "r
37f0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 2c mt:send-receive,
3800: 20 63 61 73 65 20 20 39 22 29 0a 20 20 3b 3b 20 case 9"). ;;
3810: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 72 6d (mutex-lock! *rm
3820: 74 2d 6d 75 74 65 78 2a 29 0a 20 20 28 6c 65 74 t-mutex*). (let
3830: 2a 20 28 28 63 6f 6e 6e 69 6e 66 6f 20 28 72 65 * ((conninfo (re
3840: 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 20 72 75 6e mote-conndat run
3850: 72 65 6d 6f 74 65 29 29 0a 09 20 28 64 61 74 2d remote)).. (dat-
3860: 69 6e 20 20 20 20 20 20 28 63 61 73 65 20 28 72 in (case (r
3870: 65 6d 6f 74 65 2d 74 72 61 6e 73 70 6f 72 74 20 emote-transport
3880: 72 75 6e 72 65 6d 6f 74 65 29 0a 09 09 20 20 20 runremote)...
3890: 20 20 28 28 68 74 74 70 29 20 28 63 6f 6e 64 69 ((http) (condi
38a0: 74 69 6f 6e 2d 63 61 73 65 20 3b 3b 20 68 61 6e tion-case ;; han
38b0: 64 6c 69 6e 67 20 68 65 72 65 20 68 61 73 0a 09 dling here has..
38c0: 09 09 09 09 20 20 20 20 20 3b 3b 20 63 61 75 73 .... ;; caus
38d0: 65 64 20 61 20 6c 6f 74 20 6f 66 0a 09 09 09 09 ed a lot of.....
38e0: 09 20 20 20 20 20 3b 3b 20 70 72 6f 62 6c 65 6d . ;; problem
38f0: 73 2e 20 48 6f 77 65 76 65 72 20 69 74 0a 09 09 s. However it...
3900: 09 09 09 20 20 20 20 20 3b 3b 20 69 73 20 6e 65 ... ;; is ne
3910: 65 64 65 64 20 74 6f 20 64 65 61 6c 20 77 69 74 eded to deal wit
3920: 68 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 61 h...... ;; a
3930: 74 74 65 6d 74 70 65 64 0a 09 09 09 09 09 20 20 ttemtped......
3940: 20 20 20 3b 3b 20 63 6f 6d 6d 75 6e 69 63 61 74 ;; communicat
3950: 69 6f 6e 20 74 6f 0a 09 09 09 09 09 20 20 20 20 ion to......
3960: 20 3b 3b 20 73 65 72 76 65 72 73 20 74 68 61 74 ;; servers that
3970: 20 68 61 76 65 20 67 6f 6e 65 0a 09 09 09 09 09 have gone......
3980: 20 20 20 20 20 3b 3b 20 61 77 61 79 0a 09 09 09 ;; away....
3990: 20 20 20 20 20 20 28 68 74 74 70 2d 74 72 61 6e (http-tran
39a0: 73 70 6f 72 74 3a 63 6c 69 65 6e 74 2d 61 70 69 sport:client-api
39b0: 2d 73 65 6e 64 2d 72 65 63 65 69 76 65 20 30 20 -send-receive 0
39c0: 63 6f 6e 6e 69 6e 66 6f 20 63 6d 64 20 70 61 72 conninfo cmd par
39d0: 61 6d 73 29 0a 09 09 09 20 20 20 20 20 20 28 28 ams).... ((
39e0: 63 6f 6d 6d 66 61 69 6c 29 28 76 65 63 74 6f 72 commfail)(vector
39f0: 20 23 66 20 22 63 6f 6d 6d 75 6e 69 63 61 74 69 #f "communicati
3a00: 6f 6e 73 20 66 61 69 6c 22 29 29 0a 09 09 09 20 ons fail"))....
3a10: 20 20 20 20 20 28 28 65 78 6e 29 28 76 65 63 74 ((exn)(vect
3a20: 6f 72 20 23 66 20 22 6f 74 68 65 72 20 66 61 69 or #f "other fai
3a30: 6c 22 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 l" (print-call-c
3a40: 68 61 69 6e 29 29 29 29 29 0a 09 09 20 20 20 20 hain)))))...
3a50: 20 28 65 6c 73 65 0a 09 09 20 20 20 20 20 20 28 (else... (
3a60: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
3a70: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
3a80: 20 22 45 52 52 4f 52 3a 20 74 72 61 6e 73 70 6f "ERROR: transpo
3a90: 72 74 20 22 20 28 72 65 6d 6f 74 65 2d 74 72 61 rt " (remote-tra
3aa0: 6e 73 70 6f 72 74 20 72 75 6e 72 65 6d 6f 74 65 nsport runremote
3ab0: 29 20 22 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 ) " not supporte
3ac0: 64 22 29 0a 09 09 20 20 20 20 20 20 28 65 78 69 d")... (exi
3ad0: 74 29 29 29 29 0a 0a 3b 3b 20 4e 6f 20 54 69 74 t))))..;; No Tit
3ae0: 6c 65 20 0a 3b 3b 20 45 72 72 6f 72 3a 20 28 76 le .;; Error: (v
3af0: 65 63 74 6f 72 2d 72 65 66 29 20 6f 75 74 20 6f ector-ref) out o
3b00: 66 20 72 61 6e 67 65 0a 3b 3b 20 23 28 23 3c 63 f range.;; #(#<c
3b10: 6f 6e 64 69 74 69 6f 6e 3a 20 28 65 78 6e 20 74 ondition: (exn t
3b20: 79 70 65 29 3e 20 28 23 28 22 64 62 2e 73 63 6d ype)> (#("db.scm
3b30: 3a 33 37 34 30 3a 20 72 65 67 65 78 23 72 65 67 :3740: regex#reg
3b40: 65 78 70 22 20 23 66 20 23 66 29 20 23 28 22 64 exp" #f #f) #("d
3b50: 62 2e 73 63 6d 3a 33 37 33 39 3a 20 72 65 67 65 b.scm:3739: rege
3b60: 78 23 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 x#string-substit
3b70: 75 74 65 22 20 23 66 20 23 66 29 20 23 28 22 64 ute" #f #f) #("d
3b80: 62 2e 73 63 6d 3a 33 37 33 38 3a 20 62 61 73 65 b.scm:3738: base
3b90: 36 34 23 62 61 73 65 36 34 2d 64 65 63 6f 64 65 64#base64-decode
3ba0: 22 20 23 66 20 23 66 29 20 23 28 22 64 62 2e 73 " #f #f) #("db.s
3bb0: 63 6d 3a 33 37 33 37 3a 20 7a 33 23 7a 33 3a 64 cm:3737: z3#z3:d
3bc0: 65 63 6f 64 65 2d 62 75 66 66 65 72 22 20 23 66 ecode-buffer" #f
3bd0: 20 23 66 29 20 23 28 22 64 62 2e 73 63 6d 3a 33 #f) #("db.scm:3
3be0: 37 33 36 3a 20 77 69 74 68 2d 69 6e 70 75 74 2d 736: with-input-
3bf0: 66 72 6f 6d 2d 73 74 72 69 6e 67 22 20 23 66 20 from-string" #f
3c00: 23 66 29 20 23 28 22 64 62 2e 73 63 6d 3a 33 37 #f) #("db.scm:37
3c10: 34 31 3a 20 73 31 31 6e 23 64 65 73 65 72 69 61 41: s11n#deseria
3c20: 6c 69 7a 65 22 20 23 66 20 23 66 29 20 23 28 22 lize" #f #f) #("
3c30: 61 70 69 2e 73 63 6d 3a 33 37 34 3a 20 61 70 69 api.scm:374: api
3c40: 3a 65 78 65 63 75 74 65 2d 72 65 71 75 65 73 74 :execute-request
3c50: 73 22 20 23 66 20 23 66 29 20 23 28 22 61 70 69 s" #f #f) #("api
3c60: 2e 73 63 6d 3a 31 33 39 3a 20 63 61 6c 6c 2d 77 .scm:139: call-w
3c70: 69 74 68 2d 63 75 72 72 65 6e 74 2d 63 6f 6e 74 ith-current-cont
3c80: 69 6e 75 61 74 69 6f 6e 22 20 23 66 20 23 66 29 inuation" #f #f)
3c90: 20 23 28 22 61 70 69 2e 73 63 6d 3a 31 33 39 3a #("api.scm:139:
3ca0: 20 77 69 74 68 2d 65 78 63 65 70 74 69 6f 6e 2d with-exception-
3cb0: 68 61 6e 64 6c 65 72 22 20 23 66 20 23 66 29 20 handler" #f #f)
3cc0: 23 28 22 61 70 69 2e 73 63 6d 3a 31 33 39 3a 20 #("api.scm:139:
3cd0: 23 23 73 79 73 23 63 61 6c 6c 2d 77 69 74 68 2d ##sys#call-with-
3ce0: 76 61 6c 75 65 73 22 20 23 66 20 23 66 29 20 23 values" #f #f) #
3cf0: 28 22 61 70 69 2e 73 63 6d 3a 31 35 38 3a 20 73 ("api.scm:158: s
3d00: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 22 20 23 tring->symbol" #
3d10: 66 20 23 66 29 20 23 28 22 61 70 69 2e 73 63 6d f #f) #("api.scm
3d20: 3a 31 36 30 3a 20 63 75 72 72 65 6e 74 2d 6d 69 :160: current-mi
3d30: 6c 6c 69 73 65 63 6f 6e 64 73 22 20 23 66 20 23 lliseconds" #f #
3d40: 66 29 20 23 28 22 61 70 69 2e 73 63 6d 3a 31 36 f) #("api.scm:16
3d50: 31 3a 20 64 62 72 3a 64 62 73 74 72 75 63 74 2d 1: dbr:dbstruct-
3d60: 72 65 61 64 2d 6f 6e 6c 79 22 20 23 66 20 23 66 read-only" #f #f
3d70: 29 20 23 28 22 61 70 69 2e 73 63 6d 3a 31 33 39 ) #("api.scm:139
3d80: 3a 20 6b 31 35 22 20 23 66 20 23 66 29 20 23 28 : k15" #f #f) #(
3d90: 22 61 70 69 2e 73 63 6d 3a 31 33 39 3a 20 67 31 "api.scm:139: g1
3da0: 39 22 20 23 66 20 23 66 29 20 23 28 22 61 70 69 9" #f #f) #("api
3db0: 2e 73 63 6d 3a 31 34 32 3a 20 67 65 74 2d 63 61 .scm:142: get-ca
3dc0: 6c 6c 2d 63 68 61 69 6e 22 20 23 66 20 23 66 29 ll-chain" #f #f)
3dd0: 29 20 23 28 22 67 65 74 2d 74 65 73 74 2d 69 6e ) #("get-test-in
3de0: 66 6f 2d 62 79 2d 69 64 22 20 28 31 31 30 32 20 fo-by-id" (1102
3df0: 35 30 37 32 39 39 29 29 29 0a 3b 3b 20 36 0a 3b 507299))).;; 6.;
3e00: 3b 20 0a 3b 3b 20 09 43 61 6c 6c 20 68 69 73 74 ; .;; .Call hist
3e10: 6f 72 79 3a 0a 3b 3b 20 0a 3b 3b 20 09 68 74 74 ory:.;; .;; .htt
3e20: 70 2d 74 72 61 6e 73 70 6f 72 74 2e 73 63 6d 3a p-transport.scm:
3e30: 33 30 36 3a 20 74 68 72 65 61 64 2d 74 65 72 6d 306: thread-term
3e40: 69 6e 61 74 65 21 09 20 20 0a 3b 3b 20 09 68 74 inate!. .;; .ht
3e50: 74 70 2d 74 72 61 6e 73 70 6f 72 74 2e 73 63 6d tp-transport.scm
3e60: 3a 33 30 37 3a 20 64 65 62 75 67 3a 70 72 69 6e :307: debug:prin
3e70: 74 2d 69 6e 66 6f 09 20 20 0a 3b 3b 20 09 63 6f t-info. .;; .co
3e80: 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d mmon_records.scm
3e90: 3a 32 33 35 3a 20 64 65 62 75 67 3a 64 65 62 75 :235: debug:debu
3ea0: 67 2d 6d 6f 64 65 09 20 20 0a 3b 3b 20 09 72 6d g-mode. .;; .rm
3eb0: 74 2e 73 63 6d 3a 32 35 39 3a 20 6b 35 38 37 09 t.scm:259: k587.
3ec0: 20 20 0a 3b 3b 20 09 72 6d 74 2e 73 63 6d 3a 32 .;; .rmt.scm:2
3ed0: 35 39 3a 20 67 35 39 31 09 20 20 0a 3b 3b 20 09 59: g591. .;; .
3ee0: 72 6d 74 2e 73 63 6d 3a 32 37 36 3a 20 68 74 74 rmt.scm:276: htt
3ef0: 70 2d 74 72 61 6e 73 70 6f 72 74 3a 73 65 72 76 p-transport:serv
3f00: 65 72 2d 64 61 74 2d 75 70 64 61 74 65 2d 6c 61 er-dat-update-la
3f10: 73 74 2d 61 63 63 65 73 73 09 20 20 0a 3b 3b 20 st-access. .;;
3f20: 09 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 2e .http-transport.
3f30: 73 63 6d 3a 33 36 34 3a 20 63 75 72 72 65 6e 74 scm:364: current
3f40: 2d 73 65 63 6f 6e 64 73 09 20 20 0a 3b 3b 20 09 -seconds. .;; .
3f50: 72 6d 74 2e 73 63 6d 3a 32 38 32 3a 20 64 65 62 rmt.scm:282: deb
3f60: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 09 20 20 ug:print-info.
3f70: 0a 3b 3b 20 09 63 6f 6d 6d 6f 6e 5f 72 65 63 6f .;; .common_reco
3f80: 72 64 73 2e 73 63 6d 3a 32 33 35 3a 20 64 65 62 rds.scm:235: deb
3f90: 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 09 20 20 ug:debug-mode.
3fa0: 0a 3b 3b 20 09 72 6d 74 2e 73 63 6d 3a 32 38 33 .;; .rmt.scm:283
3fb0: 3a 20 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 09 : mutex-unlock!.
3fc0: 20 20 0a 3b 3b 20 09 72 6d 74 2e 73 63 6d 3a 32 .;; .rmt.scm:2
3fd0: 38 37 3a 20 65 78 74 72 61 73 2d 74 72 61 6e 73 87: extras-trans
3fe0: 70 6f 72 74 2d 73 75 63 63 65 64 65 64 09 20 20 port-succeded.
3ff0: 09 3c 2d 2d 0a 3b 3b 20 2b 2d 2d 2d 2d 2d 2d 2d .<--.;; +-------
4000: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
4010: 2d 2d 2d 2d 2d 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 2b 0a 3b 3b 20 7c 20 45 78 69 ------+.;; | Exi
4050: 74 20 53 74 61 74 75 73 20 20 20 20 3a 20 37 30 t Status : 70
4060: 20 20 0a 3b 3b 20 20 0a 0a 09 20 28 64 61 74 20 .;; ... (dat
4070: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 76 (if (and (v
4080: 65 63 74 6f 72 3f 20 64 61 74 2d 69 6e 29 20 3b ector? dat-in) ;
4090: 3b 20 2e 2e 2e 20 63 68 65 63 6b 20 69 74 20 69 ; ... check it i
40a0: 73 20 61 20 63 6f 72 72 65 63 74 20 73 69 7a 65 s a correct size
40b0: 0a 09 09 09 20 20 20 20 28 3e 20 28 76 65 63 74 .... (> (vect
40c0: 6f 72 2d 6c 65 6e 67 74 68 20 64 61 74 2d 69 6e or-length dat-in
40d0: 29 20 31 29 29 0a 09 09 20 20 20 20 20 20 20 64 ) 1))... d
40e0: 61 74 2d 69 6e 0a 09 09 20 20 20 20 20 20 20 28 at-in... (
40f0: 76 65 63 74 6f 72 20 23 66 20 28 63 6f 6e 63 20 vector #f (conc
4100: 22 63 6f 6d 6d 75 6e 69 63 61 74 69 6f 6e 73 20 "communications
4110: 66 61 69 6c 20 28 74 79 70 65 20 32 29 2c 20 64 fail (type 2), d
4120: 61 74 2d 69 6e 3d 22 20 64 61 74 2d 69 6e 29 29 at-in=" dat-in))
4130: 29 29 0a 09 20 28 73 75 63 63 65 73 73 20 20 28 )).. (success (
4140: 69 66 20 28 76 65 63 74 6f 72 3f 20 64 61 74 29 if (vector? dat)
4150: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 (vector-ref dat
4160: 20 30 29 20 23 66 29 29 0a 09 20 28 72 65 73 20 0) #f)).. (res
4170: 20 20 20 20 20 28 69 66 20 28 76 65 63 74 6f 72 (if (vector
4180: 3f 20 64 61 74 29 20 28 76 65 63 74 6f 72 2d 72 ? dat) (vector-r
4190: 65 66 20 64 61 74 20 31 29 20 23 66 29 29 29 0a ef dat 1) #f))).
41a0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 76 65 (if (and (ve
41b0: 63 74 6f 72 3f 20 63 6f 6e 6e 69 6e 66 6f 29 20 ctor? conninfo)
41c0: 28 3c 20 35 20 28 76 65 63 74 6f 72 2d 6c 65 6e (< 5 (vector-len
41d0: 67 74 68 20 63 6f 6e 6e 69 6e 66 6f 29 29 29 0a gth conninfo))).
41e0: 09 28 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 .(http-transport
41f0: 3a 73 65 72 76 65 72 2d 64 61 74 2d 75 70 64 61 :server-dat-upda
4200: 74 65 2d 6c 61 73 74 2d 61 63 63 65 73 73 20 63 te-last-access c
4210: 6f 6e 6e 69 6e 66 6f 29 20 3b 3b 20 72 65 66 72 onninfo) ;; refr
4220: 65 73 68 20 61 63 63 65 73 73 20 74 69 6d 65 0a esh access time.
4230: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
4240: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
4250: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e lt-log-port* "IN
4260: 46 4f 3a 20 53 68 6f 75 6c 64 20 6e 6f 74 20 67 FO: Should not g
4270: 65 74 20 68 65 72 65 21 20 63 6f 6e 6e 69 6e 66 et here! conninf
4280: 6f 3d 22 20 63 6f 6e 6e 69 6e 66 6f 29 0a 09 20 o=" conninfo)..
4290: 20 28 73 65 74 21 20 63 6f 6e 6e 69 6e 66 6f 20 (set! conninfo
42a0: 23 66 29 0a 09 20 20 28 72 65 6d 6f 74 65 2d 63 #f).. (remote-c
42b0: 6f 6e 6e 64 61 74 2d 73 65 74 21 20 2a 72 75 6e onndat-set! *run
42c0: 72 65 6d 6f 74 65 2a 20 23 66 29 20 3b 3b 20 4e remote* #f) ;; N
42d0: 4f 54 45 3a 20 2a 72 75 6e 72 65 6d 6f 74 65 2a OTE: *runremote*
42e0: 20 69 73 20 67 6c 6f 62 61 6c 20 63 6f 70 79 20 is global copy
42f0: 6f 66 20 72 75 6e 72 65 6d 6f 74 65 2e 20 50 75 of runremote. Pu
4300: 72 70 6f 73 65 3a 20 66 61 63 74 6f 72 20 6f 75 rpose: factor ou
4310: 74 20 67 6c 6f 62 61 6c 2e 0a 09 20 20 28 68 74 t global... (ht
4320: 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c 6f tp-transport:clo
4330: 73 65 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 20 se-connections
4340: 61 72 65 61 2d 64 61 74 3a 20 72 75 6e 72 65 6d area-dat: runrem
4350: 6f 74 65 29 29 29 0a 20 20 20 20 28 64 65 62 75 ote))). (debu
4360: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 33 20 g:print-info 13
4370: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4380: 74 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 t* "rmt:send-rec
4390: 65 69 76 65 2c 20 63 61 73 65 20 20 39 2e 20 63 eive, case 9. c
43a0: 6f 6e 6e 69 6e 66 6f 3d 22 20 63 6f 6e 6e 69 6e onninfo=" connin
43b0: 66 6f 20 22 20 64 61 74 3d 22 20 64 61 74 20 22 fo " dat=" dat "
43c0: 20 72 75 6e 72 65 6d 6f 74 65 20 3d 20 22 20 72 runremote = " r
43d0: 75 6e 72 65 6d 6f 74 65 29 0a 20 20 20 20 28 6d unremote). (m
43e0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d utex-unlock! *rm
43f0: 74 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 28 69 t-mutex*). (i
4400: 66 20 73 75 63 63 65 73 73 20 3b 3b 20 73 75 63 f success ;; suc
4410: 63 65 73 73 20 6f 6e 6c 79 20 74 65 6c 6c 73 20 cess only tells
4420: 75 73 20 74 68 61 74 20 74 68 65 20 74 72 61 6e us that the tran
4430: 73 70 6f 72 74 20 77 61 73 0a 09 3b 3b 20 73 75 sport was..;; su
4440: 63 63 65 73 73 66 75 6c 2c 20 68 61 76 65 20 74 ccessful, have t
4450: 6f 20 65 78 61 6d 69 6e 65 20 74 68 65 20 64 61 o examine the da
4460: 74 61 20 74 6f 20 73 65 65 20 69 66 0a 09 3b 3b ta to see if..;;
4470: 20 74 68 65 72 65 20 77 61 73 20 61 20 64 65 74 there was a det
4480: 65 63 74 65 64 20 69 73 73 75 65 20 61 74 20 74 ected issue at t
4490: 68 65 20 6f 74 68 65 72 20 65 6e 64 0a 09 28 65 he other end..(e
44a0: 78 74 72 61 73 2d 74 72 61 6e 73 70 6f 72 74 2d xtras-transport-
44b0: 73 75 63 63 65 64 65 64 20 2a 64 65 66 61 75 6c succeded *defaul
44c0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 2a 72 6d 74 t-log-port* *rmt
44d0: 2d 6d 75 74 65 78 2a 20 61 74 74 65 6d 70 74 6e -mutex* attemptn
44e0: 75 6d 20 72 75 6e 72 65 6d 6f 74 65 20 72 65 73 um runremote res
44f0: 20 70 61 72 61 6d 73 20 72 69 64 20 63 6d 64 29 params rid cmd)
4500: 0a 09 28 65 78 74 72 61 73 2d 74 72 61 6e 73 70 ..(extras-transp
4510: 6f 72 74 2d 66 61 69 6c 65 64 20 2a 64 65 66 61 ort-failed *defa
4520: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 2a 72 ult-log-port* *r
4530: 6d 74 2d 6d 75 74 65 78 2a 20 61 74 74 65 6d 70 mt-mutex* attemp
4540: 74 6e 75 6d 20 72 75 6e 72 65 6d 6f 74 65 20 63 tnum runremote c
4550: 6d 64 20 72 69 64 20 70 61 72 61 6d 73 29 0a 09 md rid params)..
4560: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
4570: 74 3a 70 72 69 6e 74 2d 64 62 2d 73 74 61 74 73 t:print-db-stats
4580: 29 0a 20 20 28 6c 65 74 20 28 28 66 6d 74 73 74 ). (let ((fmtst
4590: 72 20 22 7e 34 30 61 7e 37 2d 64 7e 39 2d 64 7e r "~40a~7-d~9-d~
45a0: 32 30 2c 32 2d 66 22 29 29 20 3b 3b 20 22 7e 32 20,2-f")) ;; "~2
45b0: 30 2c 32 2d 66 22 0a 20 20 20 20 28 64 65 62 75 0,2-f". (debu
45c0: 67 3a 70 72 69 6e 74 20 31 38 20 2a 64 65 66 61 g:print 18 *defa
45d0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 44 ult-log-port* "D
45e0: 42 20 53 74 61 74 73 5c 6e 3d 3d 3d 3d 3d 3d 3d B Stats\n=======
45f0: 3d 22 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ="). (debug:p
4600: 72 69 6e 74 20 31 38 20 2a 64 65 66 61 75 6c 74 rint 18 *default
4610: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 28 66 6f 72 6d -log-port* (form
4620: 61 74 20 23 66 20 22 7e 34 30 61 7e 38 61 7e 31 at #f "~40a~8a~1
4630: 30 61 7e 31 30 61 22 20 22 43 6d 64 22 20 22 43 0a~10a" "Cmd" "C
4640: 6f 75 6e 74 22 20 22 54 6f 74 54 69 6d 65 22 20 ount" "TotTime"
4650: 22 41 76 67 22 29 29 0a 20 20 20 20 28 66 6f 72 "Avg")). (for
4660: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 63 -each (lambda (c
4670: 6d 64 29 0a 09 09 28 6c 65 74 20 28 28 63 6d 64 md)...(let ((cmd
4680: 2d 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 -dat (hash-table
4690: 2d 72 65 66 20 2a 64 62 2d 73 74 61 74 73 2a 20 -ref *db-stats*
46a0: 63 6d 64 29 29 29 0a 09 09 20 20 28 64 65 62 75 cmd)))... (debu
46b0: 67 3a 70 72 69 6e 74 20 31 38 20 2a 64 65 66 61 g:print 18 *defa
46c0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 28 66 ult-log-port* (f
46d0: 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 ormat #f fmtstr
46e0: 63 6d 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 cmd (vector-ref
46f0: 63 6d 64 2d 64 61 74 20 30 29 20 28 76 65 63 74 cmd-dat 0) (vect
4700: 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 20 31 or-ref cmd-dat 1
4710: 29 20 28 2f 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (/ (vector-ref
4720: 20 63 6d 64 2d 64 61 74 20 31 29 28 76 65 63 74 cmd-dat 1)(vect
4730: 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 20 30 or-ref cmd-dat 0
4740: 29 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 73 )))))).. (s
4750: 6f 72 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ort (hash-table-
4760: 6b 65 79 73 20 2a 64 62 2d 73 74 61 74 73 2a 29 keys *db-stats*)
4770: 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ... (lambda (
4780: 61 20 62 29 0a 09 09 20 20 20 20 20 20 28 3e 20 a b)... (>
4790: 28 76 65 63 74 6f 72 2d 72 65 66 20 28 68 61 73 (vector-ref (has
47a0: 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 64 62 2d h-table-ref *db-
47b0: 73 74 61 74 73 2a 20 61 29 20 30 29 0a 09 09 09 stats* a) 0)....
47c0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28 68 61 (vector-ref (ha
47d0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 64 62 sh-table-ref *db
47e0: 2d 73 74 61 74 73 2a 20 62 29 20 30 29 29 29 29 -stats* b) 0))))
47f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
4800: 74 3a 67 65 74 2d 6d 61 78 2d 71 75 65 72 79 2d t:get-max-query-
4810: 61 76 65 72 61 67 65 20 72 75 6e 2d 69 64 29 0a average run-id).
4820: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a (mutex-lock! *
4830: 64 62 2d 73 74 61 74 73 2d 6d 75 74 65 78 2a 29 db-stats-mutex*)
4840: 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6b 65 . (let* ((runke
4850: 79 20 28 63 6f 6e 63 20 22 72 75 6e 2d 69 64 3d y (conc "run-id=
4860: 22 20 72 75 6e 2d 69 64 20 22 20 22 29 29 0a 09 " run-id " "))..
4870: 20 28 63 6d 64 73 20 20 20 28 66 69 6c 74 65 72 (cmds (filter
4880: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
4890: 20 20 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e (substring-in
48a0: 64 65 78 20 72 75 6e 6b 65 79 20 78 29 29 0a 09 dex runkey x))..
48b0: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b .. (hash-table-k
48c0: 65 79 73 20 2a 64 62 2d 73 74 61 74 73 2a 29 29 eys *db-stats*))
48d0: 29 0a 09 20 28 72 65 73 20 20 20 20 28 69 66 20 ).. (res (if
48e0: 28 6e 75 6c 6c 3f 20 63 6d 64 73 29 0a 09 09 20 (null? cmds)...
48f0: 20 20 20 20 28 63 6f 6e 73 20 27 6e 6f 6e 65 20 (cons 'none
4900: 30 29 0a 09 09 20 20 20 20 20 28 6c 65 74 20 6c 0)... (let l
4910: 6f 6f 70 20 28 28 63 6d 64 20 28 63 61 72 20 63 oop ((cmd (car c
4920: 6d 64 73 29 29 0a 09 09 09 09 28 74 61 6c 20 28 mds)).....(tal (
4930: 63 64 72 20 63 6d 64 73 29 29 0a 09 09 09 09 28 cdr cmds)).....(
4940: 6d 61 78 2d 63 6d 64 20 28 63 61 72 20 63 6d 64 max-cmd (car cmd
4950: 73 29 29 0a 09 09 09 09 28 72 65 73 20 30 29 29 s)).....(res 0))
4960: 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ... (let*
4970: 28 28 63 6d 64 2d 64 61 74 20 28 68 61 73 68 2d ((cmd-dat (hash-
4980: 74 61 62 6c 65 2d 72 65 66 20 2a 64 62 2d 73 74 table-ref *db-st
4990: 61 74 73 2a 20 63 6d 64 29 29 0a 09 09 09 20 20 ats* cmd))....
49a0: 20 20 20 20 28 74 6f 74 20 20 20 20 20 28 76 65 (tot (ve
49b0: 63 74 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 ctor-ref cmd-dat
49c0: 20 30 29 29 0a 09 09 09 20 20 20 20 20 20 28 63 0)).... (c
49d0: 75 72 72 61 76 67 20 28 2f 20 28 76 65 63 74 6f urravg (/ (vecto
49e0: 72 2d 72 65 66 20 63 6d 64 2d 64 61 74 20 31 29 r-ref cmd-dat 1)
49f0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6d 64 (vector-ref cmd
4a00: 2d 64 61 74 20 30 29 29 29 20 3b 3b 20 63 6f 75 -dat 0))) ;; cou
4a10: 6e 74 20 69 73 20 6e 65 76 65 72 20 7a 65 72 6f nt is never zero
4a20: 20 62 79 20 63 6f 6e 73 74 72 75 63 74 69 6f 6e by construction
4a30: 0a 09 09 09 20 20 20 20 20 20 28 63 75 72 72 6d .... (currm
4a40: 61 78 20 28 6d 61 78 20 72 65 73 20 63 75 72 72 ax (max res curr
4a50: 61 76 67 29 29 0a 09 09 09 20 20 20 20 20 20 28 avg)).... (
4a60: 6e 65 77 6d 61 78 2d 63 6d 64 20 28 69 66 20 28 newmax-cmd (if (
4a70: 3e 20 63 75 72 72 61 76 67 20 72 65 73 29 20 63 > curravg res) c
4a80: 6d 64 20 6d 61 78 2d 63 6d 64 29 29 29 0a 09 09 md max-cmd)))...
4a90: 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c . (if (null? tal
4aa0: 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 3e ).... (if (>
4ab0: 20 74 6f 74 20 31 30 29 0a 09 09 09 09 20 28 63 tot 10)..... (c
4ac0: 6f 6e 73 20 6e 65 77 6d 61 78 2d 63 6d 64 20 63 ons newmax-cmd c
4ad0: 75 72 72 6d 61 78 29 0a 09 09 09 09 20 28 63 6f urrmax)..... (co
4ae0: 6e 73 20 27 6e 6f 6e 65 20 30 29 29 0a 09 09 09 ns 'none 0))....
4af0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
4b00: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
4b10: 77 6d 61 78 2d 63 6d 64 20 63 75 72 72 6d 61 78 wmax-cmd currmax
4b20: 29 29 29 29 29 29 29 0a 20 20 20 20 28 6d 75 74 ))))))). (mut
4b30: 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 2d 73 ex-unlock! *db-s
4b40: 74 61 74 73 2d 6d 75 74 65 78 2a 29 0a 20 20 20 tats-mutex*).
4b50: 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 res))..(define
4b60: 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d 63 6c (rmt:open-qry-cl
4b70: 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 63 6d 64 20 ose-locally cmd
4b80: 72 75 6e 2d 69 64 20 70 61 72 61 6d 73 20 23 21 run-id params #!
4b90: 6b 65 79 20 28 72 65 6d 72 65 74 72 69 65 73 20 key (remretries
4ba0: 35 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 71 72 5)). (let* ((qr
4bb0: 79 2d 69 73 2d 77 72 69 74 65 20 20 20 28 6e 6f y-is-write (no
4bc0: 74 20 28 6d 65 6d 62 65 72 20 63 6d 64 20 61 70 t (member cmd ap
4bd0: 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 i:read-only-quer
4be0: 69 65 73 29 29 29 0a 09 20 28 64 62 2d 66 69 6c ies))).. (db-fil
4bf0: 65 2d 70 61 74 68 20 20 20 28 64 62 3a 64 62 66 e-path (db:dbf
4c00: 69 6c 65 2d 70 61 74 68 29 29 20 3b 3b 20 20 30 ile-path)) ;; 0
4c10: 29 29 0a 09 20 28 64 62 73 74 72 75 63 74 2d 6c )).. (dbstruct-l
4c20: 6f 63 61 6c 20 28 64 62 3a 73 65 74 75 70 20 23 ocal (db:setup #
4c30: 74 29 29 20 20 3b 3b 20 6d 61 6b 65 2d 64 62 72 t)) ;; make-dbr
4c40: 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 :dbstruct path:
4c50: 20 64 62 64 69 72 20 6c 6f 63 61 6c 3a 20 23 74 dbdir local: #t
4c60: 29 29 29 0a 09 20 28 72 65 61 64 2d 6f 6e 6c 79 ))).. (read-only
4c70: 20 20 20 20 20 20 28 6e 6f 74 20 28 66 69 6c 65 (not (file
4c80: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 64 -write-access? d
4c90: 62 2d 66 69 6c 65 2d 70 61 74 68 29 29 29 0a 09 b-file-path)))..
4ca0: 20 28 73 74 61 72 74 20 20 20 20 20 20 20 20 20 (start
4cb0: 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 (current-millis
4cc0: 65 63 6f 6e 64 73 29 29 0a 09 20 28 72 65 73 64 econds)).. (resd
4cd0: 61 74 20 20 20 20 20 20 20 20 20 28 69 66 20 28 at (if (
4ce0: 6e 6f 74 20 28 61 6e 64 20 72 65 61 64 2d 6f 6e not (and read-on
4cf0: 6c 79 20 71 72 79 2d 69 73 2d 77 72 69 74 65 29 ly qry-is-write)
4d00: 29 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 ).... (let (
4d10: 28 76 20 28 61 70 69 3a 65 78 65 63 75 74 65 2d (v (api:execute-
4d20: 72 65 71 75 65 73 74 73 20 64 62 73 74 72 75 63 requests dbstruc
4d30: 74 2d 6c 6f 63 61 6c 20 28 76 65 63 74 6f 72 20 t-local (vector
4d40: 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 (symbol->string
4d50: 63 6d 64 29 20 70 61 72 61 6d 73 29 29 29 29 0a cmd) params)))).
4d60: 09 09 09 20 20 20 20 20 20 20 28 68 61 6e 64 6c ... (handl
4d70: 65 2d 65 78 63 65 70 74 69 6f 6e 73 20 3b 3b 20 e-exceptions ;;
4d80: 74 68 65 72 65 20 68 61 73 20 62 65 65 6e 20 61 there has been a
4d90: 20 6c 6f 6e 67 20 68 69 73 74 6f 72 79 20 6f 66 long history of
4da0: 20 72 65 63 65 69 76 69 6e 67 20 73 74 72 61 6e receiving stran
4db0: 67 65 20 65 72 72 6f 72 73 20 66 72 6f 6d 20 76 ge errors from v
4dc0: 61 6c 75 65 73 20 72 65 74 75 72 6e 65 64 20 62 alues returned b
4dd0: 79 20 74 68 65 20 63 6c 69 65 6e 74 20 77 68 65 y the client whe
4de0: 6e 20 74 68 69 6e 67 73 20 67 6f 20 77 72 6f 6e n things go wron
4df0: 67 2e 2e 0a 09 09 09 09 65 78 6e 20 20 20 20 20 g.......exn
4e00: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 54 68 ;; Th
4e10: 69 73 20 69 73 20 61 6e 20 61 74 74 65 6d 70 74 is is an attempt
4e20: 20 74 6f 20 64 65 74 65 63 74 20 74 68 61 74 20 to detect that
4e30: 73 69 74 75 61 74 69 6f 6e 20 61 6e 64 20 72 65 situation and re
4e40: 63 6f 76 65 72 20 67 72 61 63 65 66 75 6c 6c 79 cover gracefully
4e50: 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 .....(begin.....
4e60: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4e70: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4e80: 72 74 2a 20 22 45 52 52 4f 52 3a 20 62 61 64 20 rt* "ERROR: bad
4e90: 64 61 74 61 20 66 72 6f 6d 20 73 65 72 76 65 72 data from server
4ea0: 20 22 20 76 20 22 20 6d 65 73 73 61 67 65 3a 20 " v " message:
4eb0: 22 20 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
4ec0: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
4ed0: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
4ee0: 65 78 6e 29 20 22 2c 20 65 78 6e 3d 22 20 65 78 exn) ", exn=" ex
4ef0: 6e 29 0a 09 09 09 09 20 20 28 76 65 63 74 6f 72 n)..... (vector
4f00: 20 23 74 20 27 28 29 29 29 20 3b 3b 20 73 68 6f #t '())) ;; sho
4f10: 75 6c 64 20 61 6c 77 61 79 73 20 67 65 74 20 61 uld always get a
4f20: 20 76 65 63 74 6f 72 20 62 75 74 20 69 66 20 73 vector but if s
4f30: 6f 6d 65 74 68 69 6e 67 20 67 6f 65 73 20 77 72 omething goes wr
4f40: 6f 6e 67 20 72 65 74 75 72 6e 20 61 20 64 75 6d ong return a dum
4f50: 6d 79 0a 09 09 09 09 28 69 66 20 28 61 6e 64 20 my.....(if (and
4f60: 28 76 65 63 74 6f 72 3f 20 76 29 0a 09 09 09 09 (vector? v).....
4f70: 09 20 28 3e 20 28 76 65 63 74 6f 72 2d 6c 65 6e . (> (vector-len
4f80: 67 74 68 20 76 29 20 31 29 29 0a 09 09 09 09 20 gth v) 1)).....
4f90: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 65 63 (let ((newvec
4fa0: 20 28 76 65 63 74 6f 72 20 28 76 65 63 74 6f 72 (vector (vector
4fb0: 2d 72 65 66 20 76 20 30 29 28 76 65 63 74 6f 72 -ref v 0)(vector
4fc0: 2d 72 65 66 20 76 20 31 29 29 29 29 0a 09 09 09 -ref v 1))))....
4fd0: 09 20 20 20 20 20 20 6e 65 77 76 65 63 29 20 20 . newvec)
4fe0: 20 20 20 20 20 20 20 20 20 3b 3b 20 62 79 20 63 ;; by c
4ff0: 6f 70 79 69 6e 67 20 74 68 65 20 76 65 63 74 6f opying the vecto
5000: 72 20 77 68 69 6c 65 20 69 6e 73 69 64 65 20 74 r while inside t
5010: 68 65 20 65 72 72 6f 72 20 68 61 6e 64 6c 65 72 he error handler
5020: 20 77 65 20 73 68 6f 75 6c 64 20 66 6f 72 63 65 we should force
5030: 20 74 68 65 20 64 65 74 65 63 74 69 6f 6e 20 6f the detection o
5040: 66 20 61 20 63 6f 72 72 75 70 74 65 64 20 72 65 f a corrupted re
5050: 63 6f 72 64 0a 09 09 09 09 20 20 20 20 28 76 65 cord..... (ve
5060: 63 74 6f 72 20 23 74 20 27 28 29 29 29 29 29 20 ctor #t '()))))
5070: 20 3b 3b 20 77 65 20 63 6f 75 6c 64 20 61 6c 73 ;; we could als
5080: 6f 20 63 68 65 63 6b 20 74 68 61 74 20 74 68 65 o check that the
5090: 20 72 65 74 75 72 6e 65 64 20 74 79 70 65 73 20 returned types
50a0: 61 72 65 20 76 61 6c 69 64 0a 09 09 09 20 20 20 are valid....
50b0: 20 20 28 76 65 63 74 6f 72 20 23 74 20 27 28 29 (vector #t '()
50c0: 29 29 29 0a 09 20 28 73 75 63 63 65 73 73 20 20 ))).. (success
50d0: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 61 (common:sa
50e0: 66 65 2d 76 65 63 74 6f 72 2d 72 65 66 20 72 65 fe-vector-ref re
50f0: 73 64 61 74 20 30 20 23 66 29 29 20 3b 3b 20 28 sdat 0 #f)) ;; (
5100: 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 61 vector-ref resda
5110: 74 20 30 29 29 0a 09 20 28 72 65 73 20 20 20 20 t 0)).. (res
5120: 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
5130: 73 61 66 65 2d 76 65 63 74 6f 72 2d 72 65 66 20 safe-vector-ref
5140: 72 65 73 64 61 74 20 31 20 23 66 29 29 20 3b 3b resdat 1 #f)) ;;
5150: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 (vector-ref res
5160: 64 61 74 20 31 29 29 0a 09 20 28 64 75 72 61 74 dat 1)).. (durat
5170: 69 6f 6e 20 20 20 20 20 20 20 28 2d 20 28 63 75 ion (- (cu
5180: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
5190: 64 73 29 20 73 74 61 72 74 29 29 29 0a 20 20 20 ds) start))).
51a0: 20 28 69 66 20 28 61 6e 64 20 72 65 61 64 2d 6f (if (and read-o
51b0: 6e 6c 79 20 71 72 79 2d 69 73 2d 77 72 69 74 65 nly qry-is-write
51c0: 29 0a 20 20 20 20 20 20 20 20 28 64 65 62 75 67 ). (debug
51d0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
51e0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 t-log-port* "ERR
51f0: 4f 52 3a 20 61 74 74 65 6d 70 74 20 74 6f 20 77 OR: attempt to w
5200: 72 69 74 65 20 74 6f 20 72 65 61 64 2d 6f 6e 6c rite to read-onl
5210: 79 20 64 61 74 61 62 61 73 65 20 69 67 6e 6f 72 y database ignor
5220: 65 64 2e 20 63 6d 64 3d 22 20 63 6d 64 29 29 0a ed. cmd=" cmd)).
5230: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 73 75 63 (if (not suc
5240: 63 65 73 73 29 0a 09 28 69 66 20 28 3e 20 72 65 cess)..(if (> re
5250: 6d 72 65 74 72 69 65 73 20 30 29 0a 09 20 20 20 mretries 0)..
5260: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
5270: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
5280: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
5290: 2d 70 6f 72 74 2a 20 22 6c 6f 63 61 6c 20 71 75 -port* "local qu
52a0: 65 72 79 20 66 61 69 6c 65 64 2e 20 54 72 79 69 ery failed. Tryi
52b0: 6e 67 20 61 67 61 69 6e 2e 22 29 0a 09 20 20 20 ng again.")..
52c0: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
52d0: 21 20 28 2f 20 28 72 61 6e 64 6f 6d 20 35 30 30 ! (/ (random 500
52e0: 30 29 20 31 30 30 30 29 29 20 3b 3b 20 73 6f 6d 0) 1000)) ;; som
52f0: 65 20 72 61 6e 64 6f 6d 20 64 65 6c 61 79 20 0a e random delay .
5300: 09 20 20 20 20 20 20 28 72 6d 74 3a 6f 70 65 6e . (rmt:open
5310: 2d 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c -qry-close-local
5320: 6c 79 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 ly cmd run-id pa
5330: 72 61 6d 73 20 72 65 6d 72 65 74 72 69 65 73 3a rams remretries:
5340: 20 28 2d 20 72 65 6d 72 65 74 72 69 65 73 20 31 (- remretries 1
5350: 29 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a ))).. (begin.
5360: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
5370: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
5380: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
5390: 74 6f 6f 20 6d 61 6e 79 20 72 65 74 72 69 65 73 too many retries
53a0: 20 69 6e 20 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 in rmt:open-qry
53b0: 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 2c 20 -close-locally,
53c0: 67 69 76 69 6e 67 20 75 70 22 29 0a 09 20 20 20 giving up")..
53d0: 20 20 20 23 66 29 29 0a 09 28 62 65 67 69 6e 0a #f))..(begin.
53e0: 09 20 20 3b 3b 20 28 72 6d 74 3a 75 70 64 61 74 . ;; (rmt:updat
53f0: 65 2d 64 62 2d 73 74 61 74 73 20 72 75 6e 2d 69 e-db-stats run-i
5400: 64 20 63 6d 64 20 70 61 72 61 6d 73 20 64 75 72 d cmd params dur
5410: 61 74 69 6f 6e 29 0a 09 20 20 3b 3b 20 6d 61 72 ation).. ;; mar
5420: 6b 20 74 68 69 73 20 72 75 6e 20 61 73 20 64 69 k this run as di
5430: 72 74 79 20 69 66 20 74 68 69 73 20 77 61 73 20 rty if this was
5440: 61 20 77 72 69 74 65 2c 20 74 68 65 20 77 61 74 a write, the wat
5450: 63 68 64 6f 67 20 69 73 20 72 65 73 70 6f 6e 73 chdog is respons
5460: 69 62 6c 65 20 66 6f 72 20 73 79 6e 63 69 6e 67 ible for syncing
5470: 20 69 74 0a 09 20 20 28 69 66 20 71 72 79 2d 69 it.. (if qry-i
5480: 73 2d 77 72 69 74 65 0a 09 20 20 20 20 20 20 28 s-write.. (
5490: 6c 65 74 20 28 28 73 74 61 72 74 2d 74 69 6d 65 let ((start-time
54a0: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
54b0: 73 29 29 29 0a 09 09 28 6d 75 74 65 78 2d 6c 6f s)))...(mutex-lo
54c0: 63 6b 21 20 2a 64 62 2d 6d 75 6c 74 69 2d 73 79 ck! *db-multi-sy
54d0: 6e 63 2d 6d 75 74 65 78 2a 29 0a 09 09 28 73 65 nc-mutex*)...(se
54e0: 74 21 20 2a 64 62 2d 6c 61 73 74 2d 61 63 63 65 t! *db-last-acce
54f0: 73 73 2a 20 73 74 61 72 74 2d 74 69 6d 65 29 20 ss* start-time)
5500: 20 3b 3b 20 54 48 49 53 20 49 53 20 50 52 4f 42 ;; THIS IS PROB
5510: 41 42 4c 59 20 55 53 45 4c 45 53 53 3f 20 28 77 ABLY USELESS? (w
5520: 65 20 61 72 65 20 6f 6e 20 61 20 63 6c 69 65 6e e are on a clien
5530: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
5540: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
5550: 21 20 2a 64 62 2d 6d 75 6c 74 69 2d 73 79 6e 63 ! *db-multi-sync
5560: 2d 6d 75 74 65 78 2a 29 29 29 29 29 0a 20 20 20 -mutex*))))).
5570: 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 res))..(define
5580: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
5590: 65 2d 6e 6f 2d 61 75 74 6f 2d 63 6c 69 65 6e 74 e-no-auto-client
55a0: 2d 73 65 74 75 70 20 63 6f 6e 6e 65 63 74 69 6f -setup connectio
55b0: 6e 2d 69 6e 66 6f 20 63 6d 64 20 72 75 6e 2d 69 n-info cmd run-i
55c0: 64 20 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 d params). (let
55d0: 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 28 69 66 * ((run-id (if
55e0: 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 64 20 30 run-id run-id 0
55f0: 29 29 0a 09 20 28 72 65 73 20 20 09 20 20 20 28 )).. (res . (
5600: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
5610: 73 0a 09 09 20 20 20 20 20 20 20 65 78 6e 0a 09 s... exn..
5620: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 . (begin...
5630: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 74 72 (print "tr
5640: 61 6e 73 70 6f 72 74 20 66 61 69 6c 65 64 2e 20 ansport failed.
5650: 65 78 6e 3d 22 20 65 78 6e 29 0a 09 09 20 20 20 exn=" exn)...
5660: 20 20 20 20 23 66 29 0a 09 09 20 20 20 20 20 28 #f)... (
5670: 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 63 http-transport:c
5680: 6c 69 65 6e 74 2d 61 70 69 2d 73 65 6e 64 2d 72 lient-api-send-r
5690: 65 63 65 69 76 65 20 72 75 6e 2d 69 64 20 63 6f eceive run-id co
56a0: 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 63 6d nnection-info cm
56b0: 64 20 70 61 72 61 6d 73 29 29 29 29 0a 20 20 20 d params)))).
56c0: 20 28 69 66 20 28 61 6e 64 20 72 65 73 20 28 76 (if (and res (v
56d0: 65 63 74 6f 72 2d 72 65 66 20 72 65 73 20 30 29 ector-ref res 0)
56e0: 29 0a 09 28 76 65 63 74 6f 72 2d 72 65 66 20 72 )..(vector-ref r
56f0: 65 73 20 31 29 20 3b 3b 3b 20 59 45 53 21 21 20 es 1) ;;; YES!!
5700: 54 48 49 53 20 49 53 20 43 4f 52 52 45 43 54 21 THIS IS CORRECT!
5710: 21 20 43 48 41 4e 47 45 20 49 54 20 48 45 52 45 ! CHANGE IT HERE
5720: 2c 20 54 48 45 4e 20 43 48 41 4e 47 45 20 72 6d , THEN CHANGE rm
5730: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 41 t:send-receive A
5740: 4c 53 4f 21 21 21 0a 09 23 66 29 29 29 0a 0a 3b LSO!!!..#f)))..;
5750: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5790: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 41 20 =======.;;.;; A
57a0: 43 20 54 20 55 20 41 20 4c 20 20 20 41 20 50 20 C T U A L A P
57b0: 49 20 20 20 43 20 41 20 4c 20 4c 20 53 20 20 0a I C A L L S .
57c0: 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;.;;===========
57d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 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 0a 0a 3b 3b 3d ===========..;;=
5810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5830: 3d 3d 3d 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 0a 3b 3b 20 20 53 20 45 20 52 20 =====.;; S E R
5860: 56 20 45 20 52 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d V E R.;;========
5870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
58b0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6b 69 6c (define (rmt:kil
58c0: 6c 2d 73 65 72 76 65 72 20 72 75 6e 2d 69 64 29 l-server run-id)
58d0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
58e0: 65 69 76 65 20 27 6b 69 6c 6c 2d 73 65 72 76 65 eive 'kill-serve
58f0: 72 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 r run-id (list r
5900: 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e un-id)))..(defin
5910: 65 20 28 72 6d 74 3a 73 74 61 72 74 2d 73 65 72 e (rmt:start-ser
5920: 76 65 72 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 ver run-id). (r
5930: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
5940: 27 73 74 61 72 74 2d 73 65 72 76 65 72 20 30 20 'start-server 0
5950: 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a (list run-id))).
5960: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5980: 3d 3d 3d 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 0a 3b 3b 20 20 4d 20 =========.;; M
59b0: 49 20 53 20 43 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d I S C.;;========
59c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
5a00: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6c 6f 67 (define (rmt:log
5a10: 69 6e 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d in run-id). (rm
5a20: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
5a30: 6c 6f 67 69 6e 20 72 75 6e 2d 69 64 20 28 6c 69 login run-id (li
5a40: 73 74 20 2a 74 6f 70 70 61 74 68 2a 20 6d 65 67 st *toppath* meg
5a50: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 2a 6d atest-version *m
5a60: 79 2d 63 6c 69 65 6e 74 2d 73 69 67 6e 61 74 75 y-client-signatu
5a70: 72 65 2a 29 29 29 0a 0a 3b 3b 20 54 68 69 73 20 re*)))..;; This
5a80: 6c 6f 67 69 6e 20 64 6f 65 73 20 6e 6f 20 72 65 login does no re
5a90: 74 72 69 65 73 20 75 6e 64 65 72 20 74 68 65 20 tries under the
5aa0: 68 6f 6f 64 20 2d 20 69 74 20 61 63 74 73 20 61 hood - it acts a
5ab0: 20 62 69 74 20 6c 69 6b 65 20 61 20 70 69 6e 67 bit like a ping
5ac0: 2e 0a 3b 3b 20 44 65 70 72 65 63 61 74 65 64 20 ..;; Deprecated
5ad0: 66 6f 72 20 6e 6d 73 67 2d 74 72 61 6e 73 70 6f for nmsg-transpo
5ae0: 72 74 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 rt..;;.(define (
5af0: 72 6d 74 3a 6c 6f 67 69 6e 2d 6e 6f 2d 61 75 74 rmt:login-no-aut
5b00: 6f 2d 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 63 o-client-setup c
5b10: 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 29 0a onnection-info).
5b20: 20 20 28 63 61 73 65 20 2a 74 72 61 6e 73 70 6f (case *transpo
5b30: 72 74 2d 74 79 70 65 2a 20 3b 3b 20 72 75 6e 2d rt-type* ;; run-
5b40: 69 64 20 6f 66 20 30 20 69 73 20 6a 75 73 74 20 id of 0 is just
5b50: 61 20 70 6c 61 63 65 68 6f 6c 64 65 72 0a 20 20 a placeholder.
5b60: 20 20 28 28 68 74 74 70 29 28 72 6d 74 3a 73 65 ((http)(rmt:se
5b70: 6e 64 2d 72 65 63 65 69 76 65 2d 6e 6f 2d 61 75 nd-receive-no-au
5b80: 74 6f 2d 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 to-client-setup
5b90: 63 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 connection-info
5ba0: 27 6c 6f 67 69 6e 20 30 20 28 6c 69 73 74 20 2a 'login 0 (list *
5bb0: 74 6f 70 70 61 74 68 2a 20 6d 65 67 61 74 65 73 toppath* megates
5bc0: 74 2d 76 65 72 73 69 6f 6e 20 2a 6d 79 2d 63 6c t-version *my-cl
5bd0: 69 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 2a 29 ient-signature*)
5be0: 29 29 0a 20 20 20 20 3b 3b 28 28 6e 6d 73 67 29 )). ;;((nmsg)
5bf0: 28 6e 6d 73 67 2d 74 72 61 6e 73 70 6f 72 74 3a (nmsg-transport:
5c00: 63 6c 69 65 6e 74 2d 61 70 69 2d 73 65 6e 64 2d client-api-send-
5c10: 72 65 63 65 69 76 65 20 72 75 6e 2d 69 64 20 63 receive run-id c
5c20: 6f 6e 6e 65 63 74 69 6f 6e 2d 69 6e 66 6f 20 27 onnection-info '
5c30: 6c 6f 67 69 6e 20 28 6c 69 73 74 20 2a 74 6f 70 login (list *top
5c40: 70 61 74 68 2a 20 6d 65 67 61 74 65 73 74 2d 76 path* megatest-v
5c50: 65 72 73 69 6f 6e 20 72 75 6e 2d 69 64 20 2a 6d ersion run-id *m
5c60: 79 2d 63 6c 69 65 6e 74 2d 73 69 67 6e 61 74 75 y-client-signatu
5c70: 72 65 2a 29 29 29 0a 20 20 20 20 29 29 0a 0a 3b re*))). ))..;
5c80: 3b 20 68 61 6e 64 20 6f 66 66 20 61 20 63 61 6c ; hand off a cal
5c90: 6c 20 74 6f 20 6f 6e 65 20 6f 66 20 74 68 65 20 l to one of the
5ca0: 64 62 3a 71 75 65 72 69 65 73 20 73 74 61 74 65 db:queries state
5cb0: 6d 65 6e 74 73 0a 3b 3b 20 61 64 64 65 64 20 72 ments.;; added r
5cc0: 75 6e 2d 69 64 20 74 6f 20 6d 61 6b 65 20 6c 6f un-id to make lo
5cd0: 6f 6b 69 6e 67 20 75 70 20 74 68 65 20 63 6f 72 oking up the cor
5ce0: 72 65 63 74 20 64 62 20 70 6f 73 73 69 62 6c 65 rect db possible
5cf0: 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d .;;.(define (rm
5d00: 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 73 t:general-call s
5d10: 74 6d 74 6e 61 6d 65 20 72 75 6e 2d 69 64 20 2e tmtname run-id .
5d20: 20 70 61 72 61 6d 73 29 0a 20 20 28 72 6d 74 3a params). (rmt:
5d30: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
5d40: 6e 65 72 61 6c 2d 63 61 6c 6c 20 72 75 6e 2d 69 neral-call run-i
5d50: 64 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 d (append (list
5d60: 73 74 6d 74 6e 61 6d 65 20 72 75 6e 2d 69 64 29 stmtname run-id)
5d70: 20 70 61 72 61 6d 73 29 29 29 0a 0a 0a 3b 3b 20 params)))...;;
5d80: 67 69 76 65 6e 20 61 20 68 6f 73 74 6e 61 6d 65 given a hostname
5d90: 2c 20 72 65 74 75 72 6e 20 61 20 70 61 69 72 20 , return a pair
5da0: 6f 66 20 63 70 75 20 6c 6f 61 64 20 61 6e 64 20 of cpu load and
5db0: 75 70 64 61 74 65 20 74 69 6d 65 20 72 65 70 72 update time repr
5dc0: 65 73 65 6e 74 69 6e 67 20 6c 61 74 65 73 74 20 esenting latest
5dd0: 69 6e 74 65 6c 6c 69 67 65 6e 63 65 20 66 72 6f intelligence fro
5de0: 6d 20 74 65 73 74 73 20 72 75 6e 6e 69 6e 67 20 m tests running
5df0: 6f 6e 20 74 68 61 74 20 68 6f 73 74 0a 28 64 65 on that host.(de
5e00: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6c 61 fine (rmt:get-la
5e10: 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 20 68 test-host-load h
5e20: 6f 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a ostname). (rmt:
5e30: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
5e40: 74 2d 6c 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f t-latest-host-lo
5e50: 61 64 20 30 20 28 6c 69 73 74 20 68 6f 73 74 6e ad 0 (list hostn
5e60: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
5e70: 28 72 6d 74 3a 73 64 62 2d 71 72 79 20 71 72 79 (rmt:sdb-qry qry
5e80: 20 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 20 3b val run-id). ;
5e90: 3b 20 61 64 64 20 63 61 63 68 69 6e 67 20 69 66 ; add caching if
5ea0: 20 71 72 79 20 69 73 20 27 67 65 74 69 64 20 6f qry is 'getid o
5eb0: 72 20 27 67 65 74 73 74 72 0a 20 20 28 72 6d 74 r 'getstr. (rmt
5ec0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 73 :send-receive 's
5ed0: 64 62 2d 71 72 79 20 72 75 6e 2d 69 64 20 28 6c db-qry run-id (l
5ee0: 69 73 74 20 71 72 79 20 76 61 6c 29 29 29 0a 0a ist qry val)))..
5ef0: 3b 3b 20 4e 4f 54 20 43 4f 4d 50 4c 45 54 45 44 ;; NOT COMPLETED
5f00: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 72 75 .(define (rmt:ru
5f10: 6e 74 65 73 74 73 20 75 73 65 72 20 72 75 6e 2d ntests user run-
5f20: 69 64 20 74 65 73 74 70 61 74 74 20 70 61 72 61 id testpatt para
5f30: 6d 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ms). (rmt:send-
5f40: 72 65 63 65 69 76 65 20 27 72 75 6e 74 65 73 74 receive 'runtest
5f50: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 s run-id testpat
5f60: 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d t))..(define (rm
5f70: 74 3a 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 64 t:get-run-record
5f80: 2d 69 64 73 20 20 74 61 72 67 65 74 20 72 75 6e -ids target run
5f90: 20 6b 65 79 6e 61 6d 65 73 20 74 65 73 74 2d 70 keynames test-p
5fa0: 61 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 att). (rmt:send
5fb0: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 -receive 'get-ru
5fc0: 6e 2d 72 65 63 6f 72 64 2d 69 64 73 20 23 66 20 n-record-ids #f
5fd0: 28 6c 69 73 74 20 74 61 72 67 65 74 20 72 75 6e (list target run
5fe0: 20 6b 65 79 6e 61 6d 65 73 20 74 65 73 74 2d 70 keynames test-p
5ff0: 61 74 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 att)))..(define
6000: 28 72 6d 74 3a 67 65 74 2d 63 68 61 6e 67 65 64 (rmt:get-changed
6010: 2d 72 65 63 6f 72 64 2d 69 64 73 20 73 69 6e 63 -record-ids sinc
6020: 65 2d 74 69 6d 65 29 0a 20 20 28 72 6d 74 3a 73 e-time). (rmt:s
6030: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
6040: 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d -changed-record-
6050: 69 64 73 20 23 66 20 28 6c 69 73 74 20 73 69 6e ids #f (list sin
6060: 63 65 2d 74 69 6d 65 29 29 20 29 0a 0a 28 64 65 ce-time)) )..(de
6070: 66 69 6e 65 20 28 72 6d 74 3a 64 72 6f 70 2d 61 fine (rmt:drop-a
6080: 6c 6c 2d 74 72 69 67 67 65 72 73 29 0a 20 20 20 ll-triggers).
6090: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
60a0: 69 76 65 20 27 64 72 6f 70 2d 61 6c 6c 2d 74 72 ive 'drop-all-tr
60b0: 69 67 67 65 72 73 20 23 66 20 27 28 29 29 29 0a iggers #f '())).
60c0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 63 72 .(define (rmt:cr
60d0: 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 eate-all-trigger
60e0: 73 29 0a 20 20 20 20 20 28 72 6d 74 3a 73 65 6e s). (rmt:sen
60f0: 64 2d 72 65 63 65 69 76 65 20 27 63 72 65 61 74 d-receive 'creat
6100: 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 20 23 e-all-triggers #
6110: 66 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d f '()))..;;=====
6120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6160: 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 20 20 =.;; T E S T
6170: 4d 20 45 20 54 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d M E T A .;;=====
6180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61c0: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a =..(define (rmt:
61d0: 67 65 74 2d 74 65 73 74 73 2d 74 61 67 73 29 0a get-tests-tags).
61e0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
61f0: 69 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 74 ive 'get-tests-t
6200: 61 67 73 20 23 66 20 27 28 29 29 29 0a 0a 3b 3b ags #f '()))..;;
6210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6230: 3d 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 0a 3b 3b 20 20 4b 20 45 20 59 ======.;; K E Y
6260: 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S .;;==========
6270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
62a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
62b0: 20 54 68 65 73 65 20 72 65 71 75 69 72 65 20 72 These require r
62c0: 75 6e 2d 69 64 20 62 65 63 61 75 73 65 20 74 68 un-id because th
62d0: 65 20 76 61 6c 75 65 73 20 63 6f 6d 65 20 66 72 e values come fr
62e0: 6f 6d 20 74 68 65 20 72 75 6e 21 0a 3b 3b 0a 28 om the run!.;;.(
62f0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
6300: 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 72 75 key-val-pairs ru
6310: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
6320: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6b d-receive 'get-k
6330: 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 72 75 6e ey-val-pairs run
6340: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
6350: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
6360: 74 3a 67 65 74 2d 6b 65 79 73 29 0a 20 20 28 69 t:get-keys). (i
6370: 66 20 2a 64 62 2d 6b 65 79 73 2a 20 2a 64 62 2d f *db-keys* *db-
6380: 6b 65 79 73 2a 20 0a 20 20 20 20 20 28 6c 65 74 keys* . (let
6390: 20 28 28 72 65 73 20 28 72 6d 74 3a 73 65 6e 64 ((res (rmt:send
63a0: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 -receive 'get-ke
63b0: 79 73 20 23 66 20 27 28 29 29 29 29 0a 20 20 20 ys #f '()))).
63c0: 20 20 20 20 28 73 65 74 21 20 2a 64 62 2d 6b 65 (set! *db-ke
63d0: 79 73 2a 20 72 65 73 29 0a 20 20 20 20 20 20 20 ys* res).
63e0: 72 65 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 res)))..(define
63f0: 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 2d 77 72 (rmt:get-keys-wr
6400: 69 74 65 29 20 3b 3b 20 64 75 6d 6d 79 20 71 75 ite) ;; dummy qu
6410: 65 72 79 20 74 6f 20 66 6f 72 63 65 20 73 65 72 ery to force ser
6420: 76 65 72 20 73 74 61 72 74 0a 20 20 28 6c 65 74 ver start. (let
6430: 20 28 28 72 65 73 20 28 72 6d 74 3a 73 65 6e 64 ((res (rmt:send
6440: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 -receive 'get-ke
6450: 79 73 2d 77 72 69 74 65 20 23 66 20 27 28 29 29 ys-write #f '())
6460: 29 29 0a 20 20 20 20 28 73 65 74 21 20 2a 64 62 )). (set! *db
6470: 2d 6b 65 79 73 2a 20 72 65 73 29 0a 20 20 20 20 -keys* res).
6480: 72 65 73 29 29 0a 0a 3b 3b 20 77 65 20 64 6f 6e res))..;; we don
6490: 27 74 20 72 65 75 73 65 20 72 75 6e 2d 69 64 27 't reuse run-id'
64a0: 73 20 28 65 78 63 65 70 74 20 70 6f 73 73 69 62 s (except possib
64b0: 6c 79 20 2a 61 66 74 65 72 2a 20 61 20 64 62 20 ly *after* a db
64c0: 63 6c 65 61 6e 75 70 29 20 73 6f 20 69 74 20 69 cleanup) so it i
64d0: 73 20 73 61 66 65 0a 3b 3b 20 74 6f 20 63 61 63 s safe.;; to cac
64e0: 68 65 20 74 68 65 20 72 65 73 75 6c 73 20 69 6e he the resuls in
64f0: 20 61 20 68 61 73 68 0a 3b 3b 0a 28 64 65 66 69 a hash.;;.(defi
6500: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 2d ne (rmt:get-key-
6510: 76 61 6c 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 vals run-id). (
6520: 6f 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 or (hash-table-r
6530: 65 66 2f 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 ef/default *keyv
6540: 61 6c 73 2a 20 72 75 6e 2d 69 64 20 23 66 29 0a als* run-id #f).
6550: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
6560: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
6570: 76 65 20 27 67 65 74 2d 6b 65 79 2d 76 61 6c 73 ve 'get-key-vals
6580: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 #f (list run-id
6590: 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 68 61 )))). (ha
65a0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 6b sh-table-set! *k
65b0: 65 79 76 61 6c 73 2a 20 72 75 6e 2d 69 64 20 72 eyvals* run-id r
65c0: 65 73 29 0a 20 20 20 20 20 20 20 20 72 65 73 29 es). res)
65d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
65e0: 3a 67 65 74 2d 74 61 72 67 65 74 73 29 0a 20 20 :get-targets).
65f0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
6600: 65 20 27 67 65 74 2d 74 61 72 67 65 74 73 20 23 e 'get-targets #
6610: 66 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 f '()))..(define
6620: 20 28 72 6d 74 3a 67 65 74 2d 74 61 72 67 65 74 (rmt:get-target
6630: 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a run-id). (rmt:
6640: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
6650: 74 2d 74 61 72 67 65 74 20 72 75 6e 2d 69 64 20 t-target run-id
6660: 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a (list run-id))).
6670: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
6680: 74 2d 72 75 6e 2d 74 69 6d 65 73 20 72 75 6e 70 t-run-times runp
6690: 61 74 74 20 74 61 72 67 65 74 70 61 74 74 29 0a att targetpatt).
66a0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
66b0: 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 74 69 6d ive 'get-run-tim
66c0: 65 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 es #f (list runp
66d0: 61 74 74 20 74 61 72 67 65 74 70 61 74 74 20 29 att targetpatt )
66e0: 29 29 20 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d )) ...;;========
66f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
6730: 3b 20 20 54 20 45 20 53 20 54 20 53 0a 3b 3b 3d ; T E S T S.;;=
6740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6780: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4a 75 73 74 20 73 =====..;; Just s
6790: 6f 6d 65 20 73 79 6e 74 61 74 69 63 20 73 75 67 ome syntatic sug
67a0: 61 72 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a ar.(define (rmt:
67b0: 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 72 75 register-test ru
67c0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
67d0: 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 72 6d 74 tem-path). (rmt
67e0: 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 72 :general-call 'r
67f0: 65 67 69 73 74 65 72 2d 74 65 73 74 20 72 75 6e egister-test run
6800: 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d -id run-id test-
6810: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
6820: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
6830: 65 74 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 et-test-id run-i
6840: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
6850: 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e path). (rmt:sen
6860: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 d-receive 'get-t
6870: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c est-id run-id (l
6880: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e ist run-id testn
6890: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
68a0: 0a 0a 3b 3b 20 72 75 6e 2d 69 64 20 69 73 20 4e ..;; run-id is N
68b0: 4f 54 20 75 73 65 64 0a 3b 3b 0a 28 64 65 66 69 OT used.;;.(defi
68c0: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 ne (rmt:get-test
68d0: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d -info-by-id run-
68e0: 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 69 id test-id). (i
68f0: 66 20 28 6e 75 6d 62 65 72 3f 20 74 65 73 74 2d f (number? test-
6900: 69 64 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 73 id). (rmt:s
6910: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
6920: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
6930: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
6940: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a 20 n-id test-id)).
6950: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 (begin..(de
6960: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
6970: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
6980: 57 41 52 4e 49 4e 47 3a 20 42 61 64 20 64 61 74 WARNING: Bad dat
6990: 61 20 68 61 6e 64 65 64 20 74 6f 20 72 6d 74 3a a handed to rmt:
69a0: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
69b0: 2d 69 64 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e -id run-id=" run
69c0: 2d 69 64 20 22 2c 20 74 65 73 74 2d 69 64 3d 22 -id ", test-id="
69d0: 20 74 65 73 74 2d 69 64 29 0a 09 28 70 72 69 6e test-id)..(prin
69e0: 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 75 t-call-chain (cu
69f0: 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 rrent-error-port
6a00: 29 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 ))..#f)))..(defi
6a10: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 ne (rmt:test-get
6a20: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 -rundir-from-tes
6a30: 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 t-id run-id test
6a40: 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 -id). (rmt:send
6a50: 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 67 -receive 'test-g
6a60: 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 et-rundir-from-t
6a70: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c est-id run-id (l
6a80: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
6a90: 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 id)))..(define (
6aa0: 72 6d 74 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 rmt:open-test-db
6ab0: 2d 62 79 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d -by-test-id run-
6ac0: 69 64 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 id test-id #!key
6ad0: 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 (work-area #f))
6ae0: 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d . (let* ((test-
6af0: 70 61 74 68 20 28 69 66 20 28 73 74 72 69 6e 67 path (if (string
6b00: 3f 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 ? work-area)....
6b10: 77 6f 72 6b 2d 61 72 65 61 0a 09 09 09 28 72 6d work-area....(rm
6b20: 74 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 t:test-get-rundi
6b30: 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 72 r-from-test-id r
6b40: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 un-id test-id)))
6b50: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
6b60: 6e 74 20 33 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 3 *default-lo
6b70: 67 2d 70 6f 72 74 2a 20 22 54 45 53 54 20 50 41 g-port* "TEST PA
6b80: 54 48 3a 20 22 20 74 65 73 74 2d 70 61 74 68 29 TH: " test-path)
6b90: 0a 20 20 20 20 28 6f 70 65 6e 2d 74 65 73 74 2d . (open-test-
6ba0: 64 62 20 74 65 73 74 2d 70 61 74 68 29 29 29 0a db test-path))).
6bb0: 0a 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 54 68 69 .;; WARNING: Thi
6bc0: 73 20 63 75 72 72 65 6e 74 6c 79 20 62 79 70 61 s currently bypa
6bd0: 73 73 65 73 20 74 68 65 20 74 72 61 6e 73 61 63 sses the transac
6be0: 74 69 6f 6e 20 77 72 61 70 70 65 64 20 77 72 69 tion wrapped wri
6bf0: 74 65 73 20 73 79 73 74 65 6d 0a 28 64 65 66 69 tes system.(defi
6c00: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 ne (rmt:test-set
6c10: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 -state-status-by
6c20: 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d -id run-id test-
6c30: 69 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 id newstate news
6c40: 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 tatus newcomment
6c50: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
6c60: 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 74 2d ceive 'test-set-
6c70: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d state-status-by-
6c80: 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 id run-id (list
6c90: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e run-id test-id n
6ca0: 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 ewstate newstatu
6cb0: 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 29 29 0a s newcomment))).
6cc0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 .(define (rmt:se
6cd0: 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 t-tests-state-st
6ce0: 61 74 75 73 20 72 75 6e 2d 69 64 20 20 20 20 20 atus run-id
6cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d00: 20 74 65 73 74 6e 61 6d 65 73 20 63 75 72 72 73 testnames currs
6d10: 74 61 74 65 20 63 75 72 72 73 74 61 74 75 73 20 tate currstatus
6d20: 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 newstate newstat
6d30: 75 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d us). (rmt:send-
6d40: 72 65 63 65 69 76 65 20 27 73 65 74 2d 74 65 73 receive 'set-tes
6d50: 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 ts-state-status
6d60: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
6d70: 2d 69 64 20 74 65 73 74 6e 61 6d 65 73 20 63 75 -id testnames cu
6d80: 72 72 73 74 61 74 65 20 63 75 72 72 73 74 61 74 rrstate currstat
6d90: 75 73 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 us newstate news
6da0: 74 61 74 75 73 29 29 29 0a 0a 28 64 65 66 69 6e tatus)))..(defin
6db0: 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 e (rmt:get-tests
6dc0: 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 -for-run run-id
6dd0: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
6de0: 73 74 61 74 75 73 65 73 20 6f 66 66 73 65 74 20 statuses offset
6df0: 6c 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 6f 72 limit not-in sor
6e00: 74 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 20 t-by sort-order
6e10: 71 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 70 64 qryvals last-upd
6e20: 61 74 65 20 6d 6f 64 65 29 0a 20 20 3b 3b 20 28 ate mode). ;; (
6e30: 69 66 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d if (number? run-
6e40: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
6e50: 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 receive 'get-tes
6e60: 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 ts-for-run run-i
6e70: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
6e80: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
6e90: 74 61 74 75 73 65 73 20 6f 66 66 73 65 74 20 6c tatuses offset l
6ea0: 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 6f 72 74 imit not-in sort
6eb0: 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 20 71 -by sort-order q
6ec0: 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 70 64 61 ryvals last-upda
6ed0: 74 65 20 6d 6f 64 65 29 29 29 0a 20 20 3b 3b 20 te mode))). ;;
6ee0: 20 20 20 28 62 65 67 69 6e 0a 20 20 3b 3b 09 28 (begin. ;;.(
6ef0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
6f00: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
6f10: 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 67 65 74 2d -port* "rmt:get-
6f20: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 63 61 tests-for-run ca
6f30: 6c 6c 65 64 20 77 69 74 68 20 62 61 64 20 72 75 lled with bad ru
6f40: 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 29 0a 20 n-id=" run-id).
6f50: 20 3b 3b 09 28 70 72 69 6e 74 2d 63 61 6c 6c 2d ;;.(print-call-
6f60: 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 chain (current-e
6f70: 72 72 6f 72 2d 70 6f 72 74 29 29 0a 20 20 3b 3b rror-port)). ;;
6f80: 09 27 28 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 .'())))..(define
6f90: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
6fa0: 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 for-run-state-st
6fb0: 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 atus run-id test
6fc0: 70 61 74 74 20 6c 61 73 74 2d 75 70 64 61 74 65 patt last-update
6fd0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
6fe0: 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 74 73 ceive 'get-tests
6ff0: 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 -for-run-state-s
7000: 74 61 74 75 73 20 72 75 6e 2d 69 64 20 28 6c 69 tatus run-id (li
7010: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 st run-id testpa
7020: 74 74 20 6c 61 73 74 2d 75 70 64 61 74 65 29 29 tt last-update))
7030: 29 0a 0a 3b 3b 20 67 65 74 20 73 74 75 66 66 20 )..;; get stuff
7040: 76 69 61 20 73 79 6e 63 68 61 73 68 20 0a 28 64 via synchash .(d
7050: 65 66 69 6e 65 20 28 72 6d 74 3a 73 79 6e 63 68 efine (rmt:synch
7060: 61 73 68 2d 67 65 74 20 72 75 6e 2d 69 64 20 70 ash-get run-id p
7070: 72 6f 63 20 73 79 6e 63 6b 65 79 20 6b 65 79 6e roc synckey keyn
7080: 75 6d 20 70 61 72 61 6d 73 29 0a 20 20 28 72 6d um params). (rm
7090: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
70a0: 73 79 6e 63 68 61 73 68 2d 67 65 74 20 72 75 6e synchash-get run
70b0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
70c0: 20 70 72 6f 63 20 73 79 6e 63 6b 65 79 20 6b 65 proc synckey ke
70d0: 79 6e 75 6d 20 70 61 72 61 6d 73 29 29 29 0a 0a ynum params)))..
70e0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
70f0: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d -tests-for-run-m
7100: 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 indata run-id te
7110: 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 stpatt states st
7120: 61 74 75 73 20 6e 6f 74 2d 69 6e 29 0a 20 20 28 atus not-in). (
7130: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7140: 20 27 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 'get-tests-for-
7150: 72 75 6e 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d run-mindata run-
7160: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 id (list run-id
7170: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
7180: 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 29 29 status not-in)))
7190: 0a 20 20 0a 3b 3b 20 49 44 45 41 3a 20 54 68 72 . .;; IDEA: Thr
71a0: 65 61 64 69 66 79 20 74 68 65 73 65 20 2d 20 74 eadify these - t
71b0: 68 65 79 20 73 70 65 6e 64 20 61 20 6c 6f 74 20 hey spend a lot
71c0: 6f 66 20 74 69 6d 65 20 77 61 69 74 69 6e 67 20 of time waiting
71d0: 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ....;;.(define (
71e0: 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f rmt:get-tests-fo
71f0: 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 r-runs-mindata r
7200: 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 un-ids testpatt
7210: 73 74 61 74 65 73 20 73 74 61 74 75 73 20 6e 6f states status no
7220: 74 2d 69 6e 29 0a 20 20 28 6c 65 74 20 28 28 6d t-in). (let ((m
7230: 75 6c 74 69 2d 72 75 6e 2d 6d 75 74 65 78 20 28 ulti-run-mutex (
7240: 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 09 28 72 make-mutex))..(r
7250: 75 6e 2d 69 64 2d 6c 69 73 74 20 28 69 66 20 72 un-id-list (if r
7260: 75 6e 2d 69 64 73 0a 09 09 09 20 72 75 6e 2d 69 un-ids.... run-i
7270: 64 73 0a 09 09 09 20 28 72 6d 74 3a 67 65 74 2d ds.... (rmt:get-
7280: 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 all-run-ids)))..
7290: 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 28 29 (result '()
72a0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
72b0: 3f 20 72 75 6e 2d 69 64 2d 6c 69 73 74 29 0a 09 ? run-id-list)..
72c0: 27 28 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 '()..(let loop (
72d0: 28 68 65 64 20 20 20 20 20 28 63 61 72 20 72 75 (hed (car ru
72e0: 6e 2d 69 64 2d 6c 69 73 74 29 29 0a 09 09 20 20 n-id-list))...
72f0: 20 28 74 61 6c 20 20 20 20 20 28 63 64 72 20 72 (tal (cdr r
7300: 75 6e 2d 69 64 2d 6c 69 73 74 29 29 0a 09 09 20 un-id-list))...
7310: 20 20 28 74 68 72 65 61 64 73 20 27 28 29 29 29 (threads '()))
7320: 0a 09 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 .. (if (> (leng
7330: 74 68 20 74 68 72 65 61 64 73 29 20 35 29 0a 09 th threads) 5)..
7340: 20 20 20 20 20 20 28 6c 6f 6f 70 20 68 65 64 20 (loop hed
7350: 74 61 6c 20 28 66 69 6c 74 65 72 20 28 6c 61 6d tal (filter (lam
7360: 62 64 61 20 28 74 68 29 28 6e 6f 74 20 28 6d 65 bda (th)(not (me
7370: 6d 62 65 72 20 28 74 68 72 65 61 64 2d 73 74 61 mber (thread-sta
7380: 74 65 20 74 68 29 20 27 28 74 65 72 6d 69 6e 61 te th) '(termina
7390: 74 65 64 20 64 65 61 64 29 29 29 29 20 74 68 72 ted dead)))) thr
73a0: 65 61 64 73 29 29 0a 09 20 20 20 20 20 20 28 6c eads)).. (l
73b0: 65 74 2a 20 28 28 6e 65 77 74 68 72 65 61 64 20 et* ((newthread
73c0: 28 6d 61 6b 65 2d 74 68 72 65 61 64 0a 09 09 09 (make-thread....
73d0: 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 . (lambda ()....
73e0: 09 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 . (let ((res (
73f0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7400: 20 27 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 'get-tests-for-
7410: 72 75 6e 2d 6d 69 6e 64 61 74 61 20 68 65 64 20 run-mindata hed
7420: 28 6c 69 73 74 20 68 65 64 20 74 65 73 74 70 61 (list hed testpa
7430: 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 tt states status
7440: 20 6e 6f 74 2d 69 6e 29 29 29 29 0a 09 09 09 09 not-in)))).....
7450: 20 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 (if (list?
7460: 72 65 73 29 0a 09 09 09 09 09 20 28 62 65 67 69 res)...... (begi
7470: 6e 0a 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 n...... (mutex
7480: 2d 6c 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 75 6e -lock! multi-run
7490: 2d 6d 75 74 65 78 29 0a 09 09 09 09 09 20 20 20 -mutex)......
74a0: 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 61 70 (set! result (ap
74b0: 70 65 6e 64 20 72 65 73 75 6c 74 20 72 65 73 29 pend result res)
74c0: 29 0a 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 )...... (mutex
74d0: 2d 75 6e 6c 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 -unlock! multi-r
74e0: 75 6e 2d 6d 75 74 65 78 29 29 0a 09 09 09 09 09 un-mutex))......
74f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
7500: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
7510: 6f 67 2d 70 6f 72 74 2a 20 22 67 65 74 2d 74 65 og-port* "get-te
7520: 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 sts-for-run-mind
7530: 61 74 61 20 66 61 69 6c 65 64 20 66 6f 72 20 72 ata failed for r
7540: 75 6e 2d 69 64 20 22 20 68 65 64 20 22 2c 20 74 un-id " hed ", t
7550: 65 73 74 70 61 74 74 20 22 20 74 65 73 74 70 61 estpatt " testpa
7560: 74 74 20 22 2c 20 73 74 61 74 65 73 20 22 20 73 tt ", states " s
7570: 74 61 74 65 73 20 22 2c 20 73 74 61 74 75 73 20 tates ", status
7580: 22 20 73 74 61 74 75 73 20 22 2c 20 6e 6f 74 2d " status ", not-
7590: 69 6e 20 22 20 6e 6f 74 2d 69 6e 29 29 29 29 0a in " not-in)))).
75a0: 09 09 09 09 20 28 63 6f 6e 63 20 22 6d 75 6c 74 .... (conc "mult
75b0: 69 2d 72 75 6e 2d 74 68 72 65 61 64 20 66 6f 72 i-run-thread for
75c0: 20 72 75 6e 2d 69 64 20 22 20 68 65 64 29 29 29 run-id " hed)))
75d0: 0a 09 09 20 20 20 20 20 28 6e 65 77 74 68 72 65 ... (newthre
75e0: 61 64 73 20 28 63 6f 6e 73 20 6e 65 77 74 68 72 ads (cons newthr
75f0: 65 61 64 20 74 68 72 65 61 64 73 29 29 29 0a 09 ead threads)))..
7600: 09 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 .(thread-start!
7610: 6e 65 77 74 68 72 65 61 64 29 0a 09 09 28 74 68 newthread)...(th
7620: 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 35 read-sleep! 0.05
7630: 29 20 3b 3b 20 67 69 76 65 20 74 68 61 74 20 74 ) ;; give that t
7640: 68 72 65 61 64 20 73 6f 6d 65 20 74 69 6d 65 20 hread some time
7650: 74 6f 20 73 74 61 72 74 0a 09 09 28 69 66 20 28 to start...(if (
7660: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 20 null? tal)...
7670: 20 6e 65 77 74 68 72 65 61 64 73 0a 09 09 20 20 newthreads...
7680: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
7690: 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 74 68 )(cdr tal) newth
76a0: 72 65 61 64 73 29 29 29 29 29 29 0a 20 20 20 20 reads)))))).
76b0: 72 65 73 75 6c 74 29 29 0a 0a 3b 3b 20 3b 3b 20 result))..;; ;;
76c0: 49 44 45 41 3a 20 54 68 72 65 61 64 69 66 79 20 IDEA: Threadify
76d0: 74 68 65 73 65 20 2d 20 74 68 65 79 20 73 70 65 these - they spe
76e0: 6e 64 20 61 20 6c 6f 74 20 6f 66 20 74 69 6d 65 nd a lot of time
76f0: 20 77 61 69 74 69 6e 67 20 2e 2e 2e 0a 3b 3b 20 waiting ....;;
7700: 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 72 ;;.;; (define (r
7710: 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 mt:get-tests-for
7720: 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 -runs-mindata ru
7730: 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 n-ids testpatt s
7740: 74 61 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 tates status not
7750: 2d 69 6e 29 0a 3b 3b 20 20 20 28 6c 65 74 20 28 -in).;; (let (
7760: 28 72 75 6e 2d 69 64 2d 6c 69 73 74 20 28 69 66 (run-id-list (if
7770: 20 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 09 09 20 run-ids.;; ...
7780: 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 09 09 20 28 run-ids.;; ... (
7790: 72 6d 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d rmt:get-all-run-
77a0: 69 64 73 29 29 29 29 0a 3b 3b 20 20 20 20 20 28 ids)))).;; (
77b0: 61 70 70 6c 79 20 61 70 70 65 6e 64 20 28 6d 61 apply append (ma
77c0: 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 p (lambda (run-i
77d0: 64 29 0a 3b 3b 20 09 09 09 20 28 72 6d 74 3a 73 d).;; ... (rmt:s
77e0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
77f0: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d -tests-for-run-m
7800: 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 20 28 6c indata run-id (l
7810: 69 73 74 20 72 75 6e 2d 69 64 73 20 74 65 73 74 ist run-ids test
7820: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
7830: 75 73 20 6e 6f 74 2d 69 6e 29 29 29 0a 3b 3b 20 us not-in))).;;
7840: 09 09 20 20 20 20 20 20 20 72 75 6e 2d 69 64 2d .. run-id-
7850: 6c 69 73 74 29 29 29 29 0a 0a 28 64 65 66 69 6e list))))..(defin
7860: 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d 74 65 e (rmt:delete-te
7870: 73 74 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 st-records run-i
7880: 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d d test-id). (rm
7890: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
78a0: 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f delete-test-reco
78b0: 72 64 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 rds run-id (list
78c0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
78d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
78e0: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d :test-set-state-
78f0: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 status run-id te
7900: 73 74 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 st-id state stat
7910: 75 73 20 6d 73 67 29 0a 20 20 28 72 6d 74 3a 73 us msg). (rmt:s
7920: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 end-receive 'tes
7930: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
7940: 75 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 us run-id (list
7950: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
7960: 74 61 74 65 20 73 74 61 74 75 73 20 6d 73 67 29 tate status msg)
7970: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
7980: 3a 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e :test-toplevel-n
7990: 75 6d 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 um-items run-id
79a0: 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 72 6d test-name). (rm
79b0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
79c0: 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 test-toplevel-nu
79d0: 6d 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 28 m-items run-id (
79e0: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
79f0: 2d 6e 61 6d 65 29 29 29 0a 0a 3b 3b 20 28 64 65 -name)))..;; (de
7a00: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 70 72 fine (rmt:get-pr
7a10: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
7a20: 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 20 74 65 record run-id te
7a30: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
7a40: 68 29 0a 3b 3b 20 20 20 28 72 6d 74 3a 73 65 6e h).;; (rmt:sen
7a50: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 70 d-receive 'get-p
7a60: 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e revious-test-run
7a70: 2d 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 20 28 -record run-id (
7a80: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
7a90: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
7aa0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
7ab0: 3a 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d 70 72 :get-matching-pr
7ac0: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
7ad0: 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 74 records run-id t
7ae0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
7af0: 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d th). (rmt:send-
7b00: 72 65 63 65 69 76 65 20 27 67 65 74 2d 6d 61 74 receive 'get-mat
7b10: 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 ching-previous-t
7b20: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 est-run-records
7b30: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
7b40: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
7b50: 65 6d 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 em-path)))..(def
7b60: 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 ine (rmt:test-ge
7b70: 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 72 t-logfile-info r
7b80: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 un-id test-name)
7b90: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
7ba0: 65 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d 6c eive 'test-get-l
7bb0: 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 72 75 6e 2d ogfile-info run-
7bc0: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 id (list run-id
7bd0: 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 0a 28 64 test-name)))..(d
7be0: 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d efine (rmt:test-
7bf0: 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d get-records-for-
7c00: 69 6e 64 65 78 2d 66 69 6c 65 20 72 75 6e 2d 69 index-file run-i
7c10: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 d test-name). (
7c20: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7c30: 20 27 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 'test-get-recor
7c40: 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c ds-for-index-fil
7c50: 65 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 e run-id (list r
7c60: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 un-id test-name)
7c70: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
7c80: 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 :get-testinfo-st
7c90: 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 ate-status run-i
7ca0: 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d d test-id). (rm
7cb0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
7cc0: 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 get-testinfo-sta
7cd0: 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 te-status run-id
7ce0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
7cf0: 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e st-id)))..(defin
7d00: 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d e (rmt:test-set-
7d10: 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 log! run-id test
7d20: 2d 69 64 20 6c 6f 67 66 29 0a 20 20 28 69 66 20 -id logf). (if
7d30: 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 29 28 72 (string? logf)(r
7d40: 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 mt:general-call
7d50: 27 74 65 73 74 2d 73 65 74 2d 6c 6f 67 20 72 75 'test-set-log ru
7d60: 6e 2d 69 64 20 6c 6f 67 66 20 74 65 73 74 2d 69 n-id logf test-i
7d70: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
7d80: 6d 74 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d mt:test-set-top-
7d90: 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d process-pid run-
7da0: 69 64 20 74 65 73 74 2d 69 64 20 70 69 64 29 0a id test-id pid).
7db0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
7dc0: 69 76 65 20 27 74 65 73 74 2d 73 65 74 2d 74 6f ive 'test-set-to
7dd0: 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 p-process-pid ru
7de0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
7df0: 64 20 74 65 73 74 2d 69 64 20 70 69 64 29 29 29 d test-id pid)))
7e00: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
7e10: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
7e20: 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 ess-pid run-id t
7e30: 65 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 est-id). (rmt:s
7e40: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 end-receive 'tes
7e50: 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 t-get-top-proces
7e60: 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 s-pid run-id (li
7e70: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
7e80: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
7e90: 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d mt:get-run-ids-m
7ea0: 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 20 6b atching-target k
7eb0: 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 72 eynames target r
7ec0: 65 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 70 es runname testp
7ed0: 61 74 74 20 73 74 61 74 65 70 61 74 74 20 73 74 att statepatt st
7ee0: 61 74 75 73 70 61 74 74 29 0a 20 20 28 72 6d 74 atuspatt). (rmt
7ef0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
7f00: 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 et-run-ids-match
7f10: 69 6e 67 2d 74 61 72 67 65 74 20 23 66 20 28 6c ing-target #f (l
7f20: 69 73 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 ist keynames tar
7f30: 67 65 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 get res runname
7f40: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 70 61 testpatt statepa
7f50: 74 74 20 73 74 61 74 75 73 70 61 74 74 29 29 29 tt statuspatt)))
7f60: 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 69 73 20 ..;; NOTE: This
7f70: 77 69 6c 6c 20 6f 70 65 6e 20 61 6e 64 20 61 63 will open and ac
7f80: 63 65 73 73 20 41 4c 4c 20 72 75 6e 20 64 61 74 cess ALL run dat
7f90: 61 62 61 73 65 73 2e 20 0a 3b 3b 0a 28 64 65 66 abases. .;;.(def
7fa0: 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 ine (rmt:test-ge
7fb0: 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 t-paths-matching
7fc0: 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 -keynames-target
7fd0: 2d 6e 65 77 20 6b 65 79 6e 61 6d 65 73 20 74 61 -new keynames ta
7fe0: 72 67 65 74 20 72 65 73 20 74 65 73 74 70 61 74 rget res testpat
7ff0: 74 20 73 74 61 74 65 70 61 74 74 20 73 74 61 74 t statepatt stat
8000: 75 73 70 61 74 74 20 72 75 6e 6e 61 6d 65 29 0a uspatt runname).
8010: 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 73 (let ((run-ids
8020: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 64 (rmt:get-run-id
8030: 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 s-matching-targe
8040: 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 t keynames targe
8050: 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 74 65 t res runname te
8060: 73 74 70 61 74 74 20 73 74 61 74 65 70 61 74 74 stpatt statepatt
8070: 20 73 74 61 74 75 73 70 61 74 74 29 29 29 0a 20 statuspatt))).
8080: 20 20 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 (apply append
8090: 20 0a 09 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 .. (map (lamb
80a0: 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 09 20 20 da (run-id)...
80b0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
80c0: 65 20 27 74 65 73 74 2d 67 65 74 2d 70 61 74 68 e 'test-get-path
80d0: 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 s-matching-keyna
80e0: 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 20 72 mes-target-new r
80f0: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
8100: 69 64 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 id keynames targ
8110: 65 74 20 72 65 73 20 74 65 73 74 70 61 74 74 20 et res testpatt
8120: 73 74 61 74 65 70 61 74 74 20 73 74 61 74 75 73 statepatt status
8130: 70 61 74 74 20 72 75 6e 6e 61 6d 65 29 29 29 0a patt runname))).
8140: 09 20 20 20 72 75 6e 2d 69 64 73 29 29 29 29 0a . run-ids)))).
8150: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
8160: 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 t-prereqs-not-me
8170: 74 20 72 75 6e 2d 69 64 20 77 61 69 74 6f 6e 73 t run-id waitons
8180: 20 72 65 66 2d 74 65 73 74 2d 6e 61 6d 65 20 72 ref-test-name r
8190: 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 23 21 6b ef-item-path #!k
81a0: 65 79 20 28 6d 6f 64 65 20 27 28 6e 6f 72 6d 61 ey (mode '(norma
81b0: 6c 29 29 28 69 74 65 6d 6d 61 70 73 20 23 66 29 l))(itemmaps #f)
81c0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
81d0: 63 65 69 76 65 20 27 67 65 74 2d 70 72 65 72 65 ceive 'get-prere
81e0: 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 6e 2d 69 qs-not-met run-i
81f0: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 77 d (list run-id w
8200: 61 69 74 6f 6e 73 20 72 65 66 2d 74 65 73 74 2d aitons ref-test-
8210: 6e 61 6d 65 20 72 65 66 2d 69 74 65 6d 2d 70 61 name ref-item-pa
8220: 74 68 20 6d 6f 64 65 20 69 74 65 6d 6d 61 70 73 th mode itemmaps
8230: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
8240: 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 t:get-count-test
8250: 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 s-running-for-ru
8260: 6e 2d 69 64 20 72 75 6e 2d 69 64 20 66 61 73 74 n-id run-id fast
8270: 6d 6f 64 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e mode). (rmt:sen
8280: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 63 d-receive 'get-c
8290: 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 ount-tests-runni
82a0: 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 72 75 ng-for-run-id ru
82b0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
82c0: 64 20 66 61 73 74 6d 6f 64 65 29 29 29 0a 0a 28 d fastmode)))..(
82d0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
82e0: 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e not-completed-cn
82f0: 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 t run-id). (rmt
8300: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
8310: 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 et-not-completed
8320: 2d 63 6e 74 20 72 75 6e 2d 69 64 20 28 6c 69 73 -cnt run-id (lis
8330: 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 0a 3b 3b t run-id)))...;;
8340: 20 53 74 61 74 69 73 74 69 63 61 6c 20 71 75 65 Statistical que
8350: 72 69 65 73 0a 0a 28 64 65 66 69 6e 65 20 28 72 ries..(define (r
8360: 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 mt:get-count-tes
8370: 74 73 2d 72 75 6e 6e 69 6e 67 20 72 75 6e 2d 69 ts-running run-i
8380: 64 20 66 61 73 74 6d 6f 64 65 29 0a 20 20 28 72 d fastmode). (r
8390: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
83a0: 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 'get-count-tests
83b0: 2d 72 75 6e 6e 69 6e 67 20 72 75 6e 2d 69 64 20 -running run-id
83c0: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 66 61 73 (list run-id fas
83d0: 74 6d 6f 64 65 29 29 29 0a 0a 28 64 65 66 69 6e tmode)))..(defin
83e0: 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 e (rmt:get-count
83f0: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 -tests-running-f
8400: 6f 72 2d 74 65 73 74 6e 61 6d 65 20 72 75 6e 2d or-testname run-
8410: 69 64 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 id testname). (
8420: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
8430: 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 'get-count-test
8440: 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 74 65 s-running-for-te
8450: 73 74 6e 61 6d 65 20 72 75 6e 2d 69 64 20 28 6c stname run-id (l
8460: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e ist run-id testn
8470: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
8480: 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 (rmt:get-count-t
8490: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d ests-running-in-
84a0: 6a 6f 62 67 72 6f 75 70 20 72 75 6e 2d 69 64 20 jobgroup run-id
84b0: 6a 6f 62 67 72 6f 75 70 29 0a 20 20 28 72 6d 74 jobgroup). (rmt
84c0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
84d0: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
84e0: 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f unning-in-jobgro
84f0: 75 70 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 up run-id (list
8500: 72 75 6e 2d 69 64 20 6a 6f 62 67 72 6f 75 70 29 run-id jobgroup)
8510: 29 29 0a 0a 3b 3b 20 73 74 61 74 65 20 61 6e 64 ))..;; state and
8520: 20 73 74 61 74 75 73 20 61 72 65 20 65 78 74 72 status are extr
8530: 61 20 68 69 6e 74 73 20 6e 6f 74 20 75 73 75 61 a hints not usua
8540: 6c 6c 79 20 75 73 65 64 20 69 6e 20 74 68 65 20 lly used in the
8550: 63 61 6c 63 75 6c 61 74 69 6f 6e 0a 3b 3b 0a 28 calculation.;;.(
8560: 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d define (rmt:set-
8570: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 state-status-and
8580: 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 72 -roll-up-items r
8590: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
85a0: 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 65 20 item-path state
85b0: 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 0a status comment).
85c0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
85d0: 69 76 65 20 27 73 65 74 2d 73 74 61 74 65 2d 73 ive 'set-state-s
85e0: 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 tatus-and-roll-u
85f0: 70 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 28 p-items run-id (
8600: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
8610: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
8620: 73 74 61 74 65 20 73 74 61 74 75 73 20 63 6f 6d state status com
8630: 6d 65 6e 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 ment)))..(define
8640: 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 65 2d (rmt:set-state-
8650: 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d status-and-roll-
8660: 75 70 2d 72 75 6e 20 72 75 6e 2d 69 64 20 73 74 up-run run-id st
8670: 61 74 65 20 73 74 61 74 75 73 29 0a 20 20 28 72 ate status). (r
8680: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8690: 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 'set-state-statu
86a0: 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 s-and-roll-up-ru
86b0: 6e 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 n run-id (list r
86c0: 75 6e 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 un-id state stat
86d0: 75 73 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 us)))...(define
86e0: 28 72 6d 74 3a 75 70 64 61 74 65 2d 70 61 73 73 (rmt:update-pass
86f0: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 6e -fail-counts run
8700: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 -id test-name).
8710: 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 (rmt:general-ca
8720: 6c 6c 20 27 75 70 64 61 74 65 2d 70 61 73 73 2d ll 'update-pass-
8730: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 6e 2d fail-counts run-
8740: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 id test-name tes
8750: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 t-name test-name
8760: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
8770: 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 :top-test-set-pe
8780: 72 2d 70 66 2d 63 6f 75 6e 74 73 20 72 75 6e 2d r-pf-counts run-
8790: 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 id test-name).
87a0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
87b0: 65 20 27 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d e 'top-test-set-
87c0: 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 72 75 per-pf-counts ru
87d0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
87e0: 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 0a d test-name)))..
87f0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
8800: 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 72 -raw-run-stats r
8810: 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 un-id). (rmt:se
8820: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
8830: 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 raw-run-stats ru
8840: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
8850: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
8860: 6d 74 3a 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 mt:get-test-time
8870: 73 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 s runname target
8880: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
8890: 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 74 2d ceive 'get-test-
88a0: 74 69 6d 65 73 20 23 66 20 28 6c 69 73 74 20 72 times #f (list r
88b0: 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 20 29 29 unname target ))
88c0: 29 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ) ..;;==========
88d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
88e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
88f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
8910: 20 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d R U N S.;;=====
8920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8960: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a =..(define (rmt:
8970: 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 75 6e get-run-info run
8980: 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 -id). (rmt:send
8990: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 -receive 'get-ru
89a0: 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 28 6c n-info run-id (l
89b0: 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 ist run-id)))..(
89c0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
89d0: 6e 75 6d 2d 72 75 6e 73 20 72 75 6e 70 61 74 74 num-runs runpatt
89e0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
89f0: 63 65 69 76 65 20 27 67 65 74 2d 6e 75 6d 2d 72 ceive 'get-num-r
8a00: 75 6e 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e uns #f (list run
8a10: 70 61 74 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 patt)))..(define
8a20: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 63 (rmt:get-runs-c
8a30: 6e 74 2d 62 79 2d 70 61 74 74 20 72 75 6e 70 61 nt-by-patt runpa
8a40: 74 74 20 74 61 72 67 65 74 70 61 74 74 20 6b 65 tt targetpatt ke
8a50: 79 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ys). (rmt:send-
8a60: 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e receive 'get-run
8a70: 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 23 66 s-cnt-by-patt #f
8a80: 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 20 20 (list runpatt
8a90: 74 61 72 67 65 74 70 61 74 74 20 6b 65 79 73 29 targetpatt keys)
8aa0: 29 29 0a 0a 3b 3b 20 55 73 65 20 74 68 65 20 73 ))..;; Use the s
8ab0: 70 65 63 69 61 6c 20 72 75 6e 2d 69 64 20 3d 3d pecial run-id ==
8ac0: 20 23 66 20 73 63 65 6e 61 72 69 6f 20 68 65 72 #f scenario her
8ad0: 65 20 73 69 6e 63 65 20 74 68 65 72 65 20 69 73 e since there is
8ae0: 20 6e 6f 20 72 75 6e 20 79 65 74 0a 28 64 65 66 no run yet.(def
8af0: 69 6e 65 20 28 72 6d 74 3a 72 65 67 69 73 74 65 ine (rmt:registe
8b00: 72 2d 72 75 6e 20 6b 65 79 76 61 6c 73 20 72 75 r-run keyvals ru
8b10: 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 nname state stat
8b20: 75 73 20 75 73 65 72 20 63 6f 6e 74 6f 75 72 29 us user contour)
8b30: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
8b40: 65 69 76 65 20 27 72 65 67 69 73 74 65 72 2d 72 eive 'register-r
8b50: 75 6e 20 23 66 20 28 6c 69 73 74 20 6b 65 79 76 un #f (list keyv
8b60: 61 6c 73 20 72 75 6e 6e 61 6d 65 20 73 74 61 74 als runname stat
8b70: 65 20 73 74 61 74 75 73 20 75 73 65 72 20 63 6f e status user co
8b80: 6e 74 6f 75 72 29 29 29 0a 20 20 20 20 0a 28 64 ntour))). .(d
8b90: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 efine (rmt:get-r
8ba0: 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 un-name-from-id
8bb0: 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 run-id). (rmt:s
8bc0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
8bd0: 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 -run-name-from-i
8be0: 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 d run-id (list r
8bf0: 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e un-id)))..(defin
8c00: 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d 72 75 e (rmt:delete-ru
8c10: 6e 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 n run-id). (rmt
8c20: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 :send-receive 'd
8c30: 65 6c 65 74 65 2d 72 75 6e 20 72 75 6e 2d 69 64 elete-run run-id
8c40: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
8c50: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 75 ..(define (rmt:u
8c60: 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 20 pdate-run-stats
8c70: 72 75 6e 2d 69 64 20 73 74 61 74 73 29 0a 20 20 run-id stats).
8c80: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
8c90: 65 20 27 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 e 'update-run-st
8ca0: 61 74 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e ats #f (list run
8cb0: 2d 69 64 20 73 74 61 74 73 29 29 29 0a 0a 28 64 -id stats)))..(d
8cc0: 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 efine (rmt:delet
8cd0: 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 e-old-deleted-te
8ce0: 73 74 2d 72 65 63 6f 72 64 73 29 0a 20 20 28 72 st-records). (r
8cf0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8d00: 27 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 'delete-old-dele
8d10: 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 ted-test-records
8d20: 20 23 66 20 27 28 29 29 29 0a 0a 28 64 65 66 69 #f '()))..(defi
8d30: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 ne (rmt:get-runs
8d40: 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f runpatt count o
8d50: 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 29 0a ffset keypatts).
8d60: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
8d70: 69 76 65 20 27 67 65 74 2d 72 75 6e 73 20 23 66 ive 'get-runs #f
8d80: 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 20 63 (list runpatt c
8d90: 6f 75 6e 74 20 6f 66 66 73 65 74 20 6b 65 79 70 ount offset keyp
8da0: 61 74 74 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 atts)))..(define
8db0: 20 28 72 6d 74 3a 73 69 6d 70 6c 65 2d 67 65 74 (rmt:simple-get
8dc0: 2d 72 75 6e 73 20 72 75 6e 70 61 74 74 20 63 6f -runs runpatt co
8dd0: 75 6e 74 20 6f 66 66 73 65 74 20 74 61 72 67 65 unt offset targe
8de0: 74 20 6c 61 73 74 2d 75 70 64 61 74 65 29 0a 20 t last-update).
8df0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
8e00: 76 65 20 27 73 69 6d 70 6c 65 2d 67 65 74 2d 72 ve 'simple-get-r
8e10: 75 6e 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e uns #f (list run
8e20: 70 61 74 74 20 63 6f 75 6e 74 20 6f 66 66 73 65 patt count offse
8e30: 74 20 74 61 72 67 65 74 20 6c 61 73 74 2d 75 70 t target last-up
8e40: 64 61 74 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 date)))..(define
8e50: 20 28 72 6d 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 (rmt:get-all-ru
8e60: 6e 2d 69 64 73 29 0a 20 20 28 72 6d 74 3a 73 65 n-ids). (rmt:se
8e70: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
8e80: 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 23 66 20 27 all-run-ids #f '
8e90: 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 ()))..(define (r
8ea0: 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d mt:get-prev-run-
8eb0: 69 64 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 ids run-id). (r
8ec0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8ed0: 27 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 'get-prev-run-id
8ee0: 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 s #f (list run-i
8ef0: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
8f00: 6d 74 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 mt:lock/unlock-r
8f10: 75 6e 20 72 75 6e 2d 69 64 20 6c 6f 63 6b 20 75 un run-id lock u
8f20: 6e 6c 6f 63 6b 20 75 73 65 72 29 0a 20 20 28 72 nlock user). (r
8f30: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8f40: 27 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 'lock/unlock-run
8f50: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 #f (list run-id
8f60: 20 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 lock unlock use
8f70: 72 29 29 29 0a 0a 3b 3b 20 73 65 74 2f 67 65 74 r)))..;; set/get
8f80: 20 73 74 61 74 75 73 0a 28 64 65 66 69 6e 65 20 status.(define
8f90: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 (rmt:get-run-sta
8fa0: 74 75 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 tus run-id). (r
8fb0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
8fc0: 27 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 'get-run-status
8fd0: 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 #f (list run-id)
8fe0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
8ff0: 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 65 20 72 :get-run-state r
9000: 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 un-id). (rmt:se
9010: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
9020: 72 75 6e 2d 73 74 61 74 65 20 23 66 20 28 6c 69 run-state #f (li
9030: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 0a 28 st run-id)))...(
9040: 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d define (rmt:set-
9050: 72 75 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 run-status run-i
9060: 64 20 72 75 6e 2d 73 74 61 74 75 73 20 23 21 6b d run-status #!k
9070: 65 79 20 28 6d 73 67 20 23 66 29 29 0a 20 20 28 ey (msg #f)). (
9080: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
9090: 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 'set-run-status
90a0: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 #f (list run-id
90b0: 20 72 75 6e 2d 73 74 61 74 75 73 20 6d 73 67 29 run-status msg)
90c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
90d0: 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 65 2d 73 :set-run-state-s
90e0: 74 61 74 75 73 20 72 75 6e 2d 69 64 20 73 74 61 tatus run-id sta
90f0: 74 65 20 73 74 61 74 75 73 20 29 0a 20 20 28 72 te status ). (r
9100: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
9110: 27 73 65 74 2d 72 75 6e 2d 73 74 61 74 65 2d 73 'set-run-state-s
9120: 74 61 74 75 73 20 23 66 20 28 6c 69 73 74 20 72 tatus #f (list r
9130: 75 6e 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 un-id state stat
9140: 75 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 us)))..(define (
9150: 72 6d 74 3a 75 70 64 61 74 65 2d 74 65 73 64 61 rmt:update-tesda
9160: 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 65 2d ta-on-repilcate-
9170: 64 62 20 6f 6c 64 2d 6c 74 20 6e 65 77 2d 6c 74 db old-lt new-lt
9180: 29 0a 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 ).(rmt:send-rece
9190: 69 76 65 20 27 75 70 64 61 74 65 2d 74 65 73 64 ive 'update-tesd
91a0: 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 65 ata-on-repilcate
91b0: 2d 64 62 20 23 66 20 28 6c 69 73 74 20 6f 6c 64 -db #f (list old
91c0: 2d 6c 74 20 6e 65 77 2d 6c 74 29 29 29 0a 0a 28 -lt new-lt)))..(
91d0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 75 70 64 61 define (rmt:upda
91e0: 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d te-run-event_tim
91f0: 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 e run-id). (rmt
9200: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 75 :send-receive 'u
9210: 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f pdate-run-event_
9220: 74 69 6d 65 20 23 66 20 28 6c 69 73 74 20 72 75 time #f (list ru
9230: 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 n-id)))..(define
9240: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 (rmt:get-runs-b
9250: 79 2d 70 61 74 74 20 20 6b 65 79 73 20 72 75 6e y-patt keys run
9260: 6e 61 6d 65 70 61 74 74 20 74 61 72 67 70 61 74 namepatt targpat
9270: 74 20 6f 66 66 73 65 74 20 6c 69 6d 69 74 20 66 t offset limit f
9280: 69 65 6c 64 73 20 6c 61 73 74 2d 72 75 6e 73 2d ields last-runs-
9290: 75 70 64 61 74 65 20 20 23 21 6b 65 79 20 20 28 update #!key (
92a0: 73 6f 72 74 2d 6f 72 64 65 72 20 22 61 73 63 22 sort-order "asc"
92b0: 29 29 20 3b 3b 20 66 69 65 6c 64 73 20 6f 66 20 )) ;; fields of
92c0: 23 66 20 75 73 65 73 20 64 65 66 61 75 6c 74 0a #f uses default.
92d0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
92e0: 69 76 65 20 27 67 65 74 2d 72 75 6e 73 2d 62 79 ive 'get-runs-by
92f0: 2d 70 61 74 74 20 23 66 20 28 6c 69 73 74 20 6b -patt #f (list k
9300: 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 eys runnamepatt
9310: 74 61 72 67 70 61 74 74 20 6f 66 66 73 65 74 20 targpatt offset
9320: 6c 69 6d 69 74 20 66 69 65 6c 64 73 20 6c 61 73 limit fields las
9330: 74 2d 72 75 6e 73 2d 75 70 64 61 74 65 20 73 6f t-runs-update so
9340: 72 74 2d 6f 72 64 65 72 29 29 29 0a 0a 28 64 65 rt-order)))..(de
9350: 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e 64 2d 61 fine (rmt:find-a
9360: 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 nd-mark-incomple
9370: 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 2d 64 65 te run-id ovr-de
9380: 61 64 74 69 6d 65 29 0a 20 20 3b 3b 20 28 69 66 adtime). ;; (if
9390: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
93a0: 76 65 20 27 68 61 76 65 2d 69 6e 63 6f 6d 70 6c ve 'have-incompl
93b0: 65 74 65 73 3f 20 72 75 6e 2d 69 64 20 28 6c 69 etes? run-id (li
93c0: 73 74 20 72 75 6e 2d 69 64 20 6f 76 72 2d 64 65 st run-id ovr-de
93d0: 61 64 74 69 6d 65 29 29 0a 20 20 28 72 6d 74 3a adtime)). (rmt:
93e0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6d 61 send-receive 'ma
93f0: 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 72 75 rk-incomplete ru
9400: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
9410: 64 20 6f 76 72 2d 64 65 61 64 74 69 6d 65 29 29 d ovr-deadtime))
9420: 29 20 3b 3b 20 29 0a 0a 28 64 65 66 69 6e 65 20 ) ;; )..(define
9430: 28 72 6d 74 3a 67 65 74 2d 6d 61 69 6e 2d 72 75 (rmt:get-main-ru
9440: 6e 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 29 0a n-stats run-id).
9450: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
9460: 69 76 65 20 27 67 65 74 2d 6d 61 69 6e 2d 72 75 ive 'get-main-ru
9470: 6e 2d 73 74 61 74 73 20 23 66 20 28 6c 69 73 74 n-stats #f (list
9480: 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 run-id)))..(def
9490: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 76 61 72 ine (rmt:get-var
94a0: 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 varname). (rmt
94b0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
94c0: 65 74 2d 76 61 72 20 23 66 20 28 6c 69 73 74 20 et-var #f (list
94d0: 76 61 72 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 varname)))..(def
94e0: 69 6e 65 20 28 72 6d 74 3a 64 65 6c 2d 76 61 72 ine (rmt:del-var
94f0: 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 varname). (rmt
9500: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 :send-receive 'd
9510: 65 6c 2d 76 61 72 20 23 66 20 28 6c 69 73 74 20 el-var #f (list
9520: 76 61 72 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 varname)))..(def
9530: 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d 76 61 72 ine (rmt:set-var
9540: 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 29 0a varname value).
9550: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
9560: 69 76 65 20 27 73 65 74 2d 76 61 72 20 23 66 20 ive 'set-var #f
9570: 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 20 76 61 (list varname va
9580: 6c 75 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 lue)))..(define
9590: 28 72 6d 74 3a 69 6e 63 2d 76 61 72 20 76 61 72 (rmt:inc-var var
95a0: 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e name). (rmt:sen
95b0: 64 2d 72 65 63 65 69 76 65 20 27 69 6e 63 2d 76 d-receive 'inc-v
95c0: 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 72 6e ar #f (list varn
95d0: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
95e0: 28 72 6d 74 3a 64 65 63 2d 76 61 72 20 76 61 72 (rmt:dec-var var
95f0: 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e name). (rmt:sen
9600: 64 2d 72 65 63 65 69 76 65 20 27 64 65 63 2d 76 d-receive 'dec-v
9610: 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 72 6e ar #f (list varn
9620: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
9630: 28 72 6d 74 3a 61 64 64 2d 76 61 72 20 76 61 72 (rmt:add-var var
9640: 6e 61 6d 65 20 76 61 6c 75 65 29 0a 20 20 28 72 name value). (r
9650: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
9660: 27 61 64 64 2d 76 61 72 20 23 66 20 28 6c 69 73 'add-var #f (lis
9670: 74 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 29 t varname value)
9680: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
9690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
96d0: 4d 20 55 20 4c 20 54 20 49 20 52 20 55 20 4e 20 M U L T I R U N
96e0: 20 20 51 20 55 20 45 20 52 20 49 20 45 20 53 0a Q U E R I E S.
96f0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9730: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 65 65 ========..;; Nee
9740: 64 20 74 6f 20 6d 6f 76 65 20 74 68 69 73 20 74 d to move this t
9750: 6f 20 6d 75 6c 74 69 2d 72 75 6e 20 73 65 63 74 o multi-run sect
9760: 69 6f 6e 20 61 6e 64 20 6d 61 6b 65 20 61 73 73 ion and make ass
9770: 6f 63 69 61 74 65 64 20 63 68 61 6e 67 65 73 0a ociated changes.
9780: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e (define (rmt:fin
9790: 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d d-and-mark-incom
97a0: 70 6c 65 74 65 2d 61 6c 6c 2d 72 75 6e 73 20 23 plete-all-runs #
97b0: 21 6b 65 79 20 28 6f 76 72 2d 64 65 61 64 74 69 !key (ovr-deadti
97c0: 6d 65 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 me #f)). (let (
97d0: 28 72 75 6e 2d 69 64 73 20 28 72 6d 74 3a 67 65 (run-ids (rmt:ge
97e0: 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 t-all-run-ids)))
97f0: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
9800: 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a lambda (run-id).
9810: 09 20 20 20 20 20 20 20 28 72 6d 74 3a 66 69 6e . (rmt:fin
9820: 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d d-and-mark-incom
9830: 70 6c 65 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 plete run-id ovr
9840: 2d 64 65 61 64 74 69 6d 65 29 29 0a 09 20 20 20 -deadtime))..
9850: 20 20 72 75 6e 2d 69 64 73 29 29 29 0a 0a 3b 3b run-ids)))..;;
9860: 20 67 65 74 20 74 68 65 20 70 72 65 76 69 6f 75 get the previou
9870: 73 20 72 65 63 6f 72 64 20 66 6f 72 20 77 68 65 s record for whe
9880: 6e 20 74 68 69 73 20 74 65 73 74 20 77 61 73 20 n this test was
9890: 72 75 6e 20 77 68 65 72 65 20 61 6c 6c 20 6b 65 run where all ke
98a0: 79 73 20 6d 61 74 63 68 20 62 75 74 20 72 75 6e ys match but run
98b0: 6e 61 6d 65 0a 3b 3b 20 72 65 74 75 72 6e 73 20 name.;; returns
98c0: 23 66 20 69 66 20 6e 6f 20 73 75 63 68 20 74 65 #f if no such te
98d0: 73 74 20 66 6f 75 6e 64 2c 20 72 65 74 75 72 6e st found, return
98e0: 73 20 61 20 73 69 6e 67 6c 65 20 74 65 73 74 20 s a single test
98f0: 72 65 63 6f 72 64 20 69 66 20 66 6f 75 6e 64 0a record if found.
9900: 3b 3b 20 0a 3b 3b 20 52 75 6e 20 74 68 69 73 20 ;; .;; Run this
9910: 61 74 20 74 68 65 20 63 6c 69 65 6e 74 20 65 6e at the client en
9920: 64 20 73 69 6e 63 65 20 77 65 20 68 61 76 65 20 d since we have
9930: 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 6d 75 to connect to mu
9940: 6c 74 69 70 6c 65 20 72 75 6e 2d 69 64 20 64 62 ltiple run-id db
9950: 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d s.;;.(define (rm
9960: 74 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 t:get-previous-t
9970: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 72 est-run-record r
9980: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
9990: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 item-path). (le
99a0: 74 2a 20 28 28 6b 65 79 76 61 6c 73 20 28 72 6d t* ((keyvals (rm
99b0: 74 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 t:get-key-val-pa
99c0: 69 72 73 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 irs run-id)).. (
99d0: 6b 65 79 73 20 20 20 20 28 72 6d 74 3a 67 65 74 keys (rmt:get
99e0: 2d 6b 65 79 73 29 29 0a 09 20 28 73 65 6c 73 74 -keys)).. (selst
99f0: 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 r (string-inter
9a00: 73 70 65 72 73 65 20 20 6b 65 79 73 20 22 2c 22 sperse keys ","
9a10: 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 28 73 )).. (qrystr (s
9a20: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
9a30: 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 e (map (lambda (
9a40: 78 29 28 63 6f 6e 63 20 78 20 22 3d 3f 22 29 29 x)(conc x "=?"))
9a50: 20 6b 65 79 73 29 20 22 20 41 4e 44 20 22 29 29 keys) " AND "))
9a60: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6b ). (if (not k
9a70: 65 79 76 61 6c 73 29 0a 09 23 66 0a 09 28 6c 65 eyvals)..#f..(le
9a80: 74 20 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 t ((prev-run-ids
9a90: 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 (rmt:get-prev-r
9aa0: 75 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 29 29 un-ids run-id)))
9ab0: 0a 09 20 20 3b 3b 20 66 6f 72 20 65 61 63 68 20 .. ;; for each
9ac0: 72 75 6e 20 73 74 61 72 74 69 6e 67 20 77 69 74 run starting wit
9ad0: 68 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e h the most recen
9ae0: 74 20 6c 6f 6f 6b 20 74 6f 20 73 65 65 20 69 66 t look to see if
9af0: 20 74 68 65 72 65 20 69 73 20 61 20 6d 61 74 63 there is a matc
9b00: 68 69 6e 67 20 74 65 73 74 0a 09 20 20 3b 3b 20 hing test.. ;;
9b10: 69 66 20 66 6f 75 6e 64 20 74 68 65 6e 20 72 65 if found then re
9b20: 74 75 72 6e 20 74 68 61 74 20 6d 61 74 63 68 69 turn that matchi
9b30: 6e 67 20 74 65 73 74 20 72 65 63 6f 72 64 0a 09 ng test record..
9b40: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
9b50: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
9b60: 72 74 2a 20 22 73 65 6c 73 74 72 3a 20 22 20 73 rt* "selstr: " s
9b70: 65 6c 73 74 72 20 22 2c 20 71 72 79 73 74 72 3a elstr ", qrystr:
9b80: 20 22 20 71 72 79 73 74 72 20 22 2c 20 6b 65 79 " qrystr ", key
9b90: 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 vals: " keyvals
9ba0: 22 2c 20 70 72 65 76 69 6f 75 73 20 72 75 6e 20 ", previous run
9bb0: 69 64 73 20 66 6f 75 6e 64 3a 20 22 20 70 72 65 ids found: " pre
9bc0: 76 2d 72 75 6e 2d 69 64 73 29 0a 09 20 20 28 69 v-run-ids).. (i
9bd0: 66 20 28 6e 75 6c 6c 3f 20 70 72 65 76 2d 72 75 f (null? prev-ru
9be0: 6e 2d 69 64 73 29 20 23 66 0a 09 20 20 20 20 20 n-ids) #f..
9bf0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
9c00: 20 28 63 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 (car prev-run-i
9c10: 64 73 29 29 0a 09 09 09 20 28 74 61 6c 20 28 63 ds)).... (tal (c
9c20: 64 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 dr prev-run-ids)
9c30: 29 29 0a 09 09 28 6c 65 74 20 28 28 72 65 73 75 ))...(let ((resu
9c40: 6c 74 73 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 lts (rmt:get-tes
9c50: 74 73 2d 66 6f 72 2d 72 75 6e 20 68 65 64 20 28 ts-for-run hed (
9c60: 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 conc test-name "
9c70: 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 20 27 28 /" item-path) '(
9c80: 29 20 27 28 29 20 3b 3b 20 72 75 6e 2d 69 64 20 ) '() ;; run-id
9c90: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
9ca0: 73 74 61 74 75 73 65 73 0a 09 09 09 09 09 09 20 statuses.......
9cb0: 20 20 20 20 20 23 66 20 23 66 20 23 66 20 20 20 #f #f #f
9cc0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6f ;; o
9cd0: 66 66 73 65 74 20 6c 69 6d 69 74 20 6e 6f 74 2d ffset limit not-
9ce0: 69 6e 20 68 69 64 65 2f 6e 6f 74 2d 68 69 64 65 in hide/not-hide
9cf0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 23 66 20 ....... #f
9d00: 23 66 20 23 66 20 23 66 20 27 6e 6f 72 6d 61 6c #f #f #f 'normal
9d10: 29 29 29 20 3b 3b 20 73 6f 72 74 2d 62 79 20 73 ))) ;; sort-by s
9d20: 6f 72 74 2d 6f 72 64 65 72 20 71 72 79 76 61 6c ort-order qryval
9d30: 73 20 6c 61 73 74 2d 75 70 64 61 74 65 20 6d 6f s last-update mo
9d40: 64 65 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 de... (debug:pr
9d50: 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c int 4 *default-l
9d60: 6f 67 2d 70 6f 72 74 2a 20 22 47 6f 74 20 74 65 og-port* "Got te
9d70: 73 74 73 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 sts for run-id "
9d80: 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d run-id ", test-
9d90: 6e 61 6d 65 20 22 20 74 65 73 74 2d 6e 61 6d 65 name " test-name
9da0: 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 22 20 ", item-path "
9db0: 69 74 65 6d 2d 70 61 74 68 20 22 3a 20 22 20 72 item-path ": " r
9dc0: 65 73 75 6c 74 73 29 0a 09 09 20 20 28 69 66 20 esults)... (if
9dd0: 28 61 6e 64 20 28 6e 75 6c 6c 3f 20 72 65 73 75 (and (null? resu
9de0: 6c 74 73 29 0a 09 09 09 20 20 20 28 6e 6f 74 20 lts).... (not
9df0: 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 09 (null? tal)))...
9e00: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
9e10: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 0a tal)(cdr tal)).
9e20: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c .. (if (nul
9e30: 6c 3f 20 72 65 73 75 6c 74 73 29 20 23 66 0a 09 l? results) #f..
9e40: 09 09 20 20 28 63 61 72 20 72 65 73 75 6c 74 73 .. (car results
9e50: 29 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 ))))))))))..(def
9e60: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ine (rmt:get-run
9e70: 2d 73 74 61 74 73 29 0a 20 20 28 72 6d 74 3a 73 -stats). (rmt:s
9e80: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
9e90: 2d 72 75 6e 2d 73 74 61 74 73 20 23 66 20 27 28 -run-stats #f '(
9ea0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
9eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
9ef0: 20 20 53 20 54 20 45 20 50 20 53 0a 3b 3b 3d 3d S T E P S.;;==
9f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f40: 3d 3d 3d 3d 0a 0a 3b 3b 20 47 65 74 74 69 6e 67 ====..;; Getting
9f50: 20 73 74 65 70 73 20 69 73 20 6d 6f 72 65 20 63 steps is more c
9f60: 6f 6d 70 6c 69 63 61 74 65 64 2e 0a 3b 3b 0a 3b omplicated..;;.;
9f70: 3b 20 49 66 20 67 69 76 65 6e 20 77 6f 72 6b 20 ; If given work
9f80: 61 72 65 61 20 0a 3b 3b 20 20 31 2e 20 46 69 6e area .;; 1. Fin
9f90: 64 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 d the testdat.db
9fa0: 20 66 69 6c 65 0a 3b 3b 20 20 32 2e 20 4f 70 65 file.;; 2. Ope
9fb0: 6e 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 n the testdat.db
9fc0: 20 66 69 6c 65 20 61 6e 64 20 64 6f 20 74 68 65 file and do the
9fd0: 20 71 75 65 72 79 0a 3b 3b 20 49 66 20 6e 6f 74 query.;; If not
9fe0: 20 67 69 76 65 6e 20 74 68 65 20 77 6f 72 6b 20 given the work
9ff0: 61 72 65 61 0a 3b 3b 20 20 31 2e 20 44 6f 20 61 area.;; 1. Do a
a000: 20 72 65 6d 6f 74 65 20 63 61 6c 6c 20 74 6f 20 remote call to
a010: 67 65 74 20 74 68 65 20 74 65 73 74 20 70 61 74 get the test pat
a020: 68 0a 3b 3b 20 20 32 2e 20 43 6f 6e 74 69 6e 75 h.;; 2. Continu
a030: 65 20 61 73 20 61 62 6f 76 65 0a 3b 3b 20 0a 3b e as above.;; .;
a040: 3b 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 ;(define (rmt:ge
a050: 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 t-steps-for-test
a060: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
a070: 0a 3b 3b 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 .;; (rmt:send-r
a080: 65 63 65 69 76 65 20 27 67 65 74 2d 73 74 65 70 eceive 'get-step
a090: 73 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 28 6c s-data run-id (l
a0a0: 69 73 74 20 74 65 73 74 2d 69 64 29 29 29 0a 0a ist test-id)))..
a0b0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 (define (rmt:tes
a0c0: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
a0d0: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
a0e0: 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 teststep-name s
a0f0: 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 tate-in status-i
a100: 6e 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c n comment logfil
a110: 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 e). (let* ((sta
a120: 74 65 20 20 20 20 20 28 69 74 65 6d 73 3a 63 68 te (items:ch
a130: 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 eck-valid-items
a140: 22 73 74 61 74 65 22 20 73 74 61 74 65 2d 69 6e "state" state-in
a150: 29 29 0a 09 20 28 73 74 61 74 75 73 20 20 20 20 )).. (status
a160: 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d 76 61 6c (items:check-val
a170: 69 64 2d 69 74 65 6d 73 20 22 73 74 61 74 75 73 id-items "status
a180: 22 20 73 74 61 74 75 73 2d 69 6e 29 29 29 0a 20 " status-in))).
a190: 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 (if (or (not
a1a0: 73 74 61 74 65 29 28 6e 6f 74 20 73 74 61 74 75 state)(not statu
a1b0: 73 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e s))..(debug:prin
a1c0: 74 20 33 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 3 *default-log
a1d0: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
a1e0: 20 49 6e 76 61 6c 69 64 20 22 20 28 69 66 20 73 Invalid " (if s
a1f0: 74 61 74 75 73 20 22 73 74 61 74 75 73 22 20 22 tatus "status" "
a200: 73 74 61 74 65 22 29 0a 09 09 20 20 20 20 20 22 state")... "
a210: 20 76 61 6c 75 65 20 5c 22 22 20 28 69 66 20 73 value \"" (if s
a220: 74 61 74 75 73 20 73 74 61 74 65 2d 69 6e 20 73 tatus state-in s
a230: 74 61 74 75 73 2d 69 6e 29 20 22 5c 22 2c 20 75 tatus-in) "\", u
a240: 70 64 61 74 65 20 79 6f 75 72 20 76 61 6c 69 64 pdate your valid
a250: 76 61 6c 75 65 73 20 73 65 63 74 69 6f 6e 20 69 values section i
a260: 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 n megatest.confi
a270: 67 22 29 29 0a 20 20 20 20 28 72 6d 74 3a 73 65 g")). (rmt:se
a280: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
a290: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
a2a0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
a2b0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
a2c0: 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 74 65 tstep-name state
a2d0: 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 63 6f -in status-in co
a2e0: 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 29 29 29 mment logfile)))
a2f0: 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 )...(define (rmt
a300: 3a 64 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f :delete-steps-fo
a310: 72 2d 74 65 73 74 21 20 72 75 6e 2d 69 64 20 74 r-test! run-id t
a320: 65 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 est-id). (rmt:s
a330: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 6c end-receive 'del
a340: 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 ete-steps-for-te
a350: 73 74 21 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 st! run-id (list
a360: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
a370: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
a380: 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 :get-steps-for-t
a390: 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d est run-id test-
a3a0: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
a3b0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 73 74 65 receive 'get-ste
a3c0: 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e 2d ps-for-test run-
a3d0: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 id (list run-id
a3e0: 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 test-id)))..(def
a3f0: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 73 74 65 ine (rmt:get-ste
a400: 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 74 65 ps-info-by-id te
a410: 73 74 2d 73 74 65 70 2d 69 64 29 0a 20 20 28 72 st-step-id). (r
a420: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
a430: 27 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 'get-steps-info-
a440: 62 79 2d 69 64 20 23 66 20 28 6c 69 73 74 20 74 by-id #f (list t
a450: 65 73 74 2d 73 74 65 70 2d 69 64 29 29 29 0a 0a est-step-id)))..
a460: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
a470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a4a0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 54 20 45 ========.;; T E
a4b0: 20 53 20 54 20 20 20 44 20 41 20 54 20 41 20 0a S T D A T A .
a4c0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
a4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a4e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a4f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a500: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin
a510: 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 65 73 74 e (rmt:read-test
a520: 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 -data run-id tes
a530: 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 74 t-id categorypat
a540: 74 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 72 t #!key (work-ar
a550: 65 61 20 23 66 29 29 20 0a 20 20 28 72 6d 74 3a ea #f)) . (rmt:
a560: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 72 65 send-receive 're
a570: 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 75 6e ad-test-data run
a580: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
a590: 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 test-id categor
a5a0: 79 70 61 74 74 29 29 29 0a 28 64 65 66 69 6e 65 ypatt))).(define
a5b0: 20 28 72 6d 74 3a 72 65 61 64 2d 74 65 73 74 2d (rmt:read-test-
a5c0: 64 61 74 61 2a 20 72 75 6e 2d 69 64 20 74 65 73 data* run-id tes
a5d0: 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 74 t-id categorypat
a5e0: 74 20 76 61 72 70 61 74 74 20 23 21 6b 65 79 20 t varpatt #!key
a5f0: 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 20 (work-area #f))
a600: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
a610: 65 69 76 65 20 27 72 65 61 64 2d 74 65 73 74 2d eive 'read-test-
a620: 64 61 74 61 2a 20 72 75 6e 2d 69 64 20 28 6c 69 data* run-id (li
a630: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
a640: 64 20 63 61 74 65 67 6f 72 79 70 61 74 74 20 76 d categorypatt v
a650: 61 72 70 61 74 74 29 29 29 0a 0a 28 64 65 66 69 arpatt)))..(defi
a660: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 64 61 74 61 ne (rmt:get-data
a670: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 74 65 73 74 -info-by-id test
a680: 2d 64 61 74 61 2d 69 64 29 0a 20 20 20 28 72 6d -data-id). (rm
a690: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
a6a0: 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 79 get-data-info-by
a6b0: 2d 69 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 -id #f (list tes
a6c0: 74 2d 64 61 74 61 2d 69 64 29 29 29 0a 0a 28 64 t-data-id)))..(d
a6d0: 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 6d efine (rmt:testm
a6e0: 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 20 74 eta-add-record t
a6f0: 65 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a estname). (rmt:
a700: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 send-receive 'te
a710: 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 stmeta-add-recor
a720: 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 74 6e d #f (list testn
a730: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
a740: 28 72 6d 74 3a 74 65 73 74 6d 65 74 61 2d 67 65 (rmt:testmeta-ge
a750: 74 2d 72 65 63 6f 72 64 20 74 65 73 74 6e 61 6d t-record testnam
a760: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
a770: 65 63 65 69 76 65 20 27 74 65 73 74 6d 65 74 61 eceive 'testmeta
a780: 2d 67 65 74 2d 72 65 63 6f 72 64 20 23 66 20 28 -get-record #f (
a790: 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 29 29 list testname)))
a7a0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
a7b0: 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 estmeta-update-f
a7c0: 69 65 6c 64 20 74 65 73 74 2d 6e 61 6d 65 20 66 ield test-name f
a7d0: 6c 64 20 76 61 6c 29 0a 20 20 28 72 6d 74 3a 73 ld val). (rmt:s
a7e0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 end-receive 'tes
a7f0: 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 tmeta-update-fie
a800: 6c 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 74 ld #f (list test
a810: 2d 6e 61 6d 65 20 66 6c 64 20 76 61 6c 29 29 29 -name fld val)))
a820: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
a830: 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 est-data-rollup
a840: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
a850: 74 61 74 75 73 29 0a 20 20 28 72 6d 74 3a 73 65 tatus). (rmt:se
a860: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
a870: 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 72 75 6e -data-rollup run
a880: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
a890: 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73 29 test-id status)
a8a0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
a8b0: 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 :csv->test-data
a8c0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 63 run-id test-id c
a8d0: 73 76 64 61 74 61 29 0a 20 20 28 72 6d 74 3a 73 svdata). (rmt:s
a8e0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 63 73 76 end-receive 'csv
a8f0: 2d 3e 74 65 73 74 2d 64 61 74 61 20 72 75 6e 2d ->test-data run-
a900: 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 id (list run-id
a910: 74 65 73 74 2d 69 64 20 63 73 76 64 61 74 61 29 test-id csvdata)
a920: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
a930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
a970: 20 54 20 41 20 53 20 4b 20 53 0a 3b 3b 3d 3d 3d T A S K S.;;===
a980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a9a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a9b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a9c0: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d ===..(define (rm
a9d0: 74 3a 74 61 73 6b 73 2d 66 69 6e 64 2d 74 61 73 t:tasks-find-tas
a9e0: 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 20 k-queue-records
a9f0: 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 20 target run-name
aa00: 74 65 73 74 2d 70 61 74 74 20 73 74 61 74 65 2d test-patt state-
aa10: 70 61 74 74 20 61 63 74 69 6f 6e 2d 70 61 74 74 patt action-patt
aa20: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
aa30: 63 65 69 76 65 20 27 66 69 6e 64 2d 74 61 73 6b ceive 'find-task
aa40: 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 20 23 -queue-records #
aa50: 66 20 28 6c 69 73 74 20 74 61 72 67 65 74 20 72 f (list target r
aa60: 75 6e 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 un-name test-pat
aa70: 74 20 73 74 61 74 65 2d 70 61 74 74 20 61 63 74 t state-patt act
aa80: 69 6f 6e 2d 70 61 74 74 29 29 29 0a 0a 28 64 65 ion-patt)))..(de
aa90: 66 69 6e 65 20 28 72 6d 74 3a 74 61 73 6b 73 2d fine (rmt:tasks-
aaa0: 61 64 64 20 61 63 74 69 6f 6e 20 6f 77 6e 65 72 add action owner
aab0: 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 target runname
aac0: 74 65 73 74 70 61 74 74 20 70 61 72 61 6d 73 29 testpatt params)
aad0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
aae0: 65 69 76 65 20 27 74 61 73 6b 73 2d 61 64 64 20 eive 'tasks-add
aaf0: 23 66 20 28 6c 69 73 74 20 61 63 74 69 6f 6e 20 #f (list action
ab00: 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 75 6e owner target run
ab10: 6e 61 6d 65 20 74 65 73 74 70 61 74 74 20 70 61 name testpatt pa
ab20: 72 61 6d 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 rams)))..(define
ab30: 20 28 72 6d 74 3a 74 61 73 6b 73 2d 73 65 74 2d (rmt:tasks-set-
ab40: 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 state-given-para
ab50: 6d 2d 6b 65 79 20 70 61 72 61 6d 2d 6b 65 79 20 m-key param-key
ab60: 6e 65 77 2d 73 74 61 74 65 29 0a 20 20 28 72 6d new-state). (rm
ab70: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
ab80: 74 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d tasks-set-state-
ab90: 67 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 20 given-param-key
aba0: 23 66 20 28 6c 69 73 74 20 20 70 61 72 61 6d 2d #f (list param-
abb0: 6b 65 79 20 6e 65 77 2d 73 74 61 74 65 29 29 29 key new-state)))
abc0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
abd0: 61 73 6b 73 2d 67 65 74 2d 6c 61 73 74 20 74 61 asks-get-last ta
abe0: 72 67 65 74 20 72 75 6e 6e 61 6d 65 29 0a 20 20 rget runname).
abf0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
ac00: 65 20 27 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 e 'tasks-get-las
ac10: 74 20 23 66 20 28 6c 69 73 74 20 74 61 72 67 65 t #f (list targe
ac20: 74 20 72 75 6e 6e 61 6d 65 29 29 29 0a 0a 3b 3b t runname)))..;;
ac30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac70: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 20 4f 20 20 20 ======.;; N O
ac80: 53 20 59 20 4e 20 43 20 20 20 44 20 42 20 0a 3b S Y N C D B .;
ac90: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
aca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
acb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
acc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
acd0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
ace0: 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 73 65 (rmt:no-sync-se
acf0: 74 20 76 61 72 20 76 61 6c 29 0a 20 20 28 72 6d t var val). (rm
ad00: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
ad10: 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 23 66 20 60 no-sync-set #f `
ad20: 28 2c 76 61 72 20 2c 76 61 6c 29 29 29 0a 0a 28 (,var ,val)))..(
ad30: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 define (rmt:no-s
ad40: 79 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c 74 20 ync-get/default
ad50: 76 61 72 20 64 65 66 61 75 6c 74 29 0a 20 20 28 var default). (
ad60: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
ad70: 20 27 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 'no-sync-get/de
ad80: 66 61 75 6c 74 20 23 66 20 60 28 2c 76 61 72 20 fault #f `(,var
ad90: 2c 64 65 66 61 75 6c 74 29 29 29 0a 0a 28 64 65 ,default)))..(de
ada0: 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e fine (rmt:no-syn
adb0: 63 2d 64 65 6c 21 20 76 61 72 29 0a 20 20 28 72 c-del! var). (r
adc0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
add0: 27 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 23 66 'no-sync-del! #f
ade0: 20 60 28 2c 76 61 72 29 29 29 0a 0a 28 64 65 66 `(,var)))..(def
adf0: 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 ine (rmt:no-sync
ae00: 2d 67 65 74 2d 6c 6f 63 6b 20 6b 65 79 6e 61 6d -get-lock keynam
ae10: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
ae20: 65 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d eceive 'no-sync-
ae30: 67 65 74 2d 6c 6f 63 6b 20 23 66 20 60 28 2c 6b get-lock #f `(,k
ae40: 65 79 6e 61 6d 65 29 29 29 0a 0a 3b 3b 3d 3d 3d eyname)))..;;===
ae50: 3d 3d 3d 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 0a 3b 3b 20 41 20 52 20 43 20 48 20 49 ===.;; A R C H I
aea0: 20 56 20 45 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d V E S.;;=======
aeb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
aef0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 61 72 .(define (rmt:ar
af00: 63 68 69 76 65 2d 67 65 74 2d 61 6c 6c 6f 63 61 chive-get-alloca
af10: 74 69 6f 6e 73 20 20 74 65 73 74 6e 61 6d 65 20 tions testname
af20: 69 74 65 6d 70 61 74 68 20 64 6e 65 65 64 65 64 itempath dneeded
af30: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
af40: 63 65 69 76 65 20 27 61 72 63 68 69 76 65 2d 67 ceive 'archive-g
af50: 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 20 23 et-allocations #
af60: 66 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 f (list testname
af70: 20 69 74 65 6d 70 61 74 68 20 64 6e 65 65 64 65 itempath dneede
af80: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
af90: 6d 74 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 mt:archive-regis
afa0: 74 65 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 62 ter-block-name b
afb0: 64 69 73 6b 2d 69 64 20 61 72 63 68 69 76 65 2d disk-id archive-
afc0: 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e path). (rmt:sen
afd0: 64 2d 72 65 63 65 69 76 65 20 27 61 72 63 68 69 d-receive 'archi
afe0: 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 ve-register-bloc
aff0: 6b 2d 6e 61 6d 65 20 23 66 20 28 6c 69 73 74 20 k-name #f (list
b000: 62 64 69 73 6b 2d 69 64 20 61 72 63 68 69 76 65 bdisk-id archive
b010: 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e -path)))..(defin
b020: 65 20 28 72 6d 74 3a 61 72 63 68 69 76 65 2d 61 e (rmt:archive-a
b030: 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74 llocate-testsuit
b040: 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 20 e/area-to-block
b050: 62 6c 6f 63 6b 2d 69 64 20 74 65 73 74 73 75 69 block-id testsui
b060: 74 65 2d 6e 61 6d 65 20 61 72 65 61 6b 65 79 29 te-name areakey)
b070: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
b080: 65 69 76 65 20 27 61 72 63 68 69 76 65 2d 61 6c eive 'archive-al
b090: 6c 6f 63 61 74 65 2d 74 65 73 74 2d 74 6f 2d 62 locate-test-to-b
b0a0: 6c 6f 63 6b 20 23 66 20 28 6c 69 73 74 20 20 62 lock #f (list b
b0b0: 6c 6f 63 6b 2d 69 64 20 74 65 73 74 73 75 69 74 lock-id testsuit
b0c0: 65 2d 6e 61 6d 65 20 61 72 65 61 6b 65 79 29 29 e-name areakey))
b0d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
b0e0: 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 archive-register
b0f0: 2d 64 69 73 6b 20 62 64 69 73 6b 2d 6e 61 6d 65 -disk bdisk-name
b100: 20 62 64 69 73 6b 2d 70 61 74 68 20 64 66 29 0a bdisk-path df).
b110: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
b120: 69 76 65 20 27 61 72 63 68 69 76 65 2d 72 65 67 ive 'archive-reg
b130: 69 73 74 65 72 2d 64 69 73 6b 20 23 66 20 28 6c ister-disk #f (l
b140: 69 73 74 20 62 64 69 73 6b 2d 6e 61 6d 65 20 62 ist bdisk-name b
b150: 64 69 73 6b 2d 70 61 74 68 20 64 66 29 29 29 0a disk-path df))).
b160: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 .(define (rmt:te
b170: 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 2d 62 st-set-archive-b
b180: 6c 6f 63 6b 2d 69 64 20 72 75 6e 2d 69 64 20 74 lock-id run-id t
b190: 65 73 74 2d 69 64 20 61 72 63 68 69 76 65 2d 62 est-id archive-b
b1a0: 6c 6f 63 6b 2d 69 64 29 0a 20 20 28 72 6d 74 3a lock-id). (rmt:
b1b0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 send-receive 'te
b1c0: 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 2d 62 st-set-archive-b
b1d0: 6c 6f 63 6b 2d 69 64 20 72 75 6e 2d 69 64 20 28 lock-id run-id (
b1e0: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
b1f0: 2d 69 64 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 -id archive-bloc
b200: 6b 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 k-id)))..(define
b210: 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d 61 (rmt:test-get-a
b220: 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 rchive-block-inf
b230: 6f 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d o archive-block-
b240: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
b250: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 67 65 receive 'test-ge
b260: 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d t-archive-block-
b270: 69 6e 66 6f 20 23 66 20 28 6c 69 73 74 20 61 72 info #f (list ar
b280: 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 29 chive-block-id))
b290: 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 )...(define (rmt
b2a0: 6d 6f 64 3a 63 61 6c 63 2d 72 6f 2d 6d 6f 64 65 mod:calc-ro-mode
b2b0: 20 72 75 6e 72 65 6d 6f 74 65 20 2a 74 6f 70 70 runremote *topp
b2c0: 61 74 68 2a 29 0a 20 20 28 69 66 20 28 61 6e 64 ath*). (if (and
b2d0: 20 72 75 6e 72 65 6d 6f 74 65 0a 09 20 20 20 28 runremote.. (
b2e0: 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 63 remote-ro-mode-c
b2f0: 68 65 63 6b 65 64 20 72 75 6e 72 65 6d 6f 74 65 hecked runremote
b300: 29 29 0a 20 20 20 20 20 20 28 72 65 6d 6f 74 65 )). (remote
b310: 2d 72 6f 2d 6d 6f 64 65 20 72 75 6e 72 65 6d 6f -ro-mode runremo
b320: 74 65 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 te). (let*
b330: 28 28 64 62 66 69 6c 65 20 20 28 63 6f 6e 63 20 ((dbfile (conc
b340: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 *toppath* "/mega
b350: 74 65 73 74 2e 64 62 22 29 29 0a 09 20 20 20 20 test.db"))..
b360: 20 28 72 6f 2d 6d 6f 64 65 20 28 6e 6f 74 20 28 (ro-mode (not (
b370: 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 file-write-acces
b380: 73 3f 20 64 62 66 69 6c 65 29 29 29 29 20 3b 3b s? dbfile)))) ;;
b390: 20 54 4f 44 4f 3a 20 75 73 65 20 64 62 73 74 72 TODO: use dbstr
b3a0: 75 63 74 20 6f 72 20 72 75 6e 72 65 6d 6f 74 65 uct or runremote
b3b0: 20 74 6f 20 66 69 67 75 72 65 20 74 68 69 73 20 to figure this
b3c0: 6f 75 74 20 69 6e 20 66 75 74 75 72 65 0a 09 28 out in future..(
b3d0: 69 66 20 72 75 6e 72 65 6d 6f 74 65 0a 09 20 20 if runremote..
b3e0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
b3f0: 28 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d (remote-ro-mode-
b400: 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 72 set! runremote r
b410: 6f 2d 6d 6f 64 65 29 0a 09 20 20 20 20 20 20 28 o-mode).. (
b420: 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 63 remote-ro-mode-c
b430: 68 65 63 6b 65 64 2d 73 65 74 21 20 72 75 6e 72 hecked-set! runr
b440: 65 6d 6f 74 65 20 23 74 29 0a 09 20 20 20 20 20 emote #t)..
b450: 20 72 6f 2d 6d 6f 64 65 29 0a 09 20 20 20 20 72 ro-mode).. r
b460: 6f 2d 6d 6f 64 65 29 29 29 29 0a 0a 28 64 65 66 o-mode))))..(def
b470: 69 6e 65 20 28 65 78 74 72 61 73 2d 72 65 61 64 ine (extras-read
b480: 6f 6e 6c 79 2d 6d 6f 64 65 20 72 6d 74 2d 6d 75 only-mode rmt-mu
b490: 74 65 78 20 6c 6f 67 2d 70 6f 72 74 20 63 6d 64 tex log-port cmd
b4a0: 20 70 61 72 61 6d 73 29 0a 20 20 28 6d 75 74 65 params). (mute
b4b0: 78 2d 75 6e 6c 6f 63 6b 21 20 72 6d 74 2d 6d 75 x-unlock! rmt-mu
b4c0: 74 65 78 29 0a 20 20 28 64 65 62 75 67 3a 70 72 tex). (debug:pr
b4d0: 69 6e 74 2d 69 6e 66 6f 20 31 32 20 6c 6f 67 2d int-info 12 log-
b4e0: 70 6f 72 74 20 22 72 6d 74 3a 73 65 6e 64 2d 72 port "rmt:send-r
b4f0: 65 63 65 69 76 65 2c 20 63 61 73 65 20 33 22 29 eceive, case 3")
b500: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
b510: 30 20 6c 6f 67 2d 70 6f 72 74 20 22 57 41 52 4e 0 log-port "WARN
b520: 49 4e 47 3a 20 77 72 69 74 65 20 74 72 61 6e 73 ING: write trans
b530: 61 63 74 69 6f 6e 20 72 65 71 75 65 73 74 65 64 action requested
b540: 20 6f 6e 20 61 20 72 65 61 64 6f 6e 6c 79 20 61 on a readonly a
b550: 72 65 61 2e 20 20 63 6d 64 3d 22 63 6d 64 22 20 rea. cmd="cmd"
b560: 70 61 72 61 6d 73 3d 22 70 61 72 61 6d 73 29 0a params="params).
b570: 20 20 23 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 #f)..(define (
b580: 65 78 74 72 61 73 2d 74 72 61 6e 73 70 6f 72 74 extras-transport
b590: 2d 66 61 69 6c 65 64 20 2a 64 65 66 61 75 6c 74 -failed *default
b5a0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 2a 72 6d 74 2d -log-port* *rmt-
b5b0: 6d 75 74 65 78 2a 20 61 74 74 65 6d 70 74 6e 75 mutex* attemptnu
b5c0: 6d 20 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 20 m runremote cmd
b5d0: 72 69 64 20 70 61 72 61 6d 73 29 0a 20 20 28 64 rid params). (d
b5e0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
b5f0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
b600: 22 57 41 52 4e 49 4e 47 3a 20 63 6f 6d 6d 75 6e "WARNING: commun
b610: 69 63 61 74 69 6f 6e 20 66 61 69 6c 65 64 2e 20 ication failed.
b620: 54 72 79 69 6e 67 20 61 67 61 69 6e 2c 20 74 72 Trying again, tr
b630: 79 20 6e 75 6d 3a 20 22 20 61 74 74 65 6d 70 74 y num: " attempt
b640: 6e 75 6d 29 0a 20 20 28 6d 75 74 65 78 2d 6c 6f num). (mutex-lo
b650: 63 6b 21 20 2a 72 6d 74 2d 6d 75 74 65 78 2a 29 ck! *rmt-mutex*)
b660: 0a 20 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e 64 . (remote-connd
b670: 61 74 2d 73 65 74 21 20 20 20 20 72 75 6e 72 65 at-set! runre
b680: 6d 6f 74 65 20 23 66 29 0a 20 20 28 68 74 74 70 mote #f). (http
b690: 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c 6f 73 65 -transport:close
b6a0: 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 61 72 65 -connections are
b6b0: 61 2d 64 61 74 3a 20 72 75 6e 72 65 6d 6f 74 65 a-dat: runremote
b6c0: 29 0a 20 20 28 72 65 6d 6f 74 65 2d 73 65 72 76 ). (remote-serv
b6d0: 65 72 2d 75 72 6c 2d 73 65 74 21 20 72 75 6e 72 er-url-set! runr
b6e0: 65 6d 6f 74 65 20 23 66 29 0a 20 20 28 6d 75 74 emote #f). (mut
b6f0: 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d 74 2d ex-unlock! *rmt-
b700: 6d 75 74 65 78 2a 29 0a 20 20 28 64 65 62 75 67 mutex*). (debug
b710: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 20 2a :print-info 12 *
b720: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
b730: 2a 20 22 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 * "rmt:send-rece
b740: 69 76 65 2c 20 63 61 73 65 20 20 39 2e 31 22 29 ive, case 9.1")
b750: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
b760: 65 69 76 65 20 63 6d 64 20 72 69 64 20 70 61 72 eive cmd rid par
b770: 61 6d 73 20 61 74 74 65 6d 70 74 6e 75 6d 3a 20 ams attemptnum:
b780: 28 2b 20 61 74 74 65 6d 70 74 6e 75 6d 20 31 29 (+ attemptnum 1)
b790: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 65 )). .(define (e
b7a0: 78 74 72 61 73 2d 74 72 61 6e 73 70 6f 72 74 2d xtras-transport-
b7b0: 73 75 63 63 65 64 65 64 20 2a 64 65 66 61 75 6c succeded *defaul
b7c0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 2a 72 6d 74 t-log-port* *rmt
b7d0: 2d 6d 75 74 65 78 2a 20 61 74 74 65 6d 70 74 6e -mutex* attemptn
b7e0: 75 6d 20 72 75 6e 72 65 6d 6f 74 65 20 72 65 73 um runremote res
b7f0: 20 70 61 72 61 6d 73 20 72 69 64 20 63 6d 64 29 params rid cmd)
b800: 0a 20 20 28 69 66 20 28 61 6e 64 20 28 76 65 63 . (if (and (vec
b810: 74 6f 72 3f 20 72 65 73 29 0a 09 20 20 20 28 65 tor? res).. (e
b820: 71 3f 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 q? (vector-lengt
b830: 68 20 72 65 73 29 20 32 29 0a 09 20 20 20 28 65 h res) 2).. (e
b840: 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 q? (vector-ref r
b850: 65 73 20 31 29 20 27 6f 76 65 72 6c 6f 61 64 65 es 1) 'overloade
b860: 64 29 29 20 3b 3b 20 73 69 6e 63 65 20 77 65 20 d)) ;; since we
b870: 61 72 65 0a 09 09 09 09 09 09 20 3b 3b 20 6c 6f are....... ;; lo
b880: 6f 6b 69 6e 67 20 61 74 20 74 68 65 0a 09 09 09 oking at the....
b890: 09 09 09 20 3b 3b 20 64 61 74 61 20 74 6f 20 63 ... ;; data to c
b8a0: 61 72 72 79 20 74 68 65 0a 09 09 09 09 09 09 20 arry the.......
b8b0: 3b 3b 20 65 72 72 6f 72 20 77 65 27 6c 6c 20 75 ;; error we'll u
b8c0: 73 65 20 61 0a 09 09 09 09 09 09 20 3b 3b 20 66 se a....... ;; f
b8d0: 61 69 72 6c 79 20 6f 62 74 75 73 65 0a 09 09 09 airly obtuse....
b8e0: 09 09 09 20 3b 3b 20 63 6f 6d 62 6f 20 74 6f 20 ... ;; combo to
b8f0: 6d 69 6e 69 6d 69 73 65 0a 09 09 09 09 09 09 20 minimise.......
b900: 3b 3b 20 74 68 65 20 63 68 61 6e 63 65 73 20 6f ;; the chances o
b910: 66 0a 09 09 09 09 09 09 20 3b 3b 20 73 6f 6d 65 f....... ;; some
b920: 20 73 6f 72 74 20 6f 66 0a 09 09 09 09 09 09 20 sort of.......
b930: 3b 3b 20 63 6f 6c 6c 69 73 69 6f 6e 2e 20 20 74 ;; collision. t
b940: 68 69 73 0a 09 09 09 09 09 09 20 3b 3b 20 69 73 his....... ;; is
b950: 20 74 68 65 20 63 61 73 65 20 77 68 65 72 65 0a the case where.
b960: 09 09 09 09 09 09 20 3b 3b 20 74 68 65 20 72 65 ...... ;; the re
b970: 74 75 72 6e 65 64 20 64 61 74 61 0a 09 09 09 09 turned data.....
b980: 09 09 20 3b 3b 20 69 73 20 62 61 64 20 6f 72 20 .. ;; is bad or
b990: 74 68 65 0a 09 09 09 09 09 09 20 3b 3b 20 73 65 the....... ;; se
b9a0: 72 76 65 72 20 69 73 0a 09 09 09 09 09 09 20 3b rver is....... ;
b9b0: 3b 20 6f 76 65 72 6c 6f 61 64 65 64 20 61 6e 64 ; overloaded and
b9c0: 20 77 65 0a 09 09 09 09 09 09 20 3b 3b 20 77 61 we....... ;; wa
b9d0: 6e 74 20 74 6f 20 65 61 73 65 20 6f 66 66 0a 09 nt to ease off..
b9e0: 09 09 09 09 09 20 3b 3b 20 74 68 65 20 71 75 65 ..... ;; the que
b9f0: 72 69 65 73 0a 20 20 20 20 20 20 28 6c 65 74 20 ries. (let
ba00: 28 28 77 61 69 74 2d 64 65 6c 61 79 20 28 2b 20 ((wait-delay (+
ba10: 61 74 74 65 6d 70 74 6e 75 6d 20 28 2a 20 61 74 attemptnum (* at
ba20: 74 65 6d 70 74 6e 75 6d 20 31 30 29 29 29 29 0a temptnum 10)))).
ba30: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
ba40: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
ba50: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 73 65 72 t* "WARNING: ser
ba60: 76 65 72 20 69 73 20 6f 76 65 72 6c 6f 61 64 65 ver is overloade
ba70: 64 2e 20 44 65 6c 61 79 69 6e 67 20 22 20 77 61 d. Delaying " wa
ba80: 69 74 2d 64 65 6c 61 79 20 22 20 73 65 63 6f 6e it-delay " secon
ba90: 64 73 20 61 6e 64 20 74 72 79 69 6e 67 20 63 61 ds and trying ca
baa0: 6c 6c 20 61 67 61 69 6e 2e 22 29 0a 09 28 6d 75 ll again.")..(mu
bab0: 74 65 78 2d 6c 6f 63 6b 21 20 2a 72 6d 74 2d 6d tex-lock! *rmt-m
bac0: 75 74 65 78 2a 29 0a 09 28 68 74 74 70 2d 74 72 utex*)..(http-tr
bad0: 61 6e 73 70 6f 72 74 3a 63 6c 6f 73 65 2d 63 6f ansport:close-co
bae0: 6e 6e 65 63 74 69 6f 6e 73 20 61 72 65 61 2d 64 nnections area-d
baf0: 61 74 3a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 at: runremote)..
bb00: 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 (set! *runremote
bb10: 2a 20 23 66 29 20 3b 3b 20 66 6f 72 63 65 20 73 * #f) ;; force s
bb20: 74 61 72 74 69 6e 67 20 6f 76 65 72 0a 09 28 6d tarting over..(m
bb30: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 72 6d utex-unlock! *rm
bb40: 74 2d 6d 75 74 65 78 2a 29 0a 09 28 74 68 72 65 t-mutex*)..(thre
bb50: 61 64 2d 73 6c 65 65 70 21 20 77 61 69 74 2d 64 ad-sleep! wait-d
bb60: 65 6c 61 79 29 0a 09 28 72 6d 74 3a 73 65 6e 64 elay)..(rmt:send
bb70: 2d 72 65 63 65 69 76 65 20 63 6d 64 20 72 69 64 -receive cmd rid
bb80: 20 70 61 72 61 6d 73 20 61 74 74 65 6d 70 74 6e params attemptn
bb90: 75 6d 3a 20 28 2b 20 61 74 74 65 6d 70 74 6e 75 um: (+ attemptnu
bba0: 6d 20 31 29 29 29 0a 20 20 20 20 20 20 72 65 73 m 1))). res
bbb0: 29 29 20 3b 3b 20 41 6c 6c 20 67 6f 6f 64 2c 20 )) ;; All good,
bbc0: 72 65 74 75 72 6e 20 72 65 73 0a 0a 23 3b 28 73 return res..#;(s
bbd0: 65 74 2d 66 75 6e 63 74 69 6f 6e 73 20 72 6d 74 et-functions rmt
bbe0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 20 20 :send-receive
bbf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc00: 20 20 20 20 72 65 6d 6f 74 65 2d 73 65 72 76 65 remote-serve
bc10: 72 2d 75 72 6c 2d 73 65 74 21 0a 09 20 20 20 20 r-url-set!..
bc20: 20 20 20 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 http-transpor
bc30: 74 3a 63 6c 6f 73 65 2d 63 6f 6e 6e 65 63 74 69 t:close-connecti
bc40: 6f 6e 73 09 20 20 20 20 20 20 72 65 6d 6f 74 65 ons. remote
bc50: 2d 63 6f 6e 6e 64 61 74 2d 73 65 74 21 0a 09 20 -conndat-set!..
bc60: 20 20 20 20 20 20 64 65 62 75 67 3a 70 72 69 6e debug:prin
bc70: 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t
bc80: 20 20 20 20 20 20 20 20 20 20 20 20 20 64 65 62 deb
bc90: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 0a 09 20 ug:print-info..
bca0: 20 20 20 20 20 20 72 65 6d 6f 74 65 2d 72 6f 2d remote-ro-
bcb0: 6d 6f 64 65 20 20 20 20 20 20 20 20 20 20 20 20 mode
bcc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 6d rem
bcd0: 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 73 65 74 21 ote-ro-mode-set!
bce0: 0a 09 20 20 20 20 20 20 20 72 65 6d 6f 74 65 2d .. remote-
bcf0: 72 6f 2d 6d 6f 64 65 2d 63 68 65 63 6b 65 64 2d ro-mode-checked-
bd00: 73 65 74 21 20 20 20 20 20 20 20 20 20 20 20 20 set!
bd10: 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 63 remote-ro-mode-c
bd20: 68 65 63 6b 65 64 29 0a hecked).