Girocco/extra/capture_command.pl

   1 # capature_command.pl -- alternative to IPC::Open3
   2 # Copyright (C) 2015 Kyle J. McKay.  All rights reserved
   3
   4 # This program is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU General Public License
   6 # as published by the Free Software Foundation; either version 2
   7 # of the License, or (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  17
  18 use strict;
  19 use warnings;
  20
  21 sub _set_nonblock {
  22         use Fcntl ();
  23         my $fd = shift;
  24         my $flags = fcntl($fd, &Fcntl::F_GETFL, 0);
  25         defined($flags) or die "fcntl failed: $!";
  26         fcntl($fd, &Fcntl::F_SETFL, $flags | &Fcntl::O_NONBLOCK)
  27                 or die "fcntl failed: $!";
  28 }
  29
  30 # Return the entire output sent to stdout and/or stderr from running a command.
  31 # Input is redirected to input or /dev/null.  Noncaptured output is totally
  32 # discarded.  Returns ($status, $output) where $status will be undef if there
  33 ## was a problem running the command (see $!) otherwise $status will be the
  34 # full waitpid $? result.  $output will contain the captured output unless
  35 # $status is undefined.
  36 # First argument is:
  37 #  0 => discard stdout and stderr, only return command status
  38 #  1 => capture stdout, discard stderr, return command status
  39 #  2 => capture stderr, discard stdout, return command status
  40 #  3 => capture stdout+stderr, return command status
  41 # Second argument is undef, '' or string to send to command's stdin.
  42 # Subsequent arguments are command and arguments for pipe open call.
  43 # All I/O is byte-oriented, input MUST NOT be in internal UTF-8 format.
  44 # Note that if fd 0, 1, or 2 are NOT currently open when this function
  45 # is called, they WILL be opened to File::Spec->devnull afterwards.
  46 sub capture_command {
  47         # We avoid using STDIN/STDOUT in order to be compatible with FCGI mode
  48         use Errno ();
  49         use File::Spec ();
  50         use POSIX ();
  51         my $flags = shift;
  52         my $input = shift;
  53         defined($flags) or $flags = 1;
  54         defined($input) or $input = '';
  55         local $^F = 2; # just in case
  56         defined(my $nullfd = POSIX::open(File::Spec->devnull, &POSIX::O_RDWR))
  57                 or die "couldn't open devnull: $!";
  58         while ($nullfd <= 2) {
  59                 # paranoia
  60                 defined($nullfd = POSIX::dup($nullfd))
  61                         or die "couldn't dup devnull: $!";
  62         }
  63         my ($pipe_inp_r, $pipe_inp_w);
  64         my $pipe_inp_w_fd = -1;
  65         if ($input ne '') {
  66                 pipe($pipe_inp_r, $pipe_inp_w) or die "pipe failed: $!";
  67                 select((select($pipe_inp_w),$|=1)[0]);
  68                 _set_nonblock($pipe_inp_w);
  69                 $pipe_inp_w_fd = fileno($pipe_inp_w);
  70         }
  71         my ($pipe_out_r, $pipe_out_w);
  72         my $pipe_out_r_fd = -1;
  73         if ($flags & 0x3) {
  74                 pipe($pipe_out_r, $pipe_out_w) or die "pipe failed: $!";
  75                 select((select($pipe_out_r),$|=1)[0]);
  76                 _set_nonblock($pipe_out_r);
  77                 $pipe_out_r_fd = fileno($pipe_out_r);
  78         }
  79         my ($pipe_stat_r, $pipe_stat_w);
  80         pipe($pipe_stat_r, $pipe_stat_w) or die "pipe failed: $!";
  81         select((select($pipe_stat_w),$|=1)[0]);
  82         my $new0 = $input ne '' ? fileno($pipe_inp_r) : $nullfd;
  83         my $new1 = ($flags & 0x01) ? fileno($pipe_out_w) : $nullfd;
  84         my $new2 = ($flags & 0x02) ? fileno($pipe_out_w) : $nullfd;
  85         my $piped = 0;
  86         my $eofed = 0;
  87         my $oldsigchld = $SIG{'CHLD'};
  88         my $oldsigpipe = $SIG{'PIPE'};
  89         $SIG{'CHLD'} = sub {};
  90         $SIG{'PIPE'} = sub {$piped = 1};
  91         my $pid = fork();
  92         if (defined($pid) && !$pid) {
  93                 # child here
  94                 {
  95                         defined(POSIX::dup2($new0, 0)) or last;
  96                         defined(POSIX::dup2($new1, 1)) or last;
  97                         defined(POSIX::dup2($new2, 2)) or last;
  98                         POSIX::close($nullfd);
  99                         $SIG{'CHLD'} = sub {};
 100                         $SIG{'PIPE'} = 'DEFAULT';
 101                         exec @_;
 102                 }
 103                 # dup2 or exec failed if we get here
 104                 print $pipe_stat_w (0+$!),"\n";
 105                 POSIX::_exit 127;
 106         }
 107         POSIX::close($nullfd);
 108         close($pipe_inp_r) if $input ne '';
 109         close($pipe_out_w) if $flags & 0x03;
 110         close($pipe_stat_w);
 111         my $status;
 112         my $output;
 113         if (defined($pid)) {{
 114                 my $childstat = <$pipe_stat_r>;
 115                 close($pipe_stat_r);
 116                 if (defined($childstat) && $childstat ne '') {
 117                         # reap the failed child
 118                         waitpid($pid, 0);
 119                         chomp $childstat;
 120                         $! = Errno::EIO;
 121                         $! = 0 + $childstat if $childstat =~ /^[1-9][0-9]*$/;
 122                         last;
 123                 }
 124                 $output = "";
 125                 my $inpoff = 0;
 126                 my ($rv, $wv, $ev) = ("","","");
 127                 vec($rv,0,1) = 0;
 128                 vec($wv,0,1) = 0;
 129                 vec($rv,$pipe_out_r_fd,1) = 1 if $pipe_out_r_fd >= 0;
 130                 vec($wv,$pipe_inp_w_fd,1) = 1 if $pipe_inp_w_fd >= 0;
 131                 $ev = $rv | $wv;
 132                 if ($pipe_out_r_fd >= 0 || $pipe_inp_w_fd >= 0) {{
 133                         my ($rout, $wout, $ready);
 134                         my $n = select(($rout=$rv),($wout=$wv),($ready=$ev),undef);
 135                         die "select failed: $!" unless defined($n) || $!{EINTR} || $!{EAGAIN};
 136                         redo unless defined($n);
 137                         $ready = $ready | $rout | $wout;
 138                         if ($pipe_out_r_fd >= 0 && vec($ready, $pipe_out_r_fd, 1)) {
 139                                 my $c;
 140                                 do {
 141                                         $c = sysread($pipe_out_r, $output, 32768, length($output));
 142                                 } while defined($c) && $c > 0;
 143                                 if ((defined($c) && !$c) || (!defined($c) && !($!{EINTR} || $!{EAGAIN}))) {
 144                                         vec($rv,$pipe_out_r_fd,1) = 0;
 145                                         vec($ev,$pipe_out_r_fd,1) = 0;
 146                                         $eofed = 1;
 147                                         close($pipe_out_r);
 148                                 }
 149                         }
 150                         if ($pipe_inp_w_fd >= 0 && vec($ready, $pipe_inp_w_fd, 1)) {
 151                                 my $c;
 152                                 do {
 153                                         $c = syswrite($pipe_inp_w, $input, length($input)-$inpoff, $inpoff);
 154                                         $inpoff += $c if defined($c);
 155                                         $piped = 1 if $inpoff >= length($input);
 156                                 } while (!$piped && defined($c) && $c > 0);
 157                                 if ($piped || (defined($c) && !$c) || (!defined($c) && !($!{EINTR} || $!{EAGAIN}))) {
 158                                         vec($wv,$pipe_inp_w_fd,1) = 0;
 159                                         vec($ev,$pipe_inp_w_fd,1) = 0;
 160                                         $piped = 1;
 161                                         close($pipe_inp_w);
 162                                 }
 163                         }
 164                         redo unless ($piped || $pipe_inp_w_fd < 0) && ($eofed || $pipe_out_r_fd < 0);
 165                 }}
 166                 # Wait for child to finish
 167                 my $w = waitpid($pid, 0);
 168                 $status = $? if $w == $pid;
 169         }}
 170         $SIG{'CHLD'} = defined($oldsigchld) ? $oldsigchld : sub {};
 171         $SIG{'PIPE'} = defined($oldsigpipe) ? $oldsigpipe : 'DEFAULT';
 172         return ($status, $output);
 173 }
 174
 175 1;