Megatest

Check-in [92d3c79b3a]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:partial archive working
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 92d3c79b3aaff29ce42e7265bd68b447319c1e5d
User & Date: matt on 2014-12-10 22:52:24
Other Links: branch diff | manifest | tags
Context
2014-12-11
00:18
Basic archiving done check-in: aa5d0defe7 user: matt tags: v1.60
2014-12-10
22:52
partial archive working check-in: 92d3c79b3a user: matt tags: v1.60
11:37
Minor cleanup check-in: 5a8e1e2098 user: mrwellan tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [0861a039e1] to [a24183c8ff]. 

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20













-
+








# make install CSCOPTS='-accumulate-profile -profile-name $(PWD)/profile-ww$(shell date +%V.%u)'
PREFIX=$(PWD)
CSCOPTS= 
INSTALL=install
SRCFILES = common.scm items.scm launch.scm \
           ods.scm runconfig.scm server.scm configf.scm \
           db.scm keys.scm margs.scm megatest-version.scm \
           process.scm runs.scm tasks.scm tests.scm genexample.scm \
	   http-transport.scm nmsg-transport.scm filedb.scm \
           client.scm gutils.scm synchash.scm daemon.scm mt.scm dcommon.scm \
	   tree.scm ezsteps.scm lock-queue.scm sdb.scm \
	   rmt.scm api.scm tdb.scm rpc-transport.scm \
	   portlogger.scm
	   portlogger.scm archive.scm

# Eggs to install (straightforward ones)
EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \
     dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \
     json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \
     spiffy-directory-listing ssax sxml-serializer sxml-modifications iup canvas-draw sqlite3
︙

Modified archive.scm from [399e9c79b1] to [12956fb2bb].

︙
11
12
13
14
15
16
17



18
19
20
21
22
23
24

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27








+
+
+









(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
(import (prefix sqlite3 sqlite3:))

(declare (unit archive))
(declare (uses db))
(declare (uses common))

(include "common_records.scm")
(include "db_records.scm")

;;======================================================================
;; 
;;======================================================================

(define (archive:main linktree target runname testname itempath options)
  (let ((testdir (conc linktree "/" target "/" runname "/" testname "/" itempatt))
︙
80
81
82
83
84
85
86

















87
























83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

	       (archive-path  (conc bdisk-path "/" archive-name))
	       (block-id      (rmt:archive-register-block-name bdisk-id archive-path))
	       (allocation-id (rmt:archive-allocate-test-to-block block-id testname itempath)))
	  (if (and block-id allocation-id)
	      archive-path
	      #f)))))

;; archive - run bup
;;
;; 1. create the bup dir if not exists
;; 2. start the du of each directory
;; 3. gen index
;; 4. save
;;
(define (archive:run-bup archive-dir run-name tests)
  (let* ((bup-exe    (or (configf:lookup *configdat* "archive" "bup") "bup"))
	 (linktree   (configf:lookup *configdat* "setup" "linktree"))
	 (test-paths (filter
		      string?
		      (map (lambda (test-dat)
			     (let* ((item-path         (db:test-get-item-path test-dat))
				    (test-name         (db:test-get-testname  test-dat))
				    (run-id            (db:test-get-run_id    test-dat))
				    (target            (string-intersperse (map cadr (rmt:get-key-val-pairs run-id)) "/"))
	       
				    
				    (toplevel/children (and (db:test-get-is-toplevel test-dat)
							    (> (rmt:test-toplevel-num-items run-id test-name) 0))))
			       (if toplevel/children
				   #f
				   (conc linktree "/" target "/" run-name "/" (runs:make-full-test-name test-name item-path) "/")))) ;; note the trailing slash to get the dir inspite of it being a link
			   tests)))
	 ;; ((string-intersperse (map cadr (rmt:get-key-val-pairs 1)) "-")
	 (bup-init-params  (list "-d" archive-dir))
	 (bup-index-params (append (list "-d" archive-dir "index") test-paths))
	 (bup-save-params  (append (list "-d" archive-dir "save" "-n" (common:get-testsuite-name))
				   test-paths)))
    (if (not (file-exists? archive-dir))
	(create-directory archive-dir #t))
    (if (not (file-exists? (conc archive-dir "/HEAD")))
	(begin
	  ;; replace this with jobrunner stuff enventually
	  (debug:print-info 0 "Init bup in " archive-dir)
	  (run-n-wait bup-exe params: bup-init-params)))
    (debug:print-info 0 "Indexing data to be archived")
    (run-n-wait bup-exe params: bup-index-params)
    (debug:print-info 0 "Archiving data with bup")
    (run-n-wait bup-exe params: bup-save-params)))

Modified megatest.scm from [f33b053b58] to [dd5ff2aea5].

︙
145
146
147
148
149
150
151

152
153
154
155
156
157
158

145
146
147
148
149
150
151
152
153
154
155
156
157
158
159








+








  -ping run-id|host:port  : ping server, exit with 0 if found

Utilities
  -env2file fname         : write the environment to fname.csh and fname.sh
  -refdb2dat refdb        : convert refdb to sexp or to format specified by -dumpmode
                            formats: perl, ruby, sqlite3
  -o                      : output file for refdb2dat (defaults to stdout)
  -archive targdir        : archive runs specified by selectors to targdir using bup

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style
︙
214
215
216
217
218
219
220

221
222
223
224
225
226
227

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229








+








			"-port"
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-setvars"
			"-set-state-status"
			"-set-run-status"
			"-archive"
			"-debug" ;; for *verbosity* > 2
			"-gen-megatest-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"
			"-var"
︙
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256

244
245
246
247
248
249
250

251
252
253
254
255
256
257








-








			"-set-values"
			"-load-test-data"
			"-summarize-items"
		        "-gui"
			"-daemonize"
			"-preclean"
			;; misc
			"-archive"
			"-repl"
			"-lock"
			"-unlock"
			"-list-servers"
                        "-run-wait"      ;; wait on a run to complete (i.e. no RUNNING)

			;; misc queries
︙
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012



1013
1014


1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025

973
974
975
976
977
978
979


































980
981
982


983
984




985
986
987
988
989
990
991
992








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
+
+
-
-
-
-
+








		       paths))))))

;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
    ;; if we are in a test use the MT_CMDINFO data
    (if (getenv "MT_CMDINFO")
	(let* ((startingdir (current-directory))
	       (cmdinfo   (common:read-encoded-string (getenv "MT_CMDINFO")))
	       (transport (assoc/default 'transport cmdinfo))
	       (testpath  (assoc/default 'testpath  cmdinfo))
	       (test-name (assoc/default 'test-name cmdinfo))
	       (runscript (assoc/default 'runscript cmdinfo))
	       (db-host   (assoc/default 'db-host   cmdinfo))
	       (run-id    (assoc/default 'run-id    cmdinfo))
	       (itemdat   (assoc/default 'itemdat   cmdinfo))
	       (state     (args:get-arg ":state"))
	       (status    (args:get-arg ":status"))
	       (target    (args:get-arg "-target")))
	  (change-directory testpath)
	  (if (not target)
	      (begin
		(debug:print 0 "ERROR: -target is required.")
		(exit 1)))
	  (if (not (launch:setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -archive, exiting")
		(exit 1)))
	  (let* ((keys     (rmt:get-keys))
		 (paths    (tests:test-get-paths-matching keys target)))
	    (set! *didsomething* #t)
	    (for-each (lambda (path)
			(print path))
		      paths))
	  ;; (if (sqlite3:database? db)(sqlite3:finalize! db))
	  )
	;; else do a general-run-call
	(general-run-call 
	 "-test-paths"
    ;; else do a general-run-call
    (general-run-call 
     "-archive"
	 "Get paths to tests"
	 (lambda (target runname keys keyvals)
     "Archive"
     (lambda (target runname keys keyvals)
	   (let* ((paths    (tests:test-get-paths-matching keys target)))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))
       (operate-on 'archive))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call
︙

Modified process.scm from [781c177a90] to [ef168a2a0a].

︙
99
100
101
102
103
104
105
106
107




108
109
110
111
112
113
114

99
100
101
102
103
104
105


106
107
108
109
110
111
112
113
114
115
116








-
-
+
+
+
+








            (loop (let ((l (read-line fh)))
                    (if (eof-object? l) l (proc l)))
                  (append result (list curr)))
            result))))

;; here is an example line where the shell is sh or bash
;; "find / -print 2&>1 > findall.log"
(define (run-n-wait cmdline)
  (let ((pid (process-run cmdline)))
(define (run-n-wait cmdline #!key (params #f))
  (let ((pid (if params
		 (process-run cmdline params)
		 (process-run cmdline))))
    (let loop ((i 0))
      (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
         (if (eq? pid-val 0)
	     (begin
	       (thread-sleep! 2)
	       (loop (+ i 1)))
	     (values pid-val exit-status exit-code))))))
︙

Modified runs.scm from [3bd91bccb4] to [08b0760cef].

︙
17
18
19
20
21
22
23

24
25
26
27
28
29
30

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31








+








(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses mt))
(declare (uses archive))
;; (declare (uses filedb))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
︙
1412
1413
1414
1415
1416
1417
1418
1419

1420
1421
1422
1423
1424
1425
1426

1413
1414
1415
1416
1417
1418
1419

1420
1421
1422
1423
1424
1425
1426
1427








-
+








;; fields are passing in through 
;; action:
;;    'remove-runs
;;    'set-state-status
;;
;; NB// should pass in keys?
;;
(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(remove-data-only #f))
(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(remove-data-only #f)(options '()))
  (common:clear-caches) ;; clear all caches
  (let* ((db           #f)
	 (tdbdat       (tasks:open-db))
	 (keys         (rmt:get-keys))
	 (rundat       (mt:get-runs-by-patt keys runnamepatt target))
	 (header       (vector-ref rundat 0))
	 (runs         (vector-ref rundat 1))
︙
1446
1447
1448
1449
1450
1451
1452
1453


1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472






1473
1474



1475
1476
1477
1478
1479
1480
1481

1447
1448
1449
1450
1451
1452
1453

1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492








-
+
+



















+
+
+
+
+
+


+
+
+








							       (else          'event_time))))))
	 (let* ((run-id    (db:get-value-by-header run header "id"))
		(run-state (db:get-value-by-header run header "state"))
		(run-name  (db:get-value-by-header run header "runname"))
		(tests     (if (not (equal? run-state "locked"))
			       (proc-get-tests run-id)
			       '()))
		(lasttpath "/does/not/exist/I/hope"))
		(lasttpath "/does/not/exist/I/hope")
		(worker-thread #f))
	   (debug:print-info 4 "runs:operate-on run=" run ", header=" header)
	   (if (not (null? tests))
	       (begin
		 (case action
		   ((remove-runs)
		    (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
		    ;; seek and kill in flight -runtests with % as testpatt here
		    (if (equal? testpatt "%")
			(tasks:kill-runner target run-name)
			(debug:print 0 "not attempting to kill any run launcher processes as testpatt is " testpatt))
		    (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((set-state-status)
		    (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
		    (debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((print-run)
		    (debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
		    action)
		   ((run-wait)
		    (debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete"))
		   ((archive)
		    (debug:print 1 "Archiving data for run: " runkey " " (db:get-value-by-header run header "runname"))
		    (set! worker-thread (make-thread (lambda ()
						       (archive:run-bup (args:get-arg "-archive") run-name tests))
						     "archive-bup-thread"))
		    (thread-start! worker-thread))
		   (else
		    (debug:print-info 0 "action not recognised " action)))
		 
		 ;; actions that operate on one test at a time can be handled below
		 ;;
		 (let ((sorted-tests     (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr 
									 (db:test-get-rundir a)) ;; )  ;; (filedb:get-path *fdb* (db:test-get-rundir a)))
									(dirb ;; (rmt:sdb-qry 'getstr 
									 (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b))))
								    (if (and (string? dira)(string? dirb))
									(> (string-length dira)(string-length dirb))
									#f)))))
︙
1547
1548
1549
1550
1551
1552
1553
1554







1555
1556
1557
1558
1559
1560
1561

1558
1559
1560
1561
1562
1563
1564

1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578








-
+
+
+
+
+
+
+








				    (loop (car tal)(cdr tal))))
			       ((run-wait)
				(debug:print-info 2 "still waiting, " (length tests) " tests still running")
				(thread-sleep! 10)
				(let ((new-tests (proc-get-tests run-id)))
				  (if (null? new-tests)
				      (debug:print-info 1 "Run completed according to zero tests matching provided criteria.")
				      (loop (car new-tests)(cdr new-tests))))))))
				      (loop (car new-tests)(cdr new-tests)))))
			       ((archive)
				(if (not toplevel-with-children)
				    (begin
				      (debug:print-info 0 "Estimating disk space usage for " test-fulln)
				      (debug:print-info 0 "   " (common:get-disk-space-used run-dir)))))
			       )))
		       )))))
	   ;; remove the run if zero tests remain
	   (if (eq? action 'remove-runs)
	       (let ((remtests (mt:get-tests-for-run (db:get-value-by-header run header "id") #f '("DELETED") '("n/a") not-in: #t)))
		 (if (null? remtests) ;; no more tests remaining
		     (let* ((dparts  (string-split lasttpath "/"))
			    (runpath (conc "/" (string-intersperse
︙

tests/installall/config/megatest.config.dat became a symlink with target [736a5da885].

tests/installall/config/runconfigs.config.dat became a symlink with target [3b8f260acb].

This page was generated in about 0.113s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00