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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
package TestUtils;
use warnings;
use strict;
use POSIX ":sys_wait_h";
use IO::Socket::INET;
require File::Temp;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(start_child reap_children wait_for_type wait_for_port make_config);
our $VERSION = '0.01';
$SIG{CHLD} = \&REAPER;
my %children;
sub REAPER {
my $stiff;
while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
# do something with $stiff if you want
$children{$stiff}->{'running'} = undef;
$children{$stiff}->{'exit_code'} = $? >> 8;
$children{$stiff}->{'signal'} = $? & 127;
$children{$stiff}->{'core_dumped'} = $? & 128;
}
$SIG{CHLD} = \&REAPER; # install *after* calling waitpid
}
# Make several requests through the proxy specifying the host header
sub start_child {
my $type = shift;
my $child = shift;
my @args = @_;
my $pid = fork();
if (not defined $pid) {
die("fork: $!");
} elsif ($pid == 0) {
undef $SIG{CHLD};
$child->(@args);
# Should not be reached
exit(99);
}
$children{$pid} = {
type => $type,
pid => $pid,
running => 1,
core_dumped => undef,
signal => undef,
exit_core => undef,
};
return $pid;
}
sub reap_children {
while (my @hit_list = grep($children{$_}->{'running'}, keys %children)) {
kill 15, @hit_list;
sleep 1;
}
# Check that all our children exited cleanly
my @failures = grep($_->{'exit_code'} != 0 || $_->{'core_dumped'}, values %children);
if (@failures) {
print "Test failed.\n";
foreach (@failures) {
if ($_->{'core_dumped'}) {
printf "%s died with signal %d, %s coredump\n", $_->{'type'}, $_->{'signal'}, $_->{'core_dumped'} ? 'with' : 'without';
} else {
print "$_->{'type'} failed with exit code $_->{'exit_code'}\n";
}
}
exit 1;
} else {
# print "Test passed.\n";
return;
}
}
sub wait_for_type($) {
my $type = shift;
while (grep($children{$_}->{'running'} && $children{$_}->{'type'} eq $type, keys %children) > 0) {
sleep 1;
}
}
sub wait_for_port {
my %args = @_;
my $ip = $args{'ip'} || 'localhost';
my $port = $args{'port'} or die "port required";
my $delay = 1;
while ($delay < 60) {
my $port_open = undef;
eval {
my $socket = IO::Socket::INET->new(PeerAddr => $ip,
PeerPort => $port,
Proto => "tcp",
Type => SOCK_STREAM);
if ($socket && $socket->connected()) {
$socket->shutdown(2);
$port_open = 1;
}
};
return 1 if ($port_open);
sleep($delay);
$delay *= 2;
}
return undef;
}
sub make_config($$) {
my $proxy_port = shift;
my $httpd_port = shift;
my ($fh, $filename) = File::Temp::tempfile();
my ($unused, $logfile) = File::Temp::tempfile();
# Write out a test config file
print $fh <<END;
# Minimal test configuration
listen 127.0.0.1 $proxy_port {
proto http
access_log $logfile
}
table {
localhost 127.0.0.1 $httpd_port
}
END
close ($fh);
return $filename;
}
1;
|
