#!/usr/bin/perl
#
# Cleanfeed
#  Version 0.95.7b  3 September 1998
#
#  Usenet Spam filter
#   for:
#    INN 1.5.1 and later
#    Cyclone 1.3.5 and later
#    Typhoon
#    Breeze
#    NNTPRelay 1.1b4 and later
#
#  by Jeremy Nixon <jeremy@exit109.com>
#    available at http://www.exit109.com/~jeremy/news/cleanfeed.html
#                 ftp://ftp.exit109.com/users/jeremy/
#
#  Please read the documentation or the cleanfeed(8) man page
#
#  Always check this file with "perl -cw" after making changes!
#   There should be no warnings.
#
# $Id: cleanfeed,v 1.22.2.1 1998/09/03 07:49:00 jeremy Exp $


# directory where the cleanfeed.conf and cleanfeed.local files live
# set this to undef to not use the external file

$config_dir = '/usr/local/news/bin/filter';


# Everything below here can be set in cleanfeed.conf

#########################################################

# Set one and only one of the following
$inn = 1;		# set $inn = 1 for INN
$highwind = 0;		# set $highwind = 1 for Cyclone/Typhoon/Breeze
$nntprelay = 0;        	# set $nntprelay =1 for NNTPRelay

sub get_config {
    my ($thing,@cf_file,@l_file,$config_file,$local_file,$cf,$lf,$line,$junk,$flag);
    # Configuration:

  %config = (
   'aggressive' => 1,        	# set to 0 if your lawyers are paranoid
   'maxgroups' => 14,		# maximum number of groups in a crosspost
   'block_binaries' => 1,	# set to 1 to block misplaced binaries
   'block_late_cancels' => 0,	# set to 1 to block cancels of rejected articles

   'do_md5' => 1,		# do the md5 checks?
   'do_phl' => 1,		# do the posting-host/lines EMP check?
   'do_fsl' => 1,		# do the from/subject/lines EMP check?
   'do_scoring_filter' => 1,    # use the scoring filter?	     
   'md5maxmultiposts' => 5,	# start rejecting after this many copies
   'maxmultiposts' => 20,	# max for posting-host and from/subj/lines filters
   'fuzzy_md5' => 0,     	# screw around with the body before md5ing?
   'fuzzy_max_length' => 700,   # don't screw with bodies over this many lines
   'ArticleHistory' => 7000,	# keep history of last N article header sets
   'MD5History' => 11000,	# keep history of last N MD5 checksums
   'EMPmaxlife' => 24,		# time to keep EMP ids with no hits, in hours
   'MD5maxlife' => 24,		# same, for md5 ids
   'EMPHistSize' => 1000,	# max number of EMP ids to ever hold in memory
   'MD5HistSize' => 6000,	# same, for md5 ids
   'EMPstarttrimming' => 500,	# do not waste time trimming until this many entries
   'trimcycles' => 500,		# trim hashes every N cycles through filter
   'MIDmaxlife' => 1,		# time to keep rejected message-ids, in hours
   'md5_skips_followups' => 1,  # avoid MD5 check on articles with References?
   'do_mid_filter' => 0,        # use the message-id CHECK filter? (INN only)
   'do_bot_checks' => 1,        # do the spam-bot signature checks?
   'do_supersedes_filter' => 1,	# do the excessive supersedes filter?
   'check_supersedes_path' => 1,	# apply bad_cancel_paths to supersedes too?
   'drop_useless_controls' => 1,	# drop sendsys, senduuname, version control messages
   'drop_ihave_sendme' => 1,	# drop ihave, sendme control messages
   'drop_control_with_supersedes' => 1,	# drop control messages with supersedes headers

   'low_xpost_maxgroups' => 6,	# max xposts in low_xpost_groups
   'verbose' => 1,		# verbose rejection reasons in news.notice/logfile?
   'max_encoded_lines' => 15,	# number of encoded binary lines to allow
   'block_mime_html' => 1,      # set to 1 to block MIME encapsulated HTML
   				#  (NOT straight or multipart/alternative)
   'block_html' => 0,		# set to 1 to block HTML and multipart/alternative

   'active_file' => undef,	# active file to determine which groups are moderated

   'binaries_in_mod_groups' => 0,	# allow binaries in moderated groups?

	    ### to log the message ID's of all articles processed
	    # doesn't work for INN (uses news.notice instead).
   'logfile' => "",
   'reportfile' => "",
   'log_accepts' => 1,		# include accepted messages in the log?
   'max_log_size' => 10000000,

   'statfile' => undef,		# crude stats on what the filter is doing

   'timer_info' => 1,		# create timing information (arts/second)?
   'timer_interval' => 300,	# how often to generate timer info

   'debug_batch_directory' => undef,	# directory for debugging batches
   'debug_batch_size' => 100000,	# max size of batch files before rotation

	    ### binaries allowed if groups match
   'bin_allowed' => '\.binae?r|^alt\.sex\.pictures|^fur\.artwork'.
       '|^alt\.anonymous\.messages$|^de\.alt\.dateien|^rec\.games\.bolo$'.
       '|^comp\.security\.pgp\.test$|sfnet\.tiedostot', # '

	   ### md5 EMP check not done if groups match
   'md5exclude' => '\.test(?:$|\.)|^es\.pruebas$', # '

           ### reject all articles crossposted to groups matching this
   'poison_groups' => '^alt\.binaires|sexzilla',

	   ### no checks done if groups match '
   'allexclude' => '^clari\.|^biz\.clarinet\.',

	   ### HTML allowed here (if block_html is turned on)
   'html_allowed' => '^microsoft\.',

	   ### groups where we restrict crossposts even more than normal
   'low_xpost_groups' => 'test|jobs|forsale',

	   ### domains starting/ending in "xxx" are never good news
	   ### (checked against .com, .net, and .nu tld's only)
   'baddomainpat' => '[\w\-]+xxx|xxx[\w\-]+',

	   ### exempt these hosts from the NNTP-Posting-Host filter
   'exempt' => 'news\.aol\.com|news\.newsdawg\.com|webtv\.net'.
	'|newscene\.newscene\.com|hme1-1\.news\.sprint\.ca'.
	'|news1\.mcps\.com|postnews\.dejanews\.com|^localhost$', # '

           ### posting hosts exempt from excessive supersedes filter
   'supersedes_exempt' => 'penguin-lust\.mit\.edu|peck\.com'.
        '|valerian\.alma\.fr|digifix\.digifix\.com|^localhost$', # '

	   ### block cancels with these in the path
   'bad_cancel_paths' => 'winternet\.com|news\.ifcss\.org|ftp\.uu\.net'.
        '|netvigator\.com|vsnl\.net\.in|pacific\.net\.sg|relay\.nakhodka\.ru'.
        '|hipcancel|h1pcr1me|news\.pace\.edu|news\.ncd\.co\.jp'.
        '|ubc\.co\.jp|paradise\.co\.jp|news\.softandco\.fr|news4\.netsgo\.com'.
        '|riksbyggen\.se|crl\.aecl\.ca',

           ### refuse articles with these in the message-id (INN only)
   'refuse_messageids' => 'HeadHunter\.NET>|none\d+\.yet>',

	   ### net-abuse groups get some special treatment
   'net_abuse_groups' => '^(?:news|de)\.admin\.net-abuse',

	   ### groups expected to contain bodies and/or subject lines from spam
   'spam_report_groups' => '^(?:news|de)\.admin\.net-abuse'.
        '|fr\.usenet\.abus\.rapports|news\.lists\.filters|alt\.nocem\.misc',

  );

# used to form domain names for filtering
  $config{'badguys'} = 'eroticboxoffice|sweet18|kissingirls|erosnet'.
    '|shockingpink|dominationx|xbo|pussyforyourface|itouchmyself'.
    '|libidox|cherrypoppers|freesex|backdoor|online18'.
    '|(?:\w+\.)?barditt?ch|\w+\.quim|holowww|\w+\.holowww'.
    '|answerme|emi|latexfetish|nymphette|bondage|6t9|nudesights'.
    '|porngodess|phatt|rawxxxfun|porn-?king|dreamlands|youwish|uwish'.
    '|ilovecelebs|dirtysecrets|harddicks|\w+\.mnet1|pictureview|postagent'.
    '|malebytes|southcorp|ucla\.dorms|bmc-engineering|orchidvideos'.
    '|sexplosion|members\.sexzilla|studio\d\d\.sexzilla|netzilla|jalapeno'.
    '|forbiddenphotos|spck|simplecom|mallpage|yes-pheromones|4jon'.
    '|headhunter|conline|adultserv|theadultstore|femaleseduction|thescent';

    # Load up the external config file
    if (defined $config_dir) {
	$config_file = "$config_dir/cleanfeed.conf";
	undef %config_local;
	undef %config_append;
	if (-r $config_file) {
	    if (open (CF, "<$config_file")) {
		@cf_file = <CF>;
		close CF;
		$cf = join "", @cf_file;
		eval $cf;
		&local_config if (defined &local_config);
		undef @cf_file;
		undef $cf;
	    }
	}
	# config_local overrides the config settings
	if (%config_local) {
	    foreach $thing (keys %config_local) {
		$config{$thing} = $config_local{$thing};
	    }
	    undef %config_local;
	}
	# config_append adds to the config regexps
	if (%config_append) {
	    foreach $thing (qw(bin_allowed md5exclude allexclude badguys
		  baddomainpat exempt poison_groups html_allowed bad_cancel_paths
                  refuse_messageids low_xpost_groups supersedes_exempt)) {

		if (defined $config_append{$thing}) {
		    $config{$thing} = "$config{$thing}|$config_append{$thing}";
		    $config{$thing} =~ s/\|\|/\|/g;
		}
	    }
	    undef %config_append;
	}

        # parse the active file if we've been given one
        if ($config{'active_file'}) {
            %moderated = ();
            if (open (A, "<$config{'active_file'}")) {
                while (defined ($line = <A>)) {
                    chomp $line;
                    ($group,$junk,$junk,$flag) = split / /, $line;
                    $moderated{$group} = 1 if ($flag eq 'm');
                }
                close A;
            }
        }

	# slurp in cleanfeed.local
	$local_file = "$config_dir/cleanfeed.local";
	if (-r $local_file) {
	    if (open (LF, "<$local_file")) {
		@l_file = <LF>;
		close LF;
		$lf = join "", @l_file;
		eval $lf;
		undef @l_file;
		undef $lf;
	    }
	}

	&local_config if (defined &local_config);

    } # if config dir defined
}

    # Some stuff for regexps
    # case-insensitive pattern matches are very slow, so we don't use them
$tlds = 'com|net|org|edu|nl|de|no|dk|ch|com\.au|se';
$ip = '\d{2,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b';
$url = '(?:[Hh][Tt][Tt][Pp]:\/\/?|[Ww]{3})(?:[\w\-\.]+\.' . "$tlds|$ip" . ')';
$url2 = '[Hh][Tt][Tt][Pp]:\/\/?(?:[\w\-\.]+\.' . "$tlds|$ip" . ')';

$ci_begin = '[Bb][Ee][Gg][Ii][Nn]';
$ci_ctype = '[Cc][Oo][Nn][Tt][Ee][Nn][Tt]-[Tt][Yy][Pp][Ee]';
$ci_cte = '[Cc][Oo][Nn][Tt][Ee][Nn][Tt]-[Tt][Rr][Aa][Nn][Ss][Ff][Ee][Rr]-[Ee][Nn][Cc][Oo][Dd][Ii][Nn][Gg]';
$ci_txht = '(?:[Tt][Ee]?[Xx][Tt]|[Hh][Tt][Mm][Ll]?|[Uu][Rr][Ll])';
$ci_html = '[Tt][Ee][Xx][Tt]\/[Hh][Tt][Mm][Ll]';

$base64_chars = '[A-Za-z0-9\+\/]';
$uu_chars = '[\x20-\x60]';

# some nifty regular expressions 

$sex = 'sex|xxx|fuck';
$free = 'free(?!dom|bsd)';
$pics = 'pi(?:c|x)';
$desc1 = "hard.?core|teen|asian|extreme|live|outrageous|nasty|awesome|$free|adult";
$sex_adjs = "$desc1|$sex|erotic|gay|amateur|lesbian|blow.?job|fetish|pre.?teen|nude".
    '|celeb|school.?girl|bondage|rape|torture';
$site_desc = "$desc1|password";

$servPre = "(?:$free|cheap|unlimited|nationwide|$site_desc)";
$servPost = '(?:$free|minute|samples|800|900|no.?charge)';
$servStr = "(?:phone.{0,15}(?:$sex|fun)|(?:adult|r.?a.?p.?e|$sex).{0,10}(?:chat|site)".
    "|(?:$sex).{0,15}(?:show|call|connection|vid(?:eo|s))".
    "|hard.?core.(?:vid(?:eo|s)|amateur)|900.dateline|(?:mass|bulk).e?-?mail)";
$services = "(?:$servPre.{0,30}?$servStr)|(?:$servStr.{0,30}?$servPost)";

$free_stuff = "$free.{0,20}(?:password|membership|$pics|chat)".
    "|(?:100\%|total|complete|absolut|all).{0,15}$free".
    "|no.{0,6}(a(?:ge|dult).(?:verification|check)|avs)";
$porn = "(?:$sex_adjs).{0,25}(?:$pics|video|image|porn|photo|mpeg)";

$one_point_words = "teen|hot|sex|$free|credit|amateur|lolita|horne?y".
    '|dildo|anal(?!yst)|oral|school.?girl|bondage|breast|vid(?:eo|s)|orgy|erotic|porn'.
    '|fetish|whore|nympho|sucking|password|membership|make.money|fast.cash'.
    '|barely.?(?:18|legal)|orgasm';
$two_point_words = 'fuck|sluts|puss(?:y|ies)|\bcum|(?:hidden|live|free|dorm|spy).?cam'.
    '|le[sz]b(?:ian|o)|tit(?!an|ch)|dick(?!.?berg)|blow.?job|cock|clit|pam(?:ela)?.anderson'.
    '|twat|cunt|hard-?core|[^x]xxx|facial|gangbang|(?:live|real|innocent).girl';

&get_config;

if (not $inn) {
    $dolog = 0;
    $doreport = 0;
}

if ($config{'do_md5'}) {
    eval {require MD5; $md5 = new MD5};
} else {
    undef $md5;		# because do_md5 can change and this can be executed again
    undef $md5hash;
}

$EMPmaxlife = $config{'EMPmaxlife'} * 3600;	# convert to seconds
$MD5maxlife = $config{'MD5maxlife'} * 3600;
$MIDmaxlife = $config{'MIDmaxlife'} * 3600;

$timer{'interval'} = $config{'timer_interval'};

&writestats if ($inn);	# write stat file on each reload (if $statfile is defined)

if ($highwind or $nntprelay) {
    $dostats = 0;
    $got_hup = 0;
    $SIG{"USR1"} = sub { $dostats = 1 };	# use SIGUSR1 to write statfile
    $SIG{"HUP"} = sub { $got_hup = 1 };		# use SIGHUP to reload configuration
    &main;
}

if ($config{'timer_info'}) {
    $timer{'time'} = time unless ($timer{'time'});
}

sub main {
    # main loop for standalone mode
    my ($dolog,$doreport,$header,$value,$body,$hdrmode,$ret,$line);

    $| = 1; # Flush STDOUT
    my ($EOM) = ".\r\n";
    my ($accept_msg) = "335\r\n";
    my ($filter_msg) = "435\r\n";
    %hdr = ();
 
    binmode(STDIN) if ($nntprelay);

    if ($config{'logfile'} ne "") {
    	if (open(LOG, ">>$config{'logfile'}")) {
    	    $dolog = 1;
    	} else {
	    # we failed to open the logfile, continue on silently
    	}
    }

    if ($config{'reportfile'} ne "") {
    	if (open(REPORT, ">>$config{'reportfile'}")) {
    	    $doreport = 1;
    	    $rep_starttime = time;
    	} else {
	    # we failed to open the reportfile, continue on silently
    	}
    }

    %known_headers = ('approved'            => 'Approved',
		      'content-base'        => 'Content-Base',
		      'content-disposition' => 'Content-Disposition',
		      'content-type'        => 'Content-Type',
		      'control'             => 'Control',
		      'date'                => 'Date',
		      'distribution'        => 'Distribution',
		      'followup-to'         => 'Followup-To',
		      'from'                => 'From',
		      'lines'               => 'Lines',
		      'message-id'          => 'Message-ID',
		      'newsgroups'          => 'Newsgroups',
		      'nntp-posting-host'   => 'NNTP-Posting-Host',
		      'organization'        => 'Organization',
		      'path'                => 'Path',
		      'references'          => 'References',
		      'reply-to'            => 'Reply-To',
		      'sender'              => 'Sender',
		      'subject'             => 'Subject',
		      'x-trace'             => 'X-Trace',
		      'x-newsreader'        => 'X-Newsreader',
		      'x-newsposter'        => 'X-Newsposter',
		      'x-mailer'            => 'X-Mailer',
		      'x-cancelled-by'      => 'X-Cancelled-By',
		      'x-canceled-by'       => 'X-Canceled-By',
		     );

    $hdrmode = 1;
    $ret = "";

  LINE: while (defined ($line = <STDIN>)) {

	if ($hdrmode == 1) {
	    # read in a line of the header and store it in a hash
	    if ($line =~ /^([^ ]+): (.*)$/) {
		($header, $value) = ($1, $2);
		$value =~ tr/\r\n//d;
		$lcheader = lc($header);
		if (exists $known_headers{$lcheader}) {
		    $header = $known_headers{$lcheader}
		}
		$hdr{$header} = $value;
		next LINE;
	    } elsif ($line =~ /^\r?$/) {
		# End of headers
		$hdrmode = 0;
		next LINE;
	    } elsif ($line =~ /^\s/) {
		# Continuation line
		$line =~ s/^\s+//;
		$line =~ tr/\r\n//d;
                $hdr{$header} .= $line;
	    }
	} else {
	    # it's a body line
	    if (!(($line eq $EOM) && ($prevline =~ /\r\n$/))) {
		$prevline = $line;
		$line =~ s/\r\n$/\n/; # just get rid of the \r from the EOL \r\n
		$body .= $line;
	    }
	}
        
	# is the message complete?
	if ($line eq $EOM) {

	    $hdr{"__BODY__"} = $body; # make the body accessible

	    $ret = &filter_art; # call the filter function

	    if ($ret eq "") {
		print($accept_msg);
		if ($dolog == 1) {
		    if ($config{'log_accepts'}) {
			printf(LOG "%s accept\n", $hdr{"Message-ID"});
		    }
		}
		if ($doreport == 1) {
		    $rep_accept++;
		}
	    } else {
		print($filter_msg);
		if ($dolog == 1) {
		    printf(LOG "%s filter %s\n", $hdr{"Message-ID"}, $ret);
		}
		if ($doreport == 1) {
		    $rep_filter++;
		}
	    }

	    %hdr = ();
	    $body = "";
	    $hdrmode = 1;
            
	    if ($got_hup) {
		&re_configure;
	    }
	    if ($dostats) {
		&writestats;	# write stats file if we caught SIGUSR1
		$dostats = 0;
	    }
	}                       # EOM

        # rotate log if necessary
        if ($dolog == 1) {
            if ((-s $config{'logfile'}) > $config{'max_log_size'}) {
                close LOG;
		$num = 0;
                $num += 1 while (-e "$config{'logfile'}.$num"); # Ensure filename is unique
                rename $config{'logfile'}, "$config{'logfile'}.$num"; # Move it out of the way
                
                if (open (LOG, ">>$config{'logfile'}")) {
                    $dolog = 1;
                } else {
                    $dolog = 0;
                }
            }
        }
        
    } # while line read from stdin
    
    # Cleanup
    if ($dolog == 1) {
	close(LOG);
    }
    if ($doreport == 1) {
	$rep_endtime = time;
	printf(REPORT "%d\t%d\t%d\t%d\n", $rep_starttime, $rep_endtime, $rep_accept, $rep_filter);
	close(REPORT);
    }
}

sub re_configure {
    # when running standalone, HUP brings us here
    # reload config, open and/or close report and log files as necessary

    $got_hup = 0;

    &get_config;

    if (($dolog == 0) and ($config{'logfile'})) {
	# logging has been turned on
    	if (open(LOG, ">>$config{'logfile'}")) {
    	    $dolog = 1;
    	} else {
	    # we failed to open the logfile, continue on silently
    	}
    } elsif (($dolog == 1) and (! $config{'logfile'})) {
	# logging has been turned off
	close LOG;
	$dolog = 0;
	$rep_accept = 0;
	$rep_filter = 0;
    }

    if (($doreport == 0) and ($config{'reportfile'})) {
	# report has been turned on
    	if (open(REPORT, ">>$config{'reportfile'}")) {
    	    $doreport = 1;
    	    $rep_starttime = time;
    	} else {
	    # we failed to open the reportfile, continue on silently
    	}
    } elsif (($doreport == 1) and (! $config{'reportfile'})) {
	# report has been turned off
	$rep_endtime = time;
	printf(REPORT "%d\t%d\t%d\t%d\n", $rep_starttime, $rep_endtime, $rep_accept, $rep_filter);
	close(REPORT);
	$doreport = 0;
    }
}

sub filter_art {
    my (@result,$result);

    $now = time;	# time is used in several places

    if ($config{'timer_info'}) {
        &timer_stats if (($now - $timer{'time'}) > $timer{'interval'});
        $timer{'articles'}++;
    }

    if (! $hdr{'Control'}) {

	&trimhashes if ($cycles++ > $config{'trimcycles'});

	my ($empreturn) = "";
	$score = 0;
	undef $hash1;
	undef $hash2;
	undef $body;
        undef $source;

	# break out newsgroups into an array
    	@groups = split /[,\s]+/, $hdr{'Newsgroups'};
	if (exists ($hdr{'Followup-To'})) {
	    @followups = split /[,\s]+/, $hdr{'Followup-To'};
	} else {
	    (@followups) = (@groups);
	}

	# check out the newsgroups the article is posted to
	%gr = ();
        for (@groups) {
            if (/^net\./) { $gr{'net'}++ }
	    else          { $gr{'other'}++ }
            $gr{'skip'}++ if ($config{'allexclude'} and /$config{'allexclude'}/o);
            $gr{'md5skip'}++ if ($config{'md5exclude'} and /$config{'md5exclude'}/o);
            $gr{'binary'}++ if ($config{'bin_allowed'} and /$config{'bin_allowed'}/o);
	    $gr{'html'}++ if ($config{'html_allowed'} and /$config{'html_allowed'}/o);
            $gr{'poison'}++ if ($config{'poison_groups'} and /$config{'poison_groups'}/o);
	    $gr{'abuse'}++ if ($config{'net_abuse_groups'} and /$config{'net_abuse_groups'}/o);
	    $gr{'reports'}++ if ($config{'spam_report_groups'} and /$config{'spam_report_groups'}/o);
	    $gr{'low_xpost'}++ if ($config{'low_xpost_groups'} and /$config{'low_xpost_groups'}/o);
            $gr{'mod'}++ if ($config{'active_file'} and $moderated{$_});
        }
	$gr{'skip'} = ($gr{'skip'} == scalar @groups);		# these only count
	$gr{'md5skip'} = ($gr{'md5skip'} == scalar @groups);	# if all groups match
        $gr{'binary'} = ($gr{'binary'} == scalar @groups);
	$gr{'html'} = ($gr{'html'} == scalar @groups);
        $gr{'allmod'} = ($gr{'mod'} == scalar @groups);

        $gr{'faq'} = 1 if (grep {$_ eq 'news.answers'} @groups);

	# If all newsgroups are excluded from filtering, bail now
    	return "" if ($gr{'skip'});

	# count the lines in the article
        if (exists($hdr{'__LINES__'}) && defined( $hdr{'__LINES__'})) {
            $lines = $hdr{'__LINES__'};
        } else {
            $lines = ($hdr{'__BODY__'} =~ tr/\n/\n/);
        }

	# call a local filter if it exists
	if (defined &local_filter_before_emp) {
	    @result = &local_filter_before_emp;
	    if ($result[0] ne "") {
		return reject (@result);
	    }
	}

	##########################################################

    	# create MD5 body checksum hash
	if (defined $md5) {
	    undef $md5hash;
	    undef $mbody;
	    if (((! $hdr{'References'}) or (! $config{'md5_skips_followups'}))
                    && (! $gr{'md5skip'})
		    && ($hdr{'__BODY__'} !~ /^[\t ]{0,8}$/)) {
    	    	if ($config{'fuzzy_md5'}) {
		    if ($lines < $config{'fuzzy_max_length'}) {
		    	$mbody = lc($hdr{'__BODY__'});
			$mbody =~ s/^(?!http)\S{7,70}\r?$//mg;
			$mbody =~ s/\r{3}.*$//mg;
                        $mbody =~ s/(\r?\n)\s+$/$1/;
			if ($lines > 5) {
			    $mbody =~ s/^[^\n]*\Z//m;
			}
			$mbody =~ tr/a-z0-9//cd;
		    }
		}
  	    	$md5hash = $md5->hexhash($mbody || $hdr{'__BODY__'});
		if (exists $md5EMP{$md5hash}) {
		    $md5EMP{$md5hash} = $now;
		    return reject ("EMP rejected (md5)", "EMP rejected");
		}
	    } # if okay to do md5
	} # defined $md5

	if (not $gr{'reports'}) {

	    # create posting-host/lines hash
	    if ($config{'do_phl'}) {
		unless ($hdr{'NNTP-Posting-Host'} =~ /(?:$config{'exempt'})/o ||
			(($gr{'binary'}) && ($lines > 999))) {
		    $hash2 = "$hdr{'NNTP-Posting-Host'} $lines" if (exists $hdr{'NNTP-Posting-Host'});
		}
	    }
	    # reject (ph/l) from the EMP memory
	    if (defined $hash2 and exists $EMP{$hash2}) {
		$EMP{$hash2} = $now;
		return reject ("EMP rejected (ph/l)", "EMP rejected");
	    }

	    # create from/subject/lines hash
	    if ($config{'do_fsl'}) {
		if (defined $hdr{'Sender'}) {
		    $hash1 = "$hdr{'Sender'} $hdr{'Subject'}";
		} else {
		    $hash1 = "$hdr{'From'} $hdr{'Subject'}";
		}
		$hash1 =~ s/\d+$//;
		$hash1 =~ tr/a-z0-9\@//cd;
		$hash1 = "$hash1 $lines";
	    }
	    # reject (fsl) from the EMP memory
	    if (defined $hash1 and exists $EMP{$hash1}) {
		$EMP{$hash1} = $now;
		return reject ("EMP rejected (f/s/l)", "EMP rejected");
	    }
	} # not reports groups

	# store From, Subject, and Lines in history array and hash
	if (defined $hash1) {
	    push @history, $hash1;
	    $history{$hash1}++;
	}
	# Store NNTP-Posting-Host and Lines
	if (defined $hash2) {
	    push @history, $hash2;
	    $history{$hash2}++;
	}
	# MD5 checksums
	if (defined $md5hash) {
	    push @md5history, $md5hash;
	    $md5history{$md5hash}++;
	}

	# if post appears more than high limit, save for
	# continual rejection, outside of history window
	if ((defined $md5hash) and ($md5history{$md5hash} > $config{'md5maxmultiposts'})) {
	    md5savehist ($md5hash);
	    $empreturn = "New EMP detected (md5)";
	} elsif ((defined $hash2) and ($history{$hash2} > $config{'maxmultiposts'})) {
	    savehist ($hash2);
	    $empreturn = "New EMP detected (ph/l)";
	} elsif ((defined $hash1) and ($history{$hash1} > $config{'maxmultiposts'})) {
	    savehist ($hash1);
	    $empreturn = "New EMP detected (f/s/l)";
	}
	
	# trim old entries from history.
	# the data structure stays around, even between filter.perl reloads (INN).
	while (scalar @history > $config{'ArticleHistory'}) {
	    $tmp_hist = shift @history;
	    next unless (exists $history{$tmp_hist});
	    delete $history{$tmp_hist} if ($history{$tmp_hist}-- < 2);
	}
	while (scalar @md5history > $config{'MD5History'}) {
	    $tmp_hist = shift @md5history;
	    next unless (exists $md5history{$tmp_hist});
	    delete $md5history{$tmp_hist} if ($md5history{$tmp_hist}-- < 2);
	}
	
	return reject ($empreturn) unless ($empreturn eq "");

	##########################################################

        if ($config{'do_supersedes_filter'}) {
            if (exists $hdr{'Supersedes'}) {
                unless ($hdr{'NNTP-Posting-Host'} =~ /(?:$config{'supersedes_exempt'})/o) {
                    if ($hdr{'NNTP-Posting-Host'} =~ /^(\d+\.\d+.\d+)\.\d+/) {
                        $source = $1;
                    } elsif (exists $hdr{'NNTP-Posting-Host'}) {
                        $source = lc($hdr{'NNTP-Posting-Host'});
                        $source =~ tr/a-z.//cd;
                    }

                    if ($source) {
                        $supersede{$source} = [ $supersede{$source}[0] + 1, $now ];
                        $supersede{$source}[0] = 50 if ($supersede{$source}[0] > 50);

                        if ($gr{'faq'})                    { $max = 40 }
                        elsif (not $config{'active_file'}) { $max = 10 }
                        elsif ($gr{'allmod'})              { $max = 30 }
                        elsif ($gr{'mod'})                 { $max = 10 }
                        else                               { $max = 6  }

                        if ($supersede{$source}[0] > $max) {
                            return reject ("Excessive Supersedes - $hdr{'NNTP-Posting-Host'}", "Excessive Supersedes");
                        }
                    }
                }
            }
        }

	##########################################################

	# lowercase some headers for later
	undef %lch;
	$lch{'from'} = lc($hdr{'From'}) if (defined $hdr{'From'});
	$lch{'organization'} = lc($hdr{'Organization'}) if (defined $hdr{'Organization'});
	$lch{'content-type'} = lc($hdr{'Content-Type'}) if (defined $hdr{'Content-Type'});
	$lch{'subject'} = lc($hdr{'Subject'}) if (defined $hdr{'Subject'});
	$lch{'x-newsreader'} = lc($hdr{'X-Newsreader'}) if (defined $hdr{'X-Newsreader'});
	$lch{'x-newsposter'} = lc($hdr{'X-Newsposter'}) if (defined $hdr{'X-Newsposter'});
	$lch{'message-id'} = lc($hdr{'Message-ID'}) if (defined $hdr{'Message-ID'});
	$lch{'sender'} = lc($hdr{'Sender'}) if (defined $hdr{'Sender'});

        if (defined &local_filter_after_emp) {
            @result = &local_filter_after_emp;
            if ($result[0] ne "") {
                return reject (@result);
            }
        }

	($gr{'net'}) && ($gr{'other'}) &&
	    (return reject ("U2 violation - crosspost outside", "U2 violation"));

	($gr{'net'}) && ($hdr{'Distribution'} !~ /^\s*4[Gg][Hh]\s*$/) &&
	    (return reject ("U2 violation - invalid distribution", "U2 violation"));

        ($gr{'net'}) && (scalar @followups > 3) &&
            (return reject ("U2 violation - excessive crossposting", "U2 violation"));

    	(scalar @followups > $config{'maxgroups'}) &&
	    (return reject ("Too many newsgroups"));

	($gr{'low_xpost'}) && (scalar @followups > $config{'low_xpost_maxgroups'}) &&
	    (return reject ("Too many newsgroups"));

	($gr{'poison'}) && (return reject ("Poison newsgroup"));

        if ($config{'check_supersedes_path'}) {
            if (exists $hdr{'Supersedes'}) {
                ($hdr{"Path"} =~ /($config{'bad_cancel_paths'})/o) &&                          
                    (return reject ("Supersede with $1 in path", "Rogue supersede"));          
            }
        }

	if ($config{'do_bot_checks'}) {

	    ($lch{'organization'} =~ /email\s+platinum/) &&
		(return reject ("Email Platinum", "Bot signature"));

	    ($hdr{'X-Newsreader'} =~ /^2\.\d\.(?:\d\d? [A-Z]|\d\d?)$/) &&
		(return reject ("2.0.x Bot", "Bot signature"));

	    ($lch{'x-newsreader'} =~ /newsgroup\s+bulk\s+mailer/) &&
		(return reject ("Newsgroup Bulk Mailer", "Bot signature"));

	    ($lch{'x-newsreader'} =~ /calvacade 98/) &&
		(return reject ("Calvacade 98", "Bot signature"));

	    ($lch{'x-newsposter'} =~ /atomicpost/) &&
		(return reject ("AtomicPost", "Bot signature"));

	    ($hdr{'Message-ID'} =~ /<\d{12}\@[A-Z]{10}>|\@\d+>/) &&
		(return reject ("Bot Message-ID pattern", "Bot signature"));

	    ($hdr{'Organization'} =~ /<no\s+organization>/) &&
		($hdr{"Message-ID"} =~ /<(?:\d{12}|\d{8}\.\d{4})\@/) &&
		(return reject ("Org/MID bot pattern", "Bot signature"));

	    ($lch{'message-id'} =~ /msgidabcxyz\.com/) &&
		(return reject ("Bot - msgidabcxyz", "Bot signature"));

	    ($lch{'message-id'} =~ /none\d+\.yet>/) &&
		(return reject ("Bot - none##.yet", "Bot signature"));

	    ($lch{'message-id'} =~ /strip_path>/) &&
		(return reject ("Bot - strip_path", "Bot signature"));

	    ($hdr{'Organization'} =~ /^[A-Z]{2,3}\sInc\.\s*$/) &&
		($hdr{'Message-ID'} =~ /<\d{12}\.\d{10}\@/) &&
		(return reject ("Adultsights bot", "Bot signature"));

	    ($lch{'organization'} =~ /repost.*unauthorized.*cancel/) &&
		(return reject ("Bot (repost)", "Bot signature"));

	}

	if (not $gr{'abuse'}) {

    	    if ($config{'aggressive'}) {

		(($lch{'organization'} =~ /((?:\b$config{'badguys'})\.(?:$tlds)\b)/o) ||
		 ($lch{'from'} =~ /(\b(?:$config{'badguys'})\.(?:$tlds)\b)/o) ||
		 (lc($hdr{"NNTP-Posting-Host"}) =~ /(\b(?:$config{'badguys'})\.(?:$tlds)\b)/o) ||
		 ($lch{'message-id'} =~ /(\b(?:$config{'badguys'})\.(?:$tlds)>)/o)) &&
		     (return reject ("Spam - $1", "Spam domain"));

    	    } # aggressive

	    if ((not $gr{'reports'}) &&
		($hdr{'From'} !~ /nl-cancel\@.*xs4all\.nl|lendl\@.*sbg\.ac\.at|lendl.*?\@eddie\.ping\.at/)) {

		if (! $hdr{'References'}) {

		    if ($config{'do_bot_checks'}) {
			($hdr{'__BODY__'} =~ /[\r<=>]+\r[\r<=>]+$/m) &&
			    (return reject ("Angle-bracket bot", "Bot signature"));
		    }

		    if ($config{'aggressive'}) {
		
			$body = lc(substr($hdr{'__BODY__'},0,50000));
			($body =~ /http:..((?:www\.)?(?:($config{'badguys'})\.(?:$tlds)|($config{'baddomainpat'})\.(?:com|net|nu)))/o) &&
			    (return reject ("Spam - $1", "Spam domain"));

		    } # aggressive
		} # references
	    } # reports groups

        } # net-abuse groups

	# killer articles?
    	return "" if (($lines > 8000) and (length ($hdr{'__BODY__'}) < $lines * 4));

        if (defined &local_filter_middle) {
            @result = &local_filter_middle;
            if ($result[0] ne "") {
                return reject (@result);
            }
        }

	# uuencoded html, text, url files
	($lines > 3 and $lines < 350) &&
	    ($hdr{"__BODY__"} =~ /^$ci_begin[\t ]+[0-7]{3,4}[\t ]+\S?.{0,45}?\S+\.($ci_txht)\n+(?:^[\t |>]*M$uu_chars{60,61}[\t ]*\r?\n){2,}?/mo) &&
	    (return reject ("UUencoded $1"));

        # binaries in non-binary newsgroups
        if ($config{'block_binaries'}) {
            unless ($config{'binaries_in_mod_groups'} and $gr{'allmod'}) {
                if ($lines > $config{'max_encoded_lines'}) {
                    if (not $gr{'binary'}) {
                        (($hdr{"__BODY__"} =~ /(?:^[\t >]*$base64_chars{59,76}[\t ]*\r?\n){$config{'max_encoded_lines'}}/mo) ||
                         ($hdr{"__BODY__"} =~ /(?:^[\t >]*M$uu_chars{60,61}[\t ]*\r?\n){$config{'max_encoded_lines'}}/mo)) &&
                             (return reject ("Binary in non-binary group"));
                    }
                }
            }
	}

	# mime-encapsulated HTML
        if ($config{'block_mime_html'}) {
	    (($hdr{"Content-Disposition"} =~ /filename.*\.html?/) ||
	     ($hdr{"Content-Base"} =~ /file:.*\.html?/) ||
	     (($lch{'content-type'} =~ /multipart\/(?:mixed|related)/) &&
	      ($hdr{"__BODY__"} =~ /^$ci_ctype:[\t ]+text\/html/mo) &&
	      ($hdr{"__BODY__"} =~ /^$ci_cte:[\t ][Bb][Aa][Ss][Ee]64/mo))) &&
		  (return reject ("Misc HTML spam"));
	}

	# HTML (and multipart/alternative)
	if ($config{'block_html'}) {
	    if (not $gr{'html'}) {
		($lch{'content-type'} =~ /text\/html|multipart\/alternative/) &&
		    (return reject ("HTML post"));
		($lch{'content-type'} =~ /multipart\/(?:mixed|related)/) &&
		    ($hdr{'__BODY__'} =~ /^$ci_ctype:[\t ]$ci_html/m) &&
		    (return reject ("HTML post"));
	    }
	}

        if ((not $gr{'reports'}) &&
	    ($hdr{"From"} !~ /nl-cancel\@.*xs4all\.nl|lendl\@.*sbg\.ac\.at|lendl.*?\@eddie\.ping\.at/)) {

	    if ($config{'do_scoring_filter'}) {

		$munged_subject = $lch{'subject'};
		$munged_subject =~ tr/a-z0-9 //cd;

		($lch{'content-type'} =~ /multipart\/(?:related|mixed).*boundary/) &&
		    ($hdr{'NNTP-Posting-Host'} !~ /webtv\.net/) &&
		    ($lch{'message-id'} !~ /webtv\.net/)  &&
		    ($score += 3);

		(scalar @followups > 4) && ($score += 1);
		(scalar @followups > 8) && ($score += 2);

		($lch{'from'} =~ /$url2/o) && ($score += 4);

		($lch{'subject'} =~ /$url/o) && ($score += 1);
		($lch{'subject'} =~ /http:..$ip/o) && ($score += 5);
		($hdr{'Subject'} =~ /[\s~]\d{2,7}$/) && ($score += 3);
		($lch{'subject'} =~ /\s\d{1,3}\.jpg$/) && ($score += 4);
		($hdr{'Subject'} =~ /\${3}|!{3}|={4}|\*{3}/) && ($score += 1);
		($hdr{'Subject'} =~ /\r/) && ($score += 3);
		($hdr{'Subject'} !~ /[a-z]/) && ($score += 1);

		if ($config{'aggressive'}) {
		    ($lch{'subject'} =~ /http:..(?:www\.)?(?:$config{'badguys'})\.(?:$tlds)/) && ($score += 4);

		    while ($lch{'subject'} =~ /$one_point_words/go)      { $score += 1 }
		    while ($lch{'subject'} =~ /$two_point_words/go)      { $score += 2 }
		    while ($lch{'from'} =~ /$one_point_words/go)         { $score += 1 }
		    while ($lch{'from'} =~ /$two_point_words/go)         { $score += 2 }
		    while ($lch{'message-id'} =~ /$one_point_words/go)   { $score += 1 }
		    while ($lch{'message-id'} =~ /$two_point_words/go)   { $score += 2 }
		    while ($lch{'organization'} =~ /$one_point_words/go) { $score += 1 }
		    while ($lch{'organization'} =~ /$two_point_words/go) { $score += 2 }		

		    ($munged_subject =~ /$services/o) && ($score += 5);
		    ($munged_subject =~ /$site_desc.{0,20}site/o) && ($score += 3);
		    ($munged_subject =~ /(?:$free_stuff|$porn)/o) && ($score += 1);
		}

		($lines < 30) && ($lch{'subject'} =~ /\w\.(?:jpe?g|gif)/) && ($score += 2);

		($lines ne $hdr{'Lines'}) && ($score += 1);

		($lch{'organization'} =~ /<no\s+organization>/) && ($score += 3);
		($lch{'organization'} =~ /http:..$ip/o) && ($score += 7);

		($hdr{'Message-ID'} =~ /<(?:\d{12}|\d{8}\.\d{4}|\d{4,5})\@/) && ($score += 5);

		$body = lc(substr($hdr{'__BODY__'},0,50000)) unless (defined $body);

		if ($lch{'content-type'} =~ /^(?:multipart|text.html)/) {
		    ($body =~ /<img src=/) && ($score += 4);
		    ($body =~ /^content-base:..?http/m) && ($score += 3);
		    ($body =~ /<meta http-equiv=.?refresh/) && ($score += 5);
		    ($body =~ /<script language=.?javascript/) && ($score += 4);
		    ($body =~ /^content-type:\s+multipart\/alternative/m) && ($score += 2);
		}

		($body =~ /\r\r/) && ($score += 4);
		($body =~ /http:..$ip/o) && ($score += 5);

		($lines < 3) &&
		    ($body =~ /^[\t ]*$url\S*[\t ]*$/o) &&	# only URL
		    ($score += 7);

		(exists $hdr{'References'}) && ($score -= 3);
		($hdr{'References'} =~ /^<[^>]+>\s</) && ($score -= 2);
		($gr{'reports'}) && ($score -= 1);

                if ($config{'active_file'}) {
                    if ($gr{'allmod'}) {
                        $score -= 6;
                    } elsif ($gr{'mod'}) {
                        $score -= 4;
                    }
                }

		if (defined &local_filter_scoring) {
		    $result = &local_filter_scoring;
		    $score += $result;
		}

		($score > 7) &&
		    (return reject ("Scoring filter", "Scoring filter"));

	    } # do scoring filter?

	} # reports

        if (defined &local_filter_last) {
            @result = &local_filter_last;
            if ($result[0] ne "") {
                return reject (@result);
            }
        }

	$status{'accepted'}++;
        $timer{'accepted'}++ if ($config{'timer_info'});
        return "";	# Article Okay!

    } elsif ($hdr{"Control"} =~ /^\s*cancel/) {
	# examine cancel messages

        if (defined &local_filter_cancel) {
            @result = &local_filter_cancel;
            if ($result[0] ne "") {
                return reject (@result);
            }
        }

	if ($config{'block_late_cancels'}) {
	    if ($hdr{"Control"} =~ /^cancel (.*)$/) {
		$canmid = $1;
		return reject ("Cancel for rejected article") if (exists $MIDhistory{$canmid});
	    }
	}

	($hdr{"__BODY__"} =~ /Usenet.*Cancel.*Engine/ms) &&
	    (return reject ("Rogue cancel (UCE)", "Rogue cancel"));

        if ($config{'drop_control_with_supersedes'}) {
            if (exists $hdr{"Supersedes"}) {
                return reject ("Cancel with Supersedes header");
            }
        }

	@groups = split /[, ]+/, $hdr{"Newsgroups"};	# break out groups into array
	(grep /^control(?:\.cancel)?$/, @groups) &&
	    (return reject ("Rogue cancel (newsgroups)", "Rogue cancel"));

	($hdr{'__BODY__'} =~ /HipCrime.*NewsAgent/) &&
	    (return reject ("Rogue cancel (HipCrime)", "Rogue cancel"));

	(($hdr{'Organization'} =~ /HipCrime/) ||
	 ($hdr{'From'} =~ /HipCrime/)) &&
            (return reject ("Rogue cancel (HipCrime)", "Rogue cancel"));

	# from Ricardo's "FAQ"
	($hdr{'Path'} =~ /((?:hacker|crack|porn|cripple|gimp|cunt|hole|fag|aids|faq|god|hindu|dothead|jew|kike|moslem|towelhead|nazi|kraut|nerd|geek|nigger|redneck|rice|slanteye|spick|whine)cancel|cyberwhin(?:er|ing))/) &&
	    (return reject ("Rogue cancel - $1", "Rogue cancel"));

	($hdr{'Path'} =~ /($config{'bad_cancel_paths'})/o) &&
	    (return reject ("Cancel with $1 in path", "Rogue cancel"));

	($hdr{'NNTP-Posting-Host'} =~ /($config{'bad_cancel_paths'})/o) &&
	    (return reject ("Cancel with $1 in posting-host", "Rogue cancel"));

	if (exists $hdr{'X-Cancelled-By'} or exists $hdr{'X-Canceled-By'}) {
	    undef $xcancelby;
	    $xcancelby = lc($hdr{'X-Cancelled-By'} || $hdr{'X-Canceled-By'});

	    ($xcancelby !~ /\w\@\w/) &&
		(return reject ("Bad X-Cancelled-By", "Rogue cancel"));
	}

    } elsif ($hdr{'Control'} =~ /^\s*(?:new|rm)group\s/) {

        if (defined &local_filter_newrmgroup) {
            @result = &local_filter_newrmgroup;
            if ($result[0] ne "") {
                return reject (@result);
            }
        }

        if ($config{'drop_control_with_supersedes'}) {
            if (exists $hdr{'Supersedes'}) {
                return reject ("New/Rmgroup with Supersedes header");
            }
        }

	(($hdr{'Distribution'} =~ /collabra-internal/) ||
	 ($hdr{'__BODY__'} =~ /Control message generated by Netscape Collabra Server/)) &&
		(return reject ("Bogus control message from Collabra luser", "Bad control message"));

	if ($hdr{'Control'} =~ /(?:new|rm)group\s(?:comp|misc|news|rec|soc|sci|humanities|talk)/) {

	    ($hdr{'From'} !~ /group-admin\@isc\.org/) &&
		(return reject ("Big 8 control message from wrong address", "Bad control message"));

	    ($hdr{'Organization'} =~ /Cabal/) &&
		(return reject ("Bogus big-8 control message (Cabal)", "Bad control message"));

	    ($hdr{'__BODY__'} =~ /Meow/) &&
		(return reject ("Bogus big-8 control message (Meow)", "Bad control message"));
	} else {

	    ($hdr{'From'} =~ /(?:group-admin|tale)\@isc\.org|tale\@uunet\.uu\.net/) &&
		(return reject ("Forged non-big-8 control message supposedly from tale", "Bad control message"));
	}

	if (not $hdr{'Approved'}) {
	    return reject ("Unapproved control message", "Bad control message");
	}

	(($hdr{'From'} =~ /sexzilla\.com|netzilla\.net/) ||
	 ($hdr{'Control'} =~ /newgroup.*(?:sexzilla|netzilla)/)) &&
	     (return reject ("Sexzilla newgroup message", "Bad control message"));

    } elsif ($hdr{'Control'} =~ /^\s*(sendsys|senduuname|version)/) {

        if ($config{'drop_useless_controls'}) {
            return reject ("Unwanted $1 message", "Bad control message");
        }

        if ($config{'drop_control_with_supersedes'}) {
            if (exists $hdr{'Supersedes'}) {
                return reject ("Control message with Supersedes header");
            }
        }

    } elsif ($hdr{'Control'} =~ /^\s*(ihave|sendme)/) {

        if ($config{'drop_ihave_sendme'}) {
            return reject ("Unwanted $1 message", "Bad control message");
        }

        if ($config{'drop_control_with_supersedes'}) {
            if (exists $hdr{'Supersedes'}) {
                return reject ("Control message with Supersedes header");
            }
        }

    }


    $status{'accepted'}++;
    $timer{'accepted'}++ if ($config{'timer_info'});
    return "";
}

sub trimhashes {
    my ($id,$lasthit,$over,$when);

    # trim too-old entries from %EMP
    if ($config{'do_fsl'} || $config{'do_phl'}) {
	if (scalar keys %EMP > $config{'EMPstarttrimming'}) {
            foreach $id (keys %EMP) {
		delete $EMP{$id} if (($now - $EMP{$id}) > $EMPmaxlife);
	    }
	    # if still over the max, delete oldest entries until it's small enough
	    $over = (scalar keys %EMP) - $config{'EMPHistSize'};
	    if ($over > 0) {
		foreach $id (sort { $EMP{$b} <=> $EMP{$a} } keys %EMP) {
		    delete $EMP{$id};
		    last if (--$over < -10);
		}
	    }
	}
    }
    # trim too-old entries from %md5EMP
    if ($config{'do_md5'}) {
	if (scalar keys %md5EMP > $config{'EMPstarttrimming'}) {
            foreach $id (keys %md5EMP) {
		delete $md5EMP{$id} if (($now - $md5EMP{$id}) > $MD5maxlife);
	    }
	    # if still over the max, delete oldest entries until it's small enough
	    $over = (scalar keys %md5EMP) - $config{'MD5HistSize'};
	    if ($over > 0) {
		foreach $id (sort { $md5EMP{$b} <=> $md5EMP{$a} } keys %md5EMP) {
		    delete $md5EMP{$id};
		    last if (--$over < -50);	# cut into it so we don't have to come back soon
		}
	    }
	}
    }
    # trim too-old entries from %MIDhistory
    foreach $id (keys %MIDhistory) {
	delete $MIDhistory{$id} if (($now - $MIDhistory{$id}) > $MIDmaxlife);
    }

    # trim too-old entries from %supersedes
    foreach $id (keys %supersede) {
        if (($now - $supersede{$id}[1]) > 1200) { # make that a config option?
            $supersede{$id}[0]--;
            $supersede{$id}[1] = $now;
        }
        delete $supersede{$id} if ($supersede{$id}[0] < 1);
    }

    $cycles = 0;	# start the counter over
} 

sub savehist {
    # store the EMP id in %EMP
    my ($key) = @_;

    $EMP{$key} = $now;
    delete $history{$key} if (exists $history{$key});
    @history = grep (!($_ eq $key), @history);
    return 1;
}

sub md5savehist {
    # store the MD5 EMP id in %md5EMP
    my ($key) = @_;

    $md5EMP{$key} = $now;
    delete $md5history{$key} if (exists $md5history{$key});
    @md5history = grep (!($_ eq $key), @md5history);
    return 1;
}

sub reject {
    my ($verbose,$short) = @_;
    my ($save) = 1;

    $short = $verbose unless ($short);

    $save = 0 if ($hdr{'Control'});

    if ($config{'block_late_cancels'} and $save) {
	$MIDhistory{"$hdr{'Message-ID'}"} = $now;
    }

    $status{'rejected'}++;

    if ($config{'verbose'}) {
	return $verbose;
    } else {
	return $short;
    }
}

sub filter_messageid {
    # examine message-id during CHECK transaction (INN only)

    return "" unless ($config{'do_mid_filter'});
    my ($mid) = @_;

    if ($config{'refuse_messageids'}) {
        if ($mid =~ /$config{'refuse_messageids'}/o) {
            $status{'refused'}++;
            return "No";
        }
    }

    if ($config{'block_late_cancels'}) {
        if ($mid =~ /^<cancel\.(.*)/ && $MIDhistory{'<'.$1}) {
            $status{'refused'}++;
            return "No";
        }                                                                                 
    }

    return "";
}

sub filter_mode {
    return;
}

sub timer_stats {
    # figure out how many articles per second we're looking at and accepting
    # $timer{'articles'} - how many we've seen since last time
    # $timer{'accepted'} - how many we've accepted since last time
    # $timer{'interval'} - how long between checks
    # $timer{'time'} - time of last check
    # $timer{'rate'} - articles checked per second
    # $timer{'accept_rate'} - articles accepted per second

    $timer{'rate'} = (int ($timer{'articles'} / $timer{'interval'} * 10)) / 10;
    $timer{'accept_rate'} = (int ($timer{'accepted'} / $timer{'interval'} * 10)) / 10;
    $timer{'time'} = $now;
    $timer{'articles'} = 0;
    $timer{'accepted'} = 0;
    return 1;
}

sub filter_stats {
    # a status line in "ctlinnd mode" output (INN only)
    # requires the "mode.patch" to innd

    my ($string);
    my ($emphashentries) = scalar keys %EMP;
    my ($md5hashentries) = scalar keys %md5EMP;
    my ($midhistentries) = scalar keys %MIDhistory;
    my ($superentries) = scalar keys %supersede;
  
    $string = "Pass: $status{'accepted'}";
    $string .= "  Reject: $status{'rejected'}";
    $string .= "  Refuse: $status{'refused'}" if ($config{'do_mid_filter'});
    $string .= "  MD5: $md5hashentries  EMP: $emphashentries  MID: $midhistentries  SS: $superentries";
    if ($config{'timer_info'} and $timer{'rate'}) {
        $string .= "  Arts/sec: $timer{'rate'}  Accept/sec: $timer{'accept_rate'}";
    }

    return $string;
}

sub writestats {
    # write a crude stat file including accept/reject numbers,
    # hash sizes, and current configuration

    return 1 unless (defined $config{'statfile'});

    my ($emphashentries) = scalar keys %EMP;
    my ($md5hashentries) = scalar keys %md5EMP;
    my ($midhistentries) = scalar keys %MIDhistory;
    my ($superentries) = scalar keys %supersede;

    open FILE, ">$config{'statfile'}" or return 0;
    print FILE "Accepted: $status{'accepted'}\n";
    print FILE "Rejected: $status{'rejected'}\n";
    print FILE "Refused: $status{'refused'}\n" if ($config{'do_mid_filter'});
    print FILE "MD5 entries: $md5hashentries\n";
    print FILE "EMP entries: $emphashentries\n";
    print FILE "MID history: $midhistentries\n";
    if ($config{'timer_info'} and $timer{'rate'}) {
        print FILE "Articles examined per second: $timer{'rate'}\n";
        print FILE "Articles accepted per second: $timer{'accept_rate'}\n";
    }

    print FILE "\nSupersedes entries: $superentries\n";
    foreach $item (sort keys %supersede) {
        print FILE "  $item: $supersede{$item}[0]\n";
    }

    print FILE "\n";
    print FILE "\nCurrent configuration:\n\n";
    foreach $item (sort keys %config) {
	print FILE "$item: $config{$item}\n";
    }

    close FILE;
}

sub checkrotate {
    # See if batch file is oversized and if so, rotate it
    my ($batchfile) = @_;
    my ($num) = 1;

    (-s $batchfile < $config{'debug_batch_size'}) && return 0;

    $num += 1 while (-e "$batchfile.$num");     # Ensure filename is unique
    rename $batchfile, "$batchfile.$num";       # Move it out of the way
}

sub writeheaders {
    # Dump the headers to a batchfile
    my ($file) = @_;
    my ($header);

    return 1 unless (defined $config{'debug_batch_directory'});
    checkrotate ("$config{'debug_batch_directory'}/$file");

    if (open (BATCH, ">>$config{'debug_batch_directory'}/$file")) {
	foreach $header (keys %hdr) {
	    print BATCH "$header: $hdr{$header}\n" unless ($header eq '__BODY__');
	}
	print BATCH "\n";
	close BATCH;
    }
    return 1;
}

sub writefull {
    # Dump the full article to a batchfile
    my ($file) = @_;
    my ($header);

    return 1 unless (defined $config{'debug_batch_directory'});
    checkrotate ("$config{'debug_batch_directory'}/$file");

    if (open (BATCH, ">>$config{'debug_batch_directory'}/$file")) {
        foreach $header (keys %hdr) {
            print BATCH "$header: $hdr{$header}\n" unless ($header eq '__BODY__');
        }
        print BATCH "\n";
	print BATCH "$hdr{'__BODY__'}\n";
        close BATCH;
    }
    return 1;
}
