xref: /openbsd/regress/usr.sbin/httpd/tests/Proc.pm (revision d415bd75) 
1#	$OpenBSD: Proc.pm,v 1.3 2021/10/05 17:40:08 anton Exp $
2
3# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org>
4#
5# Permission to use, copy, modify, and distribute this software for any
6# purpose with or without fee is hereby granted, provided that the above
7# copyright notice and this permission notice appear in all copies.
8#
9# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
17use strict;
18use warnings;
19
20package Proc;
21use Carp;
22use Errno;
23use File::Basename;
24use IO::File;
25use POSIX;
26use Time::HiRes qw(time alarm sleep);
27
28my %CHILDREN;
29
30sub kill_children {
31	my @pids = @_ ? @_ : keys %CHILDREN
32	    or return;
33	my @perms;
34	foreach my $pid (@pids) {
35		if (kill(TERM => $pid) != 1 and $!{EPERM}) {
36			push @perms, $pid;
37		}
38	}
39	if (my @sudo = split(' ', $ENV{SUDO}) and @perms) {
40		local $?;  # do not modify during END block
41		my @cmd = (@sudo, '/bin/kill', '-TERM', @perms);
42		system(@cmd);
43	}
44	delete @CHILDREN{@pids};
45}
46
47BEGIN {
48	$SIG{TERM} = $SIG{INT} = sub {
49		my $sig = shift;
50		kill_children();
51		$SIG{TERM} = $SIG{INT} = 'DEFAULT';
52		POSIX::raise($sig);
53	};
54}
55
56END {
57	kill_children();
58	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
59}
60
61sub new {
62	my $class = shift;
63	my $self = { @_ };
64	$self->{down} ||= "Shutdown";
65	$self->{func} && ref($self->{func}) eq 'CODE'
66	    or croak "$class func not given";
67	$self->{logfile}
68	    or croak "$class log file not given";
69	open(my $fh, '>', $self->{logfile})
70	    or die "$class log file $self->{logfile} create failed: $!";
71	$fh->autoflush;
72	$self->{log} = $fh;
73	return bless $self, $class;
74}
75
76sub run {
77	my $self = shift;
78
79	pipe(my $reader, my $writer)
80	    or die ref($self), " pipe to child failed: $!";
81	defined(my $pid = fork())
82	    or die ref($self), " fork child failed: $!";
83	if ($pid) {
84		$CHILDREN{$pid} = 1;
85		$self->{pid} = $pid;
86		close($reader);
87		$self->{pipe} = $writer;
88		return $self;
89	}
90	%CHILDREN = ();
91	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
92	$SIG{__DIE__} = sub {
93		die @_ if $^S;
94		warn @_;
95		IO::Handle::flush(\*STDERR);
96		POSIX::_exit(255);
97	};
98	open(STDERR, '>&', $self->{log})
99	    or die ref($self), " dup STDERR failed: $!";
100	close($writer);
101	open(STDIN, '<&', $reader)
102	    or die ref($self), " dup STDIN failed: $!";
103	close($reader);
104
105	do {
106		$self->child();
107		print STDERR $self->{up}, "\n";
108		$self->{begin} = time();
109		$self->{func}->($self);
110	} while ($self->{redo});
111	$self->{end} = time();
112	print STDERR "Shutdown", "\n";
113	if ($self->{timefile}) {
114		open(my $fh, '>>', $self->{timefile})
115		    or die ref($self), " open $self->{timefile} failed: $!";
116		printf $fh "time='%s' duration='%.10g' ".
117		    "test='%s'\n",
118		    scalar(localtime(time())), $self->{end} - $self->{begin},
119		    basename($self->{testfile});
120	}
121
122	IO::Handle::flush(\*STDOUT);
123	IO::Handle::flush(\*STDERR);
124	POSIX::_exit(0);
125}
126
127sub wait {
128	my $self = shift;
129	my $flags = shift;
130
131	my $pid = $self->{pid}
132	    or croak ref($self), " no child pid";
133	my $kid = waitpid($pid, $flags);
134	if ($kid > 0) {
135		my $status = $?;
136		my $code;
137		$code = "exit: ".   WEXITSTATUS($?) if WIFEXITED($?);
138		$code = "signal: ". WTERMSIG($?)    if WIFSIGNALED($?);
139		$code = "stop: ".   WSTOPSIG($?)    if WIFSTOPPED($?);
140		delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?);
141		return wantarray ? ($kid, $status, $code) : $kid;
142	}
143	return $kid;
144}
145
146sub loggrep {
147	my $self = shift;
148	my($regex, $timeout) = @_;
149
150	my $end;
151	$end = time() + $timeout if $timeout;
152
153	do {
154		my($kid, $status, $code) = $self->wait(WNOHANG);
155		if ($kid > 0 && $status != 0 && !$self->{dryrun}) {
156			# child terminated with failure
157			die ref($self), " child status: $status $code";
158		}
159		open(my $fh, '<', $self->{logfile})
160		    or die ref($self), " log file open failed: $!";
161		my @match = grep { /$regex/ } <$fh>;
162		return wantarray ? @match : $match[0] if @match;
163		close($fh);
164		# pattern not found
165		if ($kid == 0) {
166			# child still running, wait for log data
167			sleep .1;
168		} else {
169			# child terminated, no new log data possible
170			return;
171		}
172	} while ($timeout and time() < $end);
173
174	return;
175}
176
177sub up {
178	my $self = shift;
179	my $timeout = shift || 10;
180	$self->loggrep(qr/$self->{up}/, $timeout)
181	    or croak ref($self), " no '$self->{up}' in $self->{logfile} ".
182		"after $timeout seconds";
183	return $self;
184}
185
186sub down {
187	my $self = shift;
188	my $timeout = shift || 300;
189	$self->loggrep(qr/$self->{down}/, $timeout)
190	    or croak ref($self), " no '$self->{down}' in $self->{logfile} ".
191		"after $timeout seconds";
192	return $self;
193}
194
195sub kill_child {
196	my $self = shift;
197	kill_children($self->{pid});
198	return $self;
199}
200
2011;
202