26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
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
112
113
114
115
116
117
118
119
120
121
122
123
124
|
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
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
112
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
154
155
156
157
158
159
160
161
162
|
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
-
+
+
+
+
-
+
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
+
+
-
-
+
+
-
-
+
-
-
-
+
+
-
-
-
-
+
+
+
-
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(declare (unit client))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(module client
*
)
(import client)
(include "common_records.scm")
(include "db_records.scm")
;; client:get-signature
(define (client:get-signature)
(if *my-client-signature* *my-client-signature*
(let ((sig (conc (get-host-name) " " (current-process-id))))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; Not currently used! But, I think it *should* be used!!!
#;(define (client:logout serverdat)
(let ((ok (and (socket? serverdat)
(cdb:logout serverdat *toppath* (client:get-signature)))))
ok))
(define (client:setup areapath #!key (remaining-tries 100) (failed-connects 0))
(client:setup-http areapath remaining-tries: remaining-tries failed-connects: failed-connects))
(define (client:setup-http areapath #!key (remaining-tries 100) (failed-connects 0)(area-dat #f))
(define (client:setup areapath runremote #!key (remaining-tries 100) (failed-connects 0)(area-dat #f))
(mutex-lock! *rmt-mutex*)
(let ((res (client:setup-http-baby areapath remaining-tries: remaining-tries failed-connects: failed-connects area-dat: area-dat)))
(let ((res (client:setup-http areapath runremote remaining-tries: remaining-tries failed-connects: failed-connects area-dat: area-dat)))
(mutex-unlock! *rmt-mutex*)
res))
(define (client:setup-http-baby areapath #!key (remaining-tries 100) (failed-connects 0)(area-dat #f))
(define (client:setup-http areapath runremote #!key (remaining-tries 100) (failed-connects 0))
(debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries)
(server:start-and-wait areapath)
(if (<= remaining-tries 0)
(begin
(debug:print-error 0 *default-log-port* "failed to start or connect to server")
(exit 1))
;;
;; Alternatively here, we can get the list of candidate servers and work our way
;; through them searching for a good one.
;;
(let* ((server-dat (server:choose-server areapath 'best))
(runremote (or area-dat *runremote*)))
(let* ((server-dat (server:choose-server areapath 'best))) ;; list host port start-time server-id pid
;; (runremote (or area-dat *runremote*)))
(if (not server-dat) ;; no server found
(begin
(if (< remaining-tries 99)(thread-sleep! 1)) ;; obviously it needs time
(client:setup-http-baby areapath remaining-tries: (- remaining-tries 1))
(client:setup-http areapath runremote remaining-tries: (- remaining-tries 1)))
(match server-dat
((host port start-time server-id pid)
(debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
(if (and (not area-dat)
(not *runremote*))
(begin
(set! *runremote* (make-remote))
(let* ((server-info (remote-server-info *runremote*)))
(remote-server-url-set! *runremote* (server:record->url server-info))
(remote-server-id-set! *runremote* (server:record->id server-info)))))))
(remote-server-url-set! runremote (server:record->url server-info))
(remote-server-id-set! runremote (server:record->id server-info)))))))
;; at this point we have a runremote
(if (and host port server-id)
(let* ((start-res (http-transport:client-connect host port server-id))
(ping-res (rmt:login-no-auto-client-setup start-res)))
(let* ((nada (client:connect host port server-id runremote))
(ping-res (rmt:login-no-auto-client-setup runremote)))
(if (and start-res
ping-res)
(let ((runremote (or area-dat *runremote*))) ;; it might have been generated only a few statements ago
(if runremote
(begin
(remote-conndat-set! runremote start-res) ;; (hash-table-set! runremote run-id start-res)
(debug:print-info 2 *default-log-port* "connected to " (http-transport:server-dat-make-url start-res))
start-res)
(client:setup-http-baby areapath remaining-tries: (- remaining-tries 1))))
(http-transport:close-connections *runremote*)
(http-transport:close-connections runremote)
(thread-sleep! 1)
(client:setup-http-baby areapath remaining-tries: (- remaining-tries 1))
(client:setup-http-baby areapath runremote remaining-tries: (- remaining-tries 1))
)))
(begin ;; no server registered
;; (server:kind-run areapath)
(server:start-and-wait areapath)
(debug:print-info 0 *default-log-port* "client:setup, no server registered, remaining-tries=" remaining-tries)
(thread-sleep! 1) ;; (+ 5 (random (- 20 remaining-tries)))) ;; give server a little time to start up, randomize a little to avoid start storms.
(client:setup-http-baby areapath remaining-tries: (- remaining-tries 1)))))
(client:setup-http areapath runremote remaining-tries: (- remaining-tries 1)))))
(else
(debug:print 0 *default-log-port* "ERROR: malformed server-dat="server-dat)))))))
;;
;; connect - stored in remote-condat
;;
;; (define (http-transport:client-connect iface port server-id runremote)
(define (client:connect iface port server-id runremote-in)
(let* ((runremote (or runremote-in
(make-runremote))))
(debug:print-info 2 *default-log-port* "Connecting to server at "iface":"port", id "server-id)
(let* ((api-url (conc "http://" iface ":" port "/api"))
(api-uri (uri-reference (conc "http://" iface ":" port "/api")))
(api-req (make-request method: 'POST uri: api-uri)))
;; (server-dat (vector iface port api-uri api-url api-req (current-seconds) server-id)))
(remote-iface-set! runremote iface)
(remote-port-set! runremote port)
(remote-server-id-set! runremote server-id)
(remote-connect-time-set! runremote (current-seconds))
(remote-last-access-set! runremote (current-seconds))
(remote-api-url-set! runremote api-url)
(remote-api-uri-set! runremote api-uri)
(remote-api-req-set! runremote api-req)
runremote)))
|