1 (defpackage "SB-BSD-SOCKETS-TEST"
2 (:use
"CL" "SB-BSD-SOCKETS" "SB-RT"))
4 (in-package :sb-bsd-sockets-test
)
6 (defmacro deftest
* ((name &key fails-on
) form
&rest results
)
8 (when (sb-impl::featurep
',fails-on
)
9 (pushnew ',name sb-rt
::*expected-failures
*))
10 (deftest ,name
,form
,@results
)))
13 (deftest make-inet-address
14 (equalp (make-inet-address "127.0.0.1") #(127 0 0 1))
16 ;;; and an address with bit 8 set on some octets
17 (deftest make-inet-address2
18 (equalp (make-inet-address "242.1.211.3") #(242 1 211 3))
22 (deftest make-inet6-address
.1
23 (equalp (make-inet6-address "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff")
24 #(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255))
27 (deftest get-protocol-by-name
/tcp
28 (integerp (get-protocol-by-name "tcp"))
31 (deftest get-protocol-by-name
/udp
32 (integerp (get-protocol-by-name "udp"))
35 ;;; See https://bugs.launchpad.net/sbcl/+bug/659857
36 ;;; Apparently getprotobyname_r on FreeBSD says -1 and EINTR
37 ;;; for unknown protocols...
38 #-
(and freebsd sb-thread
)
39 #-
(and dragonfly sb-thread
)
40 (deftest get-protocol-by-name
/error
41 (handler-case (get-protocol-by-name "nonexistent-protocol")
48 (deftest make-inet-socket.smoke
50 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
(get-protocol-by-name "tcp"))))
51 (> (socket-file-descriptor s
) 1))
54 (deftest make-inet-socket.keyword
56 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
)))
57 (> (socket-file-descriptor s
) 1))
60 (deftest* (make-inet-socket-wrong)
61 ;; fail to make a socket: check correct error return. There's no nice
62 ;; way to check the condition stuff on its own, which is a shame
64 (make-instance 'inet-socket
:type
:stream
:protocol
(get-protocol-by-name "udp"))
65 ;; CLH FIXME! some versions of darwin just return a socket error
66 ;; here, not socket-type-not-supported-error or
67 ;; protocol-not-supported-error.
68 ((or #+darwin socket-error
69 operation-not-supported-error
70 socket-type-not-supported-error
71 protocol-not-supported-error
)
77 (deftest* (make-inet-socket-keyword-wrong)
78 ;; same again with keywords
80 (make-instance 'inet-socket
:type
:stream
:protocol
:udp
)
81 ;; CLH FIXME! some versions of darwin just return a socket error
82 ;; here, not socket-type-not-supported-error or
83 ;; protocol-not-supported-error.
86 operation-not-supported-error
87 protocol-not-supported-error
88 socket-type-not-supported-error
)
95 (deftest make-inet6-socket.smoke
97 (let ((s (make-instance 'inet6-socket
:type
:stream
:protocol
(get-protocol-by-name "tcp"))))
98 (> (socket-file-descriptor s
) 1))
99 ((or address-family-not-supported protocol-not-supported-error
) () t
))
103 (deftest make-inet6-socket.keyword
105 (let ((s (make-instance 'inet6-socket
:type
:stream
:protocol
:tcp
)))
106 (> (socket-file-descriptor s
) 1))
107 ((or address-family-not-supported protocol-not-supported-error
) () t
))
110 (deftest* (non-block-socket)
111 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
)))
112 (setf (non-blocking-mode s
) t
)
113 (non-blocking-mode s
))
116 (deftest inet-socket-bind
117 (let* ((tcp (get-protocol-by-name "tcp"))
118 (address (make-inet-address "127.0.0.1"))
119 (s1 (make-instance 'inet-socket
:type
:stream
:protocol tcp
))
120 (s2 (make-instance 'inet-socket
:type
:stream
:protocol tcp
)))
122 ;; Given the functions we've got so far, if you can think of a
123 ;; better way to make sure the bind succeeded than trying it
124 ;; twice, let me know
126 (socket-bind s1 address
0)
128 (let ((port (nth-value 1 (socket-name s1
))))
129 (socket-bind s2 address port
)
131 (address-in-use-error () t
)))
137 (deftest inet6-socket-bind
139 (let* ((tcp (get-protocol-by-name "tcp"))
140 (address (make-inet6-address "::1"))
141 (s1 (make-instance 'inet6-socket
:type
:stream
:protocol tcp
))
142 (s2 (make-instance 'inet6-socket
:type
:stream
:protocol tcp
)))
144 ;; Given the functions we've got so far, if you can think of a
145 ;; better way to make sure the bind succeeded than trying it
146 ;; twice, let me know
148 (socket-bind s1 address
0)
150 ;; This may mean no IPv6 support, can't fail a test
151 ;; because of that (address-family-not-supported doesn't catch that)
156 (let ((port (nth-value 1 (socket-name s1
))))
157 (socket-bind s2 address port
)
159 (address-in-use-error () t
))))
162 ((or address-family-not-supported protocol-not-supported-error
) () t
))
165 (deftest* (simple-sockopt-test)
166 ;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
167 ;; the process that all the weird macros in sockopt happened right.
168 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
(get-protocol-by-name "tcp"))))
169 (setf (sockopt-reuse-address s
) t
)
170 (sockopt-reuse-address s
))
173 (defun read-buf-nonblock (buffer stream
)
174 "Like READ-SEQUENCE, but returns early if the full quantity of data isn't there to be read. Blocks if no input at all"
175 (let ((eof (gensym)))
177 (c (read-char stream nil eof
)
178 (read-char-no-hang stream nil eof
)))
179 ((or (>= i
(length buffer
)) (not c
) (eq c eof
)) i
)
180 (setf (elt buffer i
) c
))))
183 (deftest name-service-return-type
184 (vectorp (host-ent-address (get-host-by-address #(127 0 0 1))))
187 ;;; these require that the echo services are turned on in inetd
189 (deftest simple-tcp-client
190 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
))
191 (data (make-string 200)))
192 (socket-connect s
#(127 0 0 1) 7)
193 (let ((stream (socket-make-stream s
:input t
:output t
:buffering
:none
)))
194 (format stream
"here is some text")
195 (let ((data (subseq data
0 (read-buf-nonblock data stream
))))
196 (format t
"~&Got ~S back from TCP echo server~%" data
)
197 (> (length data
) 0))))
201 (deftest sockaddr-return-type
202 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
)))
205 (socket-connect s
#(127 0 0 1) 7)
206 (multiple-value-bind (host port
) (socket-peername s
)
213 (deftest simple-udp-client
214 (let ((s (make-instance 'inet-socket
:type
:datagram
:protocol
(get-protocol-by-name "udp")))
215 (data (make-string 200)))
216 (format t
"Socket type is ~A~%" (sockopt-type s
))
217 (socket-connect s
#(127 0 0 1) 7)
218 (let ((stream (socket-make-stream s
:input t
:output t
:buffering
:none
)))
219 (format stream
"here is some text")
220 (let ((data (subseq data
0 (read-buf-nonblock data stream
))))
221 (format t
"~&Got ~S back from UDP echo server~%" data
)
222 (> (length data
) 0))))
225 ;;; A fairly rudimentary test that connects to the syslog socket and
226 ;;; sends a message. Priority 7 is kern.debug; you'll probably want
227 ;;; to look at /etc/syslog.conf or local equivalent to find out where
228 ;;; the message ended up
231 (deftest simple-local-client
233 ;; SunOS (Solaris) and Darwin systems don't have a socket at
234 ;; /dev/log. We might also be building in a chroot or
235 ;; something, so don't fail this test just because the file is
236 ;; unavailable, or if it's a symlink to some weird character
239 (handler-bind ((sb-posix:syscall-error
244 (sb-posix::stat-mode
(sb-posix:stat
"/dev/log")))))
245 (let ((s (make-instance 'local-socket
:type
:datagram
)))
246 (format t
"Connecting ~A... " s
)
249 (socket-connect s
"/dev/log")
250 (sb-bsd-sockets::socket-error
()
251 (setq s
(make-instance 'local-socket
:type
:stream
))
252 (format t
"failed~%Retrying with ~A... " s
)
254 (socket-connect s
"/dev/log")))
256 (let ((stream (socket-make-stream s
:input t
:output t
:buffering
:none
)))
258 "<7>bsd-sockets: Don't panic. We're testing local-domain client code; this message can safely be ignored"))))
263 ;;; these require that the internet (or bits of it, at least) is available
266 (deftest get-host-by-name.v4
267 (equalp (car (host-ent-addresses (get-host-by-name "a.root-servers.net")))
272 (deftest get-host-by-name.v6
273 (equalp (car (host-ent-addresses (nth-value 1 (get-host-by-name "a.root-servers.net"))))
274 #(32 1 5 3 186 62 0 0 0 0 0 0 0 2 0 48))
278 (deftest get-host-by-address.v4
279 (host-ent-name (get-host-by-address #(198 41 0 4)))
280 "a.root-servers.net")
283 (deftest get-host-by-address.v6
284 (host-ent-name (get-host-by-address #(32 1 5 3 186 62 0 0 0 0 0 0 0 2 0 48)))
285 "a.root-servers.net")
287 ;;; These days lots of people seem to be using DNS servers that don't
288 ;;; report resolving failures for non-existing domains. This test
289 ;;; will fail there, so we've disabled it.
291 (deftest get-host-by-name-wrong
293 (get-host-by-name "foo.tninkpad.telent.net.")
294 (NAME-SERVICE-ERROR () t
)
298 (defun http-stream (host port request
)
299 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
)))
301 s
(car (host-ent-addresses (get-host-by-name host
))) port
)
302 (let ((stream (socket-make-stream s
:input t
:output t
:buffering
:none
)))
303 (format stream
"~A HTTP/1.0~%~%" request
))
307 (deftest simple-http-client-1
309 (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
310 (let ((data (make-string 200)))
311 (setf data
(subseq data
0
312 (read-buf-nonblock data
313 (socket-make-stream s
))))
315 (> (length data
) 0)))
316 (network-unreachable-error () 'network-unreachable
))
321 (deftest sockopt-receive-buffer
322 ;; on Linux x86, the receive buffer size appears to be doubled in the
323 ;; kernel: we set a size of x and then getsockopt() returns 2x.
324 ;; This is why we compare with >= instead of =
326 (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
327 (setf (sockopt-receive-buffer s
) 1975)
328 (let ((data (make-string 200)))
329 (setf data
(subseq data
0
330 (read-buf-nonblock data
331 (socket-make-stream s
))))
332 (and (> (length data
) 0)
333 (>= (sockopt-receive-buffer s
) 1975))))
334 (network-unreachable-error () 'network-unreachable
))
337 (deftest socket-open-p-true
.1
338 (socket-open-p (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
))
341 (deftest socket-open-p-true
.2
342 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
)))
345 (socket-connect s
#(127 0 0 1) 7)
349 (deftest socket-open-p-false
350 (let ((s (make-instance 'inet-socket
:type
:stream
:protocol
:tcp
)))
355 ;;; we don't have an automatic test for some of this yet. There's no
356 ;;; simple way to run servers and have something automatically connect
357 ;;; to them as client, unless we spawn external programs. Then we
358 ;;; have to start telling people what external programs they should
359 ;;; have installed. Which, eventually, we will, but not just yet
362 ;;; to check with this: can display packets from multiple peers
363 ;;; peer address is shown correctly for each packet
364 ;;; packet length is correct
365 ;;; long (>500 byte) packets have the full length shown (doesn't work)
367 (defun udp-server (port)
368 (let ((s (make-instance 'inet-socket
:type
:datagram
:protocol
:udp
)))
369 (socket-bind s
#(0 0 0 0) port
)
371 (multiple-value-bind (buf len address port
) (socket-receive s nil
500)
372 (format t
"Received ~A bytes from ~A:~A - ~A ~%"
373 len address port
(subseq buf
0 (min 10 len
)))))))
376 (deftest interrupt-io
381 (let ((s (make-instance 'inet-socket
384 (socket-connect s
#(127 0 0 1) port
)
385 (let ((stream (socket-make-stream s
401 (let ((s (make-instance 'inet-socket
404 (setf (sockopt-reuse-address s
) t
)
405 (socket-bind s
(make-inet-address "127.0.0.1") 0)
407 (multiple-value-bind (* port
)
409 (let* ((client (sb-thread:make-thread
410 (lambda () (client port
))))
411 (r (socket-accept s
))
412 (stream (socket-make-stream r
419 (sb-thread:interrupt-thread client
420 (lambda () (throw 'stop ok
)))
423 (write-char #\x stream
)
425 (socket-close r
))))))
430 (defmacro with-client-and-server
((server-socket-var client-socket-var
) &body body
)
431 (let ((listen-socket (gensym "LISTEN-SOCKET")))
432 `(let ((,listen-socket
(make-instance 'inet-socket
435 (,client-socket-var
(make-instance 'inet-socket
438 (,server-socket-var
))
441 (setf (sockopt-reuse-address ,listen-socket
) t
)
442 (socket-bind ,listen-socket
(make-inet-address "127.0.0.1") 0)
443 (socket-listen ,listen-socket
5)
444 (socket-connect ,client-socket-var
(make-inet-address "127.0.0.1")
445 (nth-value 1 (socket-name ,listen-socket
)))
446 (setf ,server-socket-var
(socket-accept ,listen-socket
))
448 (socket-close ,client-socket-var
)
449 (socket-close ,listen-socket
)
450 (when ,server-socket-var
451 (socket-close ,server-socket-var
))))))
453 ;; For stream sockets, make sure a shutdown of the output direction
454 ;; translates into an END-OF-FILE on the other end, no matter which
455 ;; end performs the shutdown and independent of the element-type of
458 ((define-shutdown-test (name who-shuts-down who-reads element-type direction
)
460 (with-client-and-server (client server
)
461 (socket-shutdown ,who-shuts-down
:direction
,direction
)
463 (sb-ext:with-timeout
2
464 (,(if (eql element-type
'character
)
465 'read-char
'read-byte
)
467 ,who-reads
:input t
:output t
468 :element-type
',element-type
)))
471 (sb-ext:timeout
() :timeout
)))
473 (define-shutdown-tests (direction)
474 (flet ((make-name (name)
476 'string
(string name
) "." (string direction
)))))
478 (define-shutdown-test ,(make-name 'shutdown.server.character
)
479 server client character
,direction
)
480 (define-shutdown-test ,(make-name 'shutdown.server.ub8
)
481 server client
(unsigned-byte 8) ,direction
)
482 (define-shutdown-test ,(make-name 'shutdown.client.character
)
483 client server character
,direction
)
484 (define-shutdown-test ,(make-name 'shutdown.client.ub8
)
485 client server
(unsigned-byte 8) ,direction
)))))
487 (define-shutdown-tests :output
)
488 (define-shutdown-tests :io
))