1# $OpenBSD: Proc.pm,v 1.4 2016/05/03 19:13:04 bluhm Exp $ 2 3# Copyright (c) 2010-2014 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 Carp; 23use Errno; 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 = $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 return bless $self, $class; 74} 75 76sub run { 77 my $self = shift; 78 79 pipe(my $reader, my $writer) 80 or die ref($self), " pipe to child failed: $!"; 81 defined(my $pid = fork()) 82 or die ref($self), " fork child failed: $!"; 83 if ($pid) { 84 $CHILDREN{$pid} = 1; 85 $self->{pid} = $pid; 86 close($reader); 87 $self->{pipe} = $writer; 88 return $self; 89 } 90 %CHILDREN = (); 91 $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 92 $SIG{__DIE__} = sub { 93 die @_ if $^S; 94 warn @_; 95 IO::Handle::flush(\*STDERR); 96 POSIX::_exit(255); 97 }; 98 open(STDERR, '>&', $self->{log}) 99 or die ref($self), " dup STDERR failed: $!"; 100 open(STDOUT, '>&', $self->{log}) 101 or die ref($self), " dup STDOUT failed: $!"; 102 close($writer); 103 open(STDIN, '<&', $reader) 104 or die ref($self), " dup STDIN failed: $!"; 105 close($reader); 106 107 $self->child(); 108 print STDERR $self->{up}, "\n"; 109 $self->{func}->($self); 110 print STDERR "Shutdown", "\n"; 111 112 IO::Handle::flush(\*STDOUT); 113 IO::Handle::flush(\*STDERR); 114 POSIX::_exit(0); 115} 116 117sub wait { 118 my $self = shift; 119 my $flags = shift; 120 121 my $pid = $self->{pid} 122 or croak ref($self), " no child pid"; 123 my $kid = waitpid($pid, $flags); 124 if ($kid > 0) { 125 my $status = $?; 126 my $code; 127 $code = "exit: ". WEXITSTATUS($?) if WIFEXITED($?); 128 $code = "signal: ". WTERMSIG($?) if WIFSIGNALED($?); 129 $code = "stop: ". WSTOPSIG($?) if WIFSTOPPED($?); 130 delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?); 131 return wantarray ? ($kid, $status, $code) : $kid; 132 } 133 return $kid; 134} 135 136sub loggrep { 137 my $self = shift; 138 my($regex, $timeout) = @_; 139 140 my $end; 141 $end = time() + $timeout if $timeout; 142 143 do { 144 my($kid, $status, $code) = $self->wait(WNOHANG); 145 if ($kid > 0 && $status != 0) { 146 # child terminated with failure 147 die ref($self), " child status: $status $code"; 148 } 149 open(my $fh, '<', $self->{logfile}) 150 or die ref($self), " log file open failed: $!"; 151 my @match = grep { /$regex/ } <$fh>; 152 return wantarray ? @match : $match[0] if @match; 153 close($fh); 154 # pattern not found 155 if ($kid == 0) { 156 # child still running, wait for log data 157 sleep .1; 158 } else { 159 # child terminated, no new log data possible 160 return; 161 } 162 } while ($timeout and time() < $end); 163 164 return; 165} 166 167sub up { 168 my $self = shift; 169 my $timeout = shift || 10; 170 $self->loggrep(qr/$self->{up}/, $timeout) 171 or croak ref($self), " no '$self->{up}' in $self->{logfile} ". 172 "after $timeout seconds"; 173 return $self; 174} 175 176sub down { 177 my $self = shift; 178 my $timeout = shift || 30; 179 $self->loggrep(qr/$self->{down}/, $timeout) 180 or croak ref($self), " no '$self->{down}' in $self->{logfile} ". 181 "after $timeout seconds"; 182 return $self; 183} 184 185sub kill_child { 186 my $self = shift; 187 kill_children($self->{pid}); 188 return $self; 189} 190 1911; 192