51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
+
|
(hostname (if (string=? "-" hostn)
(get-host-name)
hostn))
(ipaddrstr (if (string=? "-" hostn)
(string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
#f))
(host:port (conc (if ipaddrstr ipaddrstr hostname) ":" (rpc:default-server-port))))
(debug:print 0 "Server started on " host:port)
(db:set-var db "SERVER" host:port)
(set! *cache-on* #t)
;; can use this to run most anything at the remote
(rpc:publish-procedure!
'remote:run
(lambda (procstr . params)
|
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
-
+
|
(mutex-unlock! *incoming-mutex*)
(if (> queue-len 0)
(begin
(debug:print 0 "INFO: Queue not flushed, waiting ...")
(loop (+ n 1)))))
)))
(thread-start! th1)
(debug:print 0 "Server started...")
;; (debug:print 0 "Server started on port " (rpc:default-server-port) "...")
(thread-start! th2)
;; (thread-join! th2)
;; return th2 for the calling process to do a join with
th2
)))) ;; rpc:server)))
(define (server:keep-running db host:port)
|
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
-
-
+
+
|
(define (server:find-free-port-and-open port)
(handle-exceptions
exn
(begin
(print "Failed to bind to port " (rpc:default-server-port) ", trying next port")
(server:find-free-port-and-open (+ port 1)))
(rpc:default-server-port port)
(tcp-read-timeout 120000)
(tcp-listen (rpc:default-server-port) )))
(tcp-read-timeout 240000)
(tcp-listen (rpc:default-server-port) 10000)))
(define (server:client-setup)
(if *runremote*
(begin
(debug:print 0 "ERROR: Attempt to connect to server but already connected")
#f)
(let* ((hostinfo (open-run-close db:get-var #f "SERVER"))
|