bug#9423: lisp/server.el: Allow custom server-auth-key

[Stefan Monnier]

Package: emacs
Severity: wishlist
Tag: patch

> This patch adds a possibility to set create a custom server-auth-key
> which may be shared between several machines without the need of
> having common file system, etc.

> I'm resending this patch as last time the discussion somehow died.

> As for legal stuff, the patch is (c) Google Inc. but since Google has
> signed necessary agreement it should be no problem, right?

> Changelog entry is as follows:


> 2011-08-26  Michal Nazarewicz  <mina86@mina86.com>

>       * lisp/selver.el (server-auth-key, server-generate-key,
>       server-get-auth-key, server-start): Add possibility to set
>       server-auth-key instead of using random one each time.


> === modified file 'lisp/server.el'
> *** lisp/server.el    2011-07-04 22:40:03 +0000
> --- lisp/server.el    2011-08-08 14:12:01 +0000
> *************** directory residing in a NTFS partition i
> *** 134,139 ****
> --- 134,166 ----
>   ;;;###autoload
>   (put 'server-auth-dir 'risky-local-variable t)
  
> + (defcustom server-auth-key nil
> +   "Server authentication key.
> + 
> + Normally, authentication key is generated on random when server
> + starts, which guarantees some level of security.  It is
> + recommended to leave it that way.  Using a long-lived shared key
> + may decrease security (especially since the key is transmitted as
> + plain text).
> + 
> + In some situations however, it can be difficult to share randomly
> + generated password with remote hosts (eg. no shared directory),
> + so you can set the key with this variable and then copy server
> + file to remote host (with possible changes to IP address and/or
> + port if that applies).
> + 
> + The key must consist of 64 US-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.0")
> + 
>   (defcustom server-raise-frame t
>     "If non-nil, raise frame when switching to a buffer."
>     :group 'server
> *************** See variable `server-auth-dir' for detai
> *** 503,508 ****
> --- 530,561 ----
>         (unless safe
>       (error "The directory `%s' is unsafe" dir)))))
  
> + (defun server-generate-key ()
> +   "Generates and returns a random 64-byte strings 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)
> +     (insert auth-key))
> +     auth-key))
> + 
> + (defun server-get-auth-key ()
> +   "Returns server's authentication key.
> + 
> + If `server-auth-key' is nil this function will just call
> + `server-generate-key'.  Otherwise, if `server-auth-key' is
> + a valid authentication it will return it.  Otherwise, it will
> + signal an error."
> +   (if server-auth-key
> +     (if (string-match "^[!-~]\\{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.
> *************** server or call `M-x server-force-delete'
> *** 596,608 ****
>         (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))))
>             (process-put server-process :auth-key auth-key)
>             (with-temp-file server-file
>               (set-buffer-multibyte nil)
> --- 649,655 ----
>         (unless server-process (error "Could not start server process"))
>         (process-put server-process :server-file server-file)
>         (when server-use-tcp
> !         (let ((auth-key (server-get-auth-key)))
>             (process-put server-process :auth-key auth-key)
>             (with-temp-file server-file
>               (set-buffer-multibyte nil)