| ︙ | | |
18
19
20
21
22
23
24
25
26
27
28
29
30
31
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
+
|
(declare (unit server))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses synchash))
(declare (uses http-transport))
(declare (uses nmsg-transport))
(declare (uses launch))
;; (declare (uses zmq-transport))
(declare (uses daemon))
(include "common_records.scm")
(include "db_records.scm")
|
| ︙ | | |
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
+
-
+
+
+
|
;;
;; all routes though here end in exit ...
;;
;; start_server
;;
(define (server:launch run-id)
(case *transport-type*
(http-transport:launch run-id))
((http)(http-transport:launch run-id))
((nmsg)(nmsg-transport:launch run-id))
(else (debug:print 0 "ERROR: unknown server type " *transport-type*))))
;;======================================================================
;; Q U E U E M A N A G E M E N T
;;======================================================================
;; We don't want to flush the queue if it was just flushed
(define *server:last-write-flush* (current-milliseconds))
|
| ︙ | | |
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
+
-
-
-
+
+
+
+
+
+
|
(trycount 0))
(if server
;; note: client:start will set *runremote*. this needs to be changed
;; also, client:start will login to the server, also need to change that.
;;
;; client:start returns #t if login was successful.
;;
(let ((res (case *transport-type*
(let ((res (server:ping-server run-id
(tasks:hostinfo-get-interface server)
(tasks:hostinfo-get-port server))))
((http)(server:ping-server run-id
(tasks:hostinfo-get-interface server)
(tasks:hostinfo-get-port server)))
((nmsg)(nmsg-transport:ping (tasks:hostinfo-get-interface server)
(tasks:hostinfo-get-port server)
timeout: 2)))))
;; if the server didn't respond we must remove the record
(if res
#t
(begin
(debug:print-info 0 "server at " server " not responding, removing record")
(tasks:server-force-clean-running-records-for-run-id (db:delay-if-busy tdbdat) run-id
" server:check-if-running")
|
| ︙ | | |
194
195
196
197
198
199
200
|
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
+
+
+
+
+
+
+
+
+
+
+
+
|
(res "NOREPLY"))
(if (eof-object? inl)
(case (string->symbol res)
((NOREPLY) #f)
((LOGIN_OK) #t)
(else #f))
(loop (read-line) inl))))))
(define (server:get-timeout)
(let ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (and (string? tmo)
(string->number tmo))
(* 60 60 (string->number tmo))
;; (* 3 24 60 60) ;; default to three days
(* 60 1) ;; default to one minute
;; (* 60 60 25) ;; default to 25 hours
)))
|