1 | #!/usr/bin/perl |
1 | #!/usr/bin/perl |
2 | |
2 | |
3 | use Test::More qw(no_plan); |
3 | BEGIN { eval "use Net::SSLeay 1.33 (); 1" or ((print "1..0 # SKIP no usable Net::SSLeay\n"), exit 0) } |
4 | |
4 | |
|
|
5 | use Test::More tests => 415; |
|
|
6 | |
|
|
7 | no warnings; |
5 | use strict qw(vars subs); |
8 | use strict qw(vars subs); |
6 | |
9 | |
7 | use AnyEvent::Socket; |
10 | use AnyEvent::Socket; |
8 | use AnyEvent::Handle; |
11 | use AnyEvent::Handle; |
|
|
12 | use AnyEvent::TLS; |
9 | |
13 | |
10 | { |
14 | my $ctx = new AnyEvent::TLS cert_file => $0; |
11 | my $ctx = AnyEvent::Handle::TLS_CTX; |
|
|
12 | |
|
|
13 | Net::SSLeay::CTX_use_certificate_chain_file ($ctx->ctx, $0) |
|
|
14 | or die "unable to set certificate chain file"; |
|
|
15 | Net::SSLeay::CTX_use_PrivateKey_file ($ctx->ctx, $0, Net::SSLeay::FILETYPE_PEM ()) |
|
|
16 | or die "unable to set private key file"; |
|
|
17 | } |
|
|
18 | |
15 | |
19 | for my $mode (1..5) { |
16 | for my $mode (1..5) { |
|
|
17 | ok (1, "mode $mode"); |
|
|
18 | |
20 | my $server_done = AnyEvent->condvar; |
19 | my $server_done = AnyEvent->condvar; |
21 | my $client_done = AnyEvent->condvar; |
20 | my $client_done = AnyEvent->condvar; |
22 | |
21 | |
23 | my $server_port = AnyEvent->condvar; |
22 | my $server_port = AnyEvent->condvar; |
24 | |
23 | |
… | |
… | |
29 | |
28 | |
30 | ok (1, "server_connect $mode"); |
29 | ok (1, "server_connect $mode"); |
31 | |
30 | |
32 | my $hd; $hd = new AnyEvent::Handle |
31 | my $hd; $hd = new AnyEvent::Handle |
33 | tls => "accept", |
32 | tls => "accept", |
|
|
33 | tls_ctx => $ctx, |
34 | fh => $fh, |
34 | fh => $fh, |
35 | timeout => 8, |
35 | timeout => 8, |
36 | on_error => sub { |
36 | on_error => sub { |
37 | ok (0, "server_error <$!>"); |
37 | ok (0, "server_error <$!>"); |
38 | $server_done->send; undef $hd; |
38 | $server_done->send; undef $hd; |
… | |
… | |
83 | |
83 | |
84 | }, sub { |
84 | }, sub { |
85 | $server_port->send ($_[2]); |
85 | $server_port->send ($_[2]); |
86 | }; |
86 | }; |
87 | |
87 | |
|
|
88 | my $hd; $hd = new AnyEvent::Handle |
88 | tcp_connect "localhost", $server_port->recv, sub { |
89 | connect => ["localhost", $server_port->recv], |
89 | my ($fh) = @_; |
90 | 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 | }; |
90 | |
104 | |
91 | ok (1, "client_connect $mode"); |
105 | if ($mode == 1) { |
92 | |
106 | $hd->push_write ("1\n"); |
93 | my $hd; $hd = new AnyEvent::Handle |
107 | $hd->on_drain (sub { |
94 | tls => "connect", |
|
|
95 | fh => $fh, |
|
|
96 | timeout => 8, |
|
|
97 | on_error => sub { |
|
|
98 | ok (0, "client_error <$!>"); |
108 | ok (1, "client_drain"); |
99 | $client_done->send; undef $hd; |
109 | $client_done->send; undef $hd; |
100 | }, |
|
|
101 | on_eof => sub { |
|
|
102 | ok (1, "client_eof"); |
|
|
103 | $client_done->send; undef $hd; |
|
|
104 | }; |
110 | }); |
105 | |
|
|
106 | if ($mode == 1) { |
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]>"); |
107 | $hd->push_write ("1\n"); |
123 | $hd->push_write ("6\n"); |
108 | $hd->on_drain (sub { |
124 | $hd->on_drain (sub { |
109 | ok (1, "client_drain"); |
125 | ok (1, "client_drain"); |
110 | $client_done->send; undef $hd; |
126 | $client_done->send; undef $hd; |
111 | }); |
127 | }); |
|
|
128 | }); |
112 | } elsif ($mode == 2) { |
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) { |
113 | $hd->push_read (line => sub { |
141 | $hd->push_read (line => sub { |
114 | ok ($_[1] eq "2", "line 2 <$_[1]>"); |
142 | my ($i, $cnt, $block) = ($i, $cnt, $block); # 5.8.9. bug workaround |
115 | }); |
143 | my $len = $_[1]; |
116 | } elsif ($mode == 3) { |
144 | ok (1, "client block $len/1"); |
117 | $hd->push_write ("3\n"); |
|
|
118 | $hd->push_read (line => sub { |
145 | $hd->unshift_read (packstring => "N", sub { |
119 | ok ($_[1] eq "4", "line 4 <$_[1]>"); |
146 | ok ($len == length $_[1], "client block $len/2"); |
120 | }); |
147 | |
121 | } elsif ($mode == 4) { |
148 | if ($i != $cnt) { |
122 | $hd->push_read (line => sub { |
149 | $block->(); |
123 | ok ($_[1] eq "5", "line 5 <$_[1]>"); |
150 | } else { |
124 | $hd->push_write ("6\n"); |
|
|
125 | $hd->on_drain (sub { |
|
|
126 | ok (1, "client_drain"); |
151 | ok (1, "client_drain 5"); |
127 | $client_done->send; undef $hd; |
152 | $client_done->send; undef $hd; |
|
|
153 | } |
128 | }); |
154 | }); |
129 | }); |
155 | }); |
130 | } elsif ($mode == 5) { |
|
|
131 | # some randomly-sized blocks |
|
|
132 | srand 0; |
|
|
133 | my $cnt = 64; |
|
|
134 | my $block; $block = sub { |
|
|
135 | my $len = (16 << int rand 14) - 16 + int rand 32; |
|
|
136 | ok (1, "write $len"); |
|
|
137 | $hd->push_write ("$len\n"); |
|
|
138 | $hd->push_write (packstring => "N", "\x00" x $len); |
|
|
139 | }; |
156 | } |
140 | |
157 | |
141 | for my $i (1..$cnt) { |
|
|
142 | $hd->push_read (line => sub { |
|
|
143 | 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 | ok (1, "client_drain"); |
|
|
152 | $client_done->send; undef $hd; |
|
|
153 | } |
|
|
154 | }); |
|
|
155 | }); |
|
|
156 | } |
|
|
157 | |
|
|
158 | $block->(); |
158 | $block->(); |
159 | } |
|
|
160 | }; |
159 | } |
161 | |
160 | |
162 | $server_done->recv; |
161 | $server_done->recv; |
163 | $client_done->recv; |
162 | $client_done->recv; |
164 | } |
163 | } |
165 | |
164 | |
166 | __END__ |
165 | __END__ |
|
|
166 | -----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----- |
167 | -----BEGIN CERTIFICATE----- |
175 | -----BEGIN CERTIFICATE----- |
168 | MIIDJjCCAtCgAwIBAgIJAJ3NPnD6z5+2MA0GCSqGSIb3DQEBBQUAMIGWMQswCQYD |
176 | MIIDJjCCAtCgAwIBAgIJAJ3NPnD6z5+2MA0GCSqGSIb3DQEBBQUAMIGWMQswCQYD |
169 | VQQGEwJYTjETMBEGA1UECBMKU29tZS1TdGF0ZTESMBAGA1UEBxMJU29tZS1DaXR5 |
177 | VQQGEwJYTjETMBEGA1UECBMKU29tZS1TdGF0ZTESMBAGA1UEBxMJU29tZS1DaXR5 |
170 | MRUwEwYDVQQKEwxTb21lLUNvbXBhbnkxEjAQBgNVBAsTCVNvbWUtVW5pdDEQMA4G |
178 | MRUwEwYDVQQKEwxTb21lLUNvbXBhbnkxEjAQBgNVBAsTCVNvbWUtVW5pdDEQMA4G |
171 | A1UEAxMHU29tZS1DTjEhMB8GCSqGSIb3DQEJARYSc29tZUBlbWFpbC5pbnZhbGlk |
179 | A1UEAxMHU29tZS1DTjEhMB8GCSqGSIb3DQEJARYSc29tZUBlbWFpbC5pbnZhbGlk |
… | |
… | |
181 | b21wYW55MRIwEAYDVQQLEwlTb21lLVVuaXQxEDAOBgNVBAMTB1NvbWUtQ04xITAf |
189 | b21wYW55MRIwEAYDVQQLEwlTb21lLVVuaXQxEDAOBgNVBAMTB1NvbWUtQ04xITAf |
182 | BgkqhkiG9w0BCQEWEnNvbWVAZW1haWwuaW52YWxpZIIJAJ3NPnD6z5+2MAwGA1Ud |
190 | BgkqhkiG9w0BCQEWEnNvbWVAZW1haWwuaW52YWxpZIIJAJ3NPnD6z5+2MAwGA1Ud |
183 | EwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADQQA48HjY23liyBMmh3cNo9TC+/bu/G3E |
191 | EwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADQQA48HjY23liyBMmh3cNo9TC+/bu/G3E |
184 | oT5npm3+Lh6VA/4kKMyMu2mP31BToTZfl7vUcBJCQBhPFYOiPd/HnwzW |
192 | oT5npm3+Lh6VA/4kKMyMu2mP31BToTZfl7vUcBJCQBhPFYOiPd/HnwzW |
185 | -----END CERTIFICATE----- |
193 | -----END CERTIFICATE----- |
186 | -----BEGIN RSA PRIVATE KEY----- |
|
|
187 | MIIBOwIBAAJBAL3Qbshr1ENmAzHxIRIvUaIG8+PCjc7xdXLBm+asBPMu0APQVQXJ |
|
|
188 | RTL3DueRUB51hAgSPgzSnj+ryZVzdcDER+UCAwEAAQJAGRftDWHz9dUOpxORo63N |
|
|
189 | xPXWWE3oIWuac0lVKvGi1eMoI4UCW/Y7qM4rXsUXqasUo3mxV24+QqJHDQid1qi6 |
|
|
190 | AQIhAN5BtiqfjFjb97uUbdE6aiqE+nSG0eXlkeHKNpBNtiUxAiEA2qHNZ5fcQTqT |
|
|
191 | 4qlnYhbI+g6bTwuR7QnzzGTlHUGxsPUCIQDLfvTw37Zb4cNYb1WBPW/ZUHoU2SAz |
|
|
192 | 01cXmdMNmumL8QIhAJMGTENl9FBJPDopAcUM3YqLWBYICdIF51WEZC8QhpYhAiBe |
|
|
193 | KcoNT51hv3pKK8oZtPJGsKFjmGVVnZeNNzyQmt/YWw== |
|
|
194 | -----END RSA PRIVATE KEY----- |
|
|
195 | |
194 | |
196 | |
195 | |
197 | |
196 | |