xref: /openbsd-src/regress/usr.sbin/ospfd/Proc.pm (revision f8f8530c5d69c4296688ec64f43be06dc9d09c3a)
1*f8f8530cSbluhm#	$OpenBSD: Proc.pm,v 1.4 2016/05/03 19:13:04 bluhm Exp $
2ccf9d2bcSbluhm
36404c9ddSbluhm# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org>
46404c9ddSbluhm# Copyright (c) 2014 Florian Riehm <mail@friehm.de>
56404c9ddSbluhm#
66404c9ddSbluhm# Permission to use, copy, modify, and distribute this software for any
76404c9ddSbluhm# purpose with or without fee is hereby granted, provided that the above
86404c9ddSbluhm# copyright notice and this permission notice appear in all copies.
96404c9ddSbluhm#
106404c9ddSbluhm# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
116404c9ddSbluhm# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
126404c9ddSbluhm# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
136404c9ddSbluhm# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
146404c9ddSbluhm# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
156404c9ddSbluhm# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
166404c9ddSbluhm# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
176404c9ddSbluhm
186404c9ddSbluhmuse strict;
196404c9ddSbluhmuse warnings;
206404c9ddSbluhm
216404c9ddSbluhmpackage Proc;
226404c9ddSbluhmuse Carp;
236404c9ddSbluhmuse Errno;
246404c9ddSbluhmuse IO::File;
256404c9ddSbluhmuse POSIX;
266404c9ddSbluhmuse Time::HiRes qw(time alarm sleep);
276404c9ddSbluhm
286404c9ddSbluhmmy %CHILDREN;
296404c9ddSbluhm
306404c9ddSbluhmsub kill_children {
316404c9ddSbluhm	my @pids = @_ ? @_ : keys %CHILDREN
326404c9ddSbluhm	    or return;
336404c9ddSbluhm	my @perms;
346404c9ddSbluhm	foreach my $pid (@pids) {
356404c9ddSbluhm		if (kill(TERM => $pid) != 1 and $!{EPERM}) {
366404c9ddSbluhm			push @perms, $pid;
376404c9ddSbluhm		}
386404c9ddSbluhm	}
396404c9ddSbluhm	if (my $sudo = $ENV{SUDO} and @perms) {
406404c9ddSbluhm		local $?;  # do not modify during END block
416404c9ddSbluhm		my @cmd = ($sudo, '/bin/kill', '-TERM', @perms);
426404c9ddSbluhm		system(@cmd);
436404c9ddSbluhm	}
446404c9ddSbluhm	delete @CHILDREN{@pids};
456404c9ddSbluhm}
466404c9ddSbluhm
476404c9ddSbluhmBEGIN {
486404c9ddSbluhm	$SIG{TERM} = $SIG{INT} = sub {
496404c9ddSbluhm		my $sig = shift;
506404c9ddSbluhm		kill_children();
516404c9ddSbluhm		$SIG{TERM} = $SIG{INT} = 'DEFAULT';
526404c9ddSbluhm		POSIX::raise($sig);
536404c9ddSbluhm	};
546404c9ddSbluhm}
556404c9ddSbluhm
566404c9ddSbluhmEND {
576404c9ddSbluhm	kill_children();
586404c9ddSbluhm	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
596404c9ddSbluhm}
606404c9ddSbluhm
616404c9ddSbluhmsub new {
626404c9ddSbluhm	my $class = shift;
636404c9ddSbluhm	my $self = { @_ };
646404c9ddSbluhm	$self->{down} ||= "Shutdown";
656404c9ddSbluhm	$self->{func} && ref($self->{func}) eq 'CODE'
666404c9ddSbluhm	    or croak "$class func not given";
676404c9ddSbluhm	$self->{logfile}
686404c9ddSbluhm	    or croak "$class log file not given";
696404c9ddSbluhm	open(my $fh, '>', $self->{logfile})
706404c9ddSbluhm	    or die "$class log file $self->{logfile} create failed: $!";
716404c9ddSbluhm	$fh->autoflush;
726404c9ddSbluhm	$self->{log} = $fh;
736404c9ddSbluhm	return bless $self, $class;
746404c9ddSbluhm}
756404c9ddSbluhm
766404c9ddSbluhmsub run {
776404c9ddSbluhm	my $self = shift;
786404c9ddSbluhm
796404c9ddSbluhm	pipe(my $reader, my $writer)
80aa8f1300Sbluhm	    or die ref($self), " pipe to child failed: $!";
816404c9ddSbluhm	defined(my $pid = fork())
82aa8f1300Sbluhm	    or die ref($self), " fork child failed: $!";
836404c9ddSbluhm	if ($pid) {
846404c9ddSbluhm		$CHILDREN{$pid} = 1;
856404c9ddSbluhm		$self->{pid} = $pid;
866404c9ddSbluhm		close($reader);
876404c9ddSbluhm		$self->{pipe} = $writer;
886404c9ddSbluhm		return $self;
896404c9ddSbluhm	}
906404c9ddSbluhm	%CHILDREN = ();
916404c9ddSbluhm	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
926404c9ddSbluhm	$SIG{__DIE__} = sub {
936404c9ddSbluhm		die @_ if $^S;
946404c9ddSbluhm		warn @_;
956404c9ddSbluhm		IO::Handle::flush(\*STDERR);
966404c9ddSbluhm		POSIX::_exit(255);
976404c9ddSbluhm	};
986404c9ddSbluhm	open(STDERR, '>&', $self->{log})
996404c9ddSbluhm	    or die ref($self), " dup STDERR failed: $!";
1006404c9ddSbluhm	open(STDOUT, '>&', $self->{log})
1016404c9ddSbluhm	    or die ref($self), " dup STDOUT failed: $!";
1026404c9ddSbluhm	close($writer);
1036404c9ddSbluhm	open(STDIN, '<&', $reader)
1046404c9ddSbluhm	    or die ref($self), " dup STDIN failed: $!";
1056404c9ddSbluhm	close($reader);
1066404c9ddSbluhm
1076404c9ddSbluhm	$self->child();
1086404c9ddSbluhm	print STDERR $self->{up}, "\n";
1096404c9ddSbluhm	$self->{func}->($self);
1106404c9ddSbluhm	print STDERR "Shutdown", "\n";
111aa8f1300Sbluhm
1126404c9ddSbluhm	IO::Handle::flush(\*STDOUT);
1136404c9ddSbluhm	IO::Handle::flush(\*STDERR);
1146404c9ddSbluhm	POSIX::_exit(0);
1156404c9ddSbluhm}
1166404c9ddSbluhm
1176404c9ddSbluhmsub wait {
1186404c9ddSbluhm	my $self = shift;
1196404c9ddSbluhm	my $flags = shift;
1206404c9ddSbluhm
1216404c9ddSbluhm	my $pid = $self->{pid}
1226404c9ddSbluhm	    or croak ref($self), " no child pid";
1236404c9ddSbluhm	my $kid = waitpid($pid, $flags);
1246404c9ddSbluhm	if ($kid > 0) {
1256404c9ddSbluhm		my $status = $?;
1266404c9ddSbluhm		my $code;
1276404c9ddSbluhm		$code = "exit: ".   WEXITSTATUS($?) if WIFEXITED($?);
1286404c9ddSbluhm		$code = "signal: ". WTERMSIG($?)    if WIFSIGNALED($?);
1296404c9ddSbluhm		$code = "stop: ".   WSTOPSIG($?)    if WIFSTOPPED($?);
1306404c9ddSbluhm		delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?);
1316404c9ddSbluhm		return wantarray ? ($kid, $status, $code) : $kid;
1326404c9ddSbluhm	}
1336404c9ddSbluhm	return $kid;
1346404c9ddSbluhm}
1356404c9ddSbluhm
1366404c9ddSbluhmsub loggrep {
1376404c9ddSbluhm	my $self = shift;
1386404c9ddSbluhm	my($regex, $timeout) = @_;
1396404c9ddSbluhm
140*f8f8530cSbluhm	my $end;
141*f8f8530cSbluhm	$end = time() + $timeout if $timeout;
1426404c9ddSbluhm
1436404c9ddSbluhm	do {
1446404c9ddSbluhm		my($kid, $status, $code) = $self->wait(WNOHANG);
1456404c9ddSbluhm		if ($kid > 0 && $status != 0) {
1466404c9ddSbluhm			# child terminated with failure
1476404c9ddSbluhm			die ref($self), " child status: $status $code";
1486404c9ddSbluhm		}
1496404c9ddSbluhm		open(my $fh, '<', $self->{logfile})
1506404c9ddSbluhm		    or die ref($self), " log file open failed: $!";
1516404c9ddSbluhm		my @match = grep { /$regex/ } <$fh>;
1526404c9ddSbluhm		return wantarray ? @match : $match[0] if @match;
1536404c9ddSbluhm		close($fh);
1546404c9ddSbluhm		# pattern not found
1556404c9ddSbluhm		if ($kid == 0) {
1566404c9ddSbluhm			# child still running, wait for log data
1576404c9ddSbluhm			sleep .1;
1586404c9ddSbluhm		} else {
1596404c9ddSbluhm			# child terminated, no new log data possible
1606404c9ddSbluhm			return;
1616404c9ddSbluhm		}
1626404c9ddSbluhm	} while ($timeout and time() < $end);
1636404c9ddSbluhm
1646404c9ddSbluhm	return;
1656404c9ddSbluhm}
1666404c9ddSbluhm
1676404c9ddSbluhmsub up {
1686404c9ddSbluhm	my $self = shift;
1696404c9ddSbluhm	my $timeout = shift || 10;
1706404c9ddSbluhm	$self->loggrep(qr/$self->{up}/, $timeout)
171aa8f1300Sbluhm	    or croak ref($self), " no '$self->{up}' in $self->{logfile} ".
1726404c9ddSbluhm		"after $timeout seconds";
1736404c9ddSbluhm	return $self;
1746404c9ddSbluhm}
1756404c9ddSbluhm
1766404c9ddSbluhmsub down {
1776404c9ddSbluhm	my $self = shift;
1786404c9ddSbluhm	my $timeout = shift || 30;
1796404c9ddSbluhm	$self->loggrep(qr/$self->{down}/, $timeout)
180aa8f1300Sbluhm	    or croak ref($self), " no '$self->{down}' in $self->{logfile} ".
1816404c9ddSbluhm		"after $timeout seconds";
1826404c9ddSbluhm	return $self;
1836404c9ddSbluhm}
1846404c9ddSbluhm
1856404c9ddSbluhmsub kill_child {
1866404c9ddSbluhm	my $self = shift;
1876404c9ddSbluhm	kill_children($self->{pid});
1886404c9ddSbluhm	return $self;
1896404c9ddSbluhm}
1906404c9ddSbluhm
1916404c9ddSbluhm1;
192