979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
|
;; a specific Megatest area. Detail are being hashed out and this may change.
;;
(if (args:get-arg "-adjutant")
(begin
(adjutant-run)
(set! *didsomething* #t)))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-kill-servers"))
(let ((tl (launch:setup)))
(debug:print 0 *default-log-port* "NOT YET REIMPLEMENTED FOR TCP/INMEM") ;; BUG
(exit)
(if tl ;; all roads from here exit
(let* ((servers (server:choose-server *toppath* 'all-valid)) ;; (server:get-list *toppath*))
(fmtstr "~33a~22a~20a~20a~8a\n"))
(if (not servers)
(begin
(debug:print-info 1 *default-log-port* "No servers found")
(exit)
)
)
(format #t fmtstr "PID" "host:port" "age (hms)" "Last mod" "State")
(format #t fmtstr "===" "=========" "=========" "========" "=====")
(for-each ;; (ip-addr port? mod-time host port start-time pid )
(lambda (server)
(let* ((mtm (any->number (caddr server)))
(mod (if mtm (- (current-seconds) mtm) "unk"))
(age (- (current-seconds)(or (any->number mtm) (current-seconds))))
(pid (list-ref server 4))
(url (conc (car server) ":" (cadr server)))
(alv (if (number? mod)(< mod 360) #f)))
(format #t
fmtstr
pid
url
(seconds->hr-min-sec age)
(seconds->hr-min-sec mod)
(if alv "alive" "dead"))
(if (and alv
(args:get-arg "-kill-servers"))
(begin
(debug:print-info 0 *default-log-port* "Attempting to kill server with pid " pid)
(server:kill server)))))
(sort servers (lambda (a b)
(let ((ma (or (any->number (car a)) 9e9))
(mb (or (any->number (car b)) 9e9)))
(> ma mb)))))
(set! *didsomething* #t)
(exit))
(exit))))
;; must do, would have to add checks to many/all calls below
|
|
<
|
<
<
<
|
>
|
>
>
>
|
|
|
|
>
>
|
>
>
>
>
|
<
<
|
|
|
>
>
>
>
|
|
<
<
<
>
|
>
>
|
>
>
>
|
>
>
>
|
>
|
>
>
>
|
<
<
|
|
|
<
<
<
<
<
<
|
<
<
>
>
|
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
|
;; a specific Megatest area. Detail are being hashed out and this may change.
;;
(if (args:get-arg "-adjutant")
(begin
(adjutant-run)
(set! *didsomething* #t)))
(if (args:get-arg "-list-servers")
(let* ((tl (launch:setup))
(servdir (tt:get-servinfo-dir *toppath*))
(servfiles (glob (conc servdir "/*:*.db")))
(fmtstr "~10a~22a~10a~13a~25a\n")
(dbfiles (glob (conc *toppath* "/.mtdb/*.db")))
(ttdat (make-tt areapath: *toppath*))
)
(format #t fmtstr "DB" "host:port" "PID" "age (hms)" "Last mod")
(for-each
(lambda (dbfile)
(let* (
(dbfname (conc (pathname-file dbfile) ".db"))
(sfiles (tt:find-server *toppath* dbfname))
)
(for-each
(lambda (sfile)
(let (
(sinfos (tt:get-server-info-sorted ttdat dbfname))
)
(for-each
(lambda (sinfo)
(let* (
(db (list-ref sinfo 5))
(pid (list-ref sinfo 4))
(host (list-ref sinfo 0))
(port (list-ref sinfo 1))
(age (seconds->time-string(- (current-seconds) (list-ref sinfo 2))))
(last-mod (seconds->string (list-ref sinfo 2)))
)
(format #t fmtstr db (conc host ":" port) pid age last-mod)
)
)
sinfos
)
)
)
sfiles
)
)
)
dbfiles
)
(set! *didsomething* #t)
(exit)
)
)
(if (args:get-arg "-kill-servers")
(begin
(debug:print 0 *default-log-port* "-kill-servers not implemented yet in Megatest 1.80")
(exit)
)
)
;;======================================================================
;; Weird special calls that need to run *after* the server has started?
;;======================================================================
(if (args:get-arg "-list-targets")
(if (launch:setup)
|