Megatest

Check-in [48aa93366a]
Login
Overview
Comment:Fixed ping not cleaning up connections
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 48aa93366a26d266c7dbc308e987fb383386bad5
User & Date: matt on 2023-02-01 15:22:36
Other Links: branch diff | manifest | tags
Context
2023-02-01
20:38
Convert one statement to prepared, test and do more check-in: 87e172c693 user: matt tags: v1.80
15:22
Fixed ping not cleaning up connections check-in: 48aa93366a user: matt tags: v1.80
06:11
Pulled in ulex from v2.0 check-in: 69eb6e4304 user: matt tags: v1.80
Changes

Modified api.scm from [e629c948c8] to [1fa92fd71b].

190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
            (readonly-command  (member cmd api:read-only-queries))
            (writecmd-in-readonly-mode (and readonly-mode (not readonly-command))))
       (if (not readonly-command)
	   (mutex-lock! write-mutex))
       (let* ((res    
               (if writecmd-in-readonly-mode
                   (conc "attempt to run write command "cmd" on a read-only database")
                   (case cmd
                     ;;===============================================
                     ;; READ/WRITE QUERIES
                     ;;===============================================

                     ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
                     
                     ;; SERVERS
                     ((start-server)                    (apply server:kind-run params))
                     ((kill-server)                     (set! *server-run* #f))

                     ;; TESTS

                     ;;((test-set-state-status-by-id)     (apply mt:test-set-state-status-by-id dbstruct params))
                     ;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items.
                     ((test-set-state-status-by-id)

                      ;; (define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
                      (db:set-state-status-and-roll-up-items
                       dbstruct
                       (list-ref params 0) ; run-id
                       (list-ref params 1) ; test-name
                       #f                  ; item-path
                       (list-ref params 2) ; state
                       (list-ref params 3) ; status
                       (list-ref params 4) ; comment
                       ))
                     
                     ((delete-test-records)             (apply db:delete-test-records dbstruct params))
                     ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
                     ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
                     ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
                     ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
                     ((set-state-status-and-roll-up-run) (apply db:set-state-status-and-roll-up-run dbstruct params)) 
                     ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
                     ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))

                     ;; RUNS
                     ((register-run)                 (apply db:register-run dbstruct params))
                     ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
                     ((delete-run)                   (apply db:delete-run dbstruct params))
                     ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
                     ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
                     ((update-run-stats)             (apply db:update-run-stats dbstruct params))
                     ((set-var)                      (apply db:set-var dbstruct params))
                     ((inc-var)                      (apply db:inc-var dbstruct params))
		     ((dec-var)                      (apply db:dec-var dbstruct params))
                     ((del-var)                      (apply db:del-var dbstruct params))
		     ((add-var)                      (apply db:add-var dbstruct params))

                     ;; STEPS
                     ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
                     ((delete-steps-for-test!)       (apply db:delete-steps-for-test! dbstruct params))
                     
                     ;; TEST DATA
                     ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
                     ((csv->test-data)               (apply db:csv->test-data dbstruct params))

                     ;; MISC
                     ((sync-inmem->db)               (let ((run-id (car params)))
                                                       (db:sync-touched dbstruct run-id db:initialize-main-db force-sync: #t)))
                     ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))
                     ((create-all-triggers)          (db:create-all-triggers dbstruct))
                     ((drop-all-triggers)            (db:drop-all-triggers dbstruct)) 

                     ;; TESTMETA
                     ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
                     ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
                     ((get-tests-tags)            (db:get-tests-tags dbstruct))

                     ;; TASKS
                     ((tasks-add)                 (apply tasks:add dbstruct params))   
                     ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
                     ((tasks-get-last)            (apply tasks:get-last dbstruct params))

		     ;; NO SYNC DB
		     ((no-sync-set)               (apply db:no-sync-set         *no-sync-db* params))
		     ((no-sync-get/default)       (apply db:no-sync-get/default *no-sync-db* params))
		     ((no-sync-del!)              (apply db:no-sync-del!        *no-sync-db* params))
		     ((no-sync-get-lock)          (apply db:no-sync-get-lock    *no-sync-db* params))
		     
                     ;; ARCHIVES
                     ;; ((archive-get-allocations)   
                     ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
                     ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
                     ;; ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))

                     ;;======================================================================
                     ;; READ ONLY QUERIES
                     ;;======================================================================

                     ;; KEYS
                     ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct params))
                     ((get-keys)                        (db:get-keys dbstruct))
                     ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
                     ((get-target)                      (apply db:get-target dbstruct params))
                     ((get-targets)                     (db:get-targets dbstruct))

                     ;; ARCHIVES
                     ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct params))
                     
                     ;; TESTS
                     ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct params))
                     ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct params))
                     ((test-get-rundir-from-test-id)    (apply db:test-get-rundir-from-test-id dbstruct params))
                     ((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params))
                     ((get-count-tests-running)         (apply db:get-count-tests-running dbstruct params))
                     ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
                     ;; ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
                     ;; ((get-previous-test-run-record)    (apply db:get-previous-test-run-record dbstruct params))
                     ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
                     ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
                     ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
                     ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
                     ((test-get-top-process-pid)        (apply db:test-get-top-process-pid dbstruct params))
                     ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
                     ((get-prereqs-not-met)             (apply db:get-prereqs-not-met dbstruct params))
                     ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
                     ((get-not-completed-cnt)           (apply db:get-not-completed-cnt  dbstruct params)) 
                     ;; ((synchash-get)                    (apply synchash:server-get dbstruct params))
                     ((get-raw-run-stats)               (apply db:get-raw-run-stats dbstruct params))
		     ((get-test-times)                  (apply db:get-test-times dbstruct params))

                     ;; RUNS
                     ((get-run-info)                 (apply db:get-run-info dbstruct params))
                     ((get-run-status)               (apply db:get-run-status dbstruct params))
                     ((get-run-state)                (apply db:get-run-state dbstruct params))
                     ((set-run-status)               (apply db:set-run-status dbstruct params))
                     ((set-run-state-status)  			 (apply db:set-run-state-status dbstruct params))
                     ((update-tesdata-on-repilcate-db) (apply db:update-tesdata-on-repilcate-db  dbstruct params)) 
                     ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
                     ((get-tests-for-run-state-status) (apply db:get-tests-for-run-state-status dbstruct params))
                     ((get-test-id)                  (apply db:get-test-id dbstruct params))
                     ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
                     ;; ((get-tests-for-runs-mindata)   (apply db:get-tests-for-runs-mindata dbstruct params))
                     ((get-runs)                     (apply db:get-runs dbstruct params))
                     ((simple-get-runs)              (apply db:simple-get-runs dbstruct params))
                     ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
                     ((get-runs-cnt-by-patt)         (apply db:get-runs-cnt-by-patt dbstruct params))
                     ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
                     ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
                     ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
                     ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
                     ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
                     ((get-main-run-stats)           (apply db:get-main-run-stats dbstruct params))
                     ((get-var)                      (apply db:get-var dbstruct params))
                     ((get-run-stats)                (apply db:get-run-stats dbstruct params))
                     ((get-run-times)                (apply db:get-run-times dbstruct params)) 

                     ;; STEPS
                     ((get-steps-data)               (apply db:get-steps-data dbstruct params))
                     ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))
		     ((get-steps-info-by-id)         (apply db:get-steps-info-by-id dbstruct params))

                     ;; TEST DATA
                     ((read-test-data)               (apply db:read-test-data dbstruct params))
                     ((read-test-data-varpatt)       (apply db:read-test-data-varpatt dbstruct params))
                     ((get-data-info-by-id)          (apply db:get-data-info-by-id dbstruct params)) 

                     ;; MISC
                     ((get-latest-host-load)         (apply db:get-latest-host-load dbstruct params))
                     ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
                     ((login)                        (apply db:login dbstruct params))
                     ((general-call)                 (let ((stmtname   (car params))
                                                           (run-id     (cadr params))
                                                           (realparams (cddr params)))
                                                       (db:general-call dbstruct run-id stmtname realparams)))
                     ((sdb-qry)                      (apply sdb:qry params))
                     ((ping)                         (current-process-id))
		     ((get-changed-record-ids)       (apply db:get-changed-record-ids dbstruct params))
		     ((get-run-record-ids) 	   (apply db:get-run-record-ids dbstruct params))	
                     ;; TESTMETA
                     ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))

                     ;; TASKS 
                     ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params))
		     (else
		      (debug:print 0 *default-log-port* "ERROR: bad api call " cmd)
		      (conc "ERROR: BAD api call " cmd))))))
	 (if (not readonly-command)
	     (mutex-unlock! write-mutex))
	 
	 ;; save all stats
	 (let ((delta-t (- (current-milliseconds)
			   start-t))
	       (modified-cmd (if (eq? cmd 'general-call)







<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







190
191
192
193
194
195
196




197














































































































































































198
199
200
201
202
203
204
            (readonly-command  (member cmd api:read-only-queries))
            (writecmd-in-readonly-mode (and readonly-mode (not readonly-command))))
       (if (not readonly-command)
	   (mutex-lock! write-mutex))
       (let* ((res    
               (if writecmd-in-readonly-mode
                   (conc "attempt to run write command "cmd" on a read-only database")




		   (api:dispatch-request dbstruct cmd run-id params))))














































































































































































	 (if (not readonly-command)
	     (mutex-unlock! write-mutex))
	 
	 ;; save all stats
	 (let ((delta-t (- (current-milliseconds)
			   start-t))
	       (modified-cmd (if (eq? cmd 'general-call)
391
392
393
394
395
396
397





















































































































































































398
399
400
401
402
403
404
               (ok-res . #t)))
	       (vector #f res))
             (begin
               #;(common:telemetry-log (conc "api-out:"(->string cmd))
               payload: `((params . ,params)
               (ok-res . #f)))
               (vector #t res))))))))






















































































































































































;; http-server  send-response
;;                 api:process-request
;;                    db:*
;;
;; NB// Runs on the server as part of the server loop
;;







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
               (ok-res . #t)))
	       (vector #f res))
             (begin
               #;(common:telemetry-log (conc "api-out:"(->string cmd))
               payload: `((params . ,params)
               (ok-res . #f)))
               (vector #t res))))))))

(define (api:dispatch-request dbstruct cmd run-id params)
  (case cmd
    ;;===============================================
    ;; READ/WRITE QUERIES
    ;;===============================================

    ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
    
    ;; SERVERS
    ((start-server)                    (apply server:kind-run params))
    ((kill-server)                     (set! *server-run* #f))

    ;; TESTS

    ;;((test-set-state-status-by-id)     (apply mt:test-set-state-status-by-id dbstruct params))
    ;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items.
    ((test-set-state-status-by-id)

     ;; (define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
     (db:set-state-status-and-roll-up-items
      dbstruct
      (list-ref params 0) ; run-id
      (list-ref params 1) ; test-name
      #f                  ; item-path
      (list-ref params 2) ; state
      (list-ref params 3) ; status
      (list-ref params 4) ; comment
      ))
    
    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
    ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
    ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
    ((set-state-status-and-roll-up-run) (apply db:set-state-status-and-roll-up-run dbstruct params)) 
    ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
    ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))

    ;; RUNS
    ((register-run)                 (apply db:register-run dbstruct params))
    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
    ((delete-run)                   (apply db:delete-run dbstruct params))
    ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
    ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
    ((update-run-stats)             (apply db:update-run-stats dbstruct params))
    ((set-var)                      (apply db:set-var dbstruct params))
    ((inc-var)                      (apply db:inc-var dbstruct params))
    ((dec-var)                      (apply db:dec-var dbstruct params))
    ((del-var)                      (apply db:del-var dbstruct params))
    ((add-var)                      (apply db:add-var dbstruct params))

    ;; STEPS
    ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
    ((delete-steps-for-test!)       (apply db:delete-steps-for-test! dbstruct params))
    
    ;; TEST DATA
    ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
    ((csv->test-data)               (apply db:csv->test-data dbstruct params))

    ;; MISC
    ((sync-inmem->db)               (let ((run-id (car params)))
                                      (db:sync-touched dbstruct run-id db:initialize-main-db force-sync: #t)))
    ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))
    ((create-all-triggers)          (db:create-all-triggers dbstruct))
    ((drop-all-triggers)            (db:drop-all-triggers dbstruct)) 

    ;; TESTMETA
    ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
    ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
    ((get-tests-tags)            (db:get-tests-tags dbstruct))

    ;; TASKS
    ((tasks-add)                 (apply tasks:add dbstruct params))   
    ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
    ((tasks-get-last)            (apply tasks:get-last dbstruct params))

    ;; NO SYNC DB
    ((no-sync-set)               (apply db:no-sync-set         *no-sync-db* params))
    ((no-sync-get/default)       (apply db:no-sync-get/default *no-sync-db* params))
    ((no-sync-del!)              (apply db:no-sync-del!        *no-sync-db* params))
    ((no-sync-get-lock)          (apply db:no-sync-get-lock    *no-sync-db* params))
    
    ;; ARCHIVES
    ;; ((archive-get-allocations)   
    ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
    ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
    ;; ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))

    ;;======================================================================
    ;; READ ONLY QUERIES
    ;;======================================================================

    ;; KEYS
    ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct params))
    ((get-keys)                        (db:get-keys dbstruct))
    ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
    ((get-target)                      (apply db:get-target dbstruct params))
    ((get-targets)                     (db:get-targets dbstruct))

    ;; ARCHIVES
    ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct params))
    
    ;; TESTS
    ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct params))
    ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct params))
    ((test-get-rundir-from-test-id)    (apply db:test-get-rundir-from-test-id dbstruct params))
    ((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params))
    ((get-count-tests-running)         (apply db:get-count-tests-running dbstruct params))
    ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
    ;; ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
    ;; ((get-previous-test-run-record)    (apply db:get-previous-test-run-record dbstruct params))
    ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
    ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
    ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
    ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
    ((test-get-top-process-pid)        (apply db:test-get-top-process-pid dbstruct params))
    ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
    ((get-prereqs-not-met)             (apply db:get-prereqs-not-met dbstruct params))
    ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
    ((get-not-completed-cnt)           (apply db:get-not-completed-cnt  dbstruct params)) 
    ;; ((synchash-get)                    (apply synchash:server-get dbstruct params))
    ((get-raw-run-stats)               (apply db:get-raw-run-stats dbstruct params))
    ((get-test-times)                  (apply db:get-test-times dbstruct params))

    ;; RUNS
    ((get-run-info)                 (apply db:get-run-info dbstruct params))
    ((get-run-status)               (apply db:get-run-status dbstruct params))
    ((get-run-state)                (apply db:get-run-state dbstruct params))
    ((set-run-status)               (apply db:set-run-status dbstruct params))
    ((set-run-state-status)  			 (apply db:set-run-state-status dbstruct params))
    ((update-tesdata-on-repilcate-db) (apply db:update-tesdata-on-repilcate-db  dbstruct params)) 
    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
    ((get-tests-for-run-state-status) (apply db:get-tests-for-run-state-status dbstruct params))
    ((get-test-id)                  (apply db:get-test-id dbstruct params))
    ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
    ;; ((get-tests-for-runs-mindata)   (apply db:get-tests-for-runs-mindata dbstruct params))
    ((get-runs)                     (apply db:get-runs dbstruct params))
    ((simple-get-runs)              (apply db:simple-get-runs dbstruct params))
    ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
    ((get-runs-cnt-by-patt)         (apply db:get-runs-cnt-by-patt dbstruct params))
    ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
    ((get-main-run-stats)           (apply db:get-main-run-stats dbstruct params))
    ((get-var)                      (apply db:get-var dbstruct params))
    ((get-run-stats)                (apply db:get-run-stats dbstruct params))
    ((get-run-times)                (apply db:get-run-times dbstruct params)) 

    ;; STEPS
    ((get-steps-data)               (apply db:get-steps-data dbstruct params))
    ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))
    ((get-steps-info-by-id)         (apply db:get-steps-info-by-id dbstruct params))

    ;; TEST DATA
    ((read-test-data)               (apply db:read-test-data dbstruct params))
    ((read-test-data-varpatt)       (apply db:read-test-data-varpatt dbstruct params))
    ((get-data-info-by-id)          (apply db:get-data-info-by-id dbstruct params)) 

    ;; MISC
    ((get-latest-host-load)         (apply db:get-latest-host-load dbstruct params))
    ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
    ((login)                        (apply db:login dbstruct params))
    ((general-call)                 (let ((stmtname   (car params))
                                          (run-id     (cadr params))
                                          (realparams (cddr params)))
                                      (db:general-call dbstruct run-id stmtname realparams)))
    ((sdb-qry)                      (apply sdb:qry params))
    ((ping)                         (current-process-id))
    ((get-changed-record-ids)       (apply db:get-changed-record-ids dbstruct params))
    ((get-run-record-ids) 	   (apply db:get-run-record-ids dbstruct params))	
    ;; TESTMETA
    ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))

    ;; TASKS 
    ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params))
    (else
     (debug:print 0 *default-log-port* "ERROR: bad api call " cmd)
     (conc "ERROR: BAD api call " cmd))))

;; http-server  send-response
;;                 api:process-request
;;                    db:*
;;
;; NB// Runs on the server as part of the server loop
;;

Modified server.scm from [1a43f0a48b] to [1c00c07593].

679
680
681
682
683
684
685

686
687
688
689
690
691
692
     ((and (list? host-port)
	   (eq? (length host-port) 2))
      (let* ((myrunremote (make-remote))
	     (iface       (car host-port))
	     (port        (cadr host-port))
	     (server-dat  (client:connect iface port server-id myrunremote))
	     (login-res   (rmt:login-no-auto-client-setup myrunremote)))

	(if (and (list? login-res)
		 (car login-res))
	    (begin
	      ;; (print "LOGIN_OK")
	      (if do-exit (exit 0))
	      #t)
	    (begin







>







679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
     ((and (list? host-port)
	   (eq? (length host-port) 2))
      (let* ((myrunremote (make-remote))
	     (iface       (car host-port))
	     (port        (cadr host-port))
	     (server-dat  (client:connect iface port server-id myrunremote))
	     (login-res   (rmt:login-no-auto-client-setup myrunremote)))
	(http-transport:close-connections myrunremote)
	(if (and (list? login-res)
		 (car login-res))
	    (begin
	      ;; (print "LOGIN_OK")
	      (if do-exit (exit 0))
	      #t)
	    (begin