Megatest

Check-in [8a1f055698]
Login
Overview
Comment:Start all servers (rebased)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.80-start-all
Files: files | file ages | folders
SHA1: 8a1f05569815c0e9a203e9b8b0ca086670a9b0dd
User & Date: matt on 2023-11-06 03:22:57
Other Links: branch diff | manifest | tags
Context
2023-11-06
03:22
Start all servers (rebased) Leaf check-in: 8a1f055698 user: matt tags: v1.80-start-all
2023-11-01
14:26
Changed megatest version to 1.8019 Leaf check-in: 8e5977eca9 user: icfadm tags: v1.80, v1.8019
2023-10-20
04:57
Merged fork check-in: 53900a0d02 user: mrwellan tags: v1.80-start-all
Changes

Modified api.scm from [13a08c65d1] to [47ba07ff8b].

310
311
312
313
314
315
316


317
318
319
320





















321
322
323
324
325
326
327
	   (set! *api-process-request-count* (- *api-process-request-count* 1))
	   ;; (serialize payload)
	   (api:unregister-thread (current-thread))
	   payload))
	(else
	 (assert #f "FATAL: failed to deserialize indat "indat))))))
       



(define (api:dispatch-request dbstruct cmd run-id params)
  (if (not *no-sync-db*)
      (db:open-no-sync-db))





















  (case cmd
    ;;===============================================
    ;; READ/WRITE QUERIES
    ;;===============================================

    ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
    







>
>


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







310
311
312
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
	   (set! *api-process-request-count* (- *api-process-request-count* 1))
	   ;; (serialize payload)
	   (api:unregister-thread (current-thread))
	   payload))
	(else
	 (assert #f "FATAL: failed to deserialize indat "indat))))))
       
(define *last-refresh-of-dbs* 0)
(define *db-starts-running* #f)

(define (api:dispatch-request dbstruct cmd run-id params)
  (if (not *no-sync-db*)(db:open-no-sync-db))

  (thread-start!
   (make-thread
    (lambda ()
      (if (and (not *db-starts-running*)
	       (not run-id) ;; i.e. we are mainl.db
	       (> (- (current-seconds) *last-refresh-of-dbs*) 20))
	  (set! *db-starts-running* #t)
	  (let loop ((dbnum 10))
	    (let* ((dbname     (conc dbnum".db")) ;; Yes, this is correct, use dbnum directly
		   (candidates (dbfile:get-process-options *no-sync-db* "server" dbname)))
	      (if (null? candidates)
		  ;; start a server for this dbfile
		  (tt:server-process-run
		   *toppath*
		   (common:get-testsuite-name)
		   (common:find-local-megatest)
		   dbname)))
	    (thread-sleep! 0.5)
	    (if (> dbnum 0)(loop (- dbnum 1)))
	    (set! *db-starts-running* #f)
	    (set! *last-refresh-of-dbs* (current-seconds)))))))
  (case cmd
    ;;===============================================
    ;; READ/WRITE QUERIES
    ;;===============================================

    ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
    

Modified dbfile.scm from [5eebf6582a] to [6840895eab].

579
580
581
582
583
584
585

586
587
588
589
590
591
592
(define (dbfile:register-process nsdb host port pid starttime endtime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,endtime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?,?);"
		   host port pid starttime endtime status purpose dbname mtversion))

(define (dbfile:set-process-status nsdb host pid newstatus)
  (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid))


(define (dbfile:get-process-options nsdb purpose dbname)
  (sqlite3:fold-row
   ;; host port pid starttime status mtversion
   (lambda (res . row)
     (cons row res))
   '()
   nsdb







>







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
(define (dbfile:register-process nsdb host port pid starttime endtime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,endtime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?,?);"
		   host port pid starttime endtime status purpose dbname mtversion))

(define (dbfile:set-process-status nsdb host pid newstatus)
  (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid))

;; get list of process records to examine for suitabliity of connecting to
(define (dbfile:get-process-options nsdb purpose dbname)
  (sqlite3:fold-row
   ;; host port pid starttime status mtversion
   (lambda (res . row)
     (cons row res))
   '()
   nsdb

Modified tcp-transportmod.scm from [157488cd36] to [a77f008f86].

137
138
139
140
141
142
143

144
145
146
147
148
149
150
151
  (debug:print-info 2 *default-log-port* "tt:client-connect-to-server " dbfname " " run-id)
  (let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f))
	 (server-start-proc (lambda ()
			      (tt:server-process-run
			       (tt-areapath ttdat)
			       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* ((sdat (tt:get-current-server-info ttdat dbfname)))
	  (match sdat
	    ((host port start-time server-id pid dbfname2 servinffile)







>
|







137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
  (debug:print-info 2 *default-log-port* "tt:client-connect-to-server " dbfname " " run-id)
  (let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f))
	 (server-start-proc (lambda ()
			      (tt:server-process-run
			       (tt-areapath ttdat)
			       testsuite ;; (dbfile:testsuite-name)
			       (common:find-local-megatest)
			       dbfname ;; 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* ((sdat (tt:get-current-server-info ttdat dbfname)))
	  (match sdat
	    ((host port start-time server-id pid dbfname2 servinffile)
783
784
785
786
787
788
789
790


791
792
793
794
795
796
797
798
799
800
801
802
		      bad-dat)))))))))

;; Given an area path,  start a server process    ### NOTE ### > file 2>&1 
;; if the target-host is set 
;; try running on that host
;;   incidental: rotate logs in logs/ dir.
;;
(define  (tt:server-process-run areapath testsuite mtexe run-id #!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area


  (assert areapath  "FATAL: tt:server-process-run called without areapath defined.")
  (assert testsuite "FATAL: tt:server-process-run called without testsuite defined.")
  (assert mtexe     "FATAL: tt:server-process-run called without mtexe defined.")
  ;; mtest -server - -m testsuite:ext-tests -db 6.db
  (let* ((dbfname  (dbmod:run-id->dbfname run-id))
	 (load     (get-normalized-cpu-load))
	 (trying   (length (tt:find-server areapath dbfname)))
	 (nrun     (number-of-processes-running (conc "mtest.*server.*"testsuite".*"dbfname))))
    (cond
     ((> load 2.0)
      (debug:print 0 *default-log-port* "Normalized load "load" on " (get-host-name) " is over the limit of 2.0. Not starting a server.")
      (thread-sleep! 1))







|
>
>




|







784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
		      bad-dat)))))))))

;; Given an area path,  start a server process    ### NOTE ### > file 2>&1 
;; if the target-host is set 
;; try running on that host
;;   incidental: rotate logs in logs/ dir.
;;
(define  (tt:server-process-run areapath testsuite mtexe
				dbfname ;; run-id
				#!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area
  (assert areapath  "FATAL: tt:server-process-run called without areapath defined.")
  (assert testsuite "FATAL: tt:server-process-run called without testsuite defined.")
  (assert mtexe     "FATAL: tt:server-process-run called without mtexe defined.")
  ;; mtest -server - -m testsuite:ext-tests -db 6.db
  (let* (;; (dbfname  (dbmod:run-id->dbfname run-id))
	 (load     (get-normalized-cpu-load))
	 (trying   (length (tt:find-server areapath dbfname)))
	 (nrun     (number-of-processes-running (conc "mtest.*server.*"testsuite".*"dbfname))))
    (cond
     ((> load 2.0)
      (debug:print 0 *default-log-port* "Normalized load "load" on " (get-host-name) " is over the limit of 2.0. Not starting a server.")
      (thread-sleep! 1))