[PATCH] A myriad of interrelated daemon-mode startup bugs

[Nix <nix@esperi.org.uk>]

[Stefan Cc:ed because part of this is fixing lexical-binding fallout,
 and as a way of saying thank you for fixing a bug of mine: here's a
 fix for a bug of yours! :) ]

Startup of --daemon mode has long been iffy: if the startup lisp asks
for input it's nearly impossible to comply owing to the two emacsen
contending for input, but recently it degenerated beyond that and ceased
working for me entirely.  There were not one but multiple interrelated
problems.  (This does *not* fix the contending-for-input bug, though
I plan to fix that fairly soon as well.)

This patch against trunk, though extremely provisional, is enough to
allow Emacs to start in daemon mode for me, and to abort with an error
message if there is an uncaught error.  If I was surer that this patch
was right I'd have opened a bug, but I'm not sure how many of these
problems really *are* bugs, I'm fairly sure at least one piece of the
patch is too ugly to live, and the whole thing definitely needs review.
I may be overcomplicating things.

I can split the patch up into bits that fix one bug at a time if you
like, but I can't test all the pieces independently because without all
the fixes in place --daemon doesn't start for me (though not all are
needed if starting with -Q, some are).


It fixes the following bugs:

 - errors, throws, and file EOFs that propagate to top-level before the
   call to `daemon-initialized' lead to a hang forever with no message
   of any kind, since the daemon is waiting in a command loop that has
   nothing to read from or write to.  Fixed by introducing a new
   daemon_initialized variable that is checked by the EOF code in
   command_loop() and the catch code in cmd_error_internal().

 - errors thrown while the server is starting -- e.g. from
   `server-ensure-safe-dir' -- lead to a hang forever, or in the
   presence of the patch above can leak a server process, as the
   server-start call is not wrapped in a condition-case, and the
   exception propagates to the top level without killing the server (if
   it has started).

 - `server-ensure-safe-dir' was itself broken by the recent change of
   files.el to lexical-binding.  It binds `default-file-modes' around
   a call to `make-directory' for the server directory, but in lexical
   scoping mode this has no effect at all, leading to an instant failure
   if your umask allows e.g. group access (and, in the absence of the
   fixes above, a mysterious and silent hang).  More generally, in lexical
   scoping mode there is *no* way to affect the mode used to create a
   directory.  This is obviously unacceptable, so I've added a new
   optional octal mode argument to `make-directory' and
   `make-directory-internal', modelled explicitly on `set-file-modes',
   and used it in `server-ensure-safe-dir'.  (Best to set its mode
   immediately rather than resetting afterwards to avoid the
   possibility of racing with an attacker.)

   I hope the `make-directory' change is noncontentious but suspect it
   may attract a bit of bikeshedding.  Bikeshed away! :)

Finally, a bit I'm uncertain of:
 
 - code that listens for user input on exit -- and following the change
   in when kill-emacs-hook is run, there is some, notably
   `desktop-kill', which you *do* want to run on kill-emacs and which
   can ask for user input -- has no way to tell if it is being run
   because the server failed to start, in which case we don't want to go
   begging the user for help because we've already printed a
   presumably-fatal error message and the user just wants us to go away.
   Temporarily bind `noninteractive' to t to let such code know that it
   shouldn't ask the user any questions.  Code that is asking questions
   when noninteractive is t (e.g. desktop.el) is buggy even in the
   absence of this change.

   This works but is disgusting, and not just because it relies on
   `noninteractive' having no hyphens in and thus being dynamically
   bound. It probably needs fixing, but there must be a better way.

   (A hopefully noncontentious related change has `desktop-kill' check
   `noninteractive' and not ask questions about saving the desktop if
   this is not an interactive session.)

(aside: the guy in the changelog is me: work and non-work worlds
colliding and all that)


src/ChangeLog:

2012-11-13  Nick Alcock  <nick.alcock@oracle.com>

	* src/emacs.c (daemon_initialized): New variable.
	(Fdaemon_initialized): Set it.
	* src/lisp.h: Declare it.
	* src/keyboard.c (cmd_error_internal): Check it here...
	(command_loop): ... and here.
	* src/fileio.c (Fmake_directory_internal): New mode arg.

lisp/ChangeLog:

2012-11-13  Nick Alcock  <nick.alcock@oracle.com>

	* lisp/files.el (make-directory): New mode arg.
	* lisp/desktop.el (desktop-kill): Only ask questions when interactive.
	* lisp/server.el (server-ensure-safe-dir): Use it rather than relying
	on dynamic binding.
	* lisp/startup.el (command-line): Protect against nonlocal exit of
	`server-start'.  Go noninteractive around kill on failure to start.

=== modified file 'lisp/desktop.el'
Index: lisp/desktop.el
===================================================================
--- lisp/desktop.el.orig	2012-11-13 16:36:38.833375966 +0000
+++ lisp/desktop.el	2012-11-13 16:38:18.634889091 +0000
@@ -627,6 +627,7 @@
                    (and
                     (or (memq desktop-save '(ask ask-if-new))
                         (and exists (eq desktop-save 'ask-if-exists)))
+                    (and (not noninteractive))
                     (y-or-n-p "Save desktop? ")))))
     (unless desktop-dirname
       (setq desktop-dirname
Index: lisp/files.el
===================================================================
--- lisp/files.el.orig	2012-11-13 16:36:38.833375966 +0000
+++ lisp/files.el	2012-11-13 16:38:18.634889091 +0000
@@ -4900,10 +4900,12 @@
       (rename-buffer (generate-new-buffer-name base-name))
       (force-mode-line-update))))
 
-(defun make-directory (dir &optional parents)
+(defun make-directory (dir &optional parents mode)
   "Create the directory DIR and optionally any nonexistent parent dirs.
 If DIR already exists as a directory, signal an error, unless
-PARENTS is non-nil.
+PARENTS is non-nil.  MODE is an integer used to set the mode bits of
+the new directories, as in `set-file-modes'.  If unset, the
+`default-file-modes' are used.
 
 Interactively, the default choice of directory to create is the
 current buffer's default directory.  That is useful when you have
@@ -4926,7 +4928,7 @@
     (if handler
 	(funcall handler 'make-directory dir parents)
       (if (not parents)
-	  (make-directory-internal dir)
+	  (make-directory-internal dir (or mode (default-file-modes)))
 	(let ((dir (directory-file-name (expand-file-name dir)))
 	      create-list)
 	  (while (and (not (file-exists-p dir))
@@ -4938,7 +4940,8 @@
 	    (setq create-list (cons dir create-list)
 		  dir (directory-file-name (file-name-directory dir))))
 	  (while create-list
-	    (make-directory-internal (car create-list))
+	    (make-directory-internal (car create-list)
+				     (or mode (default-file-modes)))
 	    (setq create-list (cdr create-list))))))))
 
 (defconst directory-files-no-dot-files-regexp
Index: lisp/server.el
===================================================================
--- lisp/server.el.orig	2012-11-13 16:36:38.833375966 +0000
+++ lisp/server.el	2012-11-13 16:38:18.634889091 +0000
@@ -520,7 +520,7 @@
   (setq dir (directory-file-name dir))
   (let ((attrs (file-attributes dir 'integer)))
     (unless attrs
-      (cl-letf (((default-file-modes) ?\700)) (make-directory dir t))
+      (make-directory dir t ?\700)
       (setq attrs (file-attributes dir 'integer)))
 
     ;; Check that it's safe for use.
Index: lisp/startup.el
===================================================================
--- lisp/startup.el.orig	2012-11-13 16:36:38.833375966 +0000
+++ lisp/startup.el	2012-11-13 16:38:25.534302405 +0000
@@ -1236,7 +1236,9 @@
   (let ((dn (daemonp)))
     (when dn
       (when (stringp dn) (setq server-name dn))
-      (server-start)
+      (condition-case err
+	  (server-start)
+	(error (message (error-message-string err))))
       (if server-process
 	  (daemon-initialized)
 	(if (stringp dn)
@@ -1244,7 +1246,12 @@
 	     "Unable to start daemon: Emacs server named %S already running"
 	     server-name)
 	  (message "Unable to start the daemon.\nAnother instance of Emacs is running the server, either as daemon or interactively.\nYou can use emacsclient to connect to that Emacs process."))
-	(kill-emacs 1))))
+	;; We must pretend to be noninteractive at this point to tell
+	;; kill-emacs-hook functions that read input if interactive
+	;; not to do so, since reads from stdin are shared with the
+	;; parent.
+	(let ((noninteractive t))
+	    (kill-emacs 1)))))
 
   ;; Run emacs-session-restore (session management) if started by
   ;; the session manager and we have a session manager connection.
Index: src/emacs.c
===================================================================
--- src/emacs.c.orig	2012-11-13 16:36:38.833375966 +0000
+++ src/emacs.c	2012-11-13 16:38:18.644888244 +0000
@@ -194,6 +194,10 @@
    startup.  */
 int daemon_pipe[2];
 
+/* True if the Emacs daemon is initialized.  False if either there is no daemon
+   or it is not initialized yet.  */
+bool daemon_initialized;
+
 /* Save argv and argc.  */
 char **initial_argv;
 int initial_argc;
@@ -2263,6 +2267,9 @@
 
   if (err)
     error ("I/O error during daemon initialization");
+
+  daemon_initialized = 1;
+
   return Qt;
 }
 
Index: src/fileio.c
===================================================================
--- src/fileio.c.orig	2012-11-13 16:36:38.833375966 +0000
+++ src/fileio.c	2012-11-13 16:38:18.644888244 +0000
@@ -2083,15 +2083,16 @@
 }
 \f
 DEFUN ("make-directory-internal", Fmake_directory_internal,
-       Smake_directory_internal, 1, 1, 0,
-       doc: /* Create a new directory named DIRECTORY.  */)
-  (Lisp_Object directory)
+       Smake_directory_internal, 2, 2, 0,
+       doc: /* Create a new directory named DIRECTORY, with mode MODE.  */)
+  (Lisp_Object directory, Lisp_Object mode)
 {
   const char *dir;
   Lisp_Object handler;
   Lisp_Object encoded_dir;
 
   CHECK_STRING (directory);
+  CHECK_NUMBER (mode);
   directory = Fexpand_file_name (directory, Qnil);
 
   handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
@@ -2105,7 +2106,7 @@
 #ifdef WINDOWSNT
   if (mkdir (dir) != 0)
 #else
-  if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
+  if (mkdir (dir, (XINT (mode) & 07777) & ~auto_saving_dir_umask) != 0)
 #endif
     report_file_error ("Creating directory", list1 (directory));
 
Index: src/keyboard.c
===================================================================
--- src/keyboard.c.orig	2012-11-13 16:36:38.833375966 +0000
+++ src/keyboard.c	2012-11-13 16:38:18.644888244 +0000
@@ -1099,8 +1099,10 @@
 	      write to stderr and quit.  In daemon mode, there are
 	      many other potential errors that do not prevent frames
 	      from being created, so continuing as normal is better in
-	      that case.  */
+	      that case, unless an error has been thrown before the
+	      daemon has been fully initialized.  */
 	   || (!IS_DAEMON && FRAME_INITIAL_P (sf))
+	   || (IS_DAEMON && !daemon_initialized)
 	   || noninteractive)
     {
       print_error_message (data, Qexternal_debugging_output,
@@ -1146,8 +1148,10 @@
 	internal_catch (Qtop_level, command_loop_2, Qnil);
 	executing_kbd_macro = Qnil;
 
-	/* End of file in -batch run causes exit here.  */
-	if (noninteractive)
+	/* End of file in -batch run or before the daemon is
+	   initialized causes exit here.  */
+	if ((noninteractive) ||
+	    (IS_DAEMON && !daemon_initialized))
 	  Fkill_emacs (Qt);
       }
 }
Index: src/lisp.h
===================================================================
--- src/lisp.h.orig	2012-11-13 16:36:38.833375966 +0000
+++ src/lisp.h	2012-11-13 16:38:18.644888244 +0000
@@ -3343,6 +3343,10 @@
 extern int daemon_pipe[2];
 #define IS_DAEMON (daemon_pipe[1] != 0)
 
+/* True if the Emacs daemon is initialized.  False if either there is no daemon
+   or it is not initialized yet.  */
+extern bool daemon_initialized;
+
 /* True if handling a fatal error already.  */
 extern bool fatal_error_in_progress;