1 |
root |
1.1 |
#!/usr/bin/perl |
2 |
|
|
|
3 |
root |
1.7 |
BEGIN { eval "use Net::SSLeay 1.33 (); 1" or ((print "1..0 # SKIP no usable Net::SSLeay\n"), exit 0) } |
4 |
root |
1.5 |
|
5 |
root |
1.8 |
use Test::More tests => 415; |
6 |
root |
1.1 |
|
7 |
root |
1.8 |
no warnings; |
8 |
root |
1.1 |
use strict qw(vars subs); |
9 |
|
|
|
10 |
|
|
use AnyEvent::Socket; |
11 |
|
|
use AnyEvent::Handle; |
12 |
root |
1.3 |
use AnyEvent::TLS; |
13 |
root |
1.1 |
|
14 |
root |
1.3 |
my $ctx = new AnyEvent::TLS cert_file => $0; |
15 |
root |
1.1 |
|
16 |
|
|
for my $mode (1..5) { |
17 |
root |
1.8 |
ok (1, "mode $mode"); |
18 |
|
|
|
19 |
root |
1.1 |
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 |
root |
1.3 |
tls_ctx => $ctx, |
34 |
root |
1.1 |
fh => $fh, |
35 |
|
|
timeout => 8, |
36 |
|
|
on_error => sub { |
37 |
|
|
ok (0, "server_error <$!>"); |
38 |
|
|
$server_done->send; undef $hd; |
39 |
|
|
}, |
40 |
|
|
on_eof => sub { |
41 |
|
|
ok (1, "server_eof"); |
42 |
|
|
$server_done->send; undef $hd; |
43 |
|
|
}; |
44 |
|
|
|
45 |
|
|
if ($mode == 1) { |
46 |
|
|
$hd->push_read (line => sub { |
47 |
|
|
ok ($_[1] eq "1", "line 1 <$_[1]>"); |
48 |
|
|
}); |
49 |
|
|
} elsif ($mode == 2) { |
50 |
|
|
$hd->push_write ("2\n"); |
51 |
|
|
$hd->on_drain (sub { |
52 |
|
|
ok (1, "server_drain"); |
53 |
|
|
$server_done->send; undef $hd; |
54 |
|
|
}); |
55 |
|
|
} elsif ($mode == 3) { |
56 |
|
|
$hd->push_read (line => sub { |
57 |
|
|
ok ($_[1] eq "3", "line 3 <$_[1]>"); |
58 |
|
|
$hd->push_write ("4\n"); |
59 |
|
|
$hd->on_drain (sub { |
60 |
|
|
ok (1, "server_drain"); |
61 |
|
|
$server_done->send; undef $hd; |
62 |
|
|
}); |
63 |
|
|
}); |
64 |
|
|
} elsif ($mode == 4) { |
65 |
|
|
$hd->push_write ("5\n"); |
66 |
|
|
$hd->push_read (line => sub { |
67 |
|
|
ok ($_[1] eq "6", "line 6 <$_[1]>"); |
68 |
|
|
}); |
69 |
|
|
} elsif ($mode == 5) { |
70 |
|
|
$hd->on_read (sub { |
71 |
|
|
ok (1, "on_read"); |
72 |
|
|
$hd->push_read (line => sub { |
73 |
|
|
my $len = $_[1]; |
74 |
|
|
ok (1, "push_read $len"); |
75 |
|
|
$hd->push_read (packstring => "N", sub { |
76 |
|
|
ok ($len == length $_[1], "block server $len"); |
77 |
|
|
$hd->push_write ("$len\n"); |
78 |
|
|
$hd->push_write (packstring => "N", $_[1]); |
79 |
|
|
}); |
80 |
|
|
}); |
81 |
|
|
}); |
82 |
|
|
} |
83 |
|
|
|
84 |
|
|
}, sub { |
85 |
|
|
$server_port->send ($_[2]); |
86 |
|
|
}; |
87 |
|
|
|
88 |
root |
1.6 |
my $hd; $hd = new AnyEvent::Handle |
89 |
root |
1.9 |
connect => ["127.0.0.1", $server_port->recv], |
90 |
root |
1.6 |
tls => "connect", |
91 |
|
|
tls_ctx => $ctx, |
92 |
|
|
timeout => 8, |
93 |
|
|
on_connect => sub { |
94 |
|
|
ok (1, "client_connect $mode"); |
95 |
|
|
}, |
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 |
root |
1.1 |
$hd->on_drain (sub { |
125 |
|
|
ok (1, "client_drain"); |
126 |
|
|
$client_done->send; undef $hd; |
127 |
|
|
}); |
128 |
root |
1.6 |
}); |
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 |
root |
1.1 |
$hd->push_read (line => sub { |
142 |
root |
1.8 |
my ($i, $cnt, $block) = ($i, $cnt, $block); # 5.8.9. bug workaround |
143 |
root |
1.6 |
my $len = $_[1]; |
144 |
|
|
ok (1, "client block $len/1"); |
145 |
|
|
$hd->unshift_read (packstring => "N", sub { |
146 |
|
|
ok ($len == length $_[1], "client block $len/2"); |
147 |
|
|
|
148 |
|
|
if ($i != $cnt) { |
149 |
|
|
$block->(); |
150 |
|
|
} else { |
151 |
root |
1.8 |
ok (1, "client_drain 5"); |
152 |
root |
1.6 |
$client_done->send; undef $hd; |
153 |
|
|
} |
154 |
root |
1.1 |
}); |
155 |
|
|
}); |
156 |
root |
1.6 |
} |
157 |
root |
1.1 |
|
158 |
root |
1.6 |
$block->(); |
159 |
|
|
} |
160 |
root |
1.1 |
|
161 |
|
|
$server_done->recv; |
162 |
|
|
$client_done->recv; |
163 |
|
|
} |
164 |
|
|
|
165 |
|
|
__END__ |
166 |
root |
1.3 |
-----BEGIN RSA PRIVATE KEY----- |
167 |
|
|
MIIBOwIBAAJBAL3Qbshr1ENmAzHxIRIvUaIG8+PCjc7xdXLBm+asBPMu0APQVQXJ |
168 |
|
|
RTL3DueRUB51hAgSPgzSnj+ryZVzdcDER+UCAwEAAQJAGRftDWHz9dUOpxORo63N |
169 |
|
|
xPXWWE3oIWuac0lVKvGi1eMoI4UCW/Y7qM4rXsUXqasUo3mxV24+QqJHDQid1qi6 |
170 |
|
|
AQIhAN5BtiqfjFjb97uUbdE6aiqE+nSG0eXlkeHKNpBNtiUxAiEA2qHNZ5fcQTqT |
171 |
|
|
4qlnYhbI+g6bTwuR7QnzzGTlHUGxsPUCIQDLfvTw37Zb4cNYb1WBPW/ZUHoU2SAz |
172 |
|
|
01cXmdMNmumL8QIhAJMGTENl9FBJPDopAcUM3YqLWBYICdIF51WEZC8QhpYhAiBe |
173 |
|
|
KcoNT51hv3pKK8oZtPJGsKFjmGVVnZeNNzyQmt/YWw== |
174 |
|
|
-----END RSA PRIVATE KEY----- |
175 |
root |
1.1 |
-----BEGIN CERTIFICATE----- |
176 |
|
|
MIIDJjCCAtCgAwIBAgIJAJ3NPnD6z5+2MA0GCSqGSIb3DQEBBQUAMIGWMQswCQYD |
177 |
|
|
VQQGEwJYTjETMBEGA1UECBMKU29tZS1TdGF0ZTESMBAGA1UEBxMJU29tZS1DaXR5 |
178 |
|
|
MRUwEwYDVQQKEwxTb21lLUNvbXBhbnkxEjAQBgNVBAsTCVNvbWUtVW5pdDEQMA4G |
179 |
|
|
A1UEAxMHU29tZS1DTjEhMB8GCSqGSIb3DQEJARYSc29tZUBlbWFpbC5pbnZhbGlk |
180 |
|
|
MB4XDTA4MTAwMTA3NDk1OFoXDTM5MDMwODA3NDk1OFowgZYxCzAJBgNVBAYTAlhO |
181 |
|
|
MRMwEQYDVQQIEwpTb21lLVN0YXRlMRIwEAYDVQQHEwlTb21lLUNpdHkxFTATBgNV |
182 |
|
|
BAoTDFNvbWUtQ29tcGFueTESMBAGA1UECxMJU29tZS1Vbml0MRAwDgYDVQQDEwdT |
183 |
|
|
b21lLUNOMSEwHwYJKoZIhvcNAQkBFhJzb21lQGVtYWlsLmludmFsaWQwXDANBgkq |
184 |
|
|
hkiG9w0BAQEFAANLADBIAkEAvdBuyGvUQ2YDMfEhEi9Rogbz48KNzvF1csGb5qwE |
185 |
|
|
8y7QA9BVBclFMvcO55FQHnWECBI+DNKeP6vJlXN1wMRH5QIDAQABo4H+MIH7MB0G |
186 |
|
|
A1UdDgQWBBScspJuXxPCTlFAyiMeXa6j/zW8ATCBywYDVR0jBIHDMIHAgBScspJu |
187 |
|
|
XxPCTlFAyiMeXa6j/zW8AaGBnKSBmTCBljELMAkGA1UEBhMCWE4xEzARBgNVBAgT |
188 |
|
|
ClNvbWUtU3RhdGUxEjAQBgNVBAcTCVNvbWUtQ2l0eTEVMBMGA1UEChMMU29tZS1D |
189 |
|
|
b21wYW55MRIwEAYDVQQLEwlTb21lLVVuaXQxEDAOBgNVBAMTB1NvbWUtQ04xITAf |
190 |
|
|
BgkqhkiG9w0BCQEWEnNvbWVAZW1haWwuaW52YWxpZIIJAJ3NPnD6z5+2MAwGA1Ud |
191 |
|
|
EwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADQQA48HjY23liyBMmh3cNo9TC+/bu/G3E |
192 |
|
|
oT5npm3+Lh6VA/4kKMyMu2mP31BToTZfl7vUcBJCQBhPFYOiPd/HnwzW |
193 |
|
|
-----END CERTIFICATE----- |
194 |
|
|
|
195 |
|
|
|
196 |
|
|
|