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 (addresses truename)
 178                   (lookup-host "a.root-servers.net" :ipv6 nil)
 179                 (values (address-equal-p (car addresses) #(198 41 0 4))
 180                         truename))
 181               (values t "a.root-servers.net"))))
 182
 183 #-no-internet-available
 184 (test lookup-host.2
 185   (is-true (string= (nth-value 1 (lookup-host #(198 41 0 4)))
 186                     "a.root-servers.net")))
 187
 188 ;;; These days lots of people seem to be using DNS servers that don't
 189 ;;; report resolving failures for non-existing domains.  This test
 190 ;;; will fail there.
 191 (test lookup-host.3
 192   (signals resolver-no-name-error
 193     (lookup-host "foo.tninkpad.telent.net.")))
 194
 195 (test lookup-host.4
 196   (is-true (address-equal-p (car (lookup-host #(127 0 0 1) :ipv6 nil))
 197                             #(127 0 0 1))))
 198
 199 (test lookup-host.5
 200   (signals parse-error
 201     (lookup-host #(127 0 0))))
 202
 203 (test lookup-host.6
 204   (signals resolver-no-name-error
 205     (lookup-host #(127 0 0 1) :ipv6 :ipv6)))
 206
 207 ;;;; Service Lookup
 208
 209 (test lookup-service.1
 210   (is (equalp (lookup-service "ssh")
 211               (values 22 "ssh" :tcp))))
 212
 213 (test lookup-service.2
 214   (is (equalp (lookup-service 22 :udp)
 215               (values 22 "ssh" :udp))))
 216
 217 ;;; looks up a reserved service port
 218 (test lookup-service.3
 219   ;; TODO: check for a more specific error.
 220   (signals unknown-service
 221     (lookup-service 1024)))
 222
 223 ;;;; Protocol Lookup
 224
 225 (test lookup-protocol.1
 226   (is (equalp (multiple-value-bind (number name)
 227                   (lookup-protocol "tcp")
 228                 (values number name))
 229               (values 6 "tcp"))))
 230
 231 (test lookup-protocol.2
 232   (is (equalp (multiple-value-bind (number name)
 233                   (lookup-protocol "udp")
 234                 (values number name))
 235               (values 17 "udp"))))
 236
 237 (test lookup-protocol.3
 238   (signals unknown-protocol
 239     (lookup-protocol "nonexistent-protocol")))
 240
 241 (test lookup-protocol.4
 242   (is-true (string= (nth-value 1 (lookup-protocol 6))
 243                     "tcp")))
 244
 245 ;;;; Network Interfaces
 246
 247 (test list-network-interfaces.1
 248   (is-true (<= 1 (length (list-network-interfaces)))))
 249
 250 (test network-interfaces.1
 251   (is-true
 252    (flet ((nif-equal (if1 if2)
 253             (check-type if1 interface)
 254             (check-type if2 interface)
 255             (and (string= (interface-name if1) (interface-name if2))
 256                  (eql (interface-index if1) (interface-index if2)))))
 257      (loop for nif in (list-network-interfaces)
 258         always (nif-equal nif (lookup-interface (interface-name nif)))
 259         always (nif-equal nif (lookup-interface (interface-index nif)))))))
 260
 261 ;;;; Sockets
 262
 263 ;;; RT: don't accept unknown keyword arguments, such as typos.
 264 (test make-socket.1
 265   (signals error
 266     (make-socket :this-kw-arg-doesnt-exist t)))
 267
 268 (test make-socket.2
 269   (is (equalp (with-open-socket (s :family :ipv4)
 270                 (values (socket-connected-p s)
 271                         (socket-open-p s)
 272                         (> (socket-os-fd s) 1)
 273                         (socket-family s)
 274                         (socket-protocol s)))
 275               (values nil t t :ipv4 :default)))) ; why isn't it :TCP?
 276
 277 (test make-socket.3
 278   (is-true (with-open-socket (s :family :ipv4)
 279              (typep s 'socket))))
 280
 281 ;;; Given the functions we've got so far, if you can think of a better
 282 ;;; way to make sure the bind succeeded than trying it twice, let me
 283 ;;; know. 1974 has no special significance, unless you're the same age
 284 ;;; as me.
 285 (test inet.socket-bind.1
 286   (signals socket-address-in-use-error
 287     (with-open-socket (s :family :ipv4 :connect :passive
 288                          :local-host #(127 0 0 1) :local-port 1974)
 289       (with-open-socket (s :family :ipv4 :connect :passive
 290                            :local-host #(127 0 0 1) :local-port 1974)))))
 291
 292 (test sockopt.1
 293   (is-true (with-open-socket (s :family :ipv4)
 294              (setf (socket-option s :reuse-address) t)
 295              (socket-option s :reuse-address))))
 296
 297 ;;; Like READ-SEQUENCE, but returns early if the full quantity of data
 298 ;;; isn't there to be read.  Blocks if no input at all.
 299 (defun read-buf-nonblock (buffer stream)
 300   (let ((eof (gensym)))
 301     (do ((i 0 (1+ i))
 302          (c (read-char stream nil eof)
 303             (read-char-no-hang stream nil eof)))
 304         ((or (>= i (length buffer)) (not c) (eq c eof)) i)
 305       (setf (elt buffer i) c))))
 306
 307 (test simple-tcp-client
 308   (is-true
 309    (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port*
 310                         :family :ipv4)
 311      (let ((data (make-string 200)))
 312        (format s "here is some text")
 313        (finish-output s)
 314        (let ((data (subseq data 0 (read-buf-nonblock data s))))
 315          ;; (format t "~&Got ~S back from TCP echo server~%" data)
 316          (> (length data) 0))))))
 317
 318 (test sockaddr-return-type
 319   (is-true
 320    (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port*
 321                         :family :ipv4)
 322      (and (ipv4-address-p (remote-host s))
 323           (numberp (remote-port s))))))
 324
 325 ;;; We don't support streams with UDP sockets ATM.  But when we do,
 326 ;;; let's add a similar test using stream functions.
 327 ;;;
 328 ;;; FIXME: figure out why this test blocks with the inetd services on
 329 ;;; my machines, on both Darwin and Linux/x86-64.  Works with
 330 ;;; echo-server.c though --luis
 331 (test simple-udp-client.1
 332   (is-true
 333    (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port*
 334                         :type :datagram :family :ipv4)
 335      (send-to s "here is some text")
 336      (let ((nbytes (nth-value 1 (receive-from s :size 200))))
 337        (plusp nbytes)))))
 338
 339 (test simple-udp-client.2
 340   (is-true
 341    (with-open-socket (s :type :datagram :family :ipv4)
 342      (send-to s "here is some more text"
 343               :remote-host *echo-address*
 344               :remote-port *echo-port*)
 345      (let ((nbytes (nth-value 1 (receive-from s :size 200))))
 346        (plusp nbytes)))))
 347
 348 (test simple-local-sockets
 349   (is (string= (let ((file (namestring
 350                             (make-pathname :name "local-socket" :type nil
 351                                            :defaults (truename
 352                                                       (asdf:system-definition-pathname
 353                                                        (asdf:find-system '#:iolib-tests)))))))
 354                  ;; (ignore-errors (delete-file file))
 355                  (with-open-socket (p :family :local :connect :passive :local-filename file)
 356                    (with-open-socket (a :family :local :remote-filename file)
 357                      (format a "local socket test")
 358                      (finish-output a))
 359                    (let ((s (accept-connection p)))
 360                      (prog1 (read-line s)
 361                        (close s)
 362                        (delete-file file)))))
 363                "local socket test")))
 364
 365 (defmacro with-http-stream ((var host port request) &body body)
 366   `(with-open-socket (,var :family :ipv4 :remote-host ,host :remote-port ,port)
 367      (format ,var ,(concatenate 'string request " HTTP/1.0~%~%"))
 368      (finish-output ,var)
 369      ,@body))
 370
 371 #-no-internet-available
 372 (test simple-http-client
 373   (is-true
 374    (with-http-stream (s "www.google.com" 80 "HEAD /")
 375      (let ((data (make-string 200)))
 376        (setf data (subseq data 0 (read-buf-nonblock data s)))
 377        ;; (princ data)
 378        (> (length data) 0)))))
 379
 380 #-no-internet-available
 381 (test sockopt-receive-buffer
 382   ;; on Linux x86, the receive buffer size appears to be doubled in the
 383   ;; kernel: we set a size of x and then getsockopt() returns 2x.
 384   ;; This is why we compare with >= instead of =
 385   (is-true
 386    (with-http-stream (s "www.google.com" 80 "HEAD/")
 387      (setf (socket-option s :receive-buffer) 1975)
 388      (let ((data (make-string 200)))
 389        (setf data (subseq data 0 (read-buf-nonblock data s)))
 390        (and (> (length data) 0)
 391             (>= (socket-option s :receive-buffer) 1975))))))
 392
 393 (test socket-open-p.1
 394   (is-true (with-open-socket (s)
 395              (socket-open-p s))))
 396
 397 (test socket-open-p.2
 398   (is-true (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port*
 399                                 :family :ipv4)
 400              (socket-open-p s))))
 401
 402 (test socket-open-p.3
 403   (is-false (with-open-socket (s)
 404               (close s)
 405               (socket-open-p s))))
 406
 407 ;;; we don't have an automatic test for some of this yet.  There's no
 408 ;;; simple way to run servers and have something automatically connect
 409 ;;; to them as client, unless we spawn external programs.  Then we
 410 ;;; have to start telling people what external programs they should
 411 ;;; have installed.  Which, eventually, we will, but not just yet
 412
 413 ;;; to check with this: can display packets from multiple peers
 414 ;;; peer address is shown correctly for each packet
 415 ;;; packet length is correct
 416 ;;; long (>500 byte) packets have the full length shown (doesn't work)
 417 #-(and)
 418 (defun udp-server (port)
 419   (with-open-socket (s :type :datagram :local-port port)
 420     (loop
 421        (multiple-value-bind (buf len address port)
 422            (receive-from s :size 500)
 423          (format t "Received ~A bytes from ~A:~A - ~A ~%"
 424                  len address port (subseq buf 0 (min 10 len)))))))