Article View: pl.comp.lang.perl
Article #39723Re: sledzenie wielu logow jednoczesnie
From: hubert depesz lubaczewski
Date: Thu, 14 Oct 2004 18:13
Date: Thu, 14 Oct 2004 18:13
257 lines
7634 bytes
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!newsReferences:
<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