Author: ehuelsmann
Date: Mon Sep 17 15:50:34 2007
New Revision: 294
Modified:
usocket/branches/0.3.x/backend/allegro.lisp
usocket/branches/0.3.x/backend/armedbear.lisp
usocket/branches/0.3.x/backend/clisp.lisp
usocket/branches/0.3.x/backend/cmucl.lisp
usocket/branches/0.3.x/backend/lispworks.lisp
usocket/branches/0.3.x/backend/openmcl.lisp
usocket/branches/0.3.x/backend/sbcl.lisp
usocket/branches/0.3.x/backend/scl.lisp
Log:
Manual backport of r288 from trunk.
Modified: usocket/branches/0.3.x/backend/allegro.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/allegro.lisp (original)
+++ usocket/branches/0.3.x/backend/allegro.lisp Mon Sep 17 15:50:34 2007
@@ -87,7 +87,8 @@
(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
(declare (ignore element-type)) ;; allegro streams are multivalent
- (let ((stream-sock (socket:accept-connection (socket socket))))
+ (let ((stream-sock (with-mapped-conditions ()
+ (socket:accept-connection (socket socket)))))
(make-stream-socket :socket stream-sock :stream stream-sock)))
(defmethod get-local-address ((usocket usocket))
Modified: usocket/branches/0.3.x/backend/armedbear.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/armedbear.lisp (original)
+++ usocket/branches/0.3.x/backend/armedbear.lisp Mon Sep 17 15:50:34 2007
@@ -50,17 +50,20 @@
(host-to-hostname host) port))
(sock (jnew-call ("java.net.ServerSocket"))))
(when reuseaddress
+ (with-mapped-conditions ()
+ (jmethod-call sock
+ ("setReuseAddress" "boolean")
+ (java:make-immediate-object reuseaddress :boolean))))
+ (with-mapped-conditions ()
(jmethod-call sock
- ("setReuseAddress" "boolean")
- (java:make-immediate-object reuseaddress :boolean)))
- (jmethod-call sock
- ("bind" "java.net.SocketAddress" "int")
- sock-addr backlog)
+ ("bind" "java.net.SocketAddress" "int")
+ sock-addr backlog))
(make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
(let* ((jsock (socket socket))
- (jacc-sock (jmethod-call jsock ("accept")))
+ (jacc-sock (with-mapped-conditions (socket)
+ (jmethod-call jsock ("accept")))
(jacc-stream
(ext:get-socket-stream jacc-sock
:element-type (or element-type
Modified: usocket/branches/0.3.x/backend/clisp.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/clisp.lisp (original)
+++ usocket/branches/0.3.x/backend/clisp.lisp Mon Sep 17 15:50:34 2007
@@ -74,18 +74,20 @@
;; clisp 2.39 sets SO_REUSEADDRESS to 1 by default; no need to
;; to explicitly turn it on; unfortunately, there's no way to turn it off...
(declare (ignore reuseaddress reuse-address))
- (let ((sock (apply #'socket:socket-server
- (append (list port
- :backlog backlog)
- (when (ip/= host *wildcard-host*)
- (list :interface host))))))
+ (let ((sock (with-mapped-conditions ()
+ (apply #'socket:socket-server
+ (append (list port
+ :backlog backlog)
+ (when (ip/= host *wildcard-host*)
+ (list :interface host)))))))
(make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
(let ((stream
- (socket:socket-accept (socket socket)
- :element-type (or element-type
- (element-type socket)))))
+ (with-mapped-conditions (socket)
+ (socket:socket-accept (socket socket)
+ :element-type (or element-type
+ (element-type socket))))))
(make-stream-socket :socket stream
:stream stream)))
Modified: usocket/branches/0.3.x/backend/cmucl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/cmucl.lisp (original)
+++ usocket/branches/0.3.x/backend/cmucl.lisp Mon Sep 17 15:50:34 2007
@@ -76,22 +76,25 @@
(backlog 5)
(element-type 'character))
(let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (server-sock (apply #'ext:create-inet-listener
- (append (list port :stream
- :backlog backlog
- :reuse-address reuseaddress)
- (when (ip/= host *wildcard-host*)
- (list :host
- (host-to-hbo host)))))))
+ (server-sock
+ (with-mapped-conditions ()
+ (apply #'ext:create-inet-listener
+ (append (list port :stream
+ :backlog backlog
+ :reuse-address reuseaddress)
+ (when (ip/= host *wildcard-host*)
+ (list :host
+ (host-to-hbo host))))))))
(make-stream-server-socket server-sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (let* ((sock (ext:accept-tcp-connection (socket usocket)))
- (stream (sys:make-fd-stream sock :input t :output t
- :element-type (or element-type
- (element-type usocket))
- :buffering :full)))
- (make-stream-socket :socket sock :stream stream)))
+ (with-mapped-conditions (usocket)
+ (let* ((sock (ext:accept-tcp-connection (socket usocket)))
+ (stream (sys:make-fd-stream sock :input t :output t
+ :element-type (or element-type
+ (element-type usocket))
+ :buffering :full)))
+ (make-stream-socket :socket sock :stream stream))))
;; Sockets and socket streams are represented
;; by different objects. Be sure to close the
Modified: usocket/branches/0.3.x/backend/lispworks.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/lispworks.lisp (original)
+++ usocket/branches/0.3.x/backend/lispworks.lisp Mon Sep 17 15:50:34 2007
@@ -87,7 +87,8 @@
(make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (let* ((sock (comm::get-fd-from-socket (socket usocket)))
+ (let* ((sock (with-mapped-conditions (usocket)
+ (comm::get-fd-from-socket (socket usocket))))
(stream (make-instance 'comm:socket-stream
:socket sock
:direction :io
Modified: usocket/branches/0.3.x/backend/openmcl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/openmcl.lisp (original)
+++ usocket/branches/0.3.x/backend/openmcl.lisp Mon Sep 17 15:50:34 2007
@@ -92,19 +92,21 @@
(backlog 5)
(element-type 'character))
(let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (sock (apply #'openmcl-socket:make-socket
- (append (list :connect :passive
- :reuse-address reuseaddress
- :local-port port
- :backlog backlog
- :format (to-format element-type))
- (when (ip/= host *wildcard-host*)
- (list :local-host host))))))
+ (sock (with-mapped-conditions ()
+ (apply #'openmcl-socket:make-socket
+ (append (list :connect :passive
+ :reuse-address reuseaddress
+ :local-port port
+ :backlog backlog
+ :format (to-format element-type))
+ (when (ip/= host *wildcard-host*)
+ (list :local-host host)))))))
(make-stream-server-socket sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
(declare (ignore element-type)) ;; openmcl streams are bi/multivalent
- (let ((sock (openmcl-socket:accept-connection (socket usocket))))
+ (let ((sock (with-mapped-conditions (usocket)
+ (openmcl-socket:accept-connection (socket usocket)))))
(make-stream-socket :socket sock :stream sock)))
;; One close method is sufficient because sockets
Modified: usocket/branches/0.3.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/sbcl.lisp (original)
+++ usocket/branches/0.3.x/backend/sbcl.lisp Mon Sep 17 15:50:34 2007
@@ -136,18 +136,22 @@
(ip (host-to-vector-quad host))
(sock (make-instance 'sb-bsd-sockets:inet-socket
:type :stream :protocol :tcp)))
- (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
- (sb-bsd-sockets:socket-bind sock ip port)
- (sb-bsd-sockets:socket-listen sock backlog)
- (make-stream-server-socket sock :element-type element-type)))
+ (with-mapped-conditions ()
+ (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
+ (sb-bsd-sockets:socket-bind sock ip port)
+ (sb-bsd-sockets:socket-listen sock backlog)
+ (make-stream-server-socket sock :element-type element-type))))
(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
- (let ((sock (sb-bsd-sockets:socket-accept (socket socket))))
- (make-stream-socket :socket sock
- :stream (sb-bsd-sockets:socket-make-stream sock
- :input t :output t :buffering :full
- :element-type (or element-type
- (element-type socket))))))
+ (with-mapped-conditions (socket)
+ (let ((sock (sb-bsd-sockets:socket-accept (socket socket))))
+ (make-stream-socket
+ :socket sock
+ :stream (sb-bsd-sockets:socket-make-stream
+ sock
+ :input t :output t :buffering :full
+ :element-type (or element-type
+ (element-type socket)))))))
;; Sockets and their associated streams are modelled as
;; different objects. Be sure to close the stream (which
Modified: usocket/branches/0.3.x/backend/scl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/scl.lisp (original)
+++ usocket/branches/0.3.x/backend/scl.lisp Mon Sep 17 15:50:34 2007
@@ -50,19 +50,22 @@
(host (if (ip= host *wildcard-host*)
0
(host-to-hbo host)))
- (server-sock (ext:create-inet-listener port :stream
- :host host
- :reuse-address reuseaddress
- :backlog backlog)))
+ (server-sock
+ (with-mapped-conditions ()
+ (ext:create-inet-listener port :stream
+ :host host
+ :reuse-address reuseaddress
+ :backlog backlog))))
(make-stream-server-socket server-sock :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (let* ((sock (ext:accept-tcp-connection (socket usocket)))
- (stream (sys:make-fd-stream sock :input t :output t
- :element-type (or element-type
- (element-type usocket))
- :buffering :full)))
- (make-stream-socket :socket sock :stream stream)))
+ (with-mapped-conditions (usocket)
+ (let* ((sock (ext:accept-tcp-connection (socket usocket)))
+ (stream (sys:make-fd-stream sock :input t :output t
+ :element-type (or element-type
+ (element-type usocket))
+ :buffering :full)))
+ (make-stream-socket :socket sock :stream stream))))
;; Sockets and their associated streams are modelled as
;; different objects. Be sure to close the socket stream
