#!/usr/local/bin/perl
##
##	bottled_reply - serve files by email
##
##	Usage (in /etc/aliases):
##		owner-alias: bounceaddr
##		alias: "|progpath alias replydir bounceaddr"
##	or
##		alias: "|progpath alias replydir bounceaddr", /archive
##	where:
##
##	- progpath = full pathname of this script
##
##	- alias = name of alias @ actual host,
##		like: book-info-request@online.ora.com
##
##	- replydir = directory containing files we're allowed to send
##		back to the user. The file "default" in that directory
##		is sent if we no get request is included.
##		File should start with NO BLANK LINE, then From:, Subject:
##		and any other header except To: (which this program fills in).
##		Then, before message in file, put a single blank line.
##
##	- bounceaddr = address (envelope sender) to send bounces to
##
##	- /archive = full pathname of archive file to save all incoming messages
##		(usually needs to be mode 666 unless no messages come from local host)
##
##		by Alan Schwartz 5/16/96
##		based on canned_reply by Jerry Peek, 8/17/93


# TABSTOPS IN THIS SCRIPT SET AT 4 (IN vi, USE :se ts=4 sw=4)

# Modify $mailer for your system if necessary:
$mailer = "/usr/lib/sendmail -f$ARGV[2] -oi";
$* = 1;

#
#
$replydir = $ARGV[1];

#
# If wrong number of args or unreadable canned reply file,
# send error and sender's mail message to postmaster:
#
complain_and_die("need 3 arguments, got:\n\t@ARGV") if (scalar(@ARGV) != 3);
complain_and_die("Direcotry $replydir not a full path") 
  unless $replydir =~ m#^/#;
complain_and_die("no directory $replydir") unless -d $replydir;
complain_and_die("can't search $replydir") unless chdir($replydir);

#
# Read (only) header into the variables $from (for envelope sender)
# and $header (for the rest of the header)
#
while (<STDIN>) {
	last if /^$/;
	# Make key lower-case:
	if (/^From /) {
		# listproc system is case-sensitive on first line;
		# if it's "from" instead of "From", it's a syntax error.
		# So, save From line separately.
		@from = (split(/^([-\w]+)[ 	]*/));
	}
	elsif (/^\S/) {
		@part = (split(/^([-\w]+:?)[ 	]*/));
		$part[1] =~ tr/A-Z/a-z/;
		$header .= "$part[1] $part[2]";
	}
	else {
		$header .= $_;
	}
}

#
# Put headers into array.  Note: values (but not keys) end with newlines.
# (Adapted from "Programming Perl" chapter 4.)
# Note: loses multiple lines with same key (like Received:):
#
$header =~ s/\n\s+/ /g;      # Merge continuation lines.
%head = ('FRONTSTUFF', split(/^([-\w]+:?)[ 	]*/, $header));

# Now we can read body from <STDIN> if we need to...

#
# Get address to use:
#
if (defined($head{'reply-to:'})) {
	$useaddr = $head{'reply-to:'};
}
elsif (defined($head{'from:'})) {
	$useaddr = $head{'from:'};
}
elsif (defined($head{'apparently-from:'})) {
	$useaddr = $head{'apparently-from:'};
}

# 
# Does the subject contain "get filename"?
#
if ($head{'subject:'} =~ /^get\s+(\S+)\s+$/) {
  $filename = $1;
  if ($filename =~ m#^[\./]# || $filename =~ m#..# 
      || $filename =~ m#[^-\w\.]#) {
    $reply = "Bad filename: $filename\n";
  } elsif (! open(REPLY, $filename)) {
    $reply = "No such file: $filename\n";
  } 
} elsif (! open(REPLY,"default")) {
  $reply = "I don't know what to send you.\n";
}

#
# If we got an address, use it.  Else, bounce to bounceaddr:
#
if (defined($useaddr)) {
	chop $useaddr;
	open(MAIL, "|$mailer -t") || die;
	print MAIL "To: $useaddr\n";
	if ($reply) {
	  print MAIL "Subject: file server error\n";
	  print MAIL "\n";
	  print MAIL $reply,"\n";
	} else {
	  # REPLY file may start with From:, Subject:; MUST then have blank line:
	  print MAIL <REPLY>;
	}
	print MAIL "\n\n ----------- Your original message is below ----------\n\n";
	print MAIL <STDIN>;
	close(MAIL);
	close(REPLY) unless $reply;
}
else {
	# BOUNCE TO bounceaddr
	open(MAIL, "|$mailer $ARGV[2]") || die;
	print MAIL "$0 aborting: can't find address to reply to.\n\n";
	print MAIL "Would have sent: $reply\n" if $reply;
	# End string with > to prefix the From line in the message:
	print MAIL "This message needs a reply:\n\n>";
	print MAIL <STDIN>;
	close(MAIL);
}
exit(0);	# We don't want sender to know that something went wrong

sub complain_and_die {
  local($complaint) = $_[0];
  open(MAIL, "|$mailer postmaster") || die;
  print MAIL "$0 aborting from '$ARGV[0]' alias:\n\t$complaint\n\n";
  # End string with > to prefix the From line in the message:
  print MAIL "This message needs a reply:\n\n>";
  print MAIL <STDIN>;
  close(MAIL);
  exit(0);	# We don't want sender to know that something went wrong
}