1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
|
((rungen) (generate-run-pkts mtconf toppath))
((dispatch) (dispatch-commands mtconf toppath))
;; [mtutil]
;; # approximate interval between run processing in mtutil (seconds)
;; autorun-period 300
;; # minimal rest period between processing
;; autorun-rest 30
((go) (begin
(print "Starting long running import, rungen, and process loop")
(if (file-exists? "do-not-run-mtutil-go")
(begin
(print "NOTE: Removing flag file "(current-directory)"/do-not-run-mtutil-go")
(delete-file* "do-not-run-mtutil-go")))
(let loop ((last-run (- (current-seconds) (+ period 10))) ;; fake out first time in
(this-run (current-seconds)))
(if (file-exists? "do-not-run-mtutil-go")
(exit))
(let ((delta (- this-run last-run)))
(if (>= delta period)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat)))
(print "Running import at " (current-seconds))
(common:load-pkts-to-db mtconf)
(print "Running generate run pkts at " (current-seconds))
(generate-run-pkts mtconf toppath)
(print "Running run dispatch at " (current-seconds))
(common:load-pkts-to-db mtconf)
(dispatch-commands mtconf toppath)
(print "Done running import, generate, and dispatch done in " (- (current-seconds) this-run))
(print "NOTE: touch " (current-directory) "/do-not-run-mtutil-go to kill this runner.")
))
(thread-sleep! rest-time))
(loop this-run (current-seconds)))))
)))
;; misc
((show)
(if (> (length remargs) 0)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(sect-dat (configf:get-section mtconf (car remargs))))
(if sect-dat
|
>
>
>
|
>
>
>
>
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
|
|
|
|
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
|
((rungen) (generate-run-pkts mtconf toppath))
((dispatch) (dispatch-commands mtconf toppath))
;; [mtutil]
;; # approximate interval between run processing in mtutil (seconds)
;; autorun-period 300
;; # minimal rest period between processing
;; autorun-rest 30
((go)
;; determine if I'm the boss
(if (file-exists? "mtutil-go.pid")
(begin
(print "ERROR: mtutil go is already running under host and pid " (with-input-from-file "mtutil-go.pid" read-line)
". Please kill that process and remove the file \"mutil-go.pid\" and try again.")
(exit)))
(with-output-to-file "mtutil-go.pid" (lambda ()(print (get-host-name) " " (current-process-id))))
(print "Starting long running import, rungen, and process loop")
(if (file-exists? "do-not-run-mtutil-go")
(begin
(print "NOTE: Removing flag file "(current-directory)"/do-not-run-mtutil-go")
(delete-file* "do-not-run-mtutil-go")))
(let loop ((last-run (- (current-seconds) (+ period 10))) ;; fake out first time in
(this-run (current-seconds)))
(if (file-exists? "do-not-run-mtutil-go")
(begin
(delete-file* "mtutil-go.pid")
(exit)))
(let ((delta (- this-run last-run)))
(if (>= delta period)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat)))
(print "Running import at " (current-seconds))
(common:load-pkts-to-db mtconf)
(print "Running generate run pkts at " (current-seconds))
(generate-run-pkts mtconf toppath)
(print "Running run dispatch at " (current-seconds))
(common:load-pkts-to-db mtconf)
(dispatch-commands mtconf toppath)
(print "Done running import, generate, and dispatch done in " (- (current-seconds) this-run))
(print "NOTE: touch " (current-directory) "/do-not-run-mtutil-go to kill this runner.")
(loop this-run (current-seconds))
)
(let ((now (current-seconds)))
(print "Sleeping " rest-time " seconds, next run in aproximately " (- period (- now last-run)) " seconds")
(thread-sleep! rest-time)
(loop last-run (current-seconds))))))
(delete-file* "mtutil-go.pid")))))
;; misc
((show)
(if (> (length remargs) 0)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(sect-dat (configf:get-section mtconf (car remargs))))
(if sect-dat
|