Overview
| Comment: | merged fork |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-tcp-inmem |
| Files: | files | file ages | folders |
| SHA1: |
d8fae05b29822a4b2f77a6d7969d0a7c |
| User & Date: | matt on 2023-02-21 17:02:04 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-02-21
| ||
| 17:47 | Fixed sync back check-in: 5e7e64a893 user: matt tags: v1.80-tcp-inmem | |
| 17:02 | merged fork check-in: d8fae05b29 user: matt tags: v1.80-tcp-inmem | |
| 16:54 | Fixed run-id issue that caused wrong db to be addressed. check-in: c2f5ef0caf user: matt tags: v1.80-tcp-inmem | |
|
2023-02-20
| ||
| 22:58 | corrected match-let args in server:kill check-in: 8a443df8a9 user: mmgraham tags: v1.80-tcp-inmem | |
Changes
Modified db.scm from [8b2649f90e] to [feadb63b1e].
| ︙ | ︙ | |||
592 593 594 595 596 597 598 |
(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
| | | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 |
(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 [839a9089d2] to [f617118e28].
| ︙ | ︙ | |||
964 965 966 967 968 969 970 |
(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"))
| > > > > > > | | | | | < > | < | 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 1006 1007 1008 1009 |
(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?
|
| ︙ | ︙ | |||
2331 2332 2333 2334 2335 2336 2337 |
(if (args:get-arg "-cleanup-db")
(begin
(if (not (launch:setup))
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
| > | | | | > | 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 |
(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))
|
| ︙ | ︙ |
Modified server.scm from [8a167481c8] to [1ebaa53b59].
| ︙ | ︙ | |||
656 657 658 659 660 661 662 |
(define (server:kill servr)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "Unable to get host and/or port from " servr ", exn=" exn)
#f)
| | | 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 |
(define (server:kill servr)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "Unable to get host and/or port from " servr ", exn=" exn)
#f)
(match-let (((hostname port start-time server-id pid)
servr))
(tasks:kill-server hostname pid))))
;; called in megatest.scm, host-port is string hostname:port
;;
;; NOTE: This is NOT called directly from clients as not all transports support a client running
;; in the same process as the server.
|
| ︙ | ︙ |