#!/usr/bin/perl5
## This is ada.dhs.org:/usr/local/sbin/smtp-contentfilter
##  a.k.a. ada.dhs.org:/software/zmailer/servers/smtp-contentfilter
## $Header: /var/src/zmailer-contentfilter/RCS/smtp-contentfilter,v 4.2 2000/10/05 02:50:30 acli Exp $
##
## Will be run as user daemon
##
## Copyright 1998, 2000 by Ambrose Li <acli@ada.dhs.org>
##
## WARNING: You must be absolutely sure that this program works before you
## install it. ZMailer will happily accept Perl's syntax error message as
## a "0 Ok" message!
##
## (Not even warning messages are acceptable because of such careless
## behaviour. But it would be less possible to completely make sure there
## are no warning messages; sometimes you have to wrap components to make
## sure they don't misbehave. Or perhaps you could redirect stderr to a
## file immediately after the script begins, and hope that nothing went
## to stderr in the BEGIN blocks.)

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

use integer;
use strict;
use Getopt::Long;
use SMTP_ContentFilter_Core;
use Spamdex;
use Version_Strings qw( $appName );
use ZMailer_Message_File;
use vars qw( $debug $dry_run );
use vars qw( $default_config_file $logfile );
use vars qw( @selfaddresses @interface_addresses @local_networks );
use vars qw( $timeout );
use vars qw( $proctitlesuffix );

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

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

## Tunable parameters
$logfile = '/var/log/zmailer/smtp-contentfilter';
$timeout = 300; # must be between 0 seconds and 540 seconds (9 minutes)

## Auxiliary routines

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

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

## The scan_control_file() function scans the control file specified in the
## given path; returns an array containing a code (0 = ok, -ve = reject,
## +ve = freeze), a comment, and a string containing identification info.
## For normal use the first two codes are sent to standard output.

sub scan_control_file ($) {
   my ($file) = @_;
   my ($code, $comment, $tag, $s1, $s2, $s3) = (0, 'Ok');

   my $proctitlebase;		# used in $f closure only
   my $t_i = time;		# initial time, for timeout detection
   my $timedout_p = 0;

   my $setproctitle_f_stchg = sub {
      my($state) = @_;
      $proctitlebase = sprintf("%s <%s State=%d (%s)",
	    $appName, $file, $state, ZMailer_Message_File::state_cvs($state))
   };

   my $setproctitle_f = sub {
      my($message_size, $spamdex) = @_;
      $0 = sprintf("%s; tell=%d; spamdex=%d%s", $proctitlebase, $message_size, $spamdex, $proctitlesuffix); # setproctitle
   };

   my $setproctitle_g = sub {
      my($message_size, $spamdex) = @_;
      $0 = "$appName <$file Final analysis; tell=$message_size; spamdex=$spamdex$proctitlesuffix"; # setproctitle
   };

   my $exit_condition = sub {
      my $t = time - $t_i;
      $timedout_p = ($t > $timeout) && $t;
      return $timedout_p;
   };

   ($code, $comment, $tag, $s1, $s2, $s3) = 
      SMTP_ContentFilter_Core::scan_control_file($file,
      $setproctitle_f_stchg, $setproctitle_f, $setproctitle_g, $exit_condition);

   ($code, $comment) =
	 (1, "Timed out during scan; elapsed=$timedout_p s, limit=$timeout s")
      if $timedout_p && $code == 0;

   return ($code, $comment, $tag, $s1, $s2, $s3);
}

## 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 message file specified in standard input.

      --config=FILE   read configuration from FILE instead of $default_config_file
  -D, --debug         produce verbose debugging output
                      (specify more than once for more verbosity)
  -f, --file=FILE     use FILE for input, instead of reading file from stdin
		      (for testing and also used internally)
  -n, --dry-run       do not write log file
      --help          display this help and exit
      --version       output version information and exit

This is a "content policy filter" for ZMailer version 2.99.53.
It should be installed as \$MAILBIN/smtp-contentfilter.

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

sub display_version_then_exit () {
   print Version_Strings::version_option(@dependencies), "\n";
   exit;
}

sub exit_due_to_signal ($) {
   my($sig) = @_;
   printf LOG "%010d-%05d\taborted (SIG%s)\n", time, $$, $sig;
   exit 255;
}

## The "main program" accepts one file from the smtpserver to scan
## The ZMailer distribution does not explain this in detail; it turns out that
## the content policy filter receives *exactly* one file name from the
## smtpserver; it *must* immediately return after returning the policy results
## Otherwise the smtpserver process will hang.

if (1) {
   my $file;
   my $self = $0;
   $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,
      '--file|f=s' => \$file,
      '--help' => \&display_usage_then_exit,
      '--version' => sub { display_version_then_exit },
   ) || exit 1;
   if ($debug) {
      $Spamdex::debug = $debug;
      $SMTP_ContentFilter_Core::debug = $debug;
      $ZMailer_Message_File::debug = $debug;
      $| = 1;
      open(LOG, '>&STDERR');
   } elsif ($dry_run) {
      open(LOG, '>/dev/null');
   } else {
      ## If it is a production run, we must suppress stderr or else we're hosed
      ## because ZMailer 2.99.53 is too careless parsing its filter input
      if (open(LOG, '>>'.$logfile)) {
	 select((select(LOG), $| = 1)[$[]);
	 open(STDERR, '>&LOG');
      } else {
	 # Can't open the log file; desperately, we junk all stderr output
	 open(STDERR, '>/dev/null');
      }
   }

   unless (defined $file) {
      $file = scalar <>;
      chomp $file;
      @ARGV = (@ARGV, '-f', $file); # for SIGHUP handler
   }

   $proctitlesuffix = ($dry_run? '; dry run': '') . ($debug? "; debug=$debug": '');
   $0 = "$appName <$file $proctitlesuffix"; # setproctitle

   $SIG{HUP} = sub {
	 printf LOG "%010d-%05d\trestart requested\n", time, $$;
	 exec($self, @ARGV)
      };
   $SIG{INT} = $SIG{TERM} = \&exit_due_to_signal;

   printf LOG "%010d-%05d\tstarted: %s\n", time, $$, Version_Strings::user_agent(@dependencies);
   printf LOG "%010d-%05d\tjobspec: %s\n", time, $$, $file;
   my($code, $comment, $tag, $s1, $s2, $s3) = scan_control_file($file);
   printf LOG "%010d-%05d\t%s\n", time, $$, $tag if $tag;
   printf LOG "%010d-%05d\tcode=%d (%s), comment=%s\n", time, $$,
      $code, (!$code? 'Ok': $code < 0? 'reject': 'freeze'), $comment;
   printf LOG "%010d-%05d\tspamdex=%d (%d/%d)\n", time, $$, $s3, $s1, $s2;
   printf "%d %s\n", $code, $comment;
}

## END of program
