X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=contrib%2Fsb-bsd-sockets%2Fname-service.lisp;h=51c1c828ec27e5ff0d33983f6c3d1881ed3f52e6;hb=2d68a49fe9d30f687da45cfe7a02b497cb91137c;hp=ff9279bfbcccff5f6f28f94628e179e89936cbc2;hpb=127fd3d2fb843c6bb7ad0763e143d81877e760e8;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp index ff9279b..51c1c82 100644 --- a/contrib/sb-bsd-sockets/name-service.lisp +++ b/contrib/sb-bsd-sockets/name-service.lisp @@ -19,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) @@ -35,7 +36,7 @@ (#.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 fix in 10.5 + ;; FIXME: this is rumored to be fixed in 10.5 #+(and darwin x86-64) (progn (assert (or (= length 4) (= length 8))) @@ -53,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) @@ -61,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 @@ -68,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 @@ -77,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 (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)) + 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 @@ -158,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*))) @@ -169,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) @@ -229,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 - #-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)