[Emacs-diffs] emacs/lisp ChangeLog server.el

[Juanma Barranquero]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Juanma Barranquero <lektu>      08/12/12 00:33:34

Modified files:
        lisp           : ChangeLog server.el 

Log message:
        * 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,
          and stop the server if it is running.
          (server-running-p): Return t also for local TCP servers when we find a
          process with a matching PID, and :other for undecided cases.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.14938&r2=1.14939
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/server.el?cvsroot=emacs&r1=1.175&r2=1.176

Patches:
Index: ChangeLog
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.14938
retrieving revision 1.14939
diff -u -b -r1.14938 -r1.14939
--- ChangeLog   11 Dec 2008 17:20:45 -0000      1.14938
+++ ChangeLog   12 Dec 2008 00:33:30 -0000      1.14939
@@ -1,3 +1,15 @@
+2008-12-12  Juanma Barranquero  <address@hidden>
+           Stefan Monnier  <address@hidden>
+
+       * 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,
+       and stop the server if it is running.
+       (server-running-p): Return t also for local TCP servers when we find a
+       process with a matching PID, and :other for undecided cases.
+
 2008-12-11  Martin Rudalics  <address@hidden>
 
        * window.el (fit-window-to-buffer): Use with-selected-window and

Index: server.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/server.el,v
retrieving revision 1.175
retrieving revision 1.176
diff -u -b -r1.175 -r1.176
--- server.el   18 Nov 2008 16:27:09 -0000      1.175
+++ server.el   12 Dec 2008 00:33:34 -0000      1.176
@@ -325,11 +325,12 @@
             (process-query-on-exit-flag proc))
     (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))))
+  ;; Although there's no 100% guarantee that the file is owned by the
+  ;; running Emacs instance, server-start uses server-running-p to check
+  ;; for possible servers before doing anything, so it *should* be ours.
+  (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 +459,27 @@
 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 a server is already running, 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 (not (eq t (server-running-p server-name)))
+         ;; Remove any leftover socket or authentication file
+         (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 +488,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 +520,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 +538,48 @@
                        " " (int-to-string (emacs-pid))
                        "\n" auth-key)))))))))
 
+;;;###autoload
+(defun server-force-delete (&optional name)
+  "Unconditionally delete connection file for server NAME.
+If server is running, it is first stopped.
+NAME defaults to `server-name'.  With argument, ask for NAME."
+  (interactive
+   (list (if current-prefix-arg
+            (read-string "Server name: " nil nil server-name))))
+  (when server-mode (with-temp-message nil (server-mode -1)))
+  (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 "No connection file %S" file)))))
+
 (defun server-running-p (&optional name)
-  "Test whether server NAME is running."
+  "Test whether server NAME is running.
+
+Return values:
+  nil              the server is definitely not running.
+  t                the server seems to be running.
+  something else   we cannot determine whether it's running without using
+                   commands which may have to wait for a long time."
   (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))))
+                    t)
+               :other))
        (delete-process
         (make-network-process
          :name "server-client-test" :family 'local :server nil :noquery t