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