Hello,
The slime connection establishment is currently not very robust to
failed connection attempts. This could be a problem when using slime
to connect to long running processes. For example, if you telnet to
the slime listener port and close the connection then slime may hang
indefinitely waiting for the dedicated output connection to be established.
Further the sockets are not being closed reliably upon failed. The
attached patches reworks the code to close sockets upon failer and
adds timeouts while waiting for connections and when reading from the
connection. If there are no objections or feedback then I will commit
the changes later in the week.
Regards
Douglas Crosher
Index: ChangeLog
===================================================================
RCS file: /project/slime/cvsroot/slime/ChangeLog,v
retrieving revision 1.860
diff -u -r1.860 ChangeLog
--- ChangeLog 18 Mar 2006 07:45:18 -0000 1.860
+++ ChangeLog 19 Mar 2006 05:56:47 -0000
@@ -1,3 +1,30 @@
+2006-03-19 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-backend (accept-connection): add a 'timeout argument to
+ this function.
+
+ * swank-backend (set-stream-timeout): new implementation specific
+ function. Used to set the timeout for stream operations, which
+ can help make the network connection establishment more robust.
+
+ * swank (setup-server): ignore errors from the function 'serve to
+ allow another connection to be made.
+
+ * swank (serve-connection): ensure the listener socket is closed
+ when 'dont-close is false, even if the connection attempt fails.
+
+ * swank (accept-authenticated-connection): ensure the new
+ connection is closed if the connection establishment fails. Set a
+ short stream timeout to prevent denial of survice.
+
+ * swank (open-dedicated-output-stream): ensure the listener socket
+ is closed, even if unable to open the dedicated stream. Implement
+ a timeout while waiting for a connection for the dedicate stream
+ to prevent denial of service.
+
+ * swank (create-connection): ensure the new connection is closed
+ if not successful.
+
2006-03-18 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
* slime.el (slime-goto-location-buffer): Avoid calling the
Index: swank-allegro.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-allegro.lisp,v
retrieving revision 1.84
diff -u -r1.84 swank-allegro.lisp
--- swank-allegro.lisp 16 Mar 2006 18:34:17 -0000 1.84
+++ swank-allegro.lisp 19 Mar 2006 05:56:47 -0000
@@ -41,8 +41,9 @@
(defimplementation close-socket (socket)
(close socket))
-(defimplementation accept-connection (socket &key external-format buffering)
- (declare (ignore buffering))
+(defimplementation accept-connection (socket &key external-format buffering
+ timeout)
+ (declare (ignore buffering timeout))
(let ((ef (or external-format :iso-latin-1-unix))
(s (socket:accept-connection socket :wait t)))
(set-external-format s ef)
Index: swank-backend.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v
retrieving revision 1.96
diff -u -r1.96 swank-backend.lisp
--- swank-backend.lisp 25 Feb 2006 12:10:33 -0000 1.96
+++ swank-backend.lisp 19 Mar 2006 05:56:47 -0000
@@ -214,7 +214,7 @@
"Close the socket SOCKET.")
(definterface accept-connection (socket &key external-format
- buffering)
+ buffering timeout)
"Accept a client connection on the listening socket SOCKET.
Return a stream for the new connection.")
@@ -234,6 +234,12 @@
"Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
nil)
+(definterface set-stream-timeout (stream timeout)
+ "Set the 'stream 'timeout. The timeout is either the real number
+ specifying the timeout in seconds or 'nil for no timeout."
+ (declare (ignore stream timeout))
+ nil)
+
;;; Base condition for networking errors.
(define-condition network-error (simple-error) ())
Index: swank-clisp.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-clisp.lisp,v
retrieving revision 1.57
diff -u -r1.57 swank-clisp.lisp
--- swank-clisp.lisp 11 Nov 2005 23:43:43 -0000 1.57
+++ swank-clisp.lisp 19 Mar 2006 05:56:48 -0000
@@ -126,8 +126,8 @@
(defimplementation accept-connection (socket
&key (external-format :iso-latin-1-unix)
- buffering)
- (declare (ignore buffering))
+ buffering timeout)
+ (declare (ignore buffering timeout))
(socket:socket-accept socket
:buffered nil ;; XXX should be t
:element-type 'character
Index: swank-cmucl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-cmucl.lisp,v
retrieving revision 1.159
diff -u -r1.159 swank-cmucl.lisp
--- swank-cmucl.lisp 22 Nov 2005 10:32:37 -0000 1.159
+++ swank-cmucl.lisp 19 Mar 2006 05:56:48 -0000
@@ -100,7 +100,9 @@
(defimplementation accept-connection (socket &key
(external-format :iso-latin-1-unix)
- (buffering :full))
+ (buffering :full)
+ timeout)
+ (declare (ignore timeout))
(unless (eq external-format ':iso-latin-1-unix)
(remove-fd-handlers socket)
(remove-sigio-handlers socket)
Index: swank-corman.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-corman.lisp,v
retrieving revision 1.5
diff -u -r1.5 swank-corman.lisp
--- swank-corman.lisp 11 Nov 2005 23:43:43 -0000 1.5
+++ swank-corman.lisp 19 Mar 2006 05:56:48 -0000
@@ -239,8 +239,8 @@
(defimplementation accept-connection (socket
&key (external-format :iso-latin-1-unix)
- buffering)
- (declare (ignore buffering))
+ buffering timeout)
+ (declare (ignore buffering timeout))
(ecase external-format
(:iso-latin-1-unix
(sockets:make-socket-stream (sockets:accept-socket socket)))))
Index: swank-ecl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-ecl.lisp,v
retrieving revision 1.4
diff -u -r1.4 swank-ecl.lisp
--- swank-ecl.lisp 11 Nov 2005 23:43:43 -0000 1.4
+++ swank-ecl.lisp 19 Mar 2006 05:56:48 -0000
@@ -46,8 +46,8 @@
(defimplementation accept-connection (socket
&key (external-format :iso-latin-1-unix)
- buffering)
- (declare (ignore buffering))
+ buffering timeout)
+ (declare (ignore buffering timeout))
(assert (eq external-format :iso-latin-1-unix))
(make-socket-io-stream (accept socket) external-format))
Index: swank-lispworks.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-lispworks.lisp,v
retrieving revision 1.82
diff -u -r1.82 swank-lispworks.lisp
--- swank-lispworks.lisp 10 Feb 2006 16:54:01 -0000 1.82
+++ swank-lispworks.lisp 19 Mar 2006 05:56:48 -0000
@@ -67,8 +67,8 @@
(defimplementation accept-connection (socket
&key (external-format :iso-latin-1-unix)
- buffering)
- (declare (ignore buffering))
+ buffering timeout)
+ (declare (ignore buffering timeout))
(assert (eq external-format :iso-latin-1-unix))
(let* ((fd (comm::get-fd-from-socket socket)))
(assert (/= fd -1))
Index: swank-openmcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-openmcl.lisp,v
retrieving revision 1.106
diff -u -r1.106 swank-openmcl.lisp
--- swank-openmcl.lisp 7 Mar 2006 09:51:52 -0000 1.106
+++ swank-openmcl.lisp 19 Mar 2006 05:56:48 -0000
@@ -168,8 +168,8 @@
(defimplementation accept-connection (socket
&key (external-format :iso-latin-1-unix)
- buffering)
- (declare (ignore buffering))
+ buffering timeout)
+ (declare (ignore buffering timeout))
(assert (eq external-format :iso-latin-1-unix))
(ccl:accept-connection socket :wait t))
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.152
diff -u -r1.152 swank-sbcl.lisp
--- swank-sbcl.lisp 20 Jan 2006 21:31:20 -0000 1.152
+++ swank-sbcl.lisp 19 Mar 2006 05:56:49 -0000
@@ -60,7 +60,8 @@
(defimplementation accept-connection (socket &key
(external-format :iso-latin-1-unix)
- (buffering :full))
+ (buffering :full) timeout)
+ (declare (ignore timeout))
(make-socket-io-stream (accept socket) external-format buffering))
(defvar *sigio-handlers* '()
Index: swank-scl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-scl.lisp,v
retrieving revision 1.5
diff -u -r1.5 swank-scl.lisp
--- swank-scl.lisp 25 Feb 2006 17:46:13 -0000 1.5
+++ swank-scl.lisp 19 Mar 2006 05:56:49 -0000
@@ -54,10 +54,23 @@
(defimplementation accept-connection (socket &key
(external-format :iso-latin-1-unix)
- (buffering :full))
- (let ((external-format (or external-format :iso-latin-1-unix)))
- (make-socket-io-stream (ext:accept-tcp-connection socket)
- external-format buffering)))
+ (buffering :full)
+ (timeout nil))
+ (let ((external-format (or external-format :iso-latin-1-unix))
+ (fd (socket-fd socket)))
+ (loop
+ (let ((ready (sys:wait-until-fd-usable fd :input timeout)))
+ (unless ready
+ (error "Timeout accepting connection on socket: ~S~%" socket)))
+ (let ((new-fd (ignore-errors (ext:accept-tcp-connection fd))))
+ (when new-fd
+ (return (make-socket-io-stream new-fd external-format buffering)))))))
+
+(defimplementation set-stream-timeout (stream timeout)
+ (check-type timeout (or null real))
+ (if (fboundp 'ext::stream-timeout)
+ (setf (ext::stream-timeout stream) timeout)
+ (setf (slot-value (slot-value stream 'cl::stream) 'cl::timeout) timeout)))
;;;;; Sockets
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.364
diff -u -r1.364 swank.lisp
--- swank.lisp 18 Mar 2006 07:37:22 -0000 1.364
+++ swank.lisp 19 Mar 2006 05:56:50 -0000
@@ -424,7 +424,7 @@
(serve-connection socket style dont-close external-format)))
(ecase style
(:spawn
- (spawn (lambda () (loop do (serve) while dont-close))
+ (spawn (lambda () (loop do (ignore-errors (serve)) while dont-close))
:name "Swank"))
((:fd-handler :sigio)
(add-fd-handler socket (lambda () (serve))))
@@ -432,23 +432,34 @@
port)))
(defun serve-connection (socket style dont-close 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)))
- (run-hook *new-connection-hook* connection)
- (push connection *connections*)
- (serve-requests connection))))
+ (let ((closed-socket-p nil))
+ (unwind-protect
+ (let ((client (accept-authenticated-connection
+ socket :external-format external-format)))
+ (unless dont-close
+ (close-socket socket)
+ (setf closed-socket-p t))
+ (let ((connection (create-connection client style external-format)))
+ (run-hook *new-connection-hook* connection)
+ (push connection *connections*)
+ (serve-requests connection)))
+ (unless (or dont-close closed-socket-p)
+ (close-socket socket)))))
(defun accept-authenticated-connection (&rest args)
(let ((new (apply #'accept-connection args))
- (secret (slime-secret)))
- (when secret
- (let ((first-val (decode-message new)))
- (unless (and (stringp first-val) (string= first-val secret))
- (close new)
- (error "Incoming connection doesn't know the password."))))
+ (success nil))
+ (unwind-protect
+ (let ((secret (slime-secret)))
+ (when secret
+ (set-stream-timeout new 20)
+ (let ((first-val (decode-message new)))
+ (unless (and (stringp first-val) (string= first-val secret))
+ (error "Incoming connection doesn't know the password."))))
+ (set-stream-timeout new nil)
+ (setf success t))
+ (unless success
+ (close new :abort t)))
new))
(defun slime-secret ()
@@ -518,13 +529,20 @@
Return an output stream suitable for writing program output.
This is an optimized way for Lisp to deliver output to Emacs."
- (let* ((socket (create-socket *loopback-interface*
- *dedicated-output-stream-port*))
- (port (local-port socket)))
- (encode-message `(:open-dedicated-output-stream ,port) socket-io)
- (accept-authenticated-connection
- socket :external-format external-format
- :buffering *dedicated-output-stream-buffering*)))
+ (let ((socket (create-socket *loopback-interface*
+ *dedicated-output-stream-port*)))
+ (unwind-protect
+ (let ((port (local-port socket)))
+ (encode-message `(:open-dedicated-output-stream ,port) socket-io)
+ (let ((dedicated (accept-authenticated-connection
+ socket :external-format external-format
+ :buffering *dedicated-output-stream-buffering*
+ :timeout 30)))
+ (close-socket socket)
+ (setf socket nil)
+ dedicated))
+ (when socket
+ (close-socket socket)))))
(defun handle-request (connection)
"Read and process one request. The processing is done in the extend
@@ -828,34 +846,39 @@
connection))
(defun create-connection (socket-io style external-format)
- (let ((c (ecase style
- (:spawn
- (make-connection :socket-io socket-io
- :read #'read-from-control-thread
- :send #'send-to-control-thread
- :serve-requests #'spawn-threads-for-connection
- :cleanup #'cleanup-connection-threads))
- (:sigio
- (make-connection :socket-io socket-io
- :read #'read-from-socket-io
- :send #'send-to-socket-io
- :serve-requests #'install-sigio-handler
- :cleanup #'deinstall-sigio-handler))
- (:fd-handler
- (make-connection :socket-io socket-io
- :read #'read-from-socket-io
- :send #'send-to-socket-io
- :serve-requests #'install-fd-handler
- :cleanup #'deinstall-fd-handler))
- ((nil)
- (make-connection :socket-io socket-io
- :read #'read-from-socket-io
- :send #'send-to-socket-io
- :serve-requests #'simple-serve-requests)))))
- (setf (connection.communication-style c) style)
- (setf (connection.external-format c) external-format)
- (initialize-streams-for-connection c)
- c))
+ (let ((success nil))
+ (unwind-protect
+ (let ((c (ecase style
+ (:spawn
+ (make-connection :socket-io socket-io
+ :read #'read-from-control-thread
+ :send #'send-to-control-thread
+ :serve-requests #'spawn-threads-for-connection
+ :cleanup #'cleanup-connection-threads))
+ (:sigio
+ (make-connection :socket-io socket-io
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'install-sigio-handler
+ :cleanup #'deinstall-sigio-handler))
+ (:fd-handler
+ (make-connection :socket-io socket-io
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'install-fd-handler
+ :cleanup #'deinstall-fd-handler))
+ ((nil)
+ (make-connection :socket-io socket-io
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'simple-serve-requests)))))
+ (setf (connection.communication-style c) style)
+ (setf (connection.external-format c) external-format)
+ (initialize-streams-for-connection c)
+ (setf success t)
+ c)
+ (unless success
+ (close socket-io :abort t)))))
;;;; IO to Emacs
