1 (in-package :sb-bsd-sockets
)
4 ((name :initarg
:name
:reader host-ent-name
5 :documentation
"The name of the host")
6 ;; Deliberately not documented, since this isn't very useful,
7 ;; and the data isn't available when using getaddrinfo(). Unfortunately
9 (aliases :initarg
:aliases
:reader host-ent-aliases
)
10 (address-type :initarg
:type
:reader host-ent-address-type
)
11 (addresses :initarg
:addresses
:reader host-ent-addresses
12 :documentation
"A list of addresses for this host."))
13 (:documentation
"This class represents the results of an address lookup."))
15 (defmethod host-ent-address ((host-ent host-ent
))
16 (car (host-ent-addresses host-ent
)))
18 (declaim (inline naturalize-unsigned-byte-8-array
))
19 (defun naturalize-unsigned-byte-8-array (array length
)
20 (let ((addr (make-array length
:element-type
'(unsigned-byte 8))))
22 (setf (elt addr i
) (sb-alien:deref array i
)))
25 #-sb-bsd-sockets-addrinfo
26 (defun make-host-ent (h &optional errno
)
27 (when (sb-alien:null-alien h
)
28 (name-service-error "gethostbyname" errno
))
29 (let* ((length (sockint::hostent-length h
))
30 (aliases (loop for i
= 0 then
(1+ i
)
31 for al
= (sb-alien:deref
(sockint::hostent-aliases h
) i
)
35 (loop for i
= 0 then
(1+ i
)
36 for ad
= (sb-alien:deref
(sockint::hostent-addresses h
) i
)
37 until
(sb-alien:null-alien ad
)
38 collect
(ecase (sockint::hostent-type h
)
40 ;; CLH: Work around x86-64 darwin bug here.
41 ;; The length is reported as 8, when it should be 4.
42 ;; FIXME: this is rumored to be fixed in 10.5
45 (assert (or (= length
4) (= length
8)))
46 (naturalize-unsigned-byte-8-array ad
4))
50 (naturalize-unsigned-byte-8-array ad length
)))
53 (sb-alien:cast ad sb-alien
:c-string
))))))
54 (make-instance 'host-ent
55 :name
(sockint::hostent-name h
)
56 :type
(sockint::hostent-type h
)
58 :addresses addresses
)))
62 #-sb-bsd-sockets-addrinfo
64 (sb-ext:defglobal
**gethostby-lock
**
65 (sb-thread:make-mutex
:name
"gethostby lock"))
67 (defun get-host-by-name (host-name)
68 "Returns a HOST-ENT instance for HOST-NAME or signals a NAME-SERVICE-ERROR.
69 HOST-NAME may also be an IP address in dotted quad notation or some other
70 weird stuff - see gethostbyname(3) for the details."
71 (sb-thread::with-system-mutex
(**gethostby-lock
** :allow-with-interrupts t
)
72 (make-host-ent (sockint::gethostbyname host-name
))))
74 (defun get-host-by-address (address)
75 "Returns a HOST-ENT instance for ADDRESS, which should be a vector of
76 (integer 0 255), or signals a NAME-SERVICE-ERROR. See gethostbyaddr(3)
78 (sb-thread::with-system-mutex
(**gethostby-lock
** :allow-with-interrupts t
)
79 (sockint::with-in-addr packed-addr
()
80 (let ((addr-vector (coerce address
'vector
)))
81 (loop for i from
0 below
(length addr-vector
)
82 do
(setf (sb-alien:deref
(sockint::in-addr-addr packed-addr
) i
)
84 (make-host-ent (sockint::gethostbyaddr packed-addr
86 sockint
::af-inet
)))))))
88 #+sb-bsd-sockets-addrinfo
89 (defconstant ni-max-host
1025) ;; Not inside PROGN because of #.
91 #+sb-bsd-sockets-addrinfo
93 (defun get-host-by-name (node)
94 "Returns a HOST-ENT instance for NODE or signals a NAME-SERVICE-ERROR.
96 Another HOST-ENT instance containing zero, one or more IPv6 addresses
97 may be returned as a second return value.
99 NODE may also be an IP address in dotted quad notation or some other
100 weird stuff - see getaddrinfo(3) for the details."
101 (declare (optimize speed
))
102 (sb-alien:with-alien
((info (* sockint
::addrinfo
)))
103 (addrinfo-error-case ("getaddrinfo"
104 (sockint::getaddrinfo
105 node nil nil
(sb-alien:addr info
)))
106 (let ((host-ent4 (make-instance 'host-ent
108 :type sockint
::af-inet
111 (host-ent6 (make-instance 'host-ent
113 :type sockint
::af-inet6
116 ;; The same effective result can be multiple time
117 ;; in the list, with different socktypes. Only record
118 ;; each address once.
119 (loop for info
* = info then
(sockint::addrinfo-next info
*)
120 until
(sb-alien::null-alien info
*) do
122 ((= (sockint::addrinfo-family info
*) sockint
::af-inet
)
123 (let ((address (sockint::sockaddr-in-addr
125 (sockint::addrinfo-addr info
*)
126 (* (sb-alien:struct sockint
::sockaddr-in
))))))
127 (setf (slot-value host-ent4
'addresses
)
128 (adjoin (naturalize-unsigned-byte-8-array address
4)
129 (host-ent-addresses host-ent4
)
131 ((= (sockint::addrinfo-family info
*) sockint
::af-inet6
)
132 (let ((address (sockint::sockaddr-in6-addr
134 (sockint::addrinfo-addr info
*)
135 (* (sb-alien:struct sockint
::sockaddr-in6
))))))
136 (setf (slot-value host-ent6
'addresses
)
137 (adjoin (naturalize-unsigned-byte-8-array address
16)
138 (host-ent-addresses host-ent6
)
140 (sockint::freeaddrinfo info
)
141 (values host-ent4 host-ent6
)))))
143 (defun get-host-by-address (address)
144 "Returns a HOST-ENT instance for ADDRESS, which should be a vector of
145 \(integer 0 255) with 4 elements in case of an IPv4 address and 16
146 elements in case of an IPv6 address, or signals a NAME-SERVICE-ERROR.
147 See gethostbyaddr(3) for details."
148 (declare (optimize speed
))
149 (multiple-value-bind (sockaddr sockaddr-free sockaddr-size address-family
)
151 ((vector (unsigned-byte 8) 4)
152 (let ((sockaddr (sb-alien:make-alien sockint
::sockaddr-in
)))
153 #+darwin
(setf (sockint::sockaddr-in-len sockaddr
) 16)
154 (setf (sockint::sockaddr-in-family sockaddr
) sockint
::af-inet
)
155 (dotimes (i (length address
))
156 (setf (sb-alien:deref
(sockint::sockaddr-in-addr sockaddr
) i
)
158 (values sockaddr
#'sockint
::free-sockaddr-in
159 (sb-alien:alien-size sockint
::sockaddr-in
:bytes
)
161 ((vector (unsigned-byte 8) 16)
162 (let ((sockaddr (sb-alien:make-alien sockint
::sockaddr-in6
)))
163 (setf (sockint::sockaddr-in6-family sockaddr
) sockint
::af-inet6
)
164 (dotimes (i (length address
))
165 (setf (sb-alien:deref
(sockint::sockaddr-in6-addr sockaddr
) i
)
167 (values sockaddr
#'sockint
::free-sockaddr-in6
168 (sb-alien:alien-size sockint
::sockaddr-in6
:bytes
)
169 sockint
::af-inet6
))))
171 (sb-alien:with-alien
((host-buf (array char
#.ni-max-host
)))
172 (addrinfo-error-case ("getnameinfo"
173 (sockint::getnameinfo
174 (sb-alien:cast sockaddr
(* t
)) sockaddr-size
175 (sb-alien:cast host-buf
(* char
)) ni-max-host
177 sockint
::ni-namereqd
))
178 (make-instance 'host-ent
179 :name
(sb-alien::c-string-to-string
180 (sb-alien:alien-sap host-buf
)
181 (sb-impl::default-external-format
)
185 :addresses
(list address
))))
186 (funcall sockaddr-free sockaddr
)))))
190 (defvar *name-service-errno
* 0
191 "The value of h_errno, after it's been fetched from Unix-land by calling
192 GET-NAME-SERVICE-ERRNO")
194 (defun name-service-error (where &optional errno
)
195 ;; There was a dummy docstring here for the texinfo extractor, but I
196 ;; see no reason for this to be documented in the manual, and removed
198 (let ((*name-service-errno
* (get-name-service-errno errno
)))
199 ;; Comment next to NETDB_INTERNAL in netdb.h says "See errno.".
200 ;; This special case treatment hasn't actually been tested yet.
201 (if (and #-win32
(= *name-service-errno
* sockint
::NETDB-INTERNAL
))
204 (condition-for-name-service-errno *name-service-errno
*)))
205 (error condition
:errno
*name-service-errno
* :syscall where
)))))
207 (defun addrinfo-error (where error-code
)
208 (let ((condition (condition-for-name-service-error-code error-code
)))
209 (error condition
:error-code error-code
:syscall where
)))
211 (define-condition name-service-error
(error)
212 ((errno :initform nil
:initarg
:errno
:reader name-service-error-errno
)
213 (error-code :initform nil
:initarg
:error-code
214 :reader name-service-error-error-code
)
215 (symbol :initform nil
:initarg
:symbol
:reader name-service-error-symbol
)
216 (syscall :initform
"an unknown location" :initarg
:syscall
:reader name-service-error-syscall
))
217 (:report
(lambda (c s
)
218 (let* ((errno (name-service-error-errno c
))
219 (error-code (name-service-error-error-code c
)))
220 (format s
"Name service error in \"~A\": ~A (~A)"
221 (name-service-error-syscall c
)
222 (or (name-service-error-symbol c
)
225 (get-name-service-error-message errno error-code
))))))
227 (defparameter *conditions-for-name-service-errno
* nil
)
228 ;; getaddrinfo and getnameinfo return an error code, rather than using
229 ;; h_errno. While on Linux there's no overlap between their possible
230 ;; values, this doesn't seem to be guaranteed on all systems.
231 (defparameter *conditions-for-name-service-error-code
* nil
)
233 ;; Define a special name-service-error for variour error cases, and associate
234 ;; them with the matching h_errno / error code.
235 (defmacro define-name-service-condition
(errno-symbol error-code-symbol name
)
237 (define-condition ,name
(name-service-error)
238 ((errno-symbol :reader name-service-error-errno-symbol
239 :initform
(quote ,errno-symbol
))
240 (error-code-symbol :reader name-service-error-error-code-symbol
241 :initform
(quote ,error-code-symbol
))))
242 (push (cons ,errno-symbol
(quote ,name
))
243 *conditions-for-name-service-errno
*)
244 #+sb-bsd-sockets-addrinfo
245 (push (cons ,error-code-symbol
(quote ,name
))
246 *conditions-for-name-service-error-code
*)))
249 (define-name-service-condition
250 sockint
::NETDB-INTERNAL
251 nil
;; Doesn't map directly to any getaddrinfo error code
252 netdb-internal-error
)
254 (define-name-service-condition
255 sockint
::NETDB-SUCCESS
256 nil
;; Doesn't map directly to any getaddrinfo error code
258 (define-name-service-condition
259 sockint
::HOST-NOT-FOUND
261 host-not-found-error
)
262 (define-name-service-condition
266 (define-name-service-condition
270 (define-name-service-condition
271 ;; Also defined as NO-DATA, with the same value
273 ;; getaddrinfo() as of RFC 3493 can no longer distinguish between
274 ;; host no found and address not found
278 (defun condition-for-name-service-errno (err)
279 (or (cdr (assoc err
*conditions-for-name-service-errno
* :test
#'eql
))
280 'name-service-error
))
282 (defun condition-for-name-service-error-code (err)
283 (or (cdr (assoc err
*conditions-for-name-service-error-code
* :test
#'eql
))
284 'name-service-error
))
286 (defun get-name-service-errno (&optional errno
)
287 (setf *name-service-errno
*
289 (sb-alien:alien-funcall
291 (sb-alien:extern-alien
"get_h_errno" (function integer
))
293 (sb-alien:extern-alien
"WSAGetLastError" (function integer
))))))
295 (defun get-name-service-error-message (errno error-code
)
298 (sockint::h-strerror errno
)
299 (sockint::gai-strerror error-code
)))