blob: 67fdb9cfb581a45377c021b559fe45db6b3d485f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
source [file dirname [info script]]/testing.tcl
needs constraint jim
needs cmd socket
needs cmd os.fork
catch {[socket -ipv6 stream {[::1]:5000}]} res
set ipv6 1
if {[string match "*not supported" $res]} {
set ipv6 0
} else {
# Also, if we can't bind an IPv6 socket, don't run IPv6 tests
if {[catch {
[socket -ipv6 stream.server {[::1]:5000}] close
} msg opts]} {
set ipv6 0
}
}
testConstraint ipv6 $ipv6
# Given an IPv4 or IPv6 server socket, return an address
# that a client can use to connect to the socket.
# This handles the case where the server is listening on (say) 0.0.0.0:5000
# but some systems need the client to connect on localhost:5000
proc socket-connect-addr {s} {
if {[regexp {(.*):([^:]+)} [$s sockname] -> host port]} {
if {$host eq "0.0.0.0"} {
return 127.0.0.1:$port
} elseif {$host eq {[::]}} {
return \[::1\]:$port
}
}
return [$s sockname]
}
test socket-1.1 {stream} -body {
# Let the system choose a port
set s [socket stream.server 127.0.0.1:0]
stdout flush
if {[os.fork] == 0} {
# child
set c [socket stream [$s sockname]]
$s close
$c puts hello
$c close
exit 99
}
set cs [$s accept]
$cs gets buf
$cs close
$s close
set buf
} -result {hello}
test socket-1.2 {dgram - connected} -body {
# Let the system choose a port
set s [socket dgram.server 127.0.0.1:0]
set c [socket dgram [$s sockname]]
$s buffering none
$c buffering none
$c puts -nonewline hello
set buf [$s recv 1000]
$c close
$s close
set buf
} -result {hello}
test socket-1.3 {dgram - unconnected} -body {
# Let the system choose a port
set s [socket dgram.server 127.0.0.1:0]
set c [socket dgram]
$s buffering none
$c buffering none
$c sendto hello [$s sockname]
set buf [$s recv 1000]
$c close
$s close
set buf
} -result {hello}
test socket-1.4 {unix} -body {
set path [file tempfile]
file delete $path
set s [socket unix.server $path]
stdout flush
if {[os.fork] == 0} {
# child
set c [socket unix [$s sockname]]
$s close
$c puts hello
$c close
exit 99
}
set cs [$s accept]
$cs gets buf
$cs close
$s close
set buf
} -result {hello}
test socket-1.5 {unix.dgram} -body {
set path [file tempfile]
file delete $path
set s [socket unix.dgram.server $path]
set c [socket unix.dgram [$s sockname]]
$s buffering none
$c buffering none
$c puts -nonewline hello
set buf [$s recv 1000]
$s close
$c close
set buf
} -result {hello}
test socket-1.6 {pipe} -body {
lassign [socket pipe] r w
stdout flush
if {[os.fork] == 0} {
$r close
$w puts hello
$w close
exit 99
}
$w close
$r gets buf
$r close
set buf
} -result {hello}
test socket-1.7 {socketpair} -body {
lassign [socket pair] s1 s2
stdout flush
if {[os.fork] == 0} {
$s1 close
# Read data and send it back
$s2 gets buf
$s2 puts $buf
$s2 close
exit 99
}
$s2 close
$s1 puts hello
$s1 gets buf
$s1 close
set buf
} -result {hello}
test socket-1.8 {stream - ipv6} -constraints ipv6 -body {
# Let the system choose a port
set s [socket -ipv6 stream.server {[::1]:0}]
stdout flush
if {[os.fork] == 0} {
# child
set c [socket -ipv6 stream [$s sockname]]
$s close
$c puts hello
$c close
exit 99
}
set cs [$s accept]
$cs gets buf
$cs close
$s close
set buf
} -result {hello}
test socket-1.9 {dgram - ipv6 - unconnected} -constraints ipv6 -body {
# Let the system choose a port
set s [socket -ipv6 dgram.server {[::1]:0}]
set c [socket -ipv6 dgram]
$s buffering none
$c buffering none
$c sendto hello [$s sockname]
set buf [$s recv 1000]
$c close
$s close
set buf
} -result {hello}
test socket-1.10 {stream - port only} -body {
set s [socket stream.server 0]
stdout flush
if {[os.fork] == 0} {
# child
set c [socket stream [socket-connect-addr $s]]
$s close
$c puts hello
$c close
exit 99
}
set cs [$s accept]
$cs gets buf
$cs close
$s close
set buf
} -result {hello}
test socket-1.11 {stream - ipv6 - port only} -constraints ipv6 -body {
# Let the system choose a port
set s [socket -ipv6 stream.server 0]
stdout flush
if {[os.fork] == 0} {
# child
set c [socket -ipv6 stream [socket-connect-addr $s]]
$s close
$c puts hello
$c close
exit 99
}
set cs [$s accept]
$cs gets buf
$cs close
$s close
set buf
} -result {hello}
test socket-2.1 {read 1} -body {
lassign [socket pipe] r w
$w puts -nonewline hello
$w close
set chars {}
while {1} {
set c [$r read 1]
if {$c eq ""} {
break
}
lappend chars $c
}
$r close
set chars
} -result {h e l l o}
test socket-2.2 {read to EOF} -body {
lassign [socket pipe] r w
$w puts -nonewline hello
$w close
set buf [$r read]
$r close
set buf
} -result {hello}
test socket-2.3 {read -nonewline} -body {
lassign [socket pipe] r w
$w puts hello
$w close
set buf [$r read -nonewline]
$r close
set buf
} -result {hello}
test socket-2.4 {isatty} -body {
lassign [socket pipe] r w
set result [list [$r isatty] [$w isatty]]
$r close
$w close
set result
} -result {0 0}
test socket-2.5 {peername} -body {
set s [socket stream.server 0]
stdout flush
if {[os.fork] == 0} {
try {
set c [socket stream [socket-connect-addr $s]]
$s close
$c puts [list [$c sockname] [$c peername]]
$c close
} on error msg {
stderr puts $msg
}
exit 99
}
set cs [$s accept]
lassign [$cs gets] c_sockname c_peername
if {$c_sockname ne [$cs peername]} {
error "client sockname=$c_sockname not equal to server peername=[$cs peername]"
}
if {$c_peername ne [$cs sockname]} {
error "client peername=$c_peername not equal to server sockname=[$cs sockname]"
}
$cs close
$s close
} -result {}
test socket-3.1 {listen} {
set s [socket stream.server 0]
$s listen 10
$s close
} {}
test socket-3.2 {listen usage} -body {
set s [socket stream.server 0]
$s listen
} -returnCodes error -match glob -result {wrong # args: should be "* listen backlog"} -cleanup {
$s close
}
test socket-3.3 {listen usage} -body {
set s [socket stream.server 0]
$s listen blah
} -returnCodes error -match glob -result {expected integer but got "blah"} -cleanup {
$s close
}
test socket-3.4 {listen not a socket} -body {
set f [open [info script]]
$f listen 10
} -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup {
$f close
}
test socket-4.1 {invalid ipv6 address} -constraints ipv6 -body {
socket -ipv6 stream "- invalid - address -"
} -returnCodes error -result {Not a valid address: :::- invalid - address -}
test socket-4.2 {invalid ipv4 address} -body {
socket stream {9.9.9.9.9:0}
} -returnCodes error -result {Not a valid address: 9.9.9.9.9:0}
test socket-4.3 {sockname on non-socket} -body {
set f [open [info script]]
$f sockname
} -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup {
$f close
}
test socket-4.4 {peername on non-socket} -body {
set f [open [info script]]
$f peername
} -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup {
$f close
}
# For the eventloop tests, let's set up a client and a server where the client
# simply echos everything back to the server
set s [socket stream.server 0]
if {[os.fork] == 0} {
# child
set c [socket stream [socket-connect-addr $s]]
# Note: We have to disable buffering here, otherwise
# when we read data in $c readable {} we many leave buffered
# data and readable won't retrigger.
$c buffering none
$s close
$c readable {
# when we read we need to also read any pending data,
# otherwise readable won't retrigger
set buf [$c read 1]
if {[string length $buf] == 0} {
incr readdone
$c close
} else {
$c puts -nonewline $buf
}
}
vwait readdone
exit 99
}
# Now set up the server
set cs [$s accept addr]
defer {
$cs close
}
$s close
# At this point, $cs is the server connection to the client in the child process
test eventloop-1.1 {puts/gets} {
$cs puts hello
$cs gets
} hello
test eventloop-1.2 {puts/gets} {
$cs puts -nonewline again
lmap p [range 5] {
set c [$cs read 1]
set c
}
} {a g a i n}
test sockopt-1.1 {sockopt} -body {
lsort [dict keys [$cs sockopt]]
} -match glob -result {*tcp_nodelay*}
test sockopt-1.2 {sockopt set} {
$cs sockopt tcp_nodelay 1
dict get [$cs sockopt] tcp_nodelay
} 1
test sockopt-1.3 {sockopt set invalid} -body {
$cs sockopt tcp_nodelay badbool
} -returnCodes error -result {expected boolean but got "badbool"}
testreport
|