#!/usr/bin/perl

use Time::Local;
my $ver="0.3";

my %KnownId;
##

### more lines back -> more RAM needed (10k lines == cca 10MB RAM)
my $linesBackLimit=10000;
#   ?? 10000*512 = 4,8MB ??	-> nevim kolik ma jeden znak asi 512b ??
my $lineLengthLimit=1500;

## Pouziti: 
print "------------ver.'.$ver.'---'\n";
print "Use: tail -f -n 800 /var/log/maillog|mailtrace.pl 'hledany retezec'\n";
##
##
#        \033[0-8;30-37;40-47m
#	     efect,text,pozadi


@colours= ( 
	"\033[31m",
	"\033[32m",
	"\033[33m",
	"\033[34m",
	"\033[35;47m",
	"\033[36;40m",
	"\033[37;40m",
	"\033[1;31m",
	"\033[1;32;1;40m",
	"\033[1;33;1;40m",
	"\033[1;34m",
	"\033[1;35m",
	"\033[1;36;40m",
	"\033[1;37;40m");
$ColourIndex=0;

$search=join(' ',@ARGV);

sub Parse{
  my ($line)=@_;
  my ($id)='';
  my ($next)='';
	#    Oct 14 12:38:27 dita2 MailScanner[13116]: Message 5524B781FA.A890C
	#    Oct 14 12:46:52 dita2 postfix.in/smtp[13618]: 9A5C0781F3:
	# MailScanner[14891]: Message BD80E781F3.A93B0 
  if($line =~ /\d+:\d+:\d+\s[^:]+:.*? ([\da-fA-F]{8,})[\s:\.]/){
        $id=$1;
  }
	# ent (250 2.0.0 Ok: queued as 5A82878D45
	# 1]: Requeue: BD80E781F3.A93B0 to 1F12F78D46
  if($line =~ /status=sent\s\(250\s+.*?\s([\da-fA-F]{8,})/){
        $next=$1;
  }elsif($line =~ /Requeue:\s([\da-fA-F]{8,})\..+to\s+([\da-fA-F]{8,})/){
        $id=$1;
        $next=$2;
  }
  return($id,$next);
}

sub GetColour{
    if( $ColourIndex>scalar(@colours)){
	$ColourIndex=0;
    }
    $ColourIndex++;
    return $colours[$ColourIndex-1];
}

$count=0;
while(defined($line = <STDIN>)){
  my ($MailId, $NextId, $Print);
  ($MailId, $NextId) = Parse($line);
  if(!$MailId){ next;}
  # print "ID: $MailId \t\tnext: $NextId \n";
  if($NextId){								# v urcitych pripadech se kopirovalo samo do sebe a rostlo ^2
	if(exists($KnownId{$NextId}{'line'}) and ($KnownId{$NextId} != $KnownId{$MailId})  ){
		#print $KnownId{$NextId}." != ".$KnownId{$MailId}."\n";
		$KnownId{$MailId}{'line'} .= $KnownId{$NextId}{'line'} ;	#zachovani predchozich lines
	}
	delete $KnownId{$NextId};
	$KnownId{$NextId}=$KnownId{$MailId};
	#print $KnownId{$NextId}." == ".$KnownId{$MailId}."\n";
  }
  if(exists($KnownId{$MailId})){		

	# oriznuti dlouhych lines, u spamu o mnoha adresatech rostlo v RAM
	if( length($KnownId{$MailId}{'line'}) > $lineLengthLimit){
		$KnownId{$MailId}{'line'} = substr($KnownId{$MailId}{'line'},0,500) . "\n** too long, cut off **\n" . substr($KnownId{$MailId}{'line'}, (length($KnownId{$MailId}{'line'})-500));

	}else{
		$KnownId{$MailId}{'line'} .= $line;
	}
	$KnownId{$MailId}{'lastLineNumber'} = $count;		# udelame znacku, na kterem radku bylo naposledy videno (stare radky gc vymaze)
	
	## vypis casu zpracovani 
	#if( $line =~/^\w+ \d+ (\d+:\d+:\d+) .+? postfix\/qmgr.+ removed/){
		#$KnownId{$MailId}{'stop'} = $1;
		#print "process rawdate: $KnownId{$MailId}{'start'} - $KnownId{$MailId}{'stop'}\n";
		# print $KnownId{$MailId}{'colour'}."Process time: ".( date2time($KnownId{$MailId}{'stop'}) - date2time($KnownId{$MailId}{'start'}) )."\033[0m\n";
	#}


	
  }else{
	$KnownId{$MailId}{'line'} = $line;
	$KnownId{$MailId}{'lastLineNumber'} = $count;		# udelame znacku, na kterem radku bylo naposledy videno (stare radky gc vymaze)
	#($KnownId{$MailId}{'start'}) = $line =~/^\w+ \d+ (\d+:\d+:\d+) /;	# znacka start pro tisk casu na zpracovani zpravy
  }
  if(KeySearch($line)){ 
	$KnownId{$MailId}{'printable'} = 1;
	if(!exists($KnownId{$MailId}{'colour'})){
		$KnownId{$MailId}{'colour'} = GetColour();
	}
  }
  if($KnownId{$MailId}{'printable'}){
	chomp($KnownId{$MailId}{'line'});
	print $KnownId{$MailId}{'colour'}.$KnownId{$MailId}{'line'}."\033[0m\n";
	$KnownId{$MailId}{'line'}='';
  }
  $count++;
  if(($count % 1000) == 0){
	gc($count);
 } 
}

sub KeySearch($){
  if($line =~ /$search/){
	return 1;
  }
  return 0;
}

sub gc($){
	my ($now)=@_;
	my %toUdef;
	# vse co ma posledni zapis vice nez 1000 radku zpet vyhodime z RAM
	my $limit=int($now)-$linesBackLimit;
	if($limit< 0){
		return;
	}	

	foreach my $kid (keys(%KnownId)){
	#	print $KnownId{$kid}{'lastLineNumber'}." < ".$limit."\n";
	#	if(!$KnownId{$kid}{'lastLineNumber'}){
	#		print $kid." - ".%{$KnownId{$kid}}."\n";
	#	}

		if($KnownId{$kid}{'lastLineNumber'} < $limit){
			$toUdef{$kid}=1;
		}
	}
	foreach my $id (keys(%toUdef)){
		delete $KnownId{$id};
	}
}

sub date2time($$){
	my ($string) = @_;

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	$year += 1900; ## $year contains no. of years since 1900, to add 1900 to make Y2K compliant
	my @month_abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );

##     if ($string =~ /(\d\d)\/(\d\d)\/(\d\d) (\d\d):(\d\d):(\d\d)$/)$/){
       if ($string =~ /(\d\d):(\d\d):(\d\d)$/){
                my $hh=$1;
		my $mm=$2;
		my $ss=$3;
                my $yr=$year;
		my $mth=$mon;
		my $day=$mday;
              return timelocal($ss,$mm,$hh,$day,$mth,$year);
	}
	return 0;
}


1;