Fixed up Unix sockets a bit.

 * Support anonymous addresses.
 * Clean up bound names when closing.

diff --git a/common-net.lisp b/common-net.lisp
index 10fc919..57a5b84 100644 (file)
--- a/common-net.lisp
+++ b/common-net.lisp
@@ -461,13 +461,14 @@
 ;;; Unix sockets
 
 (defclass local-address (address)
 ;;; Unix sockets
 
 (defclass local-address (address)

-  ((path :type pathname)))
+  ((path :type (or pathname nil))))

 
 (defmethod initialize-instance :after ((instance local-address) &key path)
 
 (defmethod initialize-instance :after ((instance local-address) &key path)

-  (setf (slot-value instance 'path) (pathname path)))
+  (setf (slot-value instance 'path) (and path (pathname path))))

 
 (defmethod format-address ((address local-address))
 
 (defmethod format-address ((address local-address))

-  (namestring (slot-value address 'path)))
+  (let ((path (slot-value address 'path)))
+    (and path (namestring path))))

 
 (defclass local-stream-address (local-address) ())
 (defclass local-seq-address (local-address) ())
 
 (defclass local-stream-address (local-address) ())
 (defclass local-seq-address (local-address) ())

diff --git a/net-ecl.lisp b/net-ecl.lisp
index 3f80737..3388954 100644 (file)
--- a/net-ecl.lisp
+++ b/net-ecl.lisp
@@ -71,3 +71,8 @@
 
 (defmethod gray:stream-write-sequence ((socket stream-socket) seq &optional (start 0) (end (length seq)))
   (gray-stream-write-sequence socket seq start end))
 
 (defmethod gray:stream-write-sequence ((socket stream-socket) seq &optional (start 0) (end (length seq)))
   (gray-stream-write-sequence socket seq start end))

+
+;;; Error cover-up
+
+(defmethod sb-bsd-sockets:socket-name ((sk sb-bsd-sockets:local-socket))
+  (simple-network-error "ECL does not support reading the name of Unix sockets."))

diff --git a/net-sb-bsd.lisp b/net-sb-bsd.lisp
index 9c757c5..3d2affd 100644 (file)
--- a/net-sb-bsd.lisp
+++ b/net-sb-bsd.lisp
@@ -5,6 +5,11 @@
 (defclass sbcl-listen-socket (listen-socket sbcl-socket) ())
 (defclass sbcl-stream-socket (stream-socket sbcl-socket) ())
 (defclass sbcl-datagram-socket (datagram-socket sbcl-socket) ())
 (defclass sbcl-listen-socket (listen-socket sbcl-socket) ())
 (defclass sbcl-stream-socket (stream-socket sbcl-socket) ())
 (defclass sbcl-datagram-socket (datagram-socket sbcl-socket) ())

+(defclass sbcl-unix-socket (sbcl-socket)
+  ((unlink-name :type (or pathname nil) :initform nil)))
+(defclass sbcl-unix-listen-socket (sbcl-listen-socket sbcl-unix-socket) ())
+(defclass sbcl-unix-stream-socket (sbcl-stream-socket sbcl-unix-socket) ())
+(defclass sbcl-unix-datagram-socket (sbcl-datagramx-socket sbcl-unix-socket) ())

 
 (defmacro with-sb-socket ((var socket) &body body)
   (let ((success (gensym "SUCCESS")))
 
 (defmacro with-sb-socket ((var socket) &body body)
   (let ((success (gensym "SUCCESS")))


@@ -71,13 +76,15 @@
     (error 'socket-closed :socket socket)))
 
 (defgeneric socket-class-for-address (address mode))
     (error 'socket-closed :socket socket)))
 
 (defgeneric socket-class-for-address (address mode))

-(defmethod socket-class-for-address ((address tcp-address) (mode (eql :connect))) 'sbcl-stream-socket)
+(defmethod socket-class-for-address ((address tcp-address) mode) 'sbcl-stream-socket)

 (defmethod socket-class-for-address ((address tcp-address) (mode (eql :bind))) 'sbcl-listen-socket)
 (defmethod socket-class-for-address ((address udp-address) mode) 'sbcl-datagram-socket)
 (defmethod socket-class-for-address ((address inet-host-address) mode) 'sbcl-datagram-socket)
 (defmethod socket-class-for-address ((address tcp-address) (mode (eql :bind))) 'sbcl-listen-socket)
 (defmethod socket-class-for-address ((address udp-address) mode) 'sbcl-datagram-socket)
 (defmethod socket-class-for-address ((address inet-host-address) mode) 'sbcl-datagram-socket)

-(defmethod socket-class-for-address ((address local-stream-address) mode) 'sbcl-stream-socket)
-(defmethod socket-class-for-address ((address local-seq-address) mode) 'sbcl-datagram-socket)
-(defmethod socket-class-for-address ((address local-datagram-address) mode) 'sbcl-datagram-socket)
+(defmethod socket-class-for-address ((address local-stream-address) mode) 'sbcl-unix-stream-socket)
+(defmethod socket-class-for-address ((address local-stream-address) (mode (eql :bind))) 'sbcl-unix-listen-socket)
+(defmethod socket-class-for-address ((address local-seq-address) mode) 'sbcl-unix-datagram-socket)
+(defmethod socket-class-for-address ((address local-seq-address) (mode (eql :bind))) 'sbcl-unix-listen-socket)
+(defmethod socket-class-for-address ((address local-datagram-address) mode) 'sbcl-unix-datagram-socket)

 
 (define-condition wrapped-socket-error (error socket-condition)
   ((cause :initarg :cause))
 
 (define-condition wrapped-socket-error (error socket-condition)
   ((cause :initarg :cause))


@@ -137,7 +144,7 @@
 (defmethod socket-send-to ((socket sbcl-socket) buf destination &key (start 0) (end (length buf)) from no-hang)
   (check-not-closed socket)
   (when from
 (defmethod socket-send-to ((socket sbcl-socket) buf destination &key (start 0) (end (length buf)) from no-hang)
   (check-not-closed socket)
   (when from

-    (simple-network-error "SB-BSD-THREADS does not support specifying the source address of individual packets."))
+    (simple-network-error "SB-BSD-SOCKETS does not support specifying the source address of individual packets."))

   (let ((result (map-sb-bsd-errors (socket)
                  (retry-loop ("Retry the send operation.")
                    (sb-bsd-sockets:socket-send (slot-value socket 'sb-socket)
   (let ((result (map-sb-bsd-errors (socket)
                  (retry-loop ("Retry the send operation.")
                    (sb-bsd-sockets:socket-send (slot-value socket 'sb-socket)


@@ -207,11 +214,33 @@
                                  (apply #'sb-bsd-sockets:socket-connect sk (map-address-to-sbcl sk remote))))
                              sk)))
 
                                  (apply #'sb-bsd-sockets:socket-connect sk (map-address-to-sbcl sk remote))))
                              sk)))
 

+(defmethod bind-to-address :around ((address local-address))
+  (let ((ret (call-next-method)))
+    (when (typep ret 'sbcl-unix-socket)
+      (setf (slot-value ret 'unlink-name) (slot-value address 'path)))
+    ret))
+
+(defmethod connect-to-address :around ((remote local-address) &key local)
+  (let ((ret (call-next-method)))
+    (when (and (typep ret 'sbcl-unix-socket) (typep local 'local-address))
+      (setf (slot-value ret 'unlink-name) (slot-value local 'path)))
+    ret))
+

 (defmethod accept ((socket sbcl-listen-socket))
   (check-not-closed socket)
   (let* ((ret-list (multiple-value-list (sb-bsd-sockets:socket-accept (slot-value socket 'sb-socket))))
         (sk (first ret-list))
         (addr-list (rest ret-list)))
     (with-sb-socket (sk sk)
 (defmethod accept ((socket sbcl-listen-socket))
   (check-not-closed socket)
   (let* ((ret-list (multiple-value-list (sb-bsd-sockets:socket-accept (slot-value socket 'sb-socket))))
         (sk (first ret-list))
         (addr-list (rest ret-list)))
     (with-sb-socket (sk sk)

-      (values (make-instance 'sbcl-stream-socket :sb-socket sk)
+      (values (make-instance 'sbcl-stream-socket
+                            ;; XXX: Should be
+                            ;; (socket-class-for-address (map-sbcl-to-address sk (multiple-value-list (sb-bsd-sockets:socket-name sk))) :accept)
+                            ;; but ECL does not support socket-name for Unix sockets.
+                            :sb-socket sk)

              (map-sbcl-to-address sk addr-list)))))
              (map-sbcl-to-address sk addr-list)))))

+
+(defmethod close-socket :after ((socket sbcl-unix-socket))
+  (with-slots (unlink-name) socket
+    (when unlink-name
+      (delete-file unlink-name)
+      (setf unlink-name nil))))