Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -351,10 +351,15 @@ (debug:print 4 *default-log-port* "Added " uuid " of type " ptype " to queue")) (debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...") ))) pkts)))) (string-split pktsdirs))))) + +(define (get-pkt-alists pkts) + (map (lambda (x) + (alist-ref 'pkta x)) ;; 'pkta pulls out the alist from the read pkt + pkts)) ;;====================================================================== ;; Runs ;;====================================================================== @@ -510,13 +515,12 @@ ;; (val-list (string-split-fields ";\\s*" val #:infix)) ;; (string-split val)) ;; runname-rule params (val-alist (val->alist val)) (runname (make-runname "" "")) (runstarts (find-pkts pdb '(runstart) `((o . ,contour) (t . ,runkey)))) - (rspkts (map (lambda (x) - (alist-ref 'pkta x)) - runstarts)) + (rspkts (get-pkt-alists runstarts)) + ;; starttimes is for run start times and is used to know when the last run was launched (starttimes ;; sort by age (youngest first) and delete duplicates by target (delete-duplicates (sort (map (lambda (x) `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x)))) @@ -524,10 +528,25 @@ (lambda (a b)(> (cdr a)(cdr b)))) ;; sort descending (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target (last-run (if (null? starttimes) ;; if '() then it has never been run, else get the max 0 (apply max (map cdr starttimes)))) + ;; synctimes is for figuring out the last time a sync was done + (syncstarts (find-pkts pdb '(syncstart) '())) ;; no qualifiers, a sync does all tarets etc. + (sspkts (get-pkt-alists syncstarts)) + (synctimes + (delete-duplicates + (sort + (map (lambda (x) + `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x)))) + sspkts) + (lambda (a b)(> (cdr a)(cdr b)))) ;; sort descending + (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target + (last-sync (if (null? synctimes) ;; if '() then it has never been run, else get the max + 0 + (apply max (map cdr synctimes)))) + ) (print "runkey: " runkey " ruletype: " ruletype " action: " action) ;; look in runstarts for matching runs by target and contour ;; get the timestamp for when that run started and pass it @@ -543,31 +562,32 @@ (print "ERROR: bad sense spec \"" (string-intersperse sense " ") "\" params: " val-alist) (let* ((run-name (alist-ref 'run-name val-alist)) (target (alist-ref 'target val-alist)) (crontab (alist-ref 'cron val-alist)) ;; (action (alist-ref 'action val-alist)) - (need-run (common:extended-cron crontab #f last-run)) (cron-safe-string (string-translate (string-intersperse (string-split (alist-ref 'cron val-alist)) "-") "*" "X")) (runname std-runname)) ;; (conc "sched" (time->string (seconds->local-time (current-seconds)) "%M%H%d"))))) - (print "last-run: " last-run " need-run: " need-run) - (if need-run - (case (string->symbol action) - ((sync) + ;; (print "last-run: " last-run " need-run: " need-run) + ;; (if need-run + (case (string->symbol action) + ((sync) + (if (common:extended-cron crontab #f last-sync) (push-run-spec torun contour runkey `((message . ,(conc ruletype ":sync-" cron-safe-string)) (action . ,action) (dbdest . ,(alist-ref 'dbdest val-alist)) - (append . ,(alist-ref 'appendconf val-alist))))) - ((run) + (append . ,(alist-ref 'appendconf val-alist)))))) + ((run) + (if (common:extended-cron crontab #f last-run) (push-run-spec torun contour runkey `((message . ,(conc ruletype ":" cron-safe-string)) (runname . ,runname) (action . ,action) - (target . ,target)))) - (else - (print "ERROR: action \"" action "\" has no scheduled handler") - )))))) + (target . ,target))))) + (else + (print "ERROR: action \"" action "\" has no scheduled handler") + ))))) ((script) ;; syntax is a little different here. It is a list of commands to run, "scriptname = extra_parameters;scriptname = ..." ;; where scriptname may be repeated multiple times. The script must return unix-epoch of last change, new-target-name and new-run-name ;; the script is called like this: scriptname contour runkey std-runname action extra_param1 extra_param2 ... @@ -783,19 +803,23 @@ (torun (make-hash-table)) ;; target => ( ... info ... ) (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering (for-each (lambda (pktdat) (let* ((pkta (alist-ref 'pkta pktdat)) + (action (alist-ref 'a pkta)) (cmdline (pkt->cmdline pkta)) (uuid (alist-ref 'Z pkta)) (logf (conc logdir "/" uuid "-run.log"))) (system (conc "NBFAKE_LOG=" logf " nbfake " cmdline)) (mark-processed pdb (list (alist-ref 'id pktdat))) (let-values (((ack-uuid ack-pkt) (add-z-card (construct-sdat 'P uuid - 'T "runstart" + 'T (case (string->symbol action) + ((run) "runstart") + ((sync) "syncstart") ;; example of translating run -> runstart + (else action)) 'c (alist-ref 'o pkta) ;; THIS IS WRONG! SHOULD BE 'c 't (alist-ref 't pkta))))) (write-pkt pktsdir ack-uuid ack-pkt)))) pkts)))))) Index: runconfigs.config ================================================================== --- runconfigs.config +++ runconfigs.config @@ -8,22 +8,22 @@ [v1.63/tip/dev] # file: files changes since last run trigger new run # script: script is called with unix seconds as last parameter (other parameters are preserved) # # contour:sensetype:action params data -quick:file:run run-name=auto;glob=/home/matt/data/megatest/*.scm +# quick:file:run run-name=auto;glob=/home/matt/data/megatest/*.scm # script returns change-time (unix epoch), new-target-name, run-name # # quick:script:run checkfossil = http://www.kiatoa.com/fossils/megatest v1.63;\ # checkfossil = http://www.kiatoa.com/fossils/megatest_qa trunk # fossil based trigger # -quick:fossil:run http://www.kiatoa.com/fossils/megatest=v1.63;\ - http://www.kiatoa.com/fossils/megatest_qa=trunk;\ - http://www.kiatoa.com/fossils/megatest=v1.64 +# quick:fossil:run http://www.kiatoa.com/fossils/megatest=v1.63;\ +# http://www.kiatoa.com/fossils/megatest_qa=trunk;\ +# http://www.kiatoa.com/fossils/megatest=v1.64 # field allowed values # ----- -------------- # minute 0-59 # hour 0-23