@@ -39,5 +39,59 @@
 	(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"))
+     )
+  )
+)