Megatest

Check-in [85f3eeb353]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Reordered logic in tt:client-connect-to-server, changed sleep after starting server from 3 to 6 seconds.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-revolution
Files: files | file ages | folders
SHA1: 85f3eeb353bbd025d208402eac0e62023b10e7eb
User & Date: mmgraham on 2024-01-22 11:15:53
Other Links: branch diff | manifest | tags
Context
2024-01-23
11:24
Cleaned up couple duplicated functions. check-in: c616c43313 user: mrwellan tags: v1.80-revolution
2024-01-22
11:15
Reordered logic in tt:client-connect-to-server, changed sleep after starting server from 3 to 6 seconds. check-in: 85f3eeb353 user: mmgraham tags: v1.80-revolution
2024-01-19
22:10
guarded against empty run name and no target selected in Run Control. check-in: 3947694200 user: mmgraham tags: v1.80-revolution
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified tcp-transportmod.scm from [074453490b] to [312708d26e].

︙︙
175
176
177
178
179
180
181


182
183
184
185

186
187
188
189
190
191
192
193

				   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
			   port: port








>
>
|



>
|








175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196

				   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

	;; no conn
        (let* ((sdats (tt:get-server-info-sorted ttdat dbfname))
	       (sdat  (if (null? sdats)
			  #f
			  (car sdats))))
	   (debug:print-info 2 *default-log-port* "found sdat " sdat)
           (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
			   port: port
︙︙
209
210
211
212
213
214
215
216

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

229
230
231
232

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249

		    conn)
		   ((starting)
		    (thread-sleep! 0.5)
                    (debug:print-info 0 *default-log-port* "server for " dbfname " is in starting state, retrying connect")
		    (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc))
		   (else
		    (let* ((curr-secs (current-seconds)))
		      (if (not ping-res) ;; the server is actually dead, remove the .servinfo file

			  (begin
			    (debug:print-info 0 *default-log-port* "Unreachable server at "
					      host":"port" with servinfo file "servinffile", removing it")
			    (if (file-exists? servinffile)
				(handle-exceptions
				 exn
				 #f
				 (delete-file servinffile)))))
		      ;; rm the (last server) would go here
		      (if (> (- curr-secs (tt-last-serv-start ttdat)) 10)
			  (begin
			    (tt-last-serv-start-set! ttdat curr-secs)

			    (server-start-proc))) ;; start server if 10 sec since last attempt
		      (thread-sleep! 1)
                      (debug:print-info 0 *default-log-port* "server ping result was "ping-res" neither running nor starting. Retrying connect")
		      (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc)))))))

	    (else ;; no good server found, if haven't started server in > 5 secs, start another
	     (if (> (- (current-seconds) (tt-last-serv-start ttdat)) 3) ;; BUG - grow this number really do not want to swamp the machine with servers
		 (begin
		   (debug:print-info 0 *default-log-port* "Starting server for "dbfname)
		   (server-start-proc)
		   (tt-last-serv-start-set! ttdat (current-seconds))
                   (thread-sleep! 3)
                   ))
	     (thread-sleep! 1)
             (debug:print-info 0 *default-log-port* "Connect to server for " dbfname)
	     (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc)))))))

;; returns ( result . ping_time )
(define (tt:timed-ping host port server-id)
  (let* ((start-time (current-milliseconds))
	 (result     (tt:ping host port server-id)))
    (cons result (- (current-milliseconds) start-time))))








|
>







|
<
<
<

>


|

>



|


|


|








212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228



229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252

		    conn)
		   ((starting)
		    (thread-sleep! 0.5)
                    (debug:print-info 0 *default-log-port* "server for " dbfname " is in starting state, retrying connect")
		    (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc))
		   (else
		    (let* ((curr-secs (current-seconds)))
		      ;; rm the (last server) would go here
		      (if (> (- curr-secs (tt-last-serv-start ttdat)) 10)
			  (begin
			    (debug:print-info 0 *default-log-port* "Unreachable server at "
					      host":"port" with servinfo file "servinffile", removing it")
			    (if (file-exists? servinffile)
				(handle-exceptions
				 exn
				 #f
				 (delete-file servinffile)))



			    (tt-last-serv-start-set! ttdat curr-secs)
                            (debug:print-info 0 *default-log-port* "Starting a new server on " (get-host-name))
			    (server-start-proc))) ;; start server if 10 sec since last attempt
		      (thread-sleep! 1)
                      (debug:print-info 0 *default-log-port* "Retrying connect")
		      (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc)))))))

	    (else ;; no good server found, if haven't started server in > 5 secs, start another
	     (if (> (- (current-seconds) (tt-last-serv-start ttdat)) 3) ;; BUG - grow this number really do not want to swamp the machine with servers
		 (begin
		   (debug:print-info 0 *default-log-port* "Starting server for "dbfname " on " (get-host-name))
		   (server-start-proc)
		   (tt-last-serv-start-set! ttdat (current-seconds))
                   (thread-sleep! 6)
                   ))
	     (thread-sleep! 1)
             (debug:print-info 0 *default-log-port* "Connect to server from " (get-host-name) " for " dbfname)
	     (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc)))))))

;; returns ( result . ping_time )
(define (tt:timed-ping host port server-id)
  (let* ((start-time (current-milliseconds))
	 (result     (tt:ping host port server-id)))
    (cons result (- (current-milliseconds) start-time))))
︙︙
588
589
590
591
592
593
594

595
596
597
598
599
600
601

		      (thread-sleep! 0.25)
		      (loop (+ count 1)))
		    (begin
		      (debug:print 0 *default-log-port* "ERROR: (tt-port ttdat) no port set! Exiting.")
		      (exit)))))
	  
	  ;; create a servinfo file start keep-running

	  (tt:create-server-registration-file ttdat dbfname)
	  (procinf-status-set! *procinf* "running")
	  (tt-state-set! ttdat 'running)
	  (dbfile:with-no-sync-db
	   nosyncdbpath
	   (lambda (nsdb)
	     (dbfile:insert-or-update-process nsdb *procinf*)))








>








591
592
593
594
595
596
597
598
599
600
601
602
603
604
605

		      (thread-sleep! 0.25)
		      (loop (+ count 1)))
		    (begin
		      (debug:print 0 *default-log-port* "ERROR: (tt-port ttdat) no port set! Exiting.")
		      (exit)))))
	  
	  ;; create a servinfo file start keep-running
          (debug:print 0 *default-log-port* "Creating servinfo file for " dbfname)
	  (tt:create-server-registration-file ttdat dbfname)
	  (procinf-status-set! *procinf* "running")
	  (tt-state-set! ttdat 'running)
	  (dbfile:with-no-sync-db
	   nosyncdbpath
	   (lambda (nsdb)
	     (dbfile:insert-or-update-process nsdb *procinf*)))
︙︙
902
903
904
905
906
907
908

909
910
911
912
913
914
915


916


917
918
919
920
921
922
923

;; 	 (setup-listener uconn (+ port 1)))
;;        #f)
;;    (connect-listener uconn port)))

(define (setup-listener-portlogger uconn)
  (let ((port (portlogger:open-run-close portlogger:find-port)))
    (assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn)

    (handle-exceptions
	exn
      (if (< port 65535)
	  (begin
	    (portlogger:open-run-close portlogger:set-failed port)
	    (thread-sleep! 0.25)
	    (setup-listener-portlogger uconn))


	  #f)


      (connect-listener uconn port))))

(define (connect-listener uconn port)
  ;; (tcp-listener-socket LISTENER)(socket-name so)
  ;; sockaddr-address, sockaddr-port, sockaddr->string
  (let* ((tlsn (tcp-listen port 10000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
	 (addr  (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))








>







>
>
|
>
>








906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932

;; 	 (setup-listener uconn (+ port 1)))
;;        #f)
;;    (connect-listener uconn port)))

(define (setup-listener-portlogger uconn)
  (let ((port (portlogger:open-run-close portlogger:find-port)))
    (assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn)
    (debug:print 2 *default-log-port* "setup-listener-portlogger got port " port)
    (handle-exceptions
	exn
      (if (< port 65535)
	  (begin
	    (portlogger:open-run-close portlogger:set-failed port)
	    (thread-sleep! 0.25)
	    (setup-listener-portlogger uconn))
          (begin
            (debug:print 0 *default-log-port* "setup-listener-portlogger: could not get a port")
	    #f
          )
      )
      (connect-listener uconn port))))

(define (connect-listener uconn port)
  ;; (tcp-listener-socket LISTENER)(socket-name so)
  ;; sockaddr-address, sockaddr-port, sockaddr->string
  (let* ((tlsn (tcp-listen port 10000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
	 (addr  (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
︙︙

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