Megatest

Artifact 913dee30b88c942e6292a96c4ad3844d3aaa499f:

• File api.scm (unpublished)— part of check-in [74a5cd0abb] at 2021-02-26 07:53:35 on branch v1.65-diet2-cm1 — Merged in latest From: 14db3c2571c703c23f8b627c1d3ca06d22870c57 User: matt (user: matt, size: 21747) [annotate] [blame] [check-ins using]

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 74 61 73 6b 73 29 29 0a 0a 3b 3b 20 61 6c 6c   tasks))..;; all
0400: 6f 77 20 74 68 65 73 65 20 71 75 65 72 69 65 73  ow these queries
0410: 20 74 68 72 6f 75 67 68 20 77 69 74 68 6f 75 74   through without
0420: 20 73 74 61 72 74 69 6e 67 20 61 20 73 65 72 76   starting a serv
0430: 65 72 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 61 70  er.;;.(define ap
0440: 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 65 72  i:read-only-quer
0450: 69 65 73 0a 20 20 27 28 67 65 74 2d 6b 65 79 2d  ies.  '(get-key-
0460: 76 61 6c 2d 70 61 69 72 73 0a 20 20 20 20 67 65  val-pairs.    ge
0470: 74 2d 76 61 72 0a 20 20 20 20 67 65 74 2d 6b 65  t-var.    get-ke
0480: 79 73 0a 20 20 20 20 67 65 74 2d 6b 65 79 2d 76  ys.    get-key-v
0490: 61 6c 73 0a 20 20 20 20 74 65 73 74 2d 74 6f 70  als.    test-top
04a0: 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 0a  level-num-items.
04b0: 20 20 20 20 67 65 74 2d 74 65 73 74 2d 69 6e 66      get-test-inf
04c0: 6f 2d 62 79 2d 69 64 0a 20 20 20 20 67 65 74 2d  o-by-id.    get-
04d0: 73 74 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64  steps-info-by-id
04e0: 0a 20 20 20 20 67 65 74 2d 64 61 74 61 2d 69 6e  .    get-data-in
04f0: 66 6f 2d 62 79 2d 69 64 0a 20 20 20 20 74 65 73  fo-by-id.    tes
0500: 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f  t-get-rundir-fro
0510: 6d 2d 74 65 73 74 2d 69 64 0a 20 20 20 20 67 65  m-test-id.    ge
0520: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75  t-count-tests-ru
0530: 6e 6e 69 6e 67 2d 66 6f 72 2d 74 65 73 74 6e 61  nning-for-testna
0540: 6d 65 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e 74  me.    get-count
0550: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 0a 20  -tests-running. 
0560: 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73     get-count-tes
0570: 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f  ts-running-in-jo
0580: 62 67 72 6f 75 70 0a 20 20 20 20 67 65 74 2d 70  bgroup.    get-p
0590: 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e  revious-test-run
05a0: 2d 72 65 63 6f 72 64 0a 20 20 20 20 67 65 74 2d  -record.    get-
05b0: 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75  matching-previou
05c0: 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72  s-test-run-recor
05d0: 64 73 0a 20 20 20 20 74 65 73 74 2d 67 65 74 2d  ds.    test-get-
05e0: 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 0a 20 20 20  logfile-info.   
05f0: 20 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64   test-get-record
0600: 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65  s-for-index-file
0610: 0a 20 20 20 20 67 65 74 2d 74 65 73 74 69 6e 66  .    get-testinf
0620: 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 20  o-state-status. 
0630: 20 20 20 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d     test-get-top-
0640: 70 72 6f 63 65 73 73 2d 70 69 64 0a 20 20 20 20  process-pid.    
0650: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d  test-get-paths-m
0660: 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73  atching-keynames
0670: 2d 74 61 72 67 65 74 2d 6e 65 77 0a 20 20 20 20  -target-new.    
0680: 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d  get-prereqs-not-
0690: 6d 65 74 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e  met.    get-coun
06a0: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d  t-tests-running-
06b0: 66 6f 72 2d 72 75 6e 2d 69 64 0a 20 20 20 20 67  for-run-id.    g
06c0: 65 74 2d 72 75 6e 2d 69 6e 66 6f 0a 20 20 20 20  et-run-info.    
06d0: 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 0a 20  get-run-status. 
06e0: 20 20 20 67 65 74 2d 72 75 6e 2d 73 74 61 74 65     get-run-state
06f0: 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 73 74 61  .    get-run-sta
0700: 74 73 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 74  ts.    get-run-t
0710: 69 6d 65 73 0a 20 20 20 20 67 65 74 2d 74 61 72  imes.    get-tar
0720: 67 65 74 73 0a 20 20 20 20 67 65 74 2d 74 61 72  gets.    get-tar
0730: 67 65 74 0a 20 20 20 20 3b 3b 20 72 65 67 69 73  get.    ;; regis
0740: 74 65 72 2d 72 75 6e 0a 20 20 20 20 67 65 74 2d  ter-run.    get-
0750: 74 65 73 74 73 2d 74 61 67 73 0a 20 20 20 20 67  tests-tags.    g
0760: 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 0a 20 20  et-test-times.  
0770: 20 20 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d    get-tests-for-
0780: 72 75 6e 0a 20 20 20 20 67 65 74 2d 74 65 73 74  run.    get-test
0790: 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d  s-for-run-state-
07a0: 73 74 61 74 75 73 0a 20 20 20 20 67 65 74 2d 74  status.    get-t
07b0: 65 73 74 2d 69 64 0a 20 20 20 20 67 65 74 2d 74  est-id.    get-t
07c0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69  ests-for-runs-mi
07d0: 6e 64 61 74 61 0a 20 20 20 20 67 65 74 2d 74 65  ndata.    get-te
07e0: 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64  sts-for-run-mind
07f0: 61 74 61 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d  ata.    get-run-
0800: 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 0a 20 20 20  name-from-id.   
0810: 20 67 65 74 2d 72 75 6e 73 0a 20 20 20 20 73 69   get-runs.    si
0820: 6d 70 6c 65 2d 67 65 74 2d 72 75 6e 73 0a 20 20  mple-get-runs.  
0830: 20 20 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 0a 20    get-num-runs. 
0840: 20 20 20 67 65 74 2d 72 75 6e 73 2d 63 6e 74 2d     get-runs-cnt-
0850: 62 79 2d 70 61 74 74 0a 20 20 20 20 67 65 74 2d  by-patt.    get-
0860: 61 6c 6c 2d 72 75 6e 2d 69 64 73 0a 20 20 20 20  all-run-ids.    
0870: 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73  get-prev-run-ids
0880: 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 69 64 73  .    get-run-ids
0890: 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74  -matching-target
08a0: 0a 20 20 20 20 67 65 74 2d 72 75 6e 73 2d 62 79  .    get-runs-by
08b0: 2d 70 61 74 74 0a 20 20 20 20 67 65 74 2d 73 74  -patt.    get-st
08c0: 65 70 73 2d 64 61 74 61 0a 20 20 20 20 67 65 74  eps-data.    get
08d0: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 0a  -steps-for-test.
08e0: 20 20 20 20 72 65 61 64 2d 74 65 73 74 2d 64 61      read-test-da
08f0: 74 61 0a 20 20 20 20 72 65 61 64 2d 74 65 73 74  ta.    read-test
0900: 2d 64 61 74 61 2d 76 61 72 70 61 74 74 0a 20 20  -data-varpatt.  
0910: 20 20 6c 6f 67 69 6e 0a 20 20 20 20 74 61 73 6b    login.    task
0920: 73 2d 67 65 74 2d 6c 61 73 74 0a 20 20 20 20 74  s-get-last.    t
0930: 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f  estmeta-get-reco
0940: 72 64 0a 20 20 20 20 68 61 76 65 2d 69 6e 63 6f  rd.    have-inco
0950: 6d 70 6c 65 74 65 73 3f 0a 20 20 20 20 3b 3b 20  mpletes?.    ;; 
0960: 73 79 6e 63 68 61 73 68 2d 67 65 74 0a 20 20 20  synchash-get.   
0970: 20 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63   get-changed-rec
0980: 6f 72 64 2d 69 64 73 0a 20 20 20 20 67 65 74 2d  ord-ids.    get-
0990: 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 20 0a  run-record-ids .
09a0: 20 20 20 20 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70      get-not-comp
09b0: 6c 65 74 65 64 2d 63 6e 74 29 29 0a 0a 28 64 65  leted-cnt))..(de
09c0: 66 69 6e 65 20 61 70 69 3a 77 72 69 74 65 2d 71  fine api:write-q
09d0: 75 65 72 69 65 73 0a 20 20 27 28 0a 20 20 20 20  ueries.  '(.    
09e0: 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 65 20 3b  get-keys-write ;
09f0: 3b 20 64 75 6d 6d 79 20 22 77 72 69 74 65 22 20  ; dummy "write" 
0a00: 71 75 65 72 79 20 74 6f 20 66 6f 72 63 65 20 73  query to force s
0a10: 65 72 76 65 72 20 73 74 61 72 74 0a 0a 20 20 20  erver start..   
0a20: 20 3b 3b 20 53 45 52 56 45 52 53 0a 20 20 20 20   ;; SERVERS.    
0a30: 73 74 61 72 74 2d 73 65 72 76 65 72 0a 20 20 20  start-server.   
0a40: 20 6b 69 6c 6c 2d 73 65 72 76 65 72 0a 0a 20 20   kill-server..  
0a50: 20 20 3b 3b 20 54 45 53 54 53 0a 20 20 20 20 74    ;; TESTS.    t
0a60: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74  est-set-state-st
0a70: 61 74 75 73 2d 62 79 2d 69 64 0a 20 20 20 20 64  atus-by-id.    d
0a80: 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f 72  elete-test-recor
0a90: 64 73 0a 20 20 20 20 64 65 6c 65 74 65 2d 6f 6c  ds.    delete-ol
0aa0: 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72  d-deleted-test-r
0ab0: 65 63 6f 72 64 73 0a 20 20 20 20 74 65 73 74 2d  ecords.    test-
0ac0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73  set-state-status
0ad0: 0a 20 20 20 20 74 65 73 74 2d 73 65 74 2d 74 6f  .    test-set-to
0ae0: 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 0a 20 20  p-process-pid.  
0af0: 20 20 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74    set-state-stat
0b00: 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69  us-and-roll-up-i
0b10: 74 65 6d 73 0a 20 20 20 20 0a 20 20 20 20 75 70  tems.    .    up
0b20: 64 61 74 65 2d 70 61 73 73 2d 66 61 69 6c 2d 63  date-pass-fail-c
0b30: 6f 75 6e 74 73 0a 20 20 20 20 74 6f 70 2d 74 65  ounts.    top-te
0b40: 73 74 2d 73 65 74 2d 70 65 72 2d 70 66 2d 63 6f  st-set-per-pf-co
0b50: 75 6e 74 73 20 3b 3b 20 28 64 62 3a 74 6f 70 2d  unts ;; (db:top-
0b60: 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 66 2d  test-set-per-pf-
0b70: 63 6f 75 6e 74 73 20 28 64 62 3a 67 65 74 2d 64  counts (db:get-d
0b80: 62 20 2a 64 62 2a 20 35 29 20 35 20 22 72 75 6e  b *db* 5) 5 "run
0b90: 66 69 72 73 74 22 29 0a 0a 20 20 20 20 3b 3b 20  first")..    ;; 
0ba0: 52 55 4e 53 0a 20 20 20 20 72 65 67 69 73 74 65  RUNS.    registe
0bb0: 72 2d 72 75 6e 0a 20 20 20 20 73 65 74 2d 74 65  r-run.    set-te
0bc0: 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 73  sts-state-status
0bd0: 0a 20 20 20 20 64 65 6c 65 74 65 2d 72 75 6e 0a  .    delete-run.
0be0: 20 20 20 20 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d      lock/unlock-
0bf0: 72 75 6e 0a 20 20 20 20 75 70 64 61 74 65 2d 72  run.    update-r
0c00: 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 0a 20 20  un-event_time.  
0c10: 20 20 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74    mark-incomplet
0c20: 65 0a 20 20 20 20 73 65 74 2d 73 74 61 74 65 2d  e.    set-state-
0c30: 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d  status-and-roll-
0c40: 75 70 2d 72 75 6e 0a 20 20 20 20 3b 3b 20 53 54  up-run.    ;; ST
0c50: 45 50 53 0a 20 20 20 20 74 65 73 74 73 74 65 70  EPS.    teststep
0c60: 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 20 20 20  -set-status!.   
0c70: 20 64 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f   delete-steps-fo
0c80: 72 2d 74 65 73 74 0a 20 20 20 20 3b 3b 20 54 45  r-test.    ;; TE
0c90: 53 54 20 44 41 54 41 0a 20 20 20 20 74 65 73 74  ST DATA.    test
0ca0: 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 0a 20 20 20  -data-rollup.   
0cb0: 20 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 0a   csv->test-data.
0cc0: 0a 20 20 20 20 3b 3b 20 4d 49 53 43 0a 20 20 20  .    ;; MISC.   
0cd0: 20 73 79 6e 63 2d 69 6e 6d 65 6d 2d 3e 64 62 0a   sync-inmem->db.
0ce0: 20 20 20 20 64 72 6f 70 2d 61 6c 6c 2d 74 72 69      drop-all-tri
0cf0: 67 67 65 72 73 0a 20 20 20 20 63 72 65 61 74 65  ggers.    create
0d00: 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 0a 20 20  -all-triggers.  
0d10: 20 20 75 70 64 61 74 65 2d 74 65 73 64 61 74 61    update-tesdata
0d20: 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 65 2d 64 62  -on-repilcate-db
0d30: 20 0a 0a 20 20 20 20 3b 3b 20 54 45 53 54 4d 45   ..    ;; TESTME
0d40: 54 41 0a 20 20 20 20 74 65 73 74 6d 65 74 61 2d  TA.    testmeta-
0d50: 61 64 64 2d 72 65 63 6f 72 64 0a 20 20 20 20 74  add-record.    t
0d60: 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66  estmeta-update-f
0d70: 69 65 6c 64 0a 0a 20 20 20 20 3b 3b 20 54 41 53  ield..    ;; TAS
0d80: 4b 53 0a 20 20 20 20 74 61 73 6b 73 2d 61 64 64  KS.    tasks-add
0d90: 0a 20 20 20 20 74 61 73 6b 73 2d 73 65 74 2d 73  .    tasks-set-s
0da0: 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d  tate-given-param
0db0: 2d 6b 65 79 0a 20 20 20 20 29 29 0a 0a 3b 3b 20  -key.    ))..;; 
0dc0: 54 68 65 73 65 20 61 72 65 20 63 61 6c 6c 65 64  These are called
0dd0: 20 62 79 20 74 68 65 20 73 65 72 76 65 72 20 6f   by the server o
0de0: 6e 20 72 65 63 69 70 74 20 6f 66 20 2f 61 70 69  n recipt of /api
0df0: 20 63 61 6c 6c 73 0a 3b 3b 20 20 20 20 2d 20 6b   calls.;;    - k
0e00: 65 65 70 20 69 74 20 73 69 6d 70 6c 65 2c 20 6f  eep it simple, o
0e10: 6e 6c 79 20 72 65 74 75 72 6e 20 74 68 65 20 61  nly return the a
0e20: 63 74 75 61 6c 20 72 65 73 75 6c 74 20 6f 66 20  ctual result of 
0e30: 74 68 65 20 63 61 6c 6c 2c 20 69 2e 65 2e 20 6e  the call, i.e. n
0e40: 6f 20 6d 65 74 61 20 69 6e 66 6f 20 68 65 72 65  o meta info here
0e50: 0a 3b 3b 0a 3b 3b 20 20 20 20 2d 20 72 65 74 75  .;;.;;    - retu
0e60: 72 6e 73 20 23 28 20 66 6c 61 67 20 72 65 73 75  rns #( flag resu
0e70: 6c 74 20 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 20  lt ).;;.(define 
0e80: 28 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 71  (api:execute-req
0e90: 75 65 73 74 73 20 64 62 73 74 72 75 63 74 20 64  uests dbstruct d
0ea0: 61 74 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78  at).  (handle-ex
0eb0: 63 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a  ceptions.   exn.
0ec0: 20 20 20 28 6c 65 74 20 28 28 63 61 6c 6c 2d 63     (let ((call-c
0ed0: 68 61 69 6e 20 28 67 65 74 2d 63 61 6c 6c 2d 63  hain (get-call-c
0ee0: 68 61 69 6e 29 29 29 0a 20 20 20 20 20 28 64 65  hain))).     (de
0ef0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66  bug:print 0 *def
0f00: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22  ault-log-port* "
0f10: 57 41 52 4e 49 4e 47 3a 20 61 70 69 3a 65 78 65  WARNING: api:exe
0f20: 63 75 74 65 2d 72 65 71 75 65 73 74 73 20 72 65  cute-requests re
0f30: 63 65 69 76 65 64 20 61 6e 20 65 78 63 65 70 74  ceived an except
0f40: 69 6f 6e 20 66 72 6f 6d 20 70 65 65 72 2c 20 64  ion from peer, d
0f50: 61 74 3d 22 20 64 61 74 20 22 2c 20 65 78 6e 3d  at=" dat ", exn=
0f60: 22 20 65 78 6e 29 0a 20 20 20 20 20 28 70 72 69  " exn).     (pri
0f70: 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63  nt-call-chain (c
0f80: 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72  urrent-error-por
0f90: 74 29 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a  t)).     (debug:
0fa0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74  print 0 *default
0fb0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73  -log-port* " mes
0fc0: 73 61 67 65 3a 20 22 20 20 28 28 63 6f 6e 64 69  sage: "  ((condi
0fd0: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63  tion-property-ac
0fe0: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73  cessor 'exn 'mes
0ff0: 73 61 67 65 29 20 65 78 6e 29 29 20 20 20 20 20  sage) exn))     
1000: 20 20 0a 20 20 20 20 20 28 76 65 63 74 6f 72 20    .     (vector 
1010: 23 66 20 28 76 65 63 74 6f 72 20 65 78 6e 20 63  #f (vector exn c
1020: 61 6c 6c 2d 63 68 61 69 6e 20 64 61 74 29 29 29  all-chain dat)))
1030: 20 3b 3b 20 72 65 74 75 72 6e 20 73 6f 6d 65 20   ;; return some 
1040: 73 74 75 66 66 20 66 6f 72 20 64 65 62 75 67 20  stuff for debug 
1050: 69 66 20 61 6e 20 65 78 63 65 70 74 69 6f 6e 20  if an exception 
1060: 68 61 70 70 65 6e 73 0a 20 20 20 28 63 6f 6e 64  happens.   (cond
1070: 0a 20 20 20 20 28 28 6e 6f 74 20 28 76 65 63 74  .    ((not (vect
1080: 6f 72 3f 20 64 61 74 29 29 20 20 20 20 20 20 20  or? dat))       
1090: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20               ;; 
10a0: 69 74 20 69 73 20 61 6e 20 65 72 72 6f 72 20 74  it is an error t
10b0: 6f 20 6e 6f 74 20 72 65 63 65 69 76 65 20 61 20  o not receive a 
10c0: 76 65 63 74 6f 72 0a 20 20 20 20 20 28 76 65 63  vector.     (vec
10d0: 74 6f 72 20 23 66 20 28 76 65 63 74 6f 72 20 23  tor #f (vector #
10e0: 66 20 22 72 65 6d 6f 74 65 20 6d 75 73 74 20 62  f "remote must b
10f0: 65 20 63 61 6c 6c 65 64 20 77 69 74 68 20 61 20  e called with a 
1100: 76 65 63 74 6f 72 22 29 29 29 0a 20 20 20 20 28  vector"))).    (
1110: 28 3e 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d  (> *api-process-
1120: 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 32  request-count* 2
1130: 30 29 20 3b 3b 20 32 30 29 0a 20 20 20 20 20 28  0) ;; 20).     (
1140: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64  debug:print 0 *d
1150: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a  efault-log-port*
1160: 20 22 57 41 52 4e 49 4e 47 3a 20 61 70 69 3a 65   "WARNING: api:e
1170: 78 65 63 75 74 65 2d 72 65 71 75 65 73 74 73 20  xecute-requests 
1180: 72 65 63 65 69 76 65 64 20 61 6e 20 6f 76 65 72  received an over
1190: 6c 6f 61 64 65 64 20 6d 65 73 73 61 67 65 2e 22  loaded message."
11a0: 29 0a 20 20 20 20 20 28 73 65 74 21 20 2a 73 65  ).     (set! *se
11b0: 72 76 65 72 2d 6f 76 65 72 6c 6f 61 64 65 64 2a  rver-overloaded*
11c0: 20 23 74 29 0a 20 20 20 20 20 28 76 65 63 74 6f   #t).     (vecto
11d0: 72 20 23 66 20 28 76 65 63 74 6f 72 20 23 66 20  r #f (vector #f 
11e0: 27 6f 76 65 72 6c 6f 61 64 65 64 29 29 29 20 3b  'overloaded))) ;
11f0: 3b 20 74 68 65 20 69 6e 6e 65 72 20 76 65 63 74  ; the inner vect
1200: 6f 72 20 69 73 20 77 68 61 74 20 67 65 74 73 20  or is what gets 
1210: 72 65 74 75 72 6e 65 64 2e 20 6e 6f 70 65 2c 20  returned. nope, 
1220: 64 6f 6e 27 74 20 6b 6e 6f 77 20 77 68 79 2e 20  don't know why. 
1230: 70 6c 65 61 73 65 20 72 65 66 61 63 74 6f 72 21  please refactor!
1240: 0a 20 20 20 20 28 65 6c 73 65 20 20 0a 20 20 20  .    (else  .   
1250: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 2d 69 6e    (let* ((cmd-in
1260: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63              (vec
1270: 74 6f 72 2d 72 65 66 20 64 61 74 20 30 29 29 0a  tor-ref dat 0)).
1280: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6d 64              (cmd
1290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
12a0: 69 66 20 28 73 79 6d 62 6f 6c 3f 20 63 6d 64 2d  if (symbol? cmd-
12b0: 69 6e 29 0a 09 09 09 09 20 20 20 63 6d 64 2d 69  in).....   cmd-i
12c0: 6e 0a 09 09 09 09 20 20 20 28 73 74 72 69 6e 67  n.....   (string
12d0: 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 2d 69 6e 29  ->symbol cmd-in)
12e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  )).            (
12f0: 70 61 72 61 6d 73 20 20 20 20 20 20 20 20 20 20  params          
1300: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61    (vector-ref da
1310: 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20  t 1)).          
1320: 20 20 28 73 74 61 72 74 2d 74 20 20 20 20 20 20    (start-t      
1330: 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 6d 69       (current-mi
1340: 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 20 20 20  lliseconds)).   
1350: 20 20 20 20 20 20 20 20 20 28 72 65 61 64 6f 6e           (readon
1360: 6c 79 2d 6d 6f 64 65 20 20 20 20 20 28 64 62 72  ly-mode     (dbr
1370: 3a 64 62 73 74 72 75 63 74 2d 72 65 61 64 2d 6f  :dbstruct-read-o
1380: 6e 6c 79 20 64 62 73 74 72 75 63 74 29 29 0a 20  nly dbstruct)). 
1390: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 61 64             (read
13a0: 6f 6e 6c 79 2d 63 6f 6d 6d 61 6e 64 20 20 28 6d  only-command  (m
13b0: 65 6d 62 65 72 20 63 6d 64 20 61 70 69 3a 72 65  ember cmd api:re
13c0: 61 64 2d 6f 6e 6c 79 2d 71 75 65 72 69 65 73 29  ad-only-queries)
13d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 77  ).            (w
13e0: 72 69 74 65 63 6d 64 2d 69 6e 2d 72 65 61 64 6f  ritecmd-in-reado
13f0: 6e 6c 79 2d 6d 6f 64 65 20 28 61 6e 64 20 72 65  nly-mode (and re
1400: 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 28 6e 6f 74  adonly-mode (not
1410: 20 72 65 61 64 6f 6e 6c 79 2d 63 6f 6d 6d 61 6e   readonly-comman
1420: 64 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  d))).           
1430: 20 23 3b 28 66 6f 6f 20 20 20 20 20 20 20 20 20   #;(foo         
1440: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20        (begin.   
1450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63                (c
1470: 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 79 2d  ommon:telemetry-
1480: 6c 6f 67 20 28 63 6f 6e 63 20 22 61 70 69 2d 69  log (conc "api-i
1490: 6e 3a 22 28 2d 3e 73 74 72 69 6e 67 20 63 6d 64  n:"(->string cmd
14a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
14b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
14c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
14d0: 20 20 20 20 20 20 20 20 20 20 70 61 79 6c 6f 61            payloa
14e0: 64 3a 20 60 28 28 70 61 72 61 6d 73 20 2e 20 2c  d: `((params . ,
14f0: 70 61 72 61 6d 73 29 29 29 0a 20 20 20 20 20 20  params))).      
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 0a 20 20 20 20             .    
1520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1530: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 74 29               #t)
1540: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 72  ).            (r
1550: 65 73 20 20 20 20 0a 20 20 20 20 20 20 20 20 20  es    .         
1560: 20 20 20 20 28 69 66 20 77 72 69 74 65 63 6d 64      (if writecmd
1570: 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64  -in-readonly-mod
1580: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  e.              
1590: 20 20 20 28 63 6f 6e 63 20 22 61 74 74 65 6d 70     (conc "attemp
15a0: 74 20 74 6f 20 72 75 6e 20 77 72 69 74 65 20 63  t to run write c
15b0: 6f 6d 6d 61 6e 64 20 22 63 6d 64 22 20 6f 6e 20  ommand "cmd" on 
15c0: 61 20 72 65 61 64 2d 6f 6e 6c 79 20 64 61 74 61  a read-only data
15d0: 62 61 73 65 22 29 0a 20 20 20 20 20 20 20 20 20  base").         
15e0: 20 20 20 20 20 20 20 20 28 63 61 73 65 20 63 6d          (case cm
15f0: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  d.              
1600: 20 20 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d       ;;=========
1610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1630: 3d 3d 3d 3d 3d 3d 0a 20 20 20 20 20 20 20 20 20  ======.         
1640: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 52 45 41            ;; REA
1650: 44 2f 57 52 49 54 45 20 51 55 45 52 49 45 53 0a  D/WRITE QUERIES.
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1670: 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d     ;;===========
1680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
16a0: 3d 3d 3d 3d 0a 0a 20 20 20 20 20 20 20 20 20 20  ====..          
16b0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 6b           ((get-k
16c0: 65 79 73 2d 77 72 69 74 65 29 20 20 20 20 20 20  eys-write)      
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
16e0: 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64    (db:get-keys d
16f0: 62 73 74 72 75 63 74 29 29 20 3b 3b 20 66 6f 72  bstruct)) ;; for
1700: 63 65 20 61 20 64 75 6d 6d 79 20 22 77 72 69 74  ce a dummy "writ
1710: 65 22 20 71 75 65 72 79 20 74 6f 20 66 6f 72 63  e" query to forc
1720: 65 20 73 65 72 76 65 72 3b 20 66 6f 72 20 64 65  e server; for de
1730: 62 75 67 20 69 6e 20 2d 72 65 70 6c 0a 20 20 20  bug in -repl.   
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1750: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
1760: 20 20 20 20 3b 3b 20 53 45 52 56 45 52 53 0a 20      ;; SERVERS. 
1770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1780: 20 20 28 28 73 74 61 72 74 2d 73 65 72 76 65 72    ((start-server
1790: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  )               
17a0: 20 20 20 20 20 28 61 70 70 6c 79 20 73 65 72 76       (apply serv
17b0: 65 72 3a 6b 69 6e 64 2d 72 75 6e 20 70 61 72 61  er:kind-run para
17c0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  ms)).           
17d0: 20 20 20 20 20 20 20 20 28 28 6b 69 6c 6c 2d 73          ((kill-s
17e0: 65 72 76 65 72 29 20 20 20 20 20 20 20 20 20 20  erver)          
17f0: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21             (set!
1800: 20 2a 73 65 72 76 65 72 2d 72 75 6e 2a 20 23 66   *server-run* #f
1810: 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20  ))..            
1820: 20 20 20 20 20 20 20 3b 3b 20 54 45 53 54 53 0a         ;; TESTS.
1830: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
1840: 20 20 20 20 3b 3b 28 28 74 65 73 74 2d 73 65 74      ;;((test-set
1850: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79  -state-status-by
1860: 2d 69 64 29 20 20 20 20 20 28 61 70 70 6c 79 20  -id)     (apply 
1870: 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74  mt:test-set-stat
1880: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 64  e-status-by-id d
1890: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29  bstruct params))
18a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
18b0: 20 20 20 20 3b 3b 42 42 20 2d 20 63 6f 6d 6d 65      ;;BB - comme
18c0: 6e 74 65 64 20 6f 75 74 20 61 62 6f 76 65 20 62  nted out above b
18d0: 65 63 61 75 73 65 20 69 74 20 77 61 73 20 63 61  ecause it was ca
18e0: 6c 6c 69 6e 67 20 62 65 6c 6f 77 2c 20 65 76 65  lling below, eve
18f0: 6e 74 75 61 6c 6c 79 2c 20 69 6e 63 6f 72 72 65  ntually, incorre
1900: 63 74 6c 79 20 28 64 62 73 74 72 75 63 74 20 70  ctly (dbstruct p
1910: 61 73 73 65 64 20 74 6f 20 6d 74 3a 74 65 73 74  assed to mt:test
1920: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75  -set-state-statu
1930: 73 2d 62 79 2d 69 64 2c 20 77 68 69 63 68 20 70  s-by-id, which p
1940: 72 65 76 69 6f 73 6c 79 20 64 69 64 20 6d 6f 72  reviosly did mor
1950: 65 2c 20 62 75 74 20 6e 6f 77 20 6f 6e 6c 79 20  e, but now only 
1960: 70 61 73 73 65 73 20 74 68 72 75 20 74 6f 20 64  passes thru to d
1970: 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74  b:set-state-stat
1980: 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69  us-and-roll-up-i
1990: 74 65 6d 73 2e 0a 20 20 20 20 20 20 20 20 20 20  tems..          
19a0: 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d           ((test-
19b0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73  set-state-status
19c0: 2d 62 79 2d 69 64 29 0a 0a 20 20 20 20 20 20 20  -by-id)..       
19d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20               ;; 
19e0: 28 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 2d  (define (db:set-
19f0: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64  state-status-and
1a00: 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 64  -roll-up-items d
1a10: 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 74  bstruct run-id t
1a20: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61  est-name item-pa
1a30: 74 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20  th state status 
1a40: 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 20 20 20  comment).       
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62               (db
1a60: 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75  :set-state-statu
1a70: 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74  s-and-roll-up-it
1a80: 65 6d 73 0a 20 20 20 20 20 20 20 20 20 20 20 20  ems.            
1a90: 20 20 20 20 20 20 20 20 20 64 62 73 74 72 75 63           dbstruc
1aa0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  t.              
1ab0: 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66         (list-ref
1ac0: 20 70 61 72 61 6d 73 20 30 29 20 3b 20 72 75 6e   params 0) ; run
1ad0: 2d 69 64 0a 20 20 20 20 20 20 20 20 20 20 20 20  -id.            
1ae0: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72           (list-r
1af0: 65 66 20 70 61 72 61 6d 73 20 31 29 20 3b 20 74  ef params 1) ; t
1b00: 65 73 74 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20  est-name.       
1b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66                #f
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1b30: 20 20 3b 20 69 74 65 6d 2d 70 61 74 68 0a 20 20    ; item-path.  
1b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1b50: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 72     (list-ref par
1b60: 61 6d 73 20 32 29 20 3b 20 73 74 61 74 65 0a 20  ams 2) ; state. 
1b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1b80: 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61      (list-ref pa
1b90: 72 61 6d 73 20 33 29 20 3b 20 73 74 61 74 75 73  rams 3) ; status
1ba0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
1bb0: 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20        (list-ref 
1bc0: 70 61 72 61 6d 73 20 34 29 20 3b 20 63 6f 6d 6d  params 4) ; comm
1bd0: 65 6e 74 0a 20 20 20 20 20 20 20 20 20 20 20 20  ent.            
1be0: 20 20 20 20 20 20 20 20 20 29 29 0a 20 20 20 20           )).    
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a                 .
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1c10: 20 20 20 28 28 64 65 6c 65 74 65 2d 74 65 73 74     ((delete-test
1c20: 2d 72 65 63 6f 72 64 73 29 20 20 20 20 20 20 20  -records)       
1c30: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a        (apply db:
1c40: 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f  delete-test-reco
1c50: 72 64 73 20 64 62 73 74 72 75 63 74 20 70 61 72  rds dbstruct par
1c60: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20  ams)).          
1c70: 20 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 74           ((delet
1c80: 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65  e-old-deleted-te
1c90: 73 74 2d 72 65 63 6f 72 64 73 29 20 28 61 70 70  st-records) (app
1ca0: 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 6f 6c 64  ly db:delete-old
1cb0: 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 65  -deleted-test-re
1cc0: 63 6f 72 64 73 20 64 62 73 74 72 75 63 74 20 70  cords dbstruct p
1cd0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
1ce0: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73             ((tes
1cf0: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74  t-set-state-stat
1d00: 75 73 29 20 20 20 20 20 20 20 20 20 20 20 28 61  us)           (a
1d10: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 73 65 74  pply db:test-set
1d20: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 64 62  -state-status db
1d30: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a  struct params)).
1d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1d50: 20 20 20 28 28 74 65 73 74 2d 73 65 74 2d 74 6f     ((test-set-to
1d60: 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 29 20 20  p-process-pid)  
1d70: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a        (apply db:
1d80: 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 6f  test-set-top-pro
1d90: 63 65 73 73 2d 70 69 64 20 64 62 73 74 72 75 63  cess-pid dbstruc
1da0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20  t params)).     
1db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28                ((
1dc0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73  set-state-status
1dd0: 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65  -and-roll-up-ite
1de0: 6d 73 29 20 28 61 70 70 6c 79 20 64 62 3a 73 65  ms) (apply db:se
1df0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61  t-state-status-a
1e00: 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73  nd-roll-up-items
1e10: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73   dbstruct params
1e20: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
1e30: 20 20 20 20 20 20 28 28 73 65 74 2d 73 74 61 74        ((set-stat
1e40: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c  e-status-and-rol
1e50: 6c 2d 75 70 2d 72 75 6e 29 20 28 61 70 70 6c 79  l-up-run) (apply
1e60: 20 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74   db:set-state-st
1e70: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70  atus-and-roll-up
1e80: 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 70 61  -run dbstruct pa
1e90: 72 61 6d 73 29 29 20 0a 20 20 20 20 20 20 20 20  rams)) .        
1ea0: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 6f 70             ((top
1eb0: 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 66  -test-set-per-pf
1ec0: 2d 63 6f 75 6e 74 73 29 20 20 20 20 20 20 28 61  -counts)      (a
1ed0: 70 70 6c 79 20 64 62 3a 74 6f 70 2d 74 65 73 74  pply db:top-test
1ee0: 2d 73 65 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e  -set-per-pf-coun
1ef0: 74 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61  ts dbstruct para
1f00: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  ms)).           
1f10: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d 73          ((test-s
1f20: 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b  et-archive-block
1f30: 2d 69 64 29 20 20 20 20 20 20 20 28 61 70 70 6c  -id)       (appl
1f40: 79 20 64 62 3a 74 65 73 74 2d 73 65 74 2d 61 72  y db:test-set-ar
1f50: 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 20 64  chive-block-id d
1f60: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29  bstruct params))
1f70: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ..              
1f80: 20 20 20 20 20 3b 3b 20 52 55 4e 53 0a 20 20 20       ;; RUNS.   
1f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1fa0: 28 28 72 65 67 69 73 74 65 72 2d 72 75 6e 29 20  ((register-run) 
1fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1fc0: 28 61 70 70 6c 79 20 64 62 3a 72 65 67 69 73 74  (apply db:regist
1fd0: 65 72 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20  er-run dbstruct 
1fe0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20  params)).       
1ff0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 65              ((se
2000: 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74  t-tests-state-st
2010: 61 74 75 73 29 20 20 20 20 20 20 20 28 61 70 70  atus)       (app
2020: 6c 79 20 64 62 3a 73 65 74 2d 74 65 73 74 73 2d  ly db:set-tests-
2030: 73 74 61 74 65 2d 73 74 61 74 75 73 20 64 62 73  state-status dbs
2040: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20  truct params)). 
2050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2060: 20 20 28 28 64 65 6c 65 74 65 2d 72 75 6e 29 20    ((delete-run) 
2070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2080: 20 20 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65    (apply db:dele
2090: 74 65 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20  te-run dbstruct 
20a0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20  params)).       
20b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6c 6f              ((lo
20c0: 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 29 20 20  ck/unlock-run)  
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70              (app
20e0: 6c 79 20 64 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63  ly db:lock/unloc
20f0: 6b 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 70  k-run dbstruct p
2100: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
2110: 20 20 20 20 20 20 20 20 20 20 20 28 28 75 70 64             ((upd
2120: 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69  ate-run-event_ti
2130: 6d 65 29 20 20 20 20 20 20 20 20 28 61 70 70 6c  me)        (appl
2140: 79 20 64 62 3a 75 70 64 61 74 65 2d 72 75 6e 2d  y db:update-run-
2150: 65 76 65 6e 74 5f 74 69 6d 65 20 64 62 73 74 72  event_time dbstr
2160: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20  uct params)).   
2170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2180: 28 28 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61  ((update-run-sta
2190: 74 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20  ts)             
21a0: 28 61 70 70 6c 79 20 64 62 3a 75 70 64 61 74 65  (apply db:update
21b0: 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72  -run-stats dbstr
21c0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20  uct params)).   
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
21e0: 28 28 73 65 74 2d 76 61 72 29 20 20 20 20 20 20  ((set-var)      
21f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2200: 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d 76 61  (apply db:set-va
2210: 72 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d  r dbstruct param
2220: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  s)).            
2230: 20 20 20 20 20 20 20 28 28 69 6e 63 2d 76 61 72         ((inc-var
2240: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  )               
2250: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62         (apply db
2260: 3a 69 6e 63 2d 76 61 72 20 64 62 73 74 72 75 63  :inc-var dbstruc
2270: 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20  t params))...   
2280: 28 28 64 65 63 2d 76 61 72 29 20 20 20 20 20 20  ((dec-var)      
2290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
22a0: 28 61 70 70 6c 79 20 64 62 3a 64 65 63 2d 76 61  (apply db:dec-va
22b0: 72 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d  r dbstruct param
22c0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  s)).            
22d0: 20 20 20 20 20 20 20 28 28 64 65 6c 2d 76 61 72         ((del-var
22e0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  )               
22f0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62         (apply db
2300: 3a 64 65 6c 2d 76 61 72 20 64 62 73 74 72 75 63  :del-var dbstruc
2310: 74 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20  t params))...   
2320: 28 28 61 64 64 2d 76 61 72 29 20 20 20 20 20 20  ((add-var)      
2330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2340: 28 61 70 70 6c 79 20 64 62 3a 61 64 64 2d 76 61  (apply db:add-va
2350: 72 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d  r dbstruct param
2360: 73 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20  s))..           
2370: 20 20 20 20 20 20 20 20 3b 3b 20 53 54 45 50 53          ;; STEPS
2380: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2390: 20 20 20 20 28 28 74 65 73 74 73 74 65 70 2d 73      ((teststep-s
23a0: 65 74 2d 73 74 61 74 75 73 21 29 20 20 20 20 20  et-status!)     
23b0: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65      (apply db:te
23c0: 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75  ststep-set-statu
23d0: 73 21 20 64 62 73 74 72 75 63 74 20 70 61 72 61  s! dbstruct para
23e0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  ms)).           
23f0: 20 20 20 20 20 20 20 20 28 28 64 65 6c 65 74 65          ((delete
2400: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 21  -steps-for-test!
2410: 29 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20  )        (apply 
2420: 64 62 3a 64 65 6c 65 74 65 2d 73 74 65 70 73 2d  db:delete-steps-
2430: 66 6f 72 2d 74 65 73 74 21 20 64 62 73 74 72 75  for-test! dbstru
2440: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20  ct params)).    
2450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a                 .
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2470: 20 20 20 3b 3b 20 54 45 53 54 20 44 41 54 41 0a     ;; TEST DATA.
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2490: 20 20 20 28 28 74 65 73 74 2d 64 61 74 61 2d 72     ((test-data-r
24a0: 6f 6c 6c 75 70 29 20 20 20 20 20 20 20 20 20 20  ollup)          
24b0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73     (apply db:tes
24c0: 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 62  t-data-rollup db
24d0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a  struct params)).
24e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
24f0: 20 20 20 28 28 63 73 76 2d 3e 74 65 73 74 2d 64     ((csv->test-d
2500: 61 74 61 29 20 20 20 20 20 20 20 20 20 20 20 20  ata)            
2510: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 63 73 76     (apply db:csv
2520: 2d 3e 74 65 73 74 2d 64 61 74 61 20 64 62 73 74  ->test-data dbst
2530: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20  ruct params)).. 
2540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2550: 20 20 3b 3b 20 4d 49 53 43 0a 20 20 20 20 20 20    ;; MISC.      
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73               ((s
2570: 79 6e 63 2d 69 6e 6d 65 6d 2d 3e 64 62 29 20 20  ync-inmem->db)  
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65               (le
2590: 74 20 28 28 72 75 6e 2d 69 64 20 28 63 61 72 20  t ((run-id (car 
25a0: 70 61 72 61 6d 73 29 29 29 0a 20 20 20 20 20 20  params))).      
25b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
25c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
25d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
25e0: 64 62 3a 73 79 6e 63 2d 74 6f 75 63 68 65 64 20  db:sync-touched 
25f0: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20  dbstruct run-id 
2600: 66 6f 72 63 65 2d 73 79 6e 63 3a 20 23 74 29 29  force-sync: #t))
2610: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
2620: 20 20 20 20 20 28 28 6d 61 72 6b 2d 69 6e 63 6f       ((mark-inco
2630: 6d 70 6c 65 74 65 29 20 20 20 20 20 20 20 20 20  mplete)         
2640: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 66       (apply db:f
2650: 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63  ind-and-mark-inc
2660: 6f 6d 70 6c 65 74 65 20 64 62 73 74 72 75 63 74  omplete dbstruct
2670: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20   params)).      
2680: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63               ((c
2690: 72 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67 67 65  reate-all-trigge
26a0: 72 73 29 20 20 20 20 20 20 20 20 20 20 28 64 62  rs)          (db
26b0: 3a 63 72 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67  :create-all-trig
26c0: 67 65 72 73 20 64 62 73 74 72 75 63 74 29 29 0a  gers dbstruct)).
26d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
26e0: 20 20 20 28 28 64 72 6f 70 2d 61 6c 6c 2d 74 72     ((drop-all-tr
26f0: 69 67 67 65 72 73 29 20 20 20 20 20 20 20 20 20  iggers)         
2700: 20 20 20 28 64 62 3a 64 72 6f 70 2d 61 6c 6c 2d     (db:drop-all-
2710: 74 72 69 67 67 65 72 73 20 64 62 73 74 72 75 63  triggers dbstruc
2720: 74 29 29 20 0a 0a 20 20 20 20 20 20 20 20 20 20  t)) ..          
2730: 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45 53 54           ;; TEST
2740: 4d 45 54 41 0a 20 20 20 20 20 20 20 20 20 20 20  META.           
2750: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 6d 65          ((testme
2760: 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 29 20 20  ta-add-record)  
2770: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74       (apply db:t
2780: 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f  estmeta-add-reco
2790: 72 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61  rd dbstruct para
27a0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  ms)).           
27b0: 20 20 20 20 20 20 20 20 28 28 74 65 73 74 6d 65          ((testme
27c0: 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 29  ta-update-field)
27d0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74       (apply db:t
27e0: 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66  estmeta-update-f
27f0: 69 65 6c 64 20 64 62 73 74 72 75 63 74 20 70 61  ield dbstruct pa
2800: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20  rams)).         
2810: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d            ((get-
2820: 74 65 73 74 73 2d 74 61 67 73 29 20 20 20 20 20  tests-tags)     
2830: 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 74         (db:get-t
2840: 65 73 74 73 2d 74 61 67 73 20 64 62 73 74 72 75  ests-tags dbstru
2850: 63 74 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20  ct))..          
2860: 20 20 20 20 20 20 20 20 20 3b 3b 20 54 41 53 4b           ;; TASK
2870: 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  S.              
2880: 20 20 20 20 20 28 28 74 61 73 6b 73 2d 61 64 64       ((tasks-add
2890: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  )               
28a0: 20 20 28 61 70 70 6c 79 20 74 61 73 6b 73 3a 61    (apply tasks:a
28b0: 64 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61  dd dbstruct para
28c0: 6d 73 29 29 20 20 20 0a 20 20 20 20 20 20 20 20  ms))   .        
28d0: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 61 73             ((tas
28e0: 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 69 76  ks-set-state-giv
28f0: 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 29 20 28 61  en-param-key) (a
2900: 70 70 6c 79 20 74 61 73 6b 73 3a 73 65 74 2d 73  pply tasks:set-s
2910: 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d  tate-given-param
2920: 2d 6b 65 79 20 64 62 73 74 72 75 63 74 20 70 61  -key dbstruct pa
2930: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20  rams)).         
2940: 20 20 20 20 20 20 20 20 20 20 28 28 74 61 73 6b            ((task
2950: 73 2d 67 65 74 2d 6c 61 73 74 29 20 20 20 20 20  s-get-last)     
2960: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 74 61         (apply ta
2970: 73 6b 73 3a 67 65 74 2d 6c 61 73 74 20 64 62 73  sks:get-last dbs
2980: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a  truct params))..
2990: 09 09 20 20 20 3b 3b 20 4e 4f 20 53 59 4e 43 20  ..   ;; NO SYNC 
29a0: 44 42 0a 09 09 20 20 20 28 28 6e 6f 2d 73 79 6e  DB...   ((no-syn
29b0: 63 2d 73 65 74 29 20 20 20 20 20 20 20 20 20 20  c-set)          
29c0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6e       (apply db:n
29d0: 6f 2d 73 79 6e 63 2d 73 65 74 20 20 20 20 20 20  o-sync-set      
29e0: 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20     *no-sync-db* 
29f0: 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 28 28  params))...   ((
2a00: 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 66 61  no-sync-get/defa
2a10: 75 6c 74 29 20 20 20 20 20 20 20 28 61 70 70 6c  ult)       (appl
2a20: 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74  y db:no-sync-get
2a30: 2f 64 65 66 61 75 6c 74 20 2a 6e 6f 2d 73 79 6e  /default *no-syn
2a40: 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 0a 09  c-db* params))..
2a50: 09 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d 64 65  .   ((no-sync-de
2a60: 6c 21 29 20 20 20 20 20 20 20 20 20 20 20 20 20  l!)             
2a70: 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 79   (apply db:no-sy
2a80: 6e 63 2d 64 65 6c 21 20 20 20 20 20 20 20 20 2a  nc-del!        *
2a90: 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 72 61  no-sync-db* para
2aa0: 6d 73 29 29 0a 09 09 20 20 20 28 28 6e 6f 2d 73  ms))...   ((no-s
2ab0: 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 29 20 20 20  ync-get-lock)   
2ac0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62         (apply db
2ad0: 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c 6f 63  :no-sync-get-loc
2ae0: 6b 20 20 20 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62  k    *no-sync-db
2af0: 2a 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20  * params))...   
2b00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2b10: 20 20 20 20 3b 3b 20 41 52 43 48 49 56 45 53 0a      ;; ARCHIVES.
2b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2b30: 20 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 2d     ;; ((archive-
2b40: 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 29  get-allocations)
2b50: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20     .            
2b60: 20 20 20 20 20 20 20 28 28 61 72 63 68 69 76 65         ((archive
2b70: 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b 29 20  -register-disk) 
2b80: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 61 72      (apply db:ar
2b90: 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 64  chive-register-d
2ba0: 69 73 6b 20 64 62 73 74 72 75 63 74 20 70 61 72  isk dbstruct par
2bb0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20  ams)).          
2bc0: 20 20 20 20 20 20 20 20 20 28 28 61 72 63 68 69           ((archi
2bd0: 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c 6f 63  ve-register-bloc
2be0: 6b 2d 6e 61 6d 65 29 28 61 70 70 6c 79 20 64 62  k-name)(apply db
2bf0: 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65  :archive-registe
2c00: 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 64 62 73  r-block-name dbs
2c10: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20  truct params)). 
2c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2c30: 20 20 3b 3b 20 28 28 61 72 63 68 69 76 65 2d 61    ;; ((archive-a
2c40: 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74  llocate-testsuit
2c50: 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 29  e/area-to-block)
2c60: 28 61 70 70 6c 79 20 64 62 3a 61 72 63 68 69 76  (apply db:archiv
2c70: 65 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73  e-allocate-tests
2c80: 75 69 74 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f  uite/area-to-blo
2c90: 63 6b 20 64 62 73 74 72 75 63 74 20 62 6c 6f 63  ck dbstruct bloc
2ca0: 6b 2d 69 64 20 74 65 73 74 73 75 69 74 65 2d 6e  k-id testsuite-n
2cb0: 61 6d 65 20 61 72 65 61 6b 65 79 29 29 0a 0a 20  ame areakey)).. 
2cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2cd0: 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d    ;;============
2ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 20 20 20 20 20  ==========.     
2d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b                ;;
2d30: 20 52 45 41 44 20 4f 4e 4c 59 20 51 55 45 52 49   READ ONLY QUERI
2d40: 45 53 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ES.             
2d50: 20 20 20 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d        ;;========
2d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a  ==============..
2da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2db0: 20 20 20 3b 3b 20 4b 45 59 53 0a 20 20 20 20 20     ;; KEYS.     
2dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28                ((
2dd0: 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72  get-key-val-pair
2de0: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20  s)              
2df0: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6b   (apply db:get-k
2e00: 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 64 62 73  ey-val-pairs dbs
2e10: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20  truct params)). 
2e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e30: 20 20 28 28 67 65 74 2d 6b 65 79 73 29 20 20 20    ((get-keys)   
2e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e50: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 79       (db:get-key
2e60: 73 20 64 62 73 74 72 75 63 74 29 29 0a 20 20 20  s dbstruct)).   
2e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e80: 28 28 67 65 74 2d 6b 65 79 2d 76 61 6c 73 29 20  ((get-key-vals) 
2e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2ea0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74     (apply db:get
2eb0: 2d 6b 65 79 2d 76 61 6c 73 20 64 62 73 74 72 75  -key-vals dbstru
2ec0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20  ct params)).    
2ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
2ee0: 28 67 65 74 2d 74 61 72 67 65 74 29 20 20 20 20  (get-target)    
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2f00: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d    (apply db:get-
2f10: 74 61 72 67 65 74 20 64 62 73 74 72 75 63 74 20  target dbstruct 
2f20: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20  params)).       
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65              ((ge
2f40: 74 2d 74 61 72 67 65 74 73 29 20 20 20 20 20 20  t-targets)      
2f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
2f60: 64 62 3a 67 65 74 2d 74 61 72 67 65 74 73 20 64  db:get-targets d
2f70: 62 73 74 72 75 63 74 29 29 0a 0a 20 20 20 20 20  bstruct))..     
2f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b                ;;
2f90: 20 41 52 43 48 49 56 45 53 0a 20 20 20 20 20 20   ARCHIVES.      
2fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74               ((t
2fb0: 65 73 74 2d 67 65 74 2d 61 72 63 68 69 76 65 2d  est-get-archive-
2fc0: 62 6c 6f 63 6b 2d 69 6e 66 6f 29 20 20 20 20 20  block-info)     
2fd0: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67  (apply db:test-g
2fe0: 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b  et-archive-block
2ff0: 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74 20 70  -info dbstruct p
3000: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
3010: 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20             .    
3020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b                 ;
3030: 3b 20 54 45 53 54 53 0a 20 20 20 20 20 20 20 20  ; TESTS.        
3040: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73             ((tes
3050: 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69  t-toplevel-num-i
3060: 74 65 6d 73 29 20 20 20 20 20 20 20 20 20 28 61  tems)         (a
3070: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 74 6f 70  pply db:test-top
3080: 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 20  level-num-items 
3090: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
30a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
30b0: 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 2d       ((get-test-
30c0: 69 6e 66 6f 2d 62 79 2d 69 64 29 09 20 20 20 20  info-by-id).    
30d0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74     (apply db:get
30e0: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64  -test-info-by-id
30f0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73   dbstruct params
3100: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
3110: 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 74        ((test-get
3120: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73  -rundir-from-tes
3130: 74 2d 69 64 29 20 20 20 20 28 61 70 70 6c 79 20  t-id)    (apply 
3140: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64  db:test-get-rund
3150: 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20  ir-from-test-id 
3160: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
3170: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
3180: 20 20 20 20 20 28 28 67 65 74 2d 63 6f 75 6e 74       ((get-count
3190: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66  -tests-running-f
31a0: 6f 72 2d 74 65 73 74 6e 61 6d 65 29 20 28 61 70  or-testname) (ap
31b0: 70 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e 74  ply db:get-count
31c0: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66  -tests-running-f
31d0: 6f 72 2d 74 65 73 74 6e 61 6d 65 20 64 62 73 74  or-testname dbst
31e0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20  ruct params)).  
31f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3200: 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73   ((get-count-tes
3210: 74 73 2d 72 75 6e 6e 69 6e 67 29 20 20 20 20 20  ts-running)     
3220: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65      (apply db:ge
3230: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75  t-count-tests-ru
3240: 6e 6e 69 6e 67 20 64 62 73 74 72 75 63 74 20 70  nning dbstruct p
3250: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
3260: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74             ((get
3270: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e  -count-tests-run
3280: 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70  ning-in-jobgroup
3290: 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d  ) (apply db:get-
32a0: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e  count-tests-runn
32b0: 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20  ing-in-jobgroup 
32c0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
32d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
32e0: 20 20 20 20 20 3b 3b 20 28 28 64 65 6c 65 74 65       ;; ((delete
32f0: 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72  -test-step-recor
3300: 64 73 29 20 20 20 20 20 20 20 20 28 61 70 70 6c  ds)        (appl
3310: 79 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74  y db:delete-test
3320: 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 64 62  -step-records db
3330: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a  struct params)).
3340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3350: 20 20 20 3b 3b 20 28 28 67 65 74 2d 70 72 65 76     ;; ((get-prev
3360: 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65  ious-test-run-re
3370: 63 6f 72 64 29 20 20 20 20 28 61 70 70 6c 79 20  cord)    (apply 
3380: 64 62 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d  db:get-previous-
3390: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20  test-run-record 
33a0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
33b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
33c0: 20 20 20 20 20 28 28 67 65 74 2d 6d 61 74 63 68       ((get-match
33d0: 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 73  ing-previous-tes
33e0: 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 29 28 61  t-run-records)(a
33f0: 70 70 6c 79 20 64 62 3a 67 65 74 2d 6d 61 74 63  pply db:get-matc
3400: 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65  hing-previous-te
3410: 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 64  st-run-records d
3420: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29  bstruct params))
3430: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
3440: 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d 6c      ((test-get-l
3450: 6f 67 66 69 6c 65 2d 69 6e 66 6f 29 20 20 20 20  ogfile-info)    
3460: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62         (apply db
3470: 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c  :test-get-logfil
3480: 65 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74 20  e-info dbstruct 
3490: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20  params)).       
34a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65              ((te
34b0: 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66  st-get-records-f
34c0: 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 29 20 20  or-index-file)  
34d0: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67  (apply db:test-g
34e0: 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69  et-records-for-i
34f0: 6e 64 65 78 2d 66 69 6c 65 20 64 62 73 74 72 75  ndex-file dbstru
3500: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20  ct params)).    
3510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
3520: 28 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74  (get-testinfo-st
3530: 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 20 20  ate-status)     
3540: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d    (apply db:get-
3550: 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73  testinfo-state-s
3560: 74 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70  tatus dbstruct p
3570: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
3580: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 65 73             ((tes
3590: 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73  t-get-top-proces
35a0: 73 2d 70 69 64 29 20 20 20 20 20 20 20 20 28 61  s-pid)        (a
35b0: 70 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74  pply db:test-get
35c0: 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64  -top-process-pid
35d0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73   dbstruct params
35e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
35f0: 20 20 20 20 20 20 28 28 74 65 73 74 2d 67 65 74        ((test-get
3600: 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d  -paths-matching-
3610: 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d  keynames-target-
3620: 6e 65 77 29 20 28 61 70 70 6c 79 20 64 62 3a 74  new) (apply db:t
3630: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61  est-get-paths-ma
3640: 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d  tching-keynames-
3650: 74 61 72 67 65 74 2d 6e 65 77 20 64 62 73 74 72  target-new dbstr
3660: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20  uct params)).   
3670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3680: 28 28 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f  ((get-prereqs-no
3690: 74 2d 6d 65 74 29 20 20 20 20 20 20 20 20 20 20  t-met)          
36a0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74     (apply db:get
36b0: 2d 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74  -prereqs-not-met
36c0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73   dbstruct params
36d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
36e0: 20 20 20 20 20 20 28 28 67 65 74 2d 63 6f 75 6e        ((get-coun
36f0: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d  t-tests-running-
3700: 66 6f 72 2d 72 75 6e 2d 69 64 29 20 28 61 70 70  for-run-id) (app
3710: 6c 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d  ly db:get-count-
3720: 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f  tests-running-fo
3730: 72 2d 72 75 6e 2d 69 64 20 64 62 73 74 72 75 63  r-run-id dbstruc
3740: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20  t params)).     
3750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28                ((
3760: 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65  get-not-complete
3770: 64 2d 63 6e 74 29 20 20 20 20 20 20 20 20 20 20  d-cnt)          
3780: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6e   (apply db:get-n
3790: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74  ot-completed-cnt
37a0: 20 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d    dbstruct param
37b0: 73 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20  s)) .           
37c0: 20 20 20 20 20 20 20 20 3b 3b 20 28 28 73 79 6e          ;; ((syn
37d0: 63 68 61 73 68 2d 67 65 74 29 20 20 20 20 20 20  chash-get)      
37e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61                (a
37f0: 70 70 6c 79 20 73 79 6e 63 68 61 73 68 3a 73 65  pply synchash:se
3800: 72 76 65 72 2d 67 65 74 20 64 62 73 74 72 75 63  rver-get dbstruc
3810: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20  t params)).     
3820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28                ((
3830: 67 65 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74  get-raw-run-stat
3840: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20  s)              
3850: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72   (apply db:get-r
3860: 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 73  aw-run-stats dbs
3870: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 09  truct params))..
3880: 09 20 20 20 28 28 67 65 74 2d 74 65 73 74 2d 74  .   ((get-test-t
3890: 69 6d 65 73 29 20 20 20 20 20 20 20 20 20 20 20  imes)           
38a0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62         (apply db
38b0: 3a 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 20  :get-test-times 
38c0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
38d0: 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )..             
38e0: 20 20 20 20 20 20 3b 3b 20 52 55 4e 53 0a 20 20        ;; RUNS.  
38f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3900: 20 28 28 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 29   ((get-run-info)
3910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3920: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72   (apply db:get-r
3930: 75 6e 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74  un-info dbstruct
3940: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20   params)).      
3950: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67               ((g
3960: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 29 20 20  et-run-status)  
3970: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70               (ap
3980: 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73  ply db:get-run-s
3990: 74 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70  tatus dbstruct p
39a0: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
39b0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74             ((get
39c0: 2d 72 75 6e 2d 73 74 61 74 65 29 20 20 20 20 20  -run-state)     
39d0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c             (appl
39e0: 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74 61  y db:get-run-sta
39f0: 74 65 20 64 62 73 74 72 75 63 74 20 70 61 72 61  te dbstruct para
3a00: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  ms)).           
3a10: 20 20 20 20 20 20 20 20 28 28 73 65 74 2d 72 75          ((set-ru
3a20: 6e 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 20  n-status)       
3a30: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64          (apply d
3a40: 62 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73  b:set-run-status
3a50: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73   dbstruct params
3a60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
3a70: 20 20 20 20 20 20 28 28 73 65 74 2d 72 75 6e 2d        ((set-run-
3a80: 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 20 09  state-status)  .
3a90: 09 09 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74  .. (apply db:set
3aa0: 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75  -run-state-statu
3ab0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d  s dbstruct param
3ac0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  s)).            
3ad0: 20 20 20 20 20 20 20 28 28 75 70 64 61 74 65 2d         ((update-
3ae0: 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c  tesdata-on-repil
3af0: 63 61 74 65 2d 64 62 29 20 28 61 70 70 6c 79 20  cate-db) (apply 
3b00: 64 62 3a 75 70 64 61 74 65 2d 74 65 73 64 61 74  db:update-tesdat
3b10: 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 65 2d 64  a-on-repilcate-d
3b20: 62 20 20 64 62 73 74 72 75 63 74 20 70 61 72 61  b  dbstruct para
3b30: 6d 73 29 29 20 0a 20 20 20 20 20 20 20 20 20 20  ms)) .          
3b40: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 74           ((get-t
3b50: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 29 20 20 20  ests-for-run)   
3b60: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20           (apply 
3b70: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72  db:get-tests-for
3b80: 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 70 61  -run dbstruct pa
3b90: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20  rams)).         
3ba0: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d            ((get-
3bb0: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74  tests-for-run-st
3bc0: 61 74 65 2d 73 74 61 74 75 73 29 20 28 61 70 70  ate-status) (app
3bd0: 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d  ly db:get-tests-
3be0: 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74  for-run-state-st
3bf0: 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61  atus dbstruct pa
3c00: 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20  rams)).         
3c10: 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d            ((get-
3c20: 74 65 73 74 2d 69 64 29 20 20 20 20 20 20 20 20  test-id)        
3c30: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79            (apply
3c40: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20   db:get-test-id 
3c50: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
3c60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
3c70: 20 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 73       ((get-tests
3c80: 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61  -for-run-mindata
3c90: 29 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67  )    (apply db:g
3ca0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e  et-tests-for-run
3cb0: 2d 6d 69 6e 64 61 74 61 20 64 62 73 74 72 75 63  -mindata dbstruc
3cc0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20  t params)).     
3cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b                ;;
3ce0: 20 28 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72   ((get-tests-for
3cf0: 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 29 20 20  -runs-mindata)  
3d00: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74   (apply db:get-t
3d10: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69  ests-for-runs-mi
3d20: 6e 64 61 74 61 20 64 62 73 74 72 75 63 74 20 70  ndata dbstruct p
3d30: 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20  arams)).        
3d40: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65 74             ((get
3d50: 2d 72 75 6e 73 29 20 20 20 20 20 20 20 20 20 20  -runs)          
3d60: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c             (appl
3d70: 79 20 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 62  y db:get-runs db
3d80: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a  struct params)).
3d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3da0: 20 20 20 28 28 73 69 6d 70 6c 65 2d 67 65 74 2d     ((simple-get-
3db0: 72 75 6e 73 29 20 20 20 20 20 20 20 20 20 20 20  runs)           
3dc0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 69 6d     (apply db:sim
3dd0: 70 6c 65 2d 67 65 74 2d 72 75 6e 73 20 64 62 73  ple-get-runs dbs
3de0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20  truct params)). 
3df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3e00: 20 20 28 28 67 65 74 2d 6e 75 6d 2d 72 75 6e 73    ((get-num-runs
3e10: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  )               
3e20: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d    (apply db:get-
3e30: 6e 75 6d 2d 72 75 6e 73 20 64 62 73 74 72 75 63  num-runs dbstruc
3e40: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20  t params)).     
3e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28                ((
3e60: 67 65 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d  get-runs-cnt-by-
3e70: 70 61 74 74 29 20 20 20 20 20 20 20 20 20 28 61  patt)         (a
3e80: 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 73  pply db:get-runs
3e90: 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 64 62 73  -cnt-by-patt dbs
3ea0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20  truct params)). 
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3ec0: 20 20 28 28 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d    ((get-all-run-
3ed0: 69 64 73 29 20 20 20 20 20 20 20 20 20 20 20 20  ids)            
3ee0: 20 20 28 64 62 3a 67 65 74 2d 61 6c 6c 2d 72 75    (db:get-all-ru
3ef0: 6e 2d 69 64 73 20 64 62 73 74 72 75 63 74 29 29  n-ids dbstruct))
3f00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
3f10: 20 20 20 20 28 28 67 65 74 2d 70 72 65 76 2d 72      ((get-prev-r
3f20: 75 6e 2d 69 64 73 29 20 20 20 20 20 20 20 20 20  un-ids)         
3f30: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65      (apply db:ge
3f40: 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 64  t-prev-run-ids d
3f50: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29  bstruct params))
3f60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
3f70: 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 69 64      ((get-run-id
3f80: 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65  s-matching-targe
3f90: 74 29 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65  t)  (apply db:ge
3fa0: 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69  t-run-ids-matchi
3fb0: 6e 67 2d 74 61 72 67 65 74 20 64 62 73 74 72 75  ng-target dbstru
3fc0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20  ct params)).    
3fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
3fe0: 28 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74  (get-runs-by-pat
3ff0: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28  t)             (
4000: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e  apply db:get-run
4010: 73 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75  s-by-patt dbstru
4020: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20  ct params)).    
4030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
4040: 28 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72  (get-run-name-fr
4050: 6f 6d 2d 69 64 29 20 20 20 20 20 20 20 20 20 28  om-id)         (
4060: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e  apply db:get-run
4070: 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 64 62  -name-from-id db
4080: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a  struct params)).
4090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40a0: 20 20 20 28 28 67 65 74 2d 6d 61 69 6e 2d 72 75     ((get-main-ru
40b0: 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 20 20  n-stats)        
40c0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74     (apply db:get
40d0: 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 20  -main-run-stats 
40e0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
40f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4100: 20 20 20 20 20 28 28 67 65 74 2d 76 61 72 29 20       ((get-var) 
4110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4120: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67       (apply db:g
4130: 65 74 2d 76 61 72 20 64 62 73 74 72 75 63 74 20  et-var dbstruct 
4140: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20  params)).       
4150: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 67 65              ((ge
4160: 74 2d 72 75 6e 2d 73 74 61 74 73 29 20 20 20 20  t-run-stats)    
4170: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70              (app
4180: 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74  ly db:get-run-st
4190: 61 74 73 20 64 62 73 74 72 75 63 74 20 70 61 72  ats dbstruct par
41a0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20  ams)).          
41b0: 20 20 20 20 20 20 20 20 20 28 28 67 65 74 2d 72           ((get-r
41c0: 75 6e 2d 74 69 6d 65 73 29 20 20 20 20 20 20 20  un-times)       
41d0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20           (apply 
41e0: 64 62 3a 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73  db:get-run-times
41f0: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73   dbstruct params
4200: 29 29 20 0a 0a 20 20 20 20 20 20 20 20 20 20 20  )) ..           
4210: 20 20 20 20 20 20 20 20 3b 3b 20 53 54 45 50 53          ;; STEPS
4220: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4230: 20 20 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d      ((get-steps-
4240: 64 61 74 61 29 20 20 20 20 20 20 20 20 20 20 20  data)           
4250: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65      (apply db:ge
4260: 74 2d 73 74 65 70 73 2d 64 61 74 61 20 64 62 73  t-steps-data dbs
4270: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20  truct params)). 
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4290: 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d 66 6f    ((get-steps-fo
42a0: 72 2d 74 65 73 74 29 20 20 20 20 20 20 20 20 20  r-test)         
42b0: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d    (apply db:get-
42c0: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64  steps-for-test d
42d0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29  bstruct params))
42e0: 0a 09 09 20 20 20 28 28 67 65 74 2d 73 74 65 70  ...   ((get-step
42f0: 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 29 20 20 20  s-info-by-id)   
4300: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a        (apply db:
4310: 67 65 74 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 62  get-steps-info-b
4320: 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61  y-id dbstruct pa
4330: 72 61 6d 73 29 29 0a 0a 20 20 20 20 20 20 20 20  rams))..        
4340: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 45             ;; TE
4350: 53 54 20 44 41 54 41 0a 20 20 20 20 20 20 20 20  ST DATA.        
4360: 20 20 20 20 20 20 20 20 20 20 20 28 28 72 65 61             ((rea
4370: 64 2d 74 65 73 74 2d 64 61 74 61 29 20 20 20 20  d-test-data)    
4380: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c             (appl
4390: 79 20 64 62 3a 72 65 61 64 2d 74 65 73 74 2d 64  y db:read-test-d
43a0: 61 74 61 20 64 62 73 74 72 75 63 74 20 70 61 72  ata dbstruct par
43b0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20  ams)).          
43c0: 20 20 20 20 20 20 20 20 20 28 28 72 65 61 64 2d           ((read-
43d0: 74 65 73 74 2d 64 61 74 61 2d 76 61 72 70 61 74  test-data-varpat
43e0: 74 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 20  t)       (apply 
43f0: 64 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74  db:read-test-dat
4400: 61 2d 76 61 72 70 61 74 74 20 64 62 73 74 72 75  a-varpatt dbstru
4410: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20  ct params)).    
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
4430: 28 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62  (get-data-info-b
4440: 79 2d 69 64 29 20 20 20 20 20 20 20 20 20 20 28  y-id)          (
4450: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 64 61 74  apply db:get-dat
4460: 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73  a-info-by-id dbs
4470: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a  truct params)) .
4480: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4490: 20 20 20 20 3b 3b 20 4d 49 53 43 0a 20 20 20 20      ;; MISC.    
44a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
44b0: 28 67 65 74 2d 6c 61 74 65 73 74 2d 68 6f 73 74  (get-latest-host
44c0: 2d 6c 6f 61 64 29 20 20 20 20 20 20 20 20 20 28  -load)         (
44d0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6c 61 74  apply db:get-lat
44e0: 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 20 64 62  est-host-load db
44f0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a  struct params)).
4500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4510: 20 20 20 28 28 68 61 76 65 2d 69 6e 63 6f 6d 70     ((have-incomp
4520: 6c 65 74 65 73 3f 29 20 20 20 20 20 20 20 20 20  letes?)         
4530: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 68 61 76     (apply db:hav
4540: 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 20 64  e-incompletes? d
4550: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29  bstruct params))
4560: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4570: 20 20 20 20 28 28 6c 6f 67 69 6e 29 20 20 20 20      ((login)    
4580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4590: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 6c 6f      (apply db:lo
45a0: 67 69 6e 20 64 62 73 74 72 75 63 74 20 70 61 72  gin dbstruct par
45b0: 61 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 20  ams)).          
45c0: 20 20 20 20 20 20 20 20 20 28 28 67 65 6e 65 72           ((gener
45d0: 61 6c 2d 63 61 6c 6c 29 20 20 20 20 20 20 20 20  al-call)        
45e0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28           (let ((
45f0: 73 74 6d 74 6e 61 6d 65 20 20 20 28 63 61 72 20  stmtname   (car 
4600: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 20 20 20  params)).       
4610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4640: 20 20 28 72 75 6e 2d 69 64 20 20 20 20 20 28 63    (run-id     (c
4650: 61 64 72 20 70 61 72 61 6d 73 29 29 0a 20 20 20  adr params)).   
4660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4690: 20 20 20 20 20 20 28 72 65 61 6c 70 61 72 61 6d        (realparam
46a0: 73 20 28 63 64 64 72 20 70 61 72 61 6d 73 29 29  s (cddr params))
46b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
46c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
46d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
46e0: 20 20 20 20 20 20 20 28 64 62 3a 67 65 6e 65 72         (db:gener
46f0: 61 6c 2d 63 61 6c 6c 20 64 62 73 74 72 75 63 74  al-call dbstruct
4700: 20 73 74 6d 74 6e 61 6d 65 20 72 65 61 6c 70 61   stmtname realpa
4710: 72 61 6d 73 29 29 29 0a 20 20 20 20 20 20 20 20  rams))).        
4720: 20 20 20 20 20 20 20 20 20 20 20 28 28 73 64 62             ((sdb
4730: 2d 71 72 79 29 20 20 20 20 20 20 20 20 20 20 20  -qry)           
4740: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c             (appl
4750: 79 20 73 64 62 3a 71 72 79 20 70 61 72 61 6d 73  y sdb:qry params
4760: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )).             
4770: 20 20 20 20 20 20 28 28 70 69 6e 67 29 20 20 20        ((ping)   
4780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4790: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 70        (current-p
47a0: 72 6f 63 65 73 73 2d 69 64 29 29 0a 09 09 20 20  rocess-id))...  
47b0: 20 28 28 67 65 74 2d 63 68 61 6e 67 65 64 2d 72   ((get-changed-r
47c0: 65 63 6f 72 64 2d 69 64 73 29 20 20 20 20 20 20  ecord-ids)      
47d0: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 63   (apply db:get-c
47e0: 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d 69 64  hanged-record-id
47f0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d  s dbstruct param
4800: 73 29 29 0a 09 09 20 20 20 28 28 67 65 74 2d 72  s))...   ((get-r
4810: 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 29 20 09  un-record-ids) .
4820: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74     (apply db:get
4830: 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 73 20  -run-record-ids 
4840: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
4850: 29 09 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )..             
4860: 20 20 20 20 20 20 3b 3b 20 54 45 53 54 4d 45 54        ;; TESTMET
4870: 41 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  A.              
4880: 20 20 20 20 20 28 28 74 65 73 74 6d 65 74 61 2d       ((testmeta-
4890: 67 65 74 2d 72 65 63 6f 72 64 29 20 20 20 20 20  get-record)     
48a0: 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74    (apply db:test
48b0: 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20  meta-get-record 
48c0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29  dbstruct params)
48d0: 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )..             
48e0: 20 20 20 20 20 20 3b 3b 20 54 41 53 4b 53 20 0a        ;; TASKS .
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4900: 20 20 20 28 28 66 69 6e 64 2d 74 61 73 6b 2d 71     ((find-task-q
4910: 75 65 75 65 2d 72 65 63 6f 72 64 73 29 20 20 20  ueue-records)   
4920: 28 61 70 70 6c 79 20 74 61 73 6b 73 3a 66 69 6e  (apply tasks:fin
4930: 64 2d 74 61 73 6b 2d 71 75 65 75 65 2d 72 65 63  d-task-queue-rec
4940: 6f 72 64 73 20 64 62 73 74 72 75 63 74 20 70 61  ords dbstruct pa
4950: 72 61 6d 73 29 29 0a 09 09 20 20 20 28 65 6c 73  rams))...   (els
4960: 65 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70  e...    (debug:p
4970: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d  rint 0 *default-
4980: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52  log-port* "ERROR
4990: 3a 20 62 61 64 20 61 70 69 20 63 61 6c 6c 20 22  : bad api call "
49a0: 20 63 6d 64 29 0a 09 09 20 20 20 20 28 63 6f 6e   cmd)...    (con
49b0: 63 20 22 45 52 52 4f 52 3a 20 42 41 44 20 61 70  c "ERROR: BAD ap
49c0: 69 20 63 61 6c 6c 20 22 20 63 6d 64 29 29 29 29  i call " cmd))))
49d0: 29 29 0a 0a 20 20 20 20 20 20 20 0a 20 20 20 20  ))..       .    
49e0: 20 20 20 3b 3b 20 73 61 76 65 20 61 6c 6c 20 73     ;; save all s
49f0: 74 61 74 73 0a 20 20 20 20 20 20 20 28 6c 65 74  tats.       (let
4a00: 20 28 28 64 65 6c 74 61 2d 74 20 28 2d 20 28 63   ((delta-t (- (c
4a10: 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f  urrent-milliseco
4a20: 6e 64 73 29 0a 09 09 09 20 73 74 61 72 74 2d 74  nds).... start-t
4a30: 29 29 29 0a 09 20 28 68 61 73 68 2d 74 61 62 6c  ))).. (hash-tabl
4a40: 65 2d 73 65 74 21 20 2a 64 62 2d 61 70 69 2d 63  e-set! *db-api-c
4a50: 61 6c 6c 2d 74 69 6d 65 2a 20 63 6d 64 0a 09 09  all-time* cmd...
4a60: 09 20 20 28 63 6f 6e 73 20 64 65 6c 74 61 2d 74  .  (cons delta-t
4a70: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66   (hash-table-ref
4a80: 2f 64 65 66 61 75 6c 74 20 2a 64 62 2d 61 70 69  /default *db-api
4a90: 2d 63 61 6c 6c 2d 74 69 6d 65 2a 20 63 6d 64 20  -call-time* cmd 
4aa0: 27 28 29 29 29 29 29 0a 20 20 20 20 20 20 20 28  '())))).       (
4ab0: 69 66 20 77 72 69 74 65 63 6d 64 2d 69 6e 2d 72  if writecmd-in-r
4ac0: 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 0a 20 20 20  eadonly-mode.   
4ad0: 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20          (begin. 
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 23 3b 28 63              #;(c
4af0: 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 79 2d  ommon:telemetry-
4b00: 6c 6f 67 20 28 63 6f 6e 63 20 22 61 70 69 2d 6f  log (conc "api-o
4b10: 75 74 3a 22 28 2d 3e 73 74 72 69 6e 67 20 63 6d  ut:"(->string cm
4b20: 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  d)).            
4b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4b40: 20 20 20 20 20 20 20 70 61 79 6c 6f 61 64 3a 20         payload: 
4b50: 60 28 28 70 61 72 61 6d 73 20 2e 20 2c 70 61 72  `((params . ,par
4b60: 61 6d 73 29 0a 20 20 20 20 20 20 20 20 20 20 20  ams).           
4b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4b90: 20 20 20 28 6f 6b 2d 72 65 73 20 2e 20 23 74 29     (ok-res . #t)
4ba0: 29 29 0a 09 20 20 20 20 20 28 76 65 63 74 6f 72  ))..     (vector
4bb0: 20 23 66 20 72 65 73 29 29 0a 20 20 20 20 20 20   #f res)).      
4bc0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20       (begin.    
4bd0: 20 20 20 20 20 20 20 20 20 23 3b 28 63 6f 6d 6d           #;(comm
4be0: 6f 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c 6f 67  on:telemetry-log
4bf0: 20 28 63 6f 6e 63 20 22 61 70 69 2d 6f 75 74 3a   (conc "api-out:
4c00: 22 28 2d 3e 73 74 72 69 6e 67 20 63 6d 64 29 29  "(->string cmd))
4c10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4c30: 20 20 20 20 70 61 79 6c 6f 61 64 3a 20 60 28 28      payload: `((
4c40: 70 61 72 61 6d 73 20 2e 20 2c 70 61 72 61 6d 73  params . ,params
4c50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4c80: 28 6f 6b 2d 72 65 73 20 2e 20 23 66 29 29 29 0a  (ok-res . #f))).
4c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65               (ve
4ca0: 63 74 6f 72 20 23 74 20 72 65 73 29 29 29 29 29  ctor #t res)))))
4cb0: 29 29 29 0a 0a 3b 3b 20 68 74 74 70 2d 73 65 72  )))..;; http-ser
4cc0: 76 65 72 20 20 73 65 6e 64 2d 72 65 73 70 6f 6e  ver  send-respon
4cd0: 73 65 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20  se.;;           
4ce0: 20 20 20 20 20 20 61 70 69 3a 70 72 6f 63 65 73        api:proces
4cf0: 73 2d 72 65 71 75 65 73 74 0a 3b 3b 20 20 20 20  s-request.;;    
4d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4d10: 64 62 3a 2a 0a 3b 3b 0a 3b 3b 20 4e 42 2f 2f 20  db:*.;;.;; NB// 
4d20: 52 75 6e 73 20 6f 6e 20 74 68 65 20 73 65 72 76  Runs on the serv
4d30: 65 72 20 61 73 20 70 61 72 74 20 6f 66 20 74 68  er as part of th
4d40: 65 20 73 65 72 76 65 72 20 6c 6f 6f 70 0a 3b 3b  e server loop.;;
4d50: 0a 28 64 65 66 69 6e 65 20 28 61 70 69 3a 70 72  .(define (api:pr
4d60: 6f 63 65 73 73 2d 72 65 71 75 65 73 74 20 64 62  ocess-request db
4d70: 73 74 72 75 63 74 20 24 29 20 3b 3b 20 74 68 65  struct $) ;; the
4d80: 20 24 20 69 73 20 74 68 65 20 72 65 71 75 65 73   $ is the reques
4d90: 74 20 76 61 72 73 20 70 72 6f 63 0a 20 20 28 64  t vars proc.  (d
4da0: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65  ebug:print 4 *de
4db0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20  fault-log-port* 
4dc0: 22 73 65 72 76 65 72 2d 69 64 3a 22 20 20 2a 73  "server-id:"  *s
4dd0: 65 72 76 65 72 2d 69 64 2a 29 0a 20 20 28 64 65  erver-id*).  (de
4de0: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66  bug:print 4 *def
4df0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22  ault-log-port* "
4e00: 73 65 72 76 65 72 2d 69 64 3a 22 20 20 2a 73 65  server-id:"  *se
4e10: 72 76 65 72 2d 69 64 2a 29 0a 20 20 28 6c 65 74  rver-id*).  (let
4e20: 2a 20 28 28 63 6d 64 20 20 20 20 20 28 24 20 27  * ((cmd     ($ '
4e30: 63 6d 64 29 29 0a 09 20 28 70 61 72 61 6d 73 6a  cmd)).. (paramsj
4e40: 20 28 24 20 27 70 61 72 61 6d 73 29 29 0a 20 20   ($ 'params)).  
4e50: 20 20 20 20 20 20 20 28 6b 65 79 20 20 20 20 20         (key     
4e60: 28 24 20 27 6b 65 79 29 29 20 20 20 0a 09 20 28  ($ 'key))   .. (
4e70: 70 61 72 61 6d 73 20 20 28 64 62 3a 73 74 72 69  params  (db:stri
4e80: 6e 67 2d 3e 6f 62 6a 20 70 61 72 61 6d 73 6a 20  ng->obj paramsj 
4e90: 74 72 61 6e 73 70 6f 72 74 3a 20 27 68 74 74 70  transport: 'http
4ea0: 29 29 29 20 3b 3b 20 69 6e 63 6f 6d 69 6e 67 20  ))) ;; incoming 
4eb0: 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 50 4f  data from the PO
4ec0: 53 54 20 28 6f 72 20 69 73 20 69 74 20 61 20 47  ST (or is it a G
4ed0: 45 54 3f 29 0a 20 20 20 20 28 64 65 62 75 67 3a  ET?).    (debug:
4ee0: 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74  print 4 *default
4ef0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 6d 64 3a  -log-port* "cmd:
4f00: 22 20 63 6d 64 20 22 20 77 69 74 68 20 70 61 72  " cmd " with par
4f10: 61 6d 73 20 22 20 70 61 72 61 6d 73 20 22 6b 65  ams " params "ke
4f20: 79 20 22 20 6b 65 79 29 0a 20 20 20 20 28 69 66  y " key).    (if
4f30: 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 2a 73 65   (equal? key *se
4f40: 72 76 65 72 2d 69 64 2a 29 0a 20 20 20 20 20 20  rver-id*).      
4f50: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 28  (begin.        (
4f60: 73 65 74 21 20 2a 61 70 69 2d 70 72 6f 63 65 73  set! *api-proces
4f70: 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a  s-request-count*
4f80: 20 28 2b 20 2a 61 70 69 2d 70 72 6f 63 65 73 73   (+ *api-process
4f90: 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20  -request-count* 
4fa0: 31 29 29 0a 20 09 28 6c 65 74 2a 20 28 28 72 65  1)). .(let* ((re
4fb0: 73 64 61 74 20 20 28 61 70 69 3a 65 78 65 63 75  sdat  (api:execu
4fc0: 74 65 2d 72 65 71 75 65 73 74 73 20 64 62 73 74  te-requests dbst
4fd0: 72 75 63 74 20 28 76 65 63 74 6f 72 20 63 6d 64  ruct (vector cmd
4fe0: 20 70 61 72 61 6d 73 29 29 29 20 3b 3b 20 70 72   params))) ;; pr
4ff0: 6f 63 65 73 73 20 74 68 65 20 72 65 71 75 65 73  ocess the reques
5000: 74 2c 20 72 65 73 64 61 74 20 3d 20 23 28 20 66  t, resdat = #( f
5010: 6c 61 67 20 72 65 73 75 6c 74 20 29 0a 09 20 20  lag result )..  
5020: 20 20 20 20 20 28 73 75 63 63 65 73 73 20 28 76       (success (v
5030: 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 61 74  ector-ref resdat
5040: 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 72 65   0))..       (re
5050: 73 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65  s     (vector-re
5060: 66 20 72 65 73 64 61 74 20 31 29 29 29 20 3b 3b  f resdat 1))) ;;
5070: 20 28 76 65 63 74 6f 72 20 66 6c 61 67 20 70 61   (vector flag pa
5080: 79 6c 6f 61 64 29 2c 20 67 65 74 20 74 68 65 20  yload), get the 
5090: 70 61 79 6c 6f 61 64 2c 20 69 67 6e 6f 72 65 20  payload, ignore 
50a0: 74 68 65 20 66 6c 61 67 20 28 77 68 79 3f 29 0a  the flag (why?).
50b0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20  .  (debug:print 
50c0: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70  4 *default-log-p
50d0: 6f 72 74 2a 20 22 72 65 73 3a 22 20 72 65 73 29  ort* "res:" res)
50e0: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 73 75 63  ..  (if (not suc
50f0: 63 65 73 73 29 0a 09 20 20 20 20 20 20 28 64 65  cess)..      (de
5100: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66  bug:print 0 *def
5110: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22  ault-log-port* "
5120: 45 52 52 4f 52 3a 20 73 75 63 63 65 73 73 20 66  ERROR: success f
5130: 6c 61 67 20 69 73 20 23 66 20 66 6f 72 20 22 20  lag is #f for " 
5140: 63 6d 64 20 22 20 77 69 74 68 20 70 61 72 61 6d  cmd " with param
5150: 73 20 22 20 70 61 72 61 6d 73 29 29 0a 09 20 20  s " params))..  
5160: 28 69 66 20 28 3e 20 2a 61 70 69 2d 70 72 6f 63  (if (> *api-proc
5170: 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e  ess-request-coun
5180: 74 2a 20 2a 6d 61 78 2d 61 70 69 2d 70 72 6f 63  t* *max-api-proc
5190: 65 73 73 2d 72 65 71 75 65 73 74 73 2a 29 0a 09  ess-requests*)..
51a0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 6d 61 78        (set! *max
51b0: 2d 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71  -api-process-req
51c0: 75 65 73 74 73 2a 20 2a 61 70 69 2d 70 72 6f 63  uests* *api-proc
51d0: 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e  ess-request-coun
51e0: 74 2a 29 29 0a 09 20 20 28 73 65 74 21 20 2a 61  t*))..  (set! *a
51f0: 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65  pi-process-reque
5200: 73 74 2d 63 6f 75 6e 74 2a 20 28 2d 20 2a 61 70  st-count* (- *ap
5210: 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 73  i-process-reques
5220: 74 2d 63 6f 75 6e 74 2a 20 31 29 29 0a 09 20 20  t-count* 1))..  
5230: 3b 3b 20 54 68 69 73 20 63 61 6e 20 62 65 20 68  ;; This can be h
5240: 65 72 65 20 62 75 74 20 6e 65 65 64 73 20 63 6f  ere but needs co
5250: 6e 74 72 6f 6c 73 20 74 6f 20 65 6e 73 75 72 65  ntrols to ensure
5260: 20 69 74 20 64 6f 65 73 6e 27 74 20 72 75 6e 20   it doesn't run 
5270: 6d 6f 72 65 20 74 68 61 6e 20 65 76 65 72 79 20  more than every 
5280: 34 20 73 65 63 6f 6e 64 73 0a 09 20 20 3b 3b 20  4 seconds..  ;; 
5290: 28 72 6d 74 3a 64 61 74 2d 3e 6a 73 6f 6e 2d 73  (rmt:dat->json-s
52a0: 74 72 0a 09 20 20 3b 3b 20 20 28 69 66 20 28 6f  tr..  ;;  (if (o
52b0: 72 20 28 73 74 72 69 6e 67 3f 20 72 65 73 29 0a  r (string? res).
52c0: 09 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 28  .  ;;          (
52d0: 6c 69 73 74 3f 20 20 20 72 65 73 29 0a 09 20 20  list?   res)..  
52e0: 3b 3b 20 20 20 20 20 20 20 20 20 20 28 6e 75 6d  ;;          (num
52f0: 62 65 72 3f 20 72 65 73 29 0a 09 20 20 3b 3b 20  ber? res)..  ;; 
5300: 20 20 20 20 20 20 20 20 20 28 62 6f 6f 6c 65 61           (boolea
5310: 6e 3f 20 72 65 73 29 29 0a 09 20 20 3b 3b 20 20  n? res))..  ;;  
5320: 20 20 20 20 72 65 73 20 0a 09 20 20 3b 3b 20 20      res ..  ;;  
5330: 20 20 20 20 28 6c 69 73 74 20 22 45 52 52 4f 52      (list "ERROR
5340: 2c 20 6e 6f 74 20 73 74 72 69 6e 67 2c 20 6c 69  , not string, li
5350: 73 74 2c 20 6e 75 6d 62 65 72 20 6f 72 20 62 6f  st, number or bo
5360: 6f 6c 65 61 6e 22 20 31 20 63 6d 64 20 70 61 72  olean" 1 cmd par
5370: 61 6d 73 20 72 65 73 29 29 29 29 29 0a 09 20 20  ams res)))))..  
5380: 28 64 62 3a 6f 62 6a 2d 3e 73 74 72 69 6e 67 20  (db:obj->string 
5390: 72 65 73 20 74 72 61 6e 73 70 6f 72 74 3a 20 27  res transport: '
53a0: 68 74 74 70 29 29 29 0a 09 28 62 65 67 69 6e 0a  http)))..(begin.
53b0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20  .  (debug:print 
53c0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70  0 *default-log-p
53d0: 6f 72 74 2a 20 20 20 22 53 65 72 76 65 72 20 72  ort*   "Server r
53e0: 65 66 75 73 65 64 20 74 6f 20 70 72 6f 63 65 73  efused to proces
53f0: 73 20 72 65 71 75 65 73 74 2e 20 53 65 76 65 72  s request. Sever
5400: 20 69 64 20 6d 69 73 6d 61 74 63 68 2e 20 72 65   id mismatch. re
5410: 63 69 76 65 64 20 22 20 6b 65 79 20 22 20 65 78  cived " key " ex
5420: 70 65 63 74 65 64 3a 20 20 22 20 2a 73 65 72 76  pected:  " *serv
5430: 65 72 2d 69 64 2a 20 22 2e 5c 6e 4f 74 68 65 72  er-id* ".\nOther
5440: 20 61 72 67 75 6d 65 6e 74 73 20 72 65 63 69 76   arguments reciv
5450: 65 64 3a 20 63 6d 64 3d 22 20 63 6d 64 20 22 20  ed: cmd=" cmd " 
5460: 70 61 72 61 6d 73 20 3d 20 22 20 70 61 72 61 6d  params = " param
5470: 73 29 20 0a 09 20 20 28 64 62 3a 6f 62 6a 2d 3e  s) ..  (db:obj->
5480: 73 74 72 69 6e 67 20 28 63 6f 6e 63 20 22 53 65  string (conc "Se
5490: 72 76 65 72 20 72 65 66 75 73 65 64 20 74 6f 20  rver refused to 
54a0: 70 72 6f 63 65 73 73 20 72 65 71 75 65 73 74 20  process request 
54b0: 73 65 72 76 65 72 2d 69 64 20 6d 69 73 6d 61 74  server-id mismat
54c0: 63 68 3a 20 22 20 6b 65 79 20 22 2c 20 22 20 2a  ch: " key ", " *
54d0: 73 65 72 76 65 72 2d 69 64 2a 29 20 74 72 61 6e  server-id*) tran
54e0: 73 70 6f 72 74 3a 20 27 68 74 74 70 29 29 29 29  sport: 'http))))
54f0: 29 0a 0a                                         )..