273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
|
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
|
-
+
-
-
+
+
|
(server:launch)))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
(let ((tl (setup-for-run)))
(if tl
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
(fmtstr "~5a~8a~8a~20a~20a~10a~10a~20a~10a~10a\n")
(fmtstr "~5a~8a~8a~20a~20a~10a~10a~10a~10a\n")
(servers-to-kill '()))
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Interface" "OutPort" "InPort" "Time" "LastBeat" "State")
(format #t fmtstr "==" "=====" "===" "====" "=========" "=======" "======" "====" "========" "=====")
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Interface" "OutPort" "InPort" "LastBeat" "State")
(format #t fmtstr "==" "=====" "===" "====" "=========" "=======" "======" "========" "=====")
(for-each
(lambda (server)
(let* (;; (killinfo (args:get-arg "-kill-server"))
;; (khost-port (if killinfo (if (substring-index ":" killinfo)(string-split ":") #f) #f))
;; (kpid (if killinfo (if (substring-index ":" killinfo) #f (string->number killinfo)) #f))
(id (vector-ref server 0))
(pid (vector-ref server 1))
|
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
|
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
|
-
-
-
-
-
-
-
-
-
-
-
+
|
;; server
(if (equal? state "dead")
(if (> last-update (* 25 60 60)) ;; keep records around for slighly over a day.
(open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid action: 'delete))
(if (> last-update 20) ;; Mark as dead if not updated in last 20 seconds
(open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid)))
;; (if (and khost-port ;; kill by host/port
;; (equal? hostname (car khost-port))
;; (equal? port (string->number (cadr khost-port))))
;; (tasks:kill-server status hostname port pid))
;;
;; (if (and kpid
;; (equal? hostname (get-host-name))
;; (equal? kpid pid)) ;;; YEP, ALL WITH PID WILL BE KILLED!!!
;; (tasks:kill-server status hostname #f pid))
;;
(format #t fmtstr id mt-ver pid hostname interface pullport pubport start-time last-update
|