1.0.37.57: better DEFMETHOD pretty-printing
[sbcl/pkhuong.git] / contrib / sb-bsd-sockets / local.lisp
blob1c9e9ae81a1fffda9336fc90029a4a3dfe4427b6
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 socket-namestring ((socket local-socket))
9 (ignore-errors (socket-name socket)))
11 (defmethod socket-peerstring ((socket local-socket))
12 (ignore-errors (socket-peername socket)))
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))
22 (defmethod free-sockaddr-for ((socket local-socket) sockaddr)
23 (sockint::free-sockaddr-un sockaddr))
25 (defmethod size-of-sockaddr ((socket local-socket))
26 sockint::size-of-sockaddr-un)
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)))
33 (defclass local-abstract-socket (local-socket) ()
34 (:documentation "Class representing local domain (AF_LOCAL) sockets with
35 addresses in the abstract namespace."))
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)
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))))
58 (defmethod free-sockaddr-for ((socket local-abstract-socket) sockaddr)
59 (sockint::free-sockaddr-un-abstract sockaddr))
61 (defmethod size-of-sockaddr ((socket local-abstract-socket))
62 sockint::size-of-sockaddr-un-abstract)
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))
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))))
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))))