(in-package :sb-bsd-sockets)
-#|| <a name="name-service"><h2>Name Service</h2></a>
-
-<p>Presently name service is implemented by calling whatever
-gethostbyname(2) uses. This may be any or all of /etc/hosts, NIS, DNS,
-or something completely different. Typically it's controlled by
-/etc/nsswitch.conf
-
-<p> Direct links to the asynchronous resolver(3) routines would be nice to have
-eventually, so that we can do DNS lookups in parallel with other things
-|#
(defclass host-ent ()
- ((name :initarg :name :accessor host-ent-name)
- (aliases :initarg :aliases :accessor host-ent-aliases)
- (address-type :initarg :type :accessor host-ent-address-type)
- ; presently always AF_INET
- (addresses :initarg :addresses :accessor host-ent-addresses)))
+ ((name :initarg :name :reader host-ent-name
+ :documentation "The name of the host")
+ ;; Deliberately not documented, since this isn't very useful,
+ ;; and the data isn't available when using getaddrinfo(). Unfortunately
+ ;; it is exported.
+ (aliases :initarg :aliases :reader host-ent-aliases)
+ ;; presently always AF_INET. Not exported.
+ (address-type :initarg :type :reader host-ent-address-type)
+ (addresses :initarg :addresses :reader host-ent-addresses
+ :documentation "A list of addresses for this host."))
+ (:documentation "This class represents the results of an address lookup."))
-(defgeneric host-ent-address (host-ent))
+(defgeneric host-ent-address (host-ent)
+ (:documentation "Returns some valid address for HOST-ENT."))
(defmethod host-ent-address ((host-ent host-ent))
(car (host-ent-addresses host-ent)))
-;(define-condition host-not-found-error (socket-error)) ; host unknown
-;(define-condition no-address-error (socket-error)) ; valid name but no IP address
-;(define-condition no-recovery-error (socket-error)) ; name server error
-;(define-condition try-again-error (socket-error)) ; temporary
-
-(defun get-host-by-name (host-name)
- "Returns a HOST-ENT instance for HOST-NAME or throws some kind of condition.
-HOST-NAME may also be an IP address in dotted quad notation or some other
-weird stuff - see gethostbyname(3) for grisly details."
- (let ((h (sockint::gethostbyname host-name)))
- (make-host-ent h)))
-
-(defun get-host-by-address (address)
- "Returns a HOST-ENT instance for ADDRESS, which should be a vector of
-(integer 0 255), or throws some kind of error. See gethostbyaddr(3) for
-grisly details."
- (let ((packed-addr (sockint::allocate-in-addr)))
- (loop for i from 0 to 3
- do (setf (sockint::in-addr-addr packed-addr i) (elt address i)))
- (make-host-ent
- (sb-sys:with-pinned-objects (packed-addr)
- (sockint::gethostbyaddr (sb-grovel::array-data-address packed-addr)
- 4
- sockint::af-inet)))))
-
-(defun make-host-ent (h)
- (if (sb-grovel::foreign-nullp h) (name-service-error "gethostbyname"))
- (let* ((local-h (sb-grovel::foreign-vector h 1 sockint::size-of-hostent))
- (length (sockint::hostent-length local-h))
- (aliases
- (loop for i = 0 then (1+ i)
- for al = (sb-sys:sap-ref-sap
- (sb-sys:int-sap (sockint::hostent-aliases local-h))
- (* i 4))
- until (= (sb-sys:sap-int al) 0)
- collect (sb-c-call::%naturalize-c-string al)))
- (address0 (sb-sys:sap-ref-sap (sb-sys:int-sap (sockint::hostent-addresses local-h)) 0))
- (addresses
- (loop for i = 0 then (+ length i)
- for ad = (sb-sys:sap-ref-32 address0 i)
- while (> ad 0)
- collect
- (sb-grovel::foreign-vector (sb-sys:sap+ address0 i) 1 length))))
+#-sb-bsd-sockets-addrinfo
+(defun make-host-ent (h &optional errno)
+ (when (sb-alien:null-alien h)
+ (name-service-error "gethostbyname" errno))
+ (let* ((length (sockint::hostent-length h))
+ (aliases (loop for i = 0 then (1+ i)
+ for al = (sb-alien:deref (sockint::hostent-aliases h) i)
+ while al
+ collect al))
+ (addresses
+ (loop for i = 0 then (1+ i)
+ for ad = (sb-alien:deref (sockint::hostent-addresses h) i)
+ until (sb-alien:null-alien ad)
+ collect (ecase (sockint::hostent-type h)
+ (#.sockint::af-inet
+ ;; CLH: Work around x86-64 darwin bug here.
+ ;; The length is reported as 8, when it should be 4.
+ ;; FIXME: this is rumored to be fixed in 10.5
+ #+(and darwin x86-64)
+ (progn
+ (assert (or (= length 4) (= length 8)))
+ (naturalize-unsigned-byte-8-array ad 4))
+ #-(and darwin x86-64)
+ (progn
+ (assert (= length 4))
+ (naturalize-unsigned-byte-8-array ad length)))
+ #-win32
+ (#.sockint::af-local
+ (sb-alien:cast ad sb-alien:c-string))))))
(make-instance 'host-ent
- :name (sb-c-call::%naturalize-c-string
- (sb-sys:int-sap (sockint::hostent-name local-h)))
- :type (sockint::hostent-type local-h)
+ :name (sockint::hostent-name h)
+ :type (sockint::hostent-type h)
:aliases aliases
:addresses addresses)))
-;;; The remainder is my fault - gw
+(declaim (inline naturalize-unsigned-byte-8-array))
+(defun naturalize-unsigned-byte-8-array (array length)
+ (let ((addr (make-array 4 :element-type '(unsigned-byte 8))))
+ (dotimes (i length)
+ (setf (elt addr i) (sb-alien:deref array i)))
+ addr))
+
+;;; Resolving
+
+#-sb-bsd-sockets-addrinfo
+(progn
+ (sb-ext:defglobal **gethostby-lock**
+ (sb-thread:make-mutex :name "gethostby lock"))
+
+ (defun get-host-by-name (host-name)
+ "Returns a HOST-ENT instance for HOST-NAME or signals a NAME-SERVICE-ERROR.
+HOST-NAME may also be an IP address in dotted quad notation or some other
+weird stuff - see gethostbyname(3) for the details."
+ (sb-thread::with-system-mutex (**gethostby-lock** :allow-with-interrupts t)
+ (make-host-ent (sockint::gethostbyname host-name))))
+
+ (defun get-host-by-address (address)
+ "Returns a HOST-ENT instance for ADDRESS, which should be a vector of
+ (integer 0 255), or signals a NAME-SERVICE-ERROR. See gethostbyaddr(3)
+ for details."
+ (sb-thread::with-system-mutex (**gethostby-lock** :allow-with-interrupts t)
+ (sockint::with-in-addr packed-addr ()
+ (let ((addr-vector (coerce address 'vector)))
+ (loop for i from 0 below (length addr-vector)
+ do (setf (sb-alien:deref (sockint::in-addr-addr packed-addr) i)
+ (elt addr-vector i)))
+ (make-host-ent (sockint::gethostbyaddr packed-addr
+ 4
+ sockint::af-inet)))))))
+
+#+sb-bsd-sockets-addrinfo
+(defconstant ni-max-host 1025) ;; Not inside PROGN because of #.
+
+#+sb-bsd-sockets-addrinfo
+(progn
+ (defun get-host-by-name (node)
+ "Returns a HOST-ENT instance for HOST-NAME or signals a NAME-SERVICE-ERROR.
+HOST-NAME may also be an IP address in dotted quad notation or some other
+weird stuff - see getaddrinfo(3) for the details."
+ (declare (optimize speed))
+ (sb-alien:with-alien ((info (* sockint::addrinfo)))
+ (let* ((err (sockint::getaddrinfo node nil nil (sb-alien:addr info)))
+ (to-free info))
+ (if (zerop err)
+ (let ((host-ent (make-instance 'host-ent
+ :name node
+ :type sockint::af-inet
+ :aliases nil
+ :addresses nil)))
+ (loop until (sb-alien::null-alien info)
+ ;; Only handle AF_INET currently.
+ do
+ (when (eq (sockint::addrinfo-family info) sockint::af-inet)
+ (let* ((sockaddr (sockint::addrinfo-addr info))
+ (address (sockint::sockaddr-in-addr sockaddr)))
+ ;; The same effective result can be multiple time
+ ;; in the list, with different socktypes. Only record
+ ;; each address once.
+ (setf (slot-value host-ent 'addresses)
+ (adjoin (naturalize-unsigned-byte-8-array address
+ 4)
+ (host-ent-addresses host-ent)
+ :test 'equalp))))
+ (setf info (sockint::addrinfo-next info)))
+ (sockint::freeaddrinfo to-free)
+ host-ent)
+ (addrinfo-error "getaddrinfo" err)))))
+
+ (defun get-host-by-address (address)
+ "Returns a HOST-ENT instance for ADDRESS, which should be a vector of
+ (integer 0 255), or signals a NAME-SERVICE-ERROR.
+ See gethostbyaddr(3) for details."
+ (declare (optimize speed)
+ (vector address))
+ (assert (= (length address) 4))
+ (sockint::with-sockaddr-in sockaddr ()
+ (sb-alien:with-alien ((host-buf (array char #.ni-max-host)))
+ #+darwin (setf (sockint::sockaddr-in-len sockaddr) 16)
+ (setf (sockint::sockaddr-in-family sockaddr) sockint::af-inet)
+ (dotimes (i 4)
+ (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i)
+ (aref address i)))
+ (let ((err (sockint::getnameinfo
+ sockaddr
+ (sb-alien:alien-size sockint::sockaddr-in :bytes)
+ (sb-alien:cast host-buf (* char)) ni-max-host
+ nil 0
+ sockint::ni-namereqd)))
+ (if (zerop err)
+ (make-instance 'host-ent
+ :name (sb-alien::c-string-to-string
+ (sb-alien:alien-sap host-buf)
+ (sb-impl::default-external-format)
+ 'character)
+ :type sockint::af-inet
+ :aliases nil
+ :addresses (list address))
+ (addrinfo-error "getnameinfo" err)))))))
+
+;;; Error handling
(defvar *name-service-errno* 0
"The value of h_errno, after it's been fetched from Unix-land by calling
GET-NAME-SERVICE-ERRNO")
-(defun name-service-error (where)
- (get-name-service-errno)
- ;; Comment next to NETDB_INTERNAL in netdb.h says "See errno.".
- ;; This special case treatment hasn't actually been tested yet.
- (if (= *name-service-errno* sockint::NETDB-INTERNAL)
- (socket-error where)
- (let ((condition
- (condition-for-name-service-errno *name-service-errno*)))
- (error condition :errno *name-service-errno* :syscall where))))
-
-(define-condition name-service-error (condition)
- ((errno :initform nil
- :initarg :errno
- :reader name-service-error-errno)
+(defun name-service-error (where &optional errno)
+ ;; There was a dummy docstring here for the texinfo extractor, but I
+ ;; see no reason for this to be documented in the manual, and removed
+ ;; it. -- JES
+ (let ((*name-service-errno* (get-name-service-errno errno)))
+ ;; Comment next to NETDB_INTERNAL in netdb.h says "See errno.".
+ ;; This special case treatment hasn't actually been tested yet.
+ (if (and #-win32 (= *name-service-errno* sockint::NETDB-INTERNAL))
+ (socket-error where)
+ (let ((condition
+ (condition-for-name-service-errno *name-service-errno*)))
+ (error condition :errno *name-service-errno* :syscall where)))))
+
+(defun addrinfo-error (where error-code)
+ (let ((condition (condition-for-name-service-error-code error-code)))
+ (error condition :error-code error-code :syscall where)))
+
+(define-condition name-service-error (error)
+ ((errno :initform nil :initarg :errno :reader name-service-error-errno)
+ (error-code :initform nil :initarg :error-code
+ :reader name-service-error-error-code)
(symbol :initform nil :initarg :symbol :reader name-service-error-symbol)
(syscall :initform "an unknown location" :initarg :syscall :reader name-service-error-syscall))
(:report (lambda (c s)
- (let ((num (name-service-error-errno c)))
- (format s "Name service error in \"~A\": ~A (~A)"
- (name-service-error-syscall c)
- (or (name-service-error-symbol c)
- (name-service-error-errno c))
- (get-name-service-error-message num))))))
-
-(defmacro define-name-service-condition (symbol name)
- `(progn
- (define-condition ,name (name-service-error)
- ((symbol :reader name-service-error-symbol :initform (quote ,symbol))))
- (push (cons ,symbol (quote ,name)) *conditions-for-name-service-errno*)))
+ (let* ((errno (name-service-error-errno c))
+ (error-code (name-service-error-error-code c)))
+ (format s "Name service error in \"~A\": ~A (~A)"
+ (name-service-error-syscall c)
+ (or (name-service-error-symbol c)
+ errno
+ error-code)
+ (get-name-service-error-message errno error-code))))))
(defparameter *conditions-for-name-service-errno* nil)
+;; getaddrinfo and getnameinfo return an error code, rather than using
+;; h_errno. While on Linux there's no overlap between their possible
+;; values, this doesn't seem to be guaranteed on all systems.
+(defparameter *conditions-for-name-service-error-code* nil)
-(define-name-service-condition sockint::NETDB-INTERNAL netdb-internal-error)
-(define-name-service-condition sockint::NETDB-SUCCESS netdb-success-error)
-(define-name-service-condition sockint::HOST-NOT-FOUND host-not-found-error)
-(define-name-service-condition sockint::TRY-AGAIN try-again-error)
-(define-name-service-condition sockint::NO-RECOVERY no-recovery-error)
-;; this is the same as the next one
-;;(define-name-service-condition sockint::NO-DATA no-data-error)
-(define-name-service-condition sockint::NO-ADDRESS no-address-error)
+;; Define a special name-service-error for variour error cases, and associate
+;; them with the matching h_errno / error code.
+(defmacro define-name-service-condition (errno-symbol error-code-symbol name)
+ `(progn
+ (define-condition ,name (name-service-error)
+ ((errno-symbol :reader name-service-error-errno-symbol
+ :initform (quote ,errno-symbol))
+ (error-code-symbol :reader name-service-error-error-code-symbol
+ :initform (quote ,error-code-symbol))))
+ (push (cons ,errno-symbol (quote ,name))
+ *conditions-for-name-service-errno*)
+ #+sb-bsd-sockets-addrinfo
+ (push (cons ,error-code-symbol (quote ,name))
+ *conditions-for-name-service-error-code*)))
+
+#-win32
+(define-name-service-condition
+ sockint::NETDB-INTERNAL
+ nil ;; Doesn't map directly to any getaddrinfo error code
+ netdb-internal-error)
+#-win32
+(define-name-service-condition
+ sockint::NETDB-SUCCESS
+ nil ;; Doesn't map directly to any getaddrinfo error code
+ netdb-success-error)
+(define-name-service-condition
+ sockint::HOST-NOT-FOUND
+ sockint::EAI-NONAME
+ host-not-found-error)
+(define-name-service-condition
+ sockint::TRY-AGAIN
+ sockint::EAI-AGAIN
+ try-again-error)
+(define-name-service-condition
+ sockint::NO-RECOVERY
+ sockint::EAI-FAIL
+ no-recovery-error)
+(define-name-service-condition
+ ;; Also defined as NO-DATA, with the same value
+ sockint::NO-ADDRESS
+ ;; getaddrinfo() as of RFC 3493 can no longer distinguish between
+ ;; host no found and address not found
+ nil
+ no-address-error)
(defun condition-for-name-service-errno (err)
(or (cdr (assoc err *conditions-for-name-service-errno* :test #'eql))
- 'name-service))
+ 'name-service-error))
+(defun condition-for-name-service-error-code (err)
+ (or (cdr (assoc err *conditions-for-name-service-error-code* :test #'eql))
+ 'name-service-error))
-
-(defun get-name-service-errno ()
+(defun get-name-service-errno (&optional errno)
(setf *name-service-errno*
- (sb-alien:alien-funcall
- (sb-alien:extern-alien "get_h_errno" (function integer)))))
-
-#-(and cmu solaris)
-(progn
- #+sbcl
- (sb-alien:define-alien-routine "hstrerror"
- sb-c-call:c-string
- (errno integer))
- #+cmu
- (alien:def-alien-routine "hstrerror"
- sb-c-call:c-string
- (errno integer))
- (defun get-name-service-error-message (num)
- (hstrerror num))
-)
+ (or errno
+ (sb-alien:alien-funcall
+ #-win32
+ (sb-alien:extern-alien "get_h_errno" (function integer))
+ #+win32
+ (sb-alien:extern-alien "WSAGetLastError" (function integer))))))
+(defun get-name-service-error-message (errno error-code)
+ #-win32
+ (if errno
+ (sockint::h-strerror errno)
+ (sockint::gai-strerror error-code)))
projects / sbcl.git / blobdiff