At least one of the Tests which hang on Darwin also hang on SunOS.

[sbcl.git] / contrib / sb-bsd-sockets / inet.lisp

diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp
index 1f2ef4c..e07f828 100644 (file)
--- a/contrib/sb-bsd-sockets/inet.lisp
+++ b/contrib/sb-bsd-sockets/inet.lisp
@@ -64,17 +64,18 @@ Examples:
              (format s "Protocol not found: ~a" (prin1-to-string
                                                  (unknown-protocol-name c))))))
 
+#+(and sb-thread (not os-provides-getprotoby-r))
+;; Since getprotobyname is not thread-safe, we need a lock.
+(sb-ext:defglobal **getprotoby-lock** (sb-thread:make-mutex :name "getprotoby lock"))
+
 ;;; getprotobyname only works in the internet domain, which is why this
 ;;; is here
 (defun get-protocol-by-name (name)      ;exported
-  "Returns the values network protocol number associated with the string NAME,
-using getprotobyname(2) (or getprotobyname_r if SB-THREAD is enabled) which
-typically looks in NIS or /etc/protocols; the protocol's canonical name, and a
-list of protocol aliases"
-
-  ;;Brownie Points.  Hopefully there's one person out there using
-  ;;RSPF sockets and SBCL who will appreciate the extra info
+  "Given a protocol name, return the protocol number, the protocol name, and
+a list of protocol aliases"
 
+  ;; Brownie Points.  Hopefully there's one person out there using
+  ;; RSPF sockets and SBCL who will appreciate the extra info
   (labels ((protoent-to-values (protoent)
              (values
               (sockint::protoent-proto protoent)
@@ -87,7 +88,7 @@ list of protocol aliases"
                    collect (sb-alien::c-string-to-string (sb-alien:alien-sap alias)
                                                          (sb-impl::default-external-format)
                                                          'character))))))
-    #+sb-thread
+    #+(and sb-thread os-provides-getprotoby-r)
     (let ((buffer-length 1024)
           (max-buffer 10000))
       (declare (type fixnum buffer-length)
@@ -121,11 +122,20 @@ list of protocol aliases"
                          (if (> buffer-length max-buffer)
                              (error "Exceeded max-buffer of ~d" max-buffer)))
                        (error "Unexpected errno ~d" errno))))))))
-    #-sb-thread
-    (let ((ent (sockint::getprotobyname name)))
-      (if (sb-alien::null-alien ent)
-          (error 'unknown-protocol :name name))
-      (protoent-to-values ent))))
+    #-(and sb-thread os-provides-getprotoby-r)
+    (tagbody
+       (flet ((get-it ()
+                (let ((ent (sockint::getprotobyname name)))
+                  (if (sb-alien::null-alien ent)
+                      (go :error)
+                      (return-from get-protocol-by-name (protoent-to-values ent))))))
+         #+sb-thread
+         (sb-thread::with-system-mutex (**getprotoby-lock**)
+           (get-it))
+         #-sb-thread
+         (get-it))
+     :error
+       (error 'unknown-protocol :name name))))
 
 ;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
 ;;; bits-of-sockaddr