Overview
Context
Changes
Modified Makefile
from [1b6cbc7173]
to [da8b38b265].
| ︙ | | |
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
|
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
|
mtest-reaper: $(PREFIX)/bin/mtest-reaper
# 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) :
mkdir -p $(PREFIX)/bin/.$(ARCHSTR)
mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib
|
| ︙ | | |
Modified configf.scm
from [83ecc5b24c]
to [1a8a686afd].
| ︙ | | |
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
|
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 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)
(val (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
(else default))))
|
| ︙ | | |
Added lib/libpangox-1.0.so version [d55c756a93].
cannot compute difference between binary files
Added lib/libpangox-1.0.so.0 version [d55c756a93].
cannot compute difference between binary files
Added lib/libxcb-xlib.so.0 version [b7cbe8e250].
cannot compute difference between binary files
Modified megatest-version.scm
from [2199621c50]
to [b4d2006c23].
| ︙ | | |
16
17
18
19
20
21
22
23
|
16
17
18
19
20
21
22
23
|
-
+
|
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; 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)
|
Modified mtut.scm
from [ead30f316f]
to [413cf26858].
| ︙ | | |
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
+
|
Queries:
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
Selectors
-immediate : apply this action immediately, default is to queue up actions
|
| ︙ | | |
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
|
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
|
-
+
|
(handle-exceptions
exn
(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))
(actual-action (if action
(if (equal? action "sync-prepend")
|
| ︙ | | |
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
|
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
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
1684
|
-
+
-
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (if (not (member key *legal-params*))
;; (hash-table-delete! adjargs key))) ;; we need to delete any params intended for mtutil
;; (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))
(sect-dat (configf:get-section mtconf (car remargs))))
(if sect-dat
|
| ︙ | | |
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
|
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
|
)
)
)))
(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)
|
| ︙ | | |
Modified runs.scm
from [22193dc2d3]
to [10c892ad0a].
| ︙ | | |
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
|
+
+
-
+
+
-
+
+
|
(runname (common:args-get-runname))
(rundir (db:test-get-rundir testdat))
(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))
(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 "rerun-hook-" (string-translate target "/" "-") "-" runname "." testname (if (not (string=? itempath "")) (conc "." (string-translate itempath "/" "-")) "") ".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 file-body ".tar"))
(tarfilename (conc status "." (string-translate target "/" "-") "." runname "." testname (if (not (string=? itempath "")) (conc "." (string-translate itempath "/" "-")) "") ".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
(begin
(debug:print 0 *default-log-port* "WARNING: Failed to create " log-dir ", exn=" exn)
#f)
(create-directory log-dir #t)
#t)
#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)
(debug:print 0 *default-log-port* "ERROR: failed to run rerun-hook " rerun-hook ", check the log " log-file))
(debug:print-info 0 *default-log-port* "running rerun-hook: \"" rerun-hook "\", log is " actual-logf)
|
| ︙ | | |
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
|
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
|
-
+
|
;; Ensure all tests are registered in the test_meta table
(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
config-reruns
1)))
|
| ︙ | | |
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
|
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
|
-
+
|
;; if run-count > 0 call, set -preclean and -rerun STUCK/DEAD
(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")
;; TODO: try putting post hook call here
|
| ︙ | | |
Modified ulex.scm
from [39353b5283]
to [8e5968c5c0].
| ︙ | | |
15
16
17
18
19
20
21
22
23
24
|
15
16
17
18
19
20
21
22
23
24
|
-
+
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit ulex))
(declare (uses pkts))
;;(declare (uses pkts))
(include "ulex/ulex.scm")
|
Modified ulex/Makefile
from [2d6d448a34]
to [5f04b2caf2].
1
2
3
4
5
6
7
8
9
10
11
12
|
1
2
3
4
5
6
7
8
9
10
11
12
13
|
-
+
+
|
all : example
ulex.so : ulex.scm telemetry/telemetry.so netutil/ulex-netutil.so portlogger/portlogger.so
|
| ︙ | | |
Modified utils/mk_wrapper
from [e11fc37257]
to [713ec8f660].
| ︙ | | |
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
+
+
-
+
-
+
|
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
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
else
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
echo
else
|
| ︙ | | |