20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
(use format typed-records) ;; RADT => purpose of json format??
(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(declare (uses dbfile))
(include "common_records.scm")
;; (declare (uses rmtmod))
(import dbfile) ;; rmtmod)
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;
;; generate entries for ~/.megatestrc with the following
;;
;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u
|
>
>
>
>
>
|
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
(use format typed-records) ;; RADT => purpose of json format??
(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(declare (uses dbfile))
(declare (uses dbmemmod))
(include "common_records.scm")
;; (declare (uses rmtmod))
;; used by http-transport
(import dbfile) ;; rmtmod)
(import dbmemmod)
(define rmt:transport-mode (make-parameter 'http))
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;
;; generate entries for ~/.megatestrc with the following
;;
;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u
|
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(let* ((hh-dat (remote-hh-dat runremote)))
(if (pair? hh-dat)
(cdr hh-dat)
(begin
(debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
#f))))
;;======================================================================
(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
|
>
>
>
>
>
|
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
(let* ((hh-dat (remote-hh-dat runremote)))
(if (pair? hh-dat)
(cdr hh-dat)
(begin
(debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
#f))))
(define (make-and-init-remote areapath)
(case (rmt:transport-mode)
((http)(make-remote))
((tcp) (tt:make-remote areapath))
(else #f)))
;;======================================================================
(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
|
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
130
131
132
133
|
(let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value
(areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
(runremote (or area-dat
*runremote*))
(attemptnum (+ 1 attemptnum))
(readonly-mode (rmtmod:calc-ro-mode runremote *toppath*)))
;; DOT INIT_RUNREMOTE; // leaving off - doesn't really add to the clarity
;; DOT MUTEXLOCK -> INIT_RUNREMOTE [label="no remote?"];
;; DOT INIT_RUNREMOTE -> MUTEXLOCK;
;; ensure we have a record for our connection for given area
(if (not runremote) ;; can remove this one. should never get here.
(begin
(set! *runremote* (make-remote))
(let* ((server-info (remote-server-info *runremote*)))
(if server-info
(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)))
(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
<
<
<
|
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
(let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value
(areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
(runremote (or area-dat
*runremote*))
(attemptnum (+ 1 attemptnum))
(readonly-mode (rmtmod:calc-ro-mode runremote *toppath*)))
(case (rmt:transport-mode)
((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))
((tcp) (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)))))
(define (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
(if (not runremote)
(let* ((newremote (make-and-init-remote)))
(set! *runremote* newremote)
(set! runremote newremote)))
(let* ((dbfname (conc (dbfile:run-id->dbnum run-id)".db"))) ;;(dbfile:run-id->path areapath run-id)))
(tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)))
(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
;; DOT INIT_RUNREMOTE; // leaving off - doesn't really add to the clarity
;; DOT MUTEXLOCK -> INIT_RUNREMOTE [label="no remote?"];
;; DOT INIT_RUNREMOTE -> MUTEXLOCK;
;; ensure we have a record for our connection for given area
(if (not runremote) ;; can remove this one. should never get here.
(begin
(set! *runremote* (make-and-init-remote areapath))
(let* ((server-info (remote-server-info *runremote*)))
(if server-info
(begin
(remote-server-url-set! *runremote* (server:record->url server-info))
(remote-server-id-set! *runremote* (server:record->id server-info)))))
(set! runremote *runremote*))) ;; new runremote will come from this on next iteration
;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity
;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"];
;; DOT SET_HOMEHOST -> MUTEXLOCK;
;; ensure we have a homehost record
(if (or (not (pair? (remote-hh-dat runremote))) ;; not on homehost
(not (cdr (remote-hh-dat runremote)))) ;; not on homehost
(thread-sleep! 0.1) ;; since we shouldn't get here, delay a little
|