1.0.35.12: Minor cleanup in %TARGET-DEFSTRUCT.
[sbcl.git] / contrib / sb-bsd-sockets / tests.lisp
1 (defpackage "SB-BSD-SOCKETS-TEST"
2   (:use "CL" "SB-BSD-SOCKETS" "SB-RT"))
3
4 (in-package :sb-bsd-sockets-test)
5
6 ;;; a real address
7 (deftest make-inet-address
8   (equalp (make-inet-address "127.0.0.1")  #(127 0 0 1))
9   t)
10 ;;; and an address with bit 8 set on some octets
11 (deftest make-inet-address2
12   (equalp (make-inet-address "242.1.211.3")  #(242 1 211 3))
13   t)
14
15 (deftest get-protocol-by-name/tcp
16     (integerp (get-protocol-by-name "tcp"))
17   t)
18
19 (deftest get-protocol-by-name/udp
20   (integerp (get-protocol-by-name "udp"))
21   t)
22
23 (deftest get-protocol-by-name/error
24   (handler-case (get-protocol-by-name "nonexistent-protocol")
25     (unknown-protocol ()
26       t)
27     (:no-error ()
28       nil))
29   t)
30
31 (deftest make-inet-socket
32   ;; make a socket
33   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
34     (and (> (socket-file-descriptor s) 1) t))
35   t)
36
37 (deftest make-inet-socket-keyword
38     ;; make a socket
39     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
40       (and (> (socket-file-descriptor s) 1) t))
41   t)
42
43 (deftest make-inet-socket-wrong
44     ;; fail to make a socket: check correct error return.  There's no nice
45     ;; way to check the condition stuff on its own, which is a shame
46     (handler-case
47         (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "udp"))
48       ;; CLH FIXME! some versions of darwin just return a socket error
49       ;; here, not socket-type-not-supported-error or
50       ;; protocol-not-supported-error.
51       ((or #+darwin socket-error
52         socket-type-not-supported-error
53         protocol-not-supported-error)
54           (c)
55         (declare (ignorable c)) t)
56       (:no-error nil))
57   t)
58
59 (deftest make-inet-socket-keyword-wrong
60     ;; same again with keywords
61     (handler-case
62         (make-instance 'inet-socket :type :stream :protocol :udp)
63       ;; CLH FIXME! some versions of darwin just return a socket error
64       ;; here, not socket-type-not-supported-error or
65       ;; protocol-not-supported-error.
66       ((or
67         #+darwin socket-error
68         protocol-not-supported-error
69         socket-type-not-supported-error)
70           (c)
71         (declare (ignorable c)) t)
72       (:no-error nil))
73   t)
74
75
76 (deftest non-block-socket
77   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
78     (setf (non-blocking-mode s) t)
79     (non-blocking-mode s))
80   t)
81
82 (defun do-gc-portably ()
83   ;; cmucl on linux has generational gc with a keyword argument,
84   ;; sbcl GC function takes same arguments no matter what collector is in
85   ;; use
86   #+(or sbcl gencgc) (SB-EXT:gc :full t)
87   ;; other platforms have full gc or nothing
88   #-(or sbcl gencgc) (sb-ext:gc))
89
90 (deftest inet-socket-bind
91   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
92     ;; Given the functions we've got so far, if you can think of a
93     ;; better way to make sure the bind succeeded than trying it
94     ;; twice, let me know
95     ;; 1974 has no special significance, unless you're the same age as me
96     (do-gc-portably) ;gc should clear out any old sockets bound to this port
97     (socket-bind s (make-inet-address "127.0.0.1") 1974)
98     (handler-case
99         (let ((s2 (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
100           (socket-bind s2 (make-inet-address "127.0.0.1") 1974)
101           nil)
102       (address-in-use-error () t)))
103   t)
104
105 (deftest simple-sockopt-test
106   ;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
107   ;; the process that all the weird macros in sockopt happened right.
108   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
109     (setf (sockopt-reuse-address s) t)
110     (sockopt-reuse-address s))
111   t)
112
113 (defun read-buf-nonblock (buffer stream)
114   "Like READ-SEQUENCE, but returns early if the full quantity of data isn't there to be read.  Blocks if no input at all"
115   (let ((eof (gensym)))
116     (do ((i 0 (1+ i))
117          (c (read-char stream nil eof)
118             (read-char-no-hang stream nil eof)))
119         ((or (>= i (length buffer)) (not c) (eq c eof)) i)
120       (setf (elt buffer i) c))))
121
122 #+internet-available
123 (deftest name-service-return-type
124   (vectorp (host-ent-address (get-host-by-address #(127 0 0 1))))
125   t)
126
127 ;;; these require that the echo services are turned on in inetd
128 #+internet-available
129 (deftest simple-tcp-client
130     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))
131           (data (make-string 200)))
132       (socket-connect s #(127 0 0 1) 7)
133       (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
134         (format stream "here is some text")
135         (let ((data (subseq data 0 (read-buf-nonblock data stream))))
136           (format t "~&Got ~S back from TCP echo server~%" data)
137           (> (length data) 0))))
138   t)
139
140 #+internet-available
141 (deftest sockaddr-return-type
142   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
143     (unwind-protect
144          (progn
145            (socket-connect s #(127 0 0 1) 7)
146            (multiple-value-bind (host port) (socket-peername s)
147              (and (vectorp host)
148                   (numberp port))))
149       (socket-close s)))
150   t)
151
152 #+internet-available
153 (deftest simple-udp-client
154   (let ((s (make-instance 'inet-socket :type :datagram :protocol (get-protocol-by-name "udp")))
155         (data (make-string 200)))
156     (format t "Socket type is ~A~%" (sockopt-type s))
157     (socket-connect s #(127 0 0 1) 7)
158     (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
159       (format stream "here is some text")
160       (let ((data (subseq data 0 (read-buf-nonblock data stream))))
161         (format t "~&Got ~S back from UDP echo server~%" data)
162         (> (length data) 0))))
163   t)
164
165 ;;; A fairly rudimentary test that connects to the syslog socket and
166 ;;; sends a message.  Priority 7 is kern.debug; you'll probably want
167 ;;; to look at /etc/syslog.conf or local equivalent to find out where
168 ;;; the message ended up
169
170 (deftest simple-local-client
171     #-win32
172     (progn
173       ;; SunOS (Solaris) and Darwin systems don't have a socket at
174       ;; /dev/log.  We might also be building in a chroot or
175       ;; something, so don't fail this test just because the file is
176       ;; unavailable, or if it's a symlink to some weird character
177       ;; device.
178       (when (block nil
179               (handler-bind ((sb-posix:syscall-error
180                               (lambda (e)
181                                 (declare (ignore e))
182                                 (return nil))))
183                 (sb-posix:s-issock
184                  (sb-posix::stat-mode (sb-posix:stat "/dev/log")))))
185         (let ((s (make-instance 'local-socket :type :datagram)))
186           (format t "Connecting ~A... " s)
187           (finish-output)
188           (handler-case
189               (socket-connect s "/dev/log")
190             (sb-bsd-sockets::socket-error ()
191               (setq s (make-instance 'local-socket :type :stream))
192               (format t "failed~%Retrying with ~A... " s)
193               (finish-output)
194               (socket-connect s "/dev/log")))
195           (format t "ok.~%")
196           (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
197             (format stream
198                     "<7>bsd-sockets: Don't panic.  We're testing local-domain client code; this message can safely be ignored"))))
199       t)
200   t)
201
202
203 ;;; these require that the internet (or bits of it, at least) is available
204
205 #+internet-available
206 (deftest get-host-by-name
207   (equalp (car (host-ent-addresses (get-host-by-name "a.root-servers.net")))
208           #(198 41 0 4))
209   t)
210
211 #+internet-available
212 (deftest get-host-by-address
213     (host-ent-name (get-host-by-address #(198 41 0 4)))
214   "a.root-servers.net")
215
216 ;;; These days lots of people seem to be using DNS servers that don't
217 ;;; report resolving failures for non-existing domains. This test
218 ;;; will fail there, so we've disabled it.
219 #+nil
220 (deftest get-host-by-name-wrong
221   (handler-case
222    (get-host-by-name "foo.tninkpad.telent.net.")
223    (NAME-SERVICE-ERROR () t)
224    (:no-error nil))
225   t)
226
227 (defun http-stream (host port request)
228   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
229     (socket-connect
230      s (car (host-ent-addresses (get-host-by-name host))) port)
231     (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
232       (format stream "~A HTTP/1.0~%~%" request))
233     s))
234
235 #+internet-available
236 (deftest simple-http-client-1
237     (handler-case
238         (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
239           (let ((data (make-string 200)))
240             (setf data (subseq data 0
241                                (read-buf-nonblock data
242                                                   (socket-make-stream s))))
243             (princ data)
244             (> (length data) 0)))
245       (network-unreachable-error () 'network-unreachable))
246   t)
247
248
249 #+internet-available
250 (deftest sockopt-receive-buffer
251     ;; on Linux x86, the receive buffer size appears to be doubled in the
252     ;; kernel: we set a size of x and then getsockopt() returns 2x.
253     ;; This is why we compare with >= instead of =
254     (handler-case
255         (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
256           (setf (sockopt-receive-buffer s) 1975)
257           (let ((data (make-string 200)))
258             (setf data (subseq data 0
259                                (read-buf-nonblock data
260                                                   (socket-make-stream s))))
261             (and (> (length data) 0)
262                  (>= (sockopt-receive-buffer s) 1975))))
263       (network-unreachable-error () 'network-unreachable))
264   t)
265
266 (deftest socket-open-p-true.1
267     (socket-open-p (make-instance 'inet-socket :type :stream :protocol :tcp))
268   t)
269 #+internet-available
270 (deftest socket-open-p-true.2
271     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
272       (unwind-protect
273            (progn
274              (socket-connect s #(127 0 0 1) 7)
275              (socket-open-p s))
276         (socket-close s)))
277   t)
278 (deftest socket-open-p-false
279     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
280       (socket-close s)
281       (socket-open-p s))
282   nil)
283
284 ;;; we don't have an automatic test for some of this yet.  There's no
285 ;;; simple way to run servers and have something automatically connect
286 ;;; to them as client, unless we spawn external programs.  Then we
287 ;;; have to start telling people what external programs they should
288 ;;; have installed.  Which, eventually, we will, but not just yet
289
290
291 ;;; to check with this: can display packets from multiple peers
292 ;;; peer address is shown correctly for each packet
293 ;;; packet length is correct
294 ;;; long (>500 byte) packets have the full length shown (doesn't work)
295
296 (defun udp-server (port)
297   (let ((s (make-instance 'inet-socket :type :datagram :protocol :udp)))
298     (socket-bind s #(0 0 0 0) port)
299     (loop
300      (multiple-value-bind (buf len address port) (socket-receive s nil 500)
301        (format t "Received ~A bytes from ~A:~A - ~A ~%"
302                len address port (subseq buf 0 (min 10 len)))))))
303
304