tests/sockets.lisp

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