From b4031d85bc80194c3cd44d8dee7c51d82098c193 Mon Sep 17 00:00:00 2001
From: Richard M Kreuter <kreuter@users.sourceforge.net>
Date: Wed, 16 Jul 2008 11:48:55 +0000
Subject: [PATCH] 1.0.18.18: Add support for abstract namespace addresses for
 AF_LOCAL sockets.

* Contributed by Matthew D. Swank
---
 contrib/sb-bsd-sockets/constants.lisp  |    3 ++
 contrib/sb-bsd-sockets/defpackage.lisp |    2 +-
 contrib/sb-bsd-sockets/local.lisp      |   67 ++++++++++++++++++++++++++++++++
 version.lisp-expr                      |    2 +-
 4 files changed, 72 insertions(+), 2 deletions(-)

diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp
index bf47d1d..7badaf7 100644
--- a/contrib/sb-bsd-sockets/constants.lisp
+++ b/contrib/sb-bsd-sockets/constants.lisp
@@ -141,6 +141,9 @@
  (:structure sockaddr-un ("struct sockaddr_un"
                           (integer family "sa_family_t" "sun_family")
                           (c-string path "char" "sun_path")))
+ (:structure sockaddr-un-abstract ("struct sockaddr_un"
+                              (integer family "sa_family_t" "sun_family")
+                              ((array (unsigned 8)) path "char" "sun_path")))
  (:structure hostent ("struct hostent"
                       (c-string-pointer name "char *" "h_name")
                       ((* c-string) aliases "char **" "h_aliases")
diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp
index 5dfafa0..c329a81 100644
--- a/contrib/sb-bsd-sockets/defpackage.lisp
+++ b/contrib/sb-bsd-sockets/defpackage.lisp
@@ -11,7 +11,7 @@
   (:use "COMMON-LISP" "SB-ALIEN" "SB-EXT" "SB-C-CALL"))
 
 (defpackage "SB-BSD-SOCKETS"
-  (:export socket local-socket inet-socket
+  (:export socket local-socket local-abstract-socket inet-socket
            make-local-socket make-inet-socket
            socket-bind socket-accept socket-connect
            socket-send socket-receive socket-recv
diff --git a/contrib/sb-bsd-sockets/local.lisp b/contrib/sb-bsd-sockets/local.lisp
index 53a7f85..8ca769b 100644
--- a/contrib/sb-bsd-sockets/local.lisp
+++ b/contrib/sb-bsd-sockets/local.lisp
@@ -24,3 +24,70 @@ also known as unix-domain sockets."))
   (let ((name (sockint::sockaddr-un-path sockaddr)))
     (if (zerop (length name)) nil name)))
 
+(defclass local-abstract-socket (local-socket) ()
+  (:documentation "Class representing local domain (AF_LOCAL) sockets with
+addresses in the abstract namespace."))
+
+(defmethod make-sockaddr-for ((socket local-abstract-socket)
+                              &optional sockaddr &rest address
+                              &aux (path (first address)))
+  (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un-abstract)))
+        (len 0))
+    (setf (sockint::sockaddr-un-abstract-family sockaddr) sockint::af-local)
+    ;;First byte of the path is always 0.
+    (setf (sb-alien:deref (sockint::sockaddr-un-abstract-path sockaddr) 0) 0)
+
+    (when path
+      (when (stringp path)
+        (setf path (sb-ext:string-to-octets path)))
+      (setf len (min (- sockint::size-of-sockaddr-un-abstract 3) (length path)))
+      ;;We fill in the rest of the path starting at index 1.
+      (loop for i from 0 below len
+            do (setf (sb-alien:deref (sockint::sockaddr-un-abstract-path
+                                      sockaddr)
+                                     (1+ i))
+                     (elt path i))))
+    (values sockaddr (+ 3 len))))
+
+(defmethod free-sockaddr-for ((socket local-abstract-socket) sockaddr)
+  (sockint::free-sockaddr-un-abstract sockaddr))
+
+(defmethod size-of-sockaddr ((socket local-abstract-socket))
+  sockint::size-of-sockaddr-un-abstract)
+
+(defmethod bits-of-sockaddr ((socket local-abstract-socket) sockaddr)
+  "Return the contents of the local socket address SOCKADDR."
+  (let* ((path-len (- sockint::size-of-sockaddr-un-abstract 3))
+         (path (make-array `(,path-len)
+                           :element-type '(unsigned-byte 8)
+                           :initial-element 0)))
+    ;;exclude the first byte (it's always null) of the address
+    (loop for i from 1 to path-len
+          do (setf (elt path (1- i))
+                   (sb-alien:deref (sockint::sockaddr-un-abstract-path sockaddr)
+                                   i)))
+    path))
+
+(defmethod socket-connect ((socket local-abstract-socket) &rest peer
+                           &aux (path (first peer)))
+  (multiple-value-bind (sockaddr addr-len)
+      (make-sockaddr-for socket nil path)
+    (unwind-protect
+         (if (= (sockint::connect (socket-file-descriptor socket)
+                                  sockaddr
+                                  addr-len)
+                -1)
+             (socket-error "connect"))
+      (free-sockaddr-for socket sockaddr))))
+
+(defmethod socket-bind ((socket local-abstract-socket)
+                        &rest address &aux (path (first address)))
+  (multiple-value-bind (sockaddr addr-len)
+      (make-sockaddr-for socket nil path)
+    (unwind-protect
+         (if (= (sockint::bind (socket-file-descriptor socket)
+                               sockaddr
+                               addr-len)
+                -1)
+             (socket-error "bind"))
+      (free-sockaddr-for socket sockaddr))))
diff --git a/version.lisp-expr b/version.lisp-expr
index ab14cc2..29808c2 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.18.17"
+"1.0.18.18"
-- 
1.7.10.4