1 files changed, 96 insertions, 48 deletions

diff --git a/lisp/server.el b/lisp/server.el
index 404bebc4747..1e2f458ac9c 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -139,6 +139,32 @@ directory residing in a NTFS partition instead."
 ;;;###autoload
 (put 'server-auth-dir 'risky-local-variable t)
 
+(defcustom server-auth-key nil
+  "Server authentication key.
+
+Normally, the authentication key is randomly generated when the
+server starts, which guarantees some level of security.  It is
+recommended to leave it that way.  Using a long-lived shared key
+will decrease security (especially since the key is transmitted as
+plain text).
+
+In some situations however, it can be difficult to share randomly
+generated passwords with remote hosts (eg. no shared directory),
+so you can set the key with this variable and then copy the
+server file to the remote host (with possible changes to IP
+address and/or port if that applies).
+
+The key must consist of 64 ASCII printable characters except for
+space (this means characters from ! to ~; or from code 33 to 126).
+
+You can use \\[server-generate-key] to get a random authentication
+key."
+  :group 'server
+  :type '(choice
+          (const :tag "Random" nil)
+          (string :tag "Password"))
+  :version "24.2")
+
 (defcustom server-raise-frame t
   "If non-nil, raise frame when switching to a buffer."
   :group 'server
@@ -494,41 +520,62 @@ Creates the directory if necessary and makes sure:
     ;; Check that it's safe for use.
     (let* ((uid (nth 2 attrs))
            (w32 (eq system-type 'windows-nt))
-           (safe (catch :safe
-                   (unless (eq t (car attrs))   ; is a dir?
-                     (throw :safe nil))
-                   (when (and w32 (zerop uid))  ; on FAT32?
-                     (display-warning
-                      'server
-                      (format "Using `%s' to store Emacs-server authentication files.
+           (safe (cond
+                  ((not (eq t (car attrs))) nil)  ; is a dir?
+                  ((and w32 (zerop uid))          ; on FAT32?
+                   (display-warning
+                    'server
+                    (format "Using `%s' to store Emacs-server authentication files.
 Directories on FAT32 filesystems are NOT secure against tampering.
 See variable `server-auth-dir' for details."
-                              (file-name-as-directory dir))
-                      :warning)
-                     (throw :safe t))
-                   (unless (or (= uid (user-uid)) ; is the dir ours?
-                               (and w32
-                                    ;; Files created on Windows by
-                                    ;; Administrator (RID=500) have
-                                    ;; the Administrators (RID=544)
-                                    ;; group recorded as the owner.
-                                    (= uid 544) (= (user-uid) 500)))
-                     (throw :safe nil))
-                   (when w32                    ; on NTFS?
-                     (throw :safe t))
-                   (unless (zerop (logand ?\077 (file-modes dir)))
-                     (throw :safe nil))
-                   t)))
+                            (file-name-as-directory dir))
+                    :warning)
+                   t)
+                  ((and (/= uid (user-uid))       ; is the dir ours?
+                        (or (not w32)
+                            ;; Files created on Windows by Administrator
+                            ;; (RID=500) have the Administrators (RID=544)
+                            ;; group recorded as the owner.
+                            (/= uid 544) (/= (user-uid) 500)))
+                   nil)
+                  (w32 t)                         ; on NTFS?
+                  (t                              ; else, check permissions
+                   (zerop (logand ?\077 (file-modes dir)))))))
       (unless safe
         (error "The directory `%s' is unsafe" dir)))))
 
+(defun server-generate-key ()
+  "Generate and return a random authentication key.
+The key is a 64-byte string of random chars in the range `!'..`~'.
+If called interactively, also inserts it into current buffer."
+  (interactive)
+  (let ((auth-key
+         (loop repeat 64
+               collect (+ 33 (random 94)) into auth
+               finally return (concat auth))))
+    (if (called-interactively-p 'interactive)
+        (insert auth-key))
+    auth-key))
+
+(defun server-get-auth-key ()
+  "Return server's authentication key.
+
+If `server-auth-key' is nil, just call `server-generate-key'.
+Otherwise, if `server-auth-key' is a valid key, return it.
+If the key is not valid, signal an error."
+  (if server-auth-key
+    (if (string-match-p "^[!-~]\\{64\\}$" server-auth-key)
+        server-auth-key
+      (error "The key '%s' is invalid" server-auth-key))
+    (server-generate-key)))
+
 ;;;###autoload
 (defun server-start (&optional leave-dead inhibit-prompt)
   "Allow this Emacs process to be a server for client processes.
-This starts a server communications subprocess through which
-client \"editors\" can send your editing commands to this Emacs
-job.  To use the server, set up the program `emacsclient' in the
-Emacs distribution as your standard \"editor\".
+This starts a server communications subprocess through which client
+\"editors\" can send your editing commands to this Emacs job.
+To use the server, set up the program `emacsclient' in the Emacs
+distribution as your standard \"editor\".
 
 Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
 kill any existing server communications subprocess.
@@ -615,13 +662,7 @@ server or call `M-x server-force-delete' to forcibly disconnect it.")
           (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
-                    ;; The auth key is a 64-byte string of random chars in the
-                    ;; range `!'..`~'.
-                    repeat 64
-                    collect (+ 33 (random 94)) into auth
-                    finally return (concat auth))))
+            (let ((auth-key (server-get-auth-key)))
               (process-put server-process :auth-key auth-key)
               (with-temp-file server-file
                 (set-buffer-multibyte nil)
@@ -780,10 +821,6 @@ This handles splitting the command if it would be bigger than
     (select-frame frame)
     (process-put proc 'frame frame)
     (process-put proc 'terminal (frame-terminal frame))
-
-    ;; Display *scratch* by default.
-    (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
-
     frame))
 
 (defun server-create-window-system-frame (display nowait proc parent-id
@@ -816,9 +853,6 @@ This handles splitting the command if it would be bigger than
       (select-frame frame)
       (process-put proc 'frame frame)
       (process-put proc 'terminal (frame-terminal frame))
-
-      ;; Display *scratch* by default.
-      (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
       frame)))
 
 (defun server-goto-toplevel (proc)
@@ -1042,8 +1076,9 @@ The following commands are accepted by the client:
 
                 ;; -window-system:  Open a new X frame.
                 (`"-window-system"
-                 (setq dontkill t)
-                 (setq tty-name 'window-system))
+                 (if (fboundp 'x-create-frame)
+                     (setq dontkill t
+                           tty-name 'window-system)))
 
                 ;; -resume:  Resume a suspended tty frame.
                 (`"-resume"
@@ -1071,7 +1106,8 @@ The following commands are accepted by the client:
                  (setq dontkill t)
                  (pop args-left))
 
-                ;; -tty DEVICE-NAME TYPE:  Open a new tty frame at the client.
+                ;; -tty DEVICE-NAME TYPE:  Open a new tty frame.
+                ;; (But if we see -window-system later, use that.)
                 (`"-tty"
                  (setq tty-name (pop args-left)
                        tty-type (pop args-left)
@@ -1133,6 +1169,13 @@ The following commands are accepted by the client:
                 ;; Unknown command.
                 (arg (error "Unknown command: %s" arg))))
 
+            ;; If both -no-wait and -tty are given with file or sexp
+            ;; arguments, use an existing frame.
+            (and nowait
+                 (not (eq tty-name 'window-system))
+                 (or files commands)
+                 (setq use-current-frame t))
+
             (setq frame
                   (cond
                    ((and use-current-frame
@@ -1182,12 +1225,17 @@ The following commands are accepted by the client:
   ;; including code that needs to wait.
   (with-local-quit
     (condition-case err
-        (let* ((buffers
-                (when files
-                  (server-visit-files files proc nowait))))
-
+        (let ((buffers (server-visit-files files proc nowait)))
           (mapc 'funcall (nreverse commands))
 
+          ;; If we were told only to open a new client, obey
+          ;; `initial-buffer-choice' if it specifies a file.
+          (unless (or files commands)
+            (if (stringp initial-buffer-choice)
+                (find-file initial-buffer-choice)
+              (switch-to-buffer (get-buffer-create "*scratch*")
+                                'norecord)))
+
           ;; Delete the client if necessary.
           (cond
            (nowait