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