#!/usr/local/bin/perl
#
# Vacation program
#
# Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
#
# updates by Tom Christiansen <tchrist@convex.com>
#
# new updates by Stephane Bortzmeyer <bortzmeyer@pasteur.fr>
# This new version is made to be used form procmail which takes
# care of many things.
# It is no longer interactive. Edit the ~/.vacation.msg and ~/.forward 
# by hand.

$debug = 0;

$vacation = $0;
$vacation = '/usr/local/bin/vacation' unless $vacation =~ m#^/#;

$user = $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwuid($>))[0];

$default_msg = <<'EOF';
I will not be reading my mail for a while.
Your mail regarding "$SUBJECT" will be read when I return.
EOF


if (!@ARGV) {	
    die "not interactive";
}

@ignores = ( 
	'daemon', 
	 'postmaster', 
	 'mailer-daemon', 
	 'mailer',
	 'root',
         'http',
         'news',
	 'usenet'
     );

# set-up time scale suffix ratios
%scale = (
	's', 1,
	'm', 60,
	'h', 60 * 60,
	'd', 24 * 60 * 60,
	'w', 7 * 24 * 60 * 60,
    );

if ($debug) {
    print STDERR "Starting...\n";
}

while ($ARGV[0] =~ /^-/) {
    $_ = shift;
    if (/^-m(.*)/) {  
	$from_me = ($1 ? $1 : shift);
    } elsif (/^-j/) {
	$opt_j++;
    } elsif (/^-f(.*)/) {
	&save_file($1 ? $1 : shift);
    } elsif (/^-a(.*)/) {
	&save_alias($1 ? $1 : shift);
    } elsif (/^-s(.*)/) {
	$domain = ($1 ? $1 : shift);
    } elsif (/^-t([\d.]*)([smhdw])/) {
	$timeout = $1;
	$timeout *= $scale{$2} if $2;
    } else {
	die "Unrecognized switch: $_\n";
    }
}


$user = shift;
push(@ignores, $user);
push(@aliases, $user);
die "Usage: vacation username\n" if $user eq '' || @ARGV;

$home = (getpwnam($user))[7];
die "No home directory for user $user\n" unless $home;
chdir $home || die "Can't chdir to $home: $!\n";

$timeout = 7 * 24 * 60 * 60 unless $timeout;

if ($debug) {
    print STDERR "Opening database...\n";
}

dbmopen(%VAC, ".vacation", 0666) || die "Can't open vacation dbm files: $!\n";


$/ = '';			# paragraph mode
$header = <>;
$header =~ s/\n\s+/ /g;		# fix continuation lines
$* = 1;

exit if $header =~ /^Precedence:\s*(bulk|junk)/i;
exit if $header =~ /^(Sender|From):.*-REQUEST@/i;

for (@ignores) {
    exit if $header =~ /^From:.*\b$_\b/i;
} 

#($from) = ($header =~ /^From\s+(\S+)/);	# that's the Unix-style From line
($from) = ($header =~ /^From:\s+(.*)/i);
#die "No \"From\" line!!!!\n" if $from eq "";

#($reply_to) = ($header =~ /^Reply-To:\s+(.*)/i);
#($sender) = ($header =~ /^Sender:\s+(.*)/i);
#$reply_address = $reply_to || $from || $sender; # This is the order given by RFC 822
#die "Nowhere to reply to!!!" if $reply_address eq "";

($return_path) = ($header =~ /^Return-Path:\s+(.*)/i);
$reply_address = $return_path; # This is the order given by RFC 3834
die "Nowhere to reply to!!!" if $reply_address eq "";

($subject) = ($header =~ /^Subject:\s+(.*)/);
$subject = "(No subject)" unless $subject;
$subject =~ s/\s+$//;

($to) = ($header =~ /^To:\s+(.*)/i);
($cc) = ($header =~ /^Cc:(\s+.*)/i);
#$to .= ', '. $cc if $cc;

if ($debug) {
    print STDERR "Opening message...\n";
}

if ($domain) {
    $file = ".vacation-$domain.msg";
}
else {
    $file = ".vacation.msg";
}
if (open(MSG,$file)) {
    undef $/;
    $msg = <MSG>;
    close MSG;
} else {
    $msg = $default_msg;
} 
$msg =~ s/\$SUBJECT/$subject/g;		# Sun's vacation does this

unless ($opt_j) {
    foreach $name (@aliases) {
	if ($debug) {
	    print STDERR "Checking $name against $to, ok is $ok\n";
	}
	$ok++ if $to =~ /\b$name\b/i;
    }
    exit unless $ok;
}

$lastdate = $VAC{$reply_address}; # The only problem is if there are several addresses
   # in a Reply-To...
$now = time;
if ($lastdate ne '') {
    ($lastdate) = unpack("L",$lastdate);
    exit unless $lastdate;
    exit if $now < $lastdate + $timeout;
}

$VAC{$reply_address} = pack("L", $now);
dbmclose(%VAC);

if ($debug) {
    print STDERR "Replying to $reply_address\n";
}

open(MAIL, "|/usr/sbin/sendmail -oi -t") || die "Can't run sendmail: $!\n";
# Test
#open(MAIL, "|/usr/ucb/cat ") || die "Can't run cat: $!\n";

if ($from_me) {
	print MAIL "From: $from_me\n";
}
print MAIL <<EOF;
To: $reply_address
Subject: This is a recording... [Re: $subject]
Precedence: junk
Auto-Submitted: auto-replied
Mime-Version: 1.0
Content-Type: text/plain; charset=iso-8859-15
Content-Transfer-Encoding: 8bit

EOF
print MAIL $msg;
close MAIL;
exit;

sub save_file {
    local($FILE) = @_;
    local($_);

    open (FILE) || die "can't open $FILE: $!";

    while (<FILE>) {
	push(@ignores, split);
    } 
    close FILE;
} 

sub save_alias {
      push (@aliases, @_);
      # If sendmail rewrites addresses, it's better to assume that aliases
      # can be used in From field too:
      push (@ignores, @_);
}