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 (defparameter *echo-address* (lookup-hostname "aldebaran.cddr.org"))
  11 (defparameter *echo-port* 7)
  12 (defparameter *echo-timeout* 2)
  13
  14 ;;;; Addresses
  15
  16 ;;; a real address
  17 (test (address-to-vector.1 :compile-at :definition-time)
  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 :compile-at :definition-time)
  23   (is (equalp (address-to-vector "242.1.211.3")
  24               (values #(242 1 211 3) :ipv4))))
  25
  26 (test (address-to-vector.3 :compile-at :definition-time)
  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 :compile-at :definition-time)
  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 :compile-at :definition-time)
  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 :compile-at :definition-time)
  41   (signals parse-error
  42     (ensure-address "ff0x::114")))
  43
  44 ;;; ditto
  45 (test (ensure-address.2 :compile-at :definition-time)
  46   (signals parse-error
  47     (ensure-address "127.0.256.1")))
  48
  49 (test (ensure-address.3 :compile-at :definition-time)
  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 :compile-at :definition-time)
  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 :compile-at :definition-time)
  60   (is (string= (integer-to-dotted 0)
  61                "0.0.0.0")))
  62
  63 (test (integer-to-dotted.2 :compile-at :definition-time)
  64   (is (string= (integer-to-dotted +max-ipv4-value+)
  65                "255.255.255.255")))
  66
  67 (test (integer-to-dotted.3 :compile-at :definition-time)
  68   (signals type-error
  69     (integer-to-dotted (1+ +max-ipv4-value+))))
  70
  71 (test (integer-to-dotted.4 :compile-at :definition-time)
  72   (signals type-error
  73     (integer-to-dotted -1)))
  74
  75 (test (dotted-to-vector.1 :compile-at :definition-time)
  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 :compile-at :definition-time)
  80   (signals parse-error
  81     (dotted-to-vector "127.0.0.0.0")))
  82
  83 (test (dotted-to-vector.3 :compile-at :definition-time)
  84   (signals type-error
  85     (dotted-to-vector 'not-a-string)))
  86
  87 (test (vector-to-dotted.1 :compile-at :definition-time)
  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 :compile-at :definition-time)
  92   (signals type-error
  93     (vector-to-dotted #(127 0 0 256))))
  94
  95 (test (address-to-string.1 :compile-at :definition-time)
  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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 135   (is-true (address= +ipv4-loopback+ (make-address #(127 0 0 1)))))
 136
 137 (test (address=.2 :compile-at :definition-time)
 138   (is-true (address= +ipv6-loopback+ (ensure-address "::1"))))
 139
 140 (test (copy-address.1 :compile-at :definition-time)
 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 :compile-at :definition-time)
 150   (signals type-error
 151     (make-address 'not-a-valid-designator)))
 152
 153 (test (address.unspecified.1 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 168   (is-true (ipv6-ipv4-mapped-p (ensure-address "::ffff:127.0.0.1"))))
 169
 170 (test (address.ipv6.1 :compile-at :definition-time)
 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 (defparameter *google-ns*
 177   (list #/ip/8.8.8.8 #/ip/8.8.4.4))
 178
 179 #-no-internet-available
 180 (test (lookup-hostname.1 :compile-at :definition-time)
 181   (is (equalp (multiple-value-bind (address addresses truename)
 182                   (lookup-hostname "a.root-servers.net" :ipv6 nil :ns *google-ns*)
 183                 (declare (ignore addresses))
 184                 (values (address-equal-p address #(198 41 0 4))
 185                         truename))
 186               (values t "a.root-servers.net"))))
 187
 188 #-no-internet-available
 189 (test (lookup-hostname.2 :compile-at :definition-time)
 190   (is-true (string= (nth-value 2 (lookup-hostname #(198 41 0 4) :ns *google-ns*))
 191                     "a.root-servers.net")))
 192
 193 (test (lookup-hostname.3 :compile-at :definition-time)
 194   (signals resolver-no-name-error
 195     (lookup-hostname "foo.tninkpad.telent.net." :ns *google-ns*)))
 196
 197 (test (lookup-hostname.4 :compile-at :definition-time)
 198   (is-true (address-equal-p (lookup-hostname #(127 0 0 1) :ipv6 nil :ns *google-ns*)
 199                             #(127 0 0 1))))
 200
 201 (test (lookup-hostname.5 :compile-at :definition-time)
 202   (signals parse-error
 203     (lookup-hostname #(127 0 0) :ns *google-ns*)))
 204
 205 (test (lookup-hostname.6 :compile-at :definition-time)
 206   (signals resolver-no-name-error
 207     (lookup-hostname #(127 0 0 1) :ipv6 :ipv6 :ns *google-ns*)))
 208
 209 ;;;; Service Lookup
 210
 211 (test (lookup-service.1 :compile-at :definition-time)
 212   (is (equalp (lookup-service "ssh")
 213               (values 22 "ssh" :tcp))))
 214
 215 (test (lookup-service.2 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 240   (signals unknown-protocol
 241     (lookup-protocol "nonexistent-protocol")))
 242
 243 (test (lookup-protocol.4 :compile-at :definition-time)
 244   (is-true (string= (nth-value 1 (lookup-protocol 6))
 245                     "tcp")))
 246
 247 ;;;; Network Interfaces
 248
 249 (test (list-network-interfaces.1 :compile-at :definition-time)
 250   (is-true (<= 1 (length (list-network-interfaces)))))
 251
 252 (test (network-interfaces.1 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 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 :compile-at :definition-time)
 337   (is-true
 338    (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port*
 339                         :type :datagram :address-family :ipv4)
 340      (send-to s #(1 2 3 4 5))
 341      (let ((nbytes (nth-value 1 (handler-bind ((isys:ewouldblock
 342                                                 (lambda (e)
 343                                                   (invoke-restart (find-restart 'retry-syscall e)
 344                                                                   *echo-timeout*))))
 345                                   (receive-from s :size 200)))))
 346        (plusp nbytes)))))
 347
 348 (test (simple-udp-client.2 :compile-at :definition-time)
 349   (is-true
 350    (with-open-socket (s :type :datagram :address-family :ipv4)
 351      (send-to s #(1 2 3 4 5)
 352               :remote-host *echo-address*
 353               :remote-port *echo-port*)
 354      (let ((nbytes (nth-value 1 (handler-bind ((isys:ewouldblock
 355                                                 (lambda (e)
 356                                                   (invoke-restart (find-restart 'retry-syscall e)
 357                                                                   *echo-timeout*))))
 358                                   (receive-from s :size 200)))))
 359        (plusp nbytes)))))
 360
 361 (test (simple-local-sockets :compile-at :definition-time)
 362   (is (string= (let ((file (namestring
 363                             (make-pathname :name "local-socket" :type nil
 364                                            :defaults (truename
 365                                                       (asdf:system-definition-pathname
 366                                                        (asdf:find-system '#:iolib-tests)))))))
 367                  (ignore-errors (delete-file file))
 368                  (with-open-socket (p :address-family :local :connect :passive :local-filename file)
 369                    (with-open-socket (a :address-family :local :remote-filename file)
 370                      (format a "local socket test")
 371                      (finish-output a))
 372                    (let ((s (accept-connection p)))
 373                      (prog1 (read-line s)
 374                        (close s)
 375                        (delete-file file)))))
 376                "local socket test")))
 377
 378 (defmacro with-http-stream ((var host port request) &body body)
 379   `(with-open-socket (,var :address-family :ipv4 :remote-host ,host :remote-port ,port)
 380      (format ,var ,(concatenate 'string request " HTTP/1.0~%~%"))
 381      (finish-output ,var)
 382      ,@body))
 383
 384 #-no-internet-available
 385 (test (simple-http-client :compile-at :definition-time)
 386   (is-true
 387    (with-http-stream (s "www.google.com" 80 "HEAD /")
 388      (let ((data (make-string 200)))
 389        (setf data (subseq data 0 (read-buf-nonblock data s)))
 390        ;; (princ data)
 391        (> (length data) 0)))))
 392
 393 #-no-internet-available
 394 (test (sockopt-receive-buffer :compile-at :definition-time)
 395   ;; on Linux x86, the receive buffer size appears to be doubled in the
 396   ;; kernel: we set a size of x and then getsockopt() returns 2x.
 397   ;; This is why we compare with >= instead of =
 398   (is-true
 399    (with-http-stream (s "www.google.com" 80 "HEAD/")
 400      (setf (socket-option s :receive-buffer) 1975)
 401      (let ((data (make-string 200)))
 402        (setf data (subseq data 0 (read-buf-nonblock data s)))
 403        (and (> (length data) 0)
 404             (>= (socket-option s :receive-buffer) 1975))))))
 405
 406 (test (socket-open-p.1 :compile-at :definition-time)
 407   (is-true (with-open-socket (s)
 408              (socket-open-p s))))
 409
 410 (test (socket-open-p.2 :compile-at :definition-time)
 411   (is-true (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port*
 412                                 :address-family :ipv4)
 413              (socket-open-p s))))
 414
 415 (test (socket-open-p.3 :compile-at :definition-time)
 416   (is-false (with-open-socket (s)
 417               (close s)
 418               (socket-open-p s))))
 419
 420 ;;; we don't have an automatic test for some of this yet.  There's no
 421 ;;; simple way to run servers and have something automatically connect
 422 ;;; to them as client, unless we spawn external programs.  Then we
 423 ;;; have to start telling people what external programs they should
 424 ;;; have installed.  Which, eventually, we will, but not just yet
 425
 426 ;;; to check with this: can display packets from multiple peers
 427 ;;; peer address is shown correctly for each packet
 428 ;;; packet length is correct
 429 ;;; long (>500 byte) packets have the full length shown (doesn't work)
 430 #-(and)
 431 (defun udp-server (port)
 432   (with-open-socket (s :type :datagram :local-port port)
 433     (loop
 434        (multiple-value-bind (buf len address port)
 435            (receive-from s :size 500)
 436          (format t "Received ~A bytes from ~A:~A - ~A ~%"
 437                  len address port (subseq buf 0 (min 10 len)))))))