xref: /openbsd/regress/sys/net/pf_divert/Proc.pm (revision d76821b9) 
1#	$OpenBSD: Proc.pm,v 1.6 2017/12/18 17:01:27 bluhm Exp $
2
3# Copyright (c) 2010-2017 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 IO::File;
23use List::Util qw(first);
24use POSIX;
25use Time::HiRes qw(time alarm sleep);
26
27my %CHILDREN;
28
29BEGIN {
30	$SIG{TERM} = $SIG{INT} = sub {
31		my $sig = shift;
32		kill TERM => keys %CHILDREN;
33		$SIG{TERM} = $SIG{INT} = 'DEFAULT';
34		POSIX::raise($sig);
35	};
36}
37
38END {
39	kill TERM => keys %CHILDREN;
40	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
41}
42
43sub new {
44	my $class = shift;
45	my $self = { @_ };
46	$self->{down} ||= $self->{alarm} ? "Alarm $class" : "Shutdown $class";
47	$self->{func} && ref($self->{func}) eq 'CODE'
48	    or croak "$class func not given";
49	!$self->{ktrace} || $self->{ktracefile}
50	    or croak "$class ktrace file not given";
51	$self->{logfile}
52	    or croak "$class log file not given";
53	open(my $fh, '>', $self->{logfile})
54	    or die "$class log file $self->{logfile} create failed: $!";
55	$fh->autoflush;
56	$self->{log} = $fh;
57	return bless $self, $class;
58}
59
60sub run {
61	my $self = shift;
62
63	defined(my $pid = fork())
64	    or die ref($self), " fork child failed: $!";
65	if ($pid) {
66		$CHILDREN{$pid} = 1;
67		$self->{pid} = $pid;
68		return $self;
69	}
70	%CHILDREN = ();
71	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
72	$SIG{__DIE__} = sub {
73		die @_ if $^S;
74		warn @_;
75		IO::Handle::flush(\*STDERR);
76		POSIX::_exit(255);
77	};
78	open(STDERR, '>&', $self->{log})
79	    or die ref($self), " dup STDERR failed: $!";
80
81	if ($self->{ktrace}) {
82		my @cmd = ("ktrace", "-af", $self->{ktracefile}, "-p", $$);
83		do { local $> = 0; system(@cmd) }
84		    and die ref($self), " system '@cmd' failed: $?";
85		my $uid = $>;
86		do { local $> = 0; chown $uid, -1, $self->{ktracefile} }
87		    or die ref($self),
88		    " chown $uid '$self->{ktracefile}' failed: $?";
89	}
90
91	$self->child();
92	print STDERR $self->{up}, "\n";
93	alarm($self->{alarm}) if $self->{alarm};
94	$self->{func}->($self);
95	print STDERR "Shutdown ", ref($self), "\n";
96
97	IO::Handle::flush(\*STDOUT);
98	IO::Handle::flush(\*STDERR);
99	POSIX::_exit(0);
100}
101
102sub wait {
103	my $self = shift;
104	my $flags = shift;
105
106	my $pid = $self->{pid}
107	    or croak ref($self), " no child pid";
108	my $kid = waitpid($pid, $flags);
109	if ($kid > 0) {
110		my $status = $?;
111		my $code;
112		$code = "exit: ".   WEXITSTATUS($?) if WIFEXITED($?);
113		$code = "signal: ". WTERMSIG($?)    if WIFSIGNALED($?);
114		$code = "stop: ".   WSTOPSIG($?)    if WIFSTOPPED($?);
115		return wantarray ? ($kid, $status, $code) : $kid;
116	}
117	return $kid;
118}
119
120sub loggrep {
121	my $self = shift;
122	my($regex, $timeout) = @_;
123
124	my $end;
125	$end = time() + $timeout if $timeout;
126
127	do {
128		my($kid, $status, $code) = $self->wait(WNOHANG);
129		if ($self->{alarm} && $kid > 0 &&
130		    WIFSIGNALED($status) && WTERMSIG($status) == 14 ) {
131			# child killed by SIGALRM as expected
132			print {$self->{log}} "Alarm ", ref($self), "\n";
133		} elsif ($kid > 0 && $status != 0) {
134			# child terminated with failure
135			die ref($self), " child status: $status $code";
136		}
137		open(my $fh, '<', $self->{logfile})
138		    or die ref($self), " log file open failed: $!";
139		my $match = first { /$regex/ } <$fh>;
140		return $match if $match;
141		close($fh);
142		# pattern not found
143		if ($kid == 0) {
144			# child still running, wait for log data
145			sleep .1;
146		} else {
147			# child terminated, no new log data possible
148			return;
149		}
150	} while ($timeout and time() < $end);
151
152	return;
153}
154
155sub up {
156	my $self = shift;
157	my $timeout = shift || 10;
158	$self->loggrep(qr/$self->{up}/, $timeout)
159	    or croak ref($self), " no '$self->{up}' in $self->{logfile} ".
160		"after $timeout seconds";
161	return $self;
162}
163
164sub down {
165	my $self = shift;
166	my $timeout = shift || 20;
167	$self->loggrep(qr/$self->{down}/, $timeout)
168	    or croak ref($self), " no '$self->{down}' in $self->{logfile} ".
169		"after $timeout seconds";
170	return $self;
171}
172
1731;
174