Megatest

Check-in [a128117bd7]
Login
Overview
Comment:Purge connections that haven't been used in 60 seconds - they might have idled out
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: a128117bd7301277dea70bc07d7fdf863bc7b2a9
User & Date: matt on 2014-10-20 18:02:53
Other Links: branch diff | manifest | tags
Context
2014-10-20
21:46
Couple corrections to client discarding of connections logic check-in: d75d0889de user: matt tags: v1.60
18:02
Purge connections that haven't been used in 60 seconds - they might have idled out check-in: a128117bd7 user: matt tags: v1.60
15:32
Gracefully deal with cases where the tasks line does not have the host/pid of the running task check-in: ee38bc3f41 user: mrwellan tags: v1.60
Changes

Modified http-transport.scm from [9b05b6d402] to [4d3ec2350a].

305
306
307
308
309
310
311

312
313
314
315
316
317
318
319
320



321
322
323
324
325
326
327
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331







+









+
+
+








(define (make-http-transport:server-dat)(make-vector 5))
(define (http-transport:server-dat-get-iface         vec)    (vector-ref  vec 0))
(define (http-transport:server-dat-get-port          vec)    (vector-ref  vec 1))
(define (http-transport:server-dat-get-api-uri       vec)    (vector-ref  vec 2))
(define (http-transport:server-dat-get-api-url       vec)    (vector-ref  vec 3))
(define (http-transport:server-dat-get-api-req       vec)    (vector-ref  vec 4))
(define (http-transport:server-dat-get-last-access   vec)    (vector-ref  vec 5))

(define (http-transport:server-dat-make-url vec)
  (if (and (http-transport:server-dat-get-iface vec)
	   (http-transport:server-dat-get-port  vec))
      (conc "http://" 
	    (http-transport:server-dat-get-iface vec)
	    ":"
	    (http-transport:server-dat-get-port  vec))
      #f))

(define (http-transport:server-dat-update-last-access vec)
  (vector-set! vec 5 (current-seconds)))

;;
;; connect
;;
(define (http-transport:client-connect iface port)
  (let* ((api-url      (conc "http://" iface ":" port "/api"))
	 (api-uri      (uri-reference (conc "http://" iface ":" port "/api")))

Modified rmt.scm from [e9f97710c6] to [e0cf83e1e8].

55
56
57
58
59
60
61










62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94







+
+
+
+
+
+
+
+
+
+















+







	       #t)
	     #f))))

;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(define (rmt:send-receive cmd rid params)
  ;; clean out old connections
  (let ((expire-time (- (current-seconds) 60)))
    (for-each 
     (lambda (run-id)
       (let ((connection (hash-table-ref *runremote* run-id)))
	 (if (> (http-transport:server-dat-get-last-access connection) expire-time)
	     (begin
	       (debug:print-info 0 "Discarding connection to server for run-id " run-id ", too long between accesses")
	       (hash-table-delete! *runremote* run-id)))))
     (hash-table-keys *runremote*)))
  (let* ((run-id          (if rid rid 0))
	 (connection-info (let ((cinfo (hash-table-ref/default *runremote* run-id #f)))
			    (if cinfo
				cinfo
				;; NB// can cache the answer for server running for 10 seconds ...
				;;  ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
				(if (tasks:server-running-or-starting? (tasks:get-db) run-id)
				    (let ((res (client:setup run-id)))
				      (if res 
					  (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
					  #f))
				    #f))))
	 (jparams         (db:obj->string params)))
    (if connection-info
	(let ((res             (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
	  (http-transport:server-dat-update-last-access connection-info)
	  (if res
	      (db:string->obj res)
	      (let ((new-connection-info (client:setup run-id)))
		(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
		(rmt:send-receive cmd run-id params))))
	(let ((max-avg-qry (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") "800"))))
	  (debug:print-info 4 "no server and read-only query, bypassing normal channel")