462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
|
((< mver megatest-version)
(db:set-var db "MEGATEST_VERSION" megatest-version))))))
;;======================================================================
;; M A I N T E N A N C E
;;======================================================================
(define (db:find-and-mark-incomplete db)
(let* ((incompleted '())
(deadtime-str (configf:lookup *configdat* "setup" "deadtime"))
(deadtime (if (and deadtime-str
(string->number deadtime-str))
(string->number deadtime-str)
1800)))
(sqlite3:for-each-row
(lambda (test-id)
(set! incompleted (cons test-id incompleted)))
db
"SELECT id FROM tests WHERE event_time<? AND state IN ('RUNNING','REMOTEHOSTSTART');"
(- (current-seconds) deadtime)) ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
(sqlite3:for-each-row
(lambda (test-id)
(set! incompleted (cons test-id incompleted)))
db
"SELECT id FROM tests WHERE event_time<? AND state IN ('LAUNCHED');"
(- (current-seconds)(* 60 60 24))) ;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
(if (> (length incompleted) 0)
(begin
(debug:print 0 "WARNING: Marking test(s); " (string-intersperse (map conc incompleted) ", ") " as INCOMPLETE")
(sqlite3:execute
db
(conc "UPDATE tests SET state='INCOMPLETE' WHERE id IN ("
(string-intersperse (map conc incompleted) ",")
|
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
|
|
|
|
|
>
|
>
>
|
|
|
|
|
>
>
|
>
|
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
|
((< mver megatest-version)
(db:set-var db "MEGATEST_VERSION" megatest-version))))))
;;======================================================================
;; M A I N T E N A N C E
;;======================================================================
;; select end_time-now from
;; (select testname,item_path,event_time+run_duration as
;; end_time,strftime('%s','now') as now from tests where state in
;; ('RUNNING','REMOTEHOSTSTART','LAUNCED'));
(define (db:find-and-mark-incomplete db #!key (ovr-deadtime #f))
(let* ((incompleted '())
(deadtime-str (configf:lookup *configdat* "setup" "deadtime"))
(deadtime (if (and deadtime-str
(string->number deadtime-str))
(string->number deadtime-str)
7200)) ;; two hours
(run-ids (db:get-run-ids db))) ;; iterate over runs to divy up the calls
(if (number? ovr-deadtime)(set! deadtime ovr-deadtime))
(for-each
(lambda (run-id)
;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
;;
(sqlite3:for-each-row
(lambda (test-id)
(set! incompleted (cons test-id incompleted)))
db
"SELECT id FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time - run_duration) > ? AND state IN ('RUNNING','REMOTEHOSTSTART');"
run-id deadtime)
;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
;;
(sqlite3:for-each-row
(lambda (test-id)
(set! incompleted (cons test-id incompleted)))
db
"SELECT id FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time - run_duration) > ? AND state IN ('LAUNCHED');"
run-id (* 60 60 24)))
run-ids)
;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
;;
(if (> (length incompleted) 0)
(begin
(debug:print 0 "WARNING: Marking test(s); " (string-intersperse (map conc incompleted) ", ") " as INCOMPLETE")
(sqlite3:execute
db
(conc "UPDATE tests SET state='INCOMPLETE' WHERE id IN ("
(string-intersperse (map conc incompleted) ",")
|
875
876
877
878
879
880
881
882
883
884
885
886
887
888
|
"unlocked"
"locked")))) ;; semi-failsafe
(sqlite3:execute db "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
(sqlite3:execute db "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
user (conc newlockval " " run-id))
(debug:print-info 1 "" newlockval " run number " run-id)))
;;======================================================================
;; K E Y S
;;======================================================================
;; get key val pairs for a given run-id
;; ( (FIELDNAME1 keyval1) (FIELDNAME2 keyval2) ... )
(define (db:get-key-val-pairs db run-id)
|
>
>
>
>
>
>
>
>
|
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
|
"unlocked"
"locked")))) ;; semi-failsafe
(sqlite3:execute db "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
(sqlite3:execute db "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
user (conc newlockval " " run-id))
(debug:print-info 1 "" newlockval " run number " run-id)))
(define (db:get-run-ids db)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id)
(set! res (cons id res)))
db
"SELECT id FROM runs;")))
;;======================================================================
;; K E Y S
;;======================================================================
;; get key val pairs for a given run-id
;; ( (FIELDNAME1 keyval1) (FIELDNAME2 keyval2) ... )
(define (db:get-key-val-pairs db run-id)
|