X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fname-service.lisp;h=51c1c828ec27e5ff0d33983f6c3d1881ed3f52e6;hb=2d68a49fe9d30f687da45cfe7a02b497cb91137c;hp=dfa826b1681eee6ae3ae0daff63c235ff53e65cd;hpb=27763fafd1b170518ac2e85b9344fdddddcfd7c5;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp index dfa826b..51c1c82 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.")) @@ -20,8 +19,9 @@ (defmethod host-ent-address ((host-ent host-ent)) (car (host-ent-addresses host-ent))) +#-sb-bsd-sockets-addrinfo (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 +34,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)))))) @@ -45,6 +54,7 @@ :aliases aliases :addresses addresses))) +(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) @@ -53,6 +63,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 +73,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,59 +83,68 @@ 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 +(declaim (inline get-address-info)) +#+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))) + (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 for sap = (sb-alien:deref res) then (sockint::addrinfo-next info) - until (sb-alien::null-alien sap) - for info = (sb-alien:cast sap (* sockint::addrinfo)) + (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 (host-ent-addresses host-ent) - (adjoin (naturalize-unsigned-byte-8-array address - 4) - (host-ent-addresses host-ent) - :test 'equalp))))) - (sockint::free-addrinfo (sb-alien:deref res)) + 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))))) (defconstant ni-max-host 1025) #+sb-bsd-sockets-addrinfo +(declaim (inline get-name-info)) +#+sb-bsd-sockets-addrinfo (defun get-name-info (address) + (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 (sb-alien:alien-sap sockaddr) + (let ((err (sockint::getnameinfo sockaddr (sb-alien:alien-size sockint::sockaddr-in :bytes) (sb-alien:cast host-buf (* char)) ni-max-host nil 0 @@ -150,8 +173,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 +183,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 +243,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 - sockint::EAI-NODATA + ;; 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)