user-tools/redirexec

   1 #!/usr/bin/env perl
   2
   3
   4 =pod
   5
   6 =head1 NAME
   7
   8 redirexec - Execute a command with some file descriptiors redirected.
   9
  10 =head1 SYNOPSIS
  11
  12 redirexec [I<FILENO>:I<MODE>:file:I<PATH>] [--] I<COMMAND> I<ARGS>
  13
  14 redirexec [I<FILENO>:I<MODE>:fd:I<FD>] [--] I<COMMAND> I<ARGS>
  15
  16 redirexec [I<FILENO>:-] [--] I<COMMAND> I<ARGS>
  17
  18 =head1 DESCRIPTION
  19
  20 Setup redirections before executing I<COMMAND>.
  21 You can setup the same type of file and file descriptor redirections as in shell.
  22
  23 I<FILENO> and I<FD> are file descriptor integers or literal "stdin", "stdout", or "stderr".
  24
  25 I<MODE> is one of:
  26
  27 =over 4
  28
  29 =item r
  30
  31 read
  32
  33 =item c
  34
  35 create/clobber
  36
  37 =item rw
  38
  39 read and write
  40
  41 =item a
  42
  43 append
  44
  45 =back
  46
  47 =head1 EXAMPLES
  48
  49   +-----------------+--------------------------+
  50   | shell syntax    | redirexec(1) equivalents |
  51   +=================+==========================+
  52   | > output.txt    | stdout:c:file:output.txt |
  53   |                 | 1:c:file:output.txt      |
  54   +-----------------+--------------------------+
  55   | 2>&1            | stderr:c:fd:stdout       |
  56   |                 | 2:c:fd:1                 |
  57   +-----------------+--------------------------+
  58   | </dev/null      | 0:r:file:/dev/null       |
  59   |                 | 0:-                      |
  60   +-----------------+--------------------------+
  61   | >/dev/null 2>&1 | 1:- 2:-                  |
  62   +-----------------+--------------------------+
  63
  64
  65 =head1 SEE ALSO
  66
  67 redirfd by execlineb(1)
  68
  69 =cut
  70
  71
  72 use POSIX qw/dup2/;
  73
  74 $0 =~ s/.*\/([^\/]+)$/$1/;
  75
  76 %perlopenmode = (
  77         'r' => {symbol => '<', word => 'read'},
  78         'c' => {symbol => '>', word => 'create/clobber'},
  79         'rw' => {symbol => '+<', word => 'read/write'},
  80         'a' => {symbol => '>>', word => 'append'},
  81 );
  82
  83 @redirs = ();
  84
  85 while(@ARGV)
  86 {
  87         my $fdspec = shift @ARGV;
  88         if($fdspec eq '--') { last; }
  89         if($fdspec =~ /^(?'fd'\d+|std(in|out|err)):(?'dest'-|(?'mode'r|c|rw|a):(file:(?'path'.+)|fd:(?'fileno'\d+|std(in|out|err))))$/)
  90         {
  91                 my ($fd, $dest, $mode, $path, $fileno) = ($+{'fd'}, $+{'dest'}, $+{'mode'}, $+{'path'}, $+{'fileno'});
  92                 $fd = 0 if $fd eq 'stdin';
  93                 $fd = 1 if $fd eq 'stdout';
  94                 $fd = 2 if $fd eq 'stderr';
  95                 $fileno = 0 if $fileno eq 'stdin';
  96                 $fileno = 1 if $fileno eq 'stdout';
  97                 $fileno = 2 if $fileno eq 'stderr';
  98                 if($dest eq '-')
  99                 {
 100                         $mode = 'rw';
 101                         $path = '/dev/null';
 102                 }
 103                 push @redirs, {
 104                         fd => $fd,
 105                         mode => $perlopenmode{$mode}->{'symbol'} . (defined $fileno ? '&=' : ''),
 106                         modename => $perlopenmode{$mode}->{'word'},
 107                         file => defined $fileno ? $fileno : $path,
 108                 };
 109         }
 110         else
 111         {
 112                 # does not seem to be a redirection specification, take it as the command
 113                 unshift @ARGV, $fdspec;
 114                 last;
 115         }
 116 }
 117
 118 @command = @ARGV;
 119
 120 for my $redir (@redirs)
 121 {
 122         open $fh, $redir->{'mode'}, $redir->{'file'} or die "$0: can not open ($redir->{'modename'}) $redir->{'file'}: $!\n";
 123         dup2(fileno $fh, $redir->{'fd'}) or die "$0: can not duplicate fd of $redir->{'file'}: $!\n";
 124 }
 125
 126 exec {$command[0]} @command;
 127 ($errno, $errstr) = (int $!, $!);
 128 warn "$0: ${command[0]}: $errstr\n";
 129 exit 125+$errno;