Megatest

Check-in [3b3dbdec4b]
Login
Overview
Comment:Merged forward the beginnings of nohome
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.70-nohome
Files: files | file ages | folders
SHA1: 3b3dbdec4bed4d302b6771a35d599c96ecfd9749
User & Date: matt on 2022-06-27 09:00:52
Other Links: branch diff | manifest | tags
Context
2022-06-27
09:00
Merged forward the beginnings of nohome Leaf check-in: 3b3dbdec4b user: matt tags: v1.70-nohome
2022-06-13
19:25
Changed megatest version to v1.7004 check-in: ba39e7edd8 user: mmgraham tags: v1.70, v1.7004
Changes

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