(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)
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)
(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