Overview
| Comment: | Fixed bug in configf:lookup-number and few improvements to mtutil go |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
ca425652894955be33a3143b0333aa88 |
| User & Date: | mrwellan on 2020-12-16 20:49:54 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-12-17
| ||
| 14:05 | Turn back on aborting of server starts when there are enough running and use at to move them out of the way 10 minutes after they are created. check-in: 709d4974b2 user: mrwellan tags: v1.65 | |
|
2020-12-16
| ||
| 23:12 | Merged in v1.65, fixed Makefile and removed pkts from megatest/ulex.scm check-in: 96e98c0e2c user: matt tags: v1.65-ulex-try-again | |
| 20:49 | Fixed bug in configf:lookup-number and few improvements to mtutil go check-in: ca42565289 user: mrwellan tags: v1.65 | |
| 16:50 | Added some safety checks to mtutil go check-in: c9fbdc272c user: mrwellan tags: v1.65 | |
Changes
Modified configf.scm from [83ecc5b24c] to [1a8a686afd].
| ︙ | ︙ | |||
528 529 530 531 532 533 534 | (define config-lookup configf:lookup) (define configf:read-file read-config) ;; safely look up a value that is expected to be a number, return ;; a default (#f unless provided) ;; | | | | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 |
(define config-lookup configf:lookup)
(define configf:read-file read-config)
;; safely look up a value that is expected to be a number, return
;; a default (#f unless provided)
;;
(define (configf:lookup-number cfgdat section varname #!key (default #f))
(let* ((val (configf:lookup cfgdat section varname))
(res (if val
(string->number (string-substitute "\\s+" "" val #t))
#f)))
(cond
(res res)
(val (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
(else default))))
|
| ︙ | ︙ |
Modified mtut.scm from [3ac46e3257] to [413cf26858].
| ︙ | ︙ | |||
1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 |
(write-pkt pktsdir uuid pkt))))
((dispatch import rungen process go)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(toppath (configf:lookup mtconf "scratchdat" "toppath"))
(period (configf:lookup-number mtconf "mtutil" "autorun-period" default: 300))
(rest-time (configf:lookup-number mtconf "mtutil" "autorun-rest" default: 30)))
(case (string->symbol *action*)
((process) (begin
(common:load-pkts-to-db mtconf)
(generate-run-pkts mtconf toppath)
(common:load-pkts-to-db mtconf)
(dispatch-commands mtconf toppath)))
((import) (common:load-pkts-to-db mtconf)) ;; import pkts
| > | 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 |
(write-pkt pktsdir uuid pkt))))
((dispatch import rungen process go)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(toppath (configf:lookup mtconf "scratchdat" "toppath"))
(period (configf:lookup-number mtconf "mtutil" "autorun-period" default: 300))
(rest-time (configf:lookup-number mtconf "mtutil" "autorun-rest" default: 30)))
(print "Using period="period" and rest time="rest-time)
(case (string->symbol *action*)
((process) (begin
(common:load-pkts-to-db mtconf)
(generate-run-pkts mtconf toppath)
(common:load-pkts-to-db mtconf)
(dispatch-commands mtconf toppath)))
((import) (common:load-pkts-to-db mtconf)) ;; import pkts
|
| ︙ | ︙ | |||
1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 | (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.") | > | < | 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 |
(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
(print "File do-not-run-mtutil-go exists, exiting.")
(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)
|
| ︙ | ︙ |