user-tools/triggerexec

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 triggerexec - description
   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 LIMITATIONS
  45
  46 =head1 SEE ALSO
  47
  48 expect(1)
  49
  50 =cut
  51
  52
  53 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, };
  54 use Cwd qw/getcwd realpath/;
  55 use Data::Dumper;
  56 use Date::Parse;
  57 use DateTime::Format::Strptime;
  58 use Encode qw/decode encode decode_utf8 encode_utf8/;
  59 use Errno qw/:POSIX/;
  60 use Fcntl qw/:flock :seek F_GETFL F_SETFL O_NONBLOCK F_GETFD F_SETFD FD_CLOEXEC/;
  61 use File::Basename;
  62 use File::Temp qw/tempfile/;
  63 use Getopt::Long qw/:config no_ignore_case no_bundling no_getopt_compat no_auto_abbrev require_order/;
  64 use IPC::Run qw/run start finish/;
  65 use List::MoreUtils qw/all any none/;
  66 use Pod::Usage;
  67 use POSIX;
  68 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  69
  70
  71 GetOptions(
  72         'help' => sub { pod2usage(-exitval=>0, -verbose=>99); },
  73         '<>' => sub { unshift @ARGV, @_[0]; die '!FINISH'; },
  74 ) or pod2usage(-exitval=>2, -verbose=>99);
  75
  76
  77 @Param = ();
  78 while(my $arg = shift @ARGV)
  79 {
  80         last if $arg eq '--';
  81         push @Param, $arg;
  82 }
  83
  84 @Trigger = ();
  85 while(my $param = shift @Param)
  86 {
  87         my $action = shift @Param;
  88         push @Trigger, {event=>$param, action=>$action,};
  89 }
  90
  91 sub do_action
  92 {
  93         my $action = shift;
  94         my $PARAM = shift;
  95         if($action =~ /^perl:(.*)$/)
  96         {
  97                 eval $1;
  98                 warn $@ if $@;
  99         }
 100         # else {} TODO validate action expressions at start
 101 }
 102
 103 sub process_output_line
 104 {
 105         my $stream_name = shift;
 106         my $line = shift;
 107
 108         for my $trig (@Trigger)
 109         {
 110                 if($trig->{event} =~ /^(stdout|stderr):(.*)/)
 111                 {
 112                         my $event_stream_name = $1;
 113                         my $pattern = $2;
 114                         if($event_stream_name eq $stream_name)
 115                         {
 116                                 if($line =~ /$pattern/)
 117                                 {
 118                                         do_action($trig->{action}, {line=>$line});
 119                                 }
 120                         }
 121                 }
 122                 # else {} # TODO validate event expressions at start
 123         }
 124 }
 125
 126 sub process_buffer
 127 {
 128         my $buffer_ref = shift;
 129         my $last_call = shift;
 130         my $func_ref = shift;
 131         my $args_ref = shift;
 132
 133         while(1)
 134         {
 135                 my $eolpos = index $$buffer_ref, "\n";
 136                 last if $eolpos < 0;
 137                 $eolpos++;  # include the trailing linefeed
 138                 my $line = substr($$buffer_ref, 0, $eolpos);
 139                 $func_ref->(@$args_ref, $line);
 140                 $$buffer_ref = substr($$buffer_ref, $eolpos);
 141         }
 142         if($last_call and $$buffer_ref ne '')
 143         {
 144                 # process the last incomplete line, if any
 145                 $func_ref->(@$args_ref, $$buffer_ref);
 146         }
 147 }
 148
 149 sub read_stdout
 150 {
 151         my $chunk = shift;
 152         $stdout_buffer .= $chunk;
 153         process_buffer(\$stdout_buffer, 0, \&process_output_line, ['stdout']);
 154         print STDOUT $chunk;
 155 }
 156
 157 sub read_stderr
 158 {
 159         my $chunk = shift;
 160         $stderr_buffer .= $chunk;
 161         process_buffer(\$stderr_buffer, 0, \&process_output_line, ['stderr']);
 162         print STDERR $chunk;
 163 }
 164
 165 $stdout_buffer = '';
 166 $stderr_buffer = '';
 167
 168 $ipc = start [@ARGV], \*STDIN, \&read_stdout, \&read_stderr;
 169 $COMMAND_PID = $ipc->{KIDS}->[0]->{PID};
 170 finish $ipc;
 171 $status = $?;
 172
 173 process_buffer(\$stdout_buffer, 1, \&process_output_line, ['stdout']);
 174 process_buffer(\$stderr_buffer, 1, \&process_output_line, ['stderr']);
 175
 176 $exitcode = WEXITSTATUS($status);
 177 $exitcode = 128 + WTERMSIG($status) if WIFSIGNALED($status);
 178 exit $exitcode;