Artifact
6784eb775b3798f70e5747463a0599bbf690d73d:
0000: 0a 0a 3b 3b 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 3d 3d 0a 3b 3b 20 43 6f ==========.;; Co
0050: 70 79 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 pyright 2006-201
0060: 33 2c 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 3, Matthew Wella
0070: 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 nd..;; .;; This
0080: 66 69 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 file is part of
0090: 4d 65 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b Megatest..;; .;;
00a0: 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 Megatest is
00b0: 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 free software:
00c0: 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 you can redistri
00d0: 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d bute it and/or m
00e0: 6f 64 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 odify.;; it
00f0: 75 6e 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 under the terms
0100: 6f 66 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 of the GNU Gener
0110: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
0120: 65 20 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 e as published b
0130: 79 0a 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 y.;; the Fre
0140: 65 20 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 e Software Found
0150: 61 74 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 ation, either ve
0160: 72 73 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c rsion 3 of the L
0170: 69 63 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 icense, or.;;
0180: 20 20 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f (at your optio
0190: 6e 29 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 n) any later ver
01a0: 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 sion..;; .;;
01b0: 20 4d 65 67 61 74 65 73 74 20 69 73 20 64 69 73 Megatest is dis
01c0: 74 72 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 tributed in the
01d0: 68 6f 70 65 20 74 68 61 74 20 69 74 20 77 69 6c hope that it wil
01e0: 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 l be useful,.;;
01f0: 20 20 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 but WITHOUT
0200: 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 ANY WARRANTY; wi
0210: 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 thout even the i
0220: 6d 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 mplied warranty
0230: 6f 66 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 of.;; MERCHA
0240: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 NTABILITY or FIT
0250: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 NESS FOR A PARTI
0260: 43 55 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 CULAR PURPOSE.
0270: 53 65 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 See the.;; G
0280: 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 NU General Publi
0290: 63 20 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f c License for mo
02a0: 72 65 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a re details..;; .
02b0: 3b 3b 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c ;; You shoul
02c0: 64 20 68 61 76 65 20 72 65 63 65 69 76 65 64 20 d have received
02d0: 61 20 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e a copy of the GN
02e0: 55 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 U General Public
02f0: 20 4c 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 License.;;
0300: 61 6c 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 along with Megat
0310: 65 73 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 est. If not, se
0320: 65 20 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e e <http://www.gn
0330: 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e u.org/licenses/>
0340: 2e 0a 3b 3b 0a 3b 3b 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 3d 3d 0a 0a 28 =============..(
0390: 75 73 65 20 73 72 66 69 2d 36 39 20 70 6f 73 69 use srfi-69 posi
03a0: 78 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e x)..(declare (un
03b0: 69 74 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 it api)).(declar
03c0: 65 20 28 75 73 65 73 20 72 6d 74 29 29 0a 28 64 e (uses rmt)).(d
03d0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 eclare (uses db)
03e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03f0: 20 64 62 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 dbmod)).(declar
0400: 65 20 28 75 73 65 73 20 74 61 73 6b 73 29 29 0a e (uses tasks)).
0410: 0a 28 69 6d 70 6f 72 74 20 64 62 6d 6f 64 29 0a .(import dbmod).
0420: 0a 3b 3b 20 61 6c 6c 6f 77 20 74 68 65 73 65 20 .;; allow these
0430: 71 75 65 72 69 65 73 20 74 68 72 6f 75 67 68 20 queries through
0440: 77 69 74 68 6f 75 74 20 73 74 61 72 74 69 6e 67 without starting
0450: 20 61 20 73 65 72 76 65 72 0a 3b 3b 0a 28 64 65 a server.;;.(de
0460: 66 69 6e 65 20 61 70 69 3a 72 65 61 64 2d 6f 6e fine api:read-on
0470: 6c 79 2d 71 75 65 72 69 65 73 0a 20 20 27 28 67 ly-queries. '(g
0480: 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 et-key-val-pairs
0490: 0a 20 20 20 20 67 65 74 2d 76 61 72 0a 20 20 20 . get-var.
04a0: 20 67 65 74 2d 6b 65 79 73 0a 20 20 20 20 67 65 get-keys. ge
04b0: 74 2d 6b 65 79 2d 76 61 6c 73 0a 20 20 20 20 74 t-key-vals. t
04c0: 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d est-toplevel-num
04d0: 2d 69 74 65 6d 73 0a 20 20 20 20 67 65 74 2d 74 -items. get-t
04e0: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 0a 20 est-info-by-id.
04f0: 20 20 20 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 get-steps-inf
0500: 6f 2d 62 79 2d 69 64 0a 20 20 20 20 67 65 74 2d o-by-id. get-
0510: 64 61 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 0a data-info-by-id.
0520: 20 20 20 20 74 65 73 74 2d 67 65 74 2d 72 75 6e test-get-run
0530: 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 dir-from-test-id
0540: 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d 74 . get-count-t
0550: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 ests-running-for
0560: 2d 74 65 73 74 6e 61 6d 65 0a 20 20 20 20 67 65 -testname. ge
0570: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
0580: 6e 6e 69 6e 67 0a 20 20 20 20 67 65 74 2d 63 6f nning. get-co
0590: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
05a0: 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 0a 20 20 g-in-jobgroup.
05b0: 20 20 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 get-previous-t
05c0: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 0a 20 est-run-record.
05d0: 20 20 20 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d get-matching-
05e0: 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 previous-test-ru
05f0: 6e 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 74 65 n-records. te
0600: 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 st-get-logfile-i
0610: 6e 66 6f 0a 20 20 20 20 74 65 73 74 2d 67 65 74 nfo. test-get
0620: 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 -records-for-ind
0630: 65 78 2d 66 69 6c 65 0a 20 20 20 20 67 65 74 2d ex-file. get-
0640: 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 testinfo-state-s
0650: 74 61 74 75 73 0a 20 20 20 20 74 65 73 74 2d 67 tatus. test-g
0660: 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 et-top-process-p
0670: 69 64 0a 20 20 20 20 74 65 73 74 2d 67 65 74 2d id. test-get-
0680: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b paths-matching-k
0690: 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e eynames-target-n
06a0: 65 77 0a 20 20 20 20 67 65 74 2d 70 72 65 72 65 ew. get-prere
06b0: 71 73 2d 6e 6f 74 2d 6d 65 74 0a 20 20 20 20 67 qs-not-met. g
06c0: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
06d0: 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 unning-for-run-i
06e0: 64 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 69 6e d. get-run-in
06f0: 66 6f 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 73 fo. get-run-s
0700: 74 61 74 75 73 0a 20 20 20 20 67 65 74 2d 72 75 tatus. get-ru
0710: 6e 2d 73 74 61 74 65 0a 20 20 20 20 67 65 74 2d n-state. get-
0720: 72 75 6e 2d 73 74 61 74 73 0a 20 20 20 20 67 65 run-stats. ge
0730: 74 2d 72 75 6e 2d 74 69 6d 65 73 0a 20 20 20 20 t-run-times.
0740: 67 65 74 2d 74 61 72 67 65 74 73 0a 20 20 20 20 get-targets.
0750: 67 65 74 2d 74 61 72 67 65 74 0a 20 20 20 20 3b get-target. ;
0760: 3b 20 72 65 67 69 73 74 65 72 2d 72 75 6e 0a 20 ; register-run.
0770: 20 20 20 67 65 74 2d 74 65 73 74 73 2d 74 61 67 get-tests-tag
0780: 73 0a 20 20 20 20 67 65 74 2d 74 65 73 74 2d 74 s. get-test-t
0790: 69 6d 65 73 0a 20 20 20 20 67 65 74 2d 74 65 73 imes. get-tes
07a0: 74 73 2d 66 6f 72 2d 72 75 6e 0a 20 20 20 20 67 ts-for-run. g
07b0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
07c0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 20 20 -state-status.
07d0: 20 20 67 65 74 2d 74 65 73 74 2d 69 64 0a 20 20 get-test-id.
07e0: 20 20 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d get-tests-for-
07f0: 72 75 6e 73 2d 6d 69 6e 64 61 74 61 0a 20 20 20 runs-mindata.
0800: 20 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 get-tests-for-r
0810: 75 6e 2d 6d 69 6e 64 61 74 61 0a 20 20 20 20 67 un-mindata. g
0820: 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d et-run-name-from
0830: 2d 69 64 0a 20 20 20 20 67 65 74 2d 72 75 6e 73 -id. get-runs
0840: 0a 20 20 20 20 73 69 6d 70 6c 65 2d 67 65 74 2d . simple-get-
0850: 72 75 6e 73 0a 20 20 20 20 67 65 74 2d 6e 75 6d runs. get-num
0860: 2d 72 75 6e 73 0a 20 20 20 20 67 65 74 2d 72 75 -runs. get-ru
0870: 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 0a 20 ns-cnt-by-patt.
0880: 20 20 20 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 get-all-run-i
0890: 64 73 0a 20 20 20 20 67 65 74 2d 70 72 65 76 2d ds. get-prev-
08a0: 72 75 6e 2d 69 64 73 0a 20 20 20 20 67 65 74 2d run-ids. get-
08b0: 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 run-ids-matching
08c0: 2d 74 61 72 67 65 74 0a 20 20 20 20 67 65 74 2d -target. get-
08d0: 72 75 6e 73 2d 62 79 2d 70 61 74 74 0a 20 20 20 runs-by-patt.
08e0: 20 67 65 74 2d 73 74 65 70 73 2d 64 61 74 61 0a get-steps-data.
08f0: 20 20 20 20 67 65 74 2d 73 74 65 70 73 2d 66 6f get-steps-fo
0900: 72 2d 74 65 73 74 0a 20 20 20 20 72 65 61 64 2d r-test. read-
0910: 74 65 73 74 2d 64 61 74 61 0a 20 20 20 20 72 65 test-data. re
0920: 61 64 2d 74 65 73 74 2d 64 61 74 61 2d 76 61 72 ad-test-data-var
0930: 70 61 74 74 0a 20 20 20 20 6c 6f 67 69 6e 0a 20 patt. login.
0940: 20 20 20 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 tasks-get-las
0950: 74 0a 20 20 20 20 74 65 73 74 6d 65 74 61 2d 67 t. testmeta-g
0960: 65 74 2d 72 65 63 6f 72 64 0a 20 20 20 20 68 61 et-record. ha
0970: 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 0a ve-incompletes?.
0980: 20 20 20 20 3b 3b 20 73 79 6e 63 68 61 73 68 2d ;; synchash-
0990: 67 65 74 0a 20 20 20 20 67 65 74 2d 63 68 61 6e get. get-chan
09a0: 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 0a 20 ged-record-ids.
09b0: 20 20 20 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 get-run-recor
09c0: 64 2d 69 64 73 20 0a 20 20 20 20 67 65 74 2d 6e d-ids . get-n
09d0: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 ot-completed-cnt
09e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 61 70 69 3a ))..(define api:
09f0: 77 72 69 74 65 2d 71 75 65 72 69 65 73 0a 20 20 write-queries.
0a00: 27 28 0a 20 20 20 20 67 65 74 2d 6b 65 79 73 2d '(. get-keys-
0a10: 77 72 69 74 65 20 3b 3b 20 64 75 6d 6d 79 20 22 write ;; dummy "
0a20: 77 72 69 74 65 22 20 71 75 65 72 79 20 74 6f 20 write" query to
0a30: 66 6f 72 63 65 20 73 65 72 76 65 72 20 73 74 61 force server sta
0a40: 72 74 0a 0a 20 20 20 20 3b 3b 20 53 45 52 56 45 rt.. ;; SERVE
0a50: 52 53 0a 20 20 20 20 73 74 61 72 74 2d 73 65 72 RS. start-ser
0a60: 76 65 72 0a 20 20 20 20 6b 69 6c 6c 2d 73 65 72 ver. kill-ser
0a70: 76 65 72 0a 0a 20 20 20 20 3b 3b 20 54 45 53 54 ver.. ;; TEST
0a80: 53 0a 20 20 20 20 74 65 73 74 2d 73 65 74 2d 73 S. test-set-s
0a90: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 tate-status-by-i
0aa0: 64 0a 20 20 20 20 64 65 6c 65 74 65 2d 74 65 73 d. delete-tes
0ab0: 74 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 64 65 t-records. de
0ac0: 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 lete-old-deleted
0ad0: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 0a 20 20 -test-records.
0ae0: 20 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 test-set-state
0af0: 2d 73 74 61 74 75 73 0a 20 20 20 20 74 65 73 74 -status. test
0b00: 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -set-top-process
0b10: 2d 70 69 64 0a 20 20 20 20 73 65 74 2d 73 74 61 -pid. set-sta
0b20: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
0b30: 6c 6c 2d 75 70 2d 69 74 65 6d 73 0a 20 20 20 20 ll-up-items.
0b40: 0a 20 20 20 20 75 70 64 61 74 65 2d 70 61 73 73 . update-pass
0b50: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 0a 20 20 20 -fail-counts.
0b60: 20 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 top-test-set-pe
0b70: 72 2d 70 66 2d 63 6f 75 6e 74 73 20 3b 3b 20 28 r-pf-counts ;; (
0b80: 64 62 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d db:top-test-set-
0b90: 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 28 64 per-pf-counts (d
0ba0: 62 3a 67 65 74 2d 64 62 20 2a 64 62 2a 20 35 29 b:get-db *db* 5)
0bb0: 20 35 20 22 72 75 6e 66 69 72 73 74 22 29 0a 0a 5 "runfirst")..
0bc0: 20 20 20 20 3b 3b 20 52 55 4e 53 0a 20 20 20 20 ;; RUNS.
0bd0: 72 65 67 69 73 74 65 72 2d 72 75 6e 0a 20 20 20 register-run.
0be0: 20 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 set-tests-state
0bf0: 2d 73 74 61 74 75 73 0a 20 20 20 20 64 65 6c 65 -status. dele
0c00: 74 65 2d 72 75 6e 0a 20 20 20 20 6c 6f 63 6b 2f te-run. lock/
0c10: 75 6e 6c 6f 63 6b 2d 72 75 6e 0a 20 20 20 20 75 unlock-run. u
0c20: 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f pdate-run-event_
0c30: 74 69 6d 65 0a 20 20 20 20 6d 61 72 6b 2d 69 6e time. mark-in
0c40: 63 6f 6d 70 6c 65 74 65 0a 20 20 20 20 73 65 74 complete. set
0c50: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e -state-status-an
0c60: 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 0a 20 20 d-roll-up-run.
0c70: 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 20 74 ;; STEPS. t
0c80: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
0c90: 75 73 21 0a 20 20 20 20 64 65 6c 65 74 65 2d 73 us!. delete-s
0ca0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 0a 20 20 teps-for-test.
0cb0: 20 20 3b 3b 20 54 45 53 54 20 44 41 54 41 0a 20 ;; TEST DATA.
0cc0: 20 20 20 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c test-data-rol
0cd0: 6c 75 70 0a 20 20 20 20 63 73 76 2d 3e 74 65 73 lup. csv->tes
0ce0: 74 2d 64 61 74 61 0a 0a 20 20 20 20 3b 3b 20 4d t-data.. ;; M
0cf0: 49 53 43 0a 20 20 20 20 73 79 6e 63 2d 69 6e 6d ISC. sync-inm
0d00: 65 6d 2d 3e 64 62 0a 20 20 20 20 64 72 6f 70 2d em->db. drop-
0d10: 61 6c 6c 2d 74 72 69 67 67 65 72 73 0a 20 20 20 all-triggers.
0d20: 20 63 72 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67 create-all-trig
0d30: 67 65 72 73 0a 20 20 20 20 75 70 64 61 74 65 2d gers. update-
0d40: 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c tesdata-on-repil
0d50: 63 61 74 65 2d 64 62 20 0a 0a 20 20 20 20 3b 3b cate-db .. ;;
0d60: 20 54 45 53 54 4d 45 54 41 0a 20 20 20 20 74 65 TESTMETA. te
0d70: 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 stmeta-add-recor
0d80: 64 0a 20 20 20 20 74 65 73 74 6d 65 74 61 2d 75 d. testmeta-u
0d90: 70 64 61 74 65 2d 66 69 65 6c 64 0a 0a 20 20 20 pdate-field..
0da0: 20 3b 3b 20 54 41 53 4b 53 0a 20 20 20 20 74 61 ;; TASKS. ta
0db0: 73 6b 73 2d 61 64 64 0a 20 20 20 20 74 61 73 6b sks-add. task
0dc0: 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 69 76 65 s-set-state-give
0dd0: 6e 2d 70 61 72 61 6d 2d 6b 65 79 0a 20 20 20 20 n-param-key.
0de0: 29 29 0a 0a 3b 3b 20 54 68 65 73 65 20 61 72 65 ))..;; These are
0df0: 20 63 61 6c 6c 65 64 20 62 79 20 74 68 65 20 73 called by the s
0e00: 65 72 76 65 72 20 6f 6e 20 72 65 63 69 70 74 20 erver on recipt
0e10: 6f 66 20 2f 61 70 69 20 63 61 6c 6c 73 0a 3b 3b of /api calls.;;
0e20: 20 20 20 20 2d 20 6b 65 65 70 20 69 74 20 73 69 - keep it si
0e30: 6d 70 6c 65 2c 20 6f 6e 6c 79 20 72 65 74 75 72 mple, only retur
0e40: 6e 20 74 68 65 20 61 63 74 75 61 6c 20 72 65 73 n the actual res
0e50: 75 6c 74 20 6f 66 20 74 68 65 20 63 61 6c 6c 2c ult of the call,
0e60: 20 69 2e 65 2e 20 6e 6f 20 6d 65 74 61 20 69 6e i.e. no meta in
0e70: 66 6f 20 68 65 72 65 0a 3b 3b 0a 3b 3b 20 20 20 fo here.;;.;;
0e80: 20 2d 20 72 65 74 75 72 6e 73 20 23 28 20 66 6c - returns #( fl
0e90: 61 67 20 72 65 73 75 6c 74 20 29 0a 3b 3b 0a 28 ag result ).;;.(
0ea0: 64 65 66 69 6e 65 20 28 61 70 69 3a 65 78 65 63 define (api:exec
0eb0: 75 74 65 2d 72 65 71 75 65 73 74 73 20 64 62 73 ute-requests dbs
0ec0: 74 72 75 63 74 20 64 61 74 29 0a 20 20 28 68 61 truct dat). (ha
0ed0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
0ee0: 20 20 20 65 78 6e 0a 20 20 20 28 6c 65 74 20 28 exn. (let (
0ef0: 28 63 61 6c 6c 2d 63 68 61 69 6e 20 28 67 65 74 (call-chain (get
0f00: 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 29 29 0a 20 -call-chain))).
0f10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0f20: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
0f30: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
0f40: 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 api:execute-requ
0f50: 65 73 74 73 20 72 65 63 65 69 76 65 64 20 61 6e ests received an
0f60: 20 65 78 63 65 70 74 69 6f 6e 20 66 72 6f 6d 20 exception from
0f70: 70 65 65 72 2c 20 64 61 74 3d 22 20 64 61 74 20 peer, dat=" dat
0f80: 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a 20 20 ", exn=" exn).
0f90: 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 (print-call-c
0fa0: 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 hain (current-er
0fb0: 72 6f 72 2d 70 6f 72 74 29 29 0a 20 20 20 20 20 ror-port)).
0fc0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
0fd0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0fe0: 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 20 * " message: "
0ff0: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
1000: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
1010: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
1020: 29 29 20 20 20 20 20 20 20 0a 20 20 20 20 20 28 )) . (
1030: 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 74 6f vector #f (vecto
1040: 72 20 65 78 6e 20 63 61 6c 6c 2d 63 68 61 69 6e r exn call-chain
1050: 20 64 61 74 29 29 29 20 3b 3b 20 72 65 74 75 72 dat))) ;; retur
1060: 6e 20 73 6f 6d 65 20 73 74 75 66 66 20 66 6f 72 n some stuff for
1070: 20 64 65 62 75 67 20 69 66 20 61 6e 20 65 78 63 debug if an exc
1080: 65 70 74 69 6f 6e 20 68 61 70 70 65 6e 73 0a 20 eption happens.
1090: 20 20 28 63 6f 6e 64 0a 20 20 20 20 28 28 6e 6f (cond. ((no
10a0: 74 20 28 76 65 63 74 6f 72 3f 20 64 61 74 29 29 t (vector? dat))
10b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10c0: 20 20 20 20 3b 3b 20 69 74 20 69 73 20 61 6e 20 ;; it is an
10d0: 65 72 72 6f 72 20 74 6f 20 6e 6f 74 20 72 65 63 error to not rec
10e0: 65 69 76 65 20 61 20 76 65 63 74 6f 72 0a 20 20 eive a vector.
10f0: 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 (vector #f (v
1100: 65 63 74 6f 72 20 23 66 20 22 72 65 6d 6f 74 65 ector #f "remote
1110: 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called
1120: 77 69 74 68 20 61 20 76 65 63 74 6f 72 22 29 29 with a vector"))
1130: 29 0a 20 20 20 20 28 28 3e 20 2a 61 70 69 2d 70 ). ((> *api-p
1140: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 rocess-request-c
1150: 6f 75 6e 74 2a 20 32 30 29 20 3b 3b 20 32 30 29 ount* 20) ;; 20)
1160: 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
1170: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
1180: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
1190: 3a 20 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 : api:execute-re
11a0: 71 75 65 73 74 73 20 72 65 63 65 69 76 65 64 20 quests received
11b0: 61 6e 20 6f 76 65 72 6c 6f 61 64 65 64 20 6d 65 an overloaded me
11c0: 73 73 61 67 65 2e 22 29 0a 20 20 20 20 20 28 73 ssage."). (s
11d0: 65 74 21 20 2a 73 65 72 76 65 72 2d 6f 76 65 72 et! *server-over
11e0: 6c 6f 61 64 65 64 2a 20 23 74 29 0a 20 20 20 20 loaded* #t).
11f0: 20 28 76 65 63 74 6f 72 20 23 66 20 28 76 65 63 (vector #f (vec
1200: 74 6f 72 20 23 66 20 27 6f 76 65 72 6c 6f 61 64 tor #f 'overload
1210: 65 64 29 29 29 20 3b 3b 20 74 68 65 20 69 6e 6e ed))) ;; the inn
1220: 65 72 20 76 65 63 74 6f 72 20 69 73 20 77 68 61 er vector is wha
1230: 74 20 67 65 74 73 20 72 65 74 75 72 6e 65 64 2e t gets returned.
1240: 20 6e 6f 70 65 2c 20 64 6f 6e 27 74 20 6b 6e 6f nope, don't kno
1250: 77 20 77 68 79 2e 20 70 6c 65 61 73 65 20 72 65 w why. please re
1260: 66 61 63 74 6f 72 21 0a 20 20 20 20 28 65 6c 73 factor!. (els
1270: 65 20 20 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 e . (let* (
1280: 28 63 6d 64 2d 69 6e 20 20 20 20 20 20 20 20 20 (cmd-in
1290: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 61 66 65 2d (common:safe-
12a0: 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 20 30 vector-ref dat 0
12b0: 20 27 6e 6f 63 6d 64 29 29 0a 20 20 20 20 20 20 'nocmd)).
12c0: 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 (cmd
12d0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 79 (if (sy
12e0: 6d 62 6f 6c 3f 20 63 6d 64 2d 69 6e 29 0a 09 09 mbol? cmd-in)...
12f0: 09 09 20 20 20 63 6d 64 2d 69 6e 0a 09 09 09 09 .. cmd-in.....
1300: 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 (string->symb
1310: 6f 6c 20 63 6d 64 2d 69 6e 29 29 29 0a 20 20 20 ol cmd-in))).
1320: 20 20 20 20 20 20 20 20 20 28 70 61 72 61 6d 73 (params
1330: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d (com
1340: 6d 6f 6e 3a 73 61 66 65 2d 76 65 63 74 6f 72 2d mon:safe-vector-
1350: 72 65 66 20 64 61 74 20 31 20 27 28 29 29 29 0a ref dat 1 '())).
1360: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 (sta
1370: 72 74 2d 74 20 20 20 20 20 20 20 20 20 20 20 28 rt-t (
1380: 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 current-millisec
1390: 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 onds)).
13a0: 20 20 20 28 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 (readonly-mod
13b0: 65 20 20 20 20 20 28 64 62 72 3a 64 62 73 74 72 e (dbr:dbstr
13c0: 75 63 74 2d 72 65 61 64 2d 6f 6e 6c 79 20 64 62 uct-read-only db
13d0: 73 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 20 struct)).
13e0: 20 20 20 20 20 28 72 65 61 64 6f 6e 6c 79 2d 63 (readonly-c
13f0: 6f 6d 6d 61 6e 64 20 20 28 6d 65 6d 62 65 72 20 ommand (member
1400: 63 6d 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c cmd api:read-onl
1410: 79 2d 71 75 65 72 69 65 73 29 29 0a 20 20 20 20 y-queries)).
1420: 20 20 20 20 20 20 20 20 28 77 72 69 74 65 63 6d (writecm
1430: 64 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f d-in-readonly-mo
1440: 64 65 20 28 61 6e 64 20 72 65 61 64 6f 6e 6c 79 de (and readonly
1450: 2d 6d 6f 64 65 20 28 6e 6f 74 20 72 65 61 64 6f -mode (not reado
1460: 6e 6c 79 2d 63 6f 6d 6d 61 6e 64 29 29 29 0a 20 nly-command))).
1470: 20 20 20 20 20 20 20 20 20 20 20 23 3b 28 66 6f #;(fo
1480: 6f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 o
1490: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
14a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b0: 20 20 20 20 20 20 20 20 23 3b 28 63 6f 6d 6d 6f #;(commo
14c0: 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c 6f 67 20 n:telemetry-log
14d0: 28 63 6f 6e 63 20 22 61 70 69 2d 69 6e 3a 22 28 (conc "api-in:"(
14e0: 2d 3e 73 74 72 69 6e 67 20 63 6d 64 29 29 0a 20 ->string cmd)).
14f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1520: 20 20 20 20 20 20 70 61 79 6c 6f 61 64 3a 20 60 payload: `
1530: 28 28 70 61 72 61 6d 73 20 2e 20 2c 70 61 72 61 ((params . ,para
1540: 6d 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ms))).
1550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1560: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
1570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1580: 20 20 20 20 20 20 20 20 20 23 74 29 29 0a 20 20 #t)).
1590: 20 20 20 20 20 20 20 20 20 20 28 72 65 73 20 20 (res
15a0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15b0: 28 69 66 20 77 72 69 74 65 63 6d 64 2d 69 6e 2d (if writecmd-in-
15c0: 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 0a 20 20 readonly-mode.
15d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
15e0: 63 6f 6e 63 20 22 61 74 74 65 6d 70 74 20 74 6f conc "attempt to
15f0: 20 72 75 6e 20 77 72 69 74 65 20 63 6f 6d 6d 61 run write comma
1600: 6e 64 20 22 63 6d 64 22 20 6f 6e 20 61 20 72 65 nd "cmd" on a re
1610: 61 64 2d 6f 6e 6c 79 20 64 61 74 61 62 61 73 65 ad-only database
1620: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
1630: 20 20 20 20 28 63 61 73 65 20 63 6d 64 0a 20 20 (case cmd.
1640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1650: 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;=============
1660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1680: 3d 3d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ==.
1690: 20 20 20 20 20 20 3b 3b 20 52 45 41 44 2f 57 52 ;; READ/WR
16a0: 49 54 45 20 51 55 45 52 49 45 53 0a 20 20 20 20 ITE QUERIES.
16b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
16c0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
16d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16f0: 0a 0a 09 09 20 20 20 28 28 6e 6f 63 6d 64 29 20 .... ((nocmd)
1700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1710: 20 20 20 20 20 20 20 20 27 28 23 66 20 22 41 6c '(#f "Al
1720: 6c 20 62 72 6f 6b 65 6e 21 22 29 29 0a 0a 20 20 l broken!"))..
1730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1740: 20 28 28 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 ((get-keys-writ
1750: 65 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e)
1760: 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 (db:ge
1770: 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 t-keys dbstruct)
1780: 29 20 3b 3b 20 66 6f 72 63 65 20 61 20 64 75 6d ) ;; force a dum
1790: 6d 79 20 22 77 72 69 74 65 22 20 71 75 65 72 79 my "write" query
17a0: 20 74 6f 20 66 6f 72 63 65 20 73 65 72 76 65 72 to force server
17b0: 3b 20 66 6f 72 20 64 65 62 75 67 20 69 6e 20 2d ; for debug in -
17c0: 72 65 70 6c 0a 20 20 20 20 20 20 20 20 20 20 20 repl.
17d0: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 .
17e0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 53 ;; S
17f0: 45 52 56 45 52 53 0a 20 20 20 20 20 20 20 20 20 ERVERS.
1800: 20 20 20 20 20 20 20 20 20 20 28 28 73 74 61 72 ((star
1810: 74 2d 73 65 72 76 65 72 29 20 20 20 20 20 20 20 t-server)
1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
1830: 70 6c 79 20 73 65 72 76 65 72 3a 6b 69 6e 64 2d ply server:kind-
1840: 72 75 6e 20 70 61 72 61 6d 73 29 29 0a 20 20 20 run params)).
1850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1860: 28 28 6b 69 6c 6c 2d 73 65 72 76 65 72 29 20 20 ((kill-server)
1870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1880: 20 20 20 28 73 65 74 21 20 2a 73 65 72 76 65 72 (set! *server
1890: 2d 72 75 6e 2a 20 23 66 29 29 0a 0a 20 20 20 20 -run* #f))..
18a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
18b0: 3b 20 54 45 53 54 53 0a 0a 20 20 20 20 20 20 20 ; TESTS..
18c0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 28 ;;((
18d0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
18e0: 74 61 74 75 73 2d 62 79 2d 69 64 29 20 20 20 20 tatus-by-id)
18f0: 20 28 61 70 70 6c 79 20 6d 74 3a 74 65 73 74 2d (apply mt:test-
1900: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1910: 2d 62 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 -by-id dbstruct
1920: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
1930: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 42 42 ;;BB
1940: 20 2d 20 63 6f 6d 6d 65 6e 74 65 64 20 6f 75 74 - commented out
1950: 20 61 62 6f 76 65 20 62 65 63 61 75 73 65 20 69 above because i
1960: 74 20 77 61 73 20 63 61 6c 6c 69 6e 67 20 62 65 t was calling be
1970: 6c 6f 77 2c 20 65 76 65 6e 74 75 61 6c 6c 79 2c low, eventually,
1980: 20 69 6e 63 6f 72 72 65 63 74 6c 79 20 28 64 62 incorrectly (db
1990: 73 74 72 75 63 74 20 70 61 73 73 65 64 20 74 6f struct passed to
19a0: 20 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 mt:test-set-sta
19b0: 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 2c te-status-by-id,
19c0: 20 77 68 69 63 68 20 70 72 65 76 69 6f 73 6c 79 which previosly
19d0: 20 64 69 64 20 6d 6f 72 65 2c 20 62 75 74 20 6e did more, but n
19e0: 6f 77 20 6f 6e 6c 79 20 70 61 73 73 65 73 20 74 ow only passes t
19f0: 68 72 75 20 74 6f 20 64 62 3a 73 65 74 2d 73 74 hru to db:set-st
1a00: 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
1a10: 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 2e 0a 20 20 oll-up-items..
1a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a30: 20 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ((test-set-stat
1a40: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 29 0a e-status-by-id).
1a50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a60: 20 20 20 20 20 3b 3b 20 28 64 65 66 69 6e 65 20 ;; (define
1a70: 28 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 (db:set-state-st
1a80: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
1a90: 2d 69 74 65 6d 73 20 64 62 73 74 72 75 63 74 20 -items dbstruct
1aa0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
1ab0: 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 65 item-path state
1ac0: 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 status comment)
1ad0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ae0: 20 20 20 20 20 28 64 62 3a 73 65 74 2d 73 74 61 (db:set-sta
1af0: 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f te-status-and-ro
1b00: 6c 6c 2d 75 70 2d 69 74 65 6d 73 0a 20 20 20 20 ll-up-items.
1b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b20: 20 64 62 73 74 72 75 63 74 0a 20 20 20 20 20 20 dbstruct.
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1b40: 6c 69 73 74 2d 72 65 66 20 70 61 72 61 6d 73 20 list-ref params
1b50: 30 29 20 3b 20 72 75 6e 2d 69 64 0a 20 20 20 20 0) ; run-id.
1b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b70: 20 28 6c 69 73 74 2d 72 65 66 20 70 61 72 61 6d (list-ref param
1b80: 73 20 31 29 20 3b 20 74 65 73 74 2d 6e 61 6d 65 s 1) ; test-name
1b90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ba0: 20 20 20 20 20 20 23 66 20 20 20 20 20 20 20 20 #f
1bb0: 20 20 20 20 20 20 20 20 20 20 3b 20 69 74 65 6d ; item
1bc0: 2d 70 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 -path.
1bd0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
1be0: 2d 72 65 66 20 70 61 72 61 6d 73 20 32 29 20 3b -ref params 2) ;
1bf0: 20 73 74 61 74 65 0a 20 20 20 20 20 20 20 20 20 state.
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
1c10: 74 2d 72 65 66 20 70 61 72 61 6d 73 20 33 29 20 t-ref params 3)
1c20: 3b 20 73 74 61 74 75 73 0a 20 20 20 20 20 20 20 ; status.
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1c40: 69 73 74 2d 72 65 66 20 70 61 72 61 6d 73 20 34 ist-ref params 4
1c50: 29 20 3b 20 63 6f 6d 6d 65 6e 74 0a 20 20 20 20 ) ; comment.
1c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c70: 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 )).
1c80: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
1c90: 20 20 20 20 20 20 20 20 20 20 20 28 28 64 65 6c ((del
1ca0: 65 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 ete-test-records
1cb0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 ) (a
1cc0: 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 74 pply db:delete-t
1cd0: 65 73 74 2d 72 65 63 6f 72 64 73 20 64 62 73 74 est-records dbst
1ce0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
1cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d00: 20 28 28 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 ((delete-old-de
1d10: 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 leted-test-recor
1d20: 64 73 29 20 28 61 70 70 6c 79 20 64 62 3a 64 65 ds) (apply db:de
1d30: 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 lete-old-deleted
1d40: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 64 62 -test-records db
1d50: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
1d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d70: 20 20 20 28 28 74 65 73 74 2d 73 65 74 2d 73 74 ((test-set-st
1d80: 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 20 20 ate-status)
1d90: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
1da0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
1db0: 74 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 tatus dbstruct p
1dc0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
1dd0: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
1de0: 74 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 t-set-top-proces
1df0: 73 2d 70 69 64 29 20 20 20 20 20 20 20 20 28 61 s-pid) (a
1e00: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 73 65 74 pply db:test-set
1e10: 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 -top-process-pid
1e20: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
1e30: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1e40: 20 20 20 20 20 20 28 28 73 65 74 2d 73 74 61 74 ((set-stat
1e50: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
1e60: 6c 2d 75 70 2d 69 74 65 6d 73 29 20 28 61 70 70 l-up-items) (app
1e70: 6c 79 20 64 62 3a 73 65 74 2d 73 74 61 74 65 2d ly db:set-state-
1e80: 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d status-and-roll-
1e90: 75 70 2d 69 74 65 6d 73 20 64 62 73 74 72 75 63 up-items dbstruc
1ea0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
1eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1ec0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1ed0: 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e -and-roll-up-run
1ee0: 29 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d ) (apply db:set-
1ef0: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 state-status-and
1f00: 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 20 64 62 73 -roll-up-run dbs
1f10: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a truct params)) .
1f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f30: 20 20 20 28 28 74 6f 70 2d 74 65 73 74 2d 73 65 ((top-test-se
1f40: 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 29 t-per-pf-counts)
1f50: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
1f60: 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 top-test-set-per
1f70: 2d 70 66 2d 63 6f 75 6e 74 73 20 64 62 73 74 72 -pf-counts dbstr
1f80: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
1f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fa0: 28 28 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 ((test-set-archi
1fb0: 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 20 20 20 20 ve-block-id)
1fc0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 (apply db:tes
1fd0: 74 2d 73 65 74 2d 61 72 63 68 69 76 65 2d 62 6c t-set-archive-bl
1fe0: 6f 63 6b 2d 69 64 20 64 62 73 74 72 75 63 74 20 ock-id dbstruct
1ff0: 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 params))..
2000: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
2010: 52 55 4e 53 0a 20 20 20 20 20 20 20 20 20 20 20 RUNS.
2020: 20 20 20 20 20 20 20 20 28 28 72 65 67 69 73 74 ((regist
2030: 65 72 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 er-run)
2040: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2050: 62 3a 72 65 67 69 73 74 65 72 2d 72 75 6e 20 64 b:register-run d
2060: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2070: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2080: 20 20 20 20 28 28 73 65 74 2d 74 65 73 74 73 2d ((set-tests-
2090: 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 state-status)
20a0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 65 (apply db:se
20b0: 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 t-tests-state-st
20c0: 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 atus dbstruct pa
20d0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
20e0: 20 20 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 ((dele
20f0: 74 65 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 te-run)
2100: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
2110: 20 64 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 64 db:delete-run d
2120: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2130: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2140: 20 20 20 20 28 28 6c 6f 63 6b 2f 75 6e 6c 6f 63 ((lock/unloc
2150: 6b 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 k-run)
2160: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6c 6f (apply db:lo
2170: 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 64 62 ck/unlock-run db
2180: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21a0: 20 20 20 28 28 75 70 64 61 74 65 2d 72 75 6e 2d ((update-run-
21b0: 65 76 65 6e 74 5f 74 69 6d 65 29 20 20 20 20 20 event_time)
21c0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 75 70 64 (apply db:upd
21d0: 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 ate-run-event_ti
21e0: 6d 65 20 64 62 73 74 72 75 63 74 20 70 61 72 61 me dbstruct para
21f0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
2200: 20 20 20 20 20 20 20 20 28 28 75 70 64 61 74 65 ((update
2210: 2d 72 75 6e 2d 73 74 61 74 73 29 20 20 20 20 20 -run-stats)
2220: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2230: 62 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 b:update-run-sta
2240: 74 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ts dbstruct para
2250: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
2260: 20 20 20 20 20 20 20 20 28 28 73 65 74 2d 76 61 ((set-va
2270: 72 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r)
2280: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2290: 62 3a 73 65 74 2d 76 61 72 20 64 62 73 74 72 75 b:set-var dbstru
22a0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
22b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
22c0: 28 69 6e 63 2d 76 61 72 29 20 20 20 20 20 20 20 (inc-var)
22d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
22e0: 61 70 70 6c 79 20 64 62 3a 69 6e 63 2d 76 61 72 apply db:inc-var
22f0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2300: 29 29 0a 09 09 20 20 20 28 28 64 65 63 2d 76 61 ))... ((dec-va
2310: 72 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r)
2320: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
2330: 62 3a 64 65 63 2d 76 61 72 20 64 62 73 74 72 75 b:dec-var dbstru
2340: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2360: 28 64 65 6c 2d 76 61 72 29 20 20 20 20 20 20 20 (del-var)
2370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2380: 61 70 70 6c 79 20 64 62 3a 64 65 6c 2d 76 61 72 apply db:del-var
2390: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
23a0: 29 29 0a 09 09 20 20 20 28 28 61 64 64 2d 76 61 ))... ((add-va
23b0: 72 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r)
23c0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
23d0: 62 3a 61 64 64 2d 76 61 72 20 64 62 73 74 72 75 b:add-var dbstru
23e0: 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 ct params))..
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 3b 3b 20 53 54 45 50 53 0a 20 20 20 20 20 20 20 ;; STEPS.
2410: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 ((te
2420: 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
2430: 73 21 29 20 20 20 20 20 20 20 20 20 28 61 70 70 s!) (app
2440: 6c 79 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 ly db:teststep-s
2450: 65 74 2d 73 74 61 74 75 73 21 20 64 62 73 74 72 et-status! dbstr
2460: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2480: 28 28 64 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 ((delete-steps-f
2490: 6f 72 2d 74 65 73 74 21 29 20 20 20 20 20 20 20 or-test!)
24a0: 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 (apply db:delet
24b0: 65 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 e-steps-for-test
24c0: 21 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d ! dbstruct param
24d0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
24e0: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
24f0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 ;; TE
2500: 53 54 20 44 41 54 41 0a 20 20 20 20 20 20 20 20 ST DATA.
2510: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
2520: 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 29 20 20 t-data-rollup)
2530: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
2540: 79 20 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 72 y db:test-data-r
2550: 6f 6c 6c 75 70 20 64 62 73 74 72 75 63 74 20 70 ollup dbstruct p
2560: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
2570: 20 20 20 20 20 20 20 20 20 20 20 28 28 63 73 76 ((csv
2580: 2d 3e 74 65 73 74 2d 64 61 74 61 29 20 20 20 20 ->test-data)
2590: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
25a0: 79 20 64 62 3a 63 73 76 2d 3e 74 65 73 74 2d 64 y db:csv->test-d
25b0: 61 74 61 20 64 62 73 74 72 75 63 74 20 70 61 72 ata dbstruct par
25c0: 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 20 ams))..
25d0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4d 49 53 ;; MIS
25e0: 43 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 C.
25f0: 20 20 20 20 20 28 28 73 79 6e 63 2d 69 6e 6d 65 ((sync-inme
2600: 6d 2d 3e 64 62 29 20 20 20 20 20 20 20 20 20 20 m->db)
2610: 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 6e 2d (let ((run-
2620: 69 64 20 28 63 61 72 20 70 61 72 61 6d 73 29 29 id (car params))
2630: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2660: 20 20 20 20 20 20 20 28 64 62 3a 73 79 6e 63 2d (db:sync-
2670: 74 6f 75 63 68 65 64 20 64 62 73 74 72 75 63 74 touched dbstruct
2680: 20 72 75 6e 2d 69 64 20 66 6f 72 63 65 2d 73 79 run-id force-sy
2690: 6e 63 3a 20 23 74 29 29 29 0a 20 20 20 20 20 20 nc: #t))).
26a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6d ((m
26b0: 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 29 20 ark-incomplete)
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
26d0: 70 6c 79 20 64 62 3a 66 69 6e 64 2d 61 6e 64 2d ply db:find-and-
26e0: 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 mark-incomplete
26f0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2700: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2710: 20 20 20 20 20 28 28 63 72 65 61 74 65 2d 61 6c ((create-al
2720: 6c 2d 74 72 69 67 67 65 72 73 29 20 20 20 20 20 l-triggers)
2730: 20 20 20 20 20 28 64 62 3a 63 72 65 61 74 65 2d (db:create-
2740: 61 6c 6c 2d 74 72 69 67 67 65 72 73 20 64 62 73 all-triggers dbs
2750: 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 20 20 truct)).
2760: 20 20 20 20 20 20 20 20 20 20 20 28 28 64 72 6f ((dro
2770: 70 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 29 20 p-all-triggers)
2780: 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 64 (db:d
2790: 72 6f 70 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 rop-all-triggers
27a0: 20 64 62 73 74 72 75 63 74 29 29 20 0a 0a 20 20 dbstruct)) ..
27b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27c0: 20 3b 3b 20 54 45 53 54 4d 45 54 41 0a 20 20 20 ;; TESTMETA.
27d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27e0: 28 28 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 ((testmeta-add-r
27f0: 65 63 6f 72 64 29 20 20 20 20 20 20 20 28 61 70 ecord) (ap
2800: 70 6c 79 20 64 62 3a 74 65 73 74 6d 65 74 61 2d ply db:testmeta-
2810: 61 64 64 2d 72 65 63 6f 72 64 20 64 62 73 74 72 add-record dbstr
2820: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2840: 28 28 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 ((testmeta-updat
2850: 65 2d 66 69 65 6c 64 29 20 20 20 20 20 28 61 70 e-field) (ap
2860: 70 6c 79 20 64 62 3a 74 65 73 74 6d 65 74 61 2d ply db:testmeta-
2870: 75 70 64 61 74 65 2d 66 69 65 6c 64 20 64 62 73 update-field dbs
2880: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28a0: 20 20 28 28 67 65 74 2d 74 65 73 74 73 2d 74 61 ((get-tests-ta
28b0: 67 73 29 20 20 20 20 20 20 20 20 20 20 20 20 28 gs) (
28c0: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 74 61 67 db:get-tests-tag
28d0: 73 20 64 62 73 74 72 75 63 74 29 29 0a 0a 20 20 s dbstruct))..
28e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28f0: 20 3b 3b 20 54 41 53 4b 53 0a 20 20 20 20 20 20 ;; TASKS.
2900: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 ((t
2910: 61 73 6b 73 2d 61 64 64 29 20 20 20 20 20 20 20 asks-add)
2920: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
2930: 20 74 61 73 6b 73 3a 61 64 64 20 64 62 73 74 72 tasks:add dbstr
2940: 75 63 74 20 70 61 72 61 6d 73 29 29 20 20 20 0a uct params)) .
2950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2960: 20 20 20 28 28 74 61 73 6b 73 2d 73 65 74 2d 73 ((tasks-set-s
2970: 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d tate-given-param
2980: 2d 6b 65 79 29 20 28 61 70 70 6c 79 20 74 61 73 -key) (apply tas
2990: 6b 73 3a 73 65 74 2d 73 74 61 74 65 2d 67 69 76 ks:set-state-giv
29a0: 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 20 64 62 73 en-param-key dbs
29b0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
29c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29d0: 20 20 28 28 74 61 73 6b 73 2d 67 65 74 2d 6c 61 ((tasks-get-la
29e0: 73 74 29 20 20 20 20 20 20 20 20 20 20 20 20 28 st) (
29f0: 61 70 70 6c 79 20 74 61 73 6b 73 3a 67 65 74 2d apply tasks:get-
2a00: 6c 61 73 74 20 64 62 73 74 72 75 63 74 20 70 61 last dbstruct pa
2a10: 72 61 6d 73 29 29 0a 0a 09 09 20 20 20 3b 3b 20 rams)).... ;;
2a20: 4e 4f 20 53 59 4e 43 20 44 42 0a 09 09 20 20 20 NO SYNC DB...
2a30: 28 28 6e 6f 2d 73 79 6e 63 2d 73 65 74 29 20 20 ((no-sync-set)
2a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
2a50: 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 73 ply db:no-sync-s
2a60: 65 74 20 20 20 20 20 20 20 20 20 2a 6e 6f 2d 73 et *no-s
2a70: 79 6e 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 ync-db* params))
2a80: 0a 09 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d ... ((no-sync-
2a90: 67 65 74 2f 64 65 66 61 75 6c 74 29 20 20 20 20 get/default)
2aa0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d (apply db:no-
2ab0: 73 79 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c 74 sync-get/default
2ac0: 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 *no-sync-db* pa
2ad0: 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 6e 6f rams))... ((no
2ae0: 2d 73 79 6e 63 2d 64 65 6c 21 29 20 20 20 20 20 -sync-del!)
2af0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2b00: 64 62 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 db:no-sync-del!
2b10: 20 20 20 20 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d *no-sync-
2b20: 64 62 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 db* params))...
2b30: 20 20 28 28 6e 6f 2d 73 79 6e 63 2d 67 65 74 2d ((no-sync-get-
2b40: 6c 6f 63 6b 29 20 20 20 20 20 20 20 20 20 20 28 lock) (
2b50: 61 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 apply db:no-sync
2b60: 2d 67 65 74 2d 6c 6f 63 6b 20 20 20 20 2a 6e 6f -get-lock *no
2b70: 2d 73 79 6e 63 2d 64 62 2a 20 70 61 72 61 6d 73 -sync-db* params
2b80: 29 29 0a 09 09 20 20 20 28 28 6e 6f 2d 73 79 6e ))... ((no-syn
2b90: 63 2d 61 64 64 2d 6a 6f 62 29 20 20 20 20 20 20 c-add-job)
2ba0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6e (apply db:n
2bb0: 6f 2d 73 79 6e 63 2d 61 64 64 2d 6a 6f 62 20 20 o-sync-add-job
2bc0: 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 *no-sync-db*
2bd0: 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 params))... ((
2be0: 6e 6f 2d 73 79 6e 63 2d 74 61 6b 65 2d 6a 6f 62 no-sync-take-job
2bf0: 29 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c ) (appl
2c00: 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 74 61 6b y db:no-sync-tak
2c10: 65 2d 6a 6f 62 20 20 20 20 2a 6e 6f 2d 73 79 6e e-job *no-syn
2c20: 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 0a 09 c-db* params))..
2c30: 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d 6a 6f . ((no-sync-jo
2c40: 62 2d 72 65 63 6f 72 64 73 2d 63 6c 65 61 6e 29 b-records-clean)
2c50: 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 (apply db:no-sy
2c60: 6e 63 2d 6a 6f 62 2d 72 65 63 6f 72 64 73 2d 63 nc-job-records-c
2c70: 6c 65 61 6e 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 lean *no-sync-db
2c80: 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 * params))...
2c90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2ca0: 20 20 20 20 3b 3b 20 41 52 43 48 49 56 45 53 0a ;; ARCHIVES.
2cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2cc0: 20 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 2d ;; ((archive-
2cd0: 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 29 get-allocations)
2ce0: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
2cf0: 20 20 20 20 20 20 20 28 28 61 72 63 68 69 76 65 ((archive
2d00: 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b 29 20 -register-disk)
2d10: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 61 72 (apply db:ar
2d20: 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 64 chive-register-d
2d30: 69 73 6b 20 64 62 73 74 72 75 63 74 20 70 61 72 isk dbstruct par
2d40: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
2d50: 20 20 20 20 20 20 20 20 20 28 28 61 72 63 68 69 ((archi
2d60: 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 ve-register-bloc
2d70: 6b 2d 6e 61 6d 65 29 28 61 70 70 6c 79 20 64 62 k-name)(apply db
2d80: 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 :archive-registe
2d90: 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 64 62 73 r-block-name dbs
2da0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 2d 61 ;; ((archive-a
2dd0: 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74 llocate-testsuit
2de0: 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 29 e/area-to-block)
2df0: 28 61 70 70 6c 79 20 64 62 3a 61 72 63 68 69 76 (apply db:archiv
2e00: 65 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 e-allocate-tests
2e10: 75 69 74 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f uite/area-to-blo
2e20: 63 6b 20 64 62 73 74 72 75 63 74 20 62 6c 6f 63 ck dbstruct bloc
2e30: 6b 2d 69 64 20 74 65 73 74 73 75 69 74 65 2d 6e k-id testsuite-n
2e40: 61 6d 65 20 61 72 65 61 6b 65 79 29 29 0a 09 09 ame areakey))...
2e50: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
2e60: 20 20 20 20 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d ;;=======
2e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ec0: 20 20 20 3b 3b 20 52 45 41 44 20 4f 4e 4c 59 20 ;; READ ONLY
2ed0: 51 55 45 52 49 45 53 0a 20 20 20 20 20 20 20 20 QUERIES.
2ee0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 3d 3d 3d ;;===
2ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f30: 3d 3d 3d 0a 0a 20 20 20 20 20 20 20 20 20 20 20 ===..
2f40: 20 20 20 20 20 20 20 20 3b 3b 20 4b 45 59 53 0a ;; KEYS.
2f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f60: 20 20 20 28 28 67 65 74 2d 6b 65 79 2d 76 61 6c ((get-key-val
2f70: 2d 70 61 69 72 73 29 20 20 20 20 20 20 20 20 20 -pairs)
2f80: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
2f90: 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 get-key-val-pair
2fa0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
2fb0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
2fc0: 20 20 20 20 20 20 20 28 28 67 65 74 2d 6b 65 79 ((get-key
2fd0: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s)
2fe0: 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 (db:ge
2ff0: 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 t-keys dbstruct)
3000: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3010: 20 20 20 20 20 28 28 67 65 74 2d 6b 65 79 2d 76 ((get-key-v
3020: 61 6c 73 29 20 20 20 20 20 20 20 20 20 20 20 20 als)
3030: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3040: 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 b:get-key-vals d
3050: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3060: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3070: 20 20 20 20 28 28 67 65 74 2d 74 61 72 67 65 74 ((get-target
3080: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3090: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
30a0: 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 73 74 :get-target dbst
30b0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
30c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30d0: 20 28 28 67 65 74 2d 74 61 72 67 65 74 73 29 20 ((get-targets)
30e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30f0: 20 20 20 20 28 64 62 3a 67 65 74 2d 74 61 72 67 (db:get-targ
3100: 65 74 73 20 64 62 73 74 72 75 63 74 29 29 0a 0a ets dbstruct))..
3110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3120: 20 20 20 3b 3b 20 41 52 43 48 49 56 45 53 0a 20 ;; ARCHIVES.
3130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3140: 20 20 28 28 74 65 73 74 2d 67 65 74 2d 61 72 63 ((test-get-arc
3150: 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f 29 hive-block-info)
3160: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
3170: 65 73 74 2d 67 65 74 2d 61 72 63 68 69 76 65 2d est-get-archive-
3180: 62 6c 6f 63 6b 2d 69 6e 66 6f 20 64 62 73 74 72 block-info dbstr
3190: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
31a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
31c0: 20 20 20 20 3b 3b 20 54 45 53 54 53 0a 20 20 20 ;; TESTS.
31d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31e0: 28 28 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d ((test-toplevel-
31f0: 6e 75 6d 2d 69 74 65 6d 73 29 20 20 20 20 20 20 num-items)
3200: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 (apply db:tes
3210: 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69 t-toplevel-num-i
3220: 74 65 6d 73 20 64 62 73 74 72 75 63 74 20 70 61 tems dbstruct pa
3230: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3240: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3250: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 test-info-by-id)
3260: 09 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 . (apply d
3270: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
3280: 62 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 by-id dbstruct p
3290: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
32a0: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
32b0: 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f t-get-rundir-fro
32c0: 6d 2d 74 65 73 74 2d 69 64 29 20 20 20 20 28 61 m-test-id) (a
32d0: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 pply db:test-get
32e0: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 -rundir-from-tes
32f0: 74 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 t-id dbstruct pa
3300: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3310: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3320: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
3330: 69 6e 67 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 ing-for-testname
3340: 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d ) (apply db:get-
3350: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
3360: 69 6e 67 2d 66 6f 72 2d 74 65 73 74 6e 61 6d 65 ing-for-testname
3370: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3380: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3390: 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f 75 6e ((get-coun
33a0: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 29 t-tests-running)
33b0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
33c0: 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 db:get-count-tes
33d0: 74 73 2d 72 75 6e 6e 69 6e 67 20 64 62 73 74 72 ts-running dbstr
33e0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
33f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3400: 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 ((get-count-test
3410: 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 s-running-in-job
3420: 67 72 6f 75 70 29 20 28 61 70 70 6c 79 20 64 62 group) (apply db
3430: 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 :get-count-tests
3440: 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 -running-in-jobg
3450: 72 6f 75 70 20 64 62 73 74 72 75 63 74 20 70 61 roup dbstruct pa
3460: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3470: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 64 ;; ((d
3480: 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 70 2d elete-test-step-
3490: 72 65 63 6f 72 64 73 29 20 20 20 20 20 20 20 20 records)
34a0: 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 (apply db:delete
34b0: 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 -test-step-recor
34c0: 64 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ds dbstruct para
34d0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
34e0: 20 20 20 20 20 20 20 20 3b 3b 20 28 28 67 65 74 ;; ((get
34f0: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
3500: 75 6e 2d 72 65 63 6f 72 64 29 20 20 20 20 28 61 un-record) (a
3510: 70 70 6c 79 20 64 62 3a 67 65 74 2d 70 72 65 76 pply db:get-prev
3520: 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 ious-test-run-re
3530: 63 6f 72 64 20 64 62 73 74 72 75 63 74 20 70 61 cord dbstruct pa
3540: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3550: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3560: 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 matching-previou
3570: 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 s-test-run-recor
3580: 64 73 29 28 61 70 70 6c 79 20 64 62 3a 67 65 74 ds)(apply db:get
3590: 2d 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f -matching-previo
35a0: 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f us-test-run-reco
35b0: 72 64 73 20 64 62 73 74 72 75 63 74 20 70 61 72 rds dbstruct par
35c0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
35d0: 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d ((test-
35e0: 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f get-logfile-info
35f0: 29 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 ) (app
3600: 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 6c ly db:test-get-l
3610: 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 64 62 73 74 ogfile-info dbst
3620: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3640: 20 28 28 74 65 73 74 2d 67 65 74 2d 72 65 63 6f ((test-get-reco
3650: 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 rds-for-index-fi
3660: 6c 65 29 20 20 28 61 70 70 6c 79 20 64 62 3a 74 le) (apply db:t
3670: 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d est-get-records-
3680: 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 64 for-index-file d
3690: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
36a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
36b0: 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 69 6e ((get-testin
36c0: 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 fo-state-status)
36d0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
36e0: 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 :get-testinfo-st
36f0: 61 74 65 2d 73 74 61 74 75 73 20 64 62 73 74 72 ate-status dbstr
3700: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
3710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3720: 28 28 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 ((test-get-top-p
3730: 72 6f 63 65 73 73 2d 70 69 64 29 20 20 20 20 20 rocess-pid)
3740: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 (apply db:tes
3750: 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 t-get-top-proces
3760: 73 2d 70 69 64 20 64 62 73 74 72 75 63 74 20 70 s-pid dbstruct p
3770: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3780: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 ((tes
3790: 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 t-get-paths-matc
37a0: 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 hing-keynames-ta
37b0: 72 67 65 74 2d 6e 65 77 29 20 28 61 70 70 6c 79 rget-new) (apply
37c0: 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 db:test-get-pat
37d0: 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e hs-matching-keyn
37e0: 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 20 ames-target-new
37f0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3800: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3810: 20 20 20 20 20 28 28 67 65 74 2d 70 72 65 72 65 ((get-prere
3820: 71 73 2d 6e 6f 74 2d 6d 65 74 29 20 20 20 20 20 qs-not-met)
3830: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3840: 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f b:get-prereqs-no
3850: 74 2d 6d 65 74 20 64 62 73 74 72 75 63 74 20 70 t-met dbstruct p
3860: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3870: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 ((get
3880: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
3890: 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 29 ning-for-run-id)
38a0: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 (apply db:get-c
38b0: 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 ount-tests-runni
38c0: 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 64 62 ng-for-run-id db
38d0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
38e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38f0: 20 20 20 28 28 67 65 74 2d 6e 6f 74 2d 63 6f 6d ((get-not-com
3900: 70 6c 65 74 65 64 2d 63 6e 74 29 20 20 20 20 20 pleted-cnt)
3910: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
3920: 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 get-not-complete
3930: 64 2d 63 6e 74 20 20 64 62 73 74 72 75 63 74 20 d-cnt dbstruct
3940: 70 61 72 61 6d 73 29 29 20 0a 20 20 20 20 20 20 params)) .
3950: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
3960: 28 28 73 79 6e 63 68 61 73 68 2d 67 65 74 29 20 ((synchash-get)
3970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3980: 20 20 20 28 61 70 70 6c 79 20 73 79 6e 63 68 61 (apply syncha
3990: 73 68 3a 73 65 72 76 65 72 2d 67 65 74 20 64 62 sh:server-get db
39a0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
39b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39c0: 20 20 20 28 28 67 65 74 2d 72 61 77 2d 72 75 6e ((get-raw-run
39d0: 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 20 20 -stats)
39e0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
39f0: 67 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 get-raw-run-stat
3a00: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
3a10: 73 29 29 0a 09 09 20 20 20 28 28 67 65 74 2d 74 s))... ((get-t
3a20: 65 73 74 2d 74 69 6d 65 73 29 20 20 20 20 20 20 est-times)
3a30: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
3a40: 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 74 ly db:get-test-t
3a50: 69 6d 65 73 20 64 62 73 74 72 75 63 74 20 70 61 imes dbstruct pa
3a60: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
3a70: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 52 55 ;; RU
3a80: 4e 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 NS.
3a90: 20 20 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d ((get-run-
3aa0: 69 6e 66 6f 29 20 20 20 20 20 20 20 20 20 20 20 info)
3ab0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
3ac0: 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 73 get-run-info dbs
3ad0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3af0: 20 20 28 28 67 65 74 2d 72 75 6e 2d 73 74 61 74 ((get-run-stat
3b00: 75 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 us)
3b10: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
3b20: 72 75 6e 2d 73 74 61 74 75 73 20 64 62 73 74 72 run-status dbstr
3b30: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
3b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b50: 28 28 67 65 74 2d 72 75 6e 2d 73 74 61 74 65 29 ((get-run-state)
3b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b70: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 (apply db:get-ru
3b80: 6e 2d 73 74 61 74 65 20 64 62 73 74 72 75 63 74 n-state dbstruct
3b90: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 params)).
3ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 ((s
3bb0: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 29 20 20 et-run-status)
3bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
3bd0: 70 6c 79 20 64 62 3a 73 65 74 2d 72 75 6e 2d 73 ply db:set-run-s
3be0: 74 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 tatus dbstruct p
3bf0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
3c00: 20 20 20 20 20 20 20 20 20 20 20 28 28 73 65 74 ((set
3c10: 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 -run-state-statu
3c20: 73 29 20 20 09 09 09 20 28 61 70 70 6c 79 20 64 s) ... (apply d
3c30: 62 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 65 2d b:set-run-state-
3c40: 73 74 61 74 75 73 20 64 62 73 74 72 75 63 74 20 status dbstruct
3c50: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 params)).
3c60: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 75 70 ((up
3c70: 64 61 74 65 2d 74 65 73 64 61 74 61 2d 6f 6e 2d date-tesdata-on-
3c80: 72 65 70 69 6c 63 61 74 65 2d 64 62 29 20 28 61 repilcate-db) (a
3c90: 70 70 6c 79 20 64 62 3a 75 70 64 61 74 65 2d 74 pply db:update-t
3ca0: 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 esdata-on-repilc
3cb0: 61 74 65 2d 64 62 20 20 64 62 73 74 72 75 63 74 ate-db dbstruct
3cc0: 20 70 61 72 61 6d 73 29 29 20 0a 20 20 20 20 20 params)) .
3cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
3ce0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
3cf0: 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 28 61 n) (a
3d00: 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 pply db:get-test
3d10: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 72 75 s-for-run dbstru
3d20: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3d40: 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 (get-tests-for-r
3d50: 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 un-state-status)
3d60: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 (apply db:get-t
3d70: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 ests-for-run-sta
3d80: 74 65 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 te-status dbstru
3d90: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3db0: 28 67 65 74 2d 74 65 73 74 2d 69 64 29 20 20 20 (get-test-id)
3dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3dd0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 apply db:get-tes
3de0: 74 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 t-id dbstruct pa
3df0: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
3e00: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
3e10: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 tests-for-run-mi
3e20: 6e 64 61 74 61 29 20 20 20 20 28 61 70 70 6c 79 ndata) (apply
3e30: 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f db:get-tests-fo
3e40: 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 64 62 r-run-mindata db
3e50: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e70: 20 20 20 3b 3b 20 28 28 67 65 74 2d 74 65 73 74 ;; ((get-test
3e80: 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 s-for-runs-minda
3e90: 74 61 29 20 20 20 28 61 70 70 6c 79 20 64 62 3a ta) (apply db:
3ea0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
3eb0: 6e 73 2d 6d 69 6e 64 61 74 61 20 64 62 73 74 72 ns-mindata dbstr
3ec0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ee0: 28 28 67 65 74 2d 72 75 6e 73 29 20 20 20 20 20 ((get-runs)
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f00: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 (apply db:get-ru
3f10: 6e 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ns dbstruct para
3f20: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
3f30: 20 20 20 20 20 20 20 20 28 28 73 69 6d 70 6c 65 ((simple
3f40: 2d 67 65 74 2d 72 75 6e 73 29 20 20 20 20 20 20 -get-runs)
3f50: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3f60: 62 3a 73 69 6d 70 6c 65 2d 67 65 74 2d 72 75 6e b:simple-get-run
3f70: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
3f80: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3f90: 20 20 20 20 20 20 20 28 28 67 65 74 2d 6e 75 6d ((get-num
3fa0: 2d 72 75 6e 73 29 20 20 20 20 20 20 20 20 20 20 -runs)
3fb0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
3fc0: 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 64 62 :get-num-runs db
3fd0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ff0: 20 20 20 28 28 67 65 74 2d 72 75 6e 73 2d 63 6e ((get-runs-cn
4000: 74 2d 62 79 2d 70 61 74 74 29 20 20 20 20 20 20 t-by-patt)
4010: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
4020: 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 -runs-cnt-by-pat
4030: 74 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d t dbstruct param
4040: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
4050: 20 20 20 20 20 20 20 28 28 67 65 74 2d 61 6c 6c ((get-all
4060: 2d 72 75 6e 2d 69 64 73 29 20 20 20 20 20 20 20 -run-ids)
4070: 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 61 (db:get-a
4080: 6c 6c 2d 72 75 6e 2d 69 64 73 20 64 62 73 74 72 ll-run-ids dbstr
4090: 75 63 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 uct)).
40a0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 70 ((get-p
40b0: 72 65 76 2d 72 75 6e 2d 69 64 73 29 20 20 20 20 rev-run-ids)
40c0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
40d0: 64 62 3a 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d db:get-prev-run-
40e0: 69 64 73 20 64 62 73 74 72 75 63 74 20 70 61 72 ids dbstruct par
40f0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
4100: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72 ((get-r
4110: 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d un-ids-matching-
4120: 74 61 72 67 65 74 29 20 20 28 61 70 70 6c 79 20 target) (apply
4130: 64 62 3a 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d db:get-run-ids-m
4140: 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 20 64 atching-target d
4150: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
4160: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4170: 20 20 20 20 28 28 67 65 74 2d 72 75 6e 73 2d 62 ((get-runs-b
4180: 79 2d 70 61 74 74 29 20 20 20 20 20 20 20 20 20 y-patt)
4190: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
41a0: 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 t-runs-by-patt d
41b0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
41c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
41d0: 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 6e 61 ((get-run-na
41e0: 6d 65 2d 66 72 6f 6d 2d 69 64 29 20 20 20 20 20 me-from-id)
41f0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
4200: 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d t-run-name-from-
4210: 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 id dbstruct para
4220: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
4230: 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 6d 61 ((get-ma
4240: 69 6e 2d 72 75 6e 2d 73 74 61 74 73 29 20 20 20 in-run-stats)
4250: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
4260: 62 3a 67 65 74 2d 6d 61 69 6e 2d 72 75 6e 2d 73 b:get-main-run-s
4270: 74 61 74 73 20 64 62 73 74 72 75 63 74 20 70 61 tats dbstruct pa
4280: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 rams)).
4290: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d ((get-
42a0: 76 61 72 29 20 20 20 20 20 20 20 20 20 20 20 20 var)
42b0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
42c0: 20 64 62 3a 67 65 74 2d 76 61 72 20 64 62 73 74 db:get-var dbst
42d0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
42e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42f0: 20 28 28 67 65 74 2d 72 75 6e 2d 73 74 61 74 73 ((get-run-stats
4300: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
4310: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 (apply db:get-r
4320: 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72 75 63 un-stats dbstruc
4330: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
4350: 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 29 20 20 get-run-times)
4360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
4370: 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d pply db:get-run-
4380: 74 69 6d 65 73 20 64 62 73 74 72 75 63 74 20 70 times dbstruct p
4390: 61 72 61 6d 73 29 29 20 0a 0a 20 20 20 20 20 20 arams)) ..
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
43b0: 53 54 45 50 53 0a 20 20 20 20 20 20 20 20 20 20 STEPS.
43c0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 73 ((get-s
43d0: 74 65 70 73 2d 64 61 74 61 29 20 20 20 20 20 20 teps-data)
43e0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
43f0: 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 64 61 74 db:get-steps-dat
4400: 61 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d a dbstruct param
4410: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
4420: 20 20 20 20 20 20 20 28 28 67 65 74 2d 73 74 65 ((get-ste
4430: 70 73 2d 66 6f 72 2d 74 65 73 74 29 20 20 20 20 ps-for-test)
4440: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
4450: 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 :get-steps-for-t
4460: 65 73 74 20 64 62 73 74 72 75 63 74 20 70 61 72 est dbstruct par
4470: 61 6d 73 29 29 0a 09 09 20 20 20 28 28 67 65 74 ams))... ((get
4480: 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 -steps-info-by-i
4490: 64 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c d) (appl
44a0: 79 20 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 69 y db:get-steps-i
44b0: 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 74 72 75 nfo-by-id dbstru
44c0: 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 ct params))..
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44e0: 3b 3b 20 54 45 53 54 20 44 41 54 41 0a 20 20 20 ;; TEST DATA.
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 28 28 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 ((read-test-data
4510: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
4520: 28 61 70 70 6c 79 20 64 62 3a 72 65 61 64 2d 74 (apply db:read-t
4530: 65 73 74 2d 64 61 74 61 20 64 62 73 74 72 75 63 est-data dbstruc
4540: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
4550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
4560: 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 2d 76 read-test-data-v
4570: 61 72 70 61 74 74 29 20 20 20 20 20 20 20 28 61 arpatt) (a
4580: 70 70 6c 79 20 64 62 3a 72 65 61 64 2d 74 65 73 pply db:read-tes
4590: 74 2d 64 61 74 61 2d 76 61 72 70 61 74 74 20 64 t-data-varpatt d
45a0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
45b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
45c0: 20 20 20 20 28 28 67 65 74 2d 64 61 74 61 2d 69 ((get-data-i
45d0: 6e 66 6f 2d 62 79 2d 69 64 29 20 20 20 20 20 20 nfo-by-id)
45e0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
45f0: 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 t-data-info-by-i
4600: 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d d dbstruct param
4610: 73 29 29 20 0a 0a 20 20 20 20 20 20 20 20 20 20 s)) ..
4620: 20 20 20 20 20 20 20 20 20 3b 3b 20 4d 49 53 43 ;; MISC
4630: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4640: 20 20 20 20 28 28 67 65 74 2d 6c 61 74 65 73 74 ((get-latest
4650: 2d 68 6f 73 74 2d 6c 6f 61 64 29 20 20 20 20 20 -host-load)
4660: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
4670: 74 2d 6c 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f t-latest-host-lo
4680: 61 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ad dbstruct para
4690: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ms)).
46a0: 20 20 20 20 20 20 20 20 28 28 68 61 76 65 2d 69 ((have-i
46b0: 6e 63 6f 6d 70 6c 65 74 65 73 3f 29 20 20 20 20 ncompletes?)
46c0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
46d0: 62 3a 68 61 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 b:have-incomplet
46e0: 65 73 3f 20 64 62 73 74 72 75 63 74 20 70 61 72 es? dbstruct par
46f0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ams)).
4700: 20 20 20 20 20 20 20 20 20 28 28 6c 6f 67 69 6e ((login
4710: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
4720: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
4730: 64 62 3a 6c 6f 67 69 6e 20 64 62 73 74 72 75 63 db:login dbstruc
4740: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 t params)).
4750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
4760: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 29 20 20 20 general-call)
4770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4780: 65 74 20 28 28 73 74 6d 74 6e 61 6d 65 20 20 20 et ((stmtname
4790: 28 63 61 72 20 70 61 72 61 6d 73 29 29 0a 20 20 (car params)).
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47d0: 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 (run-id
47e0: 20 20 20 28 63 61 64 72 20 70 61 72 61 6d 73 29 (cadr params)
47f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4820: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 61 6c (real
4830: 70 61 72 61 6d 73 20 28 63 64 64 72 20 70 61 72 params (cddr par
4840: 61 6d 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 ams))).
4850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4870: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a (db:
4880: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 64 62 73 general-call dbs
4890: 74 72 75 63 74 20 73 74 6d 74 6e 61 6d 65 20 72 truct stmtname r
48a0: 65 61 6c 70 61 72 61 6d 73 29 29 29 0a 20 20 20 ealparams))).
48b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48c0: 28 28 73 64 62 2d 71 72 79 29 20 20 20 20 20 20 ((sdb-qry)
48d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48e0: 28 61 70 70 6c 79 20 73 64 62 3a 71 72 79 20 70 (apply sdb:qry p
48f0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 arams)).
4900: 20 20 20 20 20 20 20 20 20 20 20 28 28 70 69 6e ((pin
4910: 67 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 g)
4920: 20 20 20 20 20 20 20 20 20 20 20 28 63 75 72 72 (curr
4930: 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 ent-process-id))
4940: 0a 09 09 20 20 20 28 28 67 65 74 2d 63 68 61 6e ... ((get-chan
4950: 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 29 20 ged-record-ids)
4960: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
4970: 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f get-changed-reco
4980: 72 64 2d 69 64 73 20 64 62 73 74 72 75 63 74 20 rd-ids dbstruct
4990: 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28 params))... ((
49a0: 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 get-run-record-i
49b0: 64 73 29 20 09 20 20 20 28 61 70 70 6c 79 20 64 ds) . (apply d
49c0: 62 3a 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 64 b:get-run-record
49d0: 2d 69 64 73 20 64 62 73 74 72 75 63 74 20 70 61 -ids dbstruct pa
49e0: 72 61 6d 73 29 29 09 0a 20 20 20 20 20 20 20 20 rams))..
49f0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 ;; TE
4a00: 53 54 4d 45 54 41 0a 20 20 20 20 20 20 20 20 20 STMETA.
4a10: 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 ((test
4a20: 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 29 meta-get-record)
4a30: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
4a40: 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 :testmeta-get-re
4a50: 63 6f 72 64 20 64 62 73 74 72 75 63 74 20 70 61 cord dbstruct pa
4a60: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20 rams))..
4a70: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 41 ;; TA
4a80: 53 4b 53 20 0a 20 20 20 20 20 20 20 20 20 20 20 SKS .
4a90: 20 20 20 20 20 20 20 20 28 28 66 69 6e 64 2d 74 ((find-t
4aa0: 61 73 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 ask-queue-record
4ab0: 73 29 20 20 20 28 61 70 70 6c 79 20 74 61 73 6b s) (apply task
4ac0: 73 3a 66 69 6e 64 2d 74 61 73 6b 2d 71 75 65 75 s:find-task-queu
4ad0: 65 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 75 e-records dbstru
4ae0: 63 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 ct params))...
4af0: 20 28 65 6c 73 65 0a 09 09 20 20 20 20 28 64 65 (else... (de
4b00: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
4b10: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4b20: 45 52 52 4f 52 3a 20 62 61 64 20 61 70 69 20 63 ERROR: bad api c
4b30: 61 6c 6c 20 22 20 63 6d 64 29 0a 09 09 20 20 20 all " cmd)...
4b40: 20 28 63 6f 6e 63 20 22 45 52 52 4f 52 3a 20 42 (conc "ERROR: B
4b50: 41 44 20 61 70 69 20 63 61 6c 6c 20 22 20 63 6d AD api call " cm
4b60: 64 29 29 29 29 29 29 0a 0a 20 20 20 20 20 20 20 d))))))..
4b70: 0a 20 20 20 20 20 20 20 3b 3b 20 73 61 76 65 20 . ;; save
4b80: 61 6c 6c 20 73 74 61 74 73 0a 20 20 20 20 20 20 all stats.
4b90: 20 28 6c 65 74 20 28 28 64 65 6c 74 61 2d 74 20 (let ((delta-t
4ba0: 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c (- (current-mill
4bb0: 69 73 65 63 6f 6e 64 73 29 0a 09 09 09 20 73 74 iseconds).... st
4bc0: 61 72 74 2d 74 29 29 29 0a 09 20 28 68 61 73 68 art-t))).. (hash
4bd0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 64 62 2d -table-set! *db-
4be0: 61 70 69 2d 63 61 6c 6c 2d 74 69 6d 65 2a 20 63 api-call-time* c
4bf0: 6d 64 0a 09 09 09 20 20 28 63 6f 6e 73 20 64 65 md.... (cons de
4c00: 6c 74 61 2d 74 20 28 68 61 73 68 2d 74 61 62 6c lta-t (hash-tabl
4c10: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 64 e-ref/default *d
4c20: 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 69 6d 65 2a b-api-call-time*
4c30: 20 63 6d 64 20 27 28 29 29 29 29 29 0a 20 20 20 cmd '())))).
4c40: 20 20 20 20 28 69 66 20 77 72 69 74 65 63 6d 64 (if writecmd
4c50: 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 -in-readonly-mod
4c60: 65 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 65 e. (be
4c70: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
4c80: 20 23 3b 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d #;(common:telem
4c90: 65 74 72 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 etry-log (conc "
4ca0: 61 70 69 2d 6f 75 74 3a 22 28 2d 3e 73 74 72 69 api-out:"(->stri
4cb0: 6e 67 20 63 6d 64 29 29 0a 20 20 20 20 20 20 20 ng cmd)).
4cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cd0: 20 20 20 20 20 20 20 20 20 20 20 20 70 61 79 6c payl
4ce0: 6f 61 64 3a 20 60 28 28 70 61 72 61 6d 73 20 2e oad: `((params .
4cf0: 20 2c 70 61 72 61 6d 73 29 0a 20 20 20 20 20 20 ,params).
4d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d20: 20 20 20 20 20 20 20 20 28 6f 6b 2d 72 65 73 20 (ok-res
4d30: 2e 20 23 74 29 29 29 0a 09 20 20 20 20 20 28 76 . #t))).. (v
4d40: 65 63 74 6f 72 20 23 66 20 72 65 73 29 29 0a 20 ector #f res)).
4d50: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
4d60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 23 3b . #;
4d70: 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 (common:telemetr
4d80: 79 2d 6c 6f 67 20 28 63 6f 6e 63 20 22 61 70 69 y-log (conc "api
4d90: 2d 6f 75 74 3a 22 28 2d 3e 73 74 72 69 6e 67 20 -out:"(->string
4da0: 63 6d 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 cmd)).
4db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4dc0: 20 20 20 20 20 20 20 20 20 70 61 79 6c 6f 61 64 payload
4dd0: 3a 20 60 28 28 70 61 72 61 6d 73 20 2e 20 2c 70 : `((params . ,p
4de0: 61 72 61 6d 73 29 0a 20 20 20 20 20 20 20 20 20 arams).
4df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e10: 20 20 20 20 20 28 6f 6b 2d 72 65 73 20 2e 20 23 (ok-res . #
4e20: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
4e30: 20 20 28 76 65 63 74 6f 72 20 23 74 20 72 65 73 (vector #t res
4e40: 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 68 74 74 ))))))))..;; htt
4e50: 70 2d 73 65 72 76 65 72 20 20 73 65 6e 64 2d 72 p-server send-r
4e60: 65 73 70 6f 6e 73 65 0a 3b 3b 20 20 20 20 20 20 esponse.;;
4e70: 20 20 20 20 20 20 20 20 20 20 20 61 70 69 3a 70 api:p
4e80: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 0a 3b rocess-request.;
4e90: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
4ea0: 20 20 20 20 20 64 62 3a 2a 0a 3b 3b 0a 3b 3b 20 db:*.;;.;;
4eb0: 4e 42 2f 2f 20 52 75 6e 73 20 6f 6e 20 74 68 65 NB// Runs on the
4ec0: 20 73 65 72 76 65 72 20 61 73 20 70 61 72 74 20 server as part
4ed0: 6f 66 20 74 68 65 20 73 65 72 76 65 72 20 6c 6f of the server lo
4ee0: 6f 70 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 61 op.;;.(define (a
4ef0: 70 69 3a 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi:process-reque
4f00: 73 74 20 64 62 73 74 72 75 63 74 20 24 29 20 3b st dbstruct $) ;
4f10: 3b 20 74 68 65 20 24 20 69 73 20 74 68 65 20 72 ; the $ is the r
4f20: 65 71 75 65 73 74 20 76 61 72 73 20 70 72 6f 63 equest vars proc
4f30: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
4f40: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
4f50: 6f 72 74 2a 20 22 73 65 72 76 65 72 2d 69 64 3a ort* "server-id:
4f60: 22 20 20 2a 73 65 72 76 65 72 2d 69 64 2a 29 0a " *server-id*).
4f70: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 20 20 20 (let* ((cmd
4f80: 20 20 28 24 20 27 63 6d 64 29 29 0a 09 20 28 70 ($ 'cmd)).. (p
4f90: 61 72 61 6d 73 6a 20 28 24 20 27 70 61 72 61 6d aramsj ($ 'param
4fa0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 6b 65 s)). (ke
4fb0: 79 20 20 20 20 20 28 24 20 27 6b 65 79 29 29 20 y ($ 'key))
4fc0: 20 20 0a 09 20 28 70 61 72 61 6d 73 20 20 28 64 .. (params (d
4fd0: 62 3a 73 74 72 69 6e 67 2d 3e 6f 62 6a 20 70 61 b:string->obj pa
4fe0: 72 61 6d 73 6a 20 74 72 61 6e 73 70 6f 72 74 3a ramsj transport:
4ff0: 20 27 68 74 74 70 29 29 29 20 3b 3b 20 69 6e 63 'http))) ;; inc
5000: 6f 6d 69 6e 67 20 64 61 74 61 20 66 72 6f 6d 20 oming data from
5010: 74 68 65 20 50 4f 53 54 20 28 6f 72 20 69 73 20 the POST (or is
5020: 69 74 20 61 20 47 45 54 3f 29 0a 09 20 28 73 75 it a GET?).. (su
5030: 63 63 65 73 73 20 28 63 6f 6d 6d 6f 6e 3a 73 61 ccess (common:sa
5040: 66 65 2d 76 65 63 74 6f 72 2d 72 65 66 20 72 65 fe-vector-ref re
5050: 73 64 61 74 20 30 20 23 66 29 29 0a 09 20 28 72 sdat 0 #f)).. (r
5060: 65 73 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 es (common:s
5070: 61 66 65 2d 76 65 63 74 6f 72 2d 72 65 66 20 72 afe-vector-ref r
5080: 65 73 64 61 74 20 31 20 23 66 29 29 29 20 3b 3b esdat 1 #f))) ;;
5090: 20 28 76 65 63 74 6f 72 20 66 6c 61 67 20 70 61 (vector flag pa
50a0: 79 6c 6f 61 64 29 2c 20 67 65 74 20 74 68 65 20 yload), get the
50b0: 70 61 79 6c 6f 61 64 2c 20 69 67 6e 6f 72 65 20 payload, ignore
50c0: 74 68 65 20 66 6c 61 67 20 28 77 68 79 3f 29 0a the flag (why?).
50d0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
50e0: 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
50f0: 70 6f 72 74 2a 20 22 63 6d 64 3a 22 20 63 6d 64 port* "cmd:" cmd
5100: 20 22 20 77 69 74 68 20 70 61 72 61 6d 73 20 22 " with params "
5110: 20 70 61 72 61 6d 73 20 22 6b 65 79 20 22 20 6b params "key " k
5120: 65 79 29 0a 20 20 20 20 28 69 66 20 28 65 71 75 ey). (if (equ
5130: 61 6c 3f 20 6b 65 79 20 2a 73 65 72 76 65 72 2d al? key *server-
5140: 69 64 2a 29 0a 20 20 20 20 20 20 28 62 65 67 69 id*). (begi
5150: 6e 0a 20 20 20 20 20 20 20 20 28 73 65 74 21 20 n. (set!
5160: 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 *api-process-req
5170: 75 65 73 74 2d 63 6f 75 6e 74 2a 20 28 2b 20 2a uest-count* (+ *
5180: 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 api-process-requ
5190: 65 73 74 2d 63 6f 75 6e 74 2a 20 31 29 29 0a 20 est-count* 1)).
51a0: 09 28 6c 65 74 2a 20 28 28 72 65 73 64 61 74 20 .(let* ((resdat
51b0: 20 28 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 (api:execute-re
51c0: 71 75 65 73 74 73 20 64 62 73 74 72 75 63 74 20 quests dbstruct
51d0: 28 76 65 63 74 6f 72 20 63 6d 64 20 70 61 72 61 (vector cmd para
51e0: 6d 73 29 29 29 20 3b 3b 20 70 72 6f 63 65 73 73 ms))) ;; process
51f0: 20 74 68 65 20 72 65 71 75 65 73 74 2c 20 72 65 the request, re
5200: 73 64 61 74 20 3d 20 23 28 20 66 6c 61 67 20 72 sdat = #( flag r
5210: 65 73 75 6c 74 20 29 0a 09 20 20 20 20 20 20 20 esult )..
5220: 28 73 75 63 63 65 73 73 20 28 76 65 63 74 6f 72 (success (vector
5230: 2d 72 65 66 20 72 65 73 64 61 74 20 30 29 29 0a -ref resdat 0)).
5240: 09 20 20 20 20 20 20 20 28 72 65 73 20 20 20 20 . (res
5250: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 (vector-ref res
5260: 64 61 74 20 31 29 29 29 20 3b 3b 20 28 76 65 63 dat 1))) ;; (vec
5270: 74 6f 72 20 66 6c 61 67 20 70 61 79 6c 6f 61 64 tor flag payload
5280: 29 2c 20 67 65 74 20 74 68 65 20 70 61 79 6c 6f ), get the paylo
5290: 61 64 2c 20 69 67 6e 6f 72 65 20 74 68 65 20 66 ad, ignore the f
52a0: 6c 61 67 20 28 77 68 79 3f 29 0a 09 20 20 28 64 lag (why?).. (d
52b0: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 ebug:print 4 *de
52c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
52d0: 22 72 65 73 3a 22 20 72 65 73 29 0a 09 20 20 28 "res:" res).. (
52e0: 69 66 20 28 6e 6f 74 20 73 75 63 63 65 73 73 29 if (not success)
52f0: 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
5300: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
5310: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 log-port* "ERROR
5320: 3a 20 73 75 63 63 65 73 73 20 66 6c 61 67 20 69 : success flag i
5330: 73 20 23 66 20 66 6f 72 20 22 20 63 6d 64 20 22 s #f for " cmd "
5340: 20 77 69 74 68 20 70 61 72 61 6d 73 20 22 20 70 with params " p
5350: 61 72 61 6d 73 29 29 0a 09 20 20 28 69 66 20 28 arams)).. (if (
5360: 3e 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 > *api-process-r
5370: 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 2a 6d equest-count* *m
5380: 61 78 2d 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 ax-api-process-r
5390: 65 71 75 65 73 74 73 2a 29 0a 09 20 20 20 20 20 equests*)..
53a0: 20 28 73 65 74 21 20 2a 6d 61 78 2d 61 70 69 2d (set! *max-api-
53b0: 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 73 process-requests
53c0: 2a 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 * *api-process-r
53d0: 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 29 29 0a equest-count*)).
53e0: 09 20 20 28 73 65 74 21 20 2a 61 70 69 2d 70 72 . (set! *api-pr
53f0: 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f ocess-request-co
5400: 75 6e 74 2a 20 28 2d 20 2a 61 70 69 2d 70 72 6f unt* (- *api-pro
5410: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
5420: 6e 74 2a 20 31 29 29 0a 09 20 20 3b 3b 20 54 68 nt* 1)).. ;; Th
5430: 69 73 20 63 61 6e 20 62 65 20 68 65 72 65 20 62 is can be here b
5440: 75 74 20 6e 65 65 64 73 20 63 6f 6e 74 72 6f 6c ut needs control
5450: 73 20 74 6f 20 65 6e 73 75 72 65 20 69 74 20 64 s to ensure it d
5460: 6f 65 73 6e 27 74 20 72 75 6e 20 6d 6f 72 65 20 oesn't run more
5470: 74 68 61 6e 20 65 76 65 72 79 20 34 20 73 65 63 than every 4 sec
5480: 6f 6e 64 73 0a 09 20 20 3b 3b 20 28 72 6d 74 3a onds.. ;; (rmt:
5490: 64 61 74 2d 3e 6a 73 6f 6e 2d 73 74 72 0a 09 20 dat->json-str..
54a0: 20 3b 3b 20 20 28 69 66 20 28 6f 72 20 28 73 74 ;; (if (or (st
54b0: 72 69 6e 67 3f 20 72 65 73 29 0a 09 20 20 3b 3b ring? res).. ;;
54c0: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 3f (list?
54d0: 20 20 20 72 65 73 29 0a 09 20 20 3b 3b 20 20 20 res).. ;;
54e0: 20 20 20 20 20 20 20 28 6e 75 6d 62 65 72 3f 20 (number?
54f0: 72 65 73 29 0a 09 20 20 3b 3b 20 20 20 20 20 20 res).. ;;
5500: 20 20 20 20 28 62 6f 6f 6c 65 61 6e 3f 20 72 65 (boolean? re
5510: 73 29 29 0a 09 20 20 3b 3b 20 20 20 20 20 20 72 s)).. ;; r
5520: 65 73 20 0a 09 20 20 3b 3b 20 20 20 20 20 20 28 es .. ;; (
5530: 6c 69 73 74 20 22 45 52 52 4f 52 2c 20 6e 6f 74 list "ERROR, not
5540: 20 73 74 72 69 6e 67 2c 20 6c 69 73 74 2c 20 6e string, list, n
5550: 75 6d 62 65 72 20 6f 72 20 62 6f 6f 6c 65 61 6e umber or boolean
5560: 22 20 31 20 63 6d 64 20 70 61 72 61 6d 73 20 72 " 1 cmd params r
5570: 65 73 29 29 29 29 29 0a 09 20 20 28 64 62 3a 6f es))))).. (db:o
5580: 62 6a 2d 3e 73 74 72 69 6e 67 20 72 65 73 20 74 bj->string res t
5590: 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 70 29 ransport: 'http)
55a0: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
55b0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
55c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
55d0: 20 20 22 53 65 72 76 65 72 20 72 65 66 75 73 65 "Server refuse
55e0: 64 20 74 6f 20 70 72 6f 63 65 73 73 20 72 65 71 d to process req
55f0: 75 65 73 74 2e 20 53 65 76 65 72 20 69 64 20 6d uest. Sever id m
5600: 69 73 6d 61 74 63 68 2e 20 72 65 63 69 76 65 64 ismatch. recived
5610: 20 22 20 6b 65 79 20 22 20 65 78 70 65 63 74 65 " key " expecte
5620: 64 3a 20 20 22 20 2a 73 65 72 76 65 72 2d 69 64 d: " *server-id
5630: 2a 20 22 2e 5c 6e 4f 74 68 65 72 20 61 72 67 75 * ".\nOther argu
5640: 6d 65 6e 74 73 20 72 65 63 69 76 65 64 3a 20 63 ments recived: c
5650: 6d 64 3d 22 20 63 6d 64 20 22 20 70 61 72 61 6d md=" cmd " param
5660: 73 20 3d 20 22 20 70 61 72 61 6d 73 29 20 0a 09 s = " params) ..
5670: 20 20 28 64 62 3a 6f 62 6a 2d 3e 73 74 72 69 6e (db:obj->strin
5680: 67 20 28 63 6f 6e 63 20 22 53 65 72 76 65 72 20 g (conc "Server
5690: 72 65 66 75 73 65 64 20 74 6f 20 70 72 6f 63 65 refused to proce
56a0: 73 73 20 72 65 71 75 65 73 74 20 73 65 72 76 65 ss request serve
56b0: 72 2d 69 64 20 6d 69 73 6d 61 74 63 68 3a 20 22 r-id mismatch: "
56c0: 20 6b 65 79 20 22 2c 20 22 20 2a 73 65 72 76 65 key ", " *serve
56d0: 72 2d 69 64 2a 29 20 74 72 61 6e 73 70 6f 72 74 r-id*) transport
56e0: 3a 20 27 68 74 74 70 29 29 29 29 0a 0a 0a 0a : 'http))))....