xref: /openbsd/regress/usr.sbin/syslogd/Proc.pm (revision d415bd75) 
1#	$OpenBSD: Proc.pm,v 1.10 2022/03/25 14:15:10 bluhm Exp $
2
3# Copyright (c) 2010-2020 Alexander Bluhm <bluhm@openbsd.org>
4# Copyright (c) 2014 Florian Riehm <mail@friehm.de>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18use strict;
19use warnings;
20
21package Proc;
22use BSD::Resource qw(getrlimit setrlimit get_rlimits);
23use Carp;
24use Errno;
25use IO::File;
26use POSIX;
27use Time::HiRes qw(time alarm sleep);
28use IO::Socket::SSL;
29
30my %CHILDREN;
31
32sub kill_children {
33	my @pids = @_ ? @_ : keys %CHILDREN
34	    or return;
35	my @perms;
36	foreach my $pid (@pids) {
37		if (kill(TERM => $pid) != 1 and $!{EPERM}) {
38			push @perms, $pid;
39		}
40	}
41	if (my $sudo = $ENV{SUDO} and @perms) {
42		local $?;  # do not modify during END block
43		my @cmd = ($sudo, '/bin/kill', '-TERM', @perms);
44		system(@cmd);
45	}
46	delete @CHILDREN{@pids};
47}
48
49BEGIN {
50	$SIG{TERM} = $SIG{INT} = sub {
51		my $sig = shift;
52		kill_children();
53		$SIG{TERM} = $SIG{INT} = 'DEFAULT';
54		POSIX::raise($sig);
55	};
56}
57
58END {
59	kill_children();
60	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
61}
62
63sub new {
64	my $class = shift;
65	my $self = { @_ };
66	$self->{down} ||= "Shutdown";
67	$self->{func} && ref($self->{func}) eq 'CODE'
68	    or croak "$class func not given";
69	$self->{ktracepid} && $self->{ktraceexec}
70	    and croak "$class ktrace both pid and exec given";
71	!($self->{ktracepid} || $self->{ktraceexec}) || $self->{ktracefile}
72	    or croak "$class ktrace file not given";
73	$self->{logfile}
74	    or croak "$class log file not given";
75	open(my $fh, '>', $self->{logfile})
76	    or die "$class log file $self->{logfile} create failed: $!";
77	$fh->autoflush;
78	$self->{log} = $fh;
79	$self->{ppid} = $$;
80	return bless $self, $class;
81}
82
83sub run {
84	my $self = shift;
85
86	pipe(my $reader, my $writer)
87	    or die ref($self), " pipe to child failed: $!";
88	defined(my $pid = fork())
89	    or die ref($self), " fork child failed: $!";
90	if ($pid) {
91		$CHILDREN{$pid} = 1;
92		$self->{pid} = $pid;
93		close($reader);
94		$self->{pipe} = $writer;
95		return $self;
96	}
97	%CHILDREN = ();
98	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
99	$SIG{__DIE__} = sub {
100		die @_ if $^S;
101		warn @_;
102		IO::Handle::flush(\*STDERR);
103		POSIX::_exit(255);
104	};
105	open(STDERR, '>&', $self->{log})
106	    or die ref($self), " dup STDERR failed: $!";
107	open(STDOUT, '>&', $self->{log})
108	    or die ref($self), " dup STDOUT failed: $!";
109	close($writer);
110	open(STDIN, '<&', $reader)
111	    or die ref($self), " dup STDIN failed: $!";
112	close($reader);
113
114	if ($self->{rlimit}) {
115		my $rlimits = get_rlimits()
116		    or die ref($self), " get_rlimits failed: $!";
117		while (my($name, $newsoft) = each %{$self->{rlimit}}) {
118			defined(my $resource = $rlimits->{$name})
119			    or die ref($self), " rlimit $name does not exists";
120			my ($soft, $hard) = getrlimit($resource)
121			    or die ref($self), " getrlimit $name failed: $!";
122			setrlimit($resource, $newsoft, $hard) or die ref($self),
123			    " setrlimit $name to $newsoft failed: $!";
124		}
125	}
126	if ($self->{ktracepid}) {
127		my @cmd = ($self->{ktracepid}, "-i", "-f", $self->{ktracefile},
128		    "-p", $$);
129		system(@cmd)
130		    and die ref($self), " system '@cmd' failed: $?";
131	}
132	do {
133		$self->child();
134		print STDERR $self->{up}, "\n";
135		$self->{ts} = $self->{cs}
136		    if $self->{connectproto} && $self->{connectproto} eq "tls";
137		$self->{func}->($self);
138		$self->{ts}->close(SSL_fast_shutdown => 0)
139		    or die ref($self), " SSL shutdown: $!,$SSL_ERROR"
140		    if $self->{ts};
141		delete $self->{ts};
142	} while ($self->{redo});
143	print STDERR "Shutdown", "\n";
144
145	IO::Handle::flush(\*STDOUT);
146	IO::Handle::flush(\*STDERR);
147	POSIX::_exit(0);
148}
149
150sub wait {
151	my $self = shift;
152	my $flags = shift;
153
154	# if we a not the parent process, assume the child is still running
155	return 0 unless $self->{ppid} == $$;
156
157	my $pid = $self->{pid}
158	    or croak ref($self), " no child pid";
159	my $kid = waitpid($pid, $flags);
160	if ($kid > 0) {
161		my $status = $?;
162		my $code;
163		$code = "exit: ".   WEXITSTATUS($?) if WIFEXITED($?);
164		$code = "signal: ". WTERMSIG($?)    if WIFSIGNALED($?);
165		$code = "stop: ".   WSTOPSIG($?)    if WIFSTOPPED($?);
166		delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?);
167		return wantarray ? ($kid, $status, $code) : $kid;
168	}
169	return $kid;
170}
171
172sub loggrep {
173	my $self = shift;
174	my($regex, $timeout, $count) = @_;
175	my $exit = ($self->{exit} // 0) << 8;
176
177	my $end;
178	$end = time() + $timeout if $timeout;
179
180	do {
181		my($kid, $status, $code) = $self->wait(WNOHANG);
182		if ($kid > 0 && $status != $exit) {
183			# child terminated with failure
184			die ref($self), " child status: $status $code";
185		}
186		open(my $fh, '<', $self->{logfile})
187		    or die ref($self), " log file open failed: $!";
188		my @match = grep { /$regex/ } <$fh>;
189		return wantarray ? @match : $match[0]
190		    if !$count && @match or $count && @match >= $count;
191		close($fh);
192		# pattern not found
193		if ($kid == 0) {
194			# child still running, wait for log data
195			sleep .1;
196		} else {
197			# child terminated, no new log data possible
198			return;
199		}
200	} while ($timeout and time() < $end);
201
202	return;
203}
204
205sub up {
206	my $self = shift;
207	my $timeout = shift || 10;
208	$self->loggrep(qr/$self->{up}/, $timeout)
209	    or croak ref($self), " no '$self->{up}' in $self->{logfile} ".
210		"after $timeout seconds";
211	return $self;
212}
213
214sub down {
215	my $self = shift;
216	my $timeout = shift || 60;
217	$self->loggrep(qr/$self->{down}/, $timeout)
218	    or croak ref($self), " no '$self->{down}' in $self->{logfile} ".
219		"after $timeout seconds";
220	return $self;
221}
222
223sub kill_child {
224	my $self = shift;
225	kill_children($self->{pid});
226	return $self;
227}
228
229sub kill {
230	my $self = shift;
231	my $sig = shift // 'TERM';
232	my $pid = shift // $self->{pid};
233
234	if (kill($sig => $pid) != 1) {
235		my $sudo = $ENV{SUDO};
236		$sudo && $!{EPERM}
237		    or die ref($self), " kill $pid failed: $!";
238		my @cmd = ($sudo, '/bin/kill', "-$sig", $pid);
239		system(@cmd)
240		    and die ref($self), " sudo kill $pid failed: $?";
241	}
242	return $self;
243}
244
2451;
246