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
|
(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))
(numclients #f)
(stat-numc ;; (handle-exceptions
;; exn
;; (list #f (conc "EXCEPTION: " ((condition-property-accessor 'exn 'message) exn)))
(let ((zmq-socket (server:client-connect hostname port)))
(if zmq-socket
(if (server:client-login zmq-socket)
(let ((numclients (cdb:num-clients zmq-socket))
(killed #f))
(if (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)
(cdb:kill-server zmq-socket)
(debug:print-info 1 "Killed server by host:port at " hostname ":" port)
(set! killed #t))
(if (and kpid
(equal? kpid pid))
(begin
(open-run-close tasks:server-deregister tasks:open-db hostname pid: pid)
(set! killed #t)
(cdb:kill-server zmq-socket)
(debug:print-info 1 "Killed server by pid at " hostname ":" port))))
(if (not killed)(server:client-logout zmq-socket))
(close-socket zmq-socket)
(list numclients "ACCESSIBLE")) ;; (server:client-logout zmq-socket)
(begin
(close-socket zmq-socket)
(list #f "CAN'T LOGIN")))
(list #f "CAN'T CONNECT"))))) ;; )
(cadr stat-numc)(car stat-numc))))
servers)
(set! *didsomething* #t))))
;; if not list or kill then start a client (if appropriate)
(if (or (let ((res #f))
(for-each
(lambda (key)
(if (args:get-arg key)(set! res #t)))
|
>
>
|
<
|
<
|
|
|
|
<
|
|
|
|
|
>
>
|
|
>
|
|
>
|
|
|
|
|
|
<
|
<
<
<
<
<
|
|
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
|
(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))
(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))
(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)
(set! *didsomething* #t))))
;; if not list or kill then start a client (if appropriate)
(if (or (let ((res #f))
(for-each
(lambda (key)
(if (args:get-arg key)(set! res #t)))
|
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
|
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
;; this is the socket if we are a client
(if (socket? *runremote*)
(close-socket *runremote*))
|
>
|
|
|
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
|
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
;; this is the socket if we are a client
;; (if (and *runremote*
;; (socket? *runremote*))
;; (close-socket *runremote*))
(if (not *didsomething*)
(debug:print 0 help))
;; (if *runremote* (rpc:close-all-connections!))
(if (not (eq? *globalexitstatus* 0))
|