36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
+
|
(define (server:start db hostn)
(debug:print 0 "Attempting to start the server ...")
(let* ((rpc:listener (server:find-free-port-and-open (rpc:default-server-port)))
(th1 (make-thread
(cute (rpc:make-server rpc:listener) "rpc:server")
'rpc:server))
(th2 (make-thread (lambda ()(db:updater db))))
(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))))
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
+
+
+
+
+
|
(lambda (run-id test-name item-path comment)
(db:test-set-comment db run-id test-name item-path comment)))
(rpc:publish-procedure!
'rdb:test-set-log!
(lambda (run-id test-name item-path logf)
(db:test-set-log! db run-id test-name item-path logf)))
(rpc:publish-procedure!
'rpc:get-test-data-by-id
(lambda (test-id)
(db:get-test-data-by-id db test-id)))
(rpc:publish-procedure!
'serve:get-toppath
(lambda ()
*toppath*))
(rpc:publish-procedure!
|
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
+
-
+
|
(tests:register-test db run-id test-name item-path)))
(set! *rpc:listener* rpc:listener)
(on-exit (lambda ()
(sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' and val=?;" host:port)
(sqlite3:finalize! db)))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1))) ;; rpc:server)))
(thread-join! th2))) ;; rpc:server)))
(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)))
|