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
|
(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~20a~5a~20a~9a~20a~5a\n")
(servers-to-kill '()))
(format #t fmtstr "Id" "Pid" "Host" "Port" "Time" "Priority" "State" "Num Clients")
(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))
(stat-numc (server:ping hostname port))
(status (car stat-numc))
(numclients (cadr stat-numc))
(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))
|
|
|
|
|
|
<
|
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
|
(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))
|
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
|
(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 pid hostname port start-time priority
status numclients)))
servers)
(debug:print-info 1 "Done with listservers")
(exit) ;; must do, would have to add checks to many/all calls below
(set! *didsomething* #t))))
;; 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))
|
|
|
|
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
|
(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))))
;; 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))
|