37
38
39
40
41
42
43
|
configfmod
debugprint
(prefix mtargs args:))
(include "common_records.scm")
(include "db_records.scm")
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
configfmod
debugprint
(prefix mtargs args:))
(include "common_records.scm")
(include "db_records.scm")
(define (db:kill-servers)
(let* ((tl (launch:setup)) ;; need this to initialize *toppath*
(servdir (conc *toppath* "/.servinfo"))
(servfiles (glob (conc servdir "/*:*.db")))
(fmtstr "~10a~22a~10a~25a~25a~8a\n")
(dbfiles (append (glob (conc *toppath* "/.mtdb/main.db")) (glob (conc *toppath* "/.mtdb/?.db"))(glob (conc *toppath* "/.mtdb/??.db"))))
(ttdat (make-tt areapath: *toppath*))
)
(format #t fmtstr "DB" "host:port" "PID" "age" "last mod" "state")
(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))
(server-id (list-ref sinfo 3))
(age (seconds->hr-min-sec (- (current-seconds) (list-ref sinfo 2))))
(last-mod (seconds->string (list-ref sinfo 2)))
(killed (system (conc "ssh " host " kill " pid " > /dev/null")))
(dummy2 (sleep 1))
(state (if (> (system (conc "ssh " host " ps " pid " > /dev/null")) 0) "dead" "alive"))
)
(format #t fmtstr db (conc host ":" port) pid age last-mod state)
(system (conc "rm " sfile))
)
)
sinfos
)
)
)
sfiles
)
)
)
dbfiles
)
;; remove this db, because otherwise metadata contains records for old servers, and this causes a problem with db:no-sync-get-lock-with-id.
(if (file-exists? (conc *toppath* "/.mtdb/no-sync.db"))
(delete-file (conc *toppath* "/.mtdb/no-sync.db"))
)
)
)
|