78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
-
+
-
-
-
+
+
+
+
-
-
+
+
|
;; (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*)
(let* ((run-id (if rid rid 0))
(connection-info (rmt:get-connection-info run-id))
(connection-info (rmt:get-connection-info run-id)))
(jparams (db:obj->string params)))
((http)(http-transport:client-api-send-receive run-id connection-info cmd jparams))
((nmsg)(nmsg-transport:client-api-send-receive run-id connection-info cmd params))
((http)(http-transport:client-api-send-receive run-id connection-info cmd params))
((nmsg)(condition-case
(nmsg-transport:client-api-send-receive run-id connection-info cmd params)
((timeout)(vector #f "timeout talking to server"))))
(else (exit))))
(success (if (and dat (vector? dat)) (vector-ref dat 0) #f))
(res (if (and dat (vector? dat)) (vector-ref dat 1) #f)))
(http-transport:server-dat-update-last-access connection-info)
(if success
(case *transport-type*
((http)(db:string->obj res))
((nmsg)(vector-ref res 1)))
((http) res) ;; (db:string->obj res))
((nmsg) res)) ;; (vector-ref res 1)))
(begin ;; let ((new-connection-info (client:setup run-id)))
(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
;; (case *transport-type*
;; ((nmsg)(nn-close (http-transport:server-dat-get-socket connection-info))))
(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
(if (eq? (modulo attemptnum 5) 0)
(tasks:kill-server-run-id run-id tag: "api-send-receive-failed"))
|
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
+
|
;; M I S C
;;======================================================================
(define (rmt:login run-id)
(rmt:send-receive 'login run-id (list *toppath* megatest-version run-id *my-client-signature*)))
;; This login does no retries under the hood - it acts a bit like a ping.
;; Deprecated for nmsg-transport.
;;
(define (rmt:login-no-auto-client-setup connection-info run-id)
(case *transport-type*
((http)(rmt:send-receive-no-auto-client-setup connection-info 'login run-id (list *toppath* megatest-version run-id *my-client-signature*)))
((nmsg)(nmsg-transport:client-api-send-receive run-id connection-info 'login (list *toppath* megatest-version run-id *my-client-signature*)))))
;; hand off a call to one of the db:queries statements
|