Date: Tue, 22 Jun 1999 12:38:02 +0100
From: Peter Galbavy <Peter.Galbavy@knowledge.com>
To: new-httpd@apache.org
Subject: [CONTRIB] log splitting script
Message-ID: <19990622123802.A558@office.knowledge.com>
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="tThc/1wpZn/ma/RB"
Sender: new-httpd-owner@apache.org
Precedence: bulk
Reply-To: new-httpd@apache.org


--tThc/1wpZn/ma/RB
Content-Type: text/plain; charset=us-ascii

Not really a patch, but a small script that takes log lines and
in some small configurable way writes it to a log files hinted by the
first field (usually %V). You can configure the maximum number of open
files at any time etc.

If this is any use please feel free to make it available in the
contrib stuff (or even the support directory if it is good enough).

My company is happy for the Apache Group to have the copyright and
change the condition of distibution.

An uncommented, untidy version of this script has been in use here for
some considerable time. Comments welcome. Patches more so.

Regards,
-- 
Peter Galbavy
Knowledge Matters Ltd
http://www.knowledge.com/

--tThc/1wpZn/ma/RB
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename=splitlog

#!/usr/bin/perl -w
use strict;

#
# $Id: splitlog,v 1.4 1999/06/22 11:32:23 peter Exp $
#
# Copyright (c) 1999 Knowledge Matters Ltd. All Rights Reserved.
#
# Permission is granted to use or distributed this program and
# modifications for any purpose as long as you do not claim to
# any rights over it or that you wrote it.
#
# YOU USE THIS AT YOUR OWN RISK. NO WARRANTY IS GIVEN AS TO WHAT THIS
# PROGRAM SHOULD DO OR OR ACTUALLY DOES. You should read the code and
# if you think it will work, try it AT YOUR RISK.
#
# Having said all that, please send any changes or suggestions back to
# peter.galbavy@knowledge.com
#

#
# accept log lines on stdin and log to a file that is based
# on the contents of that line (ie a virtual host)
#
# implements a very simple LRU algorithm for max open files, using a
# hash (%USED) to store the last time this file was written to.
# When we start running out of fd's, close the least recently used fd.
# 

use Carp;
use IO::File;
use File::Path;
use File::Basename;

#
# configurables
#
# change these to local preferences
#

#
# The ServerRoot or your equivalent. Logs are written to
#
#	"$root/SITEDIR/logs/somefile.log"
#
my $root = "/w/domains";

#
# The map file - note that this can be shared with a txt: map used by
# mod_rewrite - in the format:
#
#	NAME1		www.domain.example
#	NAME2		www.domain.example
#	NAME3		www.domain.example
#
#	OTHER1		www.otherdomain.example
#
# or
#
#	NAME1		example/NAME1.domain
#
my $mapfile = "$root/DOMAINS.txt";

#
# The prefixes that make up the first component of a server name that
# would get translated to the log file prefix.
#
my $prefixes = "stage|www";
my $deflog = "access.log";

#
# Where to store a PID file, for "kill -HUP `cat PIDFILE`"
#
my $scriptname = basename($0);
my $pidfile = "/var/run/$scriptname.pid";

#
# Size of file descriptor cache
#
my $MAXFD = 50;

#
# debug switch 
#
my $debug = 0;

#
# END OF CONFIGURABLES
#

my (%FILES, %USED, $base);

#
# rcord the modification time of the mapfile
#
my $ageofmapfile = (stat($mapfile))[9];

my %map = initmap($mapfile);

open(PIDFILE, ">$pidfile") || carp "splitlog: cannot write to $pidfile";
print PIDFILE "$$";
close PIDFILE;

#
# close of log files and re-init mapfile on SIGHUP
#
$SIG{HUP} = sub {
	foreach (keys %FILES) {
		$FILES{$_}->close;
		$FILES{$_} = undef;
		delete $FILES{$_};
		delete $USED{$_};
	}
	undef %map;
	%map = initmap($mapfile);
};

#
# Main loop - accept lines of the form:
#
# SERVERNAME REST-OF-LINE
#
# and write them to the appropriate file from the mapfile, with the
# SERVERNAME stripped off
#
while (<>) {
	my ($host, $line) = split(/\s+/, $_, 2);
	chomp $host;

	#
	# check if mapfile has been updated
	#
	if ((stat($mapfile))[9] != $ageofmapfile) {
		$ageofmapfile = (stat(_))[9];
		%map = initmap($mapfile);
	}

	$host = lc $host;

	# match a defined prefix and strip before mapping or use the
	# default log file name
	#
	# this allows "stage.domain.example" to be mapped through
	# like:
	#
	#	stage.domain.example -> domain.example
	# then through mapfile
	#	domain.example -> example/www.domain.example
	#
	# so that the log file is actually:
	#	$root/example/www.domain.example/logs/stage.log
	#
	if ($host =~ m/^($prefixes)\./) {
		my $prefix = $1;
		$base = "$prefix.log";
		$host =~ s/^$prefix\.//;
	} else {
		$base = $deflog;
	}

	my $hostdir = $map{$host};

	if ($hostdir =~ m/^[\d\.]+$/ || $hostdir !~ /^[\w\.-\/]+$/) {
		print STDERR "$scriptname ERROR: $hostdir -> $_";
		next;
	}

	unless (exists $FILES{$hostdir}) {
		if (keys %FILES >= $MAXFD) {
			my $least = (sort { $USED{$a} <=> $USED{$b} }
				     keys %USED)[0];
			print STDERR "$scriptname: too many open files; closing $least log\n" if $debug;
			$FILES{$least}->close;
			delete $FILES{$least};
			delete $USED{$least};
		}
		my $dir = "$root/$hostdir/logs";
		mkpath($dir, 0, 0770);
		print STDERR "$scriptname: opening log file $dir/$base\n"
			if $debug;
		$FILES{$hostdir} = IO::File->new("$dir/$base", "a")
			|| carp "can't open $dir/$base";
		$FILES{$hostdir}->autoflush(1);
	}

	$FILES{$hostdir}->print($line);
	$USED{$hostdir} = time;
}

sub initmap {
	my $mapfile = shift;
	my %map;

	print STDERR "$scriptname: reading mapfile $mapfile\n" if $debug;

	open(MAPFILE, $mapfile);
	while (<MAPFILE>) {
		next if m/^#/;
		next if m/^\s*$/;
		chomp;

		my ($key, $value) = split(/\s+/, $_, 2);
		$map{$key} = $value;
	}	

	return %map;
}

1;

--tThc/1wpZn/ma/RB--