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

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

On Mon, Nov 24, 2008 at 03:55, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

> That's OK: when we add server-running-p to server-start this objection
> will disappear so we can change the code at the same time to remove the
> entry when stopping the server.

WDYT about the following patch?

  Juanma



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

	* server.el (server-sentinel): Uncomment code to delete connection file.
	(server-running-p): Return t for TCP servers if the auth file says
	there's a local server and we find an Emacs process with the right PID.
	Doc fix.
	(server-start): Save the connection file in the process' property list.
	Delete it only when we are reasonably convinced that it is not owned by
	a running server.


Index: lisp/server.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/server.el,v
retrieving revision 1.175
diff -u -2 -b -r1.175 server.el
--- lisp/server.el	18 Nov 2008 16:27:09 -0000	1.175
+++ lisp/server.el	24 Nov 2008 14:40:52 -0000
@@ -326,9 +326,7 @@
     (set-process-query-on-exit-flag proc nil))
   ;; 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))
@@ -465,12 +463,14 @@
 	 (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 (not (server-running-p server-name))
+	  (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
@@ -481,6 +481,4 @@
 	  (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)
@@ -517,4 +515,5 @@
 			       :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
@@ -535,5 +534,7 @@

 (defun server-running-p (&optional name)
-  "Test whether server NAME is running."
+  "Test whether server NAME is running.
+NOTE: This function is intended to be called from `server-start'
+and it is NOT 100% reliable."
   (interactive
    (list (if current-prefix-arg
@@ -541,5 +542,15 @@
   (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))
+	    (and (looking-at "127\.0\.0\.1:[0-9]+ \\([0-9]+\\)")
+		 (let ((case-fold-search t)
+		       (proc (assq 'comm
+				   (system-process-attributes
+				    (string-to-number (match-string 1))))))
+		   (and proc
+			(string-match-p "emacs" (cdr proc))))))
 	(delete-process
 	 (make-network-process