xref: /openbsd/regress/sys/net/pf_divert/Proc.pm (revision fc61954a) 
1#	$OpenBSD: Proc.pm,v 1.4 2016/05/03 19:13:04 bluhm 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 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" : "Shutdown";
47	$self->{func} && ref($self->{func}) eq 'CODE'
48	    or croak "$class func not given";
49	$self->{logfile}
50	    or croak "$class log file not given";
51	open(my $fh, '>', $self->{logfile})
52	    or die "$class log file $self->{logfile} create failed: $!";
53	$fh->autoflush;
54	$self->{log} = $fh;
55	return bless $self, $class;
56}
57
58sub run {
59	my $self = shift;
60
61	defined(my $pid = fork())
62	    or die ref($self), " fork child failed: $!";
63	if ($pid) {
64		$CHILDREN{$pid} = 1;
65		$self->{pid} = $pid;
66		return $self;
67	}
68	%CHILDREN = ();
69	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
70	$SIG{__DIE__} = sub {
71		die @_ if $^S;
72		warn @_;
73		IO::Handle::flush(\*STDERR);
74		POSIX::_exit(255);
75	};
76	open(STDERR, '>&', $self->{log})
77	    or die ref($self), " dup STDERR failed: $!";
78
79	$self->child();
80	print STDERR $self->{up}, "\n";
81	alarm($self->{alarm}) if $self->{alarm};
82	$self->{func}->($self);
83	print STDERR "Shutdown", "\n";
84
85	IO::Handle::flush(\*STDOUT);
86	IO::Handle::flush(\*STDERR);
87	POSIX::_exit(0);
88}
89
90sub wait {
91	my $self = shift;
92	my $flags = shift;
93
94	my $pid = $self->{pid}
95	    or croak ref($self), " no child pid";
96	my $kid = waitpid($pid, $flags);
97	if ($kid > 0) {
98		my $status = $?;
99		my $code;
100		$code = "exit: ".   WEXITSTATUS($?) if WIFEXITED($?);
101		$code = "signal: ". WTERMSIG($?)    if WIFSIGNALED($?);
102		$code = "stop: ".   WSTOPSIG($?)    if WIFSTOPPED($?);
103		return wantarray ? ($kid, $status, $code) : $kid;
104	}
105	return $kid;
106}
107
108sub loggrep {
109	my $self = shift;
110	my($regex, $timeout) = @_;
111
112	my $end;
113	$end = time() + $timeout if $timeout;
114
115	do {
116		my($kid, $status, $code) = $self->wait(WNOHANG);
117		if ($self->{alarm} && $kid > 0 &&
118		    WIFSIGNALED($status) && WTERMSIG($status) == 14 ) {
119			# child killed by SIGALRM as expected
120			print {$self->{log}} "Alarm", "\n";
121		} elsif ($kid > 0 && $status != 0) {
122			# child terminated with failure
123			die ref($self), " child status: $status $code";
124		}
125		open(my $fh, '<', $self->{logfile})
126		    or die ref($self), " log file open failed: $!";
127		my $match = first { /$regex/ } <$fh>;
128		return $match if $match;
129		close($fh);
130		# pattern not found
131		if ($kid == 0) {
132			# child still running, wait for log data
133			sleep .1;
134		} else {
135			# child terminated, no new log data possible
136			return;
137		}
138	} while ($timeout and time() < $end);
139
140	return;
141}
142
143sub up {
144	my $self = shift;
145	my $timeout = shift || 10;
146	$self->loggrep(qr/$self->{up}/, $timeout)
147	    or croak ref($self), " no '$self->{up}' in $self->{logfile} ".
148		"after $timeout seconds";
149	return $self;
150}
151
152sub down {
153	my $self = shift;
154	my $timeout = shift || 20;
155	$self->loggrep(qr/$self->{down}/, $timeout)
156	    or croak ref($self), " no '$self->{down}' in $self->{logfile} ".
157		"after $timeout seconds";
158	return $self;
159}
160
1611;
162