1# $OpenBSD: Proc.pm,v 1.13 2021/10/12 05:42:39 anton Exp $ 2 3# Copyright (c) 2010-2016 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 Errno; 23use File::Basename; 24use IO::File; 25use POSIX; 26use Time::HiRes qw(time alarm sleep); 27 28my %CHILDREN; 29 30sub kill_children { 31 my @pids = @_ ? @_ : keys %CHILDREN 32 or return; 33 my @perms; 34 foreach my $pid (@pids) { 35 if (kill(TERM => $pid) != 1 and $!{EPERM}) { 36 push @perms, $pid; 37 } 38 } 39 if (my @sudo = split(' ', $ENV{SUDO}) and @perms) { 40 local $?; # do not modify during END block 41 my @cmd = (@sudo, '/bin/kill', '-TERM', @perms); 42 system(@cmd); 43 } 44 delete @CHILDREN{@pids}; 45} 46 47BEGIN { 48 $SIG{TERM} = $SIG{INT} = sub { 49 my $sig = shift; 50 kill_children(); 51 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 52 POSIX::raise($sig); 53 }; 54} 55 56END { 57 kill_children(); 58 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 59} 60 61sub new { 62 my $class = shift; 63 my $self = { @_ }; 64 $self->{down} ||= "Shutdown"; 65 $self->{func} && ref($self->{func}) eq 'CODE' 66 or croak "$class func not given"; 67 $self->{logfile} 68 or croak "$class log file not given"; 69 open(my $fh, '>', $self->{logfile}) 70 or die "$class log file $self->{logfile} create failed: $!"; 71 $fh->autoflush; 72 $self->{log} = $fh; 73 $self->{ppid} = $$; 74 return bless $self, $class; 75} 76 77sub run { 78 my $self = shift; 79 80 pipe(my $reader, my $writer) 81 or die ref($self), " pipe to child failed: $!"; 82 defined(my $pid = fork()) 83 or die ref($self), " fork child failed: $!"; 84 if ($pid) { 85 $CHILDREN{$pid} = 1; 86 $self->{pid} = $pid; 87 close($reader); 88 $self->{pipe} = $writer; 89 return $self; 90 } 91 %CHILDREN = (); 92 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 93 $SIG{__DIE__} = sub { 94 die @_ if $^S; 95 warn @_; 96 IO::Handle::flush(\*STDERR); 97 POSIX::_exit(255); 98 }; 99 open(STDERR, '>&', $self->{log}) 100 or die ref($self), " dup STDERR failed: $!"; 101 close($writer); 102 open(STDIN, '<&', $reader) 103 or die ref($self), " dup STDIN failed: $!"; 104 close($reader); 105 106 do { 107 $self->child(); 108 print STDERR $self->{up}, "\n"; 109 $self->{begin} = time(); 110 $self->{func}->($self); 111 } while ($self->{redo}); 112 $self->{end} = time(); 113 print STDERR "Shutdown", "\n"; 114 if ($self->{timefile}) { 115 open(my $fh, '>>', $self->{timefile}) 116 or die ref($self), " open $self->{timefile} failed: $!"; 117 printf $fh "time='%s' duration='%.10g' ". 118 "forward='%s' test='%s'\n", 119 scalar(localtime(time())), $self->{end} - $self->{begin}, 120 $self->{forward}, basename($self->{testfile}); 121 } 122 123 IO::Handle::flush(\*STDOUT); 124 IO::Handle::flush(\*STDERR); 125 POSIX::_exit(0); 126} 127 128sub wait { 129 my $self = shift; 130 my $flags = shift; 131 132 # if we a not the parent process, assume the child is still running 133 return 0 unless $self->{ppid} == $$; 134 135 my $pid = $self->{pid} 136 or croak ref($self), " no child pid"; 137 my $kid = waitpid($pid, $flags); 138 if ($kid > 0) { 139 my $status = $?; 140 my $code; 141 $code = "exit: ". WEXITSTATUS($?) if WIFEXITED($?); 142 $code = "signal: ". WTERMSIG($?) if WIFSIGNALED($?); 143 $code = "stop: ". WSTOPSIG($?) if WIFSTOPPED($?); 144 delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?); 145 return wantarray ? ($kid, $status, $code) : $kid; 146 } 147 return $kid; 148} 149 150sub loggrep { 151 my $self = shift; 152 my($regex, $timeout) = @_; 153 154 my $end; 155 $end = time() + $timeout if $timeout; 156 157 do { 158 my($kid, $status, $code) = $self->wait(WNOHANG); 159 if ($kid > 0 && $status != 0 && !$self->{dryrun}) { 160 # child terminated with failure 161 die ref($self), " child status: $status $code"; 162 } 163 open(my $fh, '<', $self->{logfile}) 164 or die ref($self), " log file open failed: $!"; 165 my @match = grep { /$regex/ } <$fh>; 166 return wantarray ? @match : $match[0] if @match; 167 close($fh); 168 # pattern not found 169 if ($kid == 0) { 170 # child still running, wait for log data 171 sleep .1; 172 } else { 173 # child terminated, no new log data possible 174 return; 175 } 176 } while ($timeout and time() < $end); 177 178 return; 179} 180 181sub up { 182 my $self = shift; 183 my $timeout = shift || 10; 184 $self->loggrep(qr/$self->{up}/, $timeout) 185 or croak ref($self), " no '$self->{up}' in $self->{logfile} ". 186 "after $timeout seconds"; 187 return $self; 188} 189 190sub down { 191 my $self = shift; 192 my $timeout = shift || 30; 193 $self->loggrep(qr/$self->{down}/, $timeout) 194 or croak ref($self), " no '$self->{down}' in $self->{logfile} ". 195 "after $timeout seconds"; 196 return $self; 197} 198 199sub kill_child { 200 my $self = shift; 201 kill_children($self->{pid}); 202 return $self; 203} 204 2051; 206