Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -315,19 +315,40 @@ # install dashboard as dboard so wrapper script can be called dashboard $(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard chmod a+x $(PREFIX)/bin/dashboard $(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard + +$(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so : lib/libpangox-1.0.so + if [[ $(ARCHSTR) == 12.5 ]]; then \ + mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib; \ + $(INSTALL) lib/libpangox-1.0.so $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so; \ + fi + +$(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 : lib/libpangox-1.0.so.0 + if [[ $(ARCHSTR) == 12.5 ]]; then \ + mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib; \ + $(INSTALL) lib/libpangox-1.0.so.0 $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0; \ + fi + +$(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0 : lib/libxcb-xlib.so.0 + if [[ $(ARCHSTR) == 12.5 ]]; then \ + mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib; \ + $(INSTALL) lib/libxcb-xlib.so.0 $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0; \ + fi install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ $(PREFIX)/bin/.$(ARCHSTR)/mtexec $(PREFIX)/bin/mtexec $(PREFIX)/bin/serialize-env \ $(PREFIX)/bin/nbfind $(PREFIX)/bin/mtrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \ $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \ - $(PREFIX)/share/js/jquery-3.1.0.slim.min.js + $(PREFIX)/share/js/jquery-3.1.0.slim.min.js \ + $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so \ + $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 \ + $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0 # $(PREFIX)/bin/.$(ARCHSTR)/ndboard # $(PREFIX)/bin/newdashboard $(PREFIX)/bin/.$(ARCHSTR) : Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -530,12 +530,12 @@ (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 cfdat section varname #!key (default #f)) - (let* ((val (configf:lookup *configdat* section varname)) +(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) ADDED lib/libpangox-1.0.so Index: lib/libpangox-1.0.so ================================================================== --- /dev/null +++ lib/libpangox-1.0.so cannot compute difference between binary files ADDED lib/libpangox-1.0.so.0 Index: lib/libpangox-1.0.so.0 ================================================================== --- /dev/null +++ lib/libpangox-1.0.so.0 cannot compute difference between binary files ADDED lib/libxcb-xlib.so.0 Index: lib/libxcb-xlib.so.0 ================================================================== --- /dev/null +++ lib/libxcb-xlib.so.0 cannot compute difference between binary files Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -18,6 +18,6 @@ ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. ;; (declare (unit megatest-version)) -(define megatest-version 1.6578) +(define megatest-version 1.6579) Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -154,10 +154,11 @@ show [areas|contours... ] : show areas, contours or other section from megatest.config gendot : generate a graphviz dot file from pkts. Contour actions: process : runs import, rungen and dispatch + go : runs import, rungen and dispatch every five minutes forever Trigger propagation actions: tsend a=b,c=d... : send trigger info to all recpients in the [listeners] section tlisten -port N : listen for trigger info on port N @@ -773,11 +774,11 @@ (begin (print-call-chain) (print "FAILED TO RUN RUNNAME MAPPER " callname " FOR AREA " area) (print " message: " ((condition-property-accessor 'exn 'message) exn)) runname) - (print "(mapper " (string-intersperse (list runkey runname area area-path reason contour mode-patt) ", ") ")") + (print "(mapper " (string-intersperse (map conc (list runkey runname area area-path reason contour mode-patt)) ", ") ")") (mapper runkey runname area area-path reason contour mode-patt)) (case callname ((auto #f) runname) (else runtrans))))) (new-target target) ;; I believe we will want target manipulation here .. (map-targets xlatr-key runkey area contour)) @@ -1612,23 +1613,70 @@ ;; (hash-table-keys adjargs)) (let-values (((uuid pkt) (command-line->pkt *action* adjargs #f area-path: area-path new-ss: new-ss))) (print "run log @ " (conc (current-directory) "/" uuid "-" *action* ".log")) (write-pkt pktsdir uuid pkt)))) - ((dispatch import rungen process) + ((dispatch import rungen process go) (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir"))) (mtconf (car mtconfdat)) - (toppath (configf:lookup mtconf "scratchdat" "toppath"))) + (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 ((rungen) (generate-run-pkts mtconf toppath)) - ((dispatch) (dispatch-commands 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 + (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) (if (> (length remargs) 0) (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir"))) (mtconf (car mtconfdat)) @@ -1807,46 +1855,52 @@ ) ))) (loop (nn-recv rep)))) (print "ERROR: Port " portnum " already in use. Try another port"))))))) - - - - - ((tlisten) - (if (null? remargs) - (print "ERROR: useage for tlisten is \"mtutil tlisten portnum\"") - (let ((portnum (string->number (car remargs)))) - - (if (not portnum) - (print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs)) - (begin - (if (not (is-port-in-use portnum)) - (let* ((rep (start-nn-server portnum)) - (mtconfdat (simple-setup (args:get-arg "-start-dir"))) - (mtconf (car mtconfdat)) - (contact (configf:lookup mtconf "listener" "owner")) - (script (configf:lookup mtconf "listener" "script"))) - (print "Listening on port " portnum " for messages.") - (set-signal-handler! signal/int (lambda (signum) - (set! *time-to-exit* #t) - (debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!") - (let ((email-body (mtut:stml->string (s:body - (s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". ")))))) - (sendmail contact "Listner has been terminated." email-body use_html: #t)) - (exit))) - (set-signal-handler! signal/term (lambda (signum) - (set! *time-to-exit* #t) - (debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!") - (let ((email-body (mtut:stml->string (s:body - (s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". ")))))) - (sendmail contact "Listner has been terminated." email-body use_html: #t)) - (exit))) - - ;(set-signal-handler! signal/term special-signal-handler) - + + ((tlisten) + (if (null? remargs) + (print "ERROR: useage for tlisten is \"mtutil tlisten portnum\"") + (let ((portnum (string->number (car remargs)))) + + (if (not portnum) + (print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs)) + (begin + (if (not (is-port-in-use portnum)) + (let* ((rep (start-nn-server portnum)) + (mtconfdat (simple-setup (args:get-arg "-start-dir"))) + (mtconf (car mtconfdat)) + (contact (configf:lookup mtconf "listener" "owner")) + (script (configf:lookup mtconf "listener" "script"))) + (print "Listening on port " portnum " for messages.") + (set-signal-handler! signal/int + (lambda (signum) + (set! *time-to-exit* #t) + (debug:print-error 0 *default-log-port* "Received signal " signum + " sending email befor exiting !!") + (let ((email-body (mtut:stml->string + (s:body + (s:p (conc "Received signal " signum + ". Lister has been terminated on host " + (get-environment-variable "HOST") ". ")))))) + (sendmail contact "Listner has been terminated." email-body use_html: #t)) + (exit))) + (set-signal-handler! signal/term (lambda (signum) + (set! *time-to-exit* #t) + (debug:print-error 0 *default-log-port* "Received signal " + signum " sending email befor exiting !!") + (let ((email-body (mtut:stml->string + (s:body + (s:p (conc "Received signal " signum + ". Lister has been terminated on host " + (get-environment-variable "HOST") ". ")))))) + (sendmail contact "Listner has been terminated." email-body use_html: #t)) + (exit))) + + ;; (set-signal-handler! signal/term special-signal-handler) + (let loop ((instr (nn-recv rep))) (nn-send rep "ok") (let ((ctime (date->string (current-date)))) (if (equal? instr "time-to-die") (begin Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -472,13 +472,16 @@ (tarfiledir (conc *toppath* "/reruns")) (status (db:test-get-status testdat)) (comment (conc "\"" (db:test-get-comment testdat) "\"" )) (testname (db:test-get-testname testdat)) (itempath (db:test-get-item-path testdat)) - (log-file (conc "rerun-hook-" (string-translate target "/" "-") "-" runname "." testname (if (not (string=? itempath "")) (conc "." (string-translate itempath "/" "-")) "") ".log")) + (file-body (conc status "-" (string-translate target "/" "-") "-" runname "." testname (if (not (string=? itempath "")) (conc "." (string-translate itempath "/" "-")) ""))) + (log-file (conc file-body ".log")) + ;; (log-file (conc status "-" (string-translate target "/" "-") "-" runname "." testname (if (not (string=? itempath "")) (conc "." (string-translate itempath "/" "-")) "") ".log")) (full-log-fname (conc log-dir "/" log-file)) - (tarfilename (conc status "." (string-translate target "/" "-") "." runname "." testname (if (not (string=? itempath "")) (conc "." (string-translate itempath "/" "-")) "") ".tar")) + (tarfilename (conc file-body ".tar")) + ;; (tarfilename (conc status "." (string-translate target "/" "-") "." runname "." testname (if (not (string=? itempath "")) (conc "." (string-translate itempath "/" "-")) "") ".tar")) ) (if rerun-hook (let* ((use-log-dir (if (not (directory-exists? log-dir)) (handle-exceptions exn @@ -490,10 +493,11 @@ #t)) (start-time (current-seconds)) (actual-logf (if use-log-dir full-log-fname log-file)) (sys-call-text (conc rerun-hook " " tarfilename " " rundir " " actual-logf " " runname " " tarfiledir " " status " " target " " comment " " testname " " itempath " >> " actual-logf " 2>&1")) ) + (debug:print 2 *default-log-port* "Found rerun-hook in config:" rerun-hook) (handle-exceptions exn (begin (print-call-chain *default-log-port*) (debug:print 0 *default-log-port* "Message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) @@ -685,11 +689,11 @@ (runs:update-all-test_meta #f) ;; run the run prehook if there are no tests yet run for this run: ;; (runs:run-pre-hook run-id) - ;; mark all test launced flag as false in the meta table + ;; mark all test launched flag as false in the meta table (rmt:set-var (conc "lunch-complete-" run-id) "no") (debug:print-info 1 *default-log-port* "Setting end-of-run to no") (let* ((config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns"))) (if x (string->number x) #f))) (config-rerun-cnt (if config-reruns @@ -845,11 +849,11 @@ (if (> run-count 0) ;; handle reruns (begin (if (not (hash-table-ref/default flags "-preclean" #f)) (hash-table-set! flags "-preclean" #t)) (if (not (hash-table-ref/default flags "-rerun" #f)) - (hash-table-set! flags "-rerun" "STUCK/DEAD,n/a,ZERO_ITEMS")) + (hash-table-set! flags "-rerun" "ABORT,STUCK/DEAD,n/a,ZERO_ITEMS")) ;; recursive call to self (runs:run-tests target runname test-patts user flags run-count: (- run-count 1))) (launch:end-of-run-check run-id))) (debug:print-info 0 *default-log-port* "No tests to run"))) (debug:print-info 4 *default-log-port* "All done by here") Index: ulex.scm ================================================================== --- ulex.scm +++ ulex.scm @@ -17,8 +17,8 @@ ;; along with Megatest. If not, see . ;;====================================================================== (declare (unit ulex)) -(declare (uses pkts)) +;;(declare (uses pkts)) (include "ulex/ulex.scm") Index: ulex/Makefile ================================================================== --- ulex/Makefile +++ ulex/Makefile @@ -1,10 +1,11 @@ all : example -ulex.so : ulex.scm telemetry/telemetry.so netutil/ulex-netutil.so portlogger/portlogger.so +# telemetry/telemetry.so netutil/ulex-netutil.so portlogger/portlogger.so +ulex.so : ulex.scm chicken-install telemetry/telemetry.so : telemetry/telemetry.scm cd telemetry && chicken-install Index: utils/mk_wrapper ================================================================== --- utils/mk_wrapper +++ utils/mk_wrapper @@ -19,10 +19,11 @@ prefix=$1 cmd=$2 target=$3 cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh" +libdir="$prefix/bin/.$(lsb_release -sr)/lib" # we wish to create a var in cfg.sh for finding sqlite3 executable chicken_bin_dir=$(dirname $(which csi)) if [[ -e $chicken_bin_dir/sqlite3 ]];then sqlite3_exe=$chicken_bin_dir/sqlite3 @@ -30,19 +31,20 @@ sqlite3_exe=$(which sqlite3) fi if [ "$LD_LIBRARY_PATH" != "" ];then echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2 + echo "INFO: Writing $cfgfile" >&2 ( cat << __EOF if [ -z \$MT_ORIG_ENV ]; then export MT_ORIG_ENV=\$( $prefix/bin/serialize-env ) fi if [ "\$LD_LIBRARY_PATH" != "" ];then - export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$LD_LIBRARY_PATH + export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$LD_LIBRARY_PATH:$libdir else - export LD_LIBRARY_PATH=$LD_LIBRARY_PATH + export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$libdir fi export MT_SQLITE3_EXE=$sqlite3_exe __EOF ) > $cfgfile