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