-
Notifications
You must be signed in to change notification settings - Fork 135
/
IO-Socket-INET.t
167 lines (144 loc) · 6.32 KB
/
IO-Socket-INET.t
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
use v6;
use Test;
plan 18;
# L<S32::IO/IO::Socket::INET>
# Testing socket must solve 2 problems: find an unused port to bind to,
# and fork a client process before the server is blocked in accept().
my $host = '127.0.0.1'; # or 'localhost' may be friendlier
# To find an free port, list the ports currently in use.
my ( @ports, $netstat_cmd, $netstat_pat, $received, $expected );
given $*OS {
when 'linux' {
$netstat_cmd = "netstat --tcp --all --numeric";
$netstat_pat = regex { State .+? [ ^^ .+? ':' (\d+) .+? ]+ $ };
}
when 'darwin' {
$netstat_cmd = "netstat -f inet -p tcp -a -n";
$netstat_pat = regex { [ ^^ .+? '.' (\d+) ' ' .+? ]+ $ };
}
when 'solaris' {
$netstat_cmd = "netstat -an -P tcp -f inet";
$netstat_pat = regex { [ ^^ .+? '.' (\d+) ' ' .+? ]+ $ }; # same as darwin
}
when 'MSWin32' {
$netstat_cmd = "netstat -n";
$netstat_pat = regex { State .+? [ ^^ .+? ':' (\d+) .+? ]+ $ }; # same as linux
}
default {
skip_rest('Operating system not yet supported');
exit 0;
}
# TODO: other operating systems; *BSD etc.
}
$received = qqx{$netstat_cmd}; # refactor into 1 line after
if $received ~~ $netstat_pat { @ports = $/.list; } # development complete
# was @ports = $/[] in Rakudo/alpha
# @ports = $/[0] also now in master
#warn @ports.elems ~ " PORTS=" ~ @ports;
# sequentially search for the first unused port
my $port = 1024;
while $port < 65535 && $port==any(@ports) { $port++; }
if $port > 65535 {
diag "no free port; abortin";
skip_rest 'No port free - cannot test';
exit 0;
}
diag "Testing on port $port";
# test 1 creates a TCP socket but does not use it.
# use Perl 5 style subs for constants until 'constant' works again
sub PF_INET { 2 } # constant PF_INET = 2; # these should move into a file,
sub SOCK_STREAM { 1 } # constant SOCK_STREAM = 1; # but what name and directory?
sub TCP { 6 } # constant TCP = 6;
my $server = IO::Socket::INET.socket( PF_INET, SOCK_STREAM, TCP );
isa_ok $server, IO::Socket::INET;
# Do not bind to this socket in the parent process, that would prevent a
# child process from using it.
if $*OS eq any <linux darwin solaris MSWin32> { # please add more valid OS names
my $is-win;
$is-win = True if $*OS eq 'MSWin32';
# test 2 does echo protocol - Internet RFC 862
if $is-win {
$received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 2 $port};
} else {
$received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 2 $port};
}
#warn "TEST 2 $received";
$expected = "echo '0123456789abcdefghijklmnopqrstuvwxyz' received\n";
is $received, $expected, "echo server and client";
# test 3 does discard protocol - Internet RFC 863
if $is-win {
$received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 3 $port};
} else {
$received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 3 $port};
}
#warn "TEST 3 $received";
$expected = "discard '' received\n";
is $received, $expected, "discard server and client";
#?rakudo 8 skip
# test 4 tests recv with a parameter
if $is-win {
$received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 4 $port};
} else {
$received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 4 $port};
}
$expected = $received.split("\n");
my $i = 0;
is $expected[$i++], '0123456', 'received first 7 characters';
is $expected[$i++], '789', 'received next 3 characters';
is $expected[$i++], 'abcdefghijklmnopqrstuvwxyz', 'remaining 26 were buffered';
# Multibyte characters
is $expected[$i++], chr(0xbeef), "received {chr 0xbeef}";
is $expected[$i++], 3, '... which is 3 bytes';
is $expected[$i++], 2, 'received 2 bytes of a 3 byte unicode character';
is $expected[$i++], chr(0xbabe), "combined the bytes form {chr 0xbabe}";
is $expected[$i++], 3, '... which is 3 bytes';
#?rakudo 7 skip
# test 5 tests get()
if $is-win {
$received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 5 $port};
} else {
$received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 5 $port};
}
$expected = $received.split("\n");
$i = 0;
is $expected[$i++], "'Twas brillig, and the slithy toves",
'get() with default separator';
is $expected[$i++], 'Did gyre and gimble in the wabe;', 'default separator';
is $expected[$i++], 'All mimsy were the borogoves,', '\r\n separator';
is $expected[$i++], 'And the mome raths outgrabe', '. as a separator';
is $expected[$i++], 'O frabjous day', '! separator not at end of string';
is $expected[$i++], ' Callooh', 'Multiple separators not at end of string';
is $expected[$i++], ' Callay', '! separator at end of string';
}
else {
skip 1, "OS '$*OS' shell support not confirmed";
}
=begin pod
=head1 Perl 6 Internet Sockets Testing
The initial use of the BSD Sockets library by Parrot and Rakudo happened
without a formal test suite, slowing development and causing occasional
random errors. This set of tests aims to ensure the future stability of
of the Sockets library integration, and to help enhance Rakudo's
IO::Socket::INET class in the 'setting'.
The BSD Sockets functions provide server and client functions that run
synchronously, blocking and waiting indefinitely for communication from
a remote process. Sockets testing therefore requires separate server and
client processes or threads. Rakudo does not currently fork or thread,
so these tests employ a unix shell script that uses the & symbol to fork
background processes. When Rakudo starts forking or threading, this
testing solution should be refactored down to just the main script.
=head1 Scope of tests
To date, only single TCP sessions have been tested, and only on Linux.
The Internet standard protocols are used, except that a dynamic port
number above the first 1024 is used so that superuser (root) privileges
are not required. Execution time is 5 to 10 seconds.
=head1 TODO
UDP. Unix sockets. Concurrent connections (needs threads).
=head1 SEE ALSO
echo L<http://www.ietf.org/rfc/rfc862.txt> port 7
discard L<http://www.ietf.org/rfc/rfc863.txt> port 9
chargen L<http://www.ietf.org/rfc/rfc864.txt> port 19
daytime L<http://www.ietf.org/rfc/rfc867.txt> port 13
time L<http://www.ietf.org/rfc/rfc868.txt> port 37
=end pod
# vim: ft=perl6