1# $OpenBSD: Proc.pm,v 1.8 2016/05/03 19:13:04 bluhm Exp $ 2 3# Copyright (c) 2010-2015 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->{ktrace} || $self->{ktracefile} 69 or croak "$class ktrace file not given"; 70 $self->{logfile} 71 or croak "$class log file not given"; 72 open(my $fh, '>', $self->{logfile}) 73 or die "$class log file $self->{logfile} create failed: $!"; 74 $fh->autoflush; 75 $self->{log} = $fh; 76 $self->{ppid} = $$; 77 return bless $self, $class; 78} 79 80sub run { 81 my $self = shift; 82 83 pipe(my $reader, my $writer) 84 or die ref($self), " pipe to child failed: $!"; 85 defined(my $pid = fork()) 86 or die ref($self), " fork child failed: $!"; 87 if ($pid) { 88 $CHILDREN{$pid} = 1; 89 $self->{pid} = $pid; 90 close($reader); 91 $self->{pipe} = $writer; 92 return $self; 93 } 94 %CHILDREN = (); 95 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 96 $SIG{__DIE__} = sub { 97 die @_ if $^S; 98 warn @_; 99 IO::Handle::flush(\*STDERR); 100 POSIX::_exit(255); 101 }; 102 open(STDERR, '>&', $self->{log}) 103 or die ref($self), " dup STDERR failed: $!"; 104 open(STDOUT, '>&', $self->{log}) 105 or die ref($self), " dup STDOUT failed: $!"; 106 close($writer); 107 open(STDIN, '<&', $reader) 108 or die ref($self), " dup STDIN failed: $!"; 109 close($reader); 110 111 if ($self->{rlimit}) { 112 my $rlimits = get_rlimits() 113 or die ref($self), " get_rlimits failed: $!"; 114 while (my($name, $newsoft) = each %{$self->{rlimit}}) { 115 defined(my $resource = $rlimits->{$name}) 116 or die ref($self), " rlimit $name does not exists"; 117 my ($soft, $hard) = getrlimit($resource) 118 or die ref($self), " getrlimit $name failed: $!"; 119 setrlimit($resource, $newsoft, $hard) or die ref($self), 120 " setrlimit $name to $newsoft failed: $!"; 121 } 122 } 123 if ($self->{ktrace}) { 124 my @cmd = ("ktrace", "-f", $self->{ktracefile}, "-p", $$); 125 system(@cmd) 126 and die ref($self), " system '@cmd' failed: $?"; 127 } 128 do { 129 $self->child(); 130 print STDERR $self->{up}, "\n"; 131 $self->{func}->($self); 132 } while ($self->{redo}); 133 print STDERR "Shutdown", "\n"; 134 135 IO::Handle::flush(\*STDOUT); 136 IO::Handle::flush(\*STDERR); 137 POSIX::_exit(0); 138} 139 140sub wait { 141 my $self = shift; 142 my $flags = shift; 143 144 # if we a not the parent process, assume the child is still running 145 return 0 unless $self->{ppid} == $$; 146 147 my $pid = $self->{pid} 148 or croak ref($self), " no child pid"; 149 my $kid = waitpid($pid, $flags); 150 if ($kid > 0) { 151 my $status = $?; 152 my $code; 153 $code = "exit: ". WEXITSTATUS($?) if WIFEXITED($?); 154 $code = "signal: ". WTERMSIG($?) if WIFSIGNALED($?); 155 $code = "stop: ". WSTOPSIG($?) if WIFSTOPPED($?); 156 delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?); 157 return wantarray ? ($kid, $status, $code) : $kid; 158 } 159 return $kid; 160} 161 162sub loggrep { 163 my $self = shift; 164 my($regex, $timeout, $count) = @_; 165 my $exit = ($self->{exit} // 0) << 8; 166 167 my $end; 168 $end = time() + $timeout if $timeout; 169 170 do { 171 my($kid, $status, $code) = $self->wait(WNOHANG); 172 if ($kid > 0 && $status != $exit) { 173 # child terminated with failure 174 die ref($self), " child status: $status $code"; 175 } 176 open(my $fh, '<', $self->{logfile}) 177 or die ref($self), " log file open failed: $!"; 178 my @match = grep { /$regex/ } <$fh>; 179 return wantarray ? @match : $match[0] 180 if !$count && @match or $count && @match >= $count; 181 close($fh); 182 # pattern not found 183 if ($kid == 0) { 184 # child still running, wait for log data 185 sleep .1; 186 } else { 187 # child terminated, no new log data possible 188 return; 189 } 190 } while ($timeout and time() < $end); 191 192 return; 193} 194 195sub up { 196 my $self = shift; 197 my $timeout = shift || 10; 198 $self->loggrep(qr/$self->{up}/, $timeout) 199 or croak ref($self), " no '$self->{up}' in $self->{logfile} ". 200 "after $timeout seconds"; 201 return $self; 202} 203 204sub down { 205 my $self = shift; 206 my $timeout = shift || 60; 207 $self->loggrep(qr/$self->{down}/, $timeout) 208 or croak ref($self), " no '$self->{down}' in $self->{logfile} ". 209 "after $timeout seconds"; 210 return $self; 211} 212 213sub kill_child { 214 my $self = shift; 215 kill_children($self->{pid}); 216 return $self; 217} 218 219sub kill { 220 my $self = shift; 221 my $sig = shift // 'TERM'; 222 my $pid = shift // $self->{pid}; 223 224 if (kill($sig => $pid) != 1) { 225 my $sudo = $ENV{SUDO}; 226 $sudo && $!{EPERM} 227 or die ref($self), " kill $pid failed: $!"; 228 my @cmd = ($sudo, '/bin/kill', "-$sig", $pid); 229 system(@cmd) 230 and die ref($self), " sudo kill $pid failed: $?"; 231 } 232 return $self; 233} 234 2351; 236