#!/usr/athena/bin/perl -w

#############################################
# Portions copyright 2001 by Craig Hughes   #
#############################################

my $PREFIX          = '/mit/bert/project/spam';
my $DEF_RULES_DIR   = '/mit/bert/project/spam/share/spamassassin';
my $LOCAL_RULES_DIR = '/mit/bert/project/spam/etc/mail/spamassassin';
use lib               '/mit/bert/project/spam/lib/site_perl/5.6.1';

use strict;
use Config;

use IO::Socket;
use IO::Handle;
use IO::Pipe;

use Mail::SpamAssassin;
use Mail::SpamAssassin::NoMailAudit;
use Mail::SpamAssassin::NetSet;

use Getopt::Long;
use Sys::Syslog qw(:DEFAULT setlogsock);
use POSIX qw(:sys_wait_h);
use POSIX qw(setsid);
use Errno;

use Cwd ();
use File::Spec 0.8;
use File::Path;

use Time::HiRes qw( time );

sub spawn;  # forward declaration
sub logmsg; # forward declaration

my %resphash = (
  EX_OK          => 0,  # no problems
  EX_USAGE       => 64, # command line usage error
  EX_DATAERR     => 65, # data format error
  EX_NOINPUT     => 66, # cannot open input
  EX_NOUSER      => 67, # addressee unknown
  EX_NOHOST      => 68, # host name unknown
  EX_UNAVAILABLE => 69, # service unavailable
  EX_SOFTWARE    => 70, # internal software error
  EX_OSERR       => 71, # system error (e.g., can't fork)
  EX_OSFILE      => 72, # critical OS file missing
  EX_CANTCREAT   => 73, # can't create (user) output file
  EX_IOERR       => 74, # input/output error
  EX_TEMPFAIL    => 75, # temp failure; user is invited to retry
  EX_PROTOCOL    => 76, # remote error in protocol
  EX_NOPERM      => 77, # permission denied
  EX_CONFIG      => 78, # configuration error
);

# defaults
my %opt = (
  'user-config' => 1,
  'ident-timeout' => 5.0,
);


# Testing for taintedness only works before detainting %ENV
Mail::SpamAssassin::Util::am_running_in_taint_mode();

# Parse the command line
Getopt::Long::Configure ("bundling");
GetOptions(
  'auto-whitelist|whitelist|a'  => \$opt{'auto-whitelist'},
  'max-children|m=i'            => \$opt{'max-children'},
  'virtual-config|V=s'          => \$opt{'virtual-config'},
  'virtual-config-dir=s'        => \$opt{'virtual-config-dir'},
  'username|u=s'                => \$opt{'username'},
  'vpopmail!'                   => \$opt{'vpopmail'},
    'v'                         => \$opt{'vpopmail'},
  'user-config'                 => \$opt{'user-config'},
    'nouser-config|x'           => sub{ $opt{'user-config'} = 0 },
  'debug!'                      => \$opt{'debug'},
    'D'                         => \$opt{'debug'},
  'local!'                      => \$opt{'local'},
    'L'                         => \$opt{'local'},
  'paranoid!'                   => \$opt{'paranoid'},
    'P'                         => \$opt{'paranoid'},
  'helper-home-dir|H:s'         => \$opt{'home_dir_for_helpers'},

);# or pod2usage(-exitval => $resphash{'EX_USAGE'}, -verbose => 0);

my $extrapid = 5000;

my $orighome;
if (defined $ENV{'HOME'}) {
  $orighome = $ENV{'HOME'};   # keep a copy for use by Razor, Pyzor etc.
  delete $ENV{'HOME'};        # we do not want to use this when running spamd
}

my $spamtest = Mail::SpamAssassin->new({
  dont_copy_prefs      => 1,
  debug                => 0,
  home_dir_for_helpers => $orighome,
  PREFIX               => $PREFIX,
  DEF_RULES_DIR        => $DEF_RULES_DIR,
  LOCAL_RULES_DIR      => $LOCAL_RULES_DIR
});

$spamtest->compile_now(0);	# ensure all modules etc. are loaded

sub check {
  my ($method, $version, $start) = @_;
  local ($_);
  my $expected_length;

  # Protocol version 1.0 and greater may have "User:" and
  # "Content-length:" headers.  But they're not required.

  if($version > 1.0)
    {
      while(1)
	{
	  $_ = $client->getline;
	  if(!defined $_)
	    {
	      protocol_error ("(EOF during headers)");
	      return 1;
	    }

	    if (/^\r\n/s) { last; }

	  if (/^User: (.*)\r\n/)
	    {
	      handle_user($current_user);
	    }
	  if (/^Content-length: ([0-9]*)\r\n/i) {
	    $expected_length = $1;
	  }
	}
    }

  if ( $setuid_to_user && $> == 0 )
    {
      if ($spamtest->{paranoid}) {
	logmsg "PARANOID: still running as root, closing connection.";
	die;
      }
      logmsg "Still running as root: user not specified with -u, ".
	"not found, or set to root.  Fall back to nobody.";
      my ($uid,$gid) = (getpwnam('nobody'))[2,3];
      $uid =~ /^(\d+)$/ and $uid = $1;	# de-taint
      $gid =~ /^(\d+)$/ and $gid = $1;	# de-taint

      $) = "$gid $gid"; # eGID
      $> = $uid; # eUID
      if ( !defined($uid) || ($> != $uid and $> != ($uid-2**32))) {
	logmsg "fatal: setuid to nobody failed";
	die;
      }
    }
  
  if ($opt{'sql-config'} && !defined($current_user)) {
    handle_user_sql('nobody');
  }

  my $resp = "EX_OK";
  
  # Now read in message
  my @msglines;
  my $actual_length = 0;
  my $msgid;
  while ($_ = $client->getline()) {
    if (($actual_length == 0) .. /^$/) {             # still in header
      if (/^Message-Id:\s+(.*?)\s*$/i) {
	$msgid = $1;
	while($msgid =~ s/\([^\(\)]*\)//) {};    # remove comments and
	$msgid =~ s/^\s+|\s+$//g;                # leading and trailing spaces
	$msgid =~ s/\s.*$//;                     # keep only the first token
      }
    }
    push(@msglines, $_);
    $actual_length += length;
    last if ($actual_length == $expected_length);
  }
  
  $msgid        ||= "(unknown)";
  $current_user ||= "(unknown)";
  logmsg(
	 ($method eq 'PROCESS' ? "processing" : "checking") .
	 " message $msgid for $current_user:$>."
	);
  
  my $mail = Mail::SpamAssassin::NoMailAudit->new (
						   data => \@msglines
						  );
  
  # Check length if we're supposed to
  if($expected_length && ($actual_length != $expected_length)) {
    protocol_error ("(Content-Length mismatch: Expected $expected_length bytes, got $actual_length bytes)");
    return 1;
  }
  
  # Now use copy-on-writed (hopefully) SA object
  my $status = $spamtest->check($mail);
  
  my $msg_score = sprintf("%.1f",$status->get_hits);
  my $msg_threshold = sprintf("%.1f",$status->get_required_hits);
  
  my $response_spam_status = "";
  my $was_it_spam;
  if ($status->is_spam) {
    $response_spam_status = $method eq "REPORT_IFSPAM" ? "Yes" : "True";
    $was_it_spam = 'identified spam';
  } else {
    $response_spam_status = $method eq "REPORT_IFSPAM" ? "No" : "False";
    $was_it_spam = 'clean message';
  }
  
  my $spamhdr = "Spam: $response_spam_status ; $msg_score / $msg_threshold";
  
  if ($method eq 'PROCESS') {
    $status->rewrite_mail; #if $status->is_spam;
    
    # Build the message to send back and measure it
    my $msg_resp = join '',$mail->header,"\n",@{$mail->body};
    my $msg_resp_length = length($msg_resp);
    if($version >= 1.3) # Spamc protocol 1.3 means multi hdrs are OK
      {
	print $client "SPAMD/1.1 $resphash{$resp} $resp\r\n",
	"Content-length: $msg_resp_length\r\n",
	$spamhdr."\r\n",
	"\r\n", $msg_resp;
      }
    elsif($version >= 1.2) # Spamc protocol 1.2 means it accepts content-length
      {
	print $client "SPAMD/1.1 $resphash{$resp} $resp\r\n",
	"Content-length: $msg_resp_length\r\n",
	"\r\n", $msg_resp;
      }
    else # Earlier than 1.2 didn't accept content-length
      {
	print $client "SPAMD/1.0 $resphash{$resp} $resp\r\n", $msg_resp;
      }
  }
  else		# $method eq 'CHECK' et al
    {
      print $client "SPAMD/1.1 $resphash{$resp} $resp\r\n"; 
      
      if($method eq "CHECK") {
        print $client "$spamhdr\r\n\r\n";
      }
      else {
        my $msg_resp = '';
	
        if($method eq "REPORT" or
	   ($method eq "REPORT_IFSPAM" and $status->is_spam))
	  {
	    $msg_resp = $status->get_report;
	  }
        elsif($method eq "REPORT_IFSPAM") {
	  # message is ham, $msg_resp remains empty
	}
	elsif($method eq "SYMBOLS") {
          $msg_resp = $status->get_names_of_tests_hit;
	  $msg_resp .= "\r\n" if ($version < 1.3);
        }
        else {
          die "unknown method $method";
        }
	
        if($version >= 1.3) # Spamc protocol > 1.2 means multi hdrs are OK
	  {
	    printf $client "Content-length: %d\r\n%s\r\n\r\n%s",
	    length($msg_resp), $spamhdr, $msg_resp;
	  }
	else {
	  printf $client "%s\r\n\r\n%s",
	  $spamhdr, $msg_resp;
	}
      }
    }

  logmsg "$was_it_spam ($msg_score/$msg_threshold) for $current_user:$> in ".
    sprintf("%.1f", time - $start) ." seconds, $actual_length bytes.";
  
  $status->finish();	# added by jm to allow GC'ing
}

sub handle_user
{
  my $username = shift;
  my $userid = '';
  $userid = $username;

  my ($name,$pwd,$uid,$gid,$quota,$comment,$gcos,$dir,$etc) =
    getpwnam($userid);
  my $cf_file = $dir."/.spamassassin/user_prefs";

  $spamtest->read_scoreonly_config ($cf_file);
  $spamtest->signal_user_changed ({ username => $username,
				    user_dir => $dir });
  return 1;
}

sub get_user_from_address {
   my ($user, $domain) = split(/@/, $_[0]);
   my $dom = lc($domain);

   if ( $qmailu{$dom} ne "" ) {
      warn "returning result from cache.\n" if ($opt{'debug'});
      my $nam = getpwuid($qmailu{$dom});
      return $nam;
   } else {
      warn "cache miss\n" if ($opt{'debug'});
      &fill_qmailu_cache($assign);
      if ( $qmailu{$dom} ne "" ) {
         my $nam = getpwuid($qmailu{$dom});
         return $nam;
      } else {
         return 0;
      }
   }
}

sub fill_qmailu_cache {
   # rather than parsing the qmail users/assign file every time a message
   # arrives, we run this once when spamd is loaded and check the files
   # modified time each query to know when to reload it.
        
   my ($READ, $WRITE) = (stat($_[0]))[8,9];
   if ( $WRITE > $qu_load ) {       
      undef %qmailu;
      $qu_load = time;       
      open(ASSIGN, $_[0]) || die "couldn't open $_[0]: $!\n";
         warn "loading $_[0] into cache...." if ($opt{'debug'});
         while(<ASSIGN>) {
            my @data = split(/:/, $_);
            $qmailu{$data[1]} = $data[2];
         };
         warn "done.\n" if ($opt{'debug'});
      close(ASSIGN);
   } else {
      warn "$_[0] already cached.\n" if ($opt{'debug'});
   }
}

sub logmsg
{
}

sub set_allowed_ip {
    foreach (@_) {
	$allowed_nets->add_cidr ($_) or die "Aborting.\n";
    }
}

sub ip_is_allowed {
    $allowed_nets->contains_ip (@_);
}