1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
3 ;;; --- iolib.sockets test suite.
6 (in-package :iolib-tests
)
8 (in-suite :iolib.sockets
)
10 (defparameter *echo-address
* (ensure-address #(127 0 0 1)))
11 (defparameter *echo-port
* 7)
12 (defparameter *echo-timeout
* 2)
17 (test address-to-vector
.1
18 (is (equalp (address-to-vector "127.0.0.1")
19 (values #(127 0 0 1) :ipv4
))))
21 ;;; and an address with bit 8 set on some octets
22 (test address-to-vector
.2
23 (is (equalp (address-to-vector "242.1.211.3")
24 (values #(242 1 211 3) :ipv4
))))
26 (test address-to-vector
.3
27 (is (equalp (address-to-vector "::")
28 (values #(0 0 0 0 0 0 0 0) :ipv6
))))
30 ;;; RT: used to return the PARSE-ERROR as a secondary value.
31 (test string-address-to-vector
.1
32 (is-false (string-address-to-vector "256.0.0.1")))
34 ;;; RT: should only ignore PARSE-ERRORs.
35 (test string-address-to-vector
.2
37 (string-address-to-vector 'not-a-string
)))
39 ;;; RT: should signal a PARSE-ERROR when given an invalid string.
40 (test ensure-address
.1
42 (ensure-address "ff0x::114")))
45 (test ensure-address
.2
47 (ensure-address "127.0.256.1")))
49 (test ensure-address
.3
51 (or (ensure-address "ff0x::114" :errorp nil
)
52 (ensure-address "127.0.256.1" :errorp nil
))))
54 (test integer-to-dotted-and-back
56 (every (lambda (s) (string= s
(integer-to-dotted (dotted-to-integer s
))))
57 '("0.0.255.0" "0.255.255.0" "0.255.255.1"))))
59 (test integer-to-dotted
.1
60 (is (string= (integer-to-dotted 0)
63 (test integer-to-dotted
.2
64 (is (string= (integer-to-dotted +max-ipv4-value
+)
67 (test integer-to-dotted
.3
69 (integer-to-dotted (1+ +max-ipv4-value
+))))
71 (test integer-to-dotted
.4
73 (integer-to-dotted -
1)))
75 (test dotted-to-vector
.1
76 (is (equalp (mapcar #'dotted-to-vector
'("255.255.255.255" "0.0.0.0" "127.0.0.1"))
77 '(#(255 255 255 255) #(0 0 0 0) #(127 0 0 1)))))
79 (test dotted-to-vector
.2
81 (dotted-to-vector "127.0.0.0.0")))
83 (test dotted-to-vector
.3
85 (dotted-to-vector 'not-a-string
)))
87 (test vector-to-dotted
.1
88 (is (equalp (mapcar #'vector-to-dotted
'(#(255 255 255 255) #(0 0 0 0) (127 0 0 1)))
89 '("255.255.255.255" "0.0.0.0" "127.0.0.1"))))
91 (test vector-to-dotted
.2
93 (vector-to-dotted #(127 0 0 256))))
95 (test address-to-string
.1
96 (is (equalp (mapcar (lambda (x) (address-to-string (make-address x
)))
97 '(#(127 0 0 1) #(255 255 255 255) #(0 0 0 0 0 0 0 0)
98 #(0 0 0 0 0 0 0 1) #(1 0 0 0 0 0 0 0)))
99 '("127.0.0.1" "255.255.255.255" "::" "::1" "1::"))))
101 (test vector-to-colon-separated
.1
102 (is (equalp (let ((ip #(0 0 0 255 255 255 0 0)))
103 (values (vector-to-colon-separated ip
)
104 (vector-to-colon-separated ip
:downcase
)
105 (vector-to-colon-separated ip
:upcase
)))
106 (values "::ff:ff:ff:0:" "::ff:ff:ff:0:" "::FF:FF:FF:0:"))))
108 (test vector-to-colon-separated
.2
109 (is (string= (vector-to-colon-separated #(1 2 3 4 5 0 6 7))
112 (test vector-to-colon-separated
.3
113 (is (string= (vector-to-colon-separated #(0 2 3 4 5 0 6 7))
116 (test vector-to-colon-separated
.4
117 (is (string= (vector-to-colon-separated #(1 2 3 4 5 0 6 0))
120 (test colon-separated-to-vector
.1
121 (is (equalp (mapcar #'colon-separated-to-vector
122 '(":ff::ff:" "::" "::1" "1::" ":2:3:4:5:6:7:8" "1:2:3:4:5:6:7:"
123 ":1::2:" "::127.0.0.1" ":1::127.0.0.1"))
124 '(#(0 #xff
0 0 0 0 #xff
0)
131 #(0 0 0 0 0 0 #x7f00
1)
132 #(0 1 0 0 0 0 #x7f00
1)))))
135 (is-true (address= +ipv4-loopback
+ (make-address #(127 0 0 1)))))
138 (is-true (address= +ipv6-loopback
+ (ensure-address "::1"))))
141 (is-true (loop for designator in
(list "127.0.0.1" +max-ipv4-value
+ "::" "::1")
142 for addr1
= (ensure-address designator
)
143 for addr2
= (ensure-address designator
)
144 for addr3
= (copy-address addr1
)
145 always
(and (address= addr1 addr2
)
146 (address= addr1 addr3
)
147 (address= addr2 addr3
)))))
151 (make-address 'not-a-valid-designator
)))
153 (test address.unspecified
.1
154 (is-true (every #'inet-address-unspecified-p
155 (mapcar #'ensure-address
'("0.0.0.0" "::" "0:0:0:0:0:0:0:0")))))
157 (test address.loopback
.1
158 (is-true (every #'inet-address-loopback-p
159 (mapcar #'ensure-address
'("127.0.0.1" "::1" "0:0::1")))))
161 (test address.multicast
.1
162 (is-true (every #'inet-address-multicast-p
163 (mapcar #'ensure-address
164 '("224.0.0.0" "224.1.2.3" "232.0.0.127" "239.255.255.255"
165 "ff02::2" "ff0a::114" "ff05::1:3")))))
167 (test address.ipv6-ipv4-mapped
.1
168 (is-true (ipv6-ipv4-mapped-p (ensure-address "::ffff:127.0.0.1"))))
171 (is (equalp (address-to-vector "::1.2.3.4")
172 (values #(0 0 0 0 0 0 #x0102
#x0304
) :ipv6
))))
176 #-no-internet-available
177 (test lookup-hostname
.1
178 (is (equalp (multiple-value-bind (address addresses truename
)
179 (lookup-hostname "a.root-servers.net" :ipv6 nil
)
180 (declare (ignore addresses
))
181 (values (address-equal-p address
#(198 41 0 4))
183 (values t
"a.root-servers.net"))))
185 #-no-internet-available
186 (test lookup-hostname
.2
187 (is-true (string= (nth-value 2 (lookup-hostname #(198 41 0 4)))
188 "a.root-servers.net")))
190 ;;; These days lots of people seem to be using DNS servers that don't
191 ;;; report resolving failures for non-existing domains. This test
193 (test lookup-hostname
.3
194 (signals resolver-no-name-error
195 (lookup-hostname "foo.tninkpad.telent.net.")))
197 (test lookup-hostname
.4
198 (is-true (address-equal-p (lookup-hostname #(127 0 0 1) :ipv6 nil
)
201 (test lookup-hostname
.5
203 (lookup-hostname #(127 0 0))))
205 (test lookup-hostname
.6
206 (signals resolver-no-name-error
207 (lookup-hostname #(127 0 0 1) :ipv6
:ipv6
)))
211 (test lookup-service
.1
212 (is (equalp (lookup-service "ssh")
213 (values 22 "ssh" :tcp
))))
215 (test lookup-service
.2
216 (is (equalp (lookup-service 22 :udp
)
217 (values 22 "ssh" :udp
))))
219 ;;; looks up a reserved service port
220 (test lookup-service
.3
221 ;; TODO: check for a more specific error.
222 (signals unknown-service
223 (lookup-service 1024)))
227 (test lookup-protocol
.1
228 (is (equalp (multiple-value-bind (number name
)
229 (lookup-protocol "tcp")
230 (values number name
))
233 (test lookup-protocol
.2
234 (is (equalp (multiple-value-bind (number name
)
235 (lookup-protocol "udp")
236 (values number name
))
239 (test lookup-protocol
.3
240 (signals unknown-protocol
241 (lookup-protocol "nonexistent-protocol")))
243 (test lookup-protocol
.4
244 (is-true (string= (nth-value 1 (lookup-protocol 6))
247 ;;;; Network Interfaces
249 (test list-network-interfaces
.1
250 (is-true (<= 1 (length (list-network-interfaces)))))
252 (test network-interfaces
.1
254 (flet ((nif-equal (if1 if2
)
255 (check-type if1 cons
)
256 (check-type if2 cons
)
257 (and (string= (interface-name if1
) (interface-name if2
))
258 (eql (interface-index if1
) (interface-index if2
)))))
259 (loop for nif in
(list-network-interfaces)
260 always
(and (nif-equal nif
(lookup-interface (interface-name nif
)))
261 (nif-equal nif
(lookup-interface (interface-index nif
))))))))
265 ;;; RT: don't accept unknown keyword arguments, such as typos.
268 (make-socket :this-kw-arg-doesnt-exist t
)))
271 (is (equalp (with-open-socket (s :address-family
:ipv4
)
272 (values (socket-connected-p s
)
274 (> (socket-os-fd s
) 1)
275 (socket-address-family s
)
276 (socket-protocol s
)))
277 (values nil t t
:ipv4
:default
)))) ; why isn't it :TCP?
280 (is-true (with-open-socket (s :address-family
:ipv4
)
283 ;;; Given the functions we've got so far, if you can think of a better
284 ;;; way to make sure the bind succeeded than trying it twice, let me
285 ;;; know. 1974 has no special significance, unless you're the same age
287 (test inet.socket-bind
.1
288 (signals socket-address-in-use-error
289 (with-open-socket (s1 :address-family
:ipv4
:connect
:passive
290 :local-host
#(127 0 0 1) :local-port
1974)
291 (with-open-socket (s2 :address-family
:ipv4
:connect
:passive
292 :local-host
#(127 0 0 1) :local-port
1974)
296 (is-true (with-open-socket (s :address-family
:ipv4
)
297 (setf (socket-option s
:reuse-address
) t
)
298 (socket-option s
:reuse-address
))))
300 ;;; Like READ-SEQUENCE, but returns early if the full quantity of data
301 ;;; isn't there to be read. Blocks if no input at all.
302 (defun read-buf-nonblock (buffer stream
)
303 (let ((eof (gensym)))
305 (c (read-char stream nil eof
)
306 (read-char-no-hang stream nil eof
)))
307 ((or (>= i
(length buffer
)) (not c
) (eq c eof
)) i
)
308 (setf (elt buffer i
) c
))))
310 (test simple-tcp-client
312 (with-open-socket (s :remote-host
*echo-address
* :remote-port
*echo-port
*
313 :address-family
:ipv4
)
314 (setf (socket-option s
:receive-timeout
) *echo-timeout
*)
315 (let ((data (make-string 200)))
316 (format s
"here is some text")
318 (let ((data (subseq data
0 (read-buf-nonblock data s
))))
319 ;; (format t "~&Got ~S back from TCP echo server~%" data)
320 (> (length data
) 0))))))
322 (test sockaddr-return-type
324 (with-open-socket (s :remote-host
*echo-address
* :remote-port
*echo-port
*
325 :address-family
:ipv4
)
326 (setf (socket-option s
:receive-timeout
) *echo-timeout
*)
327 (and (ipv4-address-p (remote-host s
))
328 (numberp (remote-port s
))))))
330 ;;; We don't support streams with UDP sockets ATM. But when we do,
331 ;;; let's add a similar test using stream functions.
333 ;;; FIXME: figure out why this test blocks with the inetd services on
334 ;;; my machines, on both Darwin and Linux/x86-64. Works with
335 ;;; echo-server.c though --luis
336 (test simple-udp-client
.1
338 (with-open-socket (s :remote-host
*echo-address
* :remote-port
*echo-port
*
339 :type
:datagram
:address-family
:ipv4
)
340 (setf (socket-option s
:receive-timeout
) *echo-timeout
*)
341 (send-to s
#(1 2 3 4 5))
342 (let ((nbytes (nth-value 1 (receive-from s
:size
200))))
345 (test simple-udp-client
.2
347 (with-open-socket (s :type
:datagram
:address-family
:ipv4
)
348 (setf (socket-option s
:receive-timeout
) *echo-timeout
*)
349 (send-to s
#(1 2 3 4 5)
350 :remote-host
*echo-address
*
351 :remote-port
*echo-port
*)
352 (let ((nbytes (nth-value 1 (receive-from s
:size
200))))
355 (test simple-local-sockets
356 (is (string= (let ((file (namestring
357 (make-pathname :name
"local-socket" :type nil
359 (asdf:system-definition-pathname
360 (asdf:find-system
'#:iolib-tests
)))))))
361 (ignore-errors (delete-file file
))
362 (with-open-socket (p :address-family
:local
:connect
:passive
:local-filename file
)
363 (with-open-socket (a :address-family
:local
:remote-filename file
)
364 (format a
"local socket test")
366 (let ((s (accept-connection p
)))
369 (delete-file file
)))))
370 "local socket test")))
372 (defmacro with-http-stream
((var host port request
) &body body
)
373 `(with-open-socket (,var
:address-family
:ipv4
:remote-host
,host
:remote-port
,port
)
374 (format ,var
,(concatenate 'string request
" HTTP/1.0~%~%"))
378 #-no-internet-available
379 (test simple-http-client
381 (with-http-stream (s "www.google.com" 80 "HEAD /")
382 (let ((data (make-string 200)))
383 (setf data
(subseq data
0 (read-buf-nonblock data s
)))
385 (> (length data
) 0)))))
387 #-no-internet-available
388 (test sockopt-receive-buffer
389 ;; on Linux x86, the receive buffer size appears to be doubled in the
390 ;; kernel: we set a size of x and then getsockopt() returns 2x.
391 ;; This is why we compare with >= instead of =
393 (with-http-stream (s "www.google.com" 80 "HEAD/")
394 (setf (socket-option s
:receive-buffer
) 1975)
395 (let ((data (make-string 200)))
396 (setf data
(subseq data
0 (read-buf-nonblock data s
)))
397 (and (> (length data
) 0)
398 (>= (socket-option s
:receive-buffer
) 1975))))))
400 (test socket-open-p
.1
401 (is-true (with-open-socket (s)
404 (test socket-open-p
.2
405 (is-true (with-open-socket (s :remote-host
*echo-address
* :remote-port
*echo-port
*
406 :address-family
:ipv4
)
409 (test socket-open-p
.3
410 (is-false (with-open-socket (s)
414 ;;; we don't have an automatic test for some of this yet. There's no
415 ;;; simple way to run servers and have something automatically connect
416 ;;; to them as client, unless we spawn external programs. Then we
417 ;;; have to start telling people what external programs they should
418 ;;; have installed. Which, eventually, we will, but not just yet
420 ;;; to check with this: can display packets from multiple peers
421 ;;; peer address is shown correctly for each packet
422 ;;; packet length is correct
423 ;;; long (>500 byte) packets have the full length shown (doesn't work)
425 (defun udp-server (port)
426 (with-open-socket (s :type
:datagram
:local-port port
)
428 (multiple-value-bind (buf len address port
)
429 (receive-from s
:size
500)
430 (format t
"Received ~A bytes from ~A:~A - ~A ~%"
431 len address port
(subseq buf
0 (min 10 len
)))))))