tests/net.sockets-tests.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; tests.lisp --- bsd-sockets test suite.
   4 ;;;
   5 ;;; Copyright (C) 2007, Luis Oliveira  <loliveira@common-lisp.net>
   6 ;;;
   7 ;;; Permission is hereby granted, free of charge, to any person
   8 ;;; obtaining a copy of this software and associated documentation
   9 ;;; files (the "Software"), to deal in the Software without
  10 ;;; restriction, including without limitation the rights to use, copy,
  11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  12 ;;; of the Software, and to permit persons to whom the Software is
  13 ;;; furnished to do so, subject to the following conditions:
  14 ;;;
  15 ;;; The above copyright notice and this permission notice shall be
  16 ;;; included in all copies or substantial portions of the Software.
  17 ;;;
  18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  25 ;;; DEALINGS IN THE SOFTWARE.
  26 ;;;
  27 ;;; The first version of this test suite was based on SB-BSD-SOCKETS'
  28 ;;; to which the following licensing information applies:
  29 ;;;
  30 ;;;    All changes to SBCL since the fork from CMU CL have been
  31 ;;;    released into the public domain in jurisdictions where this is
  32 ;;;    possible, or under the FreeBSD licence where not.
  33
  34 (in-package #:cl-user)
  35
  36 (defpackage #:bsd-sockets-tests
  37   (:nicknames #:sockets-tests)
  38   (:use #:common-lisp #:rtest #:bsd-sockets))
  39
  40 (in-package #:bsd-sockets-tests)
  41
  42 ;;; Returns T if one of the expected conditions occured, otherwise returns
  43 ;;; a list of the form (:RESULT return-value-1 return-value-2) with
  44 ;;; the return values from BODY.
  45 (defmacro with-expected-conditions ((&rest conditions) &body body)
  46   `(handler-case (progn ,@body)
  47     ,@(loop for c in conditions collect `(,c () t))
  48     (:no-error (&rest result) (list* :result result))))
  49
  50 ;;;; Addresses
  51
  52 ;;; a real address
  53 (deftest address-to-vector.1
  54     (address-to-vector "127.0.0.1")
  55   #(127 0 0 1) :ipv4)
  56
  57 ;;; and an address with bit 8 set on some octets
  58 (deftest address-to-vector.2
  59     (address-to-vector "242.1.211.3")
  60   #(242 1 211 3) :ipv4)
  61
  62 (deftest address-to-vector.3
  63     (address-to-vector "::")
  64   #(0 0 0 0 0 0 0 0) :ipv6)
  65
  66 ;;; RT: used to return the PARSE-ERROR as a secondary value.
  67 (deftest string-address-to-vector.1
  68     (string-address-to-vector "256.0.0.1")
  69   nil)
  70
  71 ;;; RT: should only ignore PARSE-ERRORs.
  72 (deftest string-address-to-vector.2
  73     (handler-case (string-address-to-vector 'not-a-string)
  74       (type-error () t))
  75   t)
  76
  77 ;;; RT: should signal a PARSE-ERROR when given an invalid string.
  78 (deftest ensure-address.1
  79     (handler-case (ensure-address "ff0x::114")
  80       (parse-error () t))
  81   t)
  82
  83 ;;; ditto
  84 (deftest ensure-address.2
  85     (handler-case (ensure-address "127.0.256.1")
  86       (parse-error () t))
  87   t)
  88
  89 (deftest integer-to-dotted-and-back
  90     (loop for string in '("0.0.255.0" "0.255.255.0" "0.255.255.1")
  91           always (string= string
  92                           (integer-to-dotted (dotted-to-integer string))))
  93   t)
  94
  95 (deftest integer-to-dotted.1
  96     (values (integer-to-dotted 0) (integer-to-dotted +max-ipv4-value+))
  97   "0.0.0.0" "255.255.255.255")
  98
  99 (deftest integer-to-dotted.2
 100     (values (handler-case (integer-to-dotted (1+ +max-ipv4-value+))
 101               (type-error () t))
 102             (handler-case (integer-to-dotted -1)
 103               (type-error () t)))
 104   t t)
 105
 106 (deftest dotted-to-vector.1
 107     (mapcar #'dotted-to-vector '("255.255.255.255" "0.0.0.0" "127.0.0.1"))
 108   (#(255 255 255 255) #(0 0 0 0) #(127 0 0 1)))
 109
 110 (deftest dotted-to-vector.2
 111     (handler-case (dotted-to-vector "127.0.0.0.0")
 112       (parse-error () t))
 113   t)
 114
 115 (deftest dotted-to-vector.3
 116     (handler-case (dotted-to-vector 'not-a-string)
 117       (type-error () t))
 118   t)
 119
 120 (deftest vector-to-dotted.1
 121     (mapcar #'vector-to-dotted '(#(255 255 255 255) #(0 0 0 0) (127 0 0 1)))
 122   ("255.255.255.255" "0.0.0.0" "127.0.0.1"))
 123
 124 (deftest vector-to-dotted.2
 125     (handler-case (vector-to-dotted #(127 0 0 256))
 126       (type-error () t))
 127   t)
 128
 129 (deftest address-to-string.1
 130     (mapcar (lambda (x) (address-to-string (make-address x)))
 131             '(#(127 0 0 1) #(255 255 255 255) #(0 0 0 0 0 0 0 0)
 132               #(0 0 0 0 0 0 0 1) #(1 0 0 0 0 0 0 0)))
 133   ("127.0.0.1" "255.255.255.255" "::" "::1" "1::"))
 134
 135 (deftest vector-to-colon-separated.1
 136     (let ((ip  #(0 0 0 255 255 255 0 0)))
 137       (values (vector-to-colon-separated ip)
 138               (vector-to-colon-separated ip :downcase)
 139               (vector-to-colon-separated ip :upcase)))
 140   "::ff:ff:ff:0:0" "::ff:ff:ff:0:0" "::FF:FF:FF:0:0")
 141
 142 (deftest address=.1
 143     (address= +ipv4-loopback+ (make-address #(127 0 0 1)))
 144   t)
 145
 146 (deftest address=.2
 147     (address= +ipv6-loopback+ (ensure-address "::1"))
 148   t)
 149
 150 (deftest copy-address.1
 151     (loop for designator in (list "127.0.0.1" +max-ipv4-value+ "::" "::1")
 152           for addr1 = (ensure-address designator)
 153           for addr2 = (ensure-address designator)
 154           for addr3 = (copy-address addr1)
 155           always (and (address= addr1 addr2)
 156                       (address= addr1 addr3)
 157                       (address= addr2 addr3)))
 158   t)
 159
 160 (deftest make-address.1
 161     (handler-case (make-address 'not-a-valid-designator)
 162       (type-error () t))
 163   t)
 164
 165 (deftest address.unspecified.1
 166     (every #'inet-address-unspecified-p
 167            (mapcar #'ensure-address '("0.0.0.0" "::" "0:0:0:0:0:0:0:0")))
 168   t)
 169
 170 (deftest address.loopback.1
 171     (every #'inet-address-loopback-p
 172            (mapcar #'ensure-address '("127.0.0.1" "::1" "0:0::1")))
 173   t)
 174
 175 (deftest address.multicast.1
 176     (every #'inet-address-multicast-p
 177            (mapcar #'ensure-address
 178                    '("224.0.0.0" "224.1.2.3" "232.0.0.127" "239.255.255.255"
 179                      "ff02::2" "ff0a::114" "ff05::1:3")))
 180   t)
 181
 182 (deftest address.ipv6-ipv4-mapped.1
 183     (ipv6-ipv4-mapped-p (ensure-address "::ffff:127.0.0.1"))
 184   t)
 185
 186 ;;;; Host Lookup
 187
 188 #-no-internet-available
 189 (deftest lookup-host.1
 190     (let ((host (lookup-host "a.root-servers.net" :ipv6 nil)))
 191       (values (address-equal-p (car (host-addresses host)) #(198 41 0 4))
 192               (host-truename host)))
 193   t "a.root-servers.net")
 194
 195 #-no-internet-available
 196 (deftest lookup-host.2
 197     (host-truename (lookup-host #(198 41 0 4)))
 198   "a.root-servers.net")
 199
 200 ;;; These days lots of people seem to be using DNS servers that don't
 201 ;;; report resolving failures for non-existing domains.  This test
 202 ;;; will fail there.
 203 (deftest lookup-host.3
 204     (with-expected-conditions (resolver-no-name-error)
 205       (lookup-host "foo.tninkpad.telent.net."))
 206   t)
 207
 208 ;;; RT: LOOKUP-HOST didn't seem to like :IPV6 NIL on Darwin.
 209 (deftest lookup-host.4
 210     (typep (lookup-host #(127 0 0 1) :ipv6 nil) 'host)
 211   t)
 212
 213 (deftest lookup-host.5
 214     (address-equal-p (car (host-addresses
 215                            (lookup-host #(127 0 0 1) :ipv6 nil)))
 216                      #(127 0 0 1))
 217   t)
 218
 219 (deftest lookup-host.6
 220     (with-expected-conditions (parse-error)
 221       (lookup-host #(127 0 0)))
 222   t)
 223
 224 (deftest lookup-host.7
 225     (with-expected-conditions (resolver-fail-error)
 226       (lookup-host #(127 0 0 1) :ipv6 :ipv6))
 227   t)
 228
 229 (deftest make-host.1
 230     (listp (host-addresses (make-host "foo" (make-address #(127 0 0 1)))))
 231   t)
 232
 233 (deftest host-random-address.1
 234     (address-equal-p (host-random-address
 235                       (make-host "foo" (make-address #(127 0 0 1))))
 236                      #(127 0 0 1))
 237   t)
 238
 239 ;;;; Service Lookup
 240
 241 (deftest lookup-service.1
 242     (let ((ssh (lookup-service "ssh")))
 243       (values (service-name ssh)
 244               (service-port ssh)
 245               (service-protocol ssh)))
 246   "ssh" 22 :tcp)
 247
 248 (deftest lookup-service.2
 249     (let ((ssh (lookup-service 22 :udp)))
 250       (values (service-name ssh)
 251               (service-port ssh)
 252               (service-protocol ssh)))
 253   "ssh" 22 :udp)
 254
 255 ;;; looks up a reserved service port
 256 (deftest lookup-service.3
 257     ;; TODO: check for a more specific error.
 258     (with-expected-conditions (resolver-error)
 259       (lookup-service 1024))
 260   t)
 261
 262 ;;;; Protocol Lookup
 263
 264 (deftest lookup-protocol.1
 265     (let ((p (lookup-protocol "tcp")))
 266       (values (protocol-name p)
 267               (protocol-number p)))
 268   "tcp" 6)
 269
 270 (deftest lookup-protocol.2
 271     (let ((p (lookup-protocol "udp")))
 272       (values (protocol-name p)
 273               (protocol-number p)))
 274   "udp" 17)
 275
 276 (deftest lookup-protocol.3
 277     (with-expected-conditions (unknown-protocol)
 278       (lookup-protocol "nonexistent-protocol"))
 279   t)
 280
 281 (deftest lookup-protocol.4
 282     (protocol-name (lookup-protocol 6))
 283   "tcp")
 284
 285 ;;;; Network Interfaces
 286
 287 (deftest list-network-interfaces.1
 288     (<= 1 (length (list-network-interfaces)))
 289   t)
 290
 291 (deftest network-interfaces.1
 292     (flet ((nif-equal (if1 if2)
 293              (check-type if1 interface)
 294              (check-type if2 interface)
 295              (and (string= (interface-name if1) (interface-name if2))
 296                   (eql (interface-index if1) (interface-index if2)))))
 297       (loop for nif in (list-network-interfaces)
 298             always (nif-equal nif (lookup-interface (interface-name nif)))
 299             always (nif-equal nif (lookup-interface (interface-index nif)))))
 300   t)
 301
 302 ;;;; Sockets
 303
 304 ;;; RT: don't accept unknown keyword arguments, such as typos.
 305 (deftest make-socket.1
 306     (with-expected-conditions (error)
 307       (make-socket :this-kw-arg-doesnt-exist t))
 308   t)
 309
 310 (deftest make-socket.2
 311     (with-socket (s :family :ipv4)
 312       (values (socket-connected-p s)
 313               (socket-open-p s)
 314               (> (socket-fd s) 1)
 315               (socket-family s)
 316               (socket-protocol s)))
 317   nil t t :ipv4 :default) ; why isn't it :TCP?
 318
 319 (deftest make-socket.3
 320     (with-socket (s)
 321       (typep s 'socket))
 322   t)
 323
 324 ;;; Given the functions we've got so far, if you can think of a better
 325 ;;; way to make sure the bind succeeded than trying it twice, let me
 326 ;;; know. 1974 has no special significance, unless you're the same age
 327 ;;; as me.
 328 (deftest inet.socket-bind.1
 329     (with-socket (s :family :ipv4 :local-host #(127 0 0 1) :local-port 1974)
 330       (handler-case
 331           (with-socket (s :family :ipv4 :local-host #(127 0 0 1)
 332                           :local-port 1974)
 333             nil)
 334         (socket-address-in-use-error () t)))
 335   t)
 336
 337 (deftest sockopt.1
 338     (with-socket (s)
 339       (setf (socket-option s :reuse-address) t)
 340       (socket-option s :reuse-address))
 341   t)
 342
 343 ;;; Like READ-SEQUENCE, but returns early if the full quantity of data
 344 ;;; isn't there to be read.  Blocks if no input at all.
 345 (defun read-buf-nonblock (buffer stream)
 346   (let ((eof (gensym)))
 347     (do ((i 0 (1+ i))
 348          (c (read-char stream nil eof)
 349             (read-char-no-hang stream nil eof)))
 350         ((or (>= i (length buffer)) (not c) (eq c eof)) i)
 351       (setf (elt buffer i) c))))
 352
 353 ;;; these require that the echo services are turned on in inetd
 354 ;;;
 355 ;;; note: on Darwin, this can be achieved by uncommenting the echo
 356 ;;; service in /etc/inetd.conf and running:
 357 ;;;   xinetd -dontfork -inetd_compat
 358 (deftest simple-tcp-client
 359     (with-socket (s :family :ipv4 :remote-host #(127 0 0 1) :remote-port 7)
 360       (let ((data (make-string 200)))
 361         (format s "here is some text")
 362         (finish-output s)
 363         (let ((data (subseq data 0 (read-buf-nonblock data s))))
 364           ;; (format t "~&Got ~S back from TCP echo server~%" data)
 365           (> (length data) 0))))
 366   t)
 367
 368 (deftest sockaddr-return-type
 369     (with-socket (s :family :ipv4 :remote-host #(127 0 0 1) :remote-port 7)
 370       (and (ipv4-address-p (remote-address s))
 371            (numberp (remote-port s))))
 372   t)
 373
 374 ;;; We don't support streams with UDP sockets ATM.  But when we do,
 375 ;;; let's add a similar test using stream functions.
 376 ;;;
 377 ;;; FIXME: figure out why this test blocks on my machines, on both
 378 ;;; Darwin and Linux/x86-64 --luis
 379 #-(and)
 380 (deftest simple-udp-client
 381     (with-socket (s :type :datagram :remote-host #(127 0 0 1) :remote-port 7)
 382       (let ((data (make-array '(200) :element-type '(unsigned-byte 8))))
 383         (socket-send "here is some text" s)
 384         (socket-receive data s)
 385         (format t "~&Got ~S back from UDP echo server~%" data)
 386         (> (length data) 0)))
 387   t)
 388
 389 #-windows
 390 (deftest simple-local-sockets
 391     (let ((file (namestring
 392                  (make-pathname
 393                   :name "local-socket"
 394                   :type nil
 395                   :defaults
 396                   (asdf:system-definition-pathname
 397                    (asdf:find-system '#:bsd-sockets-tests))))))
 398       (ignore-errors (delete-file file))
 399       (with-socket (p :family :local :connect :passive :local-filename file)
 400         (with-socket (a :family :local :remote-filename file)
 401           (format a "local socket test")
 402           (finish-output a))
 403         (let ((s (accept-connection p)))
 404           (prog1 (read-line s)
 405             (close s)
 406             (delete-file file)))))
 407   "local socket test")
 408
 409 (defmacro with-http-stream ((var host port request) &body body)
 410   `(with-socket (,var :family :ipv4 :remote-host ,host :remote-port ,port)
 411      (format ,var ,(concatenate 'string request " HTTP/1.0~%~%"))
 412      (finish-output ,var)
 413      ,@body))
 414
 415 #-no-internet-available
 416 (deftest simple-http-client
 417     (handler-case
 418         (with-http-stream (s "ww.telent.net" 80 "HEAD /")
 419           (let ((data (make-string 200)))
 420             (setf data (subseq data 0 (read-buf-nonblock data s)))
 421             ;; (princ data)
 422             (> (length data) 0)))
 423       (socket-network-unreachable-error () 'network-unreachable))
 424   t)
 425
 426 #-no-internet-available
 427 (deftest sockopt-receive-buffer
 428     ;; on Linux x86, the receive buffer size appears to be doubled in the
 429     ;; kernel: we set a size of x and then getsockopt() returns 2x.
 430     ;; This is why we compare with >= instead of =
 431     (handler-case
 432         (with-http-stream (s "ww.telent.net" 80 "HEAD/")
 433           (setf (socket-option s :receive-buffer) 1975)
 434           (let ((data (make-string 200)))
 435             (setf data (subseq data 0 (read-buf-nonblock data s)))
 436             (and (> (length data) 0)
 437                  (>= (socket-option s :receive-buffer) 1975))))
 438       (network-unreachable-error () 'network-unreachable))
 439   t)
 440
 441 (deftest socket-open-p.1
 442     (with-socket (s)
 443       (socket-open-p s))
 444   t)
 445
 446 (deftest socket-open-p.2
 447     (with-socket (s :family :ipv4 :remote-host #(127 0 0 1) :remote-port 7)
 448       (socket-open-p s))
 449   t)
 450
 451 (deftest socket-open-p.3
 452     (with-socket (s)
 453       (close s)
 454       (socket-open-p s))
 455   nil)
 456
 457 ;;; we don't have an automatic test for some of this yet.  There's no
 458 ;;; simple way to run servers and have something automatically connect
 459 ;;; to them as client, unless we spawn external programs.  Then we
 460 ;;; have to start telling people what external programs they should
 461 ;;; have installed.  Which, eventually, we will, but not just yet
 462
 463 ;;; to check with this: can display packets from multiple peers
 464 ;;; peer address is shown correctly for each packet
 465 ;;; packet length is correct
 466 ;;; long (>500 byte) packets have the full length shown (doesn't work)
 467 #-(and)
 468 (defun udp-server (port)
 469   (with-socket (s :type :datagram :local-port port)
 470     (loop
 471      (multiple-value-bind (buf len address port)
 472          (socket-receive s nil 500)
 473        (format t "Received ~A bytes from ~A:~A - ~A ~%"
 474                len address port (subseq buf 0 (min 10 len)))))))