26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
+
|
(include "common_records.scm")
(declare (uses rmtmod))
(import rmtmod)
(set-fn 'server:expiration-timeout server:expiration-timeout)
(set-fn 'common:get-homehost common:get-homehost)
(set-fn 'server:check-if-running server:check-if-running)
(set-fn 'api:execute-requests api:execute-requests)
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;
;; generate entries for ~/.megatestrc with the following
;;
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
-
+
|
(if (member cmd '(blah))
(begin
(mutex-lock! *send-receive-mutex*)
(let ((ulex:conn (remote-ulex:conn runremote)))
(if (not ulex:conn)(remote-ulex:conn-set! runremote (rmtmod:setup-ulex areapath)))
(rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat)))
(rmt:send-receive-orig *default-log-port* runremote *rmt-mutex* areapath *db-multi-sync-mutex* cmd rid params attemptnum: attemptnum area-dat: area-dat ro-queries: api:read-only-queries))))
(rmt:send-receive-orig *default-log-port* runremote *rmt-mutex* areapath *db-multi-sync-mutex* cmd rid params *alldata* attemptnum: attemptnum area-dat: area-dat))))
;; bunch of small functions factored out of send-receive to make debug easier
;;
;; (define (rmt:update-db-stats run-id rawcmd params duration)
;; (mutex-lock! *db-stats-mutex*)
;; (handle-exceptions
|
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
|
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
|
-
+
|
(define (rmt:test-get-archive-block-info archive-block-id)
(rmt:send-receive 'test-get-archive-block-info #f (list archive-block-id)))
(set-functions http-transport:client-api-send-receive ;; a
http-transport:close-connections ;; b
api:execute-requests ;; c
api:read-only-queries ;; d
#f
client:setup ;; e
server:kind-run ;; f
server:start-and-wait ;; g
server:check-if-running ;; h
server:ping ;; i
common:force-server? ;; j
)
|