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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
-
+
-
-
+
+
+
+
+
-
+
-
-
+
-
-
-
+
+
|
(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)
;; if none running or if > 20 seconds since
;; server last used then start shutdown
(let loop ((count 0))
(thread-sleep! 20) ;; no need to do this very often
(let ((numrunning (db:get-count-tests-running db)))
(if (or (not (> numrunning 0))
(> *last-db-access* (+ (current-seconds) 60)))
(if (or (> numrunning 0)
(> (+ *last-db-access* 60)(current-seconds)))
(begin
(debug:print 0 "INFO: Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*))
(loop (+ 1 count)))
(begin
(debug:print 0 "INFO: Starting to shutdown the server side")
;; need to delete only *my* server entry (future use)
(sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' AND val like ?;" host:port)
(thread-sleep! 10)
(debug:print 0 "INFO: Max cached queries was " *max-cache-size*)
(debug:print 0 "INFO: Server shutdown complete. Exiting")
(exit))
;; (exit)))
(debug:print 0 "INFO: Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*))
))
(loop (+ 1 count))))
(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"))
|
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
-
+
-
+
|
;; (lambda (db . param)
;; (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'"))
;; #f)
(set! *runremote* #f))
(if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server
((rpc:procedure 'server:login host portn) *toppath*))
(begin
(debug:print 2 "INFO: Connected to " host ":" port)
(debug:print 2 "INFO: Logged in and connected to " host ":" port)
(set! *runremote* (vector host portn)))
(begin
(debug:print 2 "INFO: Failed to connect to " host ":" port)
(debug:print 2 "INFO: Failed to login or connect to " host ":" port)
(set! *runremote* #f)))))
(debug:print 2 "INFO: no server available")))))
|