test-suite/tests/socket.test

   1 ;;;; socket.test --- test socket functions     -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 2.1 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 (define-module (test-suite test-numbers)
  20   #:use-module (test-suite lib))
  21
  22 \f
  23 ;;;
  24 ;;; inet-ntop
  25 ;;;
  26
  27 (if (defined? 'inet-ntop)
  28     (with-test-prefix "inet-ntop"
  29
  30       (with-test-prefix "ipv6"
  31         (pass-if "0"
  32           (string? (inet-ntop AF_INET6 0)))
  33
  34         (pass-if "2^128-1"
  35           (string? (inet-ntop AF_INET6 (1- (ash 1 128)))))
  36
  37         (pass-if-exception "-1" exception:out-of-range
  38           (inet-ntop AF_INET6 -1))
  39
  40         (pass-if-exception "2^128" exception:out-of-range
  41           (inet-ntop AF_INET6 (ash 1 128)))
  42
  43         (pass-if-exception "2^1024" exception:out-of-range
  44           (inet-ntop AF_INET6 (ash 1 1024))))))
  45
  46 ;;;
  47 ;;; inet-pton
  48 ;;;
  49
  50 (if (defined? 'inet-pton)
  51     (with-test-prefix "inet-pton"
  52
  53       (with-test-prefix "ipv6"
  54         (pass-if "00:00:00:00:00:00:00:00"
  55           (eqv? 0 (inet-pton AF_INET6 "00:00:00:00:00:00:00:00")))
  56
  57         (pass-if "0:0:0:0:0:0:0:1"
  58           (eqv? 1 (inet-pton AF_INET6 "0:0:0:0:0:0:0:1")))
  59
  60         (pass-if "::1"
  61           (eqv? 1 (inet-pton AF_INET6 "::1")))
  62
  63         (pass-if "FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF"
  64           (eqv? #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
  65                 (inet-pton AF_INET6
  66                            "FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF")))
  67
  68         (pass-if "F000:0000:0000:0000:0000:0000:0000:0000"
  69           (eqv? #xF0000000000000000000000000000000
  70                 (inet-pton AF_INET6
  71                            "F000:0000:0000:0000:0000:0000:0000:0000")))
  72
  73         (pass-if "0F00:0000:0000:0000:0000:0000:0000:0000"
  74           (eqv? #x0F000000000000000000000000000000
  75                 (inet-pton AF_INET6
  76                            "0F00:0000:0000:0000:0000:0000:0000:0000")))
  77
  78         (pass-if "0000:0000:0000:0000:0000:0000:0000:00F0"
  79           (eqv? #xF0
  80                 (inet-pton AF_INET6
  81                            "0000:0000:0000:0000:0000:0000:0000:00F0"))))))
  82
  83 \f
  84 ;;;
  85 ;;; make-socket-address
  86 ;;;
  87
  88 (with-test-prefix "make-socket-address"
  89   (if (defined? 'AF_INET)
  90       (pass-if "AF_INET"
  91         (let ((sa (make-socket-address AF_INET 123456 80)))
  92           (and (= (sockaddr:fam  sa) AF_INET)
  93                (= (sockaddr:addr sa) 123456)
  94                (= (sockaddr:port sa) 80)))))
  95
  96   (if (defined? 'AF_INET6)
  97       (pass-if "AF_INET6"
  98         ;; Since the platform doesn't necessarily support `scopeid', we won't
  99         ;; test it.
 100         (let ((sa* (make-socket-address AF_INET6 123456 80 1))
 101               (sa+ (make-socket-address AF_INET6 123456 80)))
 102           (and (= (sockaddr:fam  sa*) (sockaddr:fam  sa+) AF_INET6)
 103                (= (sockaddr:addr sa*) (sockaddr:addr sa+) 123456)
 104                (= (sockaddr:port sa*) (sockaddr:port sa+) 80)
 105                (= (sockaddr:flowinfo sa*) 1)))))
 106
 107   (if (defined? 'AF_UNIX)
 108       (pass-if "AF_UNIX"
 109         (let ((sa (make-socket-address AF_UNIX "/tmp/unix-socket")))
 110           (and (= (sockaddr:fam sa) AF_UNIX)
 111                (string=? (sockaddr:path sa) "/tmp/unix-socket"))))))
 112
 113
 114 \f
 115 ;;;
 116 ;;; AF_UNIX sockets and `make-socket-address'
 117 ;;;
 118
 119 (if (defined? 'AF_UNIX)
 120     (with-test-prefix "AF_UNIX/SOCK_DGRAM"
 121
 122       ;; testing `bind' and `sendto' and datagram sockets
 123
 124       (let ((server-socket (socket AF_UNIX SOCK_DGRAM 0))
 125             (server-bound? #f)
 126             (path (tmpnam)))
 127
 128         (pass-if "bind"
 129           (catch 'system-error
 130             (lambda ()
 131               (bind server-socket AF_UNIX path)
 132               (set! server-bound? #t)
 133               #t)
 134             (lambda args
 135               (let ((errno (system-error-errno args)))
 136                 (cond ((= errno EADDRINUSE) (throw 'unresolved))
 137                       (else (apply throw args)))))))
 138
 139         (pass-if "bind/sockaddr"
 140           (let* ((sock (socket AF_UNIX SOCK_STREAM 0))
 141                  (path (tmpnam))
 142                  (sockaddr (make-socket-address AF_UNIX path)))
 143             (catch 'system-error
 144               (lambda ()
 145                 (bind sock sockaddr)
 146                 (false-if-exception (delete-file path))
 147                 #t)
 148               (lambda args
 149                 (let ((errno (system-error-errno args)))
 150                   (cond ((= errno EADDRINUSE) (throw 'unresolved))
 151                         (else (apply throw args))))))))
 152
 153         (pass-if "sendto"
 154           (if (not server-bound?)
 155               (throw 'unresolved)
 156               (let ((client (socket AF_UNIX SOCK_DGRAM 0)))
 157                 (> (sendto client "hello" AF_UNIX path) 0))))
 158
 159         (pass-if "sendto/sockaddr"
 160           (if (not server-bound?)
 161               (throw 'unresolved)
 162               (let ((client (socket AF_UNIX SOCK_DGRAM 0))
 163                     (sockaddr (make-socket-address AF_UNIX path)))
 164                 (> (sendto client "hello" sockaddr) 0))))
 165
 166         (false-if-exception (delete-file path)))))
 167
 168
 169 (if (defined? 'AF_UNIX)
 170     (with-test-prefix "AF_UNIX/SOCK_STREAM"
 171
 172       ;; testing `bind', `listen' and `connect' on stream-oriented sockets
 173
 174       (let ((server-socket (socket AF_UNIX SOCK_STREAM 0))
 175             (server-bound? #f)
 176             (server-listening? #f)
 177             (server-pid #f)
 178             (path (tmpnam)))
 179
 180         (pass-if "bind"
 181           (catch 'system-error
 182             (lambda ()
 183               (bind server-socket AF_UNIX path)
 184               (set! server-bound? #t)
 185               #t)
 186             (lambda args
 187               (let ((errno (system-error-errno args)))
 188                 (cond ((= errno EADDRINUSE) (throw 'unresolved))
 189                       (else (apply throw args)))))))
 190
 191         (pass-if "bind/sockaddr"
 192           (let* ((sock (socket AF_UNIX SOCK_STREAM 0))
 193                  (path (tmpnam))
 194                  (sockaddr (make-socket-address AF_UNIX path)))
 195             (catch 'system-error
 196               (lambda ()
 197                 (bind sock sockaddr)
 198                 (false-if-exception (delete-file path))
 199                 #t)
 200               (lambda args
 201                 (let ((errno (system-error-errno args)))
 202                   (cond ((= errno EADDRINUSE) (throw 'unresolved))
 203                         (else (apply throw args))))))))
 204
 205         (pass-if "listen"
 206           (if (not server-bound?)
 207               (throw 'unresolved)
 208               (begin
 209                 (listen server-socket 123)
 210                 (set! server-listening? #t)
 211                 #t)))
 212
 213         (if server-listening?
 214             (let ((pid (primitive-fork)))
 215               ;; Spawn a server process.
 216               (case pid
 217                 ((-1) (throw 'unresolved))
 218                 ((0)   ;; the kid:  serve two connections and exit
 219                  (let serve ((conn
 220                               (false-if-exception (accept server-socket)))
 221                              (count 1))
 222                    (if (not conn)
 223                        (exit 1)
 224                        (if (> count 0)
 225                            (serve (false-if-exception (accept server-socket))
 226                                   (- count 1)))))
 227                  (exit 0))
 228                 (else  ;; the parent
 229                  (set! server-pid pid)
 230                  #t))))
 231
 232         (pass-if "connect"
 233           (if (not server-pid)
 234               (throw 'unresolved)
 235               (let ((s (socket AF_UNIX SOCK_STREAM 0)))
 236                 (connect s AF_UNIX path)
 237                 #t)))
 238
 239         (pass-if "connect/sockaddr"
 240           (if (not server-pid)
 241               (throw 'unresolved)
 242               (let ((s (socket AF_UNIX SOCK_STREAM 0)))
 243                 (connect s (make-socket-address AF_UNIX path))
 244                 #t)))
 245
 246         (pass-if "accept"
 247           (if (not server-pid)
 248               (throw 'unresolved)
 249               (let ((status (cdr (waitpid server-pid))))
 250                 (eq? 0 (status:exit-val status)))))
 251
 252         (false-if-exception (delete-file path))
 253
 254         #t)))
 255