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 => 415;

no warnings;
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) {
   ok (1, "mode $mode");

   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 <$_[2]>");
            $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    => ["127.0.0.1", $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 <$_[2]>");
         $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 ($i, $cnt, $block) = ($i, $cnt, $block); # 5.8.9. bug workaround
            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 5");
                  $client_done->send; undef $hd;
               }
            });
         });
      }

      $block->();
   }

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

__END__
-----BEGIN RSA PRIVATE KEY-----
MIIEpAIBAAKCAQEA02VwAqlQzCrPenkxUjawHcXzJreJ9LDhX7Bkg3E/RB6Ilm4D
LBeilCmzkY7avp57+WCiVw2qkg+kH4Ef2sd+r10UCGPh/1diLehRAzp3Ho1bixyg
w+zkDm79OnN3uHxuKigkAxx3GGz9HhQA83U+RUns+39/OnFh0RY6/f5rV2ziA9jD
6HK3Mnsuxocd46YbVdiqlQK430CgiGj8dV44JG6+R6x3r5qXDbbRtGubC29kQOUq
kYslbpTo7ml8ShyqAP6qa8BpeSIaNG1CQQ/7JkAdxSWyFHqMQ0HR3BUiaEfUElZt
DFgXcCkKB5F8jx+wYoLzlPHHZaUvfP2nueYjcwIDAQABAoIBAQCtRDMuu0ByV5R/
Od5nGFP500mcrkrwuBnBqH56DdRhLPWe9sS62xRyhEuePoykOJo8qCvnVlg8J33K
JLfLRkBb09qbleKiuyjJn+Tm1IDWFd62gtxyOjQicG41/nZeS/6vpv79XdNvvcUp
ZhPxeGN1v0XyTWomqNAX5DSuAl5Q5HxkaRYNeuLZaPYkqmEVTgYqNSes/wRLKUb6
MaVrZ9AA/oHJMmmV4evf06s7l7ICjxAWeas7CI6UGkEz8ZFoVRJsLk5xtTsnZLgf
f24/pqHz1vApPs7CsJhK2HsLZcxMPD+hmTNI/Njl51WoH8zGhkv+p88vDzybpNSF
Hpkl+ZlBAoGBAOyfjVLD0OznJKSFksoCZKS4dlPHgXUb47Qb/XchIySQ/DNO6ff9
AA6r6doDFp51A8N1GRtGQN4LKujFPOdZ5ah7zbc2PfuOJGHku0Oby+ydgHJ19eW4
s3CIM20TuzLndFPrEGFgOrt+i5qKisti2OOZhjsDwfd48vsBm9U20lUpAoGBAOS1
Chm+vA7JevPzl+acbDSiyELaNRAXZ73CX4NIxJURjsgDeOurnBtLQEQyagZbNHcx
W4pc59Ql5KDLzu/Sne8oC3pxhaWeIPhc2d3cd/8UyGtQLtN2QnilwkjHgi3x1JGb
RPRsgAV6nwn10qUrze1XLkHsTCRI4QYD/k0uXcs7AoGBAMStJaFag2i2Ax4ArG7e
KFtFu4yNckwtv0kwTrBbScOWAxp+iDiJASgwunJsSLuylUs8JH8oGLi23ZaWgrXl
Yd918BpNqp1Rm2oG3aQndguZKm95Hscvi26Itv39/YYlHeq2omndu1OmrlDowM6m
vZIIRKr+x5Vz4brCro09QPxpAoGARJAdghBTEl/Gc2HgdOsJ6VGvlZMS+0r498NQ
nOvwuvuzgTTBSG1+9BPAJXGzpUosVVs/pSArA8eEXcwbsnvCixLHNiLYPQlFuw8i
5UcV1iul1b4I+63lSYPv1Z+x4BIydqBEsL3iN0JGcVb3mjqilndfT7YGMY6DnykN
UJgI2EcCgYAMfZHnD06XFM8ny+NsFILItpGqjCmAhkEPGwl1Zhy5Hx16CFDPDwGt
CmIbxNSLsDyiiK+i5tuSUFhV2Bw/iT539979INTIdNL1ughfhATR8MVNiOKCvZBa
uoEeE19szmG7Mj2eV2IDH0e8iaikjRFcfN89s39tNn1AjBNmEccUJA==
-----END RSA PRIVATE KEY-----
-----
-----BEGIN CERTIFICATE-----
MIIDHTCCAgWgAwIBAgIJAPASTbY2HCx0MA0GCSqGSIb3DQEBBQUAMBMxETAPBgNV
BAMTCEFueUV2ZW50MB4XDTEyMDQwNTA1NTk1MFoXDTM3MDQwNTA1NTk1MFowEzER
MA8GA1UEAxMIQW55RXZlbnQwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIB
AQDTZXACqVDMKs96eTFSNrAdxfMmt4n0sOFfsGSDcT9EHoiWbgMsF6KUKbORjtq+
nnv5YKJXDaqSD6QfgR/ax36vXRQIY+H/V2It6FEDOncejVuLHKDD7OQObv06c3e4
fG4qKCQDHHcYbP0eFADzdT5FSez7f386cWHRFjr9/mtXbOID2MPocrcyey7Ghx3j
phtV2KqVArjfQKCIaPx1Xjgkbr5HrHevmpcNttG0a5sLb2RA5SqRiyVulOjuaXxK
HKoA/qprwGl5Iho0bUJBD/smQB3FJbIUeoxDQdHcFSJoR9QSVm0MWBdwKQoHkXyP
H7BigvOU8cdlpS98/ae55iNzAgMBAAGjdDByMB0GA1UdDgQWBBTHphJ9Il0PtIWD
DI9aueToXo9DYzBDBgNVHSMEPDA6gBTHphJ9Il0PtIWDDI9aueToXo9DY6EXpBUw
EzERMA8GA1UEAxMIQW55RXZlbnSCCQDwEk22NhwsdDAMBgNVHRMEBTADAQH/MA0G
CSqGSIb3DQEBBQUAA4IBAQA/vY+qg2xjNeOuDySW/VOsStEwcaiAm/t24z3TYoZG
2ZzyKuvFXolhXsalCahNPcyUxZqDAekODPRaq+geFaZrOn41cq/LABTKv5Theukv
H7IruIFARBo1pTPFCKMnDqESBdHvV1xTOcKGxGH5I9iMgiUrd/NnlAaloT/cCNFI
OwhEPsF9kBsZwJBGWrjjVttU2lzMzizS7vaSIWLBuEDObWbSXiU+IdG+nODOe2Dv
W7PL43yd4fz4HQvN4IaZrtwkd7XiKodRR1gWjLjW/3y5kuXL+DA/jkTjrRgiH8K7
lVjm7gvkULRV2POQqtc2DUVXLubQmmGSjmQmxSwFX65t
-----END CERTIFICATE-----
Revision:	1.10
Committed:	Thu Apr 5 06:14:10 2012 UTC (14 years, 6 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-7_0, rel-7_04, rel-7_05, rel-7_07, rel-7_01, rel-7_02, rel-7_03, rel-7_08, rel-7_09, rel-7_16, rel-7_15, rel-7_14, rel-7_13, rel-7_12, rel-7_11, HEAD
Changes since 1.9:	+45 -29 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.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	root	1.10	ok (0, "server_error <$_[2]>");
38	root	1.1	$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	root	1.10	ok (0, "client_error <$_[2]>");
98	root	1.6	$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	root	1.10	MIIEpAIBAAKCAQEA02VwAqlQzCrPenkxUjawHcXzJreJ9LDhX7Bkg3E/RB6Ilm4D
168			LBeilCmzkY7avp57+WCiVw2qkg+kH4Ef2sd+r10UCGPh/1diLehRAzp3Ho1bixyg
169			w+zkDm79OnN3uHxuKigkAxx3GGz9HhQA83U+RUns+39/OnFh0RY6/f5rV2ziA9jD
170			6HK3Mnsuxocd46YbVdiqlQK430CgiGj8dV44JG6+R6x3r5qXDbbRtGubC29kQOUq
171			kYslbpTo7ml8ShyqAP6qa8BpeSIaNG1CQQ/7JkAdxSWyFHqMQ0HR3BUiaEfUElZt
172			DFgXcCkKB5F8jx+wYoLzlPHHZaUvfP2nueYjcwIDAQABAoIBAQCtRDMuu0ByV5R/
173			Od5nGFP500mcrkrwuBnBqH56DdRhLPWe9sS62xRyhEuePoykOJo8qCvnVlg8J33K
174			JLfLRkBb09qbleKiuyjJn+Tm1IDWFd62gtxyOjQicG41/nZeS/6vpv79XdNvvcUp
175			ZhPxeGN1v0XyTWomqNAX5DSuAl5Q5HxkaRYNeuLZaPYkqmEVTgYqNSes/wRLKUb6
176			MaVrZ9AA/oHJMmmV4evf06s7l7ICjxAWeas7CI6UGkEz8ZFoVRJsLk5xtTsnZLgf
177			f24/pqHz1vApPs7CsJhK2HsLZcxMPD+hmTNI/Njl51WoH8zGhkv+p88vDzybpNSF
178			Hpkl+ZlBAoGBAOyfjVLD0OznJKSFksoCZKS4dlPHgXUb47Qb/XchIySQ/DNO6ff9
179			AA6r6doDFp51A8N1GRtGQN4LKujFPOdZ5ah7zbc2PfuOJGHku0Oby+ydgHJ19eW4
180			s3CIM20TuzLndFPrEGFgOrt+i5qKisti2OOZhjsDwfd48vsBm9U20lUpAoGBAOS1
181			Chm+vA7JevPzl+acbDSiyELaNRAXZ73CX4NIxJURjsgDeOurnBtLQEQyagZbNHcx
182			W4pc59Ql5KDLzu/Sne8oC3pxhaWeIPhc2d3cd/8UyGtQLtN2QnilwkjHgi3x1JGb
183			RPRsgAV6nwn10qUrze1XLkHsTCRI4QYD/k0uXcs7AoGBAMStJaFag2i2Ax4ArG7e
184			KFtFu4yNckwtv0kwTrBbScOWAxp+iDiJASgwunJsSLuylUs8JH8oGLi23ZaWgrXl
185			Yd918BpNqp1Rm2oG3aQndguZKm95Hscvi26Itv39/YYlHeq2omndu1OmrlDowM6m
186			vZIIRKr+x5Vz4brCro09QPxpAoGARJAdghBTEl/Gc2HgdOsJ6VGvlZMS+0r498NQ
187			nOvwuvuzgTTBSG1+9BPAJXGzpUosVVs/pSArA8eEXcwbsnvCixLHNiLYPQlFuw8i
188			5UcV1iul1b4I+63lSYPv1Z+x4BIydqBEsL3iN0JGcVb3mjqilndfT7YGMY6DnykN
189			UJgI2EcCgYAMfZHnD06XFM8ny+NsFILItpGqjCmAhkEPGwl1Zhy5Hx16CFDPDwGt
190			CmIbxNSLsDyiiK+i5tuSUFhV2Bw/iT539979INTIdNL1ughfhATR8MVNiOKCvZBa
191			uoEeE19szmG7Mj2eV2IDH0e8iaikjRFcfN89s39tNn1AjBNmEccUJA==
192	root	1.3	-----END RSA PRIVATE KEY-----
193	root	1.10	-----
194	root	1.1	-----BEGIN CERTIFICATE-----
195	root	1.10	MIIDHTCCAgWgAwIBAgIJAPASTbY2HCx0MA0GCSqGSIb3DQEBBQUAMBMxETAPBgNV
196			BAMTCEFueUV2ZW50MB4XDTEyMDQwNTA1NTk1MFoXDTM3MDQwNTA1NTk1MFowEzER
197			MA8GA1UEAxMIQW55RXZlbnQwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIB
198			AQDTZXACqVDMKs96eTFSNrAdxfMmt4n0sOFfsGSDcT9EHoiWbgMsF6KUKbORjtq+
199			nnv5YKJXDaqSD6QfgR/ax36vXRQIY+H/V2It6FEDOncejVuLHKDD7OQObv06c3e4
200			fG4qKCQDHHcYbP0eFADzdT5FSez7f386cWHRFjr9/mtXbOID2MPocrcyey7Ghx3j
201			phtV2KqVArjfQKCIaPx1Xjgkbr5HrHevmpcNttG0a5sLb2RA5SqRiyVulOjuaXxK
202			HKoA/qprwGl5Iho0bUJBD/smQB3FJbIUeoxDQdHcFSJoR9QSVm0MWBdwKQoHkXyP
203			H7BigvOU8cdlpS98/ae55iNzAgMBAAGjdDByMB0GA1UdDgQWBBTHphJ9Il0PtIWD
204			DI9aueToXo9DYzBDBgNVHSMEPDA6gBTHphJ9Il0PtIWDDI9aueToXo9DY6EXpBUw
205			EzERMA8GA1UEAxMIQW55RXZlbnSCCQDwEk22NhwsdDAMBgNVHRMEBTADAQH/MA0G
206			CSqGSIb3DQEBBQUAA4IBAQA/vY+qg2xjNeOuDySW/VOsStEwcaiAm/t24z3TYoZG
207			2ZzyKuvFXolhXsalCahNPcyUxZqDAekODPRaq+geFaZrOn41cq/LABTKv5Theukv
208			H7IruIFARBo1pTPFCKMnDqESBdHvV1xTOcKGxGH5I9iMgiUrd/NnlAaloT/cCNFI
209			OwhEPsF9kBsZwJBGWrjjVttU2lzMzizS7vaSIWLBuEDObWbSXiU+IdG+nODOe2Dv
210			W7PL43yd4fz4HQvN4IaZrtwkd7XiKodRR1gWjLjW/3y5kuXL+DA/jkTjrRgiH8K7
211			lVjm7gvkULRV2POQqtc2DUVXLubQmmGSjmQmxSwFX65t
212	root	1.1	-----END CERTIFICATE-----