#!/usr/bin/perl
#
#    swatch: The Simple WATCHdog
#    Copyright (C) 1993-2004 E. Todd Atkins
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

 

=head1  NAME

swatch - simple watcher

=head1  SYNOPSIS

B<swatch> 
[ B<--config-file> I<file> ] 
[ B<--restart-time> I<time> ] 
[ B<--input-record-separator> I<regex> ] 
[ [ B<--examine> I<file_to_examine> ] 
| [ B<--read-pipe> I<program_to_pipe_from> ] 
| [ B<--tail> I<file_to_tail> ] ]
[ B<--daemon> ] 
[ B<--use-cpan-file-tail> ]
[ B<--awk-field-syntax> ]
[ B<--tail-program-name> I<filename> ]
[ B<--tail-args> I<arguments_for_tail_program> ]

=head1  DESCRIPTION

B<Swatch> is designed to monitor system activity.
In order for B<Swatch> to be useful, it requires a configuration file
which contains I<pattern(s)> to look for and I<action(s)>
to perform when each pattern is found.

=head1 COMMAND LINE OPTIONS

=over 4

=item B<--config-file>=I<filename> or B<-c> I<filename>

Tells B<swatch> where to find its configuration file. The default
is I<${HOME}/.swatchrc>.

=item B<--help>

Prints usage information and exits.

=item B<--input-record-separator>=I<regular_expression>

Tells B<swatch> to use I<regular_expression> to delineate
the boundary of each input record. The default is a carriage return. 

=item B<--restart-time>=I<[+]hh:mm[am|pm]> or B<-r> I<[+]hh:mm[am|pm]>

Restart at the specified time where I<hh> is hours and I<mm> is minutes. 
If the am/pm indicator is omitted, then a 24-hour clock is assumed. 
If the time is preceeded by the "+" character, then the restart time 
will be set to the current time plus the specified time and the am/pm
indicator will be ignored.

=item B<--script-dir>=I</path/to/directory>

This switch causes the temporary watcher script to be written to a file
in the specified directory rather than the user's home directory. It is
highly advised that you do B<NOT> use directories that are writable by others
such as /tmp.

=item B<--version> or B<-V>

Prints version information and exits.

=item B<--use-cpan-file-tail>

Use CPAN's File::Tail module to read the log file instead of the tail(1) 
command.

=back

You may specify only one of the following options:

=over 4

=item B<--tail-file>=I<filename> or B<-t> I<filename>

Examine lines of text as they are added to filename. 

=item B<--read-pipe>=I<command> or B<-p> I<command>

Examine input piped in from the I<command>. 

=item B<--examine>=I<filename> or B<-f> I<filename>

Use I<filename> as the file to examine. 
B<Swatch> will do a single pass through the named file. 

=back

The following options are purely for debugging purposes, but are
documented here for completeness:

=over 4

=item B<--dump-script>[=I<filename>]

Instead of running the watcher script after it is generated, 
it is written to I<filename> or to STDOUT.

=back 

If swatch is called with no options, it is the same as typing the 
command line

=over 5

=item

C<swatch --config-file=~/.swatchrc --tail-file=/var/log/syslog>

or if /var/log/messages exists

C<swatch --config-file=~/.swatchrc --tail-file=/var/log/messages>


=back

If the configuration file doesn't exist then the following configuration
is used:

	watchfor  /.*/
	    echo


=head1 THE CONFIGURATION FILE 

The configuration file is used by the B<swatch(8)>
program to determine what types of expression patterns to look for
and what type of action(s) should be taken when a pattern is matched.

Each line should contain a keyword and a, sometimes optional,
value for that keyword. The keyword and value are separated by 
space or an equal (=) sign.

watchfor regex

ignore regex

=over 4

=item B<echo [modes]>

.Echo the matched line. The text mode may be I<normal>,
I<bold>, I<underscore>, I<blink>, I<inverse>, 
I<black>, I<red>, I<green>, I<yellow>, I<blue>, I<magenta>, I<cyan>, I<white>,
I<black_h>, I<red_h>, I<green_h>, I<yellow_h>, I<blue_h>, 
I<magenta_h>, I<cyan_h>, and/or I<white_h>. The I<_h> colors specify 
a highlighting color. The other colors are assigned to the letters.
Some modes may not work on some terminals. B<Normal>
is the default.

=item B<bell [N]>

Echo the matched line, and send a bell I<N> times (default = 1).

=item B<exec command>

Execute I<command>. The I<command> may contain variables which are 
substituted with fields from the matched line. A I<$N> will be replaced
by the I<Nth> field in the line. A I<$0> or I<$*> will be replaced by the
 entire line.

=item B<mail [addresses=address:address:...][,subject=your_text_here]>

Send I<mail> to I<address(es)> containing the matched lines as
they appear (default address is the user who is running the program).

=item B<pipe command[,keep_open]>

Pipe matched lines into I<command>. Use the B<keep_open> option to 
force the pipe to stay open until a different pipe action is run or 
until swatch exits.

=item B<write [user:user:...]>

Use B<write(1)> to send matched lines to I<user(s)>.

=item B<throttle hours:minutes:seconds,[use=message|regex|<regex>]>

Use this action to limit the number of times that the matched pattern 
has actions performed on it.

The B<use=regex> option will cause throttling to be based on the regular
expression instead of the message.

You can also specify a perl compliant regular expression as the value for B,use>. The default is use="^\w{3}\s+\d{1,2}\s\d{2}:\d{2}:\d{2}\s+(.*)" causes the key to be the syslog message without the timestamp. This is most useful when throttling non-syslog created files.

=item B<threshold events:seconds,[repeat=no|yes]>

This action limits the actions on a matched pattern based on the number of
times it appears in a given time frame.  An action like "threshold 4:60"
will not perform any actions on that pattern unless it appears 4 times
within any 60 second period (4:60 is the arbitrary default value).
 
The B<repeat=no> option will prevent the timer from being reset after the
threshold has been reached.  By default (repeat=yes), once the pattern has
been triggered, a new 60 second period is begun, which means that if the
patterns match quickly enough, a threshold of 4:60 could mean that 1 in
every 4 messages is reported.  By using B<repeat=no>, you indicate that
there is not to be more than one match every time interval.
 
Note that this is similar to, but different from, the standard "throttle"
command, since "throttle" shows the first line and ignores the rest, while
"threshold" shows the last line and ignores the preceeding (and optionally
the following).  However, an action like "threshold 1:120" should perform
similarly to "throttle 0:2:0,use=regex" and has the advantage of not relying
on a particular timestamp format in the source log entry.

=item B<continue>

Use this action to cause B<swatch> to continue to try to match other
pattern/action groups after it is done with the current pattern/action
block.

=item B<quit>

Use this action to cause B<swatch> to clean up and quit immediately.

=back

=head1 SPECIAL OPTION

The following may be used as an option for any of the above actions except for throttle and threshold.

=over 4

=item B<when=>I<day_of_week:hour_of_day>

Use this option to specify windows of time and days when the action can 
be performed. 
For example:

mail=sysad-pager@somehost.somedomain,when=1-6:8-17

=back

=head1 FOR PERL HACKS ONLY

=over 4

=item B<perlcode> [I<depth>] arbitrary_Perl_code
 
This permits you to easily insert random Perl code into your swatchrc file.
The optional depth value tells swatch how deep into the code to put the perl 
code. (0=outside the main loop, 1=inside the main loop (default), 2=just inside the 
conditional used by the current watchfor statement, and 3=inside the throttle
block).

Its intended use is to permit variable substitution through use like.

C<perlcode $syslog="^\w{3}\s+\d{1,2}\s+\d{2}:\d{2}:\d{2}.*";>
 
watchfor /$syslog hostname pppd/>
 
=back

but any valid Perl is permitted.  Remember the semicolon, and make judicious
use of the B<--dump-script> option if you run into trouble.

=head1 CONFIGURATION EXAMPLE

=over 4

=item perlcode my $fsf_regex = '\d{2}:\d{2}:\d{2}\s+(.* file system full)';

=item watchfor /$fsf_regex/
    echo
    bell
    throttle 01:00,use=$fsf_regex

=back

In this example, a line which contains the string "file system full" will
be echoed and the screen bell will sound.  Also, B<throttle> will use what 
is matched within the parentheses as its key rather than trying to use the 
log message with its time stamp cut out. Multiple instances of
the message will not be echoed if they appear within a minute of the 
first one. Instead the following message will be acted upon after 
the time interval has expired.  This is what may appear if the message
appeared 20 times.

=over 4

=item

C<** 20 in 00:01:00 ==> host.domain: /var: file system full>

=back

=head1 SEE ALSO

B<signal(3)>, B<perl(1)>, B<perlre(1)>

=head1 NOTES

Upon receiving a ALRM or HUP signal swatch will re-read the
configuration file and restart, except when used with the I<--daemon> 
command line option where it will simply exit.
Swatch will terminate gracefully
when it receives a QUIT, TERM, or INT signal.

=head1 AUTHOR

    E. Todd Atkins
    Todd.Atkins@StanfordAlumni.ORG

=head1 AVAILABILITY

Swatch is a SourceForge project whose project page is at 
http://sourceforge.net/projects/swatch and homepage is at
http://swatch.sourceforge.net

=cut

 
use strict;
use English;
use FileHandle;
use Getopt::Long;
use IO::Handle;
use POSIX ":sys_wait_h";
use Date::Parse;
use Date::Format;

use vars qw/
  $awk_field_syntax
  $opt_config_file
  $opt_daemon
  $opt_date_loc
  $dont_get_state
  $opt_debug_level
  $opt_dump_script
  $opt_examine
  @extra_modules
  @extra_include_dirs
  $opt_help
  $opt_input_record_separator
  $opt_old_style_config
  $opt_pid_file
  $opt_style_config
  $opt_read_pipe
  $opt_restart_time
  $opt_tail_file
  $opt_time_loc
  $opt_script_dir
  $opt_version
  @Config
  $Done
  $Restart
  $VERSION
  $Now
  $pid
  $thCounter
  $tail_cmd_args
  $tail_cmd_name
  $state_file_name
  $use_cpan_file_tail
/;

my @Swatch_ARGV = join(' ', $0, @ARGV); # Save just in case we need to restart 
(my $Me = $0) =~ s%.*/%%;	      # Strip the path off of the program name

$SIG{'CHLD'} = 'IGNORE';

my $DEF_CONFIG_FILE = "$ENV{'HOME'}/.swatchrc";
my $DEF_INPUT;
if ( -f '/var/log/messages' ) {
  $DEF_INPUT = '/var/log/messages';
} elsif ( -f '/var/log/syslog' ) {
  $DEF_INPUT = '/var/log/syslog';
}

my $Config_File     = '';
my $Now = 0;  # The current time in Unix seconds. Gets set when set_restart_time is called
my $thCounter = 0;
my $tail_cmd_name = ''; # We'll try to find it in the PATH later
my $tail_cmd_args = '-n 0 -f'; 
$awk_field_syntax = 0;

my $USAGE = qq/
Usage:
    $Me [<options>]
Options:
    --config-file=FILENAME               Use FILENAME for configuration.
    --old-style-config                   Parse a pre-version 3 configuration.
    --restart-time=[+]HH:MM[AM|PM]       Send a HUP signal to swatch at the specified time.
    --input-record-separator=REGEX       Specify an what should be used to separate "lines."
    --help                               Display this message.
    --version                            Display author and version information.
    --tail-file=FILENAME                 Watch a tail of FILENAME.
    --read-pipe=COMMAND                  Watch a pipe from COMMAND
    --examine=FILENAME                   Perform a single pass through FILENAME
    --pid-file=FILENAME			 File to write pid of process to
    --use-cpan-file-tail                 Use the File::Tail CPAN module to read the log file.
/;

my $AUTHOR = "E. Todd Atkins <Todd.Atkins\@StanfordAlumni.ORG>";
$VERSION = "3.1.1";
my $BUILD_DATE = "19 Jul 2004";

 
sub print_version {
  print "This is $Me version $VERSION\n";
  print "Built on $BUILD_DATE\n";
  print "Built by $AUTHOR\n";
  exit 0;
}

 
sub parse_command_line {

  use Getopt::Long;
  Getopt::Long::config('bundling');
  die "$USAGE" if not GetOptions(
				 "awk-field-syntax!" => \$awk_field_syntax,
				 "config-file|c=s" => \$opt_config_file,
				 "daemon" => \$opt_daemon,
				 "date-loc|date-location=s" => \$opt_date_loc,
				 "debug-level=i" => \$opt_debug_level,
				 "dont-get-state" => \$dont_get_state,
				 "dump-script:s" => \$opt_dump_script,
				 "examine|f=s" => \$opt_examine,
				 "extra-include-dirs|I=s@" => \@extra_include_dirs,
                                 "extra-modules|M=s@" => \@extra_modules,
				 "help|h" => \$opt_help,
				 "input-record-separator=s" => \$opt_input_record_separator,
				 "old-style-config|O" => \$opt_old_style_config,
				 "pid-file=s" => \$opt_pid_file,
				 "read-pipe|p=s" => \$opt_read_pipe,
				 "restart-time|r=s" => \$opt_restart_time,
				 "tail-args=s" => \$tail_cmd_args,
				 "tail-program-name=s" => \$tail_cmd_name,
				 "tail-file|t=s" => \$opt_tail_file,
				 "time-loc|time-location=s" => \$opt_time_loc,
				 "save-state=s", \$state_file_name,
				 "script-dir=s" => \$opt_script_dir,
				 "use-cpan-file-tail" => \$use_cpan_file_tail,
				 "version|V" => \$opt_version,
				);

  die "$USAGE" if $opt_help;

  if ($opt_version) {
    print_version;
    exit(0);
  }
  
  $opt_input_record_separator = (defined $opt_input_record_separator) ? $opt_input_record_separator : $/;

  # This is slightly bogus -- we call the set_restart_time function now
  # because if the args aren't properly formatted,  we want to die before the fork
  set_restart_time($opt_restart_time) if defined $opt_restart_time; 
}

 
###
### Routines to help with debugging
###

sub dprint {
    my $msg_lev = shift;
    my $msg = shift;
    print STDERR "DEBUG($msg_lev): $msg\n" if ($msg_lev & $opt_debug_level);
}

 
#
# make_debug_code() - creates the debug code for the watcher script
#
sub make_debug_code {
    my $code = '';

    $code = sprintf("my \$Debug_Mode = %d;\n", defined $opt_debug_level ? $opt_debug_level : 0);
    $code .= q|

sub dprint {
    my $msg_lev = shift;
    my $msg = shift;
    print STDERR "DEBUG($msg_lev): $msg\n" if ($msg_lev & $Debug_Mode);
}

|;
    return $code;
}

 
#
# returns a default array of records 
#
sub default_config {
  my @records;
  my $rec = (); # 

  warn "$Me: using default configuration of:\n";
  warn "\n\twatchfor = /.*/\n\t\techo\n\n";
  sleep 5;
  $rec = ();
  $rec->{pattern} = '/.*/';
  $rec->{keyword} = 'watchfor';
  push(@{$rec->{actions}}, { action => 'echo', value => '' });
  push(@records, $rec);
  return(@records);
}

 
#
# checks validity of a regular expression. returns 1 if valid.
#
sub is_valid_pattern {
  my $pat = shift;
  return eval { "" =~ /$pat/; 1 } || 0;
}

 
#
# Build a configuration record structure
# 
sub read_config {
  my $filename = shift;
  my $rec = ();
  my $i = -1;
  my $keyword;
  my $pattern;
  my $option;
  my $value;
  my $fh;
  my @records;

  if ( not -r $filename ) {
    warn "$Me: cannot read $filename\n";
    exit 1 if $opt_daemon;
    return(default_config());
  }

  $fh = new FileHandle "$filename", "r";
  if (not defined $fh) {
    warn "$Me: cannot open $filename: $!\n";
    exit 1;
  }

  while (<$fh>) {
    my($key, $val);
    chomp;
    s/^\s+//; ## strip off leading blank space
    s/\s+$//; ## strip off trailing blank space

    ### Skip comments blank lines ###
    next if (/^\#/ or /^\s*$/);

    s/\#.*$//; ## strip trailing comments

    if (/\s*=\s*/) {
      $key = (split(/\s*[= ]\s*/))[0];
      ($val = substr($_, length($key))) =~ s/^\s*=\s*//;
    } else {
      $key = (split())[0];
      ($val = substr($_, length($key))) =~ s/^\s*//;
    }
    if ($key =~ /^(watchfor|waitfor|ignore)$/i) {
      $i++;
      if (defined $rec->{pattern}) {
	push @records, $rec;
	$rec = ();
      }

      if (not is_valid_pattern($val)) {
	die "$Me: error in pattern \"$val\" on line $. of $filename\n";
      }

      $rec->{keyword} = lc($key);
      if (length($val)) {
	$rec->{pattern} = $val;
      }
    } elsif ($key =~ /perlcode/i) {
      my $depth = 1;
      if ($val =~ /(\d+)\s+(.*)$/) { # put perlcode at a given depth
	$depth = $1;
	$val = $2;
      }
      if ($depth == 0 or $depth == 1) {
	$i++;
	if (defined $rec->{pattern}) {
	  push @records, $rec;
	  $rec = ();
	}
	$rec->{keyword} = lc($key);
        $rec->{depth} = $depth;
	$rec->{value} = $val if (length($val));
        push @records, $rec;
	$rec = ();
      } else {
	push(@{$rec->{actions}}, { action => lc($key),
				   depth => $depth,
				   value => $val });
      }
    } elsif ($i < 0) {
      warn "$Me: error in $filename at line ${.}: invalid keyword. Skipping.\n";
    } elsif ($key =~ /^(throttle|threshold)$/i) {
      $rec->{lc($key)}{value} = $val;
    } else {
      push(@{$rec->{actions}}, { action => $key, value => $val });
    }
  }
  undef $fh;
  if (defined $rec->{pattern}) {
    push @records, $rec;
    $rec = ();
  }

  ## Sanity Check: If the config file did not contain anything useful then 
  ## we need to return the default configuration.
  if ($#records < 0) {
    warn "$Me: There were no useful entries in the configuration file.\n";
    exit 1 if $opt_daemon;
    return(default_config());
  } else {
    return(@records);
  }
}

 
sub read_old_config {
  my $filename = shift;
  my $fh = new FileHandle $filename, "r";
  my @records = ();

  if (not defined $fh) {
    die "$Me: cannot read $filename: $!\n";
  }

  while (<$fh>) {
    my $rec = ();
    chomp;
    @_ = split(/\t+/);

    if (/^\s*$/ or /^\s*\#/) {
      next;
    } elsif (/ignore/) {
      $rec->{keyword} = 'ignore';
      $rec->{pattern} = $_[0];
    } else {
      $rec->{keyword} = 'watchfor';
      $rec->{pattern} = $_[0];
      if (defined $_[2] and $_[2] =~ /^[0-9]/) {
	$rec->{'throttle'}->{value} = $_[2];
      }
      foreach my $action (split(/,/, $_[1])) {
	my ($key,$val) = split(/\s*=\s*/, $action);
	push(@{$rec->{actions}}, { action => $key, value => $val });
      }
    }
    push(@records, $rec);
  }
  return (@records);
}

 
#
# make_start_code -- return the start of our swatch generated perl script
#
# usage: $script .= make_start_code;
#
sub make_start_code {
  my $code = '';
  my $mail_cmd = '';
  my $write_cmd = '';
  my $extra_includes = '';
  my $extra_modules = '';

  foreach my $mailer (qw(/usr/lib/sendmail /usr/sbin/sendmail)) {
    $mail_cmd = $mailer if ( -x $mailer );
  }
  if ($mail_cmd ne '') {
    $mail_cmd .= ' -oi -t -odq'; 
  }
  foreach my $path (split(/:/, $ENV{'PATH'})) {
    $write_cmd = "$path/write" if ( -x "$path/write" );
  }

  if ($#extra_modules != -1) {
    foreach my $m (@extra_modules) {
      $extra_modules .= "use $m;\n";
    }
  }

  if ($#extra_include_dirs != -1) {
    $extra_includes = join(' ', @extra_include_dirs);
  }

  $code  = qq[
#
#    swatch: The Simple WATCHdog
#    Copyright (C) 1993-2004 E. Todd Atkins
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

use strict;
use FileHandle;
use POSIX ":sys_wait_h";

## User supplied modules and their locations
use lib qw($extra_includes);
$extra_modules

use Swatch::Actions;
use Swatch::Throttle;

use vars qw/
  %Msg_Rec
  \$Fh
/;

\$SIG{'TERM'} = \$SIG{'HUP'} = 'goodbye';
\$SIG{'CHLD'} = 'IGNORE';

## Constants
(my \$Me = \$0) =~ s%.*/%%;
my \$BELL   = "\007";
my \$MAILER = "$mail_cmd";
my \$WRITE  = "$write_cmd";
\$/ = "$opt_input_record_separator";
my \$swatch_state_file_name = "$state_file_name";
my \$swatch_flush_interval = 300;
my \$swatch_last_flush = time;

use IO::Handle;
STDOUT->autoflush(1);;

sub goodbye {
  \$| = 0;
];

  if ($opt_read_pipe) {
    $code .= "  close(SW_PIPE);\n";
  } elsif ($opt_examine) {
    $code .= "  \$Fh->close;\n";
  }

  $code .= q|
  &Swatch::Actions::close_pipe_if_open();

  save_state($swatch_state_file_name);

  exit(0);
}

#
#
#
sub get_state {
  my $file = shift;
  return if ($file eq '');
  &Swatch::Throttle::readHistory($file);
}

#
#
#
sub save_state {
  my $file = shift;
  return if ($file eq '');
  &Swatch::Throttle::saveHistory($file);
}

#
# write_pid_file(file_name) - writes a one line file that contains
# the current process id.
#
sub write_pid_file {
  my $name = shift;
  my $fh = new FileHandle "$name", "w";
 
  if (defined($fh)) {
    print $fh "$$\n";
    $fh->close;
  } else {
    warn "$Me: cannot write pid file named $name: $!\n";
  }
}
  |;

  if ($opt_daemon) {
    $code .= qq[
my \$pid = fork;
exit if \$pid;
die "Couldn't fork: \$!" unless defined(\$pid);
# dissociate from the controlling terminal
POSIX::setsid() or die "Can't start new session: \$!"; 
# set our named to 'swatch' so that rc scripts can 
# figure out who we are.
\$0="swatch";
	       ];
  } else {
    $code .= qq[print \"\\n*** ${Me} version ${VERSION} (pid:$$) started at \" . `/bin/date` . \"\\n\";];
  }
  
  $code .= qq[get_state("\$swatch_state_file_name"); \n] unless $dont_get_state;
  $code .= qq[write_pid_file("$opt_pid_file"); \n] if (defined $opt_pid_file);

  return $code;
}

 
sub make_start_loop {
  my $filename = $DEF_INPUT;
  my $code = '';

  if (defined $opt_examine) {
    $filename = $opt_examine;
    $code = qq[
use FileHandle;
my \$Filename = '$filename';
\$Fh = new FileHandle \"\$Filename\", 'r';
if (not defined \$Fh) {
    die "$0: cannot read input \\"\$Filename\\": \$!\\n";
}

LOOP: while (<\$Fh>) {
];

  } elsif (defined $opt_read_pipe) {
    $filename = $opt_read_pipe;
    $code = qq[
use FileHandle;
my \$Filename = '$filename';

if (not open(SW_PIPE, \"$filename|\")) {
    die "$0: cannot read from pipe to program \\"\$Filename\\": \$!\\n";
}

LOOP: while (<SW_PIPE>) {
];

  } else {
    $filename = $opt_tail_file if (defined $opt_tail_file);
    if ($use_cpan_file_tail) {
      $code = qq[
use File::Tail;
my \$Filename = '$filename';
my \$File = File::Tail->new(name=>\$Filename, tail=>1, maxinterval=>0.5, interval=>0.5);
if (not defined \$File) {
    die "$0: cannot read input \\"\$Filename\\": \$!\\n";
}

LOOP: while (defined(\$_=\$File->read)) {
];
    } else {
      if ($tail_cmd_name eq '') {
	foreach my $path (split(/:/,$ENV{'PATH'})) {
	  if (-x "${path}/tail") {
	    $tail_cmd_name = "$path/tail";
	    last;
	  }
	}
	die "$Me: cannot find \"tail\" program in PATH\n" if $tail_cmd_name eq '';
      }
       $code = qq/
my \$filename = '$filename';
if (not open(TAIL, \"$tail_cmd_name $tail_cmd_args \$filename|\")) {
    die "$0: cannot read run \\"$tail_cmd_name $tail_cmd_args \$filename\\": \$!\\n";
}

LOOP: while (<TAIL>) {
/;
    }
  }

  $code .= q!
    chomp;
    my $S_ = $_;
    @_ = split;
    
    ### quote all special shell chars ###
    $S_ =~ s/([;&\(\)\|\^><\$`'\\\\])/\\\\$1/g;
    my @S_ = split(/\s+/, $S_);

    ### clean up the log history ###
    my $swatch_time_now = time;
    if ($swatch_time_now > $swatch_flush_interval + $swatch_last_flush) {
      &Swatch::Throttle::flushOldLogRecords;
!;
  $code .= qq/
      save_state(\$swatch_state_file_name);
      \$swatch_last_flush = \$swatch_time_now;
    }

/;
}

 
sub make_end_code {
    my $code;
    $code = q[
}
];
    return $code;
} 

 
sub action_def_to_subroutine_call {
  my $key = shift;  # converts to subroutine name
  my $optstr = shift; # comma separated option string
  my $pattern = shift;
  my $message = shift;

  my $actinfo = { # action subroutine info
                 "continue" => { 'sub_name' => "continue" },
		 "bell" => { 'sub_name' => "&Swatch::Actions::ring_bell", 'def_arg' => 'RINGS' },
		 "echo" => { 'sub_name' => "&Swatch::Actions::echo", 'def_arg' => 'MODES' },
		 "exec" => { 'sub_name' => "&Swatch::Actions::exec_command", 'def_arg' => 'COMMAND' },
		 "pipe" => { 'sub_name' => "&Swatch::Actions::send_message_to_pipe", 'def_arg' => 'COMMAND' },
		 "mail" => { 'sub_name' => "&Swatch::Actions::send_email", 'def_arg' => 'ADDRESSES' },
		 "quit" => { 'sub_name' => "exit" },
		 "throttle" => { 'sub_name' => '&Swatch::Throttle::throttle', 'def_arg' => 'MIN_DELTA' },
		 "write" => { 'sub_name' => "&Swatch::Actions::write_message", 'def_arg' => 'USERS' },
		};

  my %options;
  my $have_opts = 0;

  foreach my $v (split(/,/, $optstr)) {
    if ($v =~ /(\w+)\s*=\s*"?(\S+[^"]*)/) {
      $options{uc $1} = $2;
    } else {
      my $opt = $v;
      $opt =~ s/@/\\@/g;
      $opt =~ s/^['" ]*//;
      $opt =~ s/['" ]*$//;
      if ($actinfo->{$key}{'def_arg'} eq 'MODES') { 
        ## Modes are processed as an array ##
	push(@{$options{$actinfo->{$key}{'def_arg'}}}, $opt);
      } else {
	$options{$actinfo->{$key}{'def_arg'}} = $opt;
      }
    }
  }

  if ($key =~ /(exec|pipe)/) {
    $options{'COMMAND'} = convert_command('S_', $options{'COMMAND'});
  }

  $options{'MESSAGE'} = $message unless exists $options{'MESSAGE'};

  my $opts = '';
  if (scalar %options) {
    foreach my $k (keys %options) {
      if ($k eq 'MODES') {
	$opts .= "\'$k\' => [ ";
	foreach my $v (@{$options{$k}}) {
	  $opts .= "\"$v\",";
	}
	$opts .= " ], ";
      } elsif ($k eq 'MIN_DELTA') {
        ## convert to new throttle variable name ##
        $opts .= "\'HOLD_DHMS\' => [ ";
        my @dhms = split(/:/,$options{$k});
        for (my $i = $#dhms ; $i < 3 ; $i++) {
          unshift(@dhms, 0);
        }
        foreach my $v (@dhms) {
	  $opts .= "\"$v\",";
	}
	$opts .= " ], ";
      } else {
	$opts .= "\'$k\' => \"$options{$k}\", "; # if (defined $options{$k});
      }
    }
  }

  my $sub_name = (exists $actinfo->{$key}{'sub_name'}) 
  ? $actinfo->{$key}{'sub_name'} : $key;

  if ($key eq 'throttle') {
    return "$sub_name('REGEX' => '$pattern', $opts)";
  } else {
    return "$sub_name($opts)";
  }
}

 
#
# 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 {
  my $varname = shift;
  my $command = shift;
  my @new_cmd = ();

  $command =~ s/\$[0*]/\$$varname/g if $awk_field_syntax;

  foreach my $i (split(/\s+/, $command)) {
    if ($awk_field_syntax and $i =~ /\$([0-9]+)/) {
      my $n = substr($i, 1);
      $n--;
      push(@new_cmd, "\$$varname\[$n\]");
    } else {
      push(@new_cmd, $i);
    }
  }
#  $command =~ s/\$([0-9]+)/\$_[$1]/g;

  return join(' ', @new_cmd);;
}

 
sub make_ignore_block {
  my $ref = shift;
  dprint(4, "ignoring $ref->{pattern}");
  return "\tnext;\n";
}

 
sub make_watchfor_block {
  my $pattern = shift;
  my $ref = shift;
  my $code = "";
  my $do_quit = 0;
  my $do_continue = 0;
  my $message = '$_';

  foreach my $a_ref (@{$ref->{actions}}) {
    if ($a_ref->{action} eq 'perlcode' and $a_ref->{depth} == 2) {
      $code .= "\t$a_ref->{value}\n";
    }
  }

  # Encapsulate the whole thing (even throttle) in a threshold block.  The
  # indenting in the generated code is "wrong", but there is no easy way to
  # fix it.
  if (exists $ref->{"threshold"}) {
    $code .= "     if (";
    $code .=  action_def_to_subroutine_call('threshold', $ref->{'threshold'}{value}, $pattern, $message);
    $code .=  ") {\n";
  }

  if (exists $ref->{"throttle"}) {
    $code .= "      if ((my \$rtn = ";
    $code .=  action_def_to_subroutine_call('throttle', $ref->{'throttle'}{value}, $pattern, $message);
    $code .= ") ne '') {\n";
    $message = '$rtn';
  }
  dprint(4,"watching $ref->{pattern}");

  foreach my $a_ref (@{$ref->{actions}}) {
    my $act = $a_ref->{action};
    if ($act eq 'perlcode' and $a_ref->{depth} == 3) {
      $code .= "\t$a_ref->{value}\n";
    } elsif ($act eq 'continue') {
      $do_continue = 1;
    } elsif ($act eq 'quit') {
      $do_quit = 1
    } else {
      $code .= "\t";
      $code .= action_def_to_subroutine_call($act, $a_ref->{value}, undef, $message);
      $code .= ";\n";
    }
  }

  if (exists $ref->{"throttle"}) {
    $code .= "      }\n";
  }
  
  if (exists $ref->{"threshold"}) {
    $code .= "     }\n";
  }
  
  if ($do_quit) {
    $code .= "      exit;\n";
  } elsif (not $do_continue) {
    $code .= "      next;\n";
  }
  
  return $code;
}

 
#
# make_script() - The workhorse for creating the script that will do the
# message processing.
#
# returns a string which contains the full script.
#
sub make_script {
  my $key;
  my $block_open = 0;
  my $script = make_start_code();

  for my $rec (@Config) {
    if ($rec->{keyword} eq 'perlcode' and $rec->{depth} == 0) {
      $script .= "$rec->{value}\n";
    }
  }

  $script .= make_start_loop();

  for my $rec (0..$#Config) {
    my $pattern = $Config[$rec]->{pattern};
    my $config = $Config[$rec];
    if ($block_open) {
      $script .= "    }\n\n";
    }

    $key = $config->{keyword};

    if ($key =~ /^perlcode$/ and $config->{depth} == 1) {
      $script .= "    $config->{value}\n";
      $block_open = 0;
    } elsif ($key !~ /^perlcode$/) {
      $script .= "    if ($pattern) {\n";
      $block_open = 1;
    }

    if ($key =~ /^ignore$/) { 
      $script .= make_ignore_block($config);
    } elsif ($key =~ /^watchfor$/) {
      $script .= make_watchfor_block($pattern, $config);
    }
  }
  $script .= "    }\n";

  $script .= make_end_code;

  return $script;
}
 
#
# terminate
#
# usage: terminate($SIGNAL);
#
sub terminate {
    my($Sig) = shift;
    dprint(16, "terminate($Sig)");
    return if $pid == 0;

    if ($Sig) { 
      print STDERR "Caught a SIG$Sig -- sending a TERM signal to $pid\n" 
    }
    kill('TERM', $pid) unless $opt_dump_script;
    $Restart = 0;
}

 
#
# restart -- kill the child, delete the script, and start over.
#
# usage: &restart($Sig);
#
sub restart {
    my($Sig) = shift;
    dprint(16, "restart($Sig)");
    print STDERR "Caught a SIG$Sig -- sending a TERM signal to $pid\n";
    kill('TERM', $pid);
    $Restart = 1;
}

 
## Courtesy of "Shoshana Abrass" <shoshana@anim.dreamworks.com> ...
##
## USAGE: set_restart_time(timestring)
## WHICH: converts the user-given timestring into the time (in unix 
##        seconds) when the program should next restart
## WHERE: "timestring" is one of the supported command-line arguments, 
##        for example:
##
##       00:01       restart every day at 12:01 AM
##      +24:00       restart every 24 hours
##       +1:00       restart every hour
##
##   There is currently no way to say "restart at the next HH:00 and every
##   hour after that", but it might be a nice feature.
##
## RETURNS: seconds since Jan 1 1970  of the next restart time.
##
sub set_restart_time{
  my ($timestring)=(@_);
  my ($DeltaHrs, $DeltaMins, $RestartTime);
  
  my ($OneMinute, $OneHour, $OneDay) = (60, 3600, 86400); # In seconds
  my ($EndOfTime) = (2147483647);                         # Mon Jan 18 19:14:07 2038

  $Now = time();

  if ( $timestring =~ m/^\+/ ) {
    if ( $timestring =~ m/^\+(\d+):(\d+)$/  ) {
      #
      #
      $DeltaHrs = $1 * $OneHour;
      $DeltaMins = $2 * $OneMinute;

      $RestartTime = $Now + $DeltaHrs + $DeltaMins;
      if ( $RestartTime >= $EndOfTime ) {
	print "ERROR: Restart time delta would put us past the end of\n";
	print "       unix time, ", ctime ($EndOfTime);
	die "       Unacceptable time delta\n";
      }
    }
    else {
      die "Unrecognized delta time format \"$timestring\"\n";
    }
  }
  else {
    if ( ! ($RestartTime = str2time("$timestring")) ) {
      die "Unrecognized time format \"$timestring\"\n";
    }
    while ( $RestartTime < $Now  ) {
      # if the time of day has already passed, then   
      # the user must mean that time tomorrow
      dprint(32, "set_restart_time(): adding a day to RestartTime $RestartTime (unix seconds)");
      $RestartTime += $OneDay;
    }
  }
  
  return ($RestartTime);
}

 
## Courtesy of "Shoshana Abrass" <shoshana@anim.dreamworks.com> ...
##
## USAGE: set_alarm (seconds)
##
## WHICH: Takes an absolute time value in unix seconds, and sets the alarm 
##        to go off at that time by subtracting $Now seconds.  We want to use 
##        the same value of $Now that was used above in set_restart_time, 
##        because
##            (1) we presume these functions are being called sequentially;
##            (2) to calculate against one $Now and set against another 
##                doesn't make sense.
##
sub set_alarm{
  my ($RestartTime) = @_;

  # carp "Called set_alarm";

  if ( $Now == 0 ) { $Now = time();}  # This should never happen

  if ( $RestartTime <= $Now ) {

    # This should never happen, because the intention is that
    # set_restart_time should be called before set_alarm. 
    # But just in case....
    print "WARNING: setting restart alarm to zero\n";
    alarm(0);
  }
  else {
    alarm ($RestartTime - $Now);
  }

}

 
##
## doit()
##
sub doit {
  $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = $SIG{'ALRM'} = $SIG{'HUP'} = 'default';

  $Config_File = (defined $opt_config_file) ? $opt_config_file : $DEF_CONFIG_FILE;
  
  ## Read in the configuration file ##
  if ($opt_old_style_config) {
    @Config = read_old_config($Config_File);
  } else {
    @Config = read_config($Config_File);
  }

  ## Create a script based on the configuration file and command line options
  my $Watcher_Script = make_script;
  

  if (defined $opt_dump_script) {## Just write the script to STDOUT and exit
    print "### Watcher Script BEGIN ###\n";
    print $Watcher_Script;
    print "### Watcher Script END ###\n";
    $Done = 1;
  } else { ## Write the script to a file and run it ##

    ## Write the script file ##
    my $script_file = defined($opt_script_dir) ? $opt_script_dir : $ENV{'HOME'};
    $script_file .= "/.swatch_script.$$";
    my $swatch_fh = new FileHandle $script_file, "w";
    if (defined $swatch_fh) {
      $swatch_fh->print($Watcher_Script);
      $swatch_fh->close;

    ## Now fork and start monitoring ##
    FORK: {
	if ($pid = fork) {
	  dprint(8, "doit(): pid = $pid");
	  foreach my $k (sort keys %SIG) {
	    dprint(8, "doit(): a: $k => $SIG{$k}") if defined $SIG{$k};
	  }
	  $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'terminate';
	  $SIG{'ALRM'} = $SIG{'HUP'} = 'restart';
	  foreach my $k (sort keys %SIG) {
	    dprint(8, "doit(): b: $k => $SIG{$k}") if defined $SIG{$k};
	  }
	  if ( defined $opt_restart_time ) {
	    my $RestartTime = set_restart_time($opt_restart_time);
	    print "Will restart at ", ctime($RestartTime);
	    set_alarm ($RestartTime);
	  }
	  waitpid($pid, 0);
	  alarm(0);
	  if (defined $opt_daemon) {
	    exit(0);
	  }
	} elsif (defined $pid) {
	  exec("$EXECUTABLE_NAME $script_file");
	} elsif ($! =~ /No more processes/) {
	  # EAGAIN, supposedly recoverable fork error
	  sleep 5;
	  redo FORK;
	} else {
	  die "$Me: Can't fork: $!\n";
	}
      }
      $Done = 1 if (not $Restart); # Restart set to 1 by restart() #
      unlink($script_file);
    }
  }
}

 
###
### MAIN
###

$Done = 0;
$Restart = 0;

while (!$Done) {
  parse_command_line;
  main::doit();
}

###
### End of main block
###
 
