Article 11928 of comp.lang.perl:
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!pipex!sunic!uts!id.dth.dk!ej
From: [email protected] (Erik Johansen)
Subject: Re: 'tail -f' & PERL
Message-ID: <[email protected]>
Keywords: syslog, tail
Organization: Department of Computer Science, The Technical University of Denmark
References: <[email protected]>
Date: Tue, 22 Mar 1994 19:42:58 GMT
Lines: 368

[email protected] (Stuart Broderick) writes:


>I want to carry out monitoring of multiple files in pseudo real-time by using
>something simliar to 'tail -1 filename'.  I could do this from shell by
>launching multiple tail commands as background jobs, but I'll  have to clear
>up multiple jobs when I finish - possible but messy !!

>Has anyone written a perl script which could do something like this (or similar)
>.. (or could give me clues on how to open and scan the end of multiple files
>simultaneously with the output going to STDOUT) and which 'cleans-up' after
>termination of the script ?

>Any/all help greatly appreciated.

I have written a few scripts to monitor several files on different machines
via NFS.

Essentially it is nessesary to make a busy loop as, select()
[the otherwise best way of doing this]   keeps returning
a status for all files telling there is one byte left to read.
(I suppose it is the EOF sitting there all the time)

I have included one ('showlog') script to monitor several logfiles.

Hope that you can use the following script (or parts of it)
-------Cut here----------------------Cut here---------------------------------
#!/bin/perl -w
@Original_ARGV = @ARGV; # Just make a copy

$HelpText = "
Syntax: $0 <keywords>

   Where <keywords> are:

      do                       Enable showing the following things
                               Also 'do show', 'show' accepted for this
      dont                     Disable showing the following things
                               Also 'dont show' accepted for this

      mail                     Messages from mail/sendmail
      snmpd                    Messages from snmpd
      pcsa                     Messages from pcsa servers
      print                    Messages from lpr Line Print system
      ntpd                     Messages from Network Time Protocol
      mount                    Messages from Mount and AutoMount
      bootpd                   Messages from bootpd
      mop                      Messages from Mom / Mop
      fal                      Messages from DECnet/Remote File Access

      garbage                  Garbage messages (normally not shown)

      rescan                   Start reading the logfiles from the top
      from/on <hostnames>      Does logging from the specified hosts
                               Defaults to all system hosts from /etc/hosts
                               starting with dese/id

      openwin                  Open up a new window for the output

";

%keyword = (
'openwin',       '&OpenNewWindow',

'do',            '$state  = 1',
'do show',       '$state  = 1',
'show',          '$state  = 1',
'dont',          '$state  = 0',
'not',           '$state  = 0',
"don't",         '$state  = 0',
'dont show',     '$state  = 0',
"don't show",    '$state  = 0',
'but',           '$state  = 1 - $state',
'print',         '$print  = $state',
'mail',          '$mail   = $state',
'snmpd',         '$snmpd  = $state',
'pcsa',          '$pcsa   = $state',
'ntpd',          '$ntpd   = $state',
'mount',         '$mount  = $state',
'bootpd',        '$bootpd = $state',
'mop',           '$mop    = $state',
'fal',           '$fal    = $state',
'rescan',        '$rescan = $state',
'garbage',       '$garbage= $state',
'from',          '&GetHosts',
'on',            '&GetHosts',
'host',          '&GetHosts',
'and',           '',
'but',           '',
'all',           '$mail = $pcsa = $print = $snmpd = $ntpd = $mount = $bootpd = $mop = $fal = $state;',
);

# Defaults:
$mail = $pcsa = $print = $snmpd = $ntpd = $mount = $bootpd = $mop = $fal = 1;
$garbage = 0;

chop($hostname = `/bin/hostname`);
$rescan = 0;
@logfiles = ();
$| = 1; # Unbuffered output

$state = 1;
while ($_ = shift)
{
 y/,//d;

 # We accept +/- in front of words to mean do/dont
 if    ( s/^\+// ) { unshift(@ARGV, $_); $_ = 'do'; }
 elsif ( s/^\-// ) { unshift(@ARGV, $_); $_ = 'dont'; }


 push(@unknown, $_),next unless defined $keyword{$_};

 $_ .= " ".shift while defined $keyword{$_." ".@ARGV[0]}; # Check for more than one keyword

 eval $keyword{$_}; die $@ if $@;
}

if ( $#unknown > -1 )
{
 if ( $#unknown == 0 )
  { print "Unknown keyword '$unknown[0]'\n"; }
 else
  { print "Unknown keywords '", join("', '", @unknown), "'\n"; }

 print $HelpText;
 exit;
}

unless (defined @loghosts)
{
 open(HOSTS, "< /etc/hosts") || die "Cannot read /etc/hosts\n";
 while (<HOSTS>)
  {
   next unless s/\#.*system.*$//;
   next unless /\b(id|de)\w+/;
   push(@loghosts, $&);
  }
}
die "No hosts to enable logging on\n" unless defined @loghosts;

foreach $node ( @loghosts )
{
 next if defined $SkipHost{$node};

 print $node, " ";

 foreach $file ( "/usr/spool/mqueue/syslog", "/usr/adm/messages" )
  {
   $file = &Expand($node, $file );
   next unless defined $file;

   # No read access - then skip to next
   print("\n'$file' - No access\n"), next  unless -r $file;

   push(@logfiles, $file);
  }
 sleep 3; # Just to relax the automount - not really needed
}

# Special
push(@logfiles, "/net/iddth3/usr/adm/lp2acct");

$FH = "FH0000";
foreach $file ( @logfiles )
{
 print("No read access to '$file'\n"),next unless -r $file;
 $FH++;
 open($FH, "< $file") || print "Cound not open '$file' for read\n";
 $file{$FH} = $file;
 $host{$FH} = $file =~ m#/(id\w+|de\w+)# ? $1 : $hostname ;
 select($FH); $| = 1; select(STDOUT);
 $pos{$FH} = 0;
 unless ($rescan) { $pos{$FH} += length($_) while (<$FH>); };
}

print "\n--Ready--\n";

while(1)
{
 foreach $FH ( keys %file )
  {
   seek($FH, $pos{$FH}, 0) ||
    print "ERROR: Could not seek to $pos{$FH} in '$file{$FH}'\n";
   while (<$FH>)
    {
     last unless /\w/;
     print("DEBUG: Only first half of line: '$_'\n"),last unless /\n/;

     $pos{$FH} += length($_);
     study;

     if ( /reinitializing$/ ) # New syslog created
      {
       close($FH);
       sleep 1; # Leave time for new syslog to be created
       unless ( open($FH, "< $file{$FH}") )
        {
         print "*** $0: Could not reopen $file{$FH} sleeping 30 sec.\n";
         sleep 30; # Take a nap and see if it can be reopened later
         unless ( open($FH, "< $file{$FH}") )
          {
           print "*** $0: Could not reopen $file{$FH} at all, sorry.\n";
           print "*** No more logging from node $host{$FH}\n";
           delete $file{$FH}; # Unmap logfile - so no more reads will be done
           delete $host{$FH}; # Unmap hostname part
          }
        }
       $pos{$FH} = 0;
      }

     #
     # Serious messages that allways need to be notified
     #
     &Tell, next  if  /mountd: Duplicate directory entry for/;
     &Tell, next  if  /filesystem almost full/;
     &Tell, next  if  /dummy/;

     #
     # Other messages
     #
     if ( ! $mail )
      {
       # Mail messages
       next       if /: from=/;
       next       if /: to=/;
       next       if /: message-id=/;
       next       if /stat=Sent/;
      }

     next if ! $ntpd    &&  /ntpd:/;
     next if ! $pcsa    &&  /PCSA/;
     next if ! $mount   &&  /Mount device busy/;
     next if ! $mop     &&  /mop_dumpload:/;
     next if ! $bootpd  &&  /bootpd:/;
     next if ! $fal     &&  /fal:/;
     next if ! $garbage &&  /bootpd: startup/;
     next if ! $garbage &&  /bootpd: read \d+ entries/;
     #
     # We passed all tests so print message
     #
     &Tell;
    }
  }
 sleep 2;
}

sub Mail
{
 local($subject, @mail) = @_;
 local($mail) = join("\n", @mail);
 $mail =~ s/\n/\n*** /;
 print "
*** Sending the following mail:
***
*** Subject: $subject
*** $mail
";
}

sub Tell
{
 s/localhost/$host{$FH}/  || /$host{$FH}/  || s/^/$host{$FH}: /;

 if ( /refused/i && ! /sendmail:/ )
  {
   open(REFUSED, ">> refused");   # Written to file 'refused' in current directory
   print REFUSED;
   close REFUSED;
   print "\007"; # Ring bell to tell that something special happended
  }

 # Ring bell to tell that something special happended
 print "\007" if /illegal/;


 print;


 print "\007*** Check /etc/exports file on above machine (links pointing to same place ?) ***\n"
    if  /mountd: Duplicate directory entry for/;

 if ( /filesystem almost full/ )
  {
   print "\007*** Check filesystem on the above machine (full or allmost full) ***\n";
   &Mail( "Filesystem on $host{$FH} allmost full",
          "[Automatic message]\n\n", "Message reported from syslog on $host{$FH}:\n\n", $_ );
  }

}


sub GetHosts
{
 while ( $#ARGV > -1 )
  {
   last if defined $keyword{ $ARGV[0] };
   if ( $state )
    {
     push( @loghosts, shift(@ARGV) ); # If user does want logging from theese machines
    }
   else
    {
     $SkipHost{ shift(@ARGV) } = 1; # Note that User does not want logging from this machine
    }
  }
}

sub Undefined
{
 &Undefined, &GetHosts, &OpenNewWindow;
 $print, $snmpd;
}


sub Expand
{
 local( $node, $path ) = @_;

 $node = $1 if $path =~ s|^/net/([^/]+)/|/|;

 local( @path ) = split('/', $path, -1 );
 local( $depth ) = 0;
 while ( ++$depth <= $#path )
  {
   $test = "/net/$node".join("/", @path[0..$depth] );
   return undef unless -l $test || -e $test;
   next unless -l $test;
   $log = readlink( $test );
   if ( $log =~ m|^/| )
    {
     splice(@path, 0, $depth+1, split('/', $log, -1 )); $depth=0;
    }
   else
    {
     splice(@path, $depth, 1, split('/', $log, -1 )); $depth--;
    }
  }

 "/net/$node".join("/", @path);
}

sub OpenNewWindow
{
 local( @opts ) = grep( ! /^openwin$/, @Original_ARGV); # Remove 'openwin'

 exec '/usr/bin/dxterm', '-display', $ENV{'DISPLAY'} || ':0.0',
      '-size', '110x7',
      '-geometry', '+14+685',  # Position
      '-xrm', 'dxterm*autoWrapEnable:off',
      '-xrm', 'dxterm*transcriptSize:1000',
      '-xrm', 'dxterm*scrollHorizontal:on',
      '-xrm', 'dxterm*autoResizeWindow:off',
      '-xrm', 'dxterm*autoResizeTerminal:off',
      '-xrm', 'dxterm*rows:7',
      '-xrm', 'dxterm*columns:256',
      '-e', $0, @opts;
}
-------Cut here----------------------Cut here---------------------------------

Hope this helps

Erik
---
print "Just another perl hacker,";

Erik Johansen / Department of Computer Science / Danish Technical University
[email protected]