1 |
root |
1.1 |
#!/usr/bin/perl |
2 |
|
|
|
3 |
|
|
use Test::More qw(no_plan); |
4 |
|
|
|
5 |
|
|
use strict qw(vars subs); |
6 |
|
|
|
7 |
|
|
use AnyEvent::Socket; |
8 |
|
|
use AnyEvent::Handle; |
9 |
|
|
|
10 |
|
|
{ |
11 |
|
|
my $ctx = AnyEvent::Handle::TLS_CTX; |
12 |
|
|
Net::SSLeay::CTX_use_certificate_chain_file ($ctx, $0) |
13 |
|
|
or die "unable to set certificate chain file"; |
14 |
|
|
Net::SSLeay::CTX_use_PrivateKey_file ($ctx, $0, Net::SSLeay::FILETYPE_PEM ()) |
15 |
|
|
or die "unable to set private key file"; |
16 |
|
|
} |
17 |
|
|
|
18 |
|
|
for my $mode (1..5) { |
19 |
|
|
my $server_done = AnyEvent->condvar; |
20 |
|
|
my $client_done = AnyEvent->condvar; |
21 |
|
|
|
22 |
|
|
my $server_port = AnyEvent->condvar; |
23 |
|
|
|
24 |
|
|
tcp_server "127.0.0.1", undef, sub { |
25 |
|
|
my ($fh, $host, $port) = @_; |
26 |
|
|
|
27 |
|
|
die unless $host eq "127.0.0.1"; |
28 |
|
|
|
29 |
|
|
ok (1, "server_connect $mode"); |
30 |
|
|
|
31 |
|
|
my $hd; $hd = new AnyEvent::Handle |
32 |
|
|
tls => "accept", |
33 |
|
|
fh => $fh, |
34 |
|
|
timeout => 8, |
35 |
|
|
on_error => sub { |
36 |
|
|
ok (0, "server_error <$!>"); |
37 |
|
|
$server_done->send; undef $hd; |
38 |
|
|
}, |
39 |
|
|
on_eof => sub { |
40 |
|
|
ok (1, "server_eof"); |
41 |
|
|
$server_done->send; undef $hd; |
42 |
|
|
}; |
43 |
|
|
|
44 |
|
|
if ($mode == 1) { |
45 |
|
|
$hd->push_read (line => sub { |
46 |
|
|
ok ($_[1] eq "1", "line 1 <$_[1]>"); |
47 |
|
|
}); |
48 |
|
|
} elsif ($mode == 2) { |
49 |
|
|
$hd->push_write ("2\n"); |
50 |
|
|
$hd->on_drain (sub { |
51 |
|
|
ok (1, "server_drain"); |
52 |
|
|
$server_done->send; undef $hd; |
53 |
|
|
}); |
54 |
|
|
} elsif ($mode == 3) { |
55 |
|
|
$hd->push_read (line => sub { |
56 |
|
|
ok ($_[1] eq "3", "line 3 <$_[1]>"); |
57 |
|
|
$hd->push_write ("4\n"); |
58 |
|
|
$hd->on_drain (sub { |
59 |
|
|
ok (1, "server_drain"); |
60 |
|
|
$server_done->send; undef $hd; |
61 |
|
|
}); |
62 |
|
|
}); |
63 |
|
|
} elsif ($mode == 4) { |
64 |
|
|
$hd->push_write ("5\n"); |
65 |
|
|
$hd->push_read (line => sub { |
66 |
|
|
ok ($_[1] eq "6", "line 6 <$_[1]>"); |
67 |
|
|
}); |
68 |
|
|
} elsif ($mode == 5) { |
69 |
|
|
$hd->on_read (sub { |
70 |
|
|
ok (1, "on_read"); |
71 |
|
|
$hd->push_read (line => sub { |
72 |
|
|
my $len = $_[1]; |
73 |
|
|
ok (1, "push_read $len"); |
74 |
|
|
$hd->push_read (packstring => "N", sub { |
75 |
|
|
ok ($len == length $_[1], "block server $len"); |
76 |
|
|
$hd->push_write ("$len\n"); |
77 |
|
|
$hd->push_write (packstring => "N", $_[1]); |
78 |
|
|
}); |
79 |
|
|
}); |
80 |
|
|
}); |
81 |
|
|
} |
82 |
|
|
|
83 |
|
|
}, sub { |
84 |
|
|
$server_port->send ($_[2]); |
85 |
|
|
}; |
86 |
|
|
|
87 |
|
|
tcp_connect "localhost", $server_port->recv, sub { |
88 |
|
|
my ($fh) = @_; |
89 |
|
|
|
90 |
|
|
ok (1, "client_connect $mode"); |
91 |
|
|
|
92 |
|
|
my $hd; $hd = new AnyEvent::Handle |
93 |
|
|
tls => "connect", |
94 |
|
|
fh => $fh, |
95 |
|
|
timeout => 8, |
96 |
|
|
on_error => sub { |
97 |
|
|
ok (0, "client_error <$!>"); |
98 |
|
|
$client_done->send; undef $hd; |
99 |
|
|
}, |
100 |
|
|
on_eof => sub { |
101 |
|
|
ok (1, "client_eof"); |
102 |
|
|
$client_done->send; undef $hd; |
103 |
|
|
}; |
104 |
|
|
|
105 |
|
|
if ($mode == 1) { |
106 |
|
|
$hd->push_write ("1\n"); |
107 |
|
|
$hd->on_drain (sub { |
108 |
|
|
ok (1, "client_drain"); |
109 |
|
|
$client_done->send; undef $hd; |
110 |
|
|
}); |
111 |
|
|
} elsif ($mode == 2) { |
112 |
|
|
$hd->push_read (line => sub { |
113 |
|
|
ok ($_[1] eq "2", "line 2 <$_[1]>"); |
114 |
|
|
}); |
115 |
|
|
} elsif ($mode == 3) { |
116 |
|
|
$hd->push_write ("3\n"); |
117 |
|
|
$hd->push_read (line => sub { |
118 |
|
|
ok ($_[1] eq "4", "line 4 <$_[1]>"); |
119 |
|
|
}); |
120 |
|
|
} elsif ($mode == 4) { |
121 |
|
|
$hd->push_read (line => sub { |
122 |
|
|
ok ($_[1] eq "5", "line 5 <$_[1]>"); |
123 |
|
|
$hd->push_write ("6\n"); |
124 |
|
|
$hd->on_drain (sub { |
125 |
|
|
ok (1, "client_drain"); |
126 |
|
|
$client_done->send; undef $hd; |
127 |
|
|
}); |
128 |
|
|
}); |
129 |
|
|
} elsif ($mode == 5) { |
130 |
|
|
# some randomly-sized blocks |
131 |
|
|
srand 0; |
132 |
|
|
my $cnt = 64; |
133 |
|
|
my $block; $block = sub { |
134 |
|
|
my $len = (16 << int rand 14) - 16 + int rand 32; |
135 |
|
|
ok (1, "write $len"); |
136 |
|
|
$hd->push_write ("$len\n"); |
137 |
|
|
$hd->push_write (packstring => "N", "\x00" x $len); |
138 |
|
|
}; |
139 |
|
|
|
140 |
|
|
for my $i (1..$cnt) { |
141 |
|
|
$hd->push_read (line => sub { |
142 |
|
|
my $len = $_[1]; |
143 |
|
|
ok (1, "client block $len/1"); |
144 |
|
|
$hd->unshift_read (packstring => "N", sub { |
145 |
|
|
ok ($len == length $_[1], "client block $len/2"); |
146 |
|
|
|
147 |
|
|
if ($i != $cnt) { |
148 |
|
|
$block->(); |
149 |
|
|
} else { |
150 |
|
|
ok (1, "client_drain"); |
151 |
|
|
$client_done->send; undef $hd; |
152 |
|
|
} |
153 |
|
|
}); |
154 |
|
|
}); |
155 |
|
|
} |
156 |
|
|
|
157 |
|
|
$block->(); |
158 |
|
|
} |
159 |
|
|
}; |
160 |
|
|
|
161 |
|
|
$server_done->recv; |
162 |
|
|
$client_done->recv; |
163 |
|
|
} |
164 |
|
|
|
165 |
|
|
__END__ |
166 |
|
|
-----BEGIN CERTIFICATE----- |
167 |
|
|
MIIDJjCCAtCgAwIBAgIJAJ3NPnD6z5+2MA0GCSqGSIb3DQEBBQUAMIGWMQswCQYD |
168 |
|
|
VQQGEwJYTjETMBEGA1UECBMKU29tZS1TdGF0ZTESMBAGA1UEBxMJU29tZS1DaXR5 |
169 |
|
|
MRUwEwYDVQQKEwxTb21lLUNvbXBhbnkxEjAQBgNVBAsTCVNvbWUtVW5pdDEQMA4G |
170 |
|
|
A1UEAxMHU29tZS1DTjEhMB8GCSqGSIb3DQEJARYSc29tZUBlbWFpbC5pbnZhbGlk |
171 |
|
|
MB4XDTA4MTAwMTA3NDk1OFoXDTM5MDMwODA3NDk1OFowgZYxCzAJBgNVBAYTAlhO |
172 |
|
|
MRMwEQYDVQQIEwpTb21lLVN0YXRlMRIwEAYDVQQHEwlTb21lLUNpdHkxFTATBgNV |
173 |
|
|
BAoTDFNvbWUtQ29tcGFueTESMBAGA1UECxMJU29tZS1Vbml0MRAwDgYDVQQDEwdT |
174 |
|
|
b21lLUNOMSEwHwYJKoZIhvcNAQkBFhJzb21lQGVtYWlsLmludmFsaWQwXDANBgkq |
175 |
|
|
hkiG9w0BAQEFAANLADBIAkEAvdBuyGvUQ2YDMfEhEi9Rogbz48KNzvF1csGb5qwE |
176 |
|
|
8y7QA9BVBclFMvcO55FQHnWECBI+DNKeP6vJlXN1wMRH5QIDAQABo4H+MIH7MB0G |
177 |
|
|
A1UdDgQWBBScspJuXxPCTlFAyiMeXa6j/zW8ATCBywYDVR0jBIHDMIHAgBScspJu |
178 |
|
|
XxPCTlFAyiMeXa6j/zW8AaGBnKSBmTCBljELMAkGA1UEBhMCWE4xEzARBgNVBAgT |
179 |
|
|
ClNvbWUtU3RhdGUxEjAQBgNVBAcTCVNvbWUtQ2l0eTEVMBMGA1UEChMMU29tZS1D |
180 |
|
|
b21wYW55MRIwEAYDVQQLEwlTb21lLVVuaXQxEDAOBgNVBAMTB1NvbWUtQ04xITAf |
181 |
|
|
BgkqhkiG9w0BCQEWEnNvbWVAZW1haWwuaW52YWxpZIIJAJ3NPnD6z5+2MAwGA1Ud |
182 |
|
|
EwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADQQA48HjY23liyBMmh3cNo9TC+/bu/G3E |
183 |
|
|
oT5npm3+Lh6VA/4kKMyMu2mP31BToTZfl7vUcBJCQBhPFYOiPd/HnwzW |
184 |
|
|
-----END CERTIFICATE----- |
185 |
|
|
-----BEGIN RSA PRIVATE KEY----- |
186 |
|
|
MIIBOwIBAAJBAL3Qbshr1ENmAzHxIRIvUaIG8+PCjc7xdXLBm+asBPMu0APQVQXJ |
187 |
|
|
RTL3DueRUB51hAgSPgzSnj+ryZVzdcDER+UCAwEAAQJAGRftDWHz9dUOpxORo63N |
188 |
|
|
xPXWWE3oIWuac0lVKvGi1eMoI4UCW/Y7qM4rXsUXqasUo3mxV24+QqJHDQid1qi6 |
189 |
|
|
AQIhAN5BtiqfjFjb97uUbdE6aiqE+nSG0eXlkeHKNpBNtiUxAiEA2qHNZ5fcQTqT |
190 |
|
|
4qlnYhbI+g6bTwuR7QnzzGTlHUGxsPUCIQDLfvTw37Zb4cNYb1WBPW/ZUHoU2SAz |
191 |
|
|
01cXmdMNmumL8QIhAJMGTENl9FBJPDopAcUM3YqLWBYICdIF51WEZC8QhpYhAiBe |
192 |
|
|
KcoNT51hv3pKK8oZtPJGsKFjmGVVnZeNNzyQmt/YWw== |
193 |
|
|
-----END RSA PRIVATE KEY----- |
194 |
|
|
|
195 |
|
|
|
196 |
|
|
|