Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -1105,16 +1105,24 @@
 	(if (not cached?)(db:write-cached-data))
 	;; Any special calls are dispatched here. 
 	;; Remainder are put in the db queue
 	(case qry-name
 	  ((login) ;; login checks that the megatest path matches
-	   (if (null? remparam)
+	   (if (eq? (length remparam) 2) ;; should get toppath and signature
 	       #f ;; no path - fail!
 	       (let ((calling-path (car remparam)))
 		 (if (equal? calling-path *toppath*)
-		     #t      ;; path matches - pass! Should vet the caller at this time ...
+		     (begin
+		       (hash-table-set! *logged-in-clients* (cadr remparam) (current-seconds))
+		       #t)      ;; path matches - pass! Should vet the caller at this time ...
 		     #f))))  ;; else fail to login
+	  ((logout)
+	   (if (and (> (length remparam) 1)
+		    (eq? *toppath* (car remparam))
+		    (hash-table-ref/default *logged-in-clients* (cadr remparam) #f))
+	       #t
+	       #f))
 	  ((flush)
 	   (db:write-cached-data)
 	   #t)
 	  ((immediate)
 	   (db:write-cached-data)
@@ -1161,12 +1169,18 @@
     (send-message zmq-socket zdat)
     (set! res (db:string->obj (receive-message zmq-socket zdat)))
     (debug:print-info 11 "zmq-socket " (car params) " res=" res)
     res))
   
-(define (cdb:set-verbosity zmqsocket val)
-  (cdb:client-call zmqsocket 'set-verbosity #f val))
+(define (cdb:set-verbosity zmq-socket val)
+  (cdb:client-call zmq-socket 'set-verbosity #f val))
+
+(define (cdb:login zmq-socket keyval signature)
+  (cdb:client-call zmq-socket 'login #t keyval signature))
+
+(define (cdb:logout zmq-socket keyval signature)
+  (cdb:client-call zmq-socket 'logout #t keyval signature))
 
 (define (cdb:test-set-status-state zmqsocket test-id status state msg)
   (if msg
       (cdb:client-call zmqsocket 'state-status-msg #t state status msg test-id)
       (cdb:client-call zmqsocket 'state-status #t state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -95,10 +95,12 @@
   -env2file fname         : write the environment to fname.csh and fname.sh
   -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                  overwritten by values set in config files.
   -server -|hostname      : start the server (reduces contention on megatest.db), use
                             - to automatically figure out hostname
+  -listservers            : list the servers 
+  -killserver host:port|pid : kill server specified by host:port or pid, use % to kill all
   -repl                   : start a repl (useful for extending megatest)
 
 Spreadsheet generation
   -extract-ods fname.ods  : extract an open document spreadsheet from the database
   -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
@@ -153,10 +155,11 @@
 			":expected"
 			":tol"
 			":units"
 			;; misc
 			"-server"
+			"-killserver"
 			"-extract-ods"
 			"-pathmod"
 			"-env2file"
 			"-setvars"
 			"-set-state-status"
@@ -178,10 +181,11 @@
 			;; misc
 			"-archive"
 			"-repl"
 			"-lock"
 			"-unlock"
+			"-listservers"
 			;; queries
 			"-test-paths" ;; get path(s) to a test, ordered by youngest first
 
 			"-runall"    ;; run all tests
 			"-remove-runs"
@@ -260,10 +264,42 @@
 ;;   we start the server if not running else start the client thread
 ;;======================================================================
 
 (if (args:get-arg "-server")
     (server:launch))
+
+(define *logged-in-clients* (make-hash-table))
+
+(if (or (args:get-arg "-listservers")
+	(args:get-arg "-killserver"))
+    (let ((tl (setup-for-run)))
+      (if tl 
+	  (let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
+		(fmtstr  "~5a~8a~20a~5a~20a~8a~10a\n"))
+	    (format #t fmtstr "Id" "Pid" "Host" "Port" "Time" "Priority" "State")
+	    (format #t fmtstr "==" "===" "====" "====" "====" "========" "=====")
+	    (for-each 
+	     (lambda (server)
+	       (let* ((id         (vector-ref server 0))
+		      (pid        (vector-ref server 1))
+		      (hostname   (vector-ref server 2))
+		      (port       (vector-ref server 3))
+		      (start-time (vector-ref server 4))
+		      (priority   (vector-ref server 5))
+		      (state      (vector-ref server 6))
+		      (accessible (handle-exceptions
+				   exn
+				   #f
+				   (let ((zmq-socket (server:client-login hostname port)))
+				     (if zmq-socket
+					 (server:client-logout zmq-socket)
+					 #f)))))
+		 (format #t fmtstr id pid hostname port start-time priority 
+			 (cond
+			  (accessible "ACCESSIBLE")
+			  (else       "DEAD")))))
+		 servers)))))
 
 (if (or (let ((res #f))
 	  (for-each
 	   (lambda (key)
 	     (if (args:get-arg key)(set! res #t)))

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -9,11 +9,11 @@
 ;;  PURPOSE.
 
 (require-extension (srfi 18) extras tcp rpc s11n)
 (import (prefix rpc rpc:))
 
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo zmq)
+(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo zmq md5 message-digest)
 (import (prefix sqlite3 sqlite3:))
 
 (declare (unit server))
 
 (declare (uses common))
@@ -133,10 +133,40 @@
        (set! *runremote* #f)
        (debug:print 0 "Server started on " zmq-url)
        (open-run-close tasks:server-register tasks:open-db (current-process-id) host p 0 'live)
        s))))
 
+(define (server:mk-signature)
+  (message-digest-string (md5-primitive) 
+			 (with-output-to-string
+			   (lambda ()
+			     (write (list (current-directory)
+					  (argv)))))))
+
+;; MOVE ME TO COMMON
+(define *my-client-signature* #f)
+
+(define (server:client-login host port)
+  (let ((connect-ok #f)
+	(zmq-socket (make-socket 'req))
+	(mysig      (if *my-client-signature* *my-client-signature* (server:mk-signature)))
+	(conurl     (server:make-server-url (list host port))))
+    (set! *my-client-signature* mysig)
+    (connect-socket zmq-socket conurl)
+    (if (cdb:login zmq-socket *toppath* mysig)
+	zmq-socket
+	(if (socket? *runremote*)
+	    (begin
+	      (close-socket *runremote*)
+	      #f)
+	    zmq-socket))))
+
+(define (server:client-logout zmq-socket)
+  (and (socket? zmq-socket)
+       (cdb:logout zmq-socket *toppath* *my-client-signature*)
+       (close-socket zmq-socket)))
+
 (define (server:client-setup)
   (if (not *toppath*)(setup-for-run))
   (let* ((hostinfo   (open-run-close tasks:get-best-server tasks:open-db))
 	 (zmq-socket (make-socket 'req)))
     (if hostinfo
@@ -149,14 +179,16 @@
 	     (debug:print 0 "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
 	     (debug:print 0 "   perhaps jobs killed with -9? Removing server records")
 	     (open-run-close tasks:server-deregister tasks:open-db (car hostinfo) port: (cadr hostinfo))
 	     ;; (exit) ;; why forced exit?
 	     #f)
+	   ;; REPLACE WITH server:client-login
+	   ;;
 	   (let ((connect-ok #f)
 		 (conurl     (server:make-server-url hostinfo)))
 	     (connect-socket zmq-socket conurl)
-	     (set! connect-ok (cdb:client-call zmq-socket 'login #t *toppath*))
+	     (set! connect-ok (cdb:login zmq-socket))
 	     (if connect-ok
 		 (begin
 		   (debug:print-info 2 "Logged in and connected to " conurl)
 		   (set! *runremote* zmq-socket)
 		   #t)

Index: tasks.scm
==================================================================
--- tasks.scm
+++ tasks.scm
@@ -126,10 +126,19 @@
        (set! res (list hostname port)))
      mdb
      "SELECT id,hostname,port FROM servers WHERE state='live' ORDER BY start_time DESC LIMIT 1;")
     res))
 
+(define (tasks:get-all-servers mdb)
+  (let ((res '()))
+    (sqlite3:for-each-row
+     (lambda (id pid hostname port start-time priority state)
+       (set! res (cons (vector id pid hostname port start-time priority state) res)))
+     mdb
+     "SELECT id,pid,hostname,port,start_time,priority,state FROM servers ORDER BY start_time ASC;")
+    res))
+       
 
 ;;======================================================================
 ;; Tasks and Task monitors
 ;;======================================================================
 

Index: tests/tests.scm
==================================================================
--- tests/tests.scm
+++ tests/tests.scm
@@ -86,22 +86,34 @@
 							 res))
 (test "de-register server" #f (let ((res #f))
 				(open-run-close tasks:server-deregister tasks:open-db "bob" port: 1234)
 				(open-run-close tasks:get-best-server tasks:open-db)))
 
-
 ;; (exit)
 
 (set! *verbosity* 3) ;; enough to trigger turning off exception handling in db accesses
 (define server-pid (process-run "../../bin/megatest" (list "-server" "-" "-debug" (conc *verbosity*))))
 (sleep 3)
 (set! *verbosity* 1)
+
+(define hostinfo #f)
+(test #f #t (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
+				   (set! hostinfo dat)
+				   (and (string? (car dat))
+					(number? (cadr dat)))))
+
+(test #f #t (socket? (let ((s (server:client-login (car hostinfo)(cadr hostinfo))))
+		       (set! *runremote* s)
+		       s)))
 
 (define th1 (make-thread (lambda ()(server:client-setup))))
 (thread-start! th1)
 
+(test #f #t (cdb:login *runremote* *toppath* *my-client-signature*))
 (test #f #t (socket? *runremote*))
+
+(exit)
 
 ;;======================================================================
 ;; C O N F I G   F I L E S 
 ;;======================================================================