Commit | Line | Data |
---|---|---|
4064ed2a KR |
1 | ;;;; socket.test --- test socket functions -*- scheme -*- |
2 | ;;;; | |
6e7d5622 | 3 | ;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. |
4064ed2a KR |
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 | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
4064ed2a KR |
18 | |
19 | (define-module (test-suite test-numbers) | |
20 | #:use-module (test-suite lib)) | |
21 | ||
e7e48080 | 22 | \f |
4064ed2a KR |
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)))))) | |
3810edd9 KR |
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")))))) | |
e7e48080 KR |
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 |