tests/sockets.lisp

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