[slime-cvs] CVS update: slime/swank.lisp

[Luke Gorrie]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv30730

Modified Files:
	swank.lisp 
Log Message:
If ~/.slime-secret exists then insist that Emacs sends the contents
(as a password) during initial handshaking.

(announce-server-port): Use :IF-EXISTS :ERROR to prevent bad guys from
slipping a symlink into /tmp and reading what port Lisp is listening
on.

Date: Mon May  2 20:44:51 2005
Author: lgorrie

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.295 slime/swank.lisp:1.296
--- slime/swank.lisp:1.295	Thu Apr 21 09:39:12 2005
+++ slime/swank.lisp	Mon May  2 20:44:50 2005
@@ -373,7 +373,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)))
@@ -381,6 +382,24 @@
       (push connection *connections*)
       (serve-requests connection))))
 
+(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 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 serve-requests (connection)
   "Read and process all requests on connections."
   (funcall (connection.serve-requests connection) connection))
@@ -388,7 +407,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))
@@ -442,7 +461,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