1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
use Test::More;
use HTTP::Daemon::SSL;
use FindBin;
use strict;
use warnings;
use vars qw/$SSL_SERVER_PORT $SSL_SERVER_ADDR/;
eval "use Test::WWW::Mechanize;";
plan skip_all => "Test::WWW::Mechanize required for POST test" if $@;
eval "use Test::Builder;";
plan skip_all => "Test::Builder based Test::More version required for POST test" if $@;
require $FindBin::Bin . "/ssl_settings.req";
plan tests => 20;
# due to child, numbers will get out of order
Test::More->builder->use_numbers(0);
my $data66k = do { local $/; open my $f, $FindBin::Bin . "/post66k"; <$f> };
my $data67k = do { local $/; open my $f, $FindBin::Bin . "/post67k"; <$f> };
my $data500k = do { local $/; open my $f, $FindBin::Bin . "/post500k"; <$f> };
my $server = new HTTP::Daemon::SSL(
LocalAddr => $SSL_SERVER_ADDR,
Listen => 5,
Timeout => 30,
ReuseAddr => 1,
SSL_verify_mode => 0x00,
SSL_ca_file => "certs/test-ca.pem",
SSL_cert_file => "certs/server-cert.pem");
ok($server, "made test server");
$SSL_SERVER_PORT = $server->sockport;
ok($SSL_SERVER_PORT, "server init port=$SSL_SERVER_PORT");
ok(fileno($server), "server fileno");
unless (fork) {
close($server);
my $mech = Test::WWW::Mechanize->new();
$mech->post_ok(
"https://$SSL_SERVER_ADDR:$SSL_SERVER_PORT/",
{ data => 'foo' },
"posted small request",
);
$mech->post_ok(
"https://$SSL_SERVER_ADDR:$SSL_SERVER_PORT/",
{ data => $data66k },
"posted 66k request",
);
$mech->post_ok(
"https://$SSL_SERVER_ADDR:$SSL_SERVER_PORT/",
{ data => $data67k },
"posted 67k request",
);
$mech->post_ok(
"https://$SSL_SERVER_ADDR:$SSL_SERVER_PORT/",
{ data => $data500k },
"posted 500k request",
);
exit(0);
}
# sink first request
my $conn;
ok(($conn = $server->accept), "accepted first post");
my $r;
ok(($r = $conn->get_request), "got request object");
is($r->method, 'POST', "method is POST");
is($r->content, 'data=foo', 'content matches');
$conn->send_response("bar");
close $conn;
# sink second request
ok(($conn = $server->accept), "accepted second 66k post");
ok(($r = $conn->get_request), "got request object");
is($r->method, 'POST', "method is POST");
$conn->send_response("bar");
close $conn;
# sink third request
ok(($conn = $server->accept), "accepted third 67k post");
ok(($r = $conn->get_request), "got request object");
is($r->method, 'POST', "method is POST");
$conn->send_response("bar");
close $conn;
# sink fourth request
ok(($conn = $server->accept), "accepted third 500k post");
ok(($r = $conn->get_request), "got request object");
is($r->method, 'POST', "method is POST");
$conn->send_response("bar");
close $conn;
wait;
# count child tests
my $builder = Test::More->builder;
$builder->current_test( $builder->current_test + 4 );
|
