20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
+
|
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses fs-transport))
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
;; timestamp type (val1 val2 ...)
|
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
|
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
|
+
+
+
+
+
+
-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
|
(let ((res (proc)))
(set! *client-non-blocking-mode* #f)
res))
;; params = 'target cached remparams
;;
;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime
;;
;; cdb:client-call is the unified interface to all the transports. It dispatches the
;; query to a server routine (e.g. server:client-send-recieve) that
;; transports the data to the server where it is passed to db:process-queue-item
;; which either returns the data to the calling server routine or
;; directly calls the returning procedure (e.g. zmq).
;;
(define (cdb:client-call serverdat qtype immediate numretries . params)
(debug:print-info 11 "cdb:client-call serverdat=" serverdat ", qtype=" qtype ", immediate=" immediate ", numretries=" numretries ", params=" params)
;; (handle-exceptions
(case *transport-type*
;; exn
;; (begin
;; (thread-sleep! 5)
;; (if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
(let* ((client-sig (server:get-client-signature))
(query-sig (message-digest-string (md5-primitive) (conc qtype immediate params)))
(zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds)))) ;; (with-output-to-string (lambda ()(serialize params))))
)
(debug:print-info 11 "zdat=" zdat)
(let* (
(res #f)
(rawdat (server:client-send-receive serverdat zdat))
(tmp #f))
(debug:print-info 11 "Sent " zdat ", received " rawdat)
(set! tmp (db:string->obj rawdat))
;; (if (equal? query-sig (vector-ref myres 1))
;; (set! res
(vector-ref tmp 2)
;; (loop (server:client-send-receive serverdat zdat)))))))
;; (timeout (lambda ()
;; (let loop ((n numretries))
;; (thread-sleep! 15)
;; (if (not res)
;; (if (> numretries 0)
;; (begin
;; (debug:print 2 "WARNING: no reply to query " params ", trying resend")
;; (debug:print-info 11 "re-sending message")
;; (apply cdb:client-call serverdat qtype immediate numretries params)
;; (debug:print-info 11 "message re-sent")
;; (loop (- n 1)))
;; ;; (apply cdb:client-call serverdats qtype immediate (- numretries 1) params))
;; (begin
;; (debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.")
;; (exit 5))))))))
;; (send-receive)
)))
;; (debug:print-info 11 "Starting threads")
;; (let ((th1 (make-thread send-receive "send receive"))
;; (th2 (make-thread timeout "timeout")))
;; (thread-start! th1)
;; (thread-start! th2)
;; (thread-join! th1)
;; (debug:print-info 11 "cdb:client-call returning res=" res)
;; res))))
|