🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: pl.comp.lang.perl
Article #39723

Re: sledzenie wielu logow jednoczesnie

#39723
From: hubert depesz lubaczewski
Date: Thu, 14 Oct 2004 18:13
257 lines
7634 bytes
Sierp wyrzeźbił(a):
> O ile wiem, jak stworzyc watek, i o ile wiem, jak sledzic
> plik (uzywam File::Tail), to jakos w jedna calosc nie za
> bardzo potrafie tego zlaczyc. Czy tak sie w ogole da?
> Ktos ma pomysl, jak to zrobic?
> PS. Jezeli taki soft jest - chetnie poznam, jednak chec
> samoksztalcenia jest silniejsza :) i chcialbym to napisac

zacznę od końca.
1. jest - xtail/multitail.
2. po co wątki? czy te logi faktycznie aż tak przyrastają?

akurat dziś potrzebowałem kodu do monitorowania logów - 2 lub więcej
plików, tail na nich plus filtrowanie i kolorowanie.

kod jest free - jakbyś miał pytania - pisz na grupie może się komuś
innemu przyda.

#v+
#!/usr/bin/perl -Tw

package MailViewer;
use strict;
use Spiffy qw(-Base);
use Data::Dumper;
use Term::ANSIColor qw(:constants);
use POSIX qw(strftime);

sub modifyLineExim {
	local $_ = shift;
	my $rColors = [ [0, BOLD.BLACK], [10000, BOLD.GREEN], [50000, BOLD.YELLOW], [250000, BOLD.MAGENTA], [1000000, BOLD.RED] ];
	return undef unless s/^\d\d\d\d-\d\d-\d\d (\d\d:\d\d:\d\d) ([A-Za-z0-9]{6}-[A-Za-z0-9]{6}-[A-Za-z0-9]{2})\s+//;
	my $sID = $2;
	my $sTime = $1;

	return undef if /^==\s+/;
	return undef if /^Message is frozen\s*$/;
	return undef if /Warning: SPAM-score: \d+\s*$/;
	if (/^Completed\s*$/) {
		delete($self->{'MIDs'}->{$sID}) if defined($self->{'MIDs'}->{$sID});
		return undef;
	}
	if (/^<=\s+(\S+)\s.*\sS=(\d+)(\s.*|$)/) {
		my $sUser = $1;
		my $sSize = $2;
		my $sIP = $self->normalizeIP(/.*\[(\d+\.\d+\.\d+\.\d+)\]/ ? $1 : 'local');
		$self->{'MIDs'}->{$sID} = $sSize;
		my $sMsg = sprintf(
			'%s%8s | %4s | %-15s | %-80s | %10u | %10s | %16s%s'."\n",
			$self->getColor($sSize, $rColors),
			$sTime,
			'smtp',
			$sIP,
			"from: " . $sUser,
			$sSize,
			$self->normalizeSize($sSize),
			$sID,
			RESET,
		);
		return $sMsg;
	}
	if (/^[=-]>\s+(\S+(?:\s+<[^>]*>)?)\s+.*\sT=(pgsql_delivery|remote_smtp)(\s|$)/) {
		my $sUser = $1;
		my $sTransport = $2;
		my $sIP;
		if ($sTransport eq 'pgsql_delivery') {
			$sIP = 'local';
		} else {
			$sIP = $self->normalizeIP(/\[(\d+\.\d+\.\d+\.\d+)\]/ ? $1 : 'undef');
		}
		my $sSize = $self->{'MIDs'}->{$sID};
		my $sMsg = sprintf(
			'%s%8s | %4s | %-15s | %-80s | %10u | %10s | %16s%s'."\n",
			$self->getColor($sSize, $rColors),
			$sTime,
			'smtp',
			$sIP,
			"to  : " . $sUser,
			$sSize || 0,
			$self->normalizeSize($sSize || 0),
			$sID,
			RESET,
		);
		return $sMsg;
	}
	return undef;
}

sub modifyLineMail {
	local $_ = shift;
	my $rColors = [ [0, BOLD.BLACK], [10000, BOLD.GREEN], [50000, BOLD.YELLOW], [250000, BOLD.MAGENTA], [1000000, BOLD.RED] ];
	if (/^.*\s(\d\d:\d\d:\d\d)\s+[a-z]+\s+courierpop3login: LOGOUT, user=(\S+), ip=\[::ffff:(\d+\.\d+\.\d+\.\d+)\], top=\d+, retr=(\d+)\s*$/) {
		my $sTime = $1;
		my $sUser = $2;
		my $sIP   = $3;
		my $sSize = $4;
		return undef if 0 == $sSize;
		$sIP = $self->normalizeIP($sIP);
		my $sMsg = sprintf(
			'%s%8s | %4s | %-15s | %-80s | %10u | %10s%s'."\n",
			$self->getColor($sSize, $rColors),
			$sTime,
			'pop3',
			$sIP,
			$sUser,
			$sSize,
			$self->normalizeSize($sSize),
			RESET,
		);
		return $sMsg;
	}
	if (/^.*\s(\d\d:\d\d:\d\d)\s+[a-z]+\s+imaplogin: LOGOUT, user=(\S+), ip=\[::ffff:(\d+\.\d+\.\d+\.\d+)\], headers=(\d+), body=(\d+)\s*$/) {
		my $sTime = $1;
		my $sUser = $2;
		my $sIP   = $3;
		my $sSize = $4+$5;
		return undef if 0 == $sSize;
		$sIP = $self->normalizeIP($sIP);
		my $sMsg = sprintf(
			'%s%8s | %4s | %-15s | %-80s | %10u | %10s%s'."\n",
			$self->getColor($sSize, $rColors),
			$sTime,
			'imap',
			$sIP,
			$sUser,
			$sSize,
			$self->normalizeSize($sSize),
			RESET,
		);
		return $sMsg;
	}
	return undef;
}

sub normalizeSize {
	my $size = shift;
	if ($size < 1.5 * 1024) {
		return "$size B";
	}
	return sprintf("%.1f kB", $size/1024) if $size < 1.5 * 1024 * 1024;
	return sprintf("%.1f MB", $size/(1024*1024));
}

sub getColor {
	my $sVar = shift || 0;
	my $rColors = shift;
	my @aMatching = grep { $_->[0] <= $sVar } @$rColors;
	return $aMatching[-1]->[1] || '';
}


sub addFile {
	my $sFile = shift;
	my $sType = shift;
	$self->{'src'}->{$sFile}->{'type'} = $sType;
}

sub mainLoop {
	while (1) {
		$self->makeNewFilenames();
		my @aFiles = $self->filesToTail();
		for my $rFile(@aFiles) {
			$self->tailFile($rFile);
		}
		sleep 1;
	}
}

sub tailFile {
	my $rFile = shift;
	open(IN, "<", $rFile->{'filename'}) or die "couldn't open: " . $rFile->{'filename'} . ".\n";
	seek(IN, $rFile->{'position'}, 0);
	while (my $l = <IN>) {
		$rFile->{'position'} = tell(IN);
		$self->printLine($rFile->{'type'}, $l);
	}
}

sub printLine {
	my $x = shift;
	my $sLine = shift;
	if ($x->{'type'} eq 'exim') {
		$sLine = $self->modifyLineExim($sLine);
	} elsif ($x->{'type'} eq 'mail') {
		$sLine = $self->modifyLineMail($sLine);
	}
	print $sLine if $sLine;
}

sub filesToTail {
	my @aReply = ();
	for my $sKey (keys %{$self->{'src'}}) {
		my $rFile = $self->{'src'}->{$sKey}->{'activeFile'};
		next unless -f $rFile->{'filename'};
		my @aStats = stat($rFile->{'filename'});
		if (!$rFile->{'inode'}) {
			$rFile->{'position'} = $aStats[7]-100000;
			$rFile->{'position'} = 0 if 0 > $rFile->{'position'};
			$rFile->{'inode'} = $aStats[1];
			push @aReply, $rFile;
			next;
		}
		if ($rFile->{'inode'} != $aStats[1]) {
			$rFile->{'position'} = $aStats[7]-100000;
			$rFile->{'position'} = 0 if 0 > $rFile->{'position'};
			$rFile->{'inode'} = $aStats[1];
			push @aReply, $rFile;
			next;
		}
		if (!defined($rFile->{'position'})) {
			$rFile->{'position'} = $aStats[7]-100000;
			$rFile->{'position'} = 0 if 0 > $rFile->{'position'};
			push @aReply, $rFile;
			next;
		}
		if ($rFile->{'position'} < $aStats[7]) {
			push @aReply, $rFile;
			next;
		}
	}
	return @aReply;
}

sub makeNewFilenames {
	for my $sKey (keys %{$self->{'src'}}) {
		my $sFilename = strftime($sKey, localtime(time()));
		$self->{'files'}->{$sFilename} ||= {
			'filename'	=>	$sFilename,
			'type'	=>	$self->{'src'}->{$sKey}
		};
		$self->{'src'}->{$sKey}->{'activeFile'} = $self->{'files'}->{$sFilename};
	}
}

sub normalizeIP {
	my $sIP = shift;
	$sIP =~ s/^127.0.0.1$/WEBMAIL/;
	return $sIP;
}

package main;
use strict;

my $x = MailViewer->new();
$x->addFile('/var/log/exim4/%Y%m%d/main.log', 'exim');
$x->addFile('/var/log/syslog/%Y-%m-%d/src/mail/info.log', 'mail');

$x->mainLoop();

#v-

depesz

-- 
  napisanie do mnie na priv daje 99.9% gwarancję braku odpowiedzi
*-----------------------------------------------------------------*
 sklep z rzeczami do domu:                        http://ulek.net/
Technical Details
Message-ID: <slrn.pl.cmtge1.hh6.depesz@depeszms.hq.eo.pl>
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.gazeta.pl!newsfeed.pionier.net.pl!news.nask.pl!newsfeed.atman.pl!depeszms.hq.eo.pl!news
References: <20041014191230.26e593bd.NOspam@sierp.netwytnijcalosc>

Show Full Headers
Complete Article Headers
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.gazeta.pl!newsfeed.pionier.net.pl!news.nask.pl!newsfeed.atman.pl!depeszms.hq.eo.pl!news
From: hubert depesz lubaczewski <depesz@depesz.com>
Newsgroups: pl.comp.lang.perl
Subject: Re: sledzenie wielu logow jednoczesnie
Date: Thu, 14 Oct 2004 20:13:21 +0200
Organization: depesz Software
Lines: 257
Message-ID: <slrn.pl.cmtge1.hh6.depesz@depeszms.hq.eo.pl>
References: <20041014191230.26e593bd.NOspam@sierp.netwytnijcalosc>
NNTP-Posting-Host: anaconda.eo.pl
Mime-Version: 1.0
X-Trace: node1.news.atman.pl 1097778006 32387 217.17.33.94 (14 Oct 2004 18:20:06 GMT)
X-Complaints-To: abuse@atman.pl
NNTP-Posting-Date: Thu, 14 Oct 2004 18:20:06 +0000 (UTC)
X-Licznik: 8964
User-Agent: slrn/0.9.7.4 (pl-1.4.3) (Linux/2.6.8-1-686 (i686))
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit