AnyEvent/t/80_ssltest.t

#!/usr/bin/perl

BEGIN { eval "use Net::SSLeay 1.33 (); 1" or ((print "1..0 # SKIP no usable Net::SSLeay\n"), exit 0) }

use Test::More tests => 410;

use strict qw(vars subs);

use AnyEvent::Socket;
use AnyEvent::Handle;
use AnyEvent::TLS;

my $ctx = new AnyEvent::TLS cert_file => $0;

for my $mode (1..5) {
   my $server_done = AnyEvent->condvar;
   my $client_done = AnyEvent->condvar;

   my $server_port = AnyEvent->condvar;

   tcp_server "127.0.0.1", undef, sub {
      my ($fh, $host, $port) = @_;

      die unless $host eq "127.0.0.1";

      ok (1, "server_connect $mode");

      my $hd; $hd = new AnyEvent::Handle
         tls      => "accept",
         tls_ctx  => $ctx,
         fh       => $fh,
         timeout  => 8,
         on_error => sub {
            ok (0, "server_error <$!>");
            $server_done->send; undef $hd;
         },
         on_eof   => sub {
            ok (1, "server_eof");
            $server_done->send; undef $hd;
         };

      if ($mode == 1) {
         $hd->push_read (line => sub {
            ok ($_[1] eq "1", "line 1 <$_[1]>");
         });
      } elsif ($mode == 2) {
         $hd->push_write ("2\n");
         $hd->on_drain (sub {
            ok (1, "server_drain");
            $server_done->send; undef $hd;
         });
      } elsif ($mode == 3) {
         $hd->push_read (line => sub {
            ok ($_[1] eq "3", "line 3 <$_[1]>");
            $hd->push_write ("4\n");
            $hd->on_drain (sub {
               ok (1, "server_drain");
               $server_done->send; undef $hd;
            });
         });
      } elsif ($mode == 4) {
         $hd->push_write ("5\n");
         $hd->push_read (line => sub {
            ok ($_[1] eq "6", "line 6 <$_[1]>");
         });
      } elsif ($mode == 5) {
         $hd->on_read (sub {
            ok (1, "on_read");
            $hd->push_read (line => sub {
               my $len = $_[1];
               ok (1, "push_read $len");
               $hd->push_read (packstring => "N", sub {
                  ok ($len == length $_[1], "block server $len");
                  $hd->push_write ("$len\n");
                  $hd->push_write (packstring => "N", $_[1]);
               });
            });
         });
      }

   }, sub {
      $server_port->send ($_[2]);
   };

   my $hd; $hd = new AnyEvent::Handle
      connect    => ["localhost", $server_port->recv],
      tls        => "connect",
      tls_ctx    => $ctx,
      timeout    => 8,
      on_connect => sub {
         ok (1, "client_connect $mode");
      },
      on_error   => sub {
         ok (0, "client_error <$!>");
         $client_done->send; undef $hd;
      },
      on_eof     => sub {
         ok (1, "client_eof");
         $client_done->send; undef $hd;
      };

   if ($mode == 1) {
      $hd->push_write ("1\n");
      $hd->on_drain (sub {
         ok (1, "client_drain");
         $client_done->send; undef $hd;
      });
   } elsif ($mode == 2) {
      $hd->push_read (line => sub {
         ok ($_[1] eq "2", "line 2 <$_[1]>");
      });
   } elsif ($mode == 3) {
      $hd->push_write ("3\n");
      $hd->push_read (line => sub {
         ok ($_[1] eq "4", "line 4 <$_[1]>");
      });
   } elsif ($mode == 4) {
      $hd->push_read (line => sub {
         ok ($_[1] eq "5", "line 5 <$_[1]>");
         $hd->push_write ("6\n");
         $hd->on_drain (sub {
            ok (1, "client_drain");
            $client_done->send; undef $hd;
         });
      });
   } elsif ($mode == 5) {
      # some randomly-sized blocks
      srand 0;
      my $cnt = 64;
      my $block; $block = sub {
         my $len = (16 << int rand 14) - 16 + int rand 32;
         ok (1, "write $len");
         $hd->push_write ("$len\n");
         $hd->push_write (packstring => "N", "\x00" x $len);
      };

      for my $i (1..$cnt) {
         $hd->push_read (line => sub {
            my $len = $_[1];
            ok (1, "client block $len/1");
            $hd->unshift_read (packstring => "N", sub {
               ok ($len == length $_[1], "client block $len/2");

               if ($i != $cnt) {
                  $block->();
               } else {
                  ok (1, "client_drain");
                  $client_done->send; undef $hd;
               }
            });
         });
      }

      $block->();
   }

   $server_done->recv;
   $client_done->recv;
}

__END__
-----BEGIN RSA PRIVATE KEY-----
MIIBOwIBAAJBAL3Qbshr1ENmAzHxIRIvUaIG8+PCjc7xdXLBm+asBPMu0APQVQXJ
RTL3DueRUB51hAgSPgzSnj+ryZVzdcDER+UCAwEAAQJAGRftDWHz9dUOpxORo63N
xPXWWE3oIWuac0lVKvGi1eMoI4UCW/Y7qM4rXsUXqasUo3mxV24+QqJHDQid1qi6
AQIhAN5BtiqfjFjb97uUbdE6aiqE+nSG0eXlkeHKNpBNtiUxAiEA2qHNZ5fcQTqT
4qlnYhbI+g6bTwuR7QnzzGTlHUGxsPUCIQDLfvTw37Zb4cNYb1WBPW/ZUHoU2SAz
01cXmdMNmumL8QIhAJMGTENl9FBJPDopAcUM3YqLWBYICdIF51WEZC8QhpYhAiBe
KcoNT51hv3pKK8oZtPJGsKFjmGVVnZeNNzyQmt/YWw==
-----END RSA PRIVATE KEY-----
-----BEGIN CERTIFICATE-----
MIIDJjCCAtCgAwIBAgIJAJ3NPnD6z5+2MA0GCSqGSIb3DQEBBQUAMIGWMQswCQYD
VQQGEwJYTjETMBEGA1UECBMKU29tZS1TdGF0ZTESMBAGA1UEBxMJU29tZS1DaXR5
MRUwEwYDVQQKEwxTb21lLUNvbXBhbnkxEjAQBgNVBAsTCVNvbWUtVW5pdDEQMA4G
A1UEAxMHU29tZS1DTjEhMB8GCSqGSIb3DQEJARYSc29tZUBlbWFpbC5pbnZhbGlk
MB4XDTA4MTAwMTA3NDk1OFoXDTM5MDMwODA3NDk1OFowgZYxCzAJBgNVBAYTAlhO
MRMwEQYDVQQIEwpTb21lLVN0YXRlMRIwEAYDVQQHEwlTb21lLUNpdHkxFTATBgNV
BAoTDFNvbWUtQ29tcGFueTESMBAGA1UECxMJU29tZS1Vbml0MRAwDgYDVQQDEwdT
b21lLUNOMSEwHwYJKoZIhvcNAQkBFhJzb21lQGVtYWlsLmludmFsaWQwXDANBgkq
hkiG9w0BAQEFAANLADBIAkEAvdBuyGvUQ2YDMfEhEi9Rogbz48KNzvF1csGb5qwE
8y7QA9BVBclFMvcO55FQHnWECBI+DNKeP6vJlXN1wMRH5QIDAQABo4H+MIH7MB0G
A1UdDgQWBBScspJuXxPCTlFAyiMeXa6j/zW8ATCBywYDVR0jBIHDMIHAgBScspJu
XxPCTlFAyiMeXa6j/zW8AaGBnKSBmTCBljELMAkGA1UEBhMCWE4xEzARBgNVBAgT
ClNvbWUtU3RhdGUxEjAQBgNVBAcTCVNvbWUtQ2l0eTEVMBMGA1UEChMMU29tZS1D
b21wYW55MRIwEAYDVQQLEwlTb21lLVVuaXQxEDAOBgNVBAMTB1NvbWUtQ04xITAf
BgkqhkiG9w0BCQEWEnNvbWVAZW1haWwuaW52YWxpZIIJAJ3NPnD6z5+2MAwGA1Ud
EwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADQQA48HjY23liyBMmh3cNo9TC+/bu/G3E
oT5npm3+Lh6VA/4kKMyMu2mP31BToTZfl7vUcBJCQBhPFYOiPd/HnwzW
-----END CERTIFICATE-----


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