Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 111 lines (91 sloc) 4.084 kb
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
1 use v6;
2 use Test;
3
4 plan 3;
5
6 # Testing socket must solve 2 problems: find an unused port to bind to,
7 # and fork a client process before the server is blocked in accept().
8
9 my $host = '127.0.0.1'; # or 'localhost' may be friendlier
10
11 # To find an free port, list the ports currently in use.
12 my ( $host, @ports, $netstat_cmd, $netstat_pat, $received, $expected );
13 given $*OS {
14 when 'linux' {
15 $netstat_cmd = "netstat --tcp --all --numeric";
16 $netstat_pat = regex { State .+? [ ^^ .+? ':' (\d+) .+? ]+ $ };
17 }
18 when 'darwin' {
19 $netstat_cmd = "netstat -f inet -p tcp -a -n";
20 $netstat_pat = regex { [ ^^ .+? <dot> (\d+) <.sp> .+? ]+ $ };
21 }
22 # TODO: when 'Win32' etc.
23 }
24 #$received = slurp( '/home/martin/osx-netstat' );
25 $received = fake_qx( $netstat_cmd ); # refactor into 1 line after
26 if $received ~~ $netstat_pat { @ports = $/[]; } # development complete
27 warn @ports.elems ~ " PORTS=" ~ @ports;
28
29 exit(1);
30
31 # sequentially search for the first unused port
32 my $port = 1024;
33 while $port < 65535 && $port==any(@ports) { $port++; }
34 if $port > 65535 { die "no free port"; }
35 # warn "CHOSEN PORT $port";
36
37 # test 1 creates a TCP socket but does not use it.
38 constant PF_INET = 2; # these should move into a file,
39 constant SOCK_STREAM = 1; # but what name and directory?
40 constant TCP = 6;
41 my $server = IO::Socket::INET.socket( PF_INET, SOCK_STREAM, TCP );
42 isa_ok $server, IO::Socket::INET;
43 # Do not bind to this socket in the parent process, that would prevent a
44 # child process from using it.
45
46 #
47 if $*OS eq any <linux darwin> { # please add more valid OS names
48
49 # test 2 does echo protocol - Internet RFC 862
50 $received = fake_qx( "sh t/spec/S32-io/IO-Socket-INET.sh 2 $port" );
51 #warn "TEST 2 $received";
52 $expected = "echo '0123456789abcdefghijklmnopqrstuvwxyz' received\n";
53 is $received, $expected, "echo server and client";
54
55 # test 3 does discard protocol - Internet RFC 863
56 $received = fake_qx( "sh t/spec/S32-io/IO-Socket-INET.sh 3 $port" );
57 #warn "TEST 3 $received";
58 $expected = "discard '' received\n";
59 is $received, $expected, "discard server and client";
60 }
61 else {
62 # eg Win32 shell script needs writing
63 skip 1, "OS '$*OS' shell support not confirmed";
64 }
65
66 # inefficient workaround - remove when Rakudo gets a qx operator
67 sub fake_qx( $command ) {
68 my $tempfile = "/tmp/rakudo_httpd_qx.tmp";
69 my $fullcommand = "$command >$tempfile";
70 run $fullcommand;
71 my $result = slurp( $tempfile );
72 unlink $tempfile;
73 return $result;
74 }
75
76 =begin pod
77
78 =head1 Perl 6 Internet Sockets Testing
79 The initial use of the BSD Sockets library by Parrot and Rakudo happened
80 without a formal test suite, slowing development and causing occasional
81 random errors. This set of tests aims to ensure the future stability of
82 of the Sockets library integration, and to help enhance Rakudo's
83 IO::Socket::INET class in the 'setting'.
84
85 The BSD Sockets functions provide server and client functions that run
86 synchronously, blocking and waiting indefinitely for communication from
87 a remote process. Sockets testing therefore requires separate server and
88 client processes or threads. Rakudo does not currently fork or thread,
89 so these tests employ a unix shell script that uses the & symbol to fork
90 background processes. When Rakudo starts forking or threading, this
91 testing solution should be refactored down to just the main script.
92
93 =head1 Scope of tests
94 To date, only single TCP sessions have been tested, and only on Linux.
95 The Internet standard protocols are used, except that a dynamic port
96 number above the first 1024 is used so that superuser (root) privileges
97 are not required. Execution time is 5 to 10 seconds.
98
99 =head1 TODO
100 UDP. Unix sockets. Concurrent connections (needs threads).
101
102 =head1 SEE ALSO
103
104 echo L<http://www.ietf.org/rfc/rfc862.txt> port 7
105 discard L<http://www.ietf.org/rfc/rfc863.txt> port 9
106 chargen L<http://www.ietf.org/rfc/rfc864.txt> port 19
107 daytime L<http://www.ietf.org/rfc/rfc867.txt> port 13
108 time L<http://www.ietf.org/rfc/rfc868.txt> port 37
109
110 =end pod
Something went wrong with that request. Please try again.