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* ((tcp (get-protocol-by-name "tcp"))
 102          (address (make-inet-address "127.0.0.1"))
 103          (s (make-instance 'inet-socket :type :stream :protocol tcp)))
 104     (do-gc-portably) ; gc should clear out any old sockets bound to this port
 105     (unwind-protect
 106          ;; Given the functions we've got so far, if you can think of a
 107          ;; better way to make sure the bind succeeded than trying it
 108          ;; twice, let me know
 109          (progn
 110            (socket-bind s address 0)
 111            (handler-case
 112                (let ((port (nth-value 1 (socket-name s)))
 113                      (s2 (make-instance 'inet-socket
 114                                         :type :stream :protocol tcp)))
 115                  (unwind-protect
 116                       (socket-bind s2 address port)
 117                    (socket-close s2))
 118                  nil)
 119              (address-in-use-error () t)))
 120       (socket-close s)))
 121   t)
 122
 123 (deftest* (simple-sockopt-test)
 124   ;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
 125   ;; the process that all the weird macros in sockopt happened right.
 126   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
 127     (setf (sockopt-reuse-address s) t)
 128     (sockopt-reuse-address s))
 129   t)
 130
 131 (defun read-buf-nonblock (buffer stream)
 132   "Like READ-SEQUENCE, but returns early if the full quantity of data isn't there to be read.  Blocks if no input at all"
 133   (let ((eof (gensym)))
 134     (do ((i 0 (1+ i))
 135          (c (read-char stream nil eof)
 136             (read-char-no-hang stream nil eof)))
 137         ((or (>= i (length buffer)) (not c) (eq c eof)) i)
 138       (setf (elt buffer i) c))))
 139
 140 #+internet-available
 141 (deftest name-service-return-type
 142   (vectorp (host-ent-address (get-host-by-address #(127 0 0 1))))
 143   t)
 144
 145 ;;; these require that the echo services are turned on in inetd
 146 #+internet-available
 147 (deftest simple-tcp-client
 148     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))
 149           (data (make-string 200)))
 150       (socket-connect s #(127 0 0 1) 7)
 151       (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
 152         (format stream "here is some text")
 153         (let ((data (subseq data 0 (read-buf-nonblock data stream))))
 154           (format t "~&Got ~S back from TCP echo server~%" data)
 155           (> (length data) 0))))
 156   t)
 157
 158 #+internet-available
 159 (deftest sockaddr-return-type
 160   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
 161     (unwind-protect
 162          (progn
 163            (socket-connect s #(127 0 0 1) 7)
 164            (multiple-value-bind (host port) (socket-peername s)
 165              (and (vectorp host)
 166                   (numberp port))))
 167       (socket-close s)))
 168   t)
 169
 170 #+internet-available
 171 (deftest simple-udp-client
 172   (let ((s (make-instance 'inet-socket :type :datagram :protocol (get-protocol-by-name "udp")))
 173         (data (make-string 200)))
 174     (format t "Socket type is ~A~%" (sockopt-type s))
 175     (socket-connect s #(127 0 0 1) 7)
 176     (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
 177       (format stream "here is some text")
 178       (let ((data (subseq data 0 (read-buf-nonblock data stream))))
 179         (format t "~&Got ~S back from UDP echo server~%" data)
 180         (> (length data) 0))))
 181   t)
 182
 183 ;;; A fairly rudimentary test that connects to the syslog socket and
 184 ;;; sends a message.  Priority 7 is kern.debug; you'll probably want
 185 ;;; to look at /etc/syslog.conf or local equivalent to find out where
 186 ;;; the message ended up
 187
 188 #-win32
 189 (deftest simple-local-client
 190     (progn
 191       ;; SunOS (Solaris) and Darwin systems don't have a socket at
 192       ;; /dev/log.  We might also be building in a chroot or
 193       ;; something, so don't fail this test just because the file is
 194       ;; unavailable, or if it's a symlink to some weird character
 195       ;; device.
 196       (when (block nil
 197               (handler-bind ((sb-posix:syscall-error
 198                               (lambda (e)
 199                                 (declare (ignore e))
 200                                 (return nil))))
 201                 (sb-posix:s-issock
 202                  (sb-posix::stat-mode (sb-posix:stat "/dev/log")))))
 203         (let ((s (make-instance 'local-socket :type :datagram)))
 204           (format t "Connecting ~A... " s)
 205           (finish-output)
 206           (handler-case
 207               (socket-connect s "/dev/log")
 208             (sb-bsd-sockets::socket-error ()
 209               (setq s (make-instance 'local-socket :type :stream))
 210               (format t "failed~%Retrying with ~A... " s)
 211               (finish-output)
 212               (socket-connect s "/dev/log")))
 213           (format t "ok.~%")
 214           (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
 215             (format stream
 216                     "<7>bsd-sockets: Don't panic.  We're testing local-domain client code; this message can safely be ignored"))))
 217       t)
 218   t)
 219
 220
 221 ;;; these require that the internet (or bits of it, at least) is available
 222
 223 #+internet-available
 224 (deftest get-host-by-name
 225   (equalp (car (host-ent-addresses (get-host-by-name "a.root-servers.net")))
 226           #(198 41 0 4))
 227   t)
 228
 229 #+internet-available
 230 (deftest get-host-by-address
 231     (host-ent-name (get-host-by-address #(198 41 0 4)))
 232   "a.root-servers.net")
 233
 234 ;;; These days lots of people seem to be using DNS servers that don't
 235 ;;; report resolving failures for non-existing domains. This test
 236 ;;; will fail there, so we've disabled it.
 237 #+nil
 238 (deftest get-host-by-name-wrong
 239   (handler-case
 240    (get-host-by-name "foo.tninkpad.telent.net.")
 241    (NAME-SERVICE-ERROR () t)
 242    (:no-error nil))
 243   t)
 244
 245 (defun http-stream (host port request)
 246   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
 247     (socket-connect
 248      s (car (host-ent-addresses (get-host-by-name host))) port)
 249     (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
 250       (format stream "~A HTTP/1.0~%~%" request))
 251     s))
 252
 253 #+internet-available
 254 (deftest simple-http-client-1
 255     (handler-case
 256         (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
 257           (let ((data (make-string 200)))
 258             (setf data (subseq data 0
 259                                (read-buf-nonblock data
 260                                                   (socket-make-stream s))))
 261             (princ data)
 262             (> (length data) 0)))
 263       (network-unreachable-error () 'network-unreachable))
 264   t)
 265
 266
 267 #+internet-available
 268 (deftest sockopt-receive-buffer
 269     ;; on Linux x86, the receive buffer size appears to be doubled in the
 270     ;; kernel: we set a size of x and then getsockopt() returns 2x.
 271     ;; This is why we compare with >= instead of =
 272     (handler-case
 273         (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
 274           (setf (sockopt-receive-buffer s) 1975)
 275           (let ((data (make-string 200)))
 276             (setf data (subseq data 0
 277                                (read-buf-nonblock data
 278                                                   (socket-make-stream s))))
 279             (and (> (length data) 0)
 280                  (>= (sockopt-receive-buffer s) 1975))))
 281       (network-unreachable-error () 'network-unreachable))
 282   t)
 283
 284 (deftest socket-open-p-true.1
 285     (socket-open-p (make-instance 'inet-socket :type :stream :protocol :tcp))
 286   t)
 287 #+internet-available
 288 (deftest socket-open-p-true.2
 289     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
 290       (unwind-protect
 291            (progn
 292              (socket-connect s #(127 0 0 1) 7)
 293              (socket-open-p s))
 294         (socket-close s)))
 295   t)
 296 (deftest socket-open-p-false
 297     (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
 298       (socket-close s)
 299       (socket-open-p s))
 300   nil)
 301
 302 ;;; we don't have an automatic test for some of this yet.  There's no
 303 ;;; simple way to run servers and have something automatically connect
 304 ;;; to them as client, unless we spawn external programs.  Then we
 305 ;;; have to start telling people what external programs they should
 306 ;;; have installed.  Which, eventually, we will, but not just yet
 307
 308
 309 ;;; to check with this: can display packets from multiple peers
 310 ;;; peer address is shown correctly for each packet
 311 ;;; packet length is correct
 312 ;;; long (>500 byte) packets have the full length shown (doesn't work)
 313
 314 (defun udp-server (port)
 315   (let ((s (make-instance 'inet-socket :type :datagram :protocol :udp)))
 316     (socket-bind s #(0 0 0 0) port)
 317     (loop
 318      (multiple-value-bind (buf len address port) (socket-receive s nil 500)
 319        (format t "Received ~A bytes from ~A:~A - ~A ~%"
 320                len address port (subseq buf 0 (min 10 len)))))))
 321
 322 #+sb-thread
 323 (deftest interrupt-io
 324     (let (result)
 325       (labels
 326           ((client (port)
 327              (setf result
 328                    (let ((s (make-instance 'inet-socket
 329                                            :type :stream
 330                                            :protocol :tcp)))
 331                      (socket-connect s #(127 0 0 1) port)
 332                      (let ((stream (socket-make-stream s
 333                                                        :input t
 334                                                        :output t
 335                                                        :buffering :none)))
 336                        (handler-case
 337                            (prog1
 338                                (catch 'stop
 339                                  (progn
 340                                    (read-char stream)
 341                                    (sleep 0.1)
 342                                    (sleep 0.1)
 343                                    (sleep 0.1)))
 344                              (close stream))
 345                          (error (c)
 346                            c))))))
 347            (server ()
 348              (let ((s (make-instance 'inet-socket
 349                                      :type :stream
 350                                      :protocol :tcp)))
 351                (setf (sockopt-reuse-address s) t)
 352                (socket-bind s (make-inet-address "127.0.0.1") 0)
 353                (socket-listen s 5)
 354                (multiple-value-bind (* port)
 355                    (socket-name s)
 356                  (let* ((client (sb-thread:make-thread
 357                                  (lambda () (client port))))
 358                         (r (socket-accept s))
 359                         (stream (socket-make-stream r
 360                                                     :input t
 361                                                     :output t
 362                                                     :buffering :none))
 363                         (ok :ok))
 364                    (socket-close s)
 365                    (sleep 5)
 366                    (sb-thread:interrupt-thread client
 367                                                (lambda () (throw 'stop ok)))
 368                    (sleep 5)
 369                    (setf ok :not-ok)
 370                    (write-char #\x stream)
 371                    (close stream)
 372                    (socket-close r))))))
 373         (server))
 374       result)
 375   :ok)