tests/net.sockets-tests.lisp

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