#!/usr/local/bin/perl
# $Id: sendmail.wrapper,v 1.26 2015/09/08 15:22:23 thend20 Exp $

=head1 NAME

sendmail - filters calls before handing off to either postfix or qmail's sendmail wrapper

=cut

use strict;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Mail::Address;

# maximum recipients for users, and nobody
my $MAX_RECIPS    = 10000; # effectively disable for now
my $NOBODY_RECIPS = 30;
my $DATE          = "/bin/date";
my $HOSTNAME      = "/bin/hostname";
my $PS            = "/bin/ps";

# Environment variables in order of highest precedence to lowest
my @HOST_ENV_VARS = qw(QMAILSHOST QMAILHOST MAILHOST);
my @USER_ENV_VARS = qw(QMAILSUSER QMAILUSER MAILUSER USER LOGNAME);

# Use this user if no user env var found
my $DEFAULT_USER = 'anonymous';

# determine which mail system to use
my $DETECT_QMAIL_PATH = '/etc/sendmail.wrapper.qmail';  # use qmail if present
my $SENDMAIL_SYSTEM = ("@ARGV" =~ /-qmail/ or -e $DETECT_QMAIL_PATH) ?
                      'qmail' : 'postfix';
my $QMAIL_PATH = '/var/qmail/bin/sendmail';
my $POSTFIX_PATH = '/usr/sbin/sendmail.postfix';
my $SENDMAIL = ( $SENDMAIL_SYSTEM eq 'postfix' ? $POSTFIX_PATH : $QMAIL_PATH );

# we have to untaint path in case setuid script is calling us
$ENV{PATH} = '/usr/sbin:/bin';

# hack for the webmail servers
$NOBODY_RECIPS = 50 if (`$HOSTNAME` =~ /webmail/);

# remove any custom set timezone
delete $ENV{TZ};

# loop protection
if ($QMAIL_PATH eq $0 or $POSTFIX_PATH eq $0) {
    die "I loop back to myself!";
}

# if -bs was used, we need to bail as we don't emulate it
exec($SENDMAIL,@ARGV) if "@ARGV" =~ /-bs/;

# syslog initialization
setlogsock('unix');

if ($> == 65534) { $MAX_RECIPS = $NOBODY_RECIPS; }

my $NUM_RECIPS;
my $HEADER_CACHE;

if ("@ARGV" =~ /\-t/) { # we need to count recipients inside
  my $to = '';
  my $toline = 0;
  my $tofields = 0;
  while (<STDIN>) {
    if (/^\s*$/) { last; }
    $toline = 0 unless /^\s/;
    $HEADER_CACHE .= $_;
    chomp;
    if (/^\s*(to|cc|bcc):(.*)/i) {
      $to and $to .= ',';
      $to .= " $2";
      $to =~ s/,\s*$//; # don't penalize for trailing comma
      $tofields++;
      $toline = 1; # look for continuation lines
    }
    if ((/^\s/) && ($toline == 1)) {
      $to =~ s/,\s*$//; # don't penalize for trailing comma
      $to .= ",$_";
    }
  }

  my @addr = Mail::Address->parse($to);
  $NUM_RECIPS = scalar(@addr); 
}

# count non-flag recipients on commandline
$NUM_RECIPS += scalar grep(!/^-/,@ARGV);

# count commas on command line
$NUM_RECIPS += (join('',@ARGV) =~ y/,;//);

# overall, this errs on the cautious side, since we could have commas on
# the commandline without indicating extra recipients, either like this:
# sendmail address1, address2
# or using a full name format that contains a comma

# prepare logging data 
my $ppid = getppid();
my $LOGLINE = "pid: $$ ppid: $ppid uid: $> ";
if ($ENV{REMOTE_ADDR}) { # we have Apache's env
  $LOGLINE .= "script: $ENV{SCRIPT_FILENAME} remote: $ENV{REMOTE_ADDR} " .
              "local: $ENV{SERVER_ADDR} query: " . 
              ($ENV{QUERY_STRING} || '[none]') . " ";
} else {
  $LOGLINE .= "remote: [none] ";
  if ($ppid > 1) {
    chomp(my @pps = `$PS wweo lstart,ppid,command -p $ppid 2>/dev/null`);
    my @x = split(/\s+/,$pps[1]);
    my $pdate = join(' ',@x[0..4]);
    my $pcmd = join(' ',@x[6..$#x]);
    $LOGLINE .= "parent: $pdate pppid: $x[5], pcmd: $pcmd ";
    if ($x[5] > 1) {
      $x[5] =~ /^(.+)$/; # have to untaint though we trust /bin/ps
      chomp(@pps = `$PS wweo command -p $1 2>/dev/null`);
      $LOGLINE .= "parent2: $pps[1] ";
    }
  }
}
$LOGLINE .= "recips: $NUM_RECIPS (max $MAX_RECIPS) ";

# die if too many recipients
if ($NUM_RECIPS > $MAX_RECIPS) { 
  log_line("[BLOCKED] $LOGLINE\n");
  die "Too many recipients.\n";
} 

log_line("$LOGLINE\n");

# send mail
if ($SENDMAIL_SYSTEM eq 'postfix') {
    my @postfix_options = @ARGV;
    $ENV{NAME} ||= ''; # prevent GECOS in From:
    unshift(@postfix_options, "-f " . generate_sender())
        unless "@ARGV" =~ /-f/;
    open(P1, "|-", $POSTFIX_PATH, @postfix_options)
        or die "Could not open Postfix in path $POSTFIX_PATH";
} else {
    open(P1, "|-", $QMAIL_PATH, @ARGV)
        or die "Could not open QMail in path $QMAIL_PATH";
}

print P1 "$HEADER_CACHE\n" if defined($HEADER_CACHE);
while (<STDIN>) {
  print P1;
}
close(P1);

# use the exit value of piped subprocess
exit($?);

sub log_line {
  openlog('sendmail_wrapper','pid,nowait','mail');
  for my $line (@_) { eval { syslog('notice',"%s",$line) } }
  closelog();
}

# Return first found environment variable
sub get_env_var {
    my @env_vars = @_;
    
    map { return $ENV{$_} if defined $ENV{$_} } @env_vars;

    return 0;  # didn't find any set env vars
}

# Construct sender address from environment variables
sub generate_sender {
    my $user = get_env_var(@USER_ENV_VARS)
        || $DEFAULT_USER;

    my $host = get_env_var(@HOST_ENV_VARS)
        || `$HOSTNAME`;

    return $user . '@' . $host;
}