[slime-devel] SLIME security patch

[Mark Wooding]

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]