Megatest

Diff
Login

Differences From Artifact [5cef09f36d]:

To Artifact [108f76cedd]:


149
150
151
152
153
154
155
156
157
158
159

160
161
162
163
164
165
166
				   testsuite ;; (dbfile:testsuite-name)
				   (common:find-local-megatest)
				   run-id)))))
    (if conn
	(begin 
          (debug:print-info 2 *default-log-port* "already connected to a server")
           conn) ;; we are already connected to the server
	(let* ((sdats (tt:get-server-info-sorted ttdat dbfname))
	       (sdat  (if (null? sdats)
			  #f
			  (car sdats))))

	  (match sdat
	    ((host port start-time server-id pid dbfname2 servinffile)
	     (assert (equal? dbfname dbfname2) "FATAL: read server info from wrong file.")
             (debug:print-info 2 *default-log-port* "no conn - in match servinffile:" servinffile)
	     (let* ((host-port (conc host":"port))
		    (conn (make-tt-conn
			   host: host







|
|
|
|
>







149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
				   testsuite ;; (dbfile:testsuite-name)
				   (common:find-local-megatest)
				   run-id)))))
    (if conn
	(begin 
          (debug:print-info 2 *default-log-port* "already connected to a server")
           conn) ;; we are already connected to the server
	(let* (;; (sdats (tt:get-server-info-sorted ttdat dbfname))
	       ;; (sdat  (if (null? sdats)
	       ;;	  #f
	       ;;	  (car sdats))))
	       (sdat (tt:get-valid-server-random ttdat dbfname)))
	  (match sdat
	    ((host port start-time server-id pid dbfname2 servinffile)
	     (assert (equal? dbfname dbfname2) "FATAL: read server info from wrong file.")
             (debug:print-info 2 *default-log-port* "no conn - in match servinffile:" servinffile)
	     (let* ((host-port (conc host":"port))
		    (conn (make-tt-conn
			   host: host
347
348
349
350
351
352
353
354



















355
356
357
358
359
360
361
     (lambda (rec)
       (if (or (> (length sorted) 1)
	       (common:low-noise-print 120 "server info sorted"))
	   (debug:print 2 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", ")))
       (set! count (+ count 1)))
     sorted)
    sorted))
    



















(define (tt:send-receive ttdat conn cmd run-id params)
  (let* ((host-port (tt-conn-host-port conn)) ;; (conc (tt-conn-host conn)":"(tt-conn-port conn)))
	 (host      (tt-conn-host conn))
	 (port      (tt-conn-port conn))
	 (dat       (list cmd run-id params #f))) ;; no meta data yet
    (tt:send-receive-direct host port dat)))








|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
     (lambda (rec)
       (if (or (> (length sorted) 1)
	       (common:low-noise-print 120 "server info sorted"))
	   (debug:print 2 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", ")))
       (set! count (+ count 1)))
     sorted)
    sorted))

(define (tt:get-valid-server-random ttdat dbfname)
  (let* ((candidates (tt:get-server-info-sorted ttdat dbfname))
	 (numc       (length candidates)))
    (case numc
      ((0) #f)
      ((1) (car candidates))
      (else
       (let* ((firsthost        (caar candidates))
	      (valid-candidates (filter (lambda (x)(equal? (car x) firsthost)) candidates))
	      (numvalid         (length valid-candidates)))
	 (case numvalid
	   ((0) (debug:print 0 *default-log-port* "ERROR: code issue, filter broke?") #f)
	   ((1) (car valid-candidates))
	   (else
	    ;; expand logic here to support more than two servers
	    (if (> (random 100) 50)
		(car valid-candidates)
		(cadr valid-candidates)))))))))
   
(define (tt:send-receive ttdat conn cmd run-id params)
  (let* ((host-port (tt-conn-host-port conn)) ;; (conc (tt-conn-host conn)":"(tt-conn-port conn)))
	 (host      (tt-conn-host conn))
	 (port      (tt-conn-port conn))
	 (dat       (list cmd run-id params #f))) ;; no meta data yet
    (tt:send-receive-direct host port dat)))

500
501
502
503
504
505
506



507

508
509
510
511
512
513
514
515
		;; contact servers via ping, if no response remove the .servinfo file
		(let loop ((servrs     servers)
			   (prime-host #f)
			   (result    '()))
		  (if (null? servrs)
		      (reverse result)
		      (let* ((servdat (car servrs)))



			(match servdat

			     ((host port startseconds server-id servinfofile)
			      (let* ((ping-res  (tt:timed-ping host port server-id))
				     (good-ping (match ping-res
						   ((result . ping-time)
						    (not result)) ;; we couldn't reach the server or it was not a megatest server
						   (else #f))) ;; the ping failed completely?
				     (same-host (or (not prime-host) ;; i.e. this is the first host
						    (equal? prime-host host)))







>
>
>

>
|







520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
		;; contact servers via ping, if no response remove the .servinfo file
		(let loop ((servrs     servers)
			   (prime-host #f)
			   (result    '()))
		  (if (null? servrs)
		      (reverse result)
		      (let* ((servdat (car servrs)))
	;;; INFO: (0) 23:08:10 ERROR: bad servinfo record
	;;; "(127.0.1.1 36797 1701662813.0 88fff570fa3996d6082df8a1875e6cb1 15462 6.db /home/matt/data/megatest/ext-tests/sixtyfivek/.servinfo/127.0.1.1:36797-15462:6.db)"
			     
			(match servdat
			  ;; host port startt server-id pid dbfname servinffilr
			  ((host port startseconds server-id pid dbfname servinfofile)
			      (let* ((ping-res  (tt:timed-ping host port server-id))
				     (good-ping (match ping-res
						   ((result . ping-time)
						    (not result)) ;; we couldn't reach the server or it was not a megatest server
						   (else #f))) ;; the ping failed completely?
				     (same-host (or (not prime-host) ;; i.e. this is the first host
						    (equal? prime-host host)))