Overview
| Comment: | Fixed megatest -list-servers. Handled the changes in the server info list returned by choose-server |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-tcp-inmem |
| Files: | files | file ages | folders |
| SHA1: |
c9e2a1cd702e11432366020e22579f9c |
| User & Date: | mmgraham on 2023-02-17 16:27:13 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-02-20
| ||
| 22:58 | corrected match-let args in server:kill check-in: 8a443df8a9 user: mmgraham tags: v1.80-tcp-inmem | |
|
2023-02-17
| ||
| 16:27 | Fixed megatest -list-servers. Handled the changes in the server info list returned by choose-server check-in: c9e2a1cd70 user: mmgraham tags: v1.80-tcp-inmem | |
| 06:02 | Merged fork check-in: f756aa00cd user: matt tags: v1.80-tcp-inmem | |
Changes
Modified db.scm from [5ccfde4036] to [fbb021576e].
| ︙ | ︙ | |||
590 591 592 593 594 595 596 |
(src-area (if old2new *toppath* tmp-area))
(dest-area (if old2new tmp-area *toppath*))
(dbfiles (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db"))))
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
;; kill servers
| | | 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 |
(src-area (if old2new *toppath* tmp-area))
(dest-area (if old2new tmp-area *toppath*))
(dbfiles (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db"))))
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
;; kill servers
(if killservers (db:kill-servers))
(if (not dbfiles)
(debug:print-error 0 *default-log-port* "no dbfiles found in " (conc *toppath* "/.megatest"))
(for-each
(lambda (srcfile)
(debug:print-info 3 *default-log-port* "file: " srcfile)
(let* ((fname (conc (pathname-file srcfile) ".db"))
|
| ︙ | ︙ |
Modified megatest.scm from [a71b7bf85e] to [4376a89c11].
| ︙ | ︙ | |||
960 961 962 963 964 965 966 |
(if (or (args:get-arg "-list-servers")
(args:get-arg "-kill-servers"))
(let ((tl (launch:setup)))
(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"))
| > > > > > > | | | | | < > | < | 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 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 |
(if (or (args:get-arg "-list-servers")
(args:get-arg "-kill-servers"))
(let ((tl (launch:setup)))
(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
;;======================================================================
;; Weird special calls that need to run *after* the server has started?
|
| ︙ | ︙ | |||
2328 2329 2330 2331 2332 2333 2334 |
(if (args:get-arg "-cleanup-db")
(begin
(if (not (launch:setup))
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
| > | | | | > | 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 |
(if (args:get-arg "-cleanup-db")
(begin
(if (not (launch:setup))
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
;; (if (not (server:choose-server *toppath* 'home?))
;; (begin
;; (debug:print 0 *default-log-port* "Servers are not running on this host or no servers alive. Cannot run cleanup-db")
;; (exit 1)))
(let ((dbstructs (db:setup #f)))
(common:cleanup-db dbstructs))
(set! *didsomething* #t)))
(if (args:get-arg "-mark-incompletes")
(begin
(if (not (launch:setup))
|
| ︙ | ︙ |