1# $OpenBSD: Proc.pm,v 1.9 2020/07/24 22:12:00 bluhm Exp $ 2 3# Copyright (c) 2010-2020 Alexander Bluhm <bluhm@openbsd.org> 4# Copyright (c) 2014 Florian Riehm <mail@friehm.de> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 18use strict; 19use warnings; 20 21package Proc; 22use BSD::Resource qw(getrlimit setrlimit get_rlimits); 23use Carp; 24use Errno; 25use IO::File; 26use POSIX; 27use Time::HiRes qw(time alarm sleep); 28 29my %CHILDREN; 30 31sub kill_children { 32 my @pids = @_ ? @_ : keys %CHILDREN 33 or return; 34 my @perms; 35 foreach my $pid (@pids) { 36 if (kill(TERM => $pid) != 1 and $!{EPERM}) { 37 push @perms, $pid; 38 } 39 } 40 if (my $sudo = $ENV{SUDO} and @perms) { 41 local $?; # do not modify during END block 42 my @cmd = ($sudo, '/bin/kill', '-TERM', @perms); 43 system(@cmd); 44 } 45 delete @CHILDREN{@pids}; 46} 47 48BEGIN { 49 $SIG{TERM} = $SIG{INT} = sub { 50 my $sig = shift; 51 kill_children(); 52 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 53 POSIX::raise($sig); 54 }; 55} 56 57END { 58 kill_children(); 59 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 60} 61 62sub new { 63 my $class = shift; 64 my $self = { @_ }; 65 $self->{down} ||= "Shutdown"; 66 $self->{func} && ref($self->{func}) eq 'CODE' 67 or croak "$class func not given"; 68 $self->{ktracepid} && $self->{ktraceexec} 69 and croak "$class ktrace both pid and exec given"; 70 !($self->{ktracepid} || $self->{ktraceexec}) || $self->{ktracefile} 71 or croak "$class ktrace file not given"; 72 $self->{logfile} 73 or croak "$class log file not given"; 74 open(my $fh, '>', $self->{logfile}) 75 or die "$class log file $self->{logfile} create failed: $!"; 76 $fh->autoflush; 77 $self->{log} = $fh; 78 $self->{ppid} = $$; 79 return bless $self, $class; 80} 81 82sub run { 83 my $self = shift; 84 85 pipe(my $reader, my $writer) 86 or die ref($self), " pipe to child failed: $!"; 87 defined(my $pid = fork()) 88 or die ref($self), " fork child failed: $!"; 89 if ($pid) { 90 $CHILDREN{$pid} = 1; 91 $self->{pid} = $pid; 92 close($reader); 93 $self->{pipe} = $writer; 94 return $self; 95 } 96 %CHILDREN = (); 97 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 98 $SIG{__DIE__} = sub { 99 die @_ if $^S; 100 warn @_; 101 IO::Handle::flush(\*STDERR); 102 POSIX::_exit(255); 103 }; 104 open(STDERR, '>&', $self->{log}) 105 or die ref($self), " dup STDERR failed: $!"; 106 open(STDOUT, '>&', $self->{log}) 107 or die ref($self), " dup STDOUT failed: $!"; 108 close($writer); 109 open(STDIN, '<&', $reader) 110 or die ref($self), " dup STDIN failed: $!"; 111 close($reader); 112 113 if ($self->{rlimit}) { 114 my $rlimits = get_rlimits() 115 or die ref($self), " get_rlimits failed: $!"; 116 while (my($name, $newsoft) = each %{$self->{rlimit}}) { 117 defined(my $resource = $rlimits->{$name}) 118 or die ref($self), " rlimit $name does not exists"; 119 my ($soft, $hard) = getrlimit($resource) 120 or die ref($self), " getrlimit $name failed: $!"; 121 setrlimit($resource, $newsoft, $hard) or die ref($self), 122 " setrlimit $name to $newsoft failed: $!"; 123 } 124 } 125 if ($self->{ktracepid}) { 126 my @cmd = ($self->{ktracepid}, "-i", "-f", $self->{ktracefile}, 127 "-p", $$); 128 system(@cmd) 129 and die ref($self), " system '@cmd' failed: $?"; 130 } 131 do { 132 $self->child(); 133 print STDERR $self->{up}, "\n"; 134 $self->{func}->($self); 135 } while ($self->{redo}); 136 print STDERR "Shutdown", "\n"; 137 138 IO::Handle::flush(\*STDOUT); 139 IO::Handle::flush(\*STDERR); 140 POSIX::_exit(0); 141} 142 143sub wait { 144 my $self = shift; 145 my $flags = shift; 146 147 # if we a not the parent process, assume the child is still running 148 return 0 unless $self->{ppid} == $$; 149 150 my $pid = $self->{pid} 151 or croak ref($self), " no child pid"; 152 my $kid = waitpid($pid, $flags); 153 if ($kid > 0) { 154 my $status = $?; 155 my $code; 156 $code = "exit: ". WEXITSTATUS($?) if WIFEXITED($?); 157 $code = "signal: ". WTERMSIG($?) if WIFSIGNALED($?); 158 $code = "stop: ". WSTOPSIG($?) if WIFSTOPPED($?); 159 delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?); 160 return wantarray ? ($kid, $status, $code) : $kid; 161 } 162 return $kid; 163} 164 165sub loggrep { 166 my $self = shift; 167 my($regex, $timeout, $count) = @_; 168 my $exit = ($self->{exit} // 0) << 8; 169 170 my $end; 171 $end = time() + $timeout if $timeout; 172 173 do { 174 my($kid, $status, $code) = $self->wait(WNOHANG); 175 if ($kid > 0 && $status != $exit) { 176 # child terminated with failure 177 die ref($self), " child status: $status $code"; 178 } 179 open(my $fh, '<', $self->{logfile}) 180 or die ref($self), " log file open failed: $!"; 181 my @match = grep { /$regex/ } <$fh>; 182 return wantarray ? @match : $match[0] 183 if !$count && @match or $count && @match >= $count; 184 close($fh); 185 # pattern not found 186 if ($kid == 0) { 187 # child still running, wait for log data 188 sleep .1; 189 } else { 190 # child terminated, no new log data possible 191 return; 192 } 193 } while ($timeout and time() < $end); 194 195 return; 196} 197 198sub up { 199 my $self = shift; 200 my $timeout = shift || 10; 201 $self->loggrep(qr/$self->{up}/, $timeout) 202 or croak ref($self), " no '$self->{up}' in $self->{logfile} ". 203 "after $timeout seconds"; 204 return $self; 205} 206 207sub down { 208 my $self = shift; 209 my $timeout = shift || 60; 210 $self->loggrep(qr/$self->{down}/, $timeout) 211 or croak ref($self), " no '$self->{down}' in $self->{logfile} ". 212 "after $timeout seconds"; 213 return $self; 214} 215 216sub kill_child { 217 my $self = shift; 218 kill_children($self->{pid}); 219 return $self; 220} 221 222sub kill { 223 my $self = shift; 224 my $sig = shift // 'TERM'; 225 my $pid = shift // $self->{pid}; 226 227 if (kill($sig => $pid) != 1) { 228 my $sudo = $ENV{SUDO}; 229 $sudo && $!{EPERM} 230 or die ref($self), " kill $pid failed: $!"; 231 my @cmd = ($sudo, '/bin/kill', "-$sig", $pid); 232 system(@cmd) 233 and die ref($self), " sudo kill $pid failed: $?"; 234 } 235 return $self; 236} 237 2381; 239