1.0.27.46: Fix build on systems with "src" in the path.
[sbcl/tcr.git] / contrib / sb-bsd-sockets / local.lisp
blob8ca769bb350202ba1ef0af2931794e36eb3b4dec
1 (in-package :sb-bsd-sockets)
3 (defclass local-socket (socket)
4 ((family :initform sockint::af-local))
5 (:documentation "Class representing local domain (AF_LOCAL) sockets,
6 also known as unix-domain sockets."))
8 (defmethod make-sockaddr-for ((socket local-socket)
9 &optional sockaddr &rest address &aux (filename (first address)))
10 (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un))))
11 (setf (sockint::sockaddr-un-family sockaddr) sockint::af-local)
12 (when filename
13 (setf (sockint::sockaddr-un-path sockaddr) filename))
14 sockaddr))
16 (defmethod free-sockaddr-for ((socket local-socket) sockaddr)
17 (sockint::free-sockaddr-un sockaddr))
19 (defmethod size-of-sockaddr ((socket local-socket))
20 sockint::size-of-sockaddr-un)
22 (defmethod bits-of-sockaddr ((socket local-socket) sockaddr)
23 "Return the file name of the local socket address SOCKADDR."
24 (let ((name (sockint::sockaddr-un-path sockaddr)))
25 (if (zerop (length name)) nil name)))
27 (defclass local-abstract-socket (local-socket) ()
28 (:documentation "Class representing local domain (AF_LOCAL) sockets with
29 addresses in the abstract namespace."))
31 (defmethod make-sockaddr-for ((socket local-abstract-socket)
32 &optional sockaddr &rest address
33 &aux (path (first address)))
34 (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un-abstract)))
35 (len 0))
36 (setf (sockint::sockaddr-un-abstract-family sockaddr) sockint::af-local)
37 ;;First byte of the path is always 0.
38 (setf (sb-alien:deref (sockint::sockaddr-un-abstract-path sockaddr) 0) 0)
40 (when path
41 (when (stringp path)
42 (setf path (sb-ext:string-to-octets path)))
43 (setf len (min (- sockint::size-of-sockaddr-un-abstract 3) (length path)))
44 ;;We fill in the rest of the path starting at index 1.
45 (loop for i from 0 below len
46 do (setf (sb-alien:deref (sockint::sockaddr-un-abstract-path
47 sockaddr)
48 (1+ i))
49 (elt path i))))
50 (values sockaddr (+ 3 len))))
52 (defmethod free-sockaddr-for ((socket local-abstract-socket) sockaddr)
53 (sockint::free-sockaddr-un-abstract sockaddr))
55 (defmethod size-of-sockaddr ((socket local-abstract-socket))
56 sockint::size-of-sockaddr-un-abstract)
58 (defmethod bits-of-sockaddr ((socket local-abstract-socket) sockaddr)
59 "Return the contents of the local socket address SOCKADDR."
60 (let* ((path-len (- sockint::size-of-sockaddr-un-abstract 3))
61 (path (make-array `(,path-len)
62 :element-type '(unsigned-byte 8)
63 :initial-element 0)))
64 ;;exclude the first byte (it's always null) of the address
65 (loop for i from 1 to path-len
66 do (setf (elt path (1- i))
67 (sb-alien:deref (sockint::sockaddr-un-abstract-path sockaddr)
68 i)))
69 path))
71 (defmethod socket-connect ((socket local-abstract-socket) &rest peer
72 &aux (path (first peer)))
73 (multiple-value-bind (sockaddr addr-len)
74 (make-sockaddr-for socket nil path)
75 (unwind-protect
76 (if (= (sockint::connect (socket-file-descriptor socket)
77 sockaddr
78 addr-len)
79 -1)
80 (socket-error "connect"))
81 (free-sockaddr-for socket sockaddr))))
83 (defmethod socket-bind ((socket local-abstract-socket)
84 &rest address &aux (path (first address)))
85 (multiple-value-bind (sockaddr addr-len)
86 (make-sockaddr-for socket nil path)
87 (unwind-protect
88 (if (= (sockint::bind (socket-file-descriptor socket)
89 sockaddr
90 addr-len)
91 -1)
92 (socket-error "bind"))
93 (free-sockaddr-for socket sockaddr))))