#!/usr/bin/perl -w
#
# originally by Chris Hastie 
# 
# jhirsch 2004-08-24: write to temporary file and rename afterwards
# jhirsch 2005-02-11: create only lower-cased domain spool directories
#                     (and prevent a possible race condition)
# jhirsch 2006-06-24: qos support
#                     (by Pascal Lengard, pascal.lengard-at-gmail.com)
#
use strict;

# config section #############################################################

# define the spool directory beneath which individual domain
# spools are created.
my $spool_dir = "/var/spool/odmr";

# The default sender address used by the MTA when message
# has a null sender.
my $default_sender = 'MAILER-DAEMON@example-domain.invalid';

#  regexp to exctact score from header in $1
#my $spam_regexp = '^X-MailScanner-SpamCheck:.*score=([\d\.\-]+)';
my $spam_regexp = '';

# program code ###############################################################

# Default spam score
my $score = 0;

srand( time() ^ ($$ + ($$ << 15)) ); # Seed Random Number

sub mail_die ($$) {
   print STDERR $_[1]."\n";
   exit $_[0];
}

sub random_name ($) {
  my $score = shift;
  return sprintf("msg.%04d.%u.%u.%u", $score, time(), $$, (int(rand(100000)) + 1));
} 

# parse command line arguements.
my (%opt, $opt_idx, @rcpts);
foreach my $t (@ARGV) {
   if ($t =~ /^\-(\w)$/){
     $opt_idx = $1;
   } elsif ($opt_idx) {
     $opt{$opt_idx} = $t;
     $opt_idx = undef;
   } else {
     push @rcpts, $t;
   }
}

#die "no sender" unless $opt{f}; # empty sender address is valid
die "no nexthop" unless $opt{t};
die "no recipients" unless @rcpts;

# set sender to null if it's the MTA default
$opt{'f'} = '' if ($opt{'f'} eq $default_sender);

# if the domain's directory doesn't exist yet, create it.
my $dom_spool = $spool_dir . '/' . lc($opt{'t'});
if (!(-d $dom_spool)) {
  mkdir ($dom_spool) or mail_die (73, "Failed to create spool directory $dom_spool: $!");
}

# generate a unique filename for the message.
my $file;
do {
  $file = $dom_spool . '/temp.' . random_name('');
} while (-e $file);

open(MSG, ">" . $file) or mail_die (73, "Failed to open output file $file: $!");

print MSG "MAIL FROM: <" . $opt{'f'} . ">\r\n";

foreach my $rcpt (@rcpts ) {
  print MSG "RCPT TO: <$rcpt>\r\n";
}

print MSG "DATA\r\n";

my $out = "";
while (<STDIN>) {
  $out = $_;
  if ($spam_regexp and $out =~ /$spam_regexp/) {
    $score = (int($1) < 0) ? 0 : int($1);
  }
  print MSG $out;
}

if ( $out !~ /\r\n$/ )  { print MSG "\r\n"; }

print MSG ".\r\n";

close MSG;

# safe rename and delete of temp file
sleep 2;
while ( ! link($file, $dom_spool . '/' . random_name($score)) ) { sleep 1; }
unlink $file;