Repository List / perl / trunk / maillog_flow.pl @ HEAD

#!/usr/bin/perl -w

# 2002-06-11 Dobrica Pavlinusic <dpavlin@rot13.org>
#
# Unroll sendmail and/or postfix log on message-by-message basis
#
# Usage:
# $ cat */mail.log | ./flow_mail.pl | vi -R -
#

$|=1;	# flush stdout

my $debug = 0;

my $nr=0;

my %id2nr_hash;
my %nr2id_hash;

my %nr_line;
my %id_line;

my @t = ('','',0);	# placeholder for time stamp

print STDERR "reading log from stdin...\n       0---------12---------24";

sub fix_id {
	if (my $id=$_[0]) {
#		$id =~ tr/a-zA-Z0-9/_/cs;
		$id =~ s/:$//;
		return $id;
	}
}

sub id2nr {
	# "clever" way to find message number -- try current one,
	# if that fails use first one...
	my $id = $_[0];
	if (grep(/$nr/,@{$id2nr_hash{$id}})) {
		return $nr;
	} else {
		return $id2nr_hash{$id}[0];
	}
}

sub push_id2nr {
	my ($id,$nr) = @_;
	if (! grep(/$nr/,@{$id2nr_hash{$id}})) {
		push @{$id2nr_hash{$id}}, $nr;
	}
}

sub push_nr2id {
	my ($nr,$id) = @_;
	if (! grep(/\Q$id\E/,@{$nr2id_hash{$nr}})) {
		push @{$nr2id_hash{$nr}}, $id;
	}
}


while(<>) {
	chomp;
	chomp;
	my $line = $_;
	my @arr=split(/\s+/,$line);
	if ($arr[5] && $arr[5] =~ m/^[a-zA-Z0-9]*:$/) {
		my $id = fix_id($arr[5]);
print STDERR "id: $id\n" if ($debug);
		if (! defined id2nr($id)) {
			$nr++;
print STDERR "new: $nr -- $id\n" if ($debug);
			push_id2nr($id,$nr);
			push_nr2id($nr,$id);
			push @{$nr_line{$nr}}, $line;
			push @{$id_line{$id}}, $line;
		} else {
			my $c_nr=id2nr($id);
print STDERR "line: $c_nr -- $id\n" if ($debug);
			if ($arr[9] && $arr[12] && $arr[9] eq "status=sent") {
				# postfix follow
				my $f_id=fix_id($arr[12]);
				push_id2nr($f_id,$c_nr);
				push_nr2id($c_nr,$f_id);
print STDERR "follow postfix: $c_nr -> $f_id -- ",join("|",@arr),"\n" if ($debug);
			} elsif ($arr[15] && $arr[15] eq "stat=Sent") {
				# sendmail follow
				if (my $f_id=fix_id($arr[19])) {
					push_id2nr($f_id,$c_nr);
					push_nr2id($c_nr,$f_id);
print STDERR "follow sendmail: $c_nr -> $f_id -- ",join("|",@arr),"\n" if ($debug);
				}
			}
			push @{$nr_line{$c_nr}}, $line;
			push @{$id_line{$id}}, $line;
		}
	} else {
		# this is a cludge. If you don't have much other
		# log entries excpt mailers your progress indicator won't
		# be updated often enough. Since I do, I save a lot
		# of computing this way :-)
		
		my $h = $arr[2] || ''; $h =~ s/:.*//g;

		if ($t[0] ne $arr[0] || $t[1] != $arr[1]) {
			printf STDERR "\n%3s %2d ",$arr[0],$arr[1];
			@t = ($arr[0], $arr[1], 0);
		}
		if ($h != $t[2]) {
			print STDERR "." x ($h - $t[2]);
			$t[2] = $h;
		}
	}
}

print STDERR "\nprocessed $nr messages\n";

print STDERR "saving...\n0","-"x21,"50%","-"x21,"100%\n.";

my $last_pcnt=0;

for ($i = 1; $i < $nr; $i++) {
	print "-" x 60,"\n";
	if ($nr2id_hash{$i}) {
		print "nr: $i id: ",join(", ",@{$nr2id_hash{$i}}),"\n";
#		foreach (@{$nr_line{$i}}) {
#			print "$_\n";
#		}
		foreach $id (@{$nr2id_hash{$i}}) {
			foreach (@{$id_line{$id}}) {
				print "$_\n";
			}
		}
	}
	my $pcnt = int($i*50/$nr);
	if ($pcnt > $last_pcnt) {
		print STDERR ".";
		$last_pcnt = $pcnt;
	}
}

print STDERR "\nover...\n";