#!/usr/bin/perl 

########## Confixx(R) 3.0 Professional ############
####### Copyright SWsoft, Inc. 2004-2005 ##########
#### http://www.sw-soft.com - info@sw-soft.com ####

# $id: smtptraffic.pl, v 1.0 2003/10/16 $

require "MailLogParser/Batch.pm";
require "MailLogParser/Line.pm";

=head1 NAME

утилита анализа log-файла smtp-сервера для Confixx

=head1 SYNOPSIS

./smtptraffic.pl [-f E<lt>mail-log-fileE<gt>] [-c E<lt>confixx-config-fileE<gt>] 
                 [-a ] [-s E<lt>skip-numberE<gt>] [-t E<lt>time-outE<gt>]
		 [-d E<lt>debug-levelE<gt>] 

=head1 DESCRIPTION

Анализирует log-файлы smtp-серверов B<sendmail>, B<postfix>, B<qmail>

=over 1

Часть системы Confixx

=back

=head1 OUTPUT

Записывает в таблицу B<traffic> информацию по проходящему через smtp-сервер трафику,
соответствующему пользовательским доменам системы Confixx

Разделяет его по признакам:

=over 4

=item I<local>

локальный - внешний

=item I<sent> - I<received>

входящий - исходящий

=item I<maillist_id>

относящийся к какому-либу листу рассылок B<Majordomo>

утилита идентифицирует адреса как относящиеся к системе управления 
списками рассылок B<Majordomo> следующим образом:

B<owner>-E<lt>mlist_nameE<gt>, 
E<lt>mlist_nameE<gt>-(B<approval>E<verbar>B<outgoing>E<verbar>B<request>E<verbar>B<archive>E<verbar>B<outgoing-real>)

Кроме этого поддерживаются адреса вида

E<lt>mlist_nameE<gt>-E<lt>domain_idE<gt>

=item I<kunde>

пользователь Confixx

=item I<anbieter>

reseller Confixx

=item I<year>

Так в log-файле не указан год, то утилита берет текущий год из локального времени или предъидущий, 
если номер месяца меньше номера текущего месяца

=item I<month>

месяц

=item I<day>

день месяца

=back 

=head1 PARAMETERS

=over 4

=item -fE<verbar>--file E<lt>mail-log-fileE<gt>

анализируемый log-файл 

По умолчанию F</var/log/maillog>

=item -cE<verbar>--config E<lt>confix-config-fileE<gt>

файл конфигурации Confixx F<confixx_main.conf>

Если параметр не задан, то файл ищется в  F</usr/local/confixx/> 
или в каталоге с выполняемым скриптом

=item -tE<verbar>--timeout E<lt>number-of-secondsE<gt>

Таймаут в секундах (по умолчанию 300)

Записи в log-файле группируются в блоки. 
В B<postfix> и B<sendmail> нет метки окончания блока.
Поэтому применяется механизм закрытия блока по таймауту.
Если c момента последней строки блока прошло больше секунд чем указано в таймуате,
то блок закрывается

Незакрытые блоки не заносятся в базу, а передаются для последующей обработки

=item -sE<verbar>--skip E<lt>number-of-lineE<gt>

Количество пропускаемых строк. 

Утилита не ищет последнюю обработанную строку, а пропускает указанное количество строк

=item -aE<verbar>--all

Обрабатывается весь файл с начала

=item -dE<verbar>--debug E<lt>debug-levelE<gt>

Степень детализации отладочной информации. По умолчанию 0

=item -hE<verbar>--help

Помощь по утилите

=back

=cut

use Getopt::Long;
use DBI;

my $log='/var/log/maillog';
my $timeout = 300;
my $debug = 0;


sub printHelp {
  use File::Basename;
  my $script = &basename($0);
  print << "HELP";
usage:
	$script [<options>]

options:
  -c|--config <confixx-config-file>     path to confix_main.conf
  -f|--file <mail-log-file>             path to maillog, default /var/log/maillog
  -t|--timeout <number-of-seconds>      default 300
  -a|--all                              process the whole of log-file
  -s|--skip <number-of-skip-line>       skip the first lines
  -d|--debug <debug-level>              default 0
  -h|--help

HELP
  exit 0;
}

#my ($db_address, $dbUser, $dbPw, $majordomo_ldir, $bin_grep, $installDir, $language); ## get from config	

my (%lang_text);
my ($curMonth,$curYear) = (localtime)[4,5];
my ($lastLine,$firstDayIndex);
my $GrepAusgabe;
my (%Domains,%Kunden,%Anbieter,%MailLists,%Pops); #was filled with &getDomains


Getopt::Long::Configure('prefix_pattern=--|-||','ignore_case');
my @args_config = (
  'file|f=s',
  'all|a',
  'skip|s=i',
  'config|c=s',
  'timeout|t=i',
  'debug|d=i',
  'help',
  'h'
);

my %args = ();
unless (&GetOptions(\%args,@args_config)){
  print "Error of the comman line\n";
  &printHelp;
  exit 1;
}
if (exists $args{help}){
  system("pod2man $0 | nroff -c -mandoc -Tlatin1 | less");	
  exit 0;
}
if (exists $args{h}){
  &printHelp;
  exit 0;
}


$debug = $args{debug} if exists $args{debug};

&loadConfFile($args{config});

my $pidFile = "$PIDDir/smtptraffic.pid";
if (-e $pidFile) {
	die &ltext('script_running','#1005',$0);
}else{
  open(PID,"> $pidFile");
  print PID "$$\n";
  close (PID);		
}

$log = $args{file} if exists ($args{file});
die "Can not read log-file: $log - $?\n" unless (-r $log);

my $dbh = DBI->connect($db_address, $dbUser, $dbPw)
  or die( &ltext('db_connect', '#2001', "$DBI::errstr") );

&getDomains;

if (exists($args{skip})){
  $GrepAusgabe = $args{skip};
} else {
  $GrepAusgabe =exists($args{all})?0:&GrepLastLine($log);
}


my (%Batches,%Recs);

my (%FromTraffic,%ToTraffic); # for the storing of traffic

my $qmaildUid = (getpwnam('qmaild'))[2]; ## get uid for qmaild

($lastLine,$firstDayIndex) = &ParseLogFile ($log,$GrepAusgabe);

&cleanTraffic($firstDayIndex);

if (&StoreTraffic(\%FromTraffic,'sent') && &StoreTraffic(\%ToTraffic,'received')){
  &WriteLastLine ($lastLine);
}

$dbh->disconnect;

if (-e $pidFile){
  unlink($pidFile) or print "Can'not unlink pid-file: $pidFile - $?\n";
}

#########################################################################
#
# main sub
#
#########################################################################

sub ParseLogFile {
  my($maillog,$skipNumber)=@_;
  my  ($gid,$logLine,$j,$src,$lastLine);

  open(LOG, "< $maillog") || die "Error: open file $maillog: $?\n";
  if ( $skipNumber  ) {
#
# skip the first lines
#
    for ($logLine=0; $logLine < $skipNumber; $logLine++) {
      $src = <LOG>;
    }
  }


  my ($batch,$ltime);

  my $line = MailLogParser::Line->new();
  my ($firstDayIndex,$type,$batchLtime);
  my $curRec; ## the current record for qmail-parsing
  my $goClean = 1;
  while (<LOG>){

    chomp;

    $src=$_;
    $logLine++;
	
    my $tail=$line->parseline($src);
    $gid = $line->gid;
    $ltime = $line->ltime;

    $firstDayIndex=getDayIndex($ltime) unless $firstDayIndex;

    $type = $line->type;
    if ($type =~ /sendmail/){
      $lastLine=&parseSendmail($line,$logLine);
    }
    elsif( $type =~ /postfix/){
      $lastLine=&parsePostfix($line,$logLine);
    }
    elsif( $type =~ /qmail/){
      ($lastLine,$curRec,$goClean)=&parseQmail($line,$logLine,$curRec);
    }

    print "keys ($logLine) :".join(':',keys %Batches).":\n" if $debug>2;

#
# close batches
#
    if ($goClean){
      $ltime-=$timeout;
      $j=0;
      foreach  $gid  (keys %Batches){
         $batch = $Batches{$gid};
         $batchLtime=$batch->ltime;
          if ( $batch->complet || ( $batchLtime < $ltime)){
	    $j++;
	  print '-' x 30 ."\ncomplete:\n" if $debug>0;
	  print $batch->totext  if $debug>0;
	
	  &saveBatch($batch);
		
	  delete ($Batches{$gid});
	}
      }
    }
  }


  print "keys: ".join(':',keys %Batches)."\n" if $debug>2;
  $ltime=time -$timeout;
  foreach  $gid  (keys %Batches){
    $batch = $Batches{$gid};
    $batchLtime=$batch->ltime;
    if ( $batchLtime && $batchLtime < $ltime){
      if($debug>0){
	print '-'x45 ."\nrest:\n";
	print $batch->totext;
      }
      &saveBatch($batch);

      delete ($Batches{$gid});
	
    }
  }

  my @sortKeys = sort { $Batches{$a}->linenumber <=> $Batches{$b}->linenumber } keys %Batches;
  if (@sortKeys){
	$batch=$Batches{$sortKeys[0]};
	$lastLine=$batch->firstline;
  }
  return ($lastLine,$firstDayIndex);
}


####################################################################################
#
#    subroutines
#
####################################################################################
sub parseSendmail{

  my ($line,$logLine) = @_;
  my ($batch,$mailer,$status,$proto,$from,$rec,$to);
  my ($fromLocal,$toLocal,$lastLine);

  my $ltime = $line->ltime;
  my $gid = $line->gid;
  my $ptrPref = $line->parseprefix();

  if (defined $ptrPref && @$ptrPref>1){
    my $tag = $ptrPref->[1];
    if ( exists $Batches{$gid}){
#
# change gid
#
      my $newgid = @$ptrPref[0];
      $batch = $Batches{$gid};
      $batch->tag($tag);
      $Batches{$newgid}=$batch;
      delete($Batches{$gid});
    }
  } ## /clone: etc
  else {
    my $suffix=$line->parsesuffix;
    $line->parsetail;
	
    $mailer = $line->attr('mailer');
    $size = $line->attr('size');
    $status = $line->attr('stat');
    $proto = $line->attr('proto');

    if ($from=$line->attr('from')){
#
#	start new batch
#			
      print "new batch ($logLine)\n" if $debug>2;
      $lastLine=join('.*',($line->smon,$line->mday,$line->stime,$line->gid,'from='));
      $batch = MailLogParser::Batch->new('gid' => $gid,'type' => $line->type, 'ltime' => $ltime,
			'firstline' => $lastLine, 'linenumber' => $logLine);

      print "addfrom ($logLine): \n" if $debug>2;
		
#	  if ((!$mailer || $mailer ne 'prog') && $from=~/<(.+?)>/){
#	    $from=$1;
#	  }

      $fromLocal = ($proto && $proto =~ /^smtp/i )?0:1;
		
      $rec=$batch->addfrom('from' => $from, 'size' => $size, 'fromLocal' => $fromLocal,
			  'mailer' => $mailer);
      $Batches{$gid}=$batch;
		
      print $rec->totext if $debug>2;
		
    }  ## /from
    else {
      if (exists $Batches{$gid} && ($to=$line->attr('to'))){

#	    if ( (!$mailer || $mailer ne 'prog') && $to=~/<(.+?)>/){
#		 $to=$1;
#	    }

	print "addto ($logLine): \n" if $debug>2;
	$batch = $Batches{$gid};
			
	$lastLine=join('.*',($line->smon,$line->mday,$line->stime,$line->gid,'to='));
	$batch->lastline($lastLine);
	
	$toLocal= ($mailer && $mailer =~ /esmtp/)?0:1;

	$rec=$batch->addto('to' => $to, 'size' => $size, 'toLocal' => $toLocal,
			  'status' => $status, 'mailer' => $mailer );


			
	print $rec->totext if $debug>2;
		
      }
    }
  }
  $batch->ltime($line-ltime) if $batch;
  return $lastLine;
}

sub parsePostfix{

  my ($line,$logLine) = @_;
  my ($batch,$mailer,$status,$from,$lastLine,$rec,$to);
  my ($fromLocal,$toLocal);

  my $gid = $line->gid;
  my $ltime = $line->ltime;

  if ($gid && $gid =~ /\d+/){ 
#
# real gid
#
    my $suffix=$line->parsesuffix;
    $line->parsetail;
	
    if ( $majordomo_wrapper && $suffix =~ /\|.*$majordomo_wrapper/){
      $mailer ='prog';
    }
    elsif ($relay = $line->attr('relay')){
      $mailer = ($relay =~ /^local$/)?'local':'relay';
    }else{
      $mailer = undef;
    }
    $size = $line->attr('size');
    $status = $line->attr('status');
    $client = $line->attr('client');

    if (exists ($Batches{$gid})){
      $batch=$Batches{$gid};
      $batch->client($client) if ($client);
    }else{
      $lastLine=join('.*',($line->smon,$line->mday,$line->stime,$line->gid));
#
#	start new batch
#			

      $batch = MailLogParser::Batch->new('gid' => $gid,'type' => $line->type, 'ltime' => $ltime,
			'firstline' => $lastLine, 'linenumber' => $logLine, 'client' => $client);

      print "add batch from line # $logLine \n" if $debug>2;

      $Batches{$gid}=$batch;

    }

    if ($from=$line->attr('from')){
      if ($suffix && $mailer && $mailer =~ /prog/) {
	$from = $suffix;
      }
      print "from-field in line # $logLine ($gid)\n" if $debug>2;
      $lastLine=join('.*',($line->smon,$line->mday,$line->stime,$line->gid,'from='));
		
      $fromLocal=($batch->client)?0:1;

      $rec=$batch->addfrom('from' => $from, 'size' => $size, 'mailer' => $mailer,
				       'fromLocal' => $fromLocal );

      print $rec->totext if $debug>2;
		
    }  ## /from
    else {
      if ($to=$line->attr('to')){
	if ($suffix && $mailer && $mailer =~ /prog/) {
	  $to = $suffix;
	}

	print "to-field in line # $logLine ($gid): \n" if $debug>2;
	$batch = $Batches{$gid};
			
	$lastLine=join('.*',($line->smon,$line->mday,$line->stime,$line->gid,'to='));
	$batch->lastline($lastLine);
	
	$toLocal=($relay && $relay=~/\[[\d|\.]+\]/)?0:1;

	$rec=$batch->addto('to' => $to, 'size' => $size, 'mailer' => $mailer, 
			  'status' => $status, 'toLocal' => $toLocal );
			
	print $rec->totext if $debug>2;
		
      }
    }
    $batch->ltime($line-ltime) if $batch;

  }
  return $lastLine;
}

sub parseQmail{

  my ($line,$logLine,$curRec) = @_;
  my ($mailer,$status,$from,$lastLine,$rec,$to);
  my ($fromLocal,$toLocal,$uid,$tail,$status);
  my ($uid,$batch,$tail,$complet);

  my $goClean=1;
  my $gid = $line->gid;
  my $ltime = $line->ltime;
  my $uid=$line->uid;
#  $uid =~ s/\./\\\./g;

  $lastLine=join('.*',($line->smon,$line->mday,$line->stime,$uid));
  $tail=$line->tail;
  $complet=($tail=~/^end/)?1:0;
  if ($gid && $gid=~/\d+/){
    if (exists $Batches{$gid}){
      $batch=$Batches{$gid};
    }

    unless ($batch){
      if ( $tail !~ /^(end|bounce)/ ) {
#
#	start new batch
#			

        $batch = MailLogParser::Batch->new('gid' => $gid,'type' => $line->type, 'ltime' => $line->ltime,
		'firstline' => $lastLine, 'linenumber' => $logLine);

	$Batches{$gid}=$batch;
      }
    }
  }

  my $prefix = $line->extrprefix(':');
  if ($prefix){
    if ($prefix =~ /info/){
      $line->parsetail(' ',' ');
      $size = $line->attr('bytes');
      $from = $line->attr('from');
      $uid = $line->attr('uid') || -1;
      $fromLocal = ($uid == $qmaildUid)?0:1;
      $mailer = 'local';
      $curRec=$batch->addfrom('from' => $from, 'size' => $size, 'fromLocal' => $fromLocal,
			      'mailer' => $mailer, 'gid' => $gid);
    }
    elsif($prefix =~ /starting\s+delivery\s+(\d+)/) {
      $uid = $1;
      if( $line->tail=~ /to\s+(\w+)\s+(\S+)/){
	$mailer=$1;
	$to=$2;
	$toLocal=($mailer=~/remote/)?0:1;
	if ($curRec &&  $curRec->gid == $gid && !$curRec->uid){
	  $curRec->to($to);
	  $curRec->toLocal($toLocal);
	  $curRec->uid($uid);
	}else {
	  if ($batch){
	    $curRec=$batch->addto('to'=> $to, 'uid' => $uid, 'gid' => $gid, 'toLocal' => $toLocal);
	  }elsif ($debug){
	    print "Line # $logLine: don't have a batch\n";
	  }
	}
	$Recs{$uid}=$curRec;
	print 'recs: '.join(':',(keys %Recs))."\n" if $debug>2;

      }
    }
    elsif($prefix =~ /status/ ){
      $tail =$line->tail;
      $goClean=0;
      while($tail=~/\w+\s+(\d+)\/(\d+)\s*(.*)/){
	$goClean+=$1;
	$tail=$3;
      }
    }
    elsif($prefix =~ /delivery\s+(\d+)/){
      $uid = $1;
      unless ($curRec && $curRec->uid && $curRec->uid == $uid){
	if (exists($Recs{$uid})){
	  $curRec = $Recs{$uid};
	}else{
	  $curRec = undef;
	}
      }
      if ($curRec){
	$prefix = $line->extrprefix(':');
	$status=( $prefix && $prefix=~/success/)?'sent':$prefix;
	$curRec->status($status);
	$curRec=undef;
	delete $Recs{$uid};
	print 'recs: '.join(':',(keys %Recs))."\n" if $debug>2;
      }else{
	print "Error: delivery # $uid without rec\n" if $debug;
      }
    }
  }
  if ($batch){
    $batch->lastline($lastLine);
    $batch->complet($complet);
    $batch->ltime($line->ltime);
  }
  $goClean = ($goClean)?0:1;

  return ($lastLine,$curRec,$goClean);
}

sub cleanTraffic {
  my $firstDayIndex = shift;
  if ($firstDayIndex>0){
    my $sql="update traffic set sent=0,received=0 where year*10000+month*100+day>$firstDayIndex";
    $dbh->do( $sql );
  }
}

sub StoreTraffic {
  my ($ptrTraffic,$field) = @_;
  my ($sth,$year,$month,$mday,$domainId,$user,$reseller,$mailListTag,$sql,$exists,$where);
  my ($traffic,$mailer,$local);



  foreach my $dayIndex (keys %$ptrTraffic){
#
# process day
#	

    ($year,$month,$mday) = unpack('A4A2A2',$dayIndex);


    foreach $domainId (keys %{$ptrTraffic->{$dayIndex}}){
#
# process domain
#	

      $user = $Kunden{$domainId};
	  unless ($user){
		print "Unknown domain id: $domainId\n";
		next;
	  }
      $reseller = $Anbieter{$user};
	  unless ($reseller){
		print "Unknown user name: $user\n";
		next;
	  }
	  
	
      foreach $local  (keys %{$ptrTraffic->{$dayIndex}->{$domainId}}) {
#
# process local-tag
#	
	$traffic =  $ptrTraffic->{$dayIndex}->{$domainId}->{$local};
	($local,$mailListId)=split(/:/,$local);
		
#
# save to SQL-base
#		
	$where="WHERE kunde='$user' and maillist_id=$mailListId and local=$local".
		  " AND day=$mday AND month=$month AND year=$year";
	$sql="SELECT id FROM traffic $where";
	$sth = $dbh->prepare($sql);
	$sth->execute;
	$exists = $sth->rows;
	$sth->finish;
	if ($exists) {
	  $sql="UPDATE traffic SET $field=$field+$traffic, anbieter='$reseller' $where";
	}  else {
	  $sql="INSERT INTO traffic (kunde,anbieter,day,month,year,maillist_id,local,$field)".
	      "  VALUES ('$user','$reseller',$mday,$month,$year,$mailListId,$local,$traffic)";
	}
	
	$dbh->do($sql);
      }	
    }
  }
  return 1;
}

sub saveBatch {
  my $batch= shift;
  my ($from,$to,$rec,$fromDom,$toDom,$mailer,$size,$toDomId,$fromDomId);
  my ($toListId,$fromListId,$toBox,$fromBox,$dayNumber,$fromLocal,$toLocal);
  my ($localInd,$status,$type);
  if (defined $batch){
    my $records = $batch->records;
    my $dayIndex = &getDayIndex($batch->ltime);
	
    foreach $rec (@$records){
      $mailer = $rec->mailer;
      $status = $rec->status;
      $type = $batch->type;
      if ($rec->from) {
#
#  process from		
#
	$from = $rec->from;
	$fromLocal=$rec->fromLocal;
	($fromBox,$fromDom) = &parseDomain($from);
	if ($type=~/qmail/){
	  ($fromBox,$fromDom)=&checkQmailBox($fromBox,$fromDom);
	}
	if ($fromDom){
	  $fromDomId = $Domains{$fromDom}||0;
	  $fromListId = ($fromDomId)?&checkList($fromBox,$fromDomId):0;
	}
	if ($fromLocal && !$fromDomId){
	  ($fromListId,$fromDomId)=&checkVList($fromBox);
	
	  unless ($fromDomId){
	    $fromDomId=&checkBox($fromBox);
	  }
	}
      } else {
	unless ($from) {
	  $fromLocal =1;
	  $fromDomId = 0;
	  $fromListId =0;
	}
      }

      $size = $rec->size if $rec->size;

      if ($status && $status =~ /sent/i ){
	
	unless ($size){
	  print "The record has zero size:\n" if $debug>0;
	  print $rec->totext if $debug>0;
	  next;
	}

#
# process to
#		
	if ($rec->to){
	  $to = $rec->to;
	  $toLocal = $rec->toLocal;
	  if ($mailer && $mailer =~ /^prog$/){
	    ($toListId,$toDomId)=checkProg($to);
	  } else {
	    ($toBox,$toDom) = &parseDomain($to);
	    if ($type=~/qmail/){
	      ($toBox,$toDom) = &checkQmailBox($toBox,$toDom);
	    }
	    if ($toDom){
	      $toDomId = $Domains{$toDom}||0;
	      $toListId = ($toDomId)?&checkList($toBox,$toDomId):0;
	    }
	    if($toLocal && !$toDomId){
	      ($toListId,$toDomId)=&checkVList($toBox);

	      unless ($toDomId){
		$toDomId=&checkBox($toBox);
	      }
	    }
	  }
	} else {
	  unless ($to) {
	    $toLocal = 1;
	    $toDomId = 0;
	    $toListId = 0;
	  }
	}

	
	if ($fromDomId){
#
# store the recived traffic
#
	  $localInd ="$toLocal:$fromListId";
	  if (exists $FromTraffic{$dayIndex}{$fromDomId}{$localInd}) {
	    $FromTraffic{$dayIndex}{$fromDomId}{$localInd}+=$size;
	  } else {
	    $FromTraffic{$dayIndex}{$fromDomId}{$localInd}=$size;
	  }	
	  print '-' x 40 if $debug>1;
	  print "\nFrom\t\{$dayIndex\}\{$fromDomId\}\{$localInd\} + $size\n" if $debug>1;
	}

	if ($toDomId){
#
# store the sent traffic
#
	  $localInd ="$fromLocal:$toListId";
	  if (exists $ToTraffic{$dayIndex}{$toDomId}{$localInd}) {
	    $ToTraffic{$dayIndex}{$toDomId}{$localInd}+=$size;
	  } else {
	    $ToTraffic{$dayIndex}{$toDomId}{$localInd}=$size;
	  }	
	  print "\nTo\t\{$dayIndex\}\{$toDomId\}\{$localInd\} + $size\n" if $debug>1;
	  print '-' x 40 ."\n\n"if $debug>1;
	}
      }	
    }
  }
}

sub checkQmailBox {
  my ($box,$domain)=@_;
  my ($newBox,$newDomain);
  if ($box =~ /^(\S+?)-(.*)/){
    my $redir=$1;
    $newBox=$2;
    if ($newBox =~ /(.*)-(\S+?)$/){
      $newBox = $2;
      $newDomain = $1;
      if ($newDomain=~/:/){
	($domain = $newDomain) =~ s/:/\./g;
	$box =$newBox;
      }
    }
  }
  return ($box,$domain);
}

sub checkBox {
  my $box = shift;
  my $domainId;
  if ($box){
    $domainId = exists($Pops{$box})?$Pops{$box}:0;
  }else {
    $domainId = 0;
  }
  return $domainId;
}

sub checkProg {
  my $to = shift;
  my ($listId,$domainId,$mlist_name,$mlist_virt,$domainName);
 
  return (0,undef) unless ($majordomo_wrapper && $majordomo_ldir);
  
  if ($to =~ /$majordomo_wrapper\s*(.*)$/){
    my $cmd =$1;
    $cmd =~ /^(\S+)\s+(.*)$/;
    $cmd = $1 || '';
    my $args=$2 || '';
    if ($cmd =~ /archive/){
      $mlist_name='';
      if ($args =~ /-f\s+(\S+)/){
	my $archDir = $1;
	if ($archDir =~ /$majordomo_ldir\/(\d+)\/lists\/(\w+)\./){
	  $domainId=$1 ;
	  $mlist_name = $2 ;
	}
      }
      $mlist_virt=$mlist_name?"$mlist_name-$domainId":'-0';

    }
    elsif ($cmd =~ /request/){

      $mlist_name='';
      if ($args =~ /[-\w\s+\S*]*(\w+)/){
	$mlist_virt = $1;
	if ($mlist_virt =~ /(\w+)-(\d+)$/){
	  $mlist_name = $1;
	  $domainId = $2;
	}else{
	  $domainId = 0;
	}
      }
      $mlist_virt=($mlist_name)?"$mlist_name-$domainId":'-0' unless $mlist_virt;

    }
    elsif ($cmd =~ /majordomo/){
      if ($args =~ /-C\s+$majordomo_ldir\/(\d+)\//){
	$domainId = $1;
	$mlist_virt = "-$domainId";
      }
    } else {
#
#  resend
#
      if ($args =~ /-l\s+(\w+)/){
	$mlist_name = $1;
	if ($args =~ /-h\s+(\S+)/){
	  $domainName = $1;
	  $domainId = $Domains{$domainName} || 0;
	} else {
	  $domainId = 0;
	}
      }else{
	$mlist_name = '';
	$domainId = 0;
      }
      $mlist_virt="$mlist_name-$domainId";
    }
    
    $listId=(exists $MailLists{$mlist_virt})?$MailLists{$mlist_virt}->[1]:0;

  } else {
    $listId=0;
  }
  return ($listId,$domainId);
}

sub getDayIndex {
  my $ltime = shift;
  my($mday,$mon,$year)=(localtime($ltime))[3,4,5];
  $mon+=1;
  $year+=1900;
  
#  my $ret =  pack('A4A2A2',$year,$mon,$mday);
  my $ret = sprintf('%#4d%#2d%#2d',$year,$mon,$mday);
  $ret =~ s/\s/0/g;
  return $ret; 
}

sub parseDomain {
  my $email= shift;
  if ($email =~ /<(.+?)>/){
	$email = $1;
  }
  my ($box,$domain)=split(/\@/,$email);
  
  return ($box,$domain);
}

sub checkList {
  my ($box,$domainId) = @_;
  return 0 unless ($domainId);

  my ($listId);
  $box =~ s/^owner-//;
  $box =~ s/-(approval|outgoing|request|archive)$//;
  $box = "$box-$domainId";
  if  (exists $MailLists{$box}){
    $listId=$MailLists{$box}->[1];
  }else {
    $listId=0;
  }
  return $listId;
}

sub checkVList {
  my $box= shift;
  return 0 unless ($box);
  my ($listId,$domainId);
  $box =~ s/^owner-//;
  $box =~ s/-(approval|outgoing|request|archive|outgoing-real)$//;

  if  (exists $MailLists{$box}){
    $listId=$MailLists{$box}->[1];

    if ($listId && $box=~/-(\d+)$/){
      $domainId=$1;
    }

  } else {
    $listId=0;
  }

  return ($listId,$domainId);
}

sub getDomains {
  my (@row, $sth,$mlist_virt);
  $sth = $dbh->prepare("SELECT id,domain,kunde,anbieter,richtigedomain FROM domains WHERE richtigedomain in (0,1,3)");
  $sth->execute;
  
  while (@row = $sth->fetchrow_array){
    $Domains{$row[1]}=$row[0]; # domain => domain_id
    $Kunden{$row[0]} = $row[2]; # domain_id => user
    if ( $row[4]==3 ){
      $Pops{$row[1]}=$row[0]; # pop => domain_id
    }else{
      $Anbieter{$row[2]} = $row[3]; # user => reseller
    }
  }
  $sth->finish;
  
  $sth = $dbh->prepare("SELECT name,domain_id,id from maillist");
  $sth->execute;
  while (@row = $sth->fetchrow_array){
    $mlist_virt=$row[0]."-".$row[1];
    push @{$MailLists{$mlist_virt}},$Domains{$row[1]}; # mlist_virt => domain
    push @{$MailLists{$mlist_virt}},$row[2]; # mlist_virt => mlist_id

  }
  $sth->finish;

  $sth = $dbh->prepare("select pop3, domain from email where pop3 not like '%@%'");
  $sth->execute;
  while (@row = $sth->fetchrow_array){
    $Pops{$row[0]}=$Domains{$row[1]}; # pop => domain_id
  }
  $sth->finish;
}


sub WriteLastLine {
  my ($writeline) = @_;
  $dbh->do("UPDATE grep SET pattern='$writeline' WHERE type='smtp'");
}

sub GrepLastLine {
 
 my $logFile=shift;

  my $sth = $dbh->prepare("SELECT pattern FROM grep WHERE type='smtp'");
  $sth->execute;
  my $rows = $sth->rows;
  my $pattern = '###NEW###';
  if($rows){
    $pattern = $sth->fetchrow;
    chop($pattern);
  }
  else{
    $dbh->do("INSERT INTO grep (pattern,type) VALUES ('###NEW###','smtp')");
  }
  $sth->finish;
  $pattern =~ s/\[/\\\[/g;
  $pattern =~ s/\]/\\\]/g;
  my $grepAusgabe = `$bin_grep -na '$pattern' $logFile`;
  if($grepAusgabe =~ /^(\d+):/){
    $grepAusgabe = $1 - 1;
  }
  else{
    $grepAusgabe = 0;
  }
  return $grepAusgabe;
}


sub loadConfFile{
  my $file = shift || '/usr/local/confixx/confixx_main.conf';
  my  $base;

  unless (-T $file){
    $0 = $^X unless ($^X =~ m%(^|[/\\])(perl)|(perl.exe)$%i);
    ($base) = $0 =~ m%^(.*)[/\\]%;
    $base ||= ".";
    $file = "$base/confixx_main.conf";
    unless(-T $file){
      die("Couldn't find confixx_main.conf");
    }
  }

  do $file;

}


sub ltext {
  my $text_name = shift;
  if (!%lang_text) {
    my $langFile = "$installDir/languages/$language/scripts.local";
    do $langFile;
  }
  if (!defined($lang_text{$text_name})) {
    return "Sorry, text $text_name not found!";
  }
  else {
    my @VAR = @_;
    my $text = $lang_text{$text_name};
    $text =~ s/\$VAR\[(\d+)\]/$VAR[$1]/g;
    if ($text) {
      return $text;
    }
    else {
      return "Sorry, localizing text $text_name failed!";
    }
  }
}
