Megatest

Check-in [cec4ee3511]
Login
Overview
Comment:Re-enable closing connections if open longer than the server timeout and no accesses
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | try-nanomsg
Files: files | file ages | folders
SHA1: cec4ee35119d48720ce72766001b123af31d983a
User & Date: matt on 2014-11-29 22:44:08
Other Links: branch diff | manifest | tags
Context
2014-11-30
10:39
Merged in try-nanomsg in prep for merging to one multi-transport code base check-in: 3fda9c352d user: matt tags: multi-transport
2014-11-29
22:44
Re-enable closing connections if open longer than the server timeout and no accesses Closed-Leaf check-in: cec4ee3511 user: matt tags: try-nanomsg
21:50
Added a little time spread on client starting servers - try to avoid startup storms check-in: b3a83a0cec user: matt tags: try-nanomsg
Changes

Modified http-transport.scm from [012f18812a] to [848a81881e].

286
287
288
289
290
291
292
293
294
295



296
297
298
299
300
301
302
286
287
288
289
290
291
292



293
294
295
296
297
298
299
300
301
302







-
-
-
+
+
+







					   (begin
					     (set! success #f)
					     (debug:print 0 "WARNING: failure in with-input-from-request to " fullurl ".")
					     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
					     (hash-table-delete! *runremote* run-id)
					     ;; 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?
					     (signal (make-composite-condition
						      (make-property-condition 'commfail 'message "failed to connect to server")))
					     #f)
					     ;; (signal (make-composite-condition
					     ;;          (make-property-condition 'commfail 'message "failed to connect to server")))
					     "communications failed")
					   (with-input-from-request ;; was dat
					    fullurl 
					    (list (cons 'key "thekey")
						  (cons 'cmd cmd)
						  (cons 'params sparams))
					    read-string))
					  transport: 'http)))
403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
418
419
420
421
422
423
424
403
404
405
406
407
408
409

410







411
412
413
414
415
416
417







-
+
-
-
-
-
-
-
-







				      (exit))
				    (loop start-time
					  (equal? sdat last-sdat)
					  sdat)))))))
         (iface       (car server-info))
         (port        (cadr server-info))
         (last-access 0)
	 (server-timeout (let ((tmo (configf:lookup  *configdat* "server" "timeout")))
	 (server-timeout (server:get-timeout)))
			   (if (and (string? tmo)
				    (string->number tmo))
			       (* 60 60 (string->number tmo))
			       ;; (* 3 24 60 60) ;; default to three days
			       (* 60 1)         ;; default to one minute
			       ;; (* 60 60 25)      ;; default to 25 hours
			       ))))
    (let loop ((count         0)
	       (server-state 'available))
      ;; Use this opportunity to sync the inmemdb to db
      (let ((start-time (current-milliseconds))
	    (sync-time  #f)
	    (rem-time   #f))
	;; inmemdb is a dbstruct

Modified rmt.scm from [df66a53f8b] to [f7cf650287].

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







-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id)
	    (client:setup run-id)
	    #f))))

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected
  ;; clean out old connections
  ;; (mutex-lock! *db-multi-sync-mutex*)
  ;; (let ((expire-time (- (current-seconds) 60)))
  ;;   (for-each 
  ;;    (lambda (run-id)
  ;;      (let ((connection (hash-table-ref/default *runremote* run-id #f)))
  ;;        (if (and connection 
  ;;       	  (< (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")
  ;;              ;; SHOULD CLOSE THE CONNECTION HERE
  ;;              (hash-table-delete! *runremote* run-id)))))
  ;;    (hash-table-keys *runremote*)))
  ;; (mutex-unlock! *db-multi-sync-mutex*)
  (mutex-lock! *db-multi-sync-mutex*)
  (let ((expire-time (- (current-seconds) (server:get-timeout) 10))) ;; don't forget the 10 second margin
    (for-each 
     (lambda (run-id)
       (let ((connection (hash-table-ref/default *runremote* run-id #f)))
         (if (and connection 
        	  (< (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")
               ;; SHOULD CLOSE THE CONNECTION HERE
	       (case *transport-type*
		 ((nmsg)(nn-close (http-transport:server-dat-get-socket 
				   (hash-table-ref *runremote* run-id)))))
               (hash-table-delete! *runremote* run-id)))))
     (hash-table-keys *runremote*)))
  (mutex-unlock! *db-multi-sync-mutex*)
  ;; (mutex-lock! *send-receive-mutex*)
  (let* ((run-id          (if rid rid 0))
	 (connection-info (rmt:get-connection-info run-id)))
    ;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
    (if connection-info
	;; use the server if have connection info
	(let* ((dat     (case *transport-type*

Modified server.scm from [3a939720aa] to [e26dc140e8].

202
203
204
205
206
207
208












202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220







+
+
+
+
+
+
+
+
+
+
+
+
		(res "NOREPLY"))
       (if (eof-object? inl)
	   (case (string->symbol res)
	     ((NOREPLY)  #f)
	     ((LOGIN_OK) #t)
	     (else       #f))
	   (loop (read-line) inl))))))


(define (server:get-timeout)
  (let ((tmo (configf:lookup  *configdat* "server" "timeout")))
    (if (and (string? tmo)
	     (string->number tmo))
	(* 60 60 (string->number tmo))
	;; (* 3 24 60 60) ;; default to three days
	(* 60 1)         ;; default to one minute
	;; (* 60 60 25)      ;; default to 25 hours
	)))