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