0.8.0.65:
[sbcl.git] / contrib / sb-bsd-sockets / tests.lisp
1 (defpackage "SB-BSD-SOCKETS-TEST"
2   (:use "CL" "SB-BSD-SOCKETS" "SB-RT"))
3
4 #||
5
6 <H1>Tests</h1>
7
8 There should be at least one test for pretty much everything you can do
9 with the package.  In some places I've been more diligent than others; more
10 tests gratefully accepted.
11
12 Tests are in the file <tt>tests.lisp</tt> and also make good examples.
13
14 ||#
15
16 (in-package :sb-bsd-sockets-test)
17
18 ;;; a real address
19 (deftest make-inet-address
20   (equalp (make-inet-address "127.0.0.1")  #(127 0 0 1))
21   t)
22 ;;; and an address with bit 8 set on some octets
23 (deftest make-inet-address2
24   (equalp (make-inet-address "242.1.211.3")  #(242 1 211 3))
25   t)
26
27 (deftest make-inet-socket
28   ;; make a socket
29   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
30     (and (> (socket-file-descriptor s) 1) t))
31   t)
32
33 (deftest make-inet-socket-keyword
34     ;; make a socket
35     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
36       (and (> (socket-file-descriptor s) 1) t))
37   t)
38
39 (deftest make-inet-socket-wrong
40     ;; fail to make a socket: check correct error return.  There's no nice
41     ;; way to check the condition stuff on its own, which is a shame
42     (handler-case
43         (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "udp"))
44       ((or socket-type-not-supported-error protocol-not-supported-error) (c)
45         (declare (ignorable c)) t)
46       (:no-error nil))
47   t)
48
49 (deftest make-inet-socket-keyword-wrong
50     ;; same again with keywords
51     (handler-case
52         (make-instance 'inet-socket :type :stream :protocol :udp)
53       ((or protocol-not-supported-error socket-type-not-supported-error) (c)
54         (declare (ignorable c)) t)
55       (:no-error nil))
56   t)
57
58
59 (deftest non-block-socket
60   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
61     (setf (non-blocking-mode s) t)
62     (non-blocking-mode s))
63   t)
64
65 (defun do-gc-portably ()
66   ;; cmucl on linux has generational gc with a keyword argument,
67   ;; sbcl GC function takes same arguments no matter what collector is in
68   ;; use
69   #+(or sbcl gencgc) (SB-EXT:gc :full t)
70   ;; other platforms have full gc or nothing
71   #-(or sbcl gencgc) (sb-ext:gc))
72
73 (deftest inet-socket-bind
74   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
75     ;; Given the functions we've got so far, if you can think of a
76     ;; better way to make sure the bind succeeded than trying it
77     ;; twice, let me know
78     ;; 1974 has no special significance, unless you're the same age as me
79     (do-gc-portably) ;gc should clear out any old sockets bound to this port
80     (socket-bind s (make-inet-address "127.0.0.1") 1974)
81     (handler-case
82         (let ((s2 (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
83           (socket-bind s2 (make-inet-address "127.0.0.1") 1974)
84           nil)
85       (address-in-use-error () t)))
86   t)
87
88 (deftest simple-sockopt-test
89   ;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
90   ;; the process that all the weird macros in sockopt happened right.
91   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
92     (setf (sockopt-reuse-address s) t)
93     (sockopt-reuse-address s))
94   t)
95
96 (defun read-buf-nonblock (buffer stream)
97   "Like READ-SEQUENCE, but returns early if the full quantity of data isn't there to be read.  Blocks if no input at all"
98   (let ((eof (gensym)))
99     (do ((i 0 (1+ i))
100          (c (read-char stream nil eof)
101             (read-char-no-hang stream nil eof)))
102         ((or (>= i (length buffer)) (not c) (eq c eof)) i)
103       (setf (elt buffer i) c))))
104
105 ;;; these require that the echo services are turned on in inetd
106 #+internet-available
107 (deftest simple-tcp-client
108     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))
109           (data (make-string 200)))
110       (socket-connect s #(127 0 0 1) 7)
111       (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
112         (format stream "here is some text")
113         (let ((data (subseq data 0 (read-buf-nonblock data stream))))
114           (format t "~&Got ~S back from TCP echo server~%" data)
115           (> (length data) 0))))
116   t)
117
118 #+internet-available
119 (deftest simple-udp-client
120   (let ((s (make-instance 'inet-socket :type :datagram :protocol (get-protocol-by-name "udp")))
121         (data (make-string 200)))
122     (format t "Socket type is ~A~%" (sockopt-type s))
123     (socket-connect s #(127 0 0 1) 7)
124     (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
125       (format stream "here is some text")
126       (let ((data (subseq data 0 (read-buf-nonblock data stream))))
127         (format t "~&Got ~S back from UDP echo server~%" data)
128         (> (length data) 0))))
129   t)
130
131 ;;; A fairly rudimentary test that connects to the syslog socket and
132 ;;; sends a message.  Priority 7 is kern.debug; you'll probably want
133 ;;; to look at /etc/syslog.conf or local equivalent to find out where
134 ;;; the message ended up
135
136 #-sunos
137 (deftest simple-local-client
138     (let ((s (make-instance 'local-socket :type :datagram)))
139       (format t "~A~%" s)
140       (socket-connect s "/dev/log")
141       (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
142         (format stream
143                 "<7>bsd-sockets: Don't panic.  We're testing local-domain client code; this message can safely be ignored")
144         t))
145   t)
146
147
148 ;;; these require that the internet (or bits of it, atleast) is available
149
150 #+internet-available
151 (deftest get-host-by-name
152   (equalp (car (host-ent-addresses (get-host-by-name "a.root-servers.net")))
153           #(198 41 0 4))
154   t)
155
156 #+internet-available
157 (deftest get-host-by-address
158     (host-ent-name (get-host-by-address #(198 41 0 4)))
159   "a.root-servers.net")
160
161 (deftest get-host-by-name-wrong
162   (handler-case
163    (get-host-by-name "foo.tninkpad.telent.net")
164    (NAME-SERVICE-ERROR () t)
165    (:no-error nil))
166   t)
167
168 (defun http-stream (host port request)
169   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
170     (socket-connect
171      s (car (host-ent-addresses (get-host-by-name host))) port)
172     (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
173       (format stream "~A HTTP/1.0~%~%" request))
174     s))
175
176 #+internet-available
177 (deftest simple-http-client-1
178     (handler-case
179         (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
180           (let ((data (make-string 200)))
181             (setf data (subseq data 0
182                                (read-buf-nonblock data
183                                                   (socket-make-stream s))))
184             (princ data)
185             (> (length data) 0)))
186       (network-unreachable-error () 'network-unreachable))
187   t)
188
189
190 #+internet-available
191 (deftest sockopt-receive-buffer
192     ;; on Linux x86, the receive buffer size appears to be doubled in the
193     ;; kernel: we set a size of x and then getsockopt() returns 2x.
194     ;; This is why we compare with >= instead of =
195     (handler-case
196         (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
197           (setf (sockopt-receive-buffer s) 1975)
198           (let ((data (make-string 200)))
199             (setf data (subseq data 0
200                                (read-buf-nonblock data
201                                                   (socket-make-stream s))))
202             (and (> (length data) 0)
203                  (>= (sockopt-receive-buffer s) 1975))))
204       (network-unreachable-error () 'network-unreachable))
205   t)
206
207
208 ;;; we don't have an automatic test for some of this yet.  There's no
209 ;;; simple way to run servers and have something automatically connect
210 ;;; to them as client, unless we spawn external programs.  Then we
211 ;;; have to start telling people what external programs they should
212 ;;; have installed.  Which, eventually, we will, but not just yet
213
214
215 ;;; to check with this: can display packets from multiple peers
216 ;;; peer address is shown correctly for each packet
217 ;;; packet length is correct
218 ;;; long (>500 byte) packets have the full length shown (doesn't work)
219
220 (defun udp-server (port)
221   (let ((s (make-instance 'inet-socket :type :datagram :protocol :udp)))
222     (socket-bind s #(0 0 0 0) port)
223     (loop
224      (multiple-value-bind (buf len address port) (socket-receive s nil 500)
225        (format t "Received ~A bytes from ~A:~A - ~A ~%"
226                len address port (subseq buf 0 (min 10 len)))))))
227   
228