Megatest

Diff
Login

Differences From Artifact [ac5c069146]:

To Artifact [e68219c025]:


93
94
95
96
97
98
99
100

101
102
103
104


105
106
107
108
109
110
111
112
113
114
115
116
117
118
119


120

121
122
123
124
125
126
127
93
94
95
96
97
98
99

100
101
102


103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129







-
+


-
-
+
+















+
+
-
+







			  (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) res))
		((nmsg)(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))))
		;; (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
		(tasks:kill-server-run-id run-id tag: "api-send-receive-failed")
		(tasks:start-and-wait-for-server (tasks:open-db) run-id 15)
		;; (nmsg-transport:client-api-send-receive run-id connection-info cmd param remtries: (- remtries 1))))))

		;; no longer killing the server in http-transport:client-api-send-receive
		;; may kill it here but what are the criteria?
		;; start with three calls then kill server
		;; (if (eq? attemptnum 3)(tasks:kill-server-run-id run-id))
		;; (thread-sleep! 2)
		(rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1))))))
    (if (and (< attemptnum 10)
	     (tasks:need-server run-id))
	(begin
	  (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10)
	  (hash-table-delete! *runremote* run-id)
	  (client:setup run-id)
	  (rmt:send-receive cmd rid params (+ attemptnum 1)))
	  (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
	(rmt:open-qry-close-locally cmd run-id params))))

(define (rmt:update-db-stats run-id rawcmd params duration)
  (mutex-lock! *db-stats-mutex*)
  (handle-exceptions
   exn
   (begin
244
245
246
247
248
249
250

251
252



253
254
255
256
257
258
259
246
247
248
249
250
251
252
253


254
255
256
257
258
259
260
261
262
263







+
-
-
+
+
+








(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.
;;
(define (rmt:login-no-auto-client-setup connection-info run-id)
  (case *transport-type*
  (rmt:send-receive-no-auto-client-setup connection-info 'login run-id (list *toppath* megatest-version run-id *my-client-signature*)))
  
    ((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
;; added run-id to make looking up the correct db possible 
;;
(define (rmt:general-call stmtname run-id . params)
  (rmt:send-receive 'general-call run-id (append (list stmtname run-id) params)))

(define (rmt:sync-inmem->db run-id)