#!/usr/bin/perl

# wait for event using a boolean expression and multitute of event sources

=head1 VERSION

Version 0.32

=cut

our $VERSION="0.32";

# 20071107 PJ jakobi@acm.org created - wait for processes, tty idle, files, grep in file
# 20071228 PJ added netidle, diskidle, cpuidle 
# 20090722 PJ 
# 20090824 PJ changed iostat, modified grep for 'command|', switched to strict
# 20090913 PJ fixed my($_) for older perls
# 20090917 PJ changes for cpan.org/scripts
#
# copyright:  (c)2007-2009, GPL v3 or later
# archive:    http://jakobi.github.com/script-archive-doc/ 
#             [check github.com/jakobi/script-archive/cli.processes 
#              for some ideas on using waitcond with dbus events]

use warnings;
use vars;
use strict;

# defaults for various options
my $Me=$0; $Me=~s!.*/!!;
my ($rc,$iter,$oldpackagecount,$packagecount,$count)=(0,0,0,0,0);
my ($sleep,$recent,$cpuidle,$diskidle,$netidle,$bytesnonempty);
my ($iostat,$ifconfig)=("","");
my ($countinit,$loopmax);
my ($grepmaxsize,$grepopt,$pscmd,$pingcmd, $tty);
$sleep=5;     # shorten to waitcond -V -C 1 -s 1 in case of debugging
$recent=300; 
$cpuidle=95;
$netidle=100; # still some slight spikes for $sleep < 3s on a dual cpu host
              # nfs gigabit cpio about 2000-30000 packets/s, depending on
              # disk i/o and possible head thrashing due to small files
$diskidle=10; # buffer cache heuristics -- expect SHORT EXTREME spikes 
              # both extremely idle and extremely busy
$bytesnonempty=0; 
$grepmaxsize=100000000;
$grepopt="m"; # eval "m//".$grepopt;
$pscmd="ps -edalf";
$pingcmd="ping -t 3 -c 2 >/dev/null 2>&1"; # command must provide rc 1 on fail
$tty=`tty`; $tty=~s!(/dev/|\n)!!g; # the part of the pty name that top/ps/... display
$loopmax=99999; # less than 6 days (assuming 5sec sleep + 0sec cpu usage per iteration)

$countinit=2;  # how many times do we require a true expr value in sequence to finish?


my ($negate,$test,$verbose,$ioargs,$initialsleep)=(0,0,0,0,"",0);


# matcher
my (@file); 
my ($and,$expr)=("","");
$and=""; # changed to "and " if an implicit and is possible


while($_=$ARGV[0]){ # OK
   /^(-V|-?-verbose)$/o  and do{shift; $verbose=1; next};
   /^(-v|--negate)$/o    and do{shift; $negate=1; next};
   /^-r$/o               and do{shift; $recent=shift; next};
   /^-c$/o               and do{shift; $cpuidle=shift; next};
   /^-d$/o               and do{shift; $diskidle=shift; next};
   /^-n$/o               and do{shift; $netidle=shift; next};
   /^-C$/o               and do{shift; $countinit=shift; next};
   /^-p$/o               and do{shift; $pscmd=shift; next};
   /^-T$/o               and do{shift; $loopmax=shift; next};
   /^-1$/o               and do{shift; $countinit=1; next};
   /^-i$/o               and do{shift; $grepopt.="i"; next};
   /^-b$/o               and do{shift; $bytesnonempty=shift; next};
   /^-s$/o               and do{shift; $sleep=shift; next};
   /^(-t|--test)$/o      and do{shift; $test=1; next};

   /^-(h|-?help|\?)$/o  and do{&usage; exit 1};
   /^-(-?examples)$/o   and do{&usage_examples; exit 1};
   /^--?$/o and do{shift; last};
   last;
}
do{print "no arguments to test..."; exit 1} if not @ARGV;



grep({/^cpuidle$/}  @ARGV) and $ioargs="2 3";                                # no spikes, but still some secs
                                                                             # waiting to get the current 
                                                                             # non-1-sec-period value...
grep({/^diskidle$/} @ARGV) and $ioargs="10 3";                               # spikes! -> 10sec (20s additional
                                                                             # delay just getting a useful
                                                                             # disk io statistic
grep({/^netidle$/}  @ARGV) and do{$initialsleep=$sleep=($sleep>3)?$sleep:3}; # spiky! -> adjust sleep int to
                                                                             # at least 3secs 


# compile and report boolean expression to wait for
$expr=compile(@ARGV); @ARGV=();
my $i=0; 
&vprint("\n# expression:\n$expr\n\n# files:\n", 
   join("\n",
      map {
         sprintf "%-3s %s", $i++.":", $_
      } 
   @file), 
   "\n\n");



$rc=eval($expr) ? 1 : 0; # 1st test plus syntax test
die "whatever this is, a boolean expression it ain't\n: $@\n" if $@;
&vprint("# 1st eval returned " . ( $rc ? "true" : "false" ) . "\n");
exit( $rc ? 0 : 1 ) if $test;
sleep $initialsleep if $initialsleep;



$rc=0;
# basically be paranoid and wait for countinit event repetitions
$count=$countinit;
while(($loopmax>0) and ($count>0)){
   until($rc=eval($expr)){
      &vprint("# loop condition not yet true ($count;$iter/$loopmax)\n");
      $count=$countinit;
      last if not $loopmax>0;
      $loopmax--;
      $iter++;
      sleep $sleep;
   }
   &vprint("# loop condition true ($count;$iter/$loopmax)\n");
   $count--;
   sleep $sleep if $count;
}



print main::STDERR "TIMEOUT OCCURED - returning result from last test\n" if not $loopmax>0;
exit( $rc ? 0 : 1 ); # switch to shell return code semantics



#-----------------------------------------------------------------------------------------------------------

sub newfile { # compile time: side effects: $_, $and, @file
   local($_);
   my ($flags);
   ($_,$flags)=@_;
   # allow user to omit the /dev/ prefix when just pasting
   # a tty name from say top or ps -edalf
   $_="/dev/$_" if /^pts\/\d+$/ and $flags=~/\bdev\b/ and not -e $_;
   push @file,$_;
   $and="and ";
   $#file;
};

sub compile {
   local($_);
   my($expr)="";
   while(@_){
      $_=shift;
      /^$/o         and do {die "illegal operator/argument"};
      # aliases
      /^idle$/o     and do {unshift @_, "not", "recent";   next};
      /^empty$/o    and do {unshift @_, "not", "nonempty"; next};
      /^sh$/o       and do {unshift @_, "grep", "()", shift()."|"; next };
      /^ping$/o     and do {unshift @_, "sh", $pingcmd." ".shift(); next};
      # syntactic sugar
      /^not$/o      and do {$expr.=$and  ."not ";                                      $and="";     next};
      /^and$/o      and do {$expr.="and ";                                             $and="";     next};
      /^or$/o       and do {$expr.="or ";                                              $and="";     next};
      /^\($/o       and do {$expr.=$and."( ";                                          $and="";     next};
      /^\)$/o       and do {$expr.=") ";                                               $and="and "; next};
      # functions
      /^exists$/o   and do {$expr.=$and  .'-e &fn('.       &newfile(shift).') ';       $and="and "; next };
      /^cpuidle$/o  and do {$expr.=$and  .'&cpuidle() ';                               $and="and "; next };
      /^diskidle$/o and do {$expr.=$and  .'&diskidle('."'".        (shift) ."'".') ';  $and="and "; next };
      /^netidle$/o  and do {$expr.=$and  .'&netidle('."'".         (shift) ."'".') ';  $and="and "; next };
      /^recent$/o   and do {$expr.=$and  .'&recent(&fn('.  &newfile(shift,"dev").')) ';$and="and "; next };
      /^ps$/o       and do {$expr.=$and  .'&grep_ps(\''.   shift().'\') ';             $and="and "; next };
      /^grep$/o     and do {$expr.=$and  .'&grep_file(\''. shift().'\', &fn('.&newfile(shift).')) '; 
                                                                                       $and="and "; next };
      /^nonempty$/o and do {$expr.=$and  .'&nonempty(&fn('.&newfile(shift).')) ';      $and="and "; next };
      # default
      1             and do {$expr.=$and.'-e &fn('.&newfile($_).') ';                   $and="and "; next };
      # not reached
      next; # never reached
   }
   $expr="not ( $expr )" if $negate; # -v global negation of expr
   $expr="&prep, $expr";
   return $expr;
}

#-----------------------------------------------------------------------------------------------------------
sub fn { # eval time: return $file($1), possibly replaced
         #         by the 1st file from a successful glob
   my $f=$file[$_[0]];
   my @f=();
   @f=glob($f) if $f=~s/^\*//o;
   $f=$f[0] if @f;
   return $f;
}

sub recent {
   # return false if file does not exist or file not 
   # modified in less than $recent seconds
   warn "# $Me: missing filename for recent/idle (or did you mean {cpu,net,disk}idle)?" if not $_[0];
   
   return((-e $_[0]) ? (time-(stat($_[0]))[9] < $recent) : 0); 
}

sub nonempty {
   # return false if file does not exist or file 
   # not having MORE bytes than bytesnonempty
   warn "# $Me: missing filename for nonempty/empty?" if not $_[0];
   return(-s $_[0] > $bytesnonempty); 
}

sub grep_ps {
   my($expr,$rc,$tmp)=($_[0],0,"");
   $tmp=`$pscmd`;
   $tmp=~s/^.*//; # header line
   # exclude SELF, but hopefully not too much else (the \d\d:\d\d are sufficient)
   $tmp=~s/.*\b$$\b.* \d\d:\d\d $tty\b.*$Me\b.*//gm; 

   $rc=1 if eval '$tmp=~/$expr/'.$grepopt; # no o!
   warn "# $Me: invalid grep in ps output: $@" if $@;
   $tmp="";
  
   return($rc);
}

sub grep_file {
   my($expr,$file)=@_;
   my($tmp,$rc)=("",1);
   # NOTE that '@file=("<", "file"); open(FH, @file)' != open(FH,"<",$file[1])
   # there's something shady going on with varargs or scalar vs wantarray,as
   # the @file attempt fails.
   if ($file=~/\|\s*$/) {
      # allow use of perl idiomatic 'command |' filenames 
      # this block temporarily uses shell rc semantics
      $rc=0; # shell.true
      open(FH,$file) and defined read(FH,$tmp,$grepmaxsize,0) and close FH or $rc=256;
      $rc=$?>>8 if $?;
      warn "# $Me: failed open/read for pipe grep $expr $file\n" if $rc and $rc==256;
      warn "# $Me: rc for pipe grep $expr $file: $rc\n"          if $rc and $rc!=256 and $verbose;
      $rc= $rc ? 0 : 1;
   } else {
      # ignore failure for this
      open(FH, "<", $file) and read(FH,$tmp,$grepmaxsize,0); close FH;
   }
   $rc and do{ eval '$tmp=~/$expr/'.$grepopt or $rc=0 }; # no o!
   warn "# $Me: invalid grep in file: $@" if $@; 
  
   return($rc);
}

sub cpuidle {
   my($idle)=("");
   pos $iostat=0;
   $iostat=~/\%user.*\n/g for(1..2); 
   $idle=$1 if $iostat=~/(.*\n)/g;
   $idle=~s/^\s+//;
   $idle=(split /\s+/,$idle)[5]; # %idle field content
   if ($idle=~/[^0-9\.]/) {
      warn "# $Me: parse problem with %idle / iostat: $idle?";
   } else {
      return($idle >= $cpuidle);
   }
   return(0);
}

sub netidle {
   my($dev)=@_;
   my($idle)=("");
   $oldpackagecount=$packagecount;
   $packagecount=0;
   $ifconfig=`ifconfig $dev`;
   pos $ifconfig=0;
   $packagecount+=$1 if $ifconfig=~/RX packets:\s*(\d+)/; 
   $packagecount+=$1 if $ifconfig=~/TX packets:\s*(\d+)/; 
   vprint("packagecount: $packagecount delta ". abs($packagecount-$oldpackagecount) ."\n");
   if ($packagecount and $oldpackagecount) {
      # counter wrap around is interpreted as transient busy
      return($netidle >= abs($packagecount-$oldpackagecount)) 
   } else {
      warn "# $Me: parse error with RX/TX sum/ ifconfig $dev: $packagecount?" if $iter>1;
   }   
   return(0);
}

sub diskidle { # iostat is SLOW! we need about 10s per measurement
               # and we need 3 iterations, the first block traditionally
               # being the summary, the last one may or maybe a summary
               # furthermore, we need a multiple second period to reliably
               # get usable values as iostat might report tps 0
               # in one second inspite of continually high disk i/o
   my($dev)=@_;
   my($tps)=("");
   pos $iostat=0;
   $iostat=~/\%user.*\n/g for(1..2);
   $iostat=~/\n(?=$dev)/g;
   $tps=$1 if $iostat=~/(.*\n)/g;
   $tps=~s/^\s+//;
   $tps=(split /\s+/,$tps)[1]; # tps field content
   if ($tps=~/[^0-9\.]/) {
      warn "# $Me: parse problem with tps / iostat: $tps?";
   } else {
      return($tps <= $diskidle);
   }
   return(0);
}

sub prep {
   $iostat=`iostat $ioargs` if $ioargs;
   warn "# $Me: no iostat" if $ioargs and not $iostat;
}

sub vprint {
   print(main::STDERR @_) if $verbose;
   return(@_);
}


#----------------------------------------------------------------------------------------

sub usage {
   print <<EOF;

waitcond [OPTIONS] EXPR

version: $VERSION

Wait  for  a  boolean condition expression to evaluate to true  for  a
minimum number of iterations (-c N; default $countinit).

The command exits immediately after the test with a suitable exit code
for  option  -t, and exits with a non-zero exit code after  a  timeout
(default $loopmax iterations).

EXPR  might  be as simple as a non-empty list of filenames,  which  is
expanded  into  a  perl boolean expression that tests  for  the  ANDed
existence  of  all files. Note that perl's AND actually is ANDSEQ  and
thus  stops  testing the next sub expression if it cannot  reach  true
anyway.

Alternately  it  can be a valid complex boolean expression  containing
parenthesis  and the keywords "and", "or", "not" in addition to atoms.
A  sequence of multiple atoms is ANDed. Use ./ or similar if  keywords
and filenames collide.

Atoms for boolean expressions are

a) filenames - test for existance the file.
b) fileglobs - beginning with '*', the remainder is assumed to be a
   glob pattern and IFF matching files do exist _at_ _run-time_, 
   the argument is replaced by the first of these matching files.
c) functions without arguments
   1) "cpuidle" 
d) functions that take 'filenames' or fileglobs as argument:
   (you may need to protect the execution of more complex tests 
    with earlier tests for the existance of files - not being
    able to grep an error string in the log might be due to an
    even larger error when the application died before creating
    or updating the log...)
   1) "exists"        (alias ->see case a)
   2) "recent"        (file is recently touched)
   3) "nonempty"      (file is small/empty)
   4) "idle", "empty" (alias ->recent, ->nonempty)
   5) "diskidle"      (argument is device basename, e.g. sda; like
                       cpuidle, it is implemented via iostat and takes
                       about 30s to get a usable value when using 
                       iostat 10 3)
   6) "netidle"       (argument is device basename, e.g. eth0)
   7) "sh"            (run shell command and use its return code; ->grep)
   8) "ping"          (ping a host; update \$pingcmd if necessary ->sh)
e) functions with a perl regex as first argument (modifiers: $grepopt):
   1) "ps" greps in $pscmd (update \$pscmd if necessary)
   2) "grep" greps in the file given as second argument, allowing
       use of perl-style 'command |' pseudo filenames to regularly
       run a shell command, test its return code and for a zero shell
       return code, grep the command output. Use a regex like '()' 
       if you are only interested in the commands shell return code.

Options:
  -V     verbose output incl. printing of the compiled expression
  -i     ignore case for ps and grep
  -p CMD use as ps command 
  -t     test condition and return immediately with exit code 
         for testing or e.g. for use in "while LIST; do LIST; done"
  -v     globally negate condition 
  
  -C N   require the expression to be true for a sequence of N 
         iterations before exiting. -1 implies -C 1 ($countinit) 
  -T N   timeout after CNT iterations, returning last eval results
         ($loopmax)
  -b N   nonempty(/empty): files must have more than N bytes 
         ($bytesnonempty)

         # NOTE that idle itself always refers to files, NOT to cpu
  -c N   cpuidle:  if more than N [%] ($cpuidle)
  -d N   diskidle: if less than N transactions per second ($diskidle)
  -n N   netidle:  if less than N packets per iteration are sent or 
         received ($netidle)

  -r SEC recent(/idle): modified/touched within SEC seconds ($recent)
  -s SEC sleep SEC seconds ($sleep) 
  

For additional notes and examples try --examples.

See also: sleepuntil, waitcond.timeout

EOF
}

sub usage_examples {
   print <<'EOF';

Notes:
  - grep has a sanity limit of $grepmaxsize
  - changing $pscmd may profit from updating the self-removal in grep_ps
  - fwait is a similar tool to waitcond with a somewhat simpler 
    syntax. It implements a subset of waitcond, but lacks the idle*
    functionality.
  - use something like script or pty3.p as a man-in-the-middle to allow 
    greping in a logfile of pty output for situations when normal 
    redirection or tee fail (xterm _might_ also be able to turn on logging;
    screen offers logging (log on; logfile FILE); screen can also be asked
    remotely to 'hardcopy' a snapshot of its scrollback buffer).

Examples: 
  - regularly run a command and wait for a zero shell return code (=success)
    waitcond grep '()' 'true|'

  - regularly run a command and grep even if the command fails
    (example waits for the existance of NaMe in the current dir):
    waitcond grep 'NaMe(?!: No such file)' '{ ls -1d NaMe 2>&1; true; } |'
    as the shell never sees the final '|', we can strip the braces:
    waitcond grep 'NaMe(?!: No such file)' 'ls -1d NaMe 2>&1;true|'

  - wait for processes PID to exit:
    while ps -p 100 102 >/dev/null; do sleep 1; done
    waitcond not /proc/PID not /proc/PID # aka
    waitcond -v /proc/{PID,PID}
  
  - wait for processes matching PATTERN to exit:
    while zap -y -l PATTERN | grep . >/dev/null; do sleep 10; done # -a for all users
    while pgrep PATTERN >/dev/null; do sleep 10; done 
    # -f: egrep commandline, -t: tty, -v negate
    fwait    not ps:PATTERN
    waitcond not ps PATTERN

  - wait for 5min LOAD AVERAGE to fall below 1.05:
    [the problem being runlevel is a rather bad approx for
     the more interesting cpu short-term averages; but there's
     no procfile or command to get this value quickly]
    perl -e 'while(chomp($_=`uptime|cut -d, -f4`)>1.05){sleep 1}'

  - wait for cpu idle higher than 95%
    [ignoring the averages-SINCE-BOOT on the first and possibly 
     last lines; either waiting for ci times a one second idleness
     or better a slow 3-step mpstat testing for 10sec idleness] 
    # stupid cpu hog:  while true; do echo; done
    # perl -e '$c=$ci=3; while($c){while(CONDITION){$c=$ci;sleep 60;};$c--}'
    perl -e 'while(@m=split(/\s+/,`mpstat 10 3|tail -2|head -1`),$m[10]<95){sleep 1}'

    # use -c to set the threshold, and -s / -C to set the interval
    # length during which the condition is required to persist
    waitcond cpuidle # set threshold with -c; consider multicore issues

    in the same manner, (network)disk IO can be waited for with iostat, e.g.
    requiring the 2nd field (tps) of iostat 10 3|grep ^sda | tail -2|head -1
    to be SMALL.

    waitcond diskidle sda # set threshold with -d

    or with ifconfig, network packets per period using the difference of
    these values:
    ifconfig eth0|grep TX|head -1|sed 's/ error.*//;s/.*://'

    waitcond netidle eth0 # set threshold with -n

  - to wait until a process' tty is more than 5min idle 
    [-r RECENTTHRESHOLD / -s SLEEPINTERVAL, both in seconds
     uses: e.g. notification on install finished, or early notification of
     a job waiting for input in the middle of a lengthy compile...]
    [use who / who am i / or ps -ef to get the associated tty / or this one:]
    # perl -e 'split(/\s+/,$_=`ps -fp 24408|tail -n -1`);print "/dev/$_[5]\n"'
    waitcond not recent /dev/pts/13

  - to kill a program after a time interval or condition, try
    waitcond.timeout                               300 top
    waitcond.timeout -TERM:10:KILL                 300 top
    waitcond.timeout "waitcond not recent /dev/pts/13" top

  - to restart, these 'watchdogs' are more suitable
    # to kill/watch/restart a command consider e.g. *ps-watcher*
    #   even if this requires a small one-stanza config like e.g
    #   [aterm]\noccurs = none\naction = setsig aterm &\n
    #   ps-watcher can also be configured to kill on excess cpu, etc
    ps-watcher --sleep 10 --no-daemon --config example.ps-watcher 
    # or e.g. launchtool to restart a specific command 
    #   which is probably the minimum required command line
    launchtool -L -n -v --wait-times=1,1 -t sleep "bash -c 'sleep 10; false'" 
    # some init.d scripts may also demonstrate a suitable wrapper
    # however this insists on only one sleep running... and
    # while setting up groups and house holding (and allows
    # start/query/kill, it lacks watchdog/restart functions; making
    # launchtool more suitable)
    start-stop-daemon --start --exec /bin/sleep 3600
    # the famed upstart is worse (init/initctl) for non-init.d usage

  - dbus: have a look at the dbus-monitor-tail hack and waitcond.dbus.README
    on github.com/jakobi/script-archive/cli.processes/

EOF
}

=head1 NAME

waitcond  - Test or wait for event combinations like idleness, file or
process creation/termination.

=head1 SYNOPSIS

waitcond [OPTIONS]

=head1 DESCRIPTION

Like  tagls/Grep.pm, this script also offers boolean expressions, this
time  on top of a language of tests likes grepping in ps-output, files
and  logs, running shell commands, pinging hosts, testing existance of
files, threshold-based file mtime, as well as threshold-based cpu, net
or disk-idle.

See  github.com/jakobi/script-archive/cli.processes/ for some examples
on using waitcond with dbus events. More information is available with
the --help option.

=head1 AUTHOR

Peter Jakobi, C<< <jakobi at acm.org> >>

=head1 SUPPORT

For more information and the bug-tracker,  L<http://jakobi.github.com/script-archive-doc/>

=head1 COPYRIGHT & LICENSE

Copyright 2009 Peter Jakobi, all rights reserved. Made available under the GPL, version 3.

=begin comment

=head1 README

Test  or  wait  for  an event using boolean expressions on  top  of  a
language  of tests like grepping in ps-output and logs, pinging  hosts
or   waiting  for  events  like  'not-recently-changed'  or   'network
interface N is idle'.

=pod OSNAMES

linux
solaris
aix
freebsd

=pod SCRIPT CATEGORIES

UNIX/System_administration
Networking

=end comment

=cut



__END__

