Megatest

Changes On Branch v1.70-nohome-00
Login

Changes In Branch v1.70-nohome-00 Excluding Merge-Ins

This is equivalent to a diff from ba39e7edd8 to 3b3dbdec4b

2022-07-14
10:31
updated mt-old-to-new.sh to fix the wrap arround check-in: 3d09b9433e user: pjhatwal tags: v1.70
2022-06-27
11:34
Migrate to ck5 (again) check-in: da6fbf9f56 user: matt tags: v1.70-ck5
09:00
Merged forward the beginnings of nohome Closed-Leaf check-in: 3b3dbdec4b user: matt tags: v1.70-nohome-00
2022-06-13
19:25
Changed megatest version to v1.7004 check-in: ba39e7edd8 user: mmgraham tags: v1.70, v1.7004
17:44
Got pgdb sync working by querying for test related data in the correct dbs, passing the test ids, test_step ids and test_data ids as pairs with the run-id, and adding run-id to a few test data query functions. check-in: 6fb02466de user: mmgraham tags: v1.70

Modified TODO from [da5eae4898] to [539b258f86].

14
15
16
17
18
19
20





































21
22
23
24
25
26
27
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

TODO
====






































WW15
. fill newview matrix with data, filter pipeline gui elements
. improve [script], especially indent handling

WW16
. split db into megatest.db (runs etc.) db/<something>.db
. release basic newview implementation







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







14
15
16
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
53
54
55
56
57
58
59
60
61
62
63
64
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

TODO
====

No-homehost
-----------

Server side

    1. Add invocation type to -m [DONE]
    
    2. Switch starting of servers to look at .homehost, if it exists, respect it,
       otherwise start on current machine. [DONE]
       
    3. On start server drops a packet into .meta after starting the http server,
       pkt includes:
        a. host
        b. port
        c. Invocation type of process that started the server
        d. D card (packet create card)
        e. Process id of the server process
	
    4. Server will stay alive if it receives calls
    
    5. Server touches the pkt file every ten seconds
    
    6. On exiting the server removes its pkt file
    
Client side

    1. If no pkts in .meta start a server, wait 5-10 seconds and look again
    
    2. Read all pkts in .meta dir
    
    3. Sort servers by (take left most)
        a. Invocation type: dboard -> runner -> other -> exec
        b. Run duration: shortest -> longest
        c. Tie breaker is the shar1 hash for the pkt
	
    4. Ping the server and continue as before
    
WW15
. fill newview matrix with data, filter pipeline gui elements
. improve [script], especially indent handling

WW16
. split db into megatest.db (runs etc.) db/<something>.db
. release basic newview implementation

Modified common.scm from [a70e001edf] to [b19cd08c9c].

957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
  (message-digest-string (md5-primitive) str))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (common:run-sync?)
    (and (common:on-homehost?)
	 (args:get-arg "-server")))

(define (common:human-time)
  (time->string (seconds->local-time (current-seconds)) "%Y-%m-%d %H:%M:%S"))


(define (std-signal-handler signum)







|







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
  (message-digest-string (md5-primitive) str))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (common:run-sync?)
    (and (common:on-homehost?) ;; huh? isn't this by definition both true?
	 (args:get-arg "-server")))

(define (common:human-time)
  (time->string (seconds->local-time (current-seconds)) "%Y-%m-%d %H:%M:%S"))


(define (std-signal-handler signum)
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294

1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307



1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
      (if (and (getenv "MT_ITEMPATH")
               (not (equal? (getenv "MT_ITEMPATH") "")))
          (getenv "MT_TEST_NAME")
          (conc (getenv "MT_TEST_NAME") "/" (getenv "MT_ITEMPATH")))
      #f))

;;======================================================================
;; logic for getting homehost. Returns (host . at-home)
;; IF *toppath* is not set, wait up to five seconds trying every two seconds
;; (this is to accomodate the watchdog)
;;
(define (common:get-homehost #!key (trynum 5))
  ;; called often especially at start up. use mutex to eliminate collisions

  (mutex-lock! *homehost-mutex*)
  (cond
   (*home-host*
    (mutex-unlock! *homehost-mutex*)
    *home-host*)
   ((not *toppath*)
    (mutex-unlock! *homehost-mutex*)
    (launch:setup) ;; safely mutexed now
    (if (> trynum 0)
	(begin
	  (thread-sleep! 2)
	  (common:get-homehost trynum: (- trynum 1)))
	#f))



   (else
    (let* ((currhost (get-host-name))
	   (bestadrs (server:get-best-guess-address currhost))
	   ;; first look in config, then look in file .homehost, create it if not found
	   (homehost (or (configf:lookup *configdat* "server" "homehost" )
			 (handle-exceptions
			     exn
			     (if (> trynum 0)
				 (let ((delay-time (* (- 5 trynum) 5)))
				   (mutex-unlock! *homehost-mutex*)
				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying "
						delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn)
						", exn=" exn)
				   (thread-sleep! delay-time)
				   (common:get-homehost trynum: (- trynum 1)))
				 (begin
				   (mutex-unlock! *homehost-mutex*)
				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)
						"] Failed to read .homehost file after trying five times. Giving up and exiting, message: "
						((condition-property-accessor 'exn 'message) exn))
				   (exit 1)))
			   (let ((hhf (conc *toppath* "/.homehost")))
			     (if (common:file-exists? hhf)
				 (with-input-from-file hhf read-line)
				 (if (file-write-access? *toppath*)
				     (begin
				       (with-output-to-file hhf
					 (lambda ()
					   (print bestadrs)))
				       (begin
					 (mutex-unlock! *homehost-mutex*)
					 (car (common:get-homehost))))
				     #f))))))
	   (at-home  (or (equal? homehost currhost)
			 (equal? homehost bestadrs))))
      (set! *home-host* (cons homehost at-home))
      (mutex-unlock! *homehost-mutex*)
      *home-host*))))

;;======================================================================
;; am I on the homehost?
;;
(define (common:on-homehost?)
  (let ((hh (common:get-homehost)))
    (if hh







|





>
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<










|
|
|
|
|
|







1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332

1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
      (if (and (getenv "MT_ITEMPATH")
               (not (equal? (getenv "MT_ITEMPATH") "")))
          (getenv "MT_TEST_NAME")
          (conc (getenv "MT_TEST_NAME") "/" (getenv "MT_ITEMPATH")))
      #f))

;;======================================================================
;; logic for getting homehost . Returns (host . at-home)
;; IF *toppath* is not set, wait up to five seconds trying every two seconds
;; (this is to accomodate the watchdog)
;;
(define (common:get-homehost #!key (trynum 5))
  ;; called often especially at start up. use mutex to eliminate collisions
  (let ((hhf (conc *toppath* "/.homehost")))
    (mutex-lock! *homehost-mutex*)
    (cond
     (*home-host*
      (mutex-unlock! *homehost-mutex*)
      *home-host*)
     ((not *toppath*)
      (mutex-unlock! *homehost-mutex*)
      (launch:setup) ;; safely mutexed now
      (if (> trynum 0)
	  (begin
	    (thread-sleep! 2)
	    (common:get-homehost trynum: (- trynum 1)))
	  `(#f . #f)))
     #;((and (configf:lookup *configdat* "server" "no-homehost")
	   (not (file-exists? hhf)))
      `(#f . #f))  ;; NEW METHOD, DO NOT USE A HOMEHOST - nope, not doing it this way.
     (else
      (let* ((currhost (get-host-name))
	     (bestadrs (server:get-best-guess-address currhost))
	     ;; first look in config, then look in file .homehost, create it if not found
	     (homehost (or (configf:lookup *configdat* "server" "homehost" )
			   (handle-exceptions
			       exn
			       (if (> trynum 0)
				   (let ((delay-time (* (- 5 trynum) 5)))
				     (mutex-unlock! *homehost-mutex*)
				     (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying "
						  delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn)
						  ", exn=" exn)
				     (thread-sleep! delay-time)
				     (common:get-homehost trynum: (- trynum 1)))
				   (begin
				     (mutex-unlock! *homehost-mutex*)
				     (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)
						  "] Failed to read .homehost file after trying five times. Giving up and exiting, message: "
						  ((condition-property-accessor 'exn 'message) exn))
				     (exit 1)))

			     (if (common:file-exists? hhf)
				 (with-input-from-file hhf read-line)
				 (if (file-write-access? *toppath*)
				     (begin
				       (with-output-to-file hhf
					 (lambda ()
					   (print bestadrs)))
				       (begin
					 (mutex-unlock! *homehost-mutex*)
					 (car (common:get-homehost))))
				     `(#f . #f))))))
	     (at-home  (or (equal? homehost currhost)
			   (equal? homehost bestadrs))))
	(set! *home-host* (cons homehost at-home))
	(mutex-unlock! *homehost-mutex*)
	*home-host*)))))

;;======================================================================
;; am I on the homehost?
;;
(define (common:on-homehost?)
  (let ((hh (common:get-homehost)))
    (if hh