X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fname-service.lisp;h=d1483735212842fdface54ccf1484b199749ec0e;hb=7f4bf063d5f4716b87d34cc706f05b27ad3906b1;hp=165c2152f18413da85e330451d79d8f1c70c7a7a;hpb=96f9d7f026dbafe7c6a7842acf4b1376149dbf6d;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp
index 165c215..d148373 100644
--- a/contrib/sb-bsd-sockets/name-service.lisp
+++ b/contrib/sb-bsd-sockets/name-service.lisp
@@ -61,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
@@ -68,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
@@ -77,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
@@ -114,7 +119,7 @@ weird stuff - see gethostbyname(3) or getaddrinfo(3) for the details."
                                                                          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)))))
 
@@ -159,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*)))