[RESEND] lisp/server.el: Allow custom server-auth-key

[Michal Nazarewicz <mina86@mina86.com>]

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)