Re: error in server-running-p on M$

["Juanma Barranquero" <lekktu@gmail.com>]

On Thu, Dec 11, 2008 at 03:07, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

> I usually prefer it if the command just fails and lets the user run some
> other command to do what she wants.  Sometimes asking the question is
> a better option, but here I don't thinkg that its worth it.  The main
> problem with asking a question is that it's modal.

I've implemented `server-force-delete', as you suggested.

> Most/all Unix locks based on process-ids (like the ones used by Emacs,
> for example) don't pay attention to the process name.  So experience
> shows it's usually good enough.

OK. Now `server-running-p' will return t for a matching PID process,
and does not check the name. It is the safer behavior anyway.

> We can also reduce the likelihood of leaving behind some obsolete
> socket/file using kill-emacs-hook.

When the server is running, `kill-emacs-hook' already contains code to
turn the server off; (with the patch) that deletes the connection
file.

Please, take a look at the attached patch.

    Juanma



2008-12-11  Juanma Barranquero  <lekktu@gmail.com>

	* server.el (server-sentinel): Uncomment code to delete connection file.
	(server-start): Save the connection file in the server property list.
	Delete it only when we are reasonably convinced that it is not owned by
	a running server.
	(server-force-delete): New command to force-delete the connection file.
	(server-running-p): Return t also for local TCP servers when we find a
	process with a matching PID, and :other for undecided cases.



Index: lisp/server.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/server.el,v
retrieving revision 1.175
diff -u -3 -b -r1.175 server.el
--- lisp/server.el	18 Nov 2008 16:27:09 -0000	1.175
+++ lisp/server.el	11 Dec 2008 16:15:17 -0000
@@ -327,9 +327,9 @@
   ;; Delete the associated connection file, if applicable.
   ;; This is actually problematic: the file may have been overwritten by
   ;; another Emacs server in the mean time, so it's not ours any more.
-  ;; (and (process-contact proc :server)
-  ;;      (eq (process-status proc) 'closed)
-  ;;      (ignore-errors (delete-file (process-get proc :server-file))))
+  (and (process-contact proc :server)
+       (eq (process-status proc) 'closed)
+       (ignore-errors (delete-file (process-get proc :server-file))))
   (server-log (format "Status changed to %s: %s" (process-status
proc) msg) proc)
   (server-delete-client proc))

@@ -458,20 +458,26 @@
 Emacs distribution as your standard \"editor\".

 Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
-kill any existing server communications subprocess."
+kill any existing server communications subprocess.
+
+If `server-running-p' returns t, the server is not started.
+To force-start a server, do \\[server-force-delete] and then
+\\[server-start]."
   (interactive "P")
   (when (or
 	 (not server-clients)
 	 (yes-or-no-p
 	  "The current server still has clients; delete them? "))
+    (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
+	   (server-file (expand-file-name server-name server-dir)))
     (when server-process
       ;; kill it dead!
       (ignore-errors (delete-process server-process)))
     ;; Delete the socket files made by previous server invocations.
-    (when server-socket-dir
-      (condition-case ()
-	  (delete-file (expand-file-name server-name server-socket-dir))
-	(error nil)))
+      (if (memq (server-running-p server-name) '(nil :other))
+	  (ignore-errors (delete-file server-file))
+	(setq server-mode nil) ;; already set by the minor mode code
+	(error "Server %S is already running" server-name))
     ;; If this Emacs already had a server, clear out associated status.
     (while server-clients
       (server-delete-client (car server-clients)))
@@ -480,12 +486,8 @@
 	(progn
 	  (server-log (message "Server stopped"))
 	  (setq server-process nil))
-      (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
-	     (server-file (expand-file-name server-name server-dir)))
 	;; Make sure there is a safe directory in which to place the socket.
 	(server-ensure-safe-dir server-dir)
-	;; Remove any leftover socket or authentication file.
-	(ignore-errors (delete-file server-file))
 	(when server-process
 	  (server-log (message "Restarting server")))
 	(letf (((default-file-modes) ?\700))
@@ -516,6 +518,7 @@
 			       :service server-file
 			       :plist '(:authenticated t)))))
 	  (unless server-process (error "Could not start server process"))
+	  (process-put server-process :server-file server-file)
 	  (when server-use-tcp
 	    (let ((auth-key
 		   (loop
@@ -533,14 +536,43 @@
 			" " (int-to-string (emacs-pid))
 			"\n" auth-key)))))))))

+;;;###autoload
+(defun server-force-delete (&optional name)
+  "Unconditionally delete connection file for server NAME.
+NAME defaults to `server-name'.  With argument, ask for NAME."
+  (interactive
+   (list (if current-prefix-arg
+	     (read-string "Server name: " nil nil server-name))))
+  (let ((file (expand-file-name (or name server-name)
+				(if server-use-tcp
+				    server-auth-dir
+				  server-socket-dir))))
+    (condition-case nil
+	(progn
+	  (delete-file file)
+	  (message "Connection file %S deleted" file))
+      (file-error
+       (message "Connection file %S not found or not deleted" file)))))
+
 (defun server-running-p (&optional name)
-  "Test whether server NAME is running."
+  "Test whether server NAME is running.
+
+NOTE: This function is designed to return immediately, rather than
+risking non-termination.  In some cases it returns `:other' when it
+cannot completely determine whether there's a server running or not."
   (interactive
    (list (if current-prefix-arg
 	     (read-string "Server name: " nil nil server-name))))
   (unless name (setq name server-name))
   (condition-case nil
-      (progn
+      (if server-use-tcp
+	  (with-temp-buffer
+	    (insert-file-contents-literally (expand-file-name name server-auth-dir))
+	    (or (and (looking-at "127\.0\.0\.1:[0-9]+ \\([0-9]+\\)")
+		     (assq 'comm
+			   (system-process-attributes
+			    (string-to-number (match-string 1)))))
+		:other))
 	(delete-process
 	 (make-network-process
 	  :name "server-client-test" :family 'local :server nil :noquery t