1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
|
(set! ret #f))
(if (string-contains cmd "-modepatt")
(if (check-if-modepatt-defined pkta notification-hook pktfile)
(print "Modepatt is valid")
(set! ret #f))))
ret))
;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (dispatch-commands mtconf toppath)
;; we are expecting a directory "logs", check and create it, create the log in /tmp if not able to create logs dir
(let ((logdir
(if (if (not (directory? "logs"))
(handle-exceptions
|
|
>
|
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
|
(set! ret #f))
(if (string-contains cmd "-modepatt")
(if (check-if-modepatt-defined pkta notification-hook pktfile)
(print "Modepatt is valid")
(set! ret #f))))
ret))
;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (dispatch-commands mtconf toppath)
;; we are expecting a directory "logs", check and create it, create the log in /tmp if not able to create logs dir
(let ((logdir
(if (if (not (directory? "logs"))
(handle-exceptions
|
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
|
(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))
|
>
|
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
|
(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
(debug:print 0 *default-log-port* "dispatch-commands: number of pkts = " (length pkts))
(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))
|
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
|
(system notification-cmd))))
(begin
;; if modepatt used chek if it is defined for the target. If -reqtarg check if target exist.
(if (validate-cmd fullcmd pkta notification-hook pktfile)
(begin
(print "RUNNING: " fullcmd)
(system fullcmd) ;; replace with process ...
(mark-processed pdb (list (alist-ref 'id pktdat)))
(let-values (((ack-uuid ack-pkt)
(add-z-card
(construct-sdat 'P uuid
'T (case (string->symbol action)
((run) "runstart")
((sync) "syncstart") ;; example of translating run -> runstart
(else action))
|
>
>
>
|
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
|
(system notification-cmd))))
(begin
;; if modepatt used chek if it is defined for the target. If -reqtarg check if target exist.
(if (validate-cmd fullcmd pkta notification-hook pktfile)
(begin
(print "RUNNING: " fullcmd)
(system fullcmd) ;; replace with process ...
(debug:print 0 *default-log-port* "doing mark-processed. pktsdir: " pktsdir)
(debug:print 0 *default-log-port* "fullcmd: " fullcmd)
(mark-processed pdb (list (alist-ref 'id pktdat)))
(thread-sleep! 100)
(let-values (((ack-uuid ack-pkt)
(add-z-card
(construct-sdat 'P uuid
'T (case (string->symbol action)
((run) "runstart")
((sync) "syncstart") ;; example of translating run -> runstart
(else action))
|