1.0.35.12: Minor cleanup in %TARGET-DEFSTRUCT.
[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 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))
15
16 (defmethod free-sockaddr-for ((socket local-socket) sockaddr)
17   (sockint::free-sockaddr-un sockaddr))
18
19 (defmethod size-of-sockaddr ((socket local-socket))
20   sockint::size-of-sockaddr-un)
21
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)))
26
27 (defclass local-abstract-socket (local-socket) ()
28   (:documentation "Class representing local domain (AF_LOCAL) sockets with
29 addresses in the abstract namespace."))
30
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)
39
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))))
51
52 (defmethod free-sockaddr-for ((socket local-abstract-socket) sockaddr)
53   (sockint::free-sockaddr-un-abstract sockaddr))
54
55 (defmethod size-of-sockaddr ((socket local-abstract-socket))
56   sockint::size-of-sockaddr-un-abstract)
57
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))
70
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))))
82
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))))