#!/usr/bin/perl
#
# Netmail loop detector for HPT. (c) Stas Mishchenkov 2:460/58
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Insert into config:
# hptperlfile /home/fido/lib/filter.pl
# and place to filter.pl some like this:
# use loop;
# sub filter{
#    if ( isloop($fromname, $fromaddr, $toname $toaddr, $subject, $text) == 1 ) {
#	$newnet = 1;
#	$kill=1;
#	return;
#    }
# }
#
# sub isloop by default returns 0 and if loop detected it returns 1.
#

sub isloop($$$$$$)
{
  local ( $from_name, $from_addr, $to_name, $to_addr, $subj, $mtext ) = @_;
  local ($c, @cnt, $looplink, $msgtext) = ();

#    $c = @cnt = ($mtext =~ /\x01Via @{$config{addr}}[0] \@/sg);
#    if ( $c ge 3 ) {
    if ($mtext =~ /\x01Via @{$config{addr}}[0] \@[^\r]+\r\x01Via [^\r]*(\d+\:\d+\/\d+)[^\r]*\r\x01Via @{$config{addr}}[0] \@/) {
	$looplink = $1;
	w_log(8, "Loop detected $fro_mname $from_addr, $toname $to_addr, $subj, $date");
#	$mtext =~ /\x01Via @{$config{addr}}[0] \@[^\r]+\r\x01Via [^\r]*(\d+\:\d+\/\d+)[^\r]*\r\x01Via @{$config{addr}}[0] \@/;
	$mtext =~ s/\x01/\@/sg;
	$mtext =~ s/\r--- /\r-+- /sg;
	$mtext =~ s/\r \* Origin:/\r + Origin:/gm;
	$msgtext = "\r=========================================================================".
		"\r From: ".sprintf("%-32s", $from_name).sprintf("%-20s",$from_addr).$date.
		"\r To  : ".sprintf("%-32s", $to_name). $to_addr.
		"\r Subj: $subj".
		"\r=========================================================================".
		"\r$mtext".
		"\r=========================================================================\r\r".
		"--- perl on $hpt_version\r".
		" * Origin: $config{origin} \(@{$config{addr}}[0]\)";
#	for my $d_addrr (@my_aka){
#	    putMsgInArea("NetMail", "Evil Robot", "$config{sysop}",
#		"@{$config{addr}}[0]", "$d_addrr", "Loop detected!", "",
#		$attr, "$msgtext", 1);
#	    w_log("\"$d_addrr\" warned.");
#	}
	putMsgInArea("NetMail", "Evil Robot", "$config{sysop}",
		"@{$config{addr}}[0]", "@{$config{addr}}[0]", "Loop detected!",
		"", $attr, "$msgtext", 1);
	w_log("\"SysOp\" warned.");
	
	putMsgInArea("NETMAIL", "Evil Robot", $from_name, "@{$config{addr}}[0]",
	    "$from_addr", "Loop detected!", "", $attr, "$msgtext", 1);
	w_log("\"$from_addr warned.\"");

	putMsgInArea("NETMAIL", "Evil Robot", "$links{$looplink}{name}",
	    "@{$config{addr}}[0]",
	    "$looplink", "Loop detected!", "", $attr,"$msgtext", 1);
	w_log("\"$looplink warned.\"");
	return 1;
    }
return 0;
}

1;