SLIME is very cool; thanks.
It's a shame it's not very secure, though. Below is a patch which
addresses the two problems I've found:
* /tmp file vulnerability. In slime-swank-port-file, the code falls
back to putting the temporary file used to communicate the port
number in /tmp. The filename contains the pid of the running Emacs
process which is easy to guess. In ANNOUNCE-SERVER-PORT, the
server-port file is written :IF-EXISTS :OVERWRITE, which means that
another user can put a symlink in /tmp/slime.PID pointing at one of
your precious files and leave SLIME to trash it for you. Not good.
I just made it be :IF-EXISTS :ERROR which seems fine given that
slime-inferior-connect deleted it if it was an ordinary file.
* Any local user can connect. I addressed this one quite simply. If
there is a file .slime-secret in the user's home directory, then
SWANK will reject an connection unless the first sexp read through
it is a string matching the first line of that file. Similarly, the
Emacs side will send the correct thing, if it can. This neatly
sidesteps all of the hard and system-specific questions about
generating random numbers and file permissions that more complex
solutions would involve, largely by leaving them up to the user.
The downside is that this leaves the system insecure by default,
which is still bad, but I care less.
This fix isn't ideal: I suspect there will be problems from a
mismatch between Emacs's idea of home directory (usually the HOME
environment variable) and the Common Lisp system's
USER-HOMEDIR-PATHNAME. It seems right on Unix; I've no idea what
it'll do on any other system. Besides, `.slime-secret' seems a poor
filename for Windows, even though it will work. The difficulty here
is making sure that Emacs and CL agree on which name to use. I
decided that, at least for now, a reliable but ugly name was a
better choice.
My patch is against the code in the Debian 2:1.0.cvs-20050116 package; I
hope that's vaguely useful. The change is quite simple, though.
diff -ru slime-1.0.cvs/slime.el slime-1.0.cvs+mdw/slime.el
--- slime-1.0.cvs/slime.el 2005-01-16 12:29:52.000000000 +0000
+++ slime-1.0.cvs+mdw/slime.el 2005-04-30 23:48:39.000000000 +0100
@@ -1480,6 +1480,21 @@
"A list of valid coding systems.
Each element is of the form: (NAME MULTIBYTEP CL-NAME)")
+(defun slime-secret ()
+ "Finds the magic secret from the user's home directory. Returns nil
+if the file doesn't exist or is empty; otherwise the first line of the
+file."
+ (condition-case err
+ (with-temp-buffer
+ (insert-file-contents "~/.slime-secret")
+ (goto-char (point-min))
+ (buffer-substring 1
+ (let ((nl (search-forward "\n" nil t nil)))
+ (if nl
+ (- nl 1)
+ (point-max)))))
+ (file-error nil)))
+
;;; Interface
(defun slime-net-connect (host port)
"Establish a connection with a CL."
@@ -1496,6 +1511,8 @@
(set-process-coding-system proc
slime-net-coding-system
slime-net-coding-system))
+ (when-let (secret (slime-secret))
+ (slime-net-send secret proc))
proc))
(defun slime-make-net-buffer (name)
@@ -2421,6 +2438,8 @@
(set-process-coding-system stream
slime-net-coding-system
slime-net-coding-system)
+ (when-let (secret (slime-secret))
+ (slime-net-send secret stream))
stream))
(defun slime-output-string (string)
diff -ru slime-1.0.cvs/swank.lisp slime-1.0.cvs+mdw/swank.lisp
--- slime-1.0.cvs/swank.lisp 2005-01-16 12:29:53.000000000 +0000
+++ slime-1.0.cvs+mdw/swank.lisp 2005-05-01 00:32:01.000000000 +0100
@@ -294,6 +294,24 @@
(defvar *use-dedicated-output-stream* t)
(defvar *communication-style* (preferred-communication-style))
+(defun slime-secret ()
+ "Finds the magic secret from the user's home directory. Returns nil
+if the file doesn't exist; otherwise the first line of the file."
+ (with-open-file (in
+ (merge-pathnames (user-homedir-pathname)
+ #+unix #p".slime-secret")
+ :if-does-not-exist nil)
+ (and in (read-line in nil ""))))
+
+(defun accept-authenticated-connection (&rest args)
+ (let ((new (apply #'accept-connection args))
+ (secret (slime-secret)))
+ (when secret
+ (unless (string= (decode-message new) secret)
+ (close new)
+ (error "Incoming connection doesn't know the password.")))
+ new))
+
(defun start-server (port-file &key (style *communication-style*)
dont-close (external-format *coding-system*))
"Start the server and write the listen port number to PORT-FILE.
@@ -337,7 +355,8 @@
port)))
(defun serve-connection (socket style dont-close external-format)
- (let ((client (accept-connection socket :external-format external-format)))
+ (let ((client (accept-authenticated-connection
+ socket :external-format external-format)))
(unless dont-close
(close-socket socket))
(let ((connection (create-connection client style external-format)))
@@ -352,7 +371,7 @@
(defun announce-server-port (file port)
(with-open-file (s file
:direction :output
- :if-exists :overwrite
+ :if-exists :error
:if-does-not-exist :create)
(format s "~S~%" port))
(simple-announce-function port))
@@ -406,7 +425,8 @@
(let* ((socket (create-socket *loopback-interface* 0))
(port (local-port socket)))
(encode-message `(:open-dedicated-output-stream ,port) socket-io)
- (accept-connection socket :external-format external-format)))
+ (accept-authenticated-connection
+ socket :external-format external-format)))
(defun handle-request (connection)
"Read and process one request. The processing is done in the extend
-- [mdw]
