| ︙ | | |
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
+
|
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
srfi-19 srfi-18 extras format pkts regex regex-case
(prefix dbi dbi:)
(prefix sqlite3 sqlite3:)
nanomsg)
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
|
| ︙ | | |
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
+
|
("-log" . #f)
("-override-user" . #f)
("-msg" . M)
("-start-dir" . S)
("-set-vars" . v)
("-config" . h)
("-time-out" . u)
("-archive" . b)
))
(define *switch-keys*
'(
("-h" . #f)
("-help" . #f)
("--help" . #f)
("-manual" . #f)
|
| ︙ | | |
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
|
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
|
-
+
|
(rerun-clean . "-rerun-clean")
(rerun-all . "-rerun-all")
(kill-run . "-kill-runs")
(kill-rerun . "-kill-rerun")
(lock . "-lock")
(unlock . "-unlock")
(sync . "")
(archive . "-archive")
(archive . "")
(set-ss . "-set-state-status")
(remove . "-remove-runs")))
;; manually keep this list updated from the keys to
;; the case *action* near the end of this file.
(define *other-actions*
'(run remove rerun set-ss archive kill list
|
| ︙ | | |
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
|
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
|
-
-
+
|
(rgconf (car rgconfdat))
(all-areas (map car (configf:get-section mtconf "areas")))
(contours (configf:get-section mtconf "contours"))
(torun (make-hash-table)) ;; target => ( ... info ... )
(rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering
;;(print "rgentargs: " rgentargs)
(for-each
|
| ︙ | | |
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
|
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
|
+
|
(let* ((rgconfdat (find-and-read-config (conc toppath "/runconfigs.config")))
(rgconf (car rgconfdat))
(areas (configf:get-section mtconf "areas"))
(contours (configf:get-section mtconf "contours"))
(pkts (find-pkts pdb '(cmd) '()))
(torun (make-hash-table)) ;; target => ( ... info ... )
(rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering
(sqlite3:set-busy-handler! (dbi:db-conn pdb) (sqlite3:make-busy-timeout 10000))
(for-each
(lambda (pktdat)
(let* ((pkta (alist-ref 'apkt pktdat))
(action (alist-ref 'A pkta))
(cmdline (pkt->cmdline pkta))
(uuid (alist-ref 'Z pkta))
(user (alist-ref 'U pkta))
|
| ︙ | | |