X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fname-service.lisp;h=d1483735212842fdface54ccf1484b199749ec0e;hb=7f4bf063d5f4716b87d34cc706f05b27ad3906b1;hp=f37556244cb8d79279aadc1d2e0ec9412ab4d924;hpb=b3893d0b3c852b0b535ba6ecd9d66a5f92308c09;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp index f375562..d148373 100644 --- a/contrib/sb-bsd-sockets/name-service.lisp +++ b/contrib/sb-bsd-sockets/name-service.lisp @@ -1,16 +1,15 @@ (in-package :sb-bsd-sockets) (defclass host-ent () - ;; Unfortunately the docstring generator can't currently create. - ((name :initarg :name :accessor host-ent-name + ((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 :accessor host-ent-aliases) + (aliases :initarg :aliases :reader host-ent-aliases) ;; presently always AF_INET. Not exported. - (address-type :initarg :type :accessor host-ent-address-type) - (addresses :initarg :addresses :accessor host-ent-addresses + (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.")) @@ -21,7 +20,7 @@ (car (host-ent-addresses host-ent))) (defun make-host-ent (h &optional errno) - (when (sb-grovel::foreign-nullp h) + (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) @@ -34,8 +33,17 @@ 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)) + (naturalize-unsigned-byte-8-array ad length))) #-win32 (#.sockint::af-local (sb-alien:cast ad sb-alien:c-string)))))) @@ -53,6 +61,9 @@ ;;; Resolving +#-sb-bsd-sockets-addrinfo +(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 @@ -60,7 +71,8 @@ weird stuff - see gethostbyname(3) or getaddrinfo(3) for the details." #+sb-bsd-sockets-addrinfo (get-address-info host-name) #-sb-bsd-sockets-addrinfo - (make-host-ent (sockint::gethostbyname host-name))) + (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 @@ -69,22 +81,23 @@ weird stuff - see gethostbyname(3) or getaddrinfo(3) for the details." #+sb-bsd-sockets-addrinfo (get-name-info address) #-sb-bsd-sockets-addrinfo - (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-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)))))) ;;; Emulate the above two functions with getaddrinfo / getnameinfo #+sb-bsd-sockets-addrinfo (defun get-address-info (node) - (sb-alien:with-alien ((res (* (* sockint::addrinfo)) :local - (sb-alien:make-alien (* sockint::addrinfo)))) - (let ((err (sockint::getaddrinfo node nil nil res))) + (sb-alien:with-alien ((buf (sb-alien:array (* sockint::addrinfo) 1))) + (let* ((res (sb-alien:addr (sb-alien:deref buf 0))) + (err (sockint::getaddrinfo node nil nil res))) (if (zerop err) (let ((host-ent (make-instance 'host-ent :name node @@ -101,12 +114,12 @@ weird stuff - see gethostbyname(3) or getaddrinfo(3) for the details." ;; The same effective result can be multiple time ;; in the list, with different socktypes. Only record ;; each address once. - (setf (host-ent-addresses host-ent) + (setf (slot-value host-ent 'addresses) (adjoin (naturalize-unsigned-byte-8-array address 4) (host-ent-addresses host-ent) :test 'equalp))))) - (sockint::free-addrinfo (sb-alien:deref res)) + (sockint::freeaddrinfo (sb-alien:deref res)) host-ent) (addrinfo-error "getaddrinfo" err))))) @@ -117,6 +130,7 @@ weird stuff - see gethostbyname(3) or getaddrinfo(3) for the details." (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) @@ -150,8 +164,7 @@ GET-NAME-SERVICE-ERRNO") (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. - #-win32 - (if (= *name-service-errno* sockint::NETDB-INTERNAL) + (if (and #-win32 (= *name-service-errno* sockint::NETDB-INTERNAL)) (socket-error where) (let ((condition (condition-for-name-service-errno *name-service-errno*))) @@ -161,7 +174,7 @@ GET-NAME-SERVICE-ERRNO") (let ((condition (condition-for-name-service-error-code error-code))) (error condition :error-code error-code :syscall where))) -(define-condition name-service-error (condition) +(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) @@ -221,8 +234,11 @@ GET-NAME-SERVICE-ERRNO") sockint::EAI-FAIL no-recovery-error) (define-name-service-condition - sockint::NO-ADDRESS ;; Also defined as NO-DATA, with the same value - #-freebsd sockint::EAI-NODATA #+freebsd nil + ;; 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)