#########################################################################
# Advanced EchoMail Dupe Checker for hpt tosser				#
# ---------------------------------------------				#
#									#
# Copyright (c)      2004 Pavel  Gulchouck 2:463/68 <gul@gul.kiev.ua>	#
# Copyright (c) 2004-2006 Sergey Babitch   2:463/94 <vinny@babitch.com>	#
#									#
# $Id: DupeCheck.pm,v 1.9 2007/06/17 12:19:12 fido Exp $		#
#########################################################################
package DupeCheck;

$dupebase			= '/home/fido/var/dupebase/DupeBase';

$echo_loop_area 		= 'ECHOLOOPS';
$mail_loop_area 		= 'MAILLOOPS';
$pkt_dupes_area 		= 'ECHODUPES';

$dupebase_purge_period		= 1*24*60*60;
$dupebase_remember_period	= 7*24*60*60;

#========================================================================
#
# INSTALL
# -------
#
# 1) Create local areas ECHOLOOPS and ECHODUPES (may be same),
#    and netmail MAILLOOPS area for NetMail loops:
#
#    LocalArea     ECHODUPES .../msgbase/ECHODUPES
#    LocalArea     ECHOLOOPS .../msgbase/ECHODUPES
#    NetmailArea   MAILLOOPS .../msgbase/MAILLOOPS
#
# 2) Add calls functions &DupeCheck::filter and &DupeCheck::hpt_exit
#    to the hpt perl hooks file filter.pl:
#
#    use DupeCheck;
#    ...
#    sub filter {                         sub filter {
#      ...                           or     ...
#      my $rc = DupeCheck::filter;          return DupeCheck::filter;
#      return $rc if $rc;                 }
#      ...
#    }
#    ...
#    sub hpt_exit {
#      ...
#      DupeCheck::hpt_exit;
#      ...
#    }
#
# 3) Enjoy! ;)
#
#========================================================================

$VERSION	= sprintf '%d.%03d', q$Revision: 1.9 $ =~ /(\d+)/g;

*area		= \$main::area		;
*attr		= \$main::attr		;
*config 	= \%main::config	;
*date		= \$main::date		;
*fromaddr	= \$main::fromaddr	;
*fromname	= \$main::fromname	;
*kill		= \$main::kill		;
*pktfrom	= \$main::pktfrom	;
*putMsgInArea	= \&main::putMsgInArea	;
*subject	= \$main::subject	;
*text		= \$main::text		;
*toaddr 	= \$main::toaddr	;
*toname 	= \$main::toname	;
*w_log		= \&main::w_log		;

sub TRS {main::TRS};

use DB_File;

$re_my_addr	= join ('|', @{$config {'addr'}});
$re_my_addr_via	= qr/^\x01Via $re_my_addr(\@|\s)/;

#$bad_message	= '/home/fido/var/dupebase/DupeCheckBadMessageBody';

#========================================================================
# Check NetMail loops
#========================================================================
sub check_netmail {
  return '' unless $mail_loop_area;
  my @lines = split /\r/, $text;
  if (grep (/$re_my_addr_via/, split (/\r/, $text)) > 1) {
    putMsgInArea ($mail_loop_area, $fromname,$toname,$fromaddr,$toaddr,
		  $subject, $date, $attr | TRS, $text, 0);
    $kill = 1;
    return "Moved to $mail_loop_area area...";
  }
  return '';
}
#========================================================================
# Process message
#========================================================================
sub filter {
  return &check_netmail unless $area;
  unless ($text =~ /\r\x01MSGID: ([^\r]+)\r/) {
    w_log ('B', "DupeCheck::filter: \"MSGID: \" field not found.");
    save_message ();
    return '';
  }
  $msgid = $1;
  $msgid =~ tr/A-Z/a-z/;
  return '' unless open_dupebase ();
  my $key = sprintf "%s|%s", $area, $msgid;
  my ($path) = $text =~ /((\r\x01PATH: [^\r]+)*)\r$/;
  $path = '' unless $path;
  $path =~ s/\r\x01PATH://g;
  my $curtime = time();
  if (exists $msg {$key}) {
    seek  DUPEBASE, $msg {$key}, 0;
    $_ = <DUPEBASE>;
    seek  DUPEBASE, 0, 2;
    s/^[^\t]+\t(.*)\s*$/$1/;
    my ($oldtime, $oldpath, $oldpktfrom) = split /\|/;
    $otime = localtime $oldtime;
    $ctime = localtime $curtime;
    my ($folder, $dupetext);
    if ($pktfrom eq $oldpktfrom && $path eq $oldpath) {
      $folder	= $pkt_dupes_area;
      $dupetext	= "Pkt from             : $pktfrom\r"	.
		  "Msg arrived          : $ctime\r"	.
		  "Original msg arrived : $otime\r"	.
		  "\@$text"				;
    } else {
      $folder	= $echo_loop_area;
      $dupetext	= "Pkt from             : $pktfrom\r"	.
		  "Original pkt from    : $oldpktfrom\r".
		  "PATH                 :$path\r"	.
		  "Original PATH        :$oldpath\r"	.
		  "Msg arrived          : $ctime\r"	.
		  "Original msg arrived : $otime\r"	.
		  "\@$text"				;
    }
    putMsgInArea ($folder , $fromname, $toname        , $fromaddr, "",
                  $subject, $date    , "pvt sent read", $dupetext, 0);
    $kill = 1;
    return 'Dupe';
  }
  $msg {$key} = tell (DUPEBASE);
  print DUPEBASE "$key\t$curtime|$path|$pktfrom\n";
  return '';
}
#========================================================================
# End advanced dupecheck process
#========================================================================
sub hpt_exit {
  purge_dupebase ();
  close_dupebase ();
}
#========================================================================
# Open dupebase
#========================================================================
sub open_dupebase {
  return 1 if tied %msg;
  return 0 if $dupebase_error;
  unless (	open (DUPEBASE, "+<$dupebase.txt")	||
		open (DUPEBASE, "+>$dupebase.txt")	){
    w_log ('B',	"DupeCheck::open_dupebase: "	.
		"Can't open file \"$dupebase.txt\" for append: $!.");
    $dupebase_error = 1;
    return 0;
  }
  seek DUPEBASE, 0, 2;
  unless (tie %msg, 'DB_File', "$dupebase.index", O_RDWR|O_CREAT, 0644) {
    w_log ('B', "DupeCheck::open_dupebase: "	.
		"Can't open dupebase \"$dupebase.index\": $!.");
    close DUPEBASE;
    $dupebase_error = 1;
    return 0;
  }
  $msg {'Purge Last Time'} = time unless exists $msg {'Purge Last Time'};
  return 1;
}
#========================================================================
# Close dupebase
#========================================================================
sub close_dupebase {
  return unless tied %msg;
  untie %msg;
  close DUPEBASE;
}
#========================================================================
# Purge dupebase
#========================================================================
sub purge_dupebase {
  return unless tied %msg;
  return unless (time-$msg{'Purge Last Time'}) > $dupebase_purge_period;
  close_dupebase ();
  unlink "$dupebase.old";
  unless (rename "$dupebase.txt", "$dupebase.old") {
    w_log ('B', "DupeCheck::purge_dupebase: "				.
		"Can't rename file \"$dupebase.txt\" "			.
			       "to \"$dupebase.old\": $!.")		;
    return;
  }
  unless (unlink "$dupebase.index") {
    w_log ('B', "DupeCheck::purge_dupebase: "				.
		"Can't unlink file \"$dupebase.index\": $!.")		;
    rename "$dupebase.old", "$dupebase.txt";
    return;
  }
  local *F;
  unless (open F, "<$dupebase.old") {
    w_log ('B', "DupeCheck::purge_dupebase: "				.
		"Can't open file \"$dupebase.old\" for read: $!.")	;
    return;
  }
  unless (open_dupebase ()) {
    w_log ('B', "DupeCheck::purge_dupebase: "				.
		"Can't open dupebase for purging.")			;
    close F;
    return;
  }
  w_log (1, "Start purging dupebase...");
  my $processed	= 0;
  my $retained	= 0;
  while (<F>) {
    unless (/^(.*)\t(.*)\s*$/) {
      w_log ('B', "  Invalid line: \"$_\"");
      next;
    }
    $processed++;
    my $key	= $1;
    my $value	= $2;
    my ($time)	= $value =~ /^(\d+)|/;
    next if (time - $time) > $dupebase_remember_period;
    $retained++;
    $msg {$key} = tell (DUPEBASE);
    print DUPEBASE "$key\t$value\n";
  }
  close F;
  w_log (4, "  Records processed : $processed");
  w_log (4, "  Records retained  : $retained");
  w_log (4, "  Records dropped   : " . ($processed - $retained));
  w_log (1, "End purging dupebase...");
}
#========================================================================
# Save message body if need
#========================================================================
sub save_message {
  return unless $bad_message;
  local *F;
  unless (open F, ">$bad_message") {
    w_log ('B', "DupeCheck::save_message: "	.
		"Can't open \"$bad_message\" for write: $!.\n");
    return;
  }
  print F $text;
  close F;
  w_log ('B', "Message body stored to \"$bad_message\".");
}
#########################################################################
# End of file DupeCheck.pm						#
#########################################################################
1;
