Commit | Line | Data |
4536f655 |
1 | # t/socket/SockFork.pm |
2 | # common code for forked socket tests |
3 | |
4 | package SockFork ; |
5 | |
6 | use strict ; |
7 | |
8 | |
9 | use Stem ; |
10 | use Stem::Socket ; |
11 | |
12 | use Test::More tests => 7 ; |
13 | |
14 | my $self = bless {} ; |
15 | my $pid ; |
16 | my $port = 9000 ; |
17 | my $data = "FOO\n" ; |
18 | |
19 | sub test { |
20 | |
21 | my ( $ssl_client_args, $ssl_server_args ) = @_ ; |
22 | |
23 | my ( @ssl_client_args, @ssl_server_args ) ; |
24 | |
25 | if ( @{$ssl_client_args} ) { |
26 | |
27 | @ssl_client_args = ( 'ssl_args' => $ssl_client_args ) ; |
28 | @ssl_server_args = ( 'ssl_args' => $ssl_server_args ) ; |
29 | } |
30 | |
31 | |
32 | if ( $pid = fork() ) { |
33 | |
34 | sleep 1 ; |
35 | |
36 | $self->{'pid'} = $pid ; |
37 | |
38 | ok( 1, 'parent' ) ; |
39 | |
40 | #print "SSL @ssl_client_args\n" ; |
41 | |
42 | my $connect_sock = Stem::Socket->new( |
43 | 'object' => $self, |
44 | 'port' => $port, |
45 | @ssl_client_args, |
46 | |
47 | ) ; |
48 | |
49 | die $connect_sock unless ref $connect_sock ; |
50 | |
51 | ok( 1, 'created connect event' ) ; |
52 | $self->{'connect_sock'} = $connect_sock ; |
53 | } |
54 | else { |
55 | |
56 | my $listen_sock = Stem::Socket->new( |
57 | 'object' => $self, |
58 | 'port' => $port, |
59 | 'server' => 1, |
60 | 'method' => 'accepted', |
61 | @ssl_server_args |
62 | ) ; |
63 | |
64 | die $listen_sock unless ref $listen_sock ; |
65 | $self->{'listen_sock'} = $listen_sock ; |
66 | } |
67 | |
68 | Stem::Event::start_loop() ; |
69 | |
70 | ok( 1, 'event loop exit' ) ; |
71 | } |
72 | |
73 | sub connected { |
74 | |
75 | my( $self, $client_sock ) = @_ ; |
76 | |
77 | #print "CLIENT [$client_sock]\n" ; |
78 | |
79 | ok( 1, 'connected' ) ; |
80 | |
81 | $self->{'client_sock'} = $client_sock ; |
82 | |
83 | my $wcnt = $client_sock->syswrite( $data ) ; |
84 | |
85 | #print "WCNT [$wcnt] $!\n" ; |
86 | |
87 | my $client_read_event = Stem::Event::Read->new( |
88 | 'object' => $self, |
89 | 'fh' => $client_sock, |
90 | 'method' => 'client_readable', |
91 | ) ; |
92 | |
93 | ok( $client_read_event, 'created client read event' ) ; |
94 | |
95 | $self->{'client_read_event'} = $client_read_event ; |
96 | } |
97 | |
98 | sub client_readable { |
99 | |
100 | my( $self ) = @_ ; |
101 | |
102 | ok( 1, 'client readable' ) ; |
103 | |
104 | my $buf ; |
105 | |
106 | my $client_sock = $self->{'client_sock'} ; |
107 | |
108 | my $cnt = $client_sock->sysread( $buf, 100 ) ; |
109 | |
110 | is( $buf, "[$data]", 'client read data' ) ; |
111 | |
112 | #print "CLIENT READ $cnt [$buf]\n" ; |
113 | |
114 | $self->{'connect_sock'}->shut_down() ; |
115 | $self->{'client_read_event'}->cancel() ; |
116 | } |
117 | |
118 | sub accepted { |
119 | |
120 | my( $self, $accepted_sock ) = @_ ; |
121 | |
122 | $self->{'accepted_sock'} = $accepted_sock ; |
123 | |
124 | $self->{'listen_sock'}->shut_down() ; |
125 | |
126 | my $server_read_event = Stem::Event::Read->new( |
127 | 'object' => $self, |
128 | 'fh' => $accepted_sock, |
129 | 'method' => 'server_readable', |
130 | ) ; |
131 | |
132 | $self->{'server_read_event'} = $server_read_event ; |
133 | } |
134 | |
135 | sub server_readable { |
136 | |
137 | my( $self ) = @_ ; |
138 | |
139 | my $accepted_sock = $self->{'accepted_sock'} ; |
140 | |
141 | my $cnt = $accepted_sock->sysread( my $buf, 100 ) ; |
142 | |
143 | $accepted_sock->syswrite( "[$buf]" ) ; |
144 | |
145 | # exit forked child |
146 | |
147 | exit ; |
148 | } |
149 | |
150 | 1 ; |