#!/usr/local/bin/perl
#
# this script was modified from fml-1.5 m(..)m
#
# CAUTION, This script not tested for DISK FULL case,
#                           or wrong format mail.
#
# If spam come, that cause to return error mail by sendmail.
#
# for testing,   % kreject.pl < maildata
# start line of maildata must be "From mail@address.domain"
#
# and for a while, please test .forward by `\yourname,"|kreject.pl"'
# for not to lost your mail. ( and see, man vacation)

#$debug = 1;

$LOGFILE = "kreject.log";   # may be fullpath need.
$SPOOLFILE = "mspool";      # /var/mail/your_name


$ENV{'PATH'}  = '/bin:/usr/ucb:/usr/bin';   # or whatever you need
$ENV{'SHELL'} = '/bin/sh';

umask 0x77; # is this ok?

# buffering mail header

&Parsing;               # Phase 1(1st pass), pre-parsing here
&GetFieldsFromHeader;   # Phase 2(2nd pass), extract headers

$SPAMMER = 0;

&checkspam;

if ($SPAMMER)
{ 
   &Logspam;
   exit(1);   # cause sendmail error return
}

&savemail;  # save mail to SPOOL

exit 0;            # the main ends.
#################### MAIN ENDS ####################


# buffering mail header for spam check.

sub Parsing
{
   while (<STDIN>)
   {
      $MailHeaders .= $_;
      if (/^$/o)
      {  # Header block end
         return;
      }
   }

#  if (/^$/) not found, may be bug, but ignore.
}

# Phase 2(2nd pass), extract several fields

sub GetFieldsFromHeader
{
   local($s) = $MailHeaders;
   local($field, $contents);

   #  These two lines are tricky for folding and unfolding.
   $s =~ s/\n(\S+):/\n\n$1:\n\n/g;
   local(@MailHeaders) = split(/\n\n/, $s, 999);

   while (@MailHeaders)
   {
      $_ = $field = shift @MailHeaders;
      print STDERR "FIELD:          >$field<\n" if $debug;

      # UNIX FROM is a special case.
      if (/^From /io)
      {   next;
      }

      $contents = shift @MailHeaders;
      $contents =~ s/^\s+//; # cut the first spaces of the contents.

      print STDERR "FIELD CONTENTS: >$contents<\n" if $debug;

      next if /^$/o;      # if null, skip. must be mistakes.

      # filelds to use later.
      /^Message-Id:$/io     && ($Message_Id = $contents, next);
      /^Subject:$/io        && ($Subject = $contents, next);
      /^From:$/io           && ($From = $contents, next);
      /^Content-Type:$/io   && ($C_Type = $contents, next);

   }# end of while loop;
}

# case of mail ok, then save to mailspool

sub savemail    # save mail to SPOOL
{
   if( !open(MSPOOL, ">> $SPOOLFILE") )
   {  printf STDERR "SPOOL open error \n";
      printf STDERR "SPOOL open error ERROR \n";
      exit(7);
   }

   select(MSPOOL);

   print MSPOOL $MailHeaders;

   # copy rest of mail body
   while (<STDIN>)
  {
      print MSPOOL $_;
  }
  print MSPOOL "\n" ; # 2002/06/18 18:02 add
  close(MSPOOL);
}

# Logging(String as message)

sub Logspam
{
##    local($str, $e) = @_;

    open(LOGFILE, ">> $LOGFILE");
    select(LOGFILE); $| = 1; select(STDOUT);
    print LOGFILE "spam from: $From \n" ;
    print LOGFILE "     message-id: $Message_Id \n" ;
    close(LOGFILE);
}

sub checkspam
{

##   $_ = $Message_Id;
##   /telenews.teleline.es/io   && ($SPAMMER = 1, return);

   $_ = $C_Type;
   /ks_c_5601-1987/io         && ($SPAMMER = 1, return);
   /euc-kr/io                 && ($SPAMMER = 1, return);
   /GB2312/io                 && ($SPAMMER = 1, return);

# 2002/07/20  add, multipart check.

   if (/multipart/io)
   {
      $_ = $From; # if root, then must not reject.

      /mailer/io       && (return);
      /root/io         && (return);
      /postmaster/io   && (return);

      $_ = $Subject;  # check for subject.

      /ks_c_5601/io    && ($SPAMMER = 1, return);
      /gb2312/io       && ($SPAMMER = 1, return);

      # 8bit code subject check. (ex. 0xb1a4 0xb0ed )

      /[\xb0-\xb1]/   && ($SPAMMER = 1, return);

   }

}

# 1;