user-tools/triggerexec

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 triggerexec - Run a command and do various specified actions depending on what command does
   8
   9 =head1 SYNOPSIS
  10
  11 triggerexec [I<EVENT> I<ACTION> [I<EVENT> I<ACTION> [...]]] [--] I<COMMAND> [I<ARGS>]
  12
  13 =head1 DESCRIPTION
  14
  15 Run I<COMMAND> and execute specific actions depending on
  16 what I<COMMAND> does.
  17
  18 Supported I<EVENT> events:
  19
  20 =over 4
  21
  22 =item B<stdout>:I<PATTERN>
  23
  24 =item B<stderr>:I<PATTERN>
  25
  26 Match I<PATTERN> regex pattern to B<stdout>/B<stderr> line-wise.
  27
  28 =back
  29
  30 Supported I<ACTION> actions:
  31
  32 =over 4
  33
  34 =item B<perl>:I<EXPR>
  35
  36 Evaluate perl expression in triggerexec(1)'s own context.
  37 Useful variables:
  38 B<$COMMAND_PID> is the I<COMMAND>'s PID.
  39 B<$PARAM> is a hash ref containing event parameters,
  40 for example B<$PARAM->{line}> is the text triggered the action - if applicable (B<stdout:>/B<stderr:> events).
  41
  42 =back
  43
  44 =head1 IMPLEMENTATION STATUS
  45
  46 incomplete
  47
  48 =head1 LIMITATIONS
  49
  50 =head1 SEE ALSO
  51
  52 expect(1)
  53
  54 =cut
  55
  56
  57 use constant { STAT_DEV=>0, STAT_INODE=>1, STAT_PERM=>2, STAT_NLINKS=>3, STAT_UID=>4, STAT_GID=>5, STAT_RDEV=>6, STAT_SIZE=>7, STAT_ATIME=>8, STAT_MTIME=>9, STAT_CTIME=>10, STAT_BLOCKSIZE=>11, STAT_BLOCKS=>12, };
  58 use Cwd qw/getcwd realpath/;
  59 use Data::Dumper;
  60 use Date::Parse;
  61 use DateTime::Format::Strptime;
  62 use Encode qw/decode encode decode_utf8 encode_utf8/;
  63 use Errno qw/:POSIX/;
  64 use Fcntl qw/:flock :seek F_GETFL F_SETFL O_NONBLOCK F_GETFD F_SETFD FD_CLOEXEC/;
  65 use File::Basename;
  66 use File::Temp qw/tempfile/;
  67 use Getopt::Long qw/:config no_ignore_case no_bundling no_getopt_compat no_auto_abbrev require_order/;
  68 use IPC::Run qw/run start finish/;
  69 use List::MoreUtils qw/all any none/;
  70 use Pod::Usage;
  71 use POSIX;
  72 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  73
  74
  75 GetOptions(
  76         'help' => sub { pod2usage(-exitval=>0, -verbose=>99); },
  77         '<>' => sub { unshift @ARGV, @_[0]; die '!FINISH'; },
  78 ) or pod2usage(-exitval=>2, -verbose=>99);
  79
  80
  81 @Param = ();
  82 while(my $arg = shift @ARGV)
  83 {
  84         last if $arg eq '--';
  85         push @Param, $arg;
  86 }
  87
  88 @Trigger = ();
  89 while(my $param = shift @Param)
  90 {
  91         my $action = shift @Param;
  92         push @Trigger, {event=>$param, action=>$action,};
  93 }
  94
  95 sub do_action
  96 {
  97         my $action = shift;
  98         my $PARAM = shift;
  99         if($action =~ /^perl:(.*)$/)
 100         {
 101                 eval $1;
 102                 warn $@ if $@;
 103         }
 104         # else {} TODO validate action expressions at start
 105 }
 106
 107 sub process_output_line
 108 {
 109         my $stream_name = shift;
 110         my $line = shift;
 111
 112         for my $trig (@Trigger)
 113         {
 114                 if($trig->{event} =~ /^(stdout|stderr):(.*)/)
 115                 {
 116                         my $event_stream_name = $1;
 117                         my $pattern = $2;
 118                         if($event_stream_name eq $stream_name)
 119                         {
 120                                 if($line =~ /$pattern/)
 121                                 {
 122                                         do_action($trig->{action}, {line=>$line});
 123                                 }
 124                         }
 125                 }
 126                 # else {} # TODO validate event expressions at start
 127         }
 128 }
 129
 130 sub process_buffer
 131 {
 132         my $buffer_ref = shift;
 133         my $last_call = shift;
 134         my $func_ref = shift;
 135         my $args_ref = shift;
 136
 137         while(1)
 138         {
 139                 my $eolpos = index $$buffer_ref, "\n";
 140                 last if $eolpos < 0;
 141                 $eolpos++;  # include the trailing linefeed
 142                 my $line = substr($$buffer_ref, 0, $eolpos);
 143                 $func_ref->(@$args_ref, $line);
 144                 $$buffer_ref = substr($$buffer_ref, $eolpos);
 145         }
 146         if($last_call and $$buffer_ref ne '')
 147         {
 148                 # process the last incomplete line, if any
 149                 $func_ref->(@$args_ref, $$buffer_ref);
 150         }
 151 }
 152
 153 sub read_stdout
 154 {
 155         my $chunk = shift;
 156         $stdout_buffer .= $chunk;
 157         process_buffer(\$stdout_buffer, 0, \&process_output_line, ['stdout']);
 158         print STDOUT $chunk;
 159 }
 160
 161 sub read_stderr
 162 {
 163         my $chunk = shift;
 164         $stderr_buffer .= $chunk;
 165         process_buffer(\$stderr_buffer, 0, \&process_output_line, ['stderr']);
 166         print STDERR $chunk;
 167 }
 168
 169 $stdout_buffer = '';
 170 $stderr_buffer = '';
 171
 172 $ipc = start [@ARGV], \*STDIN, \&read_stdout, \&read_stderr;
 173 $COMMAND_PID = $ipc->{KIDS}->[0]->{PID};
 174 finish $ipc;
 175 $status = $?;
 176
 177 process_buffer(\$stdout_buffer, 1, \&process_output_line, ['stdout']);
 178 process_buffer(\$stderr_buffer, 1, \&process_output_line, ['stderr']);
 179
 180 $exitcode = WEXITSTATUS($status);
 181 $exitcode = 128 + WTERMSIG($status) if WIFSIGNALED($status);
 182 exit $exitcode;