Megatest

Diff
Login

Differences From Artifact [f4ca251106]:

To Artifact [e18f34d37e]:


22
23
24
25
26
27
28
29







30
31
32
33
34
35
36
(declare (uses commonmod))
(declare (uses dbmod))
(declare (uses debugprint))
(declare (uses tasksmod))
(declare (uses servermod))

(module apimod
	*







	
(import scheme
	chicken.base
	chicken.process-context.posix
	chicken.string
	chicken.time
	chicken.condition







<
>
>
>
>
>
>
>







22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
37
38
39
40
41
42
(declare (uses commonmod))
(declare (uses dbmod))
(declare (uses debugprint))
(declare (uses tasksmod))
(declare (uses servermod))

(module apimod

  (
api:run-server-process
api:start-server
api:dispatch-cmd
api:execute-requests
api:process-request
)
	
(import scheme
	chicken.base
	chicken.process-context.posix
	chicken.string
	chicken.time
	chicken.condition
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
    get-run-info
    get-run-status
    get-run-state
    get-run-stats
    get-run-times
    get-targets
    get-target
    ;; register-run
    get-tests-tags
    get-test-times
    get-tests-for-run
    get-tests-for-run-state-status
    get-test-id
    get-tests-for-runs-mindata
    get-tests-for-run-mindata







<







85
86
87
88
89
90
91

92
93
94
95
96
97
98
    get-run-info
    get-run-status
    get-run-state
    get-run-stats
    get-run-times
    get-targets
    get-target

    get-tests-tags
    get-test-times
    get-tests-for-run
    get-tests-for-run-state-status
    get-test-id
    get-tests-for-runs-mindata
    get-tests-for-run-mindata
198
199
200
201
202
203
204


205
206
207
208
209
210
211
    ((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))
    ((get-server)                        (api:start-server dbstruct params))
    ((register-server)                   (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)



    ;; 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)








>
>







203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
    ((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))
    ((get-server)                        (api:start-server dbstruct params))
    ((register-server)                   (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
    ((deregister-server)                 (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
    ((get-count-servers)                 (apply db:get-count-servers dbstruct params))

    ;; 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)

227
228
229
230
231
232
233

234
235
236
237
238
239
240
    ((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))







>







234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
    ((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))
    ((insert-run)                   (apply db:insert-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))
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
    ;; 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 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







|
|
|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
    ;; 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 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
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
    ;; 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 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))








|







362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
    ;; 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 stmtname run-id 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))

407
408
409
410
411
412
413

414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
  (let* ((cmd-in  (alist-ref 'cmd indat)) ;; ($ 'cmd))
	 (cmd     (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
	 (params  (alist-ref 'params indat))
         (key     (alist-ref 'key indat))    ;; TODO - add this back

	 )
    (debug:print 0 *default-log-port* "cmd:" cmd " with params " params ", key " key)
    (case cmd-in
      ((ping) #t)
      ;; ((quit) (exit))
      (else
       (if (equal? key *my-signature*) ;; TODO - get real key involved
	   (begin
	     (set! *api-process-request-count* (+ *api-process-request-count* 1))
	     (let* ((res (api:execute-requests dbstruct cmd params))) 
	       (debug:print 0 *default-log-port* "res:" res)
	       #;(if (not success)
	       (debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
	       (if (> *api-process-request-count* *max-api-process-requests*)
		   (set! *max-api-process-requests* *api-process-request-count*))
	       (set! *api-process-request-count* (- *api-process-request-count* 1))
	       #;(sexpr->string res)
	       res))
	   (begin
	     (debug:print 0 *default-log-port*   "Server refused to process request. Sever id mismatch. recived " key " expected:  " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params) 
	     (conc "Server refused to process request server signature mismatch: " key ", " *my-signature*)))))))

)







>

|








|












415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
  (let* ((cmd-in  (alist-ref 'cmd indat)) ;; ($ 'cmd))
	 (cmd     (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
	 (params  (alist-ref 'params indat))
         (key     (alist-ref 'key indat))    ;; TODO - add this back
	 ;; (doprint (apply common:low-noise-print 10 params))
	 )
    ;; (if doprint (debug:print 0 *default-log-port* "cmd: " cmd " with params: " params ", key: " key))
    (case cmd-in
      ((ping) #t)
      ;; ((quit) (exit))
      (else
       (if (equal? key *my-signature*) ;; TODO - get real key involved
	   (begin
	     (set! *api-process-request-count* (+ *api-process-request-count* 1))
	     (let* ((res (api:execute-requests dbstruct cmd params))) 
	       ;; (if doprint (debug:print 0 *default-log-port* "res:" res))
	       #;(if (not success)
	       (debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
	       (if (> *api-process-request-count* *max-api-process-requests*)
		   (set! *max-api-process-requests* *api-process-request-count*))
	       (set! *api-process-request-count* (- *api-process-request-count* 1))
	       #;(sexpr->string res)
	       res))
	   (begin
	     (debug:print 0 *default-log-port*   "Server refused to process request. Sever id mismatch. recived " key " expected:  " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params) 
	     (conc "Server refused to process request server signature mismatch: " key ", " *my-signature*)))))))

)