#!/usr/bin/perl
# Filename:     forge_pipe
# Author:       David Ljung
# Description:  Forges raw email through a pipe to sendmail
#
# chown root:root forge_pipe
# chmod 4755 forge_pipe
use strict;
use English;

$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

my $SENDMAIL="/usr/lib/sendmail";

##################################################
# Usage
##################################################
sub usage {
  my $msg;
  foreach $msg (@_) { print "ERROR:  $msg\n"; }
  print "\n";
  print "Usage:\t$MAIN::PROGNAME -f <from> -F <from_full> <-t|to> [message_file]\n";
  print "\tForges a raw mail message\n";
  print "\t-f\tFrom address\n";
  print "\t-F\tFrom full name\n";
  print "\t-ignore_headers\tSkip headers in the message file\n";
  print "\n";
  exit -1;
}

sub parse_args {
  my ($from,$from_full,$to,$file);

  while ($#ARGV>=0) {
    $a=shift(@ARGV);
    if($a =~ /^-h$/) { &usage; }
    if($a =~ /^-f$/) { $from=shift(@ARGV); next; }
    if($a =~ /^-F$/) { $from_full=shift(@ARGV); next; }
    if($a =~ /^-ignore_headers$/) { $MAIN::SKIP_HEADERS=1; next; }
    if($a =~ /^-t$/) { $to="-t"; next; }
    if($a =~ /^-i$/) { next; }          # Ignore this
    if($a =~ /^-/) { &usage("Unknown option: $a"); }

    usage("Too many files specified") if ($to && $file);
    ($to) ? $file = $a : $to = $a;
  }

  usage("Need to specify -f <from>") unless $from;
  $from_full = $from unless $from_full;
  usage("Need to specify <to> address") unless $to;
  push(@ARGV,$file) if $file;

  # Get around taint
  $from=$1 if $from =~ m/(.*)/;
  $from_full=$1 if $from_full =~ m/(.*)/;
  $to=$1 if $to =~ m/(.*)/;

  ($from,$from_full,$to);
}

##################################################
# Main code
##################################################
sub main {
  my ($from,$from_full,$to) = parse_args();

  # Get message
	if ($MAIN::SKIP_HEADERS) {
		while (<>) { last if /^$/; }
	}

  my @msg = <>;

  my ($SAVE_UID,$SAVE_GID) = ($UID,$GID);
  ($UID,$GID) = ($EUID,$EGID);	# XXX: initgroups() not called

  ## This doesn't work under taint
  #open(SEND,"| $SENDMAIL -i -f $from -F \"$from_full\" $to")
  #|| die("[$PROGNAME] Couldn't start sendmail [$SENDMAIL]\n");

  #########################
  # Safely pipe to sendmail
  my $pid = open(SEND,"|-");
  die("[$PROGNAME] Couldn't fork!\n") unless defined $pid;
  $SIG{ALRM} = sub { die "[$PROGNAME] Pipe to $SENDMAIL broke\n" };

  unless ($pid) {
    # Child
    exec($SENDMAIL,"-i","-f",$from,"-F",$from_full,$to)
    || die("[$PROGNAME] Can't exec $SENDMAIL");
  }
  #########################

  print SEND @msg;
  close SEND;

  ($UID,$GID) = ($SAVE_UID,$SAVE_GID);
} main();