Overview
| Comment: | implemented -list-servers |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80 |
| Files: | files | file ages | folders |
| SHA1: |
536d85c6c46c86d7541e71f4853343af |
| User & Date: | mmgraham on 2023-09-22 19:00:06 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-09-22
| ||
| 19:31 | Added server process checking to -list-servers check-in: b0e72501af user: mmgraham tags: v1.80 | |
| 19:00 | implemented -list-servers check-in: 536d85c6c4 user: mmgraham tags: v1.80 | |
|
2023-08-21
| ||
| 17:44 | merged fork check-in: f5b6549716 user: mmgraham tags: v1.80, v1.8017 | |
Changes
Modified megatest.scm from [55136b63dd] to [59c2df0c37].
| ︙ | ︙ | |||
979 980 981 982 983 984 985 |
;; a specific Megatest area. Detail are being hashed out and this may change.
;;
(if (args:get-arg "-adjutant")
(begin
(adjutant-run)
(set! *didsomething* #t)))
| | < | < < < | > | > > > | | | | > > | > > > > | < < | | | > > > > | | < < < > | > > | > > > | > > > | > | > > > | < < | | | < < < < < < | < < > > | 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)
|
| ︙ | ︙ |
Modified tcp-transportmod.scm from [7db23f7cad] to [896ad94c25].
| ︙ | ︙ | |||
318 319 320 321 322 323 324 |
(string>? (list-ref a 3)(list-ref b 3)) ;; if servers started at same time look at server-id
(< starta startb))))))
(count 0))
(for-each
(lambda (rec)
(if (or (> (length sorted) 1)
(common:low-noise-print 120 "server info sorted"))
| | | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 |
(string>? (list-ref a 3)(list-ref b 3)) ;; if servers started at same time look at server-id
(< starta startb))))))
(count 0))
(for-each
(lambda (rec)
(if (or (> (length sorted) 1)
(common:low-noise-print 120 "server info sorted"))
(debug:print 2 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", ")))
(set! count (+ count 1)))
sorted)
sorted))
(define (tt:get-current-server-info ttdat dbfname)
(assert (tt-areapath ttdat) "FATAL: areapath not set in ttdat.")
;;
|
| ︙ | ︙ |