#!/usr/bin/perl5
## This is ada.dhs.org:/usr/local/sbin/ckfreezer
## $Header: /var/src/zmailer-contentfilter/RCS/ckfreezer,v 4.2 2000/10/05 02:55:28 acli Exp $
##
## Simple script to attempt to report (and act) on frozen files
## Hope this has no side effects (relaying etc.)
## Copyright 1998, 2000 by Ambrose Li <acli@ada.dhs.org>
##
## Note: The actual spam-guessing logic has been moved to Spamdex.pm
## Note: The actual FSM logic has been moved to ZMailer_Message_File.pm
## Note: The actual spam detection logic has been scrapped and replaced
##       with a use of SMTP_ContentFilter_Core.pm which is derived from
##       the new smtp-contentfiler logic

BEGIN {
   # Guess where Spamdex.pm and ZMailer_Message_File.pm are.
   # Hope we will get it right...
   push @INC, ($0 =~ /^\.\// || $0 !~ /\//)? '.': '/usr/local/lib';
}

use integer;
use strict;
use vars qw(
   $debug
   $dry_run
   $freezer $queue
   $default_config_file
);

use vars qw( @dependencies );
@dependencies = ('Spamdex', 'SMTP_ContentFilter_Core', 'ZMailer_Message_File');

use Getopt::Long;
use SMTP_ContentFilter_Core;
use Spamdex;
use Version_Strings qw( $appName );
use ZMailer_Message_File;

BEGIN {
   use vars qw( $rcsRevision $rcsLocker $rcsDate @Copyright );
   $rcsDate     = q$Date: 2000/10/05 02:55:28 $;
   $rcsLocker   = q$Locker:  $;
   $rcsRevision = q$Revision: 4.2 $;
   @Copyright   = 'Copyright 1998, 2000 Ambrose Li <acli@ada.dhs.org>';
}

## BEGIN tunable parameters

sub SPAMDEX_THRESHOLD () { $Spamdex::threshold };

$freezer = "/software/zmailer/spool/freezer";
$queue   = "/software/zmailer/spool/router";

## END tunable parameters


## Auxiliary routines

sub warn {
   my ($msg, @argv) = @_;
   printf STDERR "%s: %s\n", $appName, sprintf($msg, @argv);
}

sub die {
   &warn(@_);
   exit(1);
}

## The exam routine examines a frozen message and try to guess if it is spam
## according to spamdex() function. If it is deemed unlikely to be spam, the
## allegedly-wrongfully-frozen file is fed back into the router queue.

sub looks_like_spam {
   my ($file) = @_;
   my $spammy = 0;

   my $spamdex = 0;
   my ($env_from, $env_to);
   my ($head_subject, $head_from, $head_sender, $head_to);

   my $message_size;		# excluding envelope
   my($code, $comment, $adjusted_sample_size, $adjusted_spamdex);

   $file = $freezer . '/' . $file unless $file =~ /^\//;

   do {
      my $setproctitle_g = sub { ($message_size, $spamdex) = @_ };
      my($tag, $env, $head);
      ($code, $comment, $tag, $_, $adjusted_sample_size, $adjusted_spamdex,
	 $env, $head)
	 = SMTP_ContentFilter_Core::scan_control_file($file,
				    undef,
				    undef,
				    $setproctitle_g);
      ($env_from, $env_to) = ($env->{from}, $env->{to});
      ($head_subject, $head_from, $head_sender, $head_to)
	 = ($head->{subject}, $head->{from}, $head->{sender}, $head->{to});
   };

   printf("%s (size %5.2fk, adjusted %5.2fk), subjective spam index %d:\n",
      $file, $message_size/1024, $adjusted_sample_size, $spamdex);

   if (defined $head_from) {
      printf("\tFrom: %s", $head_from);
      printf(" (%s)", $env_from) if defined $env_from;
      printf("\n");
   } else {
      printf("\tFROM: %s\n", $env_from);
   }
   if (defined $head_to) {
      printf("\tTo: %s", $head_to);
      printf(" (%s)", $env_to) if defined $env_to;
      printf("\n");
   } else {
      printf("\tTO: %s\n", $env_to);
   }
   if (defined $head_subject) {
      printf("\tSubject: %s\n", $head_subject);
   }
   if ($code != 0) {
      printf("\n\t$comment\n\tPlease re-examine manually.\n");
      $spammy = 1;
   } elsif ($dry_run) {
      printf("\n\tThis is probably non-spam (but this is a dry run).\n");
   } else {
      printf("\n\tThis is probably non-spam. Moving to router queue...");
      my $target = sprintf("%s-%s", (stat($file))[1], $$);
      if (rename($file, "$queue/$target")) {
	 print " $target ok\n" ;
      } else {
	 print " $target failed ($!)\n" ;
      }
   }
   printf("\n");
   return $spammy;
}

## Usage message, for interactive testing

sub display_usage_then_exit (;$) {
   my($st) = @_;
   my $h = $st? *STDERR: *STDOUT;
   print $h <<EOF;
Usage: $0 [OPTIONS]...
Determine what to do with messages in the freezer area.

      --config=FILE   read configuration from FILE instead of $default_config_file
  -D, --debug         produce verbose debugging output
                      specify more than once for more verbosity
  -n, --dry-run       do not write log file
      --help          display this help and exit
      --version       output version information and exit

Examines the ZMailer freezer area and determines what to do with each frozen
message. Messages which either look like spam or fails anti-relay crosschecks
are left intact; otherwise the messages are rerouted for delivery.

Report bugs to clara\@ada.dhs.org.
EOF
   exit $st;
}

sub display_version_then_exit () {
   print Version_Strings::version_option(
	 'Spamdex',
	 'ZMailer_Message_File',
      ), "\n";
   exit;
}

## The "main program" scans the freezer for files to process.

sub main {
   $default_config_file = $Spamdex::config_file;
   Getopt::Long::config('bundling');
   GetOptions(
      'config=s' => \$Spamdex::config_file,
      'debug|D' => sub { $debug += 1 },
      'dry-run|n' => \$dry_run,
      'help' => \&display_usage_then_exit,
      'version' => sub { display_version_then_exit },
   ) || exit 1;
   $Spamdex::debug = $debug;
   $ZMailer_Message_File::debug = $debug;
   my @probable_spams;
   opendir(FREEZER, $freezer) || &die("$freezer: opendir failed: $!");
   for (;;) {
      my $frozen_spam = readdir FREEZER;
      my $freezer_area;
   last unless defined $frozen_spam;
      $freezer_area = $1 if $frozen_spam =~ /policy-(\d+)$/;
      unless (-d $frozen_spam) {
	 $0 = "$appName <$frozen_spam"; # setproctitle
	 push @probable_spams, $frozen_spam if looks_like_spam($frozen_spam);
      }
   }
   if (@probable_spams) {
      print "\n--\nIf all of these looks like spam to you, you can remove them by running\n";
      print "(cd $freezer;\n";
      my $n = 0;
      my $prefix = "rm -f ";
      for my $candidate (@probable_spams) {
	 $candidate =~ s/([\s\\'"])/\\\1/g;
	 my $m = length($candidate);
	 if ($n + $m + length($prefix) >= 79) {
	    print "\\\n";
	    $n = 0;
	    $prefix = " ";
	 }
	 print "$prefix$candidate ";
	 $n += length($prefix) + $m;
	 $prefix = "";
      }
      print "\n)\n";
   }
}

exit(&main());

## END of program
