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