use utf8;
use warnings;
use strict;
use Dbase::Globals qw(unterkunden find_descr bignum find_dienst);
use Dbase::Help qw(DoFn qquote DoTime Do DoBinary);
use Cf qw($WDESCR $MAILDOM);
use Errno;
use Storable qw(nfreeze thaw);

my %mmcache;
# my $mflag = bignum(1)<<find_descr("pwdomain", "mail");
my $mflag=0; # ignorieren

sub mailhost($$) {
	my($acct,$host) = @_;
	my $dom;
	return undef unless defined $host;
	if($host =~ /^\(?\b(\S+)\b.* \[(\S+)\]/) {
		return $acct->who_ip($2) || $acct->who_dom($1,1);
	} elsif($host =~ /\[(\S+)\]/) {
		return $acct->who_ip($1);
	} elsif($host =~ /^(\S+)/) {
		return $acct->who_dom($1,1);
	} else {
		return undef;
	}
}

sub mailaddr($$) {
	my($acct,$adr) = @_;
	my($cust) = "";
	$adr =~ s/^\<(.*)\>$/$1/;
	my($thegoodadr,$theadr,$nextadr) = ("","",$adr);
	while(1) {
		if($adr =~ /^\@([^\@\,\:]*)[\,\:](.*)$/) {
			$theadr=$1;$nextadr=$2;
		} elsif($adr =~ /^(.*)\@([^\@]*)$/) {
			$theadr=$2;$nextadr=$1;
		} elsif($adr =~ /^([^\!]*)\!(.*)$/) {
			$theadr=$1;$nextadr=$2;
		} elsif($adr =~ /^(.*)\%([^%]*)$/) {
			$theadr=$2;$nextadr=$1;
		} else {
			last;
		}
		if($theadr =~ /\./) {
			$cust = $acct->who_dom($theadr,1) if $cust eq "";
		} else {
			$cust = $acct->{'hash_uucp'}{$theadr} if $cust eq "";
		}
		$thegoodadr = $theadr;
		$adr = $nextadr;
	}
	$theadr = lc $theadr;
	$adr = lc $adr;
	if($thegoodadr eq "") {
		return (1,$theadr,$adr);
	}
	$thegoodadr = lc $thegoodadr;
	no warnings 'numeric';

	$cust = "w" if not $cust;
	if($cust > 0) {
		my $mm;
		no warnings 'uninitialized'; # $mm

		unless(defined($mm = $mmcache{"$adr\@$thegoodadr"})) {
			# print STDERR "NOCACHE $adr\@$thegoodadr\n";
			if($mflag and $mm == 0 and $cust == 1) {
				my($mx,$px) = DoFn("select person.kunde,person.pwuse from person where user = ${\qquote $thegoodadr}");
				$mm = $mx if $mx > 0 and $px & $mflag;
			}
			if($mflag and $mm == 0) {
				my($mx,$px) = DoFn("select person.kunde,person.pwuse from kunde,person where person.kunde = kunde.id AND ( kunde.ende IS NULL OR kunde.ende >= UNIX_TIMESTAMP(NOW()) ) AND email = ${\qquote \"$adr\@$thegoodadr\"}");
				$mm = $mx if $mx > 0 and $px & $mflag;
			}
			$mmcache{"$adr\@$thegoodadr"} = ($mm || 0);
		}
		$cust = $mm if $mm > 0;
	}
	return ($cust,$thegoodadr,$adr);
}


my %uk = ();
foreach my $uk(unterkunden(1)) { $uk{$uk} = 1; }

#2004-05-25 06:25:24 1BQKQc-0007Yr-IX <= test-sender@accttest.de H=mail03.noris.net [62.128.1.223] P=esmtp X=TLS-1.0:RSA_ARCFOUR_SHA:16 S=300152 id=test-msgid@accttest.de
#2004-05-25 06:25:24 1BQKQc-0007Yr-IX => test-empfaenger@accttest2.de R=dnslookup T=remote_smtp H=blubber.accttest2.de [194.25.134.9]
#2004-05-25 06:25:24 1BQKQc-0007Yr-IX Completed
#2004-05-25 06:25:17 1BS71V-0001CU-JP ** zdpwmy@chinaren.com F=<> R=dnslookup T=remote_smtp: SMTP error from remote mailer after MAIL FROM:<> SIZE=5448: host mx.chinaren.com [61.135.132.108]: 554 Error: unknown sender
#2004-05-25 06:25:17 1BS71V-0001CU-JP zdpwmy@chinaren.com: error ignored
#2004-05-25 06:25:17 1BS71V-0001CU-JP Completed
#2004-05-25 06:25:17 1BS71V-0001CT-6Y Unfrozen by errmsg timer
#2004-05-25 06:25:17 SMTP connection from ...

use constant CACHE_DB => 1;
use constant CACHE_TIME => 10;

sub dt_clean($) {
	my($db) = @_;
	return unless CACHE_DB;
	my $mintm = DoTime()-24*3600*CACHE_TIME;

	my $id = DoFn("select id from nextid where name='exim_cache_$db'");
	my $maxid = DoFn("select max(id) from exim_cache_$db");
	return unless $maxid;
	unless($id) {
		$id=1;
		Do("insert into maxid set name='exim_cache_$db', id=$id");
	}
	while($id < $maxid) {
		my $tm = 0+DoFn("select timestamp from exim_cache_$db where id=$id");
		next unless $tm;
		last if unixtime($tm) > $mintm;
		Do("delete from exim_cache_$db where id=$id");
	} continue {
		$id++;
	}
	Do("update nextid set id=$id where name='exim_cache_$db'");
}

sub dt_save($$$) {
	my($db,$id,$data) = @_;
	Do("replace into exim_cache_$db set data=${\qquote(nfreeze($data))}, exim_id=${\qquote $id}");
}

sub dt_del($$) {
	my($db,$id) = @_;
	Do("delete from exim_cache_$db where exim_id=${\qquote $id}");
}

sub dt_load($$) {
	my($db,$id) = @_;
	my $data;
	$data = DoFn("select data from exim_cache_$db where exim_id=${\qquote $id}");
	return undef unless defined $data;
	return thaw($data);
}

my %id = ();
sub acct_exim {
	my($file) = @_;
	my $dir = $file->{dir};
	$dir="both" unless defined $dir;
	my $mail_in = find_dienst("mail-in");
	my $mail_out = find_dienst("mail-out");

	my $acct_in = do_start(want=>"mail,kunde,ip,domain,ip_de,uucp,pers",dienst=>"mail-in",quelle=>$WDESCR,logdir=>"exim-in",do_reverse=>0);
	my $acct_out = do_start(want=>"mail,kunde,ip,domain,ip_de,uucp,pers",dienst=>"mail-out",quelle=>$WDESCR,logdir=>"exim-out",do_reverse=>0);
	return "Kein Accounting" unless ref $acct_in and ref $acct_out;

	#dts# msgid: Senderdaten, aufgehobene
	#dt # locid: Senderdaten, aktuelle
  DoBinary {
	mada:
	while(defined(my $line = get_line($acct_in))) {
		chomp $line;
		$line =~ s/^ +//; $line =~ s/ +$//;
		# $line =~ s/^\[\d+\]\s*//;

		my ($dat,$tim,$locid,$was,$rest) = split(/\s+/,$line,5);
		next unless $locid;
		next if $locid eq "SMTP";

		my @adr;
		my %data;
		if($was =~ /^[A-Z]=/i) {
			my $dx = dt_load(1,$locid);
			if(defined $dx and $dx->{"was"} eq "Virus_found") {
				$rest = "$was $rest";
				$was = "VF2";
			}
		}
		if($was eq "<=" or $was eq "=>" or $was eq "->"
				or $was eq "Virus_found" or $was eq "VF2") {
			$rest .= " ";
			my $key = "";

			# Das erste Argument hinter <= etc. ist immer eine Mailadresse
			my $skip = 1;

			while($rest ne "") {
				if(not $skip and ($rest =~ s/^(\w+)="(.*?)"\s+// or
				   $rest =~ s/^(\w\w?)=(\S*)\s+// or
				   $key ne "" and $rest =~ s/^(\w+)=(\S*)\s+//)) {
					$key=lc($1);
					$data{$key}=$2;
				} elsif($rest =~ s/^((?:"[^@]+")?\S+)\s+//) {
					if($key eq "") {
						my $adr = $1;
						$adr =~ s/,$//;
						if($adr =~ /^<(.+)>$/) {
							pop(@adr);
							push(@adr,$1);
						} else {
							push(@adr,$adr);
						}
					} else {
						$data{$key} .= " ".$1;
					}
				} else {
					print STDERR "Unknown:2: $line\n... $rest\n";
					next mada;
				}
				$skip=0;
			}
			if($was eq "<=" or $was eq "Virus_found") {
				$data{"was"} = $was;
				$data{"date"} = unixtime("$dat $tim");
				my $data = (defined $data{"id"}) ? dt_load(2,$data{"id"}) : undef;
				if(defined $data) {
					dt_save(1,$locid, $data);
					dt_del(2,$data{"id"});
				} else {
					if($was eq "<=") {
						if(@adr != 1) {
							print STDERR "E-Mail-Adresse nicht eindeutig erkannt: $line\n";
							next mada;
						}
						$data{"adr"} = $adr[0];
					} else { # Virus: Empfängeradressen!
						$data{"adr"} = \@adr;
					}
					dt_save(1,$locid, \%data);
				}
				next mada;
			}
		} elsif($was eq "**" or $was eq "Frozen" or $was eq "Unfrozen") {
			next; # ignoriere diese Zeile
		} elsif($line =~ /\[[\.0-9]+\]:/) {
			next;
		} elsif($was eq "Completed") {
			dt_del(1, $locid);
			next;
		} elsif($was eq "==") {
		} elsif($was eq "Virus_checked") {
		} elsif($was eq "Spam_checked") {
		} elsif($was eq "disconnection") {
		} elsif($was eq "removed") {
		} elsif($was eq "Unknown" and $line =~ / Unknown local part /) {
		} elsif($line =~ / sender verify fail /) {
		} elsif($line =~ / no host name found /) {
		} elsif($line =~ / no IP address found /) {
		} elsif($line =~ / Start queue run:/) {
		} elsif($line =~ / End queue run:/) {
		} elsif($line =~ / rejected AUTH LOGIN:/) {
		} elsif($line =~ / rejected AUTH PLAIN /) {
		} elsif($line =~ / rejected RCPT /) {
		} elsif($line =~ / rejected VRFY /) {
		} elsif($line =~ / Malformed SMTP reply /) {
		} elsif($line =~ / SMTP data timeout /) {
		} elsif($line =~ / SMTP timeout while /) {
		} elsif($line =~ / Authorization required for sending short messages /) {
		} elsif($line =~ / TLS error on connection /) {
		} elsif($line =~ / TLS session failure:/) {
		} elsif($line =~ /: STARTTLS required before AUTH$/) {
		} elsif($line =~ / malware acl condition:/) {
		} elsif($line =~ / demime acl condition:/) {
		} elsif($line =~ / remote host address is the local host:/) {
		} elsif($line =~ / rejected after DATA:/) {
		} elsif($line =~ / unqualified sender rejected:/) {
		} elsif($line =~ / unqualified recipient rejected:/) {
		} elsif($line =~ / sender verify defer for /) {
		} elsif($line =~ / condition test deferred:/) {
		} elsif($line =~ / closed connection in response to /) {
		} elsif($line =~ / host name alias list truncated /) {
		} elsif($line =~ / CNAME loop for /) {
		} elsif($line =~ / no immediate delivery:/) {
		} elsif($line =~ / Connection from .+ refused:/) {
		} elsif($line =~ /: error ignored$/) {
		} elsif($line =~ / spam acl condition:/) {
		} elsif($line =~ / Spool file .+ not found$/) {
		} elsif($line =~ /: No route to host$/) {
		} elsif($line =~ /: Broken pipe/) {
		} elsif($line =~ /: host lookup did not complete$/) {
		} elsif($line =~ /: Connection timed out$/) {
		} elsif($line =~ /: Connection reset by peer$/) {
		} elsif($line =~ /\sexim 4.50 daemon started: pid=\d+\s$/) {
		} else {
			# print STDERR "Unknown:1:$was: $line\n";
			next;
		}
		# Ab hier: nur Empfängerzeilen

		# Mail an mailq weitergeleitet? => später.
		my $data = dt_load(1,$locid);
		unless($data) {
			# print STDERR "ID_unbekannt $line\n";
			next mada;
		}
		if(defined $data->{"h"} and $data->{"h"} =~ /^mailq\.$MAILDOM\s/) {
			if($data->{"id"}) {
				dt_save(2,$data->{"id"}, $data);
			}
			next mada;
		}
		
		my($volpack,$msgid);

		$volpack=$data->{"s"};
		$msgid=$data->{"id"} || "?";
		if($was eq "VF2") {
			dt_del(1,$locid); # es gibt keine "Complete"-Zeile
			$data->{"h"} = $data{"h"}; # das steht in der zweiten Zeile,
			                           # ich brauchs aber in der ersten
			
			# Bei Viren sind, siehe oben, die Zieladressen in @adr und
			# die Quelle in $f.
			@adr = @{$data->{"adr"}};
			$data->{"adr"} = $data->{"f"};
			$volpack /= (0+@adr); # accounte abgelehnte Virenmails nur einmal
		}

		no warnings "numeric";
		my $fromhost = $data->{"h"};

		# Workaround für eXpurgate@mx, vgl. RT#342663:
		next if defined $fromhost and $fromhost =~ /^localhost /i;

		my $tohost = $data{"h"};

		my $thefrom = $data->{"adr"}; $thefrom="" unless defined $thefrom;
		my($fromdom,$fromadr,$fromlocal)=mailaddr($acct_in,$thefrom);
		my $as = $data->{"a"}; # SMTP-Auth: "A=login:NAME"
		if(defined $as and $as =~ s/^login://) {
			unless ( defined( my $user = $acct_in->{hash_uucp}{$as} ) ) {
				warn "Unbekannter Benutzer im exim-Log: $as\n";
			}
			elsif ( $user > 0 ) { $fromdom = $user }
		}

		my $dom = mailhost($acct_in,$fromhost);
		$fromdom=$dom if defined $dom and $dom>0;

		foreach my $adr(@adr) {
			my($todom,$toadr,$tolocal)=mailaddr($acct_in,$adr);

			my $dom = mailhost($acct_in,$tohost);
			$todom=$dom if defined $dom and $dom>0;

			no warnings "uninitialized";

			# ankommend, d.h. auf das Ziel zu accounten
			$acct_in->acct($todom,$mail_in,$fromdom,$mail_out, 1,$volpack,
				    "$fromdom|$todom|$msgid|$locid|$fromlocal\@$fromadr|$tolocal\@$toadr|$fromhost|$tohost|$volpack")
				if $dir ne "out";

			# abgehend, d.h. auf die Quelle zu accounten
			$acct_out->acct($fromdom,$mail_out,$todom,$mail_in, 1,$volpack,
				    "$fromdom|$todom|$msgid|$locid|$fromlocal\@$fromadr|$tolocal\@$toadr|$fromhost|$tohost|$volpack")
				if $dir ne "in";
		}
	}
  };
	do_end($acct_in);
	do_end($acct_out);
}

1;
