-
Notifications
You must be signed in to change notification settings - Fork 0
/
Util.pm
178 lines (161 loc) · 4.52 KB
/
Util.pm
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
package t::Util;
use strict;
use warnings;
use Digest::MD5 qw(md5_hex);
use File::Temp qw(tempfile);
use Net::EmptyPort qw(check_port empty_port);
use POSIX ":sys_wait_h";
use Scope::Guard qw(scope_guard);
use Test::More;
use Time::HiRes qw(sleep);
use base qw(Exporter);
our @EXPORT = qw(ASSETS_DIR DOC_ROOT bindir exec_unittest spawn_server spawn_h2o empty_ports create_data_file md5_file prog_exists run_prog openssl_can_negotiate);
use constant ASSETS_DIR => 't/assets';
use constant DOC_ROOT => ASSETS_DIR . "/doc_root";
sub bindir {
$ENV{BINARY_DIR} || '.';
}
sub exec_unittest {
my $base = shift;
my $fn = bindir() . "/t-00unit-$base.t";
plan skip_all => "unit test:$base does not exist"
if ! -e $fn;
exec $fn;
die "failed to exec $fn:$!";
}
# spawns a child process and returns a guard object that kills the process when destroyed
sub spawn_server {
my %args = @_;
my $pid = fork;
die "fork failed:$!"
unless defined $pid;
if ($pid != 0) {
print STDERR "spawning $args{argv}->[0]... ";
if ($args{is_ready}) {
while (1) {
if ($args{is_ready}->()) {
print STDERR "done\n";
last;
}
if (waitpid($pid, WNOHANG) == $pid) {
die "server failed to start (got $?)\n";
}
sleep 0.1;
}
}
my $guard = scope_guard(sub {
print STDERR "killing $args{argv}->[0]... ";
my $sig = 'TERM';
Retry:
if (kill $sig, $pid) {
my $i = 0;
while (1) {
if (waitpid($pid, WNOHANG) == $pid) {
print STDERR "killed (got $?)\n";
last;
}
if ($i++ == 100) {
if ($sig eq 'TERM') {
print STDERR "failed, sending SIGKILL... ";
$sig = 'KILL';
goto Retry;
}
print STDERR "failed, continuing anyways\n";
last;
}
sleep 0.1;
}
} else {
print STDERR "no proc? ($!)\n";
}
});
return wantarray ? ($guard, $pid) : $guard;
}
# child process
exec @{$args{argv}};
die "failed to exec $args{argv}->[0]:$!";
}
# returns a hash containing `port`, `tls_port`, `guard`
sub spawn_h2o {
my ($conf) = @_;
my @opts;
# decide the port numbers
my ($port, $tls_port) = empty_ports(2);
# setup the configuration file
my ($conffh, $conffn) = tempfile(UNLINK => 1);
$conf = $conf->($port, $tls_port)
if ref $conf eq 'CODE';
if (ref $conf eq 'HASH') {
@opts = @{$conf->{opts}}
if $conf->{opts};
$conf = $conf->{conf};
}
print $conffh <<"EOT";
$conf
listen:
host: 0.0.0.0
port: $port
listen:
host: 0.0.0.0
port: $tls_port
ssl:
key-file: examples/h2o/server.key
certificate-file: examples/h2o/server.crt
EOT
# spawn the server
my ($guard, $pid) = spawn_server(
argv => [ bindir() . "/h2o", "-c", $conffn, @opts ],
is_ready => sub {
check_port($port) && check_port($tls_port);
},
);
return +{
port => $port,
tls_port => $tls_port,
guard => $guard,
pid => $pid,
};
}
sub empty_ports {
my $n = shift;
my @ports;
while (@ports < $n) {
my $t = empty_port();
push @ports, $t
unless grep { $_ == $t } @ports;
}
return @ports;
}
sub create_data_file {
my $sz = shift;
my ($fh, $fn) = tempfile(UNLINK => 1);
print $fh '0' x $sz;
close $fh;
return $fn;
}
sub md5_file {
my $fn = shift;
open my $fh, "<", $fn
or die "failed to open file:$fn:$!";
local $/;
return md5_hex(join '', <$fh>);
}
sub prog_exists {
my $prog = shift;
system("which $prog > /dev/null 2>&1") == 0;
}
sub run_prog {
my $cmd = shift;
my ($tempfh, $tempfn) = tempfile(UNLINK => 1);
my $stderr = `$cmd 2>&1 > $tempfn`;
my $stdout = do { local $/; <$tempfh> };
return ($stderr, $stdout);
}
sub openssl_can_negotiate {
my $openssl_ver = `openssl version`;
$openssl_ver =~ /^\S+\s(\d+)\.(\d+)\.(\d+)/
or die "cannot parse OpenSSL version: $openssl_ver";
$openssl_ver = $1 * 10000 + $2 * 100 + $3;
return $openssl_ver >= 10001;
}
1;