[c06b8c]: contrib / sb-bsd-sockets / tests.lisp Maximize Restore History

Download this file

tests.lisp    428 lines (388 with data), 16.4 kB

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