270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
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
329
330
331
332
|
(server:launch)))
(if (or (args:get-arg "-listservers")
(args:get-arg "-killserver"))
(let ((tl (setup-for-run)))
(if tl
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
(fmtstr "~5a~8a~8a~20a~5a~20a~9a~20a\n")
(servers-to-kill '()))
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Port" "Time" "Priority" "State")
(format #t fmtstr "==" "=====" "===" "====" "====" "====" "========" "=====")
(for-each
(lambda (server)
(let* ((killinfo (args:get-arg "-killserver"))
(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))
(hostname (vector-ref server 2))
(port (vector-ref server 3))
(start-time (vector-ref server 4))
(priority (vector-ref server 5))
(state (vector-ref server 6))
(mt-ver (vector-ref server 7))
(status (open-run-close tasks:server-alive? tasks:open-db hostname port: port))
(killed #f)
(zmq-socket (if status (server:client-connect hostname port) #f)))
;; no need to login as status of #t indicates we are connecting to correct
;; server
(if (or (not status) ;; no point in keeping dead records in the db
(and khost-port ;; kill by host/port
(equal? hostname (car khost-port))
(equal? port (string->number (cadr khost-port)))))
(begin
(open-run-close tasks:server-deregister tasks:open-db hostname port: port)
(if status ;; #t means alive
(begin
(cdb:kill-server zmq-socket)
(debug:print-info 1 "Killed server by host:port at " hostname ":" port))
(debug:print-info 1 "Removing defunct server record for " hostname ":" port))
(set! killed #t)))
(if (and kpid
;; (equal? hostname (car khost-port))
(equal? kpid pid)) ;;; YEP, ALL WITH PID WILL BE KILLED!!!
(begin
(open-run-close tasks:server-deregister tasks:open-db hostname pid: pid)
(set! killed #t)
(if status (cdb:kill-server zmq-socket))
(debug:print-info 1 "Killed server by pid at " hostname ":" port)))
;; (if zmq-socket (close-socket zmq-socket))
(format #t fmtstr id mt-ver pid hostname port start-time priority
status)))
servers)
(debug:print-info 1 "Done with listservers")
(exit) ;; must do, would have to add checks to many/all calls below
(set! *didsomething* #t))
|
|
|
|
>
|
|
|
|
|
>
>
|
|
>
>
>
|
|
>
<
>
|
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
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
329
330
331
332
333
334
335
336
337
338
339
|
(server:launch)))
(if (or (args:get-arg "-listservers")
(args:get-arg "-killserver"))
(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~20a~10a~10a\n")
(servers-to-kill '()))
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Interface" "Port" "Time" "Priority" "State")
(format #t fmtstr "==" "=====" "===" "====" "=========" "====" "====" "========" "=====")
(for-each
(lambda (server)
(let* ((killinfo (args:get-arg "-killserver"))
(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))
(hostname (vector-ref server 2))
(interface (vector-ref server 3))
(port (vector-ref server 4))
(start-time (vector-ref server 5))
(priority (vector-ref server 6))
(state (vector-ref server 7))
(mt-ver (vector-ref server 8))
(status (open-run-close tasks:server-alive? tasks:open-db hostname port: port))
(killed #f)
(zmq-socket (if status (server:client-connect hostname port) #f)))
;; no need to login as status of #t indicates we are connecting to correct
;; server
(if (or (not status) ;; no point in keeping dead records in the db
(and khost-port ;; kill by host/port
(equal? hostname (car khost-port))
(equal? port (string->number (cadr khost-port)))))
(begin
(open-run-close tasks:server-deregister tasks:open-db hostname port: port)
(if status ;; #t means alive
(begin
(if (equal? hostname (get-host-name))
(process-signal pid signal/term)
(cdb:kill-server zmq-socket))
(debug:print-info 1 "Killed server by host:port at " hostname ":" port))
(debug:print-info 1 "Removing defunct server record for " hostname ":" port))
(set! killed #t)))
(if (and kpid
;; (equal? hostname (car khost-port))
(equal? kpid pid)) ;;; YEP, ALL WITH PID WILL BE KILLED!!!
(begin
(open-run-close tasks:server-deregister tasks:open-db hostname pid: pid)
(set! killed #t)
(if status
(if (equal? hostname (get-host-name))
(process-signal pid signal/term)
(debug:print 0 "WARNING: Can't kill a dead server on host " hostname)))
(debug:print-info 1 "Killed server by pid at " hostname ":" port)))
;; (if zmq-socket (close-socket zmq-socket))
(format #t fmtstr id mt-ver pid hostname interface port start-time priority
(if status "alive" "dead"))))
servers)
(debug:print-info 1 "Done with listservers")
(set! *didsomething* #t)
(exit) ;; must do, would have to add checks to many/all calls below
)
(exit)))
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
(server:client-launch do-ping: #t)))
|