11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
(use json format)
(declare (unit rmt))
(declare (uses api))
(declare (uses tdb))
(declare (uses http-transport))
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;
;; ;; For debugging add the following to ~/.megatestrc
;;
|
>
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
(use json format)
(declare (unit rmt))
(declare (uses api))
(declare (uses tdb))
(declare (uses http-transport))
(declare (uses nmsg-transport))
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;
;; ;; For debugging add the following to ~/.megatestrc
;;
|
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
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? (db:delay-if-busy (tasks:open-db)) run-id)
(client:setup run-id)
#f))))
;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(let* ((dat (http-transport:client-api-send-receive run-id connection-info cmd jparams))
(res (if (and dat (vector? dat)) (vector-ref dat 1) #f))
(success (if (and dat (vector? dat)) (vector-ref dat 0) #f)))
(http-transport:server-dat-update-last-access connection-info)
(if success
(db:string->obj res)
;; (if (< attemptnum 100)
;; (begin
;; (hash-table-delete! *runremote* run-id)
;; (thread-sleep! 0.5)
;; (rmt:send-receive cmd rid params attempnum: (+ attemptnum 1)))
;; (begin
;; (print-call-chain (current-error-port))
;; (debug:print 0 "ERROR: too many attempts to communicate have failed. Giving up. Kill your mtest processes and start over")
;; (exit 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.")
(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
;; 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
|
<
<
<
>
>
>
|
>
>
>
|
<
<
<
|
<
<
<
<
<
|
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
95
96
97
98
99
100
101
102
103
104
105
106
107
|
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? (db:delay-if-busy (tasks:open-db)) run-id)
(client:setup run-id)
#f))))
(define (rmt:send-receive cmd rid params #!key (attemptnum 0))
;; 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*)
(let* ((run-id (if rid rid 0))
(connection-info (rmt:get-connection-info run-id))
(jparams (db:obj->string params)))
;; 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*
((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))
(else (exit))))
(res (if (and dat (vector? dat)) (vector-ref dat 1) #f))
(success (if (and dat (vector? dat)) (vector-ref dat 0) #f)))
(http-transport:server-dat-update-last-access connection-info)
(if success
(case *transport-type*
((http)(db:string->obj res))
((nmsg) res))
(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.")
(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
;; 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
|
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
(let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(db (make-dbr:dbstruct path: dbdir local: #t)))
(set! *dbstruct-db* db)
db)))
(db-file-path (db:dbfile-path 0)))
;; (read-only (not (file-read-access? db-file-path)))
(let* ((start (current-milliseconds))
(res (api:execute-requests dbstruct-local (symbol->string cmd) params))
(duration (- (current-milliseconds) start)))
(rmt:update-db-stats run-id cmd params duration)
;; mark this run as dirty if this was a write
(if (not (member cmd api:read-only-queries))
(let ((start-time (current-seconds)))
(mutex-lock! *db-multi-sync-mutex*)
;; (if (not (hash-table-ref/default *db-local-sync* run-id #f))
|
|
>
|
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
(let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(db (make-dbr:dbstruct path: dbdir local: #t)))
(set! *dbstruct-db* db)
db)))
(db-file-path (db:dbfile-path 0)))
;; (read-only (not (file-read-access? db-file-path)))
(let* ((start (current-milliseconds))
(resdat (api:execute-requests dbstruct-local (symbol->string cmd) params))
(res (vector-ref resdat 1))
(duration (- (current-milliseconds) start)))
(rmt:update-db-stats run-id cmd params duration)
;; mark this run as dirty if this was a write
(if (not (member cmd api:read-only-queries))
(let ((start-time (current-seconds)))
(mutex-lock! *db-multi-sync-mutex*)
;; (if (not (hash-table-ref/default *db-local-sync* run-id #f))
|