1*f8f8530cSbluhm# $OpenBSD: Proc.pm,v 1.4 2016/05/03 19:13:04 bluhm Exp $ 2ccf9d2bcSbluhm 36404c9ddSbluhm# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org> 46404c9ddSbluhm# Copyright (c) 2014 Florian Riehm <mail@friehm.de> 56404c9ddSbluhm# 66404c9ddSbluhm# Permission to use, copy, modify, and distribute this software for any 76404c9ddSbluhm# purpose with or without fee is hereby granted, provided that the above 86404c9ddSbluhm# copyright notice and this permission notice appear in all copies. 96404c9ddSbluhm# 106404c9ddSbluhm# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 116404c9ddSbluhm# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 126404c9ddSbluhm# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 136404c9ddSbluhm# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 146404c9ddSbluhm# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 156404c9ddSbluhm# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 166404c9ddSbluhm# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 176404c9ddSbluhm 186404c9ddSbluhmuse strict; 196404c9ddSbluhmuse warnings; 206404c9ddSbluhm 216404c9ddSbluhmpackage Proc; 226404c9ddSbluhmuse Carp; 236404c9ddSbluhmuse Errno; 246404c9ddSbluhmuse IO::File; 256404c9ddSbluhmuse POSIX; 266404c9ddSbluhmuse Time::HiRes qw(time alarm sleep); 276404c9ddSbluhm 286404c9ddSbluhmmy %CHILDREN; 296404c9ddSbluhm 306404c9ddSbluhmsub kill_children { 316404c9ddSbluhm my @pids = @_ ? @_ : keys %CHILDREN 326404c9ddSbluhm or return; 336404c9ddSbluhm my @perms; 346404c9ddSbluhm foreach my $pid (@pids) { 356404c9ddSbluhm if (kill(TERM => $pid) != 1 and $!{EPERM}) { 366404c9ddSbluhm push @perms, $pid; 376404c9ddSbluhm } 386404c9ddSbluhm } 396404c9ddSbluhm if (my $sudo = $ENV{SUDO} and @perms) { 406404c9ddSbluhm local $?; # do not modify during END block 416404c9ddSbluhm my @cmd = ($sudo, '/bin/kill', '-TERM', @perms); 426404c9ddSbluhm system(@cmd); 436404c9ddSbluhm } 446404c9ddSbluhm delete @CHILDREN{@pids}; 456404c9ddSbluhm} 466404c9ddSbluhm 476404c9ddSbluhmBEGIN { 486404c9ddSbluhm $SIG{TERM} = $SIG{INT} = sub { 496404c9ddSbluhm my $sig = shift; 506404c9ddSbluhm kill_children(); 516404c9ddSbluhm $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 526404c9ddSbluhm POSIX::raise($sig); 536404c9ddSbluhm }; 546404c9ddSbluhm} 556404c9ddSbluhm 566404c9ddSbluhmEND { 576404c9ddSbluhm kill_children(); 586404c9ddSbluhm $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 596404c9ddSbluhm} 606404c9ddSbluhm 616404c9ddSbluhmsub new { 626404c9ddSbluhm my $class = shift; 636404c9ddSbluhm my $self = { @_ }; 646404c9ddSbluhm $self->{down} ||= "Shutdown"; 656404c9ddSbluhm $self->{func} && ref($self->{func}) eq 'CODE' 666404c9ddSbluhm or croak "$class func not given"; 676404c9ddSbluhm $self->{logfile} 686404c9ddSbluhm or croak "$class log file not given"; 696404c9ddSbluhm open(my $fh, '>', $self->{logfile}) 706404c9ddSbluhm or die "$class log file $self->{logfile} create failed: $!"; 716404c9ddSbluhm $fh->autoflush; 726404c9ddSbluhm $self->{log} = $fh; 736404c9ddSbluhm return bless $self, $class; 746404c9ddSbluhm} 756404c9ddSbluhm 766404c9ddSbluhmsub run { 776404c9ddSbluhm my $self = shift; 786404c9ddSbluhm 796404c9ddSbluhm pipe(my $reader, my $writer) 80aa8f1300Sbluhm or die ref($self), " pipe to child failed: $!"; 816404c9ddSbluhm defined(my $pid = fork()) 82aa8f1300Sbluhm or die ref($self), " fork child failed: $!"; 836404c9ddSbluhm if ($pid) { 846404c9ddSbluhm $CHILDREN{$pid} = 1; 856404c9ddSbluhm $self->{pid} = $pid; 866404c9ddSbluhm close($reader); 876404c9ddSbluhm $self->{pipe} = $writer; 886404c9ddSbluhm return $self; 896404c9ddSbluhm } 906404c9ddSbluhm %CHILDREN = (); 916404c9ddSbluhm $SIG{TERM} = $SIG{INT} = 'DEFAULT'; 926404c9ddSbluhm $SIG{__DIE__} = sub { 936404c9ddSbluhm die @_ if $^S; 946404c9ddSbluhm warn @_; 956404c9ddSbluhm IO::Handle::flush(\*STDERR); 966404c9ddSbluhm POSIX::_exit(255); 976404c9ddSbluhm }; 986404c9ddSbluhm open(STDERR, '>&', $self->{log}) 996404c9ddSbluhm or die ref($self), " dup STDERR failed: $!"; 1006404c9ddSbluhm open(STDOUT, '>&', $self->{log}) 1016404c9ddSbluhm or die ref($self), " dup STDOUT failed: $!"; 1026404c9ddSbluhm close($writer); 1036404c9ddSbluhm open(STDIN, '<&', $reader) 1046404c9ddSbluhm or die ref($self), " dup STDIN failed: $!"; 1056404c9ddSbluhm close($reader); 1066404c9ddSbluhm 1076404c9ddSbluhm $self->child(); 1086404c9ddSbluhm print STDERR $self->{up}, "\n"; 1096404c9ddSbluhm $self->{func}->($self); 1106404c9ddSbluhm print STDERR "Shutdown", "\n"; 111aa8f1300Sbluhm 1126404c9ddSbluhm IO::Handle::flush(\*STDOUT); 1136404c9ddSbluhm IO::Handle::flush(\*STDERR); 1146404c9ddSbluhm POSIX::_exit(0); 1156404c9ddSbluhm} 1166404c9ddSbluhm 1176404c9ddSbluhmsub wait { 1186404c9ddSbluhm my $self = shift; 1196404c9ddSbluhm my $flags = shift; 1206404c9ddSbluhm 1216404c9ddSbluhm my $pid = $self->{pid} 1226404c9ddSbluhm or croak ref($self), " no child pid"; 1236404c9ddSbluhm my $kid = waitpid($pid, $flags); 1246404c9ddSbluhm if ($kid > 0) { 1256404c9ddSbluhm my $status = $?; 1266404c9ddSbluhm my $code; 1276404c9ddSbluhm $code = "exit: ". WEXITSTATUS($?) if WIFEXITED($?); 1286404c9ddSbluhm $code = "signal: ". WTERMSIG($?) if WIFSIGNALED($?); 1296404c9ddSbluhm $code = "stop: ". WSTOPSIG($?) if WIFSTOPPED($?); 1306404c9ddSbluhm delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?); 1316404c9ddSbluhm return wantarray ? ($kid, $status, $code) : $kid; 1326404c9ddSbluhm } 1336404c9ddSbluhm return $kid; 1346404c9ddSbluhm} 1356404c9ddSbluhm 1366404c9ddSbluhmsub loggrep { 1376404c9ddSbluhm my $self = shift; 1386404c9ddSbluhm my($regex, $timeout) = @_; 1396404c9ddSbluhm 140*f8f8530cSbluhm my $end; 141*f8f8530cSbluhm $end = time() + $timeout if $timeout; 1426404c9ddSbluhm 1436404c9ddSbluhm do { 1446404c9ddSbluhm my($kid, $status, $code) = $self->wait(WNOHANG); 1456404c9ddSbluhm if ($kid > 0 && $status != 0) { 1466404c9ddSbluhm # child terminated with failure 1476404c9ddSbluhm die ref($self), " child status: $status $code"; 1486404c9ddSbluhm } 1496404c9ddSbluhm open(my $fh, '<', $self->{logfile}) 1506404c9ddSbluhm or die ref($self), " log file open failed: $!"; 1516404c9ddSbluhm my @match = grep { /$regex/ } <$fh>; 1526404c9ddSbluhm return wantarray ? @match : $match[0] if @match; 1536404c9ddSbluhm close($fh); 1546404c9ddSbluhm # pattern not found 1556404c9ddSbluhm if ($kid == 0) { 1566404c9ddSbluhm # child still running, wait for log data 1576404c9ddSbluhm sleep .1; 1586404c9ddSbluhm } else { 1596404c9ddSbluhm # child terminated, no new log data possible 1606404c9ddSbluhm return; 1616404c9ddSbluhm } 1626404c9ddSbluhm } while ($timeout and time() < $end); 1636404c9ddSbluhm 1646404c9ddSbluhm return; 1656404c9ddSbluhm} 1666404c9ddSbluhm 1676404c9ddSbluhmsub up { 1686404c9ddSbluhm my $self = shift; 1696404c9ddSbluhm my $timeout = shift || 10; 1706404c9ddSbluhm $self->loggrep(qr/$self->{up}/, $timeout) 171aa8f1300Sbluhm or croak ref($self), " no '$self->{up}' in $self->{logfile} ". 1726404c9ddSbluhm "after $timeout seconds"; 1736404c9ddSbluhm return $self; 1746404c9ddSbluhm} 1756404c9ddSbluhm 1766404c9ddSbluhmsub down { 1776404c9ddSbluhm my $self = shift; 1786404c9ddSbluhm my $timeout = shift || 30; 1796404c9ddSbluhm $self->loggrep(qr/$self->{down}/, $timeout) 180aa8f1300Sbluhm or croak ref($self), " no '$self->{down}' in $self->{logfile} ". 1816404c9ddSbluhm "after $timeout seconds"; 1826404c9ddSbluhm return $self; 1836404c9ddSbluhm} 1846404c9ddSbluhm 1856404c9ddSbluhmsub kill_child { 1866404c9ddSbluhm my $self = shift; 1876404c9ddSbluhm kill_children($self->{pid}); 1886404c9ddSbluhm return $self; 1896404c9ddSbluhm} 1906404c9ddSbluhm 1916404c9ddSbluhm1; 192