#!@@PERL@@ @@PERLCGIOPTS@@

# Copyright 1999, 2000, 2001 (c) Thomas Erskine <@@AUTHOR@@>
# See the COPYRIGHT file with the distribution.

# log-server - allow the log-collector to get information 
#	about a remote logfile, without transferring it
# $Id: log-server.pl,v 1.8 2001/08/28 15:22:24 remstats Exp $

# - - -   Configuration   - - -

use strict;

# What is this program called, for error-messages and file-names
$main::prog = 'log-server';
# Where to store context (file position per log-file)
$main::context_dir = '/var/tmp/remstats';
$main::context_prefix = 'log-server-';

# - - -   Version History   - - -

(undef, $main::version) = split(' ', '$Revision: 1.8 $');

# - - -   Setup   - - -

# Make sure there is no buffering of output
$| = 1;

# Parse the command-line
use Getopt::Std;
# STRICT use vars qw($opt_d $opt_h $opt_t $opt_p);

getopts('d:hp:t');

if (defined $main::opt_h) { &usage; } # no return
if (defined $main::opt_d) { $main::debug = $main::opt_d; } else { $main::debug = 0; }
if (defined $main::opt_p) { $main::context_prefix = $main::opt_p; }
if (defined $main::opt_t) { $main::testmode = 1; } else { $main::testmode = 0; }

# Make sure some of the specified log-files actually exist
unless ($#ARGV >= 0) { &usage; } # no return
my @logs = ();
foreach my $file (@ARGV) {
	if (-f $file) { push @logs, $file; }
	else { &error("log-file '$file' doesn't exist; ignored"); }
}
unless (@logs > 0) { &abort("no specified log-files exist"); }

# Read the request, variables associated with patterns
my $complete = 0;
my @variables = ();
my ($logfile, $variable, $type, $pattern, %pattern, %type);
while ($_ = &prompt) {
	tr/\015\012//d;
	next if (/^#/ or /^\s*$/);
	if (/^LOGFILE\s+(\S+)/) {
		$logfile = $1;
		unless( grep( $logfile, @logs)) {
			&abort("$logfile isn't one of the log-files I serve.");
		}
	}
	elsif (/^GO$/) {
		$complete = 1;
		last;
	}
	elsif (/^QUIT$/) { exit 0; }
	elsif (/^VERSION$/) { print "$main::prog version $main::version\n"; }
	elsif (/^DEBUG$/) {
		$main::debug = 1;
		&debug("debugging on; version $main::version");
	}
	elsif (/^TEST$/) { $main::testmode = 1; }
	elsif (/^HELP$/) { &do_help; }
	elsif (/^(\S+)\s+(sum|count|first|last|max|min|average)\s+(.+)/) {
		$variable = $1;
		$type = $2;
		$pattern = qr{$3};

# May have some order-dependent stuff later
		push @variables, $variable;
		$pattern{$variable} = $pattern;
		$type{$variable} = lc $type;
	}
	else { &error("unknown line in request: $_"); }
}

# Make sure we've got something comprehensible to do
unless ($complete) { &abort("incomplete request"); }
unless (defined $logfile) { &abort("no logfile requested"); }
unless (%pattern) { &abort("no variables requested"); }
unless (grep $logfile, @logs) { &abort("unknown logfile ($logfile)"); }
&debug("logfiles available: ".join(', ',@logs)) if ($main::debug);
&debug(($#variables+1)." variables read") if ($main::debug);

# - - -   Mainline   - - -

# Make sure the context directory exists
unless (-d $main::context_dir) {
	mkdir ($main::context_dir, 0700) or 
		&abort("can't mkdir ${main::context_dir}: $!\n");
}

# Make sure we have some context
my ($contextfile, $position, %value, %count);
($contextfile = $logfile) =~ tr#/#_#;
$contextfile = $main::context_dir . '/' . $main::context_prefix . $contextfile;
if ( -f $contextfile) {

# Get the current log-file position
	open (CONTEXT, "<$contextfile") or 
		&abort("can't open $contextfile: $!");
	$position = <CONTEXT>;
	close(CONTEXT);
	chomp $position;
	&debug("got $position from context $contextfile") if ($main::debug);

# Has the log-file been rolled-over since last time?
	if ($position > -s $logfile) {
		&debug("logfile rolled over; starting from beginning") 
			if ($main::debug);
		$position = 0;
	}
}

# No context-file; either this is a new log (never collected before) or
# we've lost the context.  In either case, remember where we are now and
# don't give misleading info from the beginning.  Logfile may be large.
else {
	&debug("no context; skipping data this time") if ($main::debug);
	&putcontext( $contextfile, -s $logfile) unless ($main::testmode);
	exit 0;
}

# Now deal with the log-file
open (LOG, "<$logfile") or &abort("can't open $logfile: $!");
seek (LOG, $position, 0) or &abort("can't seek $logfile: $!");
my $records = 0;
while (<LOG>) {
	chomp;
	++$records;
	foreach $variable (@variables) {
		if (/$pattern{$variable}/i) {
			&debug("pattern '$pattern{$variable}' matched rec '$_'") if ($main::debug>1);
			$type = $type{$variable};
			if ($type eq 'count') {
				if (defined $value{$variable}) {
					$value{$variable}++;
				}
				else { $value{$variable} = 1; }
			}
			elsif ($type eq 'sum') {
				if (defined $1) {
					if (defined $value{$variable}) {
						$value{$variable} += $1;
					}
					else { $value{$variable} = $1; }
				}
				else { &error("pattern for $variable doesn't define \$1; line=\n$_"); }
			}
			elsif ($type eq 'first') {
				if (defined $1) {
					unless (defined $value{$variable}) {
						$value{$variable} = $1;
					}
				}
				else { &error("pattern for $variable doesn't define \$1; line=\n$_"); }
			}
			elsif ($type eq 'last') {
				if (defined $1) {
					$value{$variable} = $1;
				}
				else { &error("pattern for $variable doesn't define \$1; line=\n$_"); }
			}
			elsif ($type eq 'min') {
				if (defined $1) {
					if (defined $value{$variable}) {
						if ($1 < $value{$variable}) {
							$value{$variable} = $1;
						}
					}
					else { $value{$variable} = $1; }
				}
				else { &error("pattern for $variable doesn't define \$1; line=\n$_"); }
			}
			elsif ($type eq 'max') {
				if (defined $1) {
					if (defined $value{$variable}) {
						if ($1 > $value{$variable}) {
							$value{$variable} = $1;
						}
					}
					else { $value{$variable} = $1; }
				}
				else { &error("pattern for $variable doesn't define \$1; line=\n$_"); }
			}
			elsif ($type eq 'average') {
				if (defined $1) {
					if (defined $value{$variable}) {
						$value{$variable} += $1;
					}
					else { $value{$variable} = $1; }
					if (defined $count{$variable}) { $count{$variable}++; }
					else { $count{$variable} = 1; }
				}
				else { &error("pattern for $variable doesn't define \$1; line=\n$_"); }
			}
			else { &abort("unknown variable type $type for $variable"); }
		}
	}
}

# Remember where we left off
my $eof = tell(LOG);
&debug("$records log records read") if ($main::debug);
&debug("eof at $eof") if ($main::debug);
close (LOG);
&putcontext($contextfile, $eof) unless ($main::testmode);

# Now report what we found
my $now = time;
foreach $variable (@variables) {
	if ($type{$variable} eq 'average') {
		if (defined $value{$variable}) {
			$value{$variable} = $value{$variable}/$count{$variable};
		}
	}
	unless (defined $value{$variable}) { $value{$variable} = 0; }
	print "$now $variable $value{$variable}\n";
}

exit 0;

#------------------------------------------------------------ prompt ---
sub prompt {
	if (-t STDIN) { print $main::prog .'> '; }
	scalar(<STDIN>);
}

#------------------------------------------------------------ do_help ---
sub do_help {
	print <<"EOD_HELP";
$main::prog version $main::version
Valid commands are:
	LOGFILE GO QUIT VERSION DEBUG TEST HELP
or a variable specification:
	variable function pattern

The LOGFILE command requires the name of the log-file.
EOD_HELP
}

#----------------------------------------------------------------- usage ---
sub usage {
	print STDERR <<"EOD_USAGE";
$main::prog version $main::version
usage: $0 [options] logfile ...
where options are:
	-d nnn	enable debugging output at level 'nnn'
	-p ppp	set the prefix for context-files to 'ppp' [$main::context_prefix]
	-h	show this help
EOD_USAGE
	exit 0;
}

#----------------------------------------------------------------- debug ---
sub debug {
	my ($msg) = @_;

	if ($main::debug) { print "DEBUG: $msg\n"; }
0;
}

#--------------------------------------------------------------- abort ---
sub abort {
	my ($msg) = @_;
	print "ABORT: $msg\n";
	exit 1;
}

#--------------------------------------------------------------- error ---
sub error {
	my ($msg) = @_;
	print "ERROR: $msg\n";
}

#---------------------------------------------------------- putcontext ---
sub putcontext {
	my ($file, $string) = @_;

	open (PUTCONTEXT, ">$file") or &abort("can't open $file: $!");
	print PUTCONTEXT $string;
	close (PUTCONTEXT);
	&debug("saved context $string in $file") if ($main::debug);
}

#---------------------------------------------- keep_strict_happy ---
sub keep_strict_happy {
	$main::opt_h = $main::opt_t = 0;
}