Megatest

Check-in [f78750d901]
Login
Overview
Comment:Appear to have fixed the growing connections issue
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-disconnect-tests
Files: files | file ages | folders
SHA1: f78750d901dccb33b932713162067ae0b4137a29
User & Date: matt on 2023-01-15 21:45:12
Other Links: branch diff | manifest | tags
Context
2023-01-16
03:21
Merged v1.80 Leaf check-in: ccccfdb50a user: matt tags: v1.80-disconnect-tests
2023-01-15
21:45
Appear to have fixed the growing connections issue check-in: f78750d901 user: matt tags: v1.80-disconnect-tests
18:27
Disconnecting tests from servers where possible to save connections. check-in: cdac5f3909 user: matt tags: v1.80-disconnect-tests
Changes

Modified db.scm from [e71eb01cf3] to [ee9b271883].

4650
4651
4652
4653
4654
4655
4656

4657

4658
4659
4660
4661
4662
4663
4664
4650
4651
4652
4653
4654
4655
4656
4657

4658
4659
4660
4661
4662
4663
4664
4665







+
-
+







					  (sqlite3:finalize! db #t)
					  ;; (vector-set! *task-db* 0 #f)
					  (set! *task-db* #f)))))
			      (if (and (not (args:get-arg "-server"))
				       *runremote*)
				  (begin
				    (debug:print-info 0 *default-log-port* "Closing all client connections...")
				    (http-transport:close-connections *runremote*)
				    (http-client#close-all-connections!)))
				    #;(http-client#close-all-connections!)))
                              ;; (if (and *runremote*
                              ;;          (remote-conndat *runremote*))
                              ;;     (begin
                              ;;       (http-client#close-all-connections!))) ;; for http-client
                              (if (not (eq? *default-log-port* (current-error-port)))
                                  (close-output-port *default-log-port*))
			      (set! *default-log-port* (current-error-port))) "Cleanup db exit thread"))

Modified http-transport.scm from [4037b30aac] to [01e370881e].

294
295
296
297
298
299
300
301


302
303
304
305
306
307
308
294
295
296
297
298
299
300

301
302
303
304
305
306
307
308
309







-
+
+







						;;    (remote-conndat-set! runremote #f))
						;; Killing associated server to allow clean retry.")
						;; (tasks:kill-server-run-id run-id)  ;; better to kill the server in the logic that called this routine?
						(mutex-unlock! *http-mutex*)
						;; (signal (make-composite-condition
						;;          (make-property-condition 'commfail 'message "failed to connect to server")))
						;; "communications failed"
						(close-all-connections!)
						;; (close-all-connections!)
						(close-connection! fullurl)
						(db:obj->string #f))
					      (with-input-from-request ;; was dat
					       fullurl 
					       (list (cons 'key (or server-id   "thekey"))
						     (cons 'cmd cmd)
						     (cons 'params sparams))
					       read-string))
355
356
357
358
359
360
361


362
363

364
365
366
367
368
369
370
356
357
358
359
360
361
362
363
364
365

366
367
368
369
370
371
372
373







+
+

-
+







    (if (vector? server-dat)
	(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
	  (handle-exceptions
	    exn
	    (begin
	      (print-call-chain *default-log-port*)
	      (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
	    (if (args:any-defined? "-server" "-execute" "-run")
		(debug:print-info 0 *default-log-port* "Closing connections to "api-dat))
	    (close-connection! api-dat)
            (close-idle-connections!)
	    (close-connection! (http-transport:server-dat-make-url server-dat))
	    (remote-conndat-set! runremote #f)
	    #t))
	#f)))


(define (make-http-transport:server-dat)(make-vector 6))
(define (http-transport:server-dat-get-iface         vec)    (vector-ref  vec 0))

Modified rmt.scm from [53cc395259] to [c1074b692d].

40
41
42
43
44
45
46
47

48
49

50
51
52
53
54
55
56
40
41
42
43
44
45
46

47


48
49
50
51
52
53
54
55







-
+
-
-
+







;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================

;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info areapath #!key (area-dat #f)) ;; TODO: push areapath down.
(define (rmt:get-connection-info areapath runremote) ;; TODO: push areapath down.
  (let* ((runremote (or area-dat *runremote*))
	 (cinfo     (if (remote? runremote)
  (let* ((cinfo     (if (remote? runremote)
			(remote-conndat runremote)
			#f)))
	  (if cinfo
	      cinfo
	      (if (server:check-if-running areapath)
		  (client:setup areapath)
		  #f))))
260
261
262
263
264
265
266
267

268
269
270
271
272
273
274
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273







-
+







	       (not (remote-conndat runremote)))
	  (and (not (cdr (remote-hh-dat runremote)))        ;; not on a homehost 
	       (not (remote-conndat runremote))))           ;; and no connection
      (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9, hh-dat: " (remote-hh-dat runremote) " conndat: " (remote-conndat runremote))
      (mutex-unlock! *rmt-mutex*)
      (if (not (server:check-if-running *toppath*)) ;; who knows, maybe one has started up?
	  (server:start-and-wait *toppath*))
      (remote-conndat-set! runremote (rmt:get-connection-info *toppath*)) ;; calls client:setup which calls client:setup-http
      (remote-conndat-set! runremote (rmt:get-connection-info *toppath* runremote)) ;; calls client:setup which calls client:setup-http
      (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; TODO: add back-off timeout as

     ;;DOT CASE10 [label="on homehost"];
     ;;DOT MUTEXLOCK -> CASE10 [label="server not required,\non homehost"]; {rank=same "case 10" CASE10};
     ;;DOT CASE10 -> "rmt:open-qry-close-locally";
     ;; all set up if get this far, dispatch the query
     ((and (not (remote-force-server runremote))