From: Nikodemus Siivola <nikodemus@sb-studio.net>
Date: Fri, 18 Nov 2011 14:37:20 +0000 (+0200)
Subject: sb-bsd-sockets: gethostbyname and gethostbyaddr are not thread safe
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=dcf7b5cbc859426d005b534f3fa273be5da0b64c;p=sbcl.git

sb-bsd-sockets: gethostbyname and gethostbyaddr are not thread safe

   ...or re-entrant. Need to disable interrupts and grab a lock.

   Affects only platforms without getaddrinfo.

   Correct the size of memory leak fixed in last commit in NEWS -- it
   was more than one word per call.
---

diff --git a/NEWS b/NEWS
index b0ea21f..63beae9 100644
--- a/NEWS
+++ b/NEWS
@@ -24,10 +24,12 @@ changes relative to sbcl-1.0.53:
     result in fasl-dumping internal type objects. (lp#890750)
   * bug fix: type mismatch on (setf aref) and function return values no
     longer result in fasl-dumping internal type objects.
-  * bug fix: SB-BSD-SOCKETS foreign memory leaks
-    ** GET-PROTOCOL-BY-NAME had a significant leak.
-    ** GET-HOST-BY-NAME and GET-HOST-BY-ADDRESS leaked 1 word per call on
-       systems providing getaddrinfo().
+  * bug fix: SB-BSD-SOCKETS issues
+    ** GET-PROTOCOL-BY-NAME had a significant memory leak.
+    ** GET-HOST-BY-NAME and GET-HOST-BY-ADDRESS small amounts of memory on
+       systems with getaddrinfo().
+    ** GET-HOST-BY-NAME and GET-HOST-BY-ADDRESS weren't thread or interrupt
+       safe outside systems with getaddrinfo().
 
 changes in sbcl-1.0.53 relative to sbcl-1.0.52:
   * enhancement: on 64-bit targets, in src/compiler/generic/early-vm.lisp,
diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp
index 8e96c7b..056bda3 100644
--- a/contrib/sb-bsd-sockets/name-service.lisp
+++ b/contrib/sb-bsd-sockets/name-service.lisp
@@ -61,6 +61,9 @@
 
 ;;; Resolving
 
+#+(and sb-thread (not 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,14 +81,15 @@ 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