#!/usr/bin/perl
#
# swatch -- system watcher
#
# usage: swatch [ -c config_file ] [ -r restart_time ]
#   [ [ -f file_to_examine ] || [ -p program_to_pipe_from ]
#   || [ -t file_to_tail ] ]
#   [ -P pattern_separator ] [ -A action_separator ]
#   [ -I input_record_separator ]
#
# default: swatch -c ~/.swatchrc -t /var/log/syslog
#
# Created on Thu Mar 19 10:10:19 PST 1992 by Todd_Atkins@EE-CF.Stanford.EDU
#
# Copyright (c) 1992 Leland Stanford Jr. University Board of Trustees
#
# $Log: Copyright.pl,v $#
# Revision 2.0  1994/03/25  16:59:35  atkins
# initial revision of 2.0
#
#
eval '/usr/bin/perl -S $0 ${1+"$@"}'
    if 0 ;
#
$ENV{'PATH'} = '/usr/ucb:/usr/bin:/bin:/usr/bin' ;
$ENV{'IFS'} = '' if $ENV{'IFS'} ne '' ;

$VERSION = '2.1' ;

# The location of our supporting cast
$SWATCH_PERL_LIB = '/usr/lib' ;
unshift(@INC, $SWATCH_PERL_LIB) ;

require 'ctime.pl' ;
require 'yagrip.pl' ;

# Some defaults
$PERL			= '/usr/bin/perl' ;
$TAIL			= '/usr/bin/tail -f' ;
$DEF_INPUT		= "$TAIL /var/log/syslog" ;
$Pipe			= 1 ;
$ConfigFile		= "$ENV{'HOME'}/.swatchrc" ;
$PatternSeparator	= ',' ;
$ActionSeparator	= ',' ;
#
$Done			= 0 ;	### Done watching
$Restart		= 0 ;	### Restart watcher


############################
# Set up signal handlers
############################

# catch these signals so that we can clean up before dying
$SIG{'INT'} = $SIG{'QUIT'} =  $SIG{'TERM'} = 'quit' ;
# catch these signals so that we can restart swatch more easily
$SIG{'ALRM'} = $SIG{'HUP'} = 'restart' ;

#######################################################
# Get the command line arguments and process them
#######################################################

&getopt("c:r:A:P:I:df:p:t:") ||
  die &usage("$0","c:r:A:P:I:f:p:t:","config_file","time_to_restart",
	     "action_separator","pattern_separator",
	     "input_record_separator",
	     "file_to_examine","program_to_pipe_from","file_to_tail") ;

if    ($opt_c)	{ $ConfigFile = $opt_c ; }
if    ($opt_r)	{ $RestartTime = $opt_r ; &set_alarm($RestartTime) ; }
if    ($opt_A)	{ $ActionSeparator = $opt_A ; }
if    ($opt_P)	{ $PatternSeparator = $opt_P ; }
if    ($opt_I)	{ $/ = $opt_I ; }

if    ($opt_f)	{ $Input = $opt_f ; $Pipe = 0 ; }
elsif ($opt_p)	{ $Input = "$opt_p" ; }
elsif ($opt_t)	{ $Input = "$TAIL $opt_t" ; }
else		{ $Input = $DEF_INPUT ; }

if ($opt_d) { # debugging
    $swatchScript = "&STDOUT" ;
} else {
    $swatchScript = "/tmp/..swatch..$$" ;
}

####################
# Main section
####################

do {
    $Restart = 0 ;
    &doit() ;
} until $Done ;

&quit() ;

sub doit {
    #
    # create the perl script 
    #
    open(OUTPUT,">$swatchScript") || die "$0: can't open $swatchScript: $!\n" ;
    select((select(OUTPUT), $| = 1)[0]); # unbuffer pipe

    &put_header() ;
    &sw_cf2pl($ConfigFile,$swatchScript) ;
    &put_footer() ;

    close(OUTPUT) ;

    #
    # Run the perl script unless we are debugging
    #
    if (! $opt_d ) { 
        undef $pid ;
        FORK: {
          if ($pid = fork) {
              waitpid($pid,0) ;
          } elsif (defined $pid) {
    	      chmod 0755, $swatchScript ;
              exec($swatchScript) ;
	      die "$0: exec of $swatchScript failed: $!\n" ;
          } elsif ($! =~ /No more processes/) {
              # EAGAIN, supposedly recoverable fork error
              sleep 5;
              redo FORK;
          } else {
              die "Can't fork: $!\n";
          }
        }
	$Done = 1 if !$Restart ;
    } else {
	$Done = 1 ;
    }
}

#########################
# End of Main section
#########################


#########################################
#
# makescript.pl -- Swatcher script creation subroutines
#
#########################################

#
# put_header -- print out the start of our swatch generated perl script
#
# usage: &put_header() ;
#
sub put_header {
    # get the perl version information
    local($junk,$junk,$junk,$Revision,$junk,$Date,$junk,$junk,$junk,$junk,$PatchLevel) = split(/[ \t\n]+/,$]);

    print  OUTPUT "#!$PERL\n" ;
    print  OUTPUT "#\n" ;
    printf OUTPUT "# Created on %s", &ctime(time) ;
    print  OUTPUT "# Created by $0 $VERSION using Perl $Revision Patch Level $PatchLevel ($Date)\n";
    print  OUTPUT "#\n" ;
    print  OUTPUT "# Copyright 1994 Stanford University Board of Trustees\n" ;
    print  OUTPUT "#\n" ;
    print  OUTPUT "unshift(\@INC, '$SWATCH_PERL_LIB') ;\n" ;
    print  OUTPUT "require 'sw_actions.pl' ;\n" ;
    print  OUTPUT "require 'sw_history.pl' ;\n" ;
    print  OUTPUT "\n" ;
    print  OUTPUT "\$/ = \"$/\" ;\n" ; 
    print  OUTPUT "\$Input = '$Input' ;\n" ;
    print  OUTPUT "\$SIG{'TERM'} = 'goodbye' ;\n" ;
    print  OUTPUT "\n" ;
    print  OUTPUT "select((select(STDOUT), \$| = 1)[0]); # unbuffer pipe\n" ;
    print  OUTPUT "\n" ;
    if ($Pipe) {
      print  OUTPUT "require 'open2.pl' ;\n" ;
      print  OUTPUT "\$childPid = &open2('read_fh', 'write_fh', \$Input) ;\n" ;
    } else {
      print  OUTPUT "open(read_fh,\$Input) || die \"$0: cannot open \$Input: \$!\\n\" ;\n" ;
    }
    print  OUTPUT "select((select(read_fh), \$| = 1)[0]); # unbuffer pipe\n" ;
    print  OUTPUT "\n" ;
    print  OUTPUT "LINE: while (<read_fh>) {\n" ;
}


#
# sw_cf2pl -- convert the configuration file to perl
#
# usage: cf2pl(input_file_name,output_file_name)
#

sub sw_cf2pl {
    local($InputFile,$OutputFile) = @_ ;
    local($UserName)		= $ENV{'USER'} ;
    local($BoldPrint)		=  "\033[1m" ;
    local($BlinkPrint)		=  "\033[5m" ;
    local($InversePrint)	=  "\033[7m" ;
    local($NormalPrint)		=  "\033[0m" ;
    local($UnderscorePrint)	=  "\033[4m" ;
    local($LineNum)		= 0 ;

    $OutputFile = '+>>' . $OutputFile ;
    open(INPUT, $InputFile) || die "$0: cannot open $InputFile: $!\n" ;
    open(OUTPUT, $OutputFile) || die "$0: cannot open $OutputFile: $!\n" ;

    $FirstLine = 1 ;

    INPUTLOOP: while (<INPUT>) {
	$LineNum++ ;
	chop ;

	next INPUTLOOP if substr($_, 0, 1) eq '#' || !length($_) ;

	local($PatternList,$ActionList,$Interval,$TimeStampLoc)
	 = split(/[\t]+/,$_,4) ;

	@Patterns = split($PatternSeparator, $PatternList) ;
	@Actions = split($ActionSeparator, $ActionList) ;

	### Insert the pattern list ###

	if ($FirstLine) {
	    print OUTPUT "  if (" ;
	    $FirstLine = 0 ;
	} else {
	    print OUTPUT "  } elsif (" ;
	}

	$FirstPattern = 1 ;
	foreach $Pattern (@Patterns) {
	    if ($FirstPattern) {
		print  OUTPUT " $Pattern" ;
	        $FirstPattern = 0 ;
	    } else {
		print  OUTPUT " || $Pattern"  ;
	    }
        }
	print OUTPUT " ) {\n" ;
	
	### Insert history list check if necessary ###
	if (defined $Interval) {
	   $Interval = &hms2s($Interval) ;
	   print OUTPUT "    if (! &skip_message(&strip_message(\$_,\"$TimeStampLoc\"), $Interval)) {\n" ;
	}

	### Insert the actions ###
	foreach $Action (@Actions) {
	    ($Action,$Value) = split("=", $Action, 2) ;
	    $Action =~ tr/A-Z/a-z/ ;

	    if ("bell" eq $Action) {
		printf OUTPUT "\t\&do_bell(%d) ;\n", $Value ? $Value : 1 ;
	    } elsif ("echo" eq $Action) {
		undef $PrintMode ;
		$Value =~ tr/A-Z/a-z/ ;
		$Value =~ s/ //g ;
		$PrintMode .= $BoldPrint if index($Value, "bold") != -1 ;
		$PrintMode .= $BlinkPrint if index($Value, "blink") != -1 ;
		$PrintMode .= $InversePrint if index($Value, "inverse") != -1 ;
		$PrintMode .= $NormalPrint if index($Value, "normal") != -1 ;
		$PrintMode .= $UnderscorePrint if index($Value, "underscore") != -1 ;
                if ( defined $Interval ) {
	            print OUTPUT "\t\$echo_message = &format_message(\$_,\"$TimeStampLoc\") ;\n" ;
                } else {
		    print OUTPUT "\t\$echo_message = \$_ ;\n" ;
		}
		printf OUTPUT "\tprint \"%s\$echo_message%s\";\n",
		       $PrintMode,
		       $PrintMode ? $NormalPrint : "" ;
            } elsif ("exec" eq $Action || "system" eq $Action) {
                die "$0: 'exec' action requires a value (line $LineNum)\n" if !$Value ;
		print  OUTPUT "\t\$orig_input = \$_ ;\n" ;
                print  OUTPUT "\t\$[ = 1 ;\n" ;
		print  OUTPUT "\tchop ;\n" ;
		print  OUTPUT "\t\$_ =~ s/[;&\\(\\)\\|\\^><\\\$`'\\\\]/\\\\\$+/g ;\n" ;
                print  OUTPUT "\tsplit ;\n" ;
                if ("exec" eq $Action) {
                  printf OUTPUT "\t&exec_it(%s) ;\n", &convert_command($Value) ;
                } else {
                  printf OUTPUT "\tsystem(%s) ;\n", &convert_command($Value) ;
                }
                print  OUTPUT "\t\$[ = 0 ;\n" ;
		print  OUTPUT "\t\$_ = \$orig_input ;\n" ;
	    } elsif ("ignore" eq $Action) {
		printf OUTPUT "\n" ;
	    } elsif ("mail" eq $Action) {
		printf OUTPUT "\t&mail_it('%s', \$_) ;\n",
		       $Value ? $Value : $UserName ; 
	    } elsif ("pipe" eq $Action) {
                die "$0: 'pipe' action requires a value (line $LineNum)\n" if !$Value ;
		### Look to see if value is quoted ###
		local($first_char) = substr($Value,0,1) ;
		if ($first_char eq '"' || $first_char eq "'") {
		    printf OUTPUT "\t&pipe_it(%s, \$_) ;\n", $Value ;
		} else {
		    printf OUTPUT "\t&pipe_it(\"%s\", \$_) ;\n", $Value ;
		}
	    } elsif ("write" eq $Action) {
		printf OUTPUT "\t&write_it('%s', \$_) ;\n",
		       $Value ? $Value : $UserName ;
	    } else {
		die "$0: unrecognized action (line $LineNum): $Action\n" ;
	    }
        }  

        ### Insert the end block character for history check if statement ###
	if (defined $Interval) {
	    print OUTPUT "    }\n" ;
        }

	print  OUTPUT "\tnext LINE ;\n" ;
    }
    print OUTPUT "  }\n" ;
    close(INPUT) ;
}


#
# convert_command -- convert wildcards for fields in command from
#	awk type to perl type.  Also, single quote wildcards
#	for better security.
#
# usage: &convert_command($Command) ;
#
sub convert_command {
    local($Command) = @_ ;

    $Command =~ s/\$[0*]/\$_/g ;
    $Command =~ s/\$([1-9])/\$_[\1]/g ;

    return $Command ;
}


#
# put_footer -- finish our swatch generated perl script.
#
# usage: &put_footer() ;
#
sub put_footer {
    print  OUTPUT "}\n" ;
    print  OUTPUT "&goodbye() ;\n" ;
    print  OUTPUT "\n" ;
    print  OUTPUT "sub goodbye {\n" ;
    print  OUTPUT "  \$| = 0 ;\n" ;
    if ($Pipe) {
      print  OUTPUT "  kill('KILL',\$childPid) ;\n" ;
    } else {
      print  OUTPUT "  close(INPUT) ;\n" ;
    }
    print  OUTPUT "  \&close_pipe_if_open() ;\n" ;
    print  OUTPUT "  exit(0) ;\n" ;
    print  OUTPUT "}\n" ;
}

# hms2s -- Take a string which may be in the form hours:minutes:seconds,
#	convert it to just seconds, and return the number of seconds
#	
sub hms2s {
    local($hms) = @_ ;
    local($hours,$minutes,$seconds) ;
    if ($hms =~ /[0-9]+:[0-9]+:[0-9]+/) {
        ($hours,$minutes,$seconds) = split(":",$hms) ;
    } elsif ($hms =~ /[0-9]+:[0-9]+/) {
        ($minutes,$seconds) = split(":",$hms) ;
    } else {
        $seconds = $hms ;
    }

    return ($hours * 60 * 60) + ($minutes * 60) + $seconds ;
}

####################
#
# sighandlers.pl -- Signal handlers for Swatch
#
####################


#
# set_alarm -- set alarm to go off
#
# usage: &set_alarm($When) ;
#
sub set_alarm {
    local($When) = @_ ;
    local($Specific) = 1 ;
    local($AM) = 1 ;
    local($Hour) = 0 ;
    local($Minute) = 0 ;
    local($Seconds) = 0 ;
    local($CurTime) = 0 ;
    local($CurHour, $CurMin, $CurSec) ;
    local($H, $M, $S) ;

    $When =~ tr/A-Z/a-z/ ;

    if (($When =~ /[ap]m/) && ($When =~ /\+/)) {
	die "$0: restart time cannot contain a '+' and \"am\" or \"pm\"\n" ;
    }

    if ($When =~ /am/) {
        $When = substr($When, $[, rindex($When,"am")) ;
    } elsif ($When =~ /pm/) {
	$When = substr($When, $[, rindex($When,"pm")) ;
	$AM = 0 ;
    } elsif ($When =~ /[a-z]/) {
        die "$0: restart time must be in \"hour:minute\" format\n" ;
    }

    if ($When =~ /^\+/) {
        $Specific = 0 ;
	$When =~ s/^\+// ;
    }
    if ($When =~ /:/) {
	($Hour,$Minute) = split(":", $When) ;
	$Hour += 12 if (!$AM && $Hour < 12) ;
    } else {
	die "$0: restart time must be in \"hour:minute\" format\n" if $Specific;
	$Minute = $When ;
    }

    $CurTime = `/bin/date +%H:%M:%S` ;
    if ($Specific) {
        ($CurHour, $CurMin, $CurSec) = split(/[:\n]/, $CurTime) ;
        $S = 60 - $CurSec ;
        $M = $Minute - $CurMin > 0 ? $Minute - $CurMin
                                   : 60 + $Minute - $CurMin ;
        $H = $Hour - $CurHour > 0 ? $Hour - $CurHour : 24 + $Hour - $CurHour ;
        $H = $Minute - $CurMin > 0 ? $H : $H - 1 ;
        $Seconds = ((($H * 60) + $M) * 60) + $S ;
    } else {
        $Seconds = (($Hour * 60) + $Minute) * 60 ;
    }
    alarm($Seconds) ;
}



#
# quit -- terminate gracefully
#
# usage: &quit($SIGNAL) ;
#
sub quit {
    local($Sig) = @_ ;

    if ($Sig) { print STDERR "Caught a SIG$Sig -- shutting down\n" ; }
    kill('TERM', $pid) ;
    unlink($Output) ;
    exit(0) ;
}


#
# restart -- kill the child, delete the script, and start over.
#
# usage: &restart() ;
#
sub restart {
    local($Sig) = @_ ;
    print STDERR "Caught a SIG$Sig -- restarting\n" ;
    kill('TERM', $pid) ;
    waitpid($pid, 0) ;
    unlink($Output) ;
    $Restart = 1 ;
    &set_alarm($RestartTime) if ($RestartTime && $Sig eq 'ALRM') ;
}