50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
;;
(define (server:launch run-id transport-type-raw)
(let ((transport-type
(cond
((string? transport-type-raw) (string->symbol transport-type-raw))
(else transport-type-raw))))
(BB> "server:launch fired for run-id="run-id" transport-type="transport-type)
(case transport-type
((http)(http-transport:launch run-id))
;;((nmsg)(nmsg-transport:launch run-id))
((rpc) (rpc-transport:launch run-id))
(else (debug:print-error 0 *default-log-port* "unknown server type " transport-type)))))
|
|
|
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
;;
(define (server:launch run-id transport-type-raw)
(let ((transport-type
(cond
((string? transport-type-raw) (string->symbol transport-type-raw))
(else transport-type-raw))))
;;(BB> "server:launch fired for run-id="run-id" transport-type="transport-type)
(case transport-type
((http)(http-transport:launch run-id))
;;((nmsg)(nmsg-transport:launch run-id))
((rpc) (rpc-transport:launch run-id))
(else (debug:print-error 0 *default-log-port* "unknown server type " transport-type)))))
|
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
(file-read-access? dotfile))
(with-input-from-file
dotfile
(lambda ()
(read-line)))
#f))))
;; write a .server file in *toppath* with hostport
;; return #t on success, #f otherwise
;;
(define (server:write-dotserver areapath hostport)
(let ((lock-file (conc areapath "/.server.lock"))
(server-file (conc areapath "/.server")))
(if (common:simple-file-lock lock-file)
(let ((res (handle-exceptions
exn
#f ;; failed for some reason, for the moment simply return #f
(with-output-to-file server-file
(lambda ()
(print hostport)))
#t)))
(debug:print-info 0 *default-log-port* "server file " server-file " for " hostport " created")
(common:simple-file-release-lock lock-file)
res)
#f)))
(define (server:remove-dotserver-file areapath hostport)
(let ((dotserver (server:read-dotserver areapath))
(server-file (conc areapath "/.server"))
(lock-file (conc areapath "/.server.lock")))
(if (and dotserver (string-match (conc ".*:" hostport "$") dotserver)) ;; port matches, good enough info to decide to remove the file
(if (common:simple-file-lock lock-file)
(begin
(handle-exceptions
exn
#f
(delete-file* server-file))
(debug:print-info 0 *default-log-port* "server file " server-file " for " hostport " removed")
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
|
(file-read-access? dotfile))
(with-input-from-file
dotfile
(lambda ()
(read-line)))
#f))))
(define (server:dotserver-starting)
(with-output-to-file
(conc *toppath* "/.starting-server")
(lambda ()
(print (current-process-id) " on " (get-host-name)))))
(define (server:dotserver-starting-remove)
(delete-file* (conc *toppath* "/.starting-server")))
;; write a .server file in *toppath* with hostport
;; return #t on success, #f otherwise
;;
(define (server:write-dotserver areapath hostport)
(let ((lock-file (conc areapath "/.server.lock"))
(server-file (conc areapath "/.server")))
(if (common:simple-file-lock lock-file)
(let ((res (handle-exceptions
exn
#f ;; failed for some reason, for the moment simply return #f
(with-output-to-file server-file
(lambda ()
(print hostport)))
#t)))
(debug:print-info 0 *default-log-port* "server file " server-file " for " hostport " created")
(common:simple-file-release-lock lock-file)
res)
#f)))
(define (server:remove-dotserver-file areapath hostport #!key (force #f))
(let ((dotserver (server:read-dotserver areapath))
(server-file (conc areapath "/.server"))
(lock-file (conc areapath "/.server.lock")))
(if (or force (and dotserver (string-match (conc ".*:" hostport "$") dotserver))) ;; port matches, good enough info to decide to remove the file
(if (common:simple-file-lock lock-file)
(begin
(handle-exceptions
exn
#f
(delete-file* server-file))
(debug:print-info 0 *default-log-port* "server file " server-file " for " hostport " removed")
|