bug#58877: 29.0.50; [PATCH] When killing Emacs from a client frame with no other frames, Emacs shows a useless error prompt

[Jim Porter <jporterbugs@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2273 bytes --]

On 10/29/2022 11:14 PM, Eli Zaretskii wrote:
>> Date: Sat, 29 Oct 2022 14:33:42 -0700
>> From: Jim Porter <jporterbugs@gmail.com>
>>
>> Attached is a patch to do this. Note that I named the new argument
>> "noframe" because that matches the existing code in server.el (see
>> 'server-delete-client'). It's a bit of a misnomer though, and maybe
>> "keep-frames" would be better...
> 
> Hmm... it doesn't look very elegant to add to server-start an extra
> argument whose purpose is to affect server-delete-client.  Can we do
> this in some more elegant way?  For example, how about making most of
> the code in server-start an internal function with an additional
> argument, and then have server-start and server-force-stop call that
> internal function?  At the very least the new argument to server-start
> shouldn't be advertised, I think, since it's entirely for internal use
> by us.

Thanks for taking a look. I had hesitated to make any big changes to 
this code since it doesn't have regression tests, but I think the 
attached patch should be more elegant while retaining the flow of the 
code as much as possible. Do you know of a good way to write regression 
tests for this code? I couldn't find any existing tests that start/stop 
Emacs processes in a way that I could use for testing this. It seems 
like we'd need to be able to start a new Emacs process and then be able 
to send arbitrary key combinations to it to drive it...

Back to the patch itself though: one small functional change I made was 
that I slightly changed how 'server-ensure-safe-dir' is called in 
'server-start'. (I only mention this because this code looks to be 
security-related, so I think it should have extra attention.)

It used to check the 'server-dir', defined as:

   (if server-use-tcp server-auth-dir server-socket-dir)

Now, it checks the directory of the server *file*. The file is defined as:

   (expand-file-name server-name server-dir)

This could be different if 'server-name' (a defcustom) contains a slash. 
I think the new code is actually safer, since it checks the proper 
directory even if a user customized 'server-name' to have a slash or 
'..' or whatever. Still, I thought this change deserved a mention so 
that I don't inadvertently open a security hole.

[-- Attachment #2: 0001-Don-t-explicitly-delete-client-frames-when-killing-E.patch --]
[-- Type: text/plain, Size: 8648 bytes --]

From 54ee256adaad53a38712ca194bd9e1ba8b00a397 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Fri, 19 Nov 2021 20:14:33 -0800
Subject: [PATCH] Don't explicitly delete client frames when killing Emacs
 anyway

This eliminates a useless error prompt when killing Emacs from a
client frame when there are no other frames (bug#58877).

* lisp/server.el (server-running-external): New error.
(server--file-name): New function...
(server-eval-at): ... use it.
(server-start): Factor out server stopping code into...
(server-stop): ... here.
(server-force-stop): Use 'server-stop', and tell it not to delete
frames.
---
 lisp/server.el | 132 +++++++++++++++++++++++++++++--------------------
 1 file changed, 78 insertions(+), 54 deletions(-)

diff --git a/lisp/server.el b/lisp/server.el
index 90d97c1538..095de06cf9 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -287,6 +287,8 @@ server-socket-dir
   "The directory in which to place the server socket.
 If local sockets are not supported, this is nil.")
 
+(define-error 'server-running-external "External server running")
+
 (defun server-clients-with (property value)
   "Return a list of clients with PROPERTY set to VALUE."
   (let (result)
@@ -610,6 +612,59 @@ server-get-auth-key
       (error "The key `%s' is invalid" server-auth-key))
     (server-generate-key)))
 
+(defsubst server--file-name ()
+  "Return the file name to use for the server socket."
+  (let ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)))
+    (expand-file-name server-name server-dir)))
+
+(defun server-stop (&optional noframe)
+  "If this Emacs process has a server communication subprocess, stop it.
+If the server is running in some other Emac process (see
+`server-running-p'), signal a `server-running-external' error.
+
+If NOFRAME is non-nil, don't delete any existing frames
+associated with a client process.  This is useful, for example,
+when killing Emacs, in which case the frames will get deleted
+anyway."
+  (let ((server-file (server--file-name)))
+    (when server-process
+      ;; Kill it dead!
+      (ignore-errors (delete-process server-process))
+      (unless noframe
+        (server-log (message "Server stopped")))
+      (setq server-process nil))
+    (unwind-protect
+        ;; Check to see if an uninitialized external socket has been
+        ;; passed in.  If that is the case, skip checking
+        ;; `server-running-p' as this will return the wrong result.
+        (if (and internal--daemon-sockname
+                 (not server--external-socket-initialized))
+            (setq server--external-socket-initialized t)
+          ;; Delete the socket files made by previous server
+          ;; invocations.
+          (if (not (eq t (server-running-p server-name)))
+              ;; Remove any leftover socket or authentication file.
+              (ignore-errors
+                (let (delete-by-moving-to-trash)
+                  (delete-file server-file)
+                  ;; Also delete the directory that the server file was
+                  ;; created in -- but only in /tmp (see bug#44644).
+                  ;; There may be other servers running, too, so this may
+                  ;; fail.
+                  (when (equal (file-name-directory
+                                (directory-file-name
+                                 (file-name-directory server-file)))
+                               "/tmp/")
+                    (ignore-errors
+                      (delete-directory (file-name-directory server-file))))))
+            (setq server-mode nil) ;; already set by the minor mode code
+            (signal 'server-running-external
+                    (list (format "There is an existing Emacs server, named %S."
+                                  server-name)))))
+      ;; If this Emacs already had a server, clear out associated status.
+      (while server-clients
+        (server-delete-client (car server-clients) noframe)))))
+
 ;;;###autoload
 (defun server-start (&optional leave-dead inhibit-prompt)
   "Allow this Emacs process to be a server for client processes.
@@ -643,55 +698,25 @@ server-start
 	     (inhibit-prompt t)
 	     (t (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)))
-      ;; Check to see if an uninitialized external socket has been
-      ;; passed in, if that is the case, skip checking
-      ;; `server-running-p' as this will return the wrong result.
-      (if (and internal--daemon-sockname
-               (not server--external-socket-initialized))
-          (setq server--external-socket-initialized t)
-        ;; Delete the socket files made by previous server invocations.
-        (if (not (eq t (server-running-p server-name)))
-           ;; Remove any leftover socket or authentication file.
-           (ignore-errors
-             (let (delete-by-moving-to-trash)
-               (delete-file server-file)
-               ;; Also delete the directory that the server file was
-               ;; created in -- but only in /tmp (see bug#44644).
-               ;; There may be other servers running, too, so this may
-               ;; fail.
-               (when (equal (file-name-directory
-                             (directory-file-name
-                              (file-name-directory server-file)))
-                            "/tmp/")
-                 (ignore-errors
-                   (delete-directory (file-name-directory server-file))))))
-         (setq server-mode nil) ;; already set by the minor mode code
-         (display-warning
-          'server
-          (concat "Unable to start the Emacs server.\n"
-                  (format "There is an existing Emacs server, named %S.\n"
-                          server-name)
-                  (substitute-command-keys
-                    "To start the server in this Emacs process, stop the existing
+    ;; If a server is already running, try to stop it.
+    (condition-case err
+        (server-stop)
+      (server-running-external
+       (display-warning
+        'server
+        (concat "Unable to start the Emacs server.\n"
+                (cadr err)
+                (substitute-command-keys
+                 "\nTo start the server in this Emacs process, stop the existing
 server or call `\\[server-force-delete]' to forcibly disconnect it."))
-          :warning)
-         (setq leave-dead t)))
-      ;; If this Emacs already had a server, clear out associated status.
-      (while server-clients
-	(server-delete-client (car server-clients)))
-      ;; Now any previous server is properly stopped.
-      (if leave-dead
-	  (progn
-	    (unless (eq t leave-dead) (server-log (message "Server stopped")))
-	    (setq server-process nil))
-	;; Make sure there is a safe directory in which to place the socket.
-	(server-ensure-safe-dir server-dir)
-	(when server-process
+        :warning)
+       (setq leave-dead t)))
+    ;; Now any previous server is properly stopped.
+    (unless leave-dead
+      (let ((server-file (server--file-name)))
+        ;; Make sure there is a safe directory in which to place the socket.
+        (server-ensure-safe-dir (file-name-directory server-file))
+        (when server-process
 	  (server-log (message "Restarting server")))
         (with-file-modes ?\700
 	  (add-hook 'suspend-tty-functions #'server-handle-suspend-tty)
@@ -742,7 +767,7 @@ server-start
 (defun server-force-stop ()
   "Kill all connections to the current server.
 This function is meant to be called from `kill-emacs-hook'."
-  (server-start t t))
+  (ignore-errors (server-stop 'noframe)))
 
 ;;;###autoload
 (defun server-force-delete (&optional name)
@@ -1858,11 +1883,10 @@ server-eval-at
 cannot contact the specified server.  For example:
   (server-eval-at \"server\" \\='(emacs-pid))
 returns the process ID of the Emacs instance running \"server\"."
-  (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
-	 (server-file (expand-file-name server server-dir))
-	 (coding-system-for-read 'binary)
-	 (coding-system-for-write 'binary)
-	 address port secret process)
+  (let ((server-file (server--file-name))
+        (coding-system-for-read 'binary)
+        (coding-system-for-write 'binary)
+        address port secret process)
     (unless (file-exists-p server-file)
       (error "No such server: %s" server))
     (with-temp-buffer
-- 
2.25.1