1 ;;;; socket.test --- test socket functions -*- scheme -*-
3 ;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
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.
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.
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
19 (define-module (test-suite test-socket)
20 #:use-module (test-suite lib))
29 (with-test-prefix "htonl"
31 (pass-if "0" (eqv? 0 (htonl 0)))
33 (pass-if-exception "-1" exception:out-of-range
36 ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect
37 ;; an overflow for values 2^32 <= x < 2^63
38 (pass-if-exception "2^32" exception:out-of-range
41 (pass-if-exception "2^1024" exception:out-of-range
42 (htonl (ash 1 1024)))))
49 (if (defined? 'inet-ntop)
50 (with-test-prefix "inet-ntop"
52 (with-test-prefix "ipv6"
54 (string? (inet-ntop AF_INET6 0)))
57 (string? (inet-ntop AF_INET6 (1- (ash 1 128)))))
59 (pass-if-exception "-1" exception:out-of-range
60 (inet-ntop AF_INET6 -1))
62 (pass-if-exception "2^128" exception:out-of-range
63 (inet-ntop AF_INET6 (ash 1 128)))
65 (pass-if-exception "2^1024" exception:out-of-range
66 (inet-ntop AF_INET6 (ash 1 1024))))))
72 (if (defined? 'inet-pton)
73 (with-test-prefix "inet-pton"
75 (with-test-prefix "ipv6"
76 (pass-if "00:00:00:00:00:00:00:00"
77 (eqv? 0 (inet-pton AF_INET6 "00:00:00:00:00:00:00:00")))
79 (pass-if "0:0:0:0:0:0:0:1"
80 (eqv? 1 (inet-pton AF_INET6 "0:0:0:0:0:0:0:1")))
83 (eqv? 1 (inet-pton AF_INET6 "::1")))
85 (pass-if "FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF"
86 (eqv? #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
88 "FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF")))
90 (pass-if "F000:0000:0000:0000:0000:0000:0000:0000"
91 (eqv? #xF0000000000000000000000000000000
93 "F000:0000:0000:0000:0000:0000:0000:0000")))
95 (pass-if "0F00:0000:0000:0000:0000:0000:0000:0000"
96 (eqv? #x0F000000000000000000000000000000
98 "0F00:0000:0000:0000:0000:0000:0000:0000")))
100 (pass-if "0000:0000:0000:0000:0000:0000:0000:00F0"
103 "0000:0000:0000:0000:0000:0000:0000:00F0"))))))
105 (if (defined? 'inet-ntop)
106 (with-test-prefix "inet-ntop"
108 (with-test-prefix "ipv4"
110 (equal? "127.0.0.1" (inet-ntop AF_INET INADDR_LOOPBACK))))
112 (if (defined? 'AF_INET6)
113 (with-test-prefix "ipv6"
114 (pass-if "FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF"
115 (string-ci=? "FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF"
116 (inet-ntop AF_INET6 (- (expt 2 128) 1))))
119 (equal? "::1" (inet-ntop AF_INET6 1)))))))
123 ;;; make-socket-address
126 (with-test-prefix "make-socket-address"
127 (if (defined? 'AF_INET)
129 (let ((sa (make-socket-address AF_INET 123456 80)))
130 (and (= (sockaddr:fam sa) AF_INET)
131 (= (sockaddr:addr sa) 123456)
132 (= (sockaddr:port sa) 80)))))
134 (if (defined? 'AF_INET6)
136 ;; Since the platform doesn't necessarily support `scopeid', we won't
138 (let ((sa* (make-socket-address AF_INET6 123456 80 1))
139 (sa+ (make-socket-address AF_INET6 123456 80)))
140 (and (= (sockaddr:fam sa*) (sockaddr:fam sa+) AF_INET6)
141 (= (sockaddr:addr sa*) (sockaddr:addr sa+) 123456)
142 (= (sockaddr:port sa*) (sockaddr:port sa+) 80)
143 (= (sockaddr:flowinfo sa*) 1)))))
145 (if (defined? 'AF_UNIX)
147 (let ((sa (make-socket-address AF_UNIX "/tmp/unix-socket")))
148 (and (= (sockaddr:fam sa) AF_UNIX)
149 (string=? (sockaddr:path sa) "/tmp/unix-socket"))))))
155 (if (defined? 'ntohl)
156 (with-test-prefix "ntohl"
158 (pass-if "0" (eqv? 0 (ntohl 0)))
160 (pass-if-exception "-1" exception:out-of-range
163 ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect
164 ;; an overflow for values 2^32 <= x < 2^63
165 (pass-if-exception "2^32" exception:out-of-range
168 (pass-if-exception "2^1024" exception:out-of-range
169 (ntohl (ash 1 1024)))))
174 ;;; AF_UNIX sockets and `make-socket-address'
178 ;; Honor `$TMPDIR', which tmpnam(3) doesn't do.
179 (or (getenv "TMPDIR") "/tmp"))
182 ;; Remember the current working directory.
185 ;; Temporarily cd to %TMPDIR. The goal is to work around path name
186 ;; limitations, which can lead to exceptions like:
188 ;; (misc-error "scm_to_sockaddr"
189 ;; "unix address path too long: ~A"
190 ;; ("/tmp/nix-build-fb7bph4ifh0vr3ihigm702dzffdnapfj-guile-coverage-1.9.5.drv-0/guile-test-socket-1258553296-77619")
194 (define (temp-file-path)
195 ;; Return a temporary file name, assuming the current directory is %TMPDIR.
196 (string-append "guile-test-socket-"
197 (number->string (current-time)) "-"
198 (number->string (random 100000))))
201 (if (defined? 'AF_UNIX)
202 (with-test-prefix "AF_UNIX/SOCK_DGRAM"
204 ;; testing `bind' and `sendto' and datagram sockets
206 (let ((server-socket (socket AF_UNIX SOCK_DGRAM 0))
208 (path (temp-file-path)))
213 (bind server-socket AF_UNIX path)
214 (set! server-bound? #t)
217 (let ((errno (system-error-errno args)))
218 (cond ((= errno EADDRINUSE) (throw 'unresolved))
219 (else (apply throw args)))))))
221 (pass-if "bind/sockaddr"
222 (let* ((sock (socket AF_UNIX SOCK_STREAM 0))
223 (path (temp-file-path))
224 (sockaddr (make-socket-address AF_UNIX path)))
228 (false-if-exception (delete-file path))
231 (let ((errno (system-error-errno args)))
232 (cond ((= errno EADDRINUSE) (throw 'unresolved))
233 (else (apply throw args))))))))
236 (if (not server-bound?)
238 (let ((client (socket AF_UNIX SOCK_DGRAM 0)))
239 (> (sendto client "hello" AF_UNIX path) 0))))
241 (pass-if "sendto/sockaddr"
242 (if (not server-bound?)
244 (let ((client (socket AF_UNIX SOCK_DGRAM 0))
245 (sockaddr (make-socket-address AF_UNIX path)))
246 (> (sendto client "hello" sockaddr) 0))))
248 (false-if-exception (delete-file path)))))
251 (if (defined? 'AF_UNIX)
252 (with-test-prefix "AF_UNIX/SOCK_STREAM"
254 ;; testing `bind', `listen' and `connect' on stream-oriented sockets
256 (let ((server-socket (socket AF_UNIX SOCK_STREAM 0))
258 (server-listening? #f)
260 (path (temp-file-path)))
265 (bind server-socket AF_UNIX path)
266 (set! server-bound? #t)
269 (let ((errno (system-error-errno args)))
270 (cond ((= errno EADDRINUSE) (throw 'unresolved))
271 (else (apply throw args)))))))
273 (pass-if "bind/sockaddr"
274 (let* ((sock (socket AF_UNIX SOCK_STREAM 0))
275 (path (temp-file-path))
276 (sockaddr (make-socket-address AF_UNIX path)))
280 (false-if-exception (delete-file path))
283 (let ((errno (system-error-errno args)))
284 (cond ((= errno EADDRINUSE) (throw 'unresolved))
285 (else (apply throw args))))))))
288 (if (not server-bound?)
291 (listen server-socket 123)
292 (set! server-listening? #t)
295 (if server-listening?
296 (let ((pid (primitive-fork)))
297 ;; Spawn a server process.
299 ((-1) (throw 'unresolved))
300 ((0) ;; the kid: serve two connections and exit
302 (false-if-exception (accept server-socket)))
307 (serve (false-if-exception (accept server-socket))
311 (set! server-pid pid)
317 (let ((s (socket AF_UNIX SOCK_STREAM 0)))
318 (connect s AF_UNIX path)
321 (pass-if "connect/sockaddr"
324 (let ((s (socket AF_UNIX SOCK_STREAM 0)))
325 (connect s (make-socket-address AF_UNIX path))
331 (let ((status (cdr (waitpid server-pid))))
332 (eq? 0 (status:exit-val status)))))
334 (false-if-exception (delete-file path))
339 (if (defined? 'AF_INET6)
340 (with-test-prefix "AF_INET6/SOCK_STREAM"
342 ;; testing `bind', `listen' and `connect' on stream-oriented sockets
344 (let ((server-socket (socket AF_INET6 SOCK_STREAM 0))
346 (server-listening? #f)
355 (bind server-socket AF_INET6 ipv6-addr server-port)
356 (set! server-bound? #t)
359 (let ((errno (system-error-errno args)))
360 (cond ((= errno EADDRINUSE) (throw 'unresolved))
361 (else (apply throw args)))))))
363 (pass-if "bind/sockaddr"
364 (let* ((sock (socket AF_INET6 SOCK_STREAM 0))
365 (sockaddr (make-socket-address AF_INET6 ipv6-addr client-port)))
371 (let ((errno (system-error-errno args)))
372 (cond ((= errno EADDRINUSE) (throw 'unresolved))
373 (else (apply throw args))))))))
376 (if (not server-bound?)
379 (listen server-socket 123)
380 (set! server-listening? #t)
383 (if server-listening?
384 (let ((pid (primitive-fork)))
385 ;; Spawn a server process.
387 ((-1) (throw 'unresolved))
388 ((0) ;; the kid: serve two connections and exit
390 (false-if-exception (accept server-socket)))
395 (serve (false-if-exception (accept server-socket))
399 (set! server-pid pid)
405 (let ((s (socket AF_INET6 SOCK_STREAM 0)))
406 (connect s AF_INET6 ipv6-addr server-port)
409 (pass-if "connect/sockaddr"
412 (let ((s (socket AF_INET6 SOCK_STREAM 0)))
413 (connect s (make-socket-address AF_INET6 ipv6-addr server-port))
419 (let ((status (cdr (waitpid server-pid))))
420 (eq? 0 (status:exit-val status)))))
424 ;; Switch back to the previous directory.
425 (false-if-exception (chdir %curdir))