1 (in-package :sb-bsd-sockets
)
5 (define-condition unknown-protocol
()
7 :reader unknown-protocol-name
))
9 (format s
"Protocol not found: ~a" (prin1-to-string
10 (unknown-protocol-name c
))))))
12 `((:tcp
,sockint
::ipproto_tcp
"tcp" "TCP")
13 (:udp
,sockint
::ipproto_udp
"udp" "UDP")
14 (:ip
,sockint
::ipproto_ip
"ip" "IP")
15 (:ipv6
,sockint
::ipproto_ipv6
"ipv6" "IPV6")
16 (:icmp
,sockint
::ipproto_icmp
"icmp" "ICMP")
17 (:igmp
,sockint
::ipproto_igmp
"igmp" "IGMP")
18 (:raw
,sockint
::ipproto_raw
"raw" "RAW")))
20 ;;; Try to get to a protocol quickly, falling back to calling
21 ;;; getprotobyname if it's available.
22 (defun get-protocol-by-name (name)
23 "Given a protocol name, return the protocol number, the protocol name, and
24 a list of protocol aliases"
25 (let ((result (cdr (if (keywordp name
)
26 (assoc name
*protocols
*)
27 (assoc name
*protocols
* :test
#'string-equal
)))))
29 (values (first result
) (second result
) (third result
))
31 (getprotobyname (string-downcase name
))
32 #+android
(error 'unknown-protocol
:name name
))))
34 #+(and sb-thread
(not os-provides-getprotoby-r
) (not android
) (not netbsd
))
35 ;; Since getprotobyname is not thread-safe, we need a lock.
36 (sb-ext:defglobal
**getprotoby-lock
** (sb-thread:make-mutex
:name
"getprotoby lock"))
38 ;;; getprotobyname only works in the internet domain, which is why this
41 (defun getprotobyname (name)
42 ;; Brownie Points. Hopefully there's one person out there using
43 ;; RSPF sockets and SBCL who will appreciate the extra info
44 (labels ((protoent-to-values (protoent)
46 (sockint::protoent-proto protoent
)
47 (sockint::protoent-name protoent
)
50 for alias
= (sb-alien:deref
51 (sockint::protoent-aliases protoent
) index
)
52 while
(not (sb-alien:null-alien alias
))
54 collect
(sb-alien::c-string-to-string
55 (sb-alien:alien-sap alias
)
56 (sb-impl::default-external-format
)
58 #+(and sb-thread os-provides-getprotoby-r
(not netbsd
))
59 (let ((buffer-length 1024)
65 (declare (type fixnum buffer-length
)
66 (type fixnum max-buffer
))
70 (setf result-buf
(sb-alien:make-alien sockint
::protoent
)
71 buffer
(sb-alien:make-alien sb-alien
:char buffer-length
))
73 (setf result
(sb-alien:make-alien
(* sockint
::protoent
)))
74 (when (or (sb-alien:null-alien result-buf
)
75 (sb-alien:null-alien buffer
)
76 (sb-alien:null-alien result
))
77 (error "Could not allocate foreign memory."))
78 (let ((res (sockint::getprotobyname-r
79 name result-buf buffer buffer-length
#-solaris result
)))
82 (when (sb-alien:null-alien
(sb-alien:deref result
0))
83 (error 'unknown-protocol
:name name
))
84 (return-from getprotobyname
85 (protoent-to-values result-buf
)))
87 (let ((errno (sb-alien:get-errno
)))
88 (cond ((eql errno sb-unix
:enoent
)
89 ;; Usually caused by missing /etc/protocols
90 (error 'unknown-protocol
:name name
))
91 ((eql errno sockint
::erange
)
92 (incf buffer-length
1024)
93 (when (> buffer-length max-buffer
)
94 (error "Exceeded max-buffer of ~d" max-buffer
)))
96 (error "Unexpected errno ~d" errno
))))))))
98 (sb-alien:free-alien result-buf
))
100 (sb-alien:free-alien buffer
))
103 (sb-alien:free-alien result
)))))
104 #+(or (not sb-thread
) (not os-provides-getprotoby-r
) netbsd
)
107 (let ((ent (sockint::getprotobyname name
)))
108 (if (sb-alien::null-alien ent
)
110 (return-from getprotobyname
(protoent-to-values ent
))))))
111 #+(and sb-thread
(not netbsd
))
112 (sb-thread::with-system-mutex
(**getprotoby-lock
**)
114 #+(or (not sb-thread
) netbsd
)
117 (error 'unknown-protocol
:name name
))))