tests/sockets.lisp

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