512 lines
8.9 KiB
Plaintext
512 lines
8.9 KiB
Plaintext
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: vacation.pl,v 1.3 1999/01/04 04:28:17 psamuel Exp $
|
||
|
|
#
|
||
|
|
# Vacation program for qmail. Based on the original version for
|
||
|
|
# sendmail by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> and Tom
|
||
|
|
# Christiansen <tchrist@convex.com>.
|
||
|
|
#
|
||
|
|
# The original is available from CPAN as
|
||
|
|
#
|
||
|
|
# CPAN/scripts/mailstuff/vacation
|
||
|
|
#
|
||
|
|
# This version by Peter Samuel <peter@uniq.com.au>
|
||
|
|
#
|
||
|
|
# Minor changes by Daniel van Raay <danielvr@caa.org.au>
|
||
|
|
#
|
||
|
|
|
||
|
|
###########################################################################
|
||
|
|
|
||
|
|
use DB_File;
|
||
|
|
require 5;
|
||
|
|
$check_to_and_cc = 1;
|
||
|
|
$dot_vacation_prefix = "";
|
||
|
|
|
||
|
|
###########################################################################
|
||
|
|
#
|
||
|
|
# Process any command line arguments.
|
||
|
|
|
||
|
|
while ($ARGV[0] =~ /^-/)
|
||
|
|
{
|
||
|
|
$_ = shift;
|
||
|
|
|
||
|
|
if (/^-I/i)
|
||
|
|
{
|
||
|
|
&initialise();
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
|
||
|
|
if (/^-n/)
|
||
|
|
{
|
||
|
|
$no_msg_no_reply = 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
if (/^-j/)
|
||
|
|
{
|
||
|
|
$check_to_and_cc = 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
if (/^-s/)
|
||
|
|
{
|
||
|
|
chdir;
|
||
|
|
&get_user_details();
|
||
|
|
&show_dbm_file("$dbm_file");
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
|
||
|
|
if (/^-t([\d.]*)([smhdw])/)
|
||
|
|
{
|
||
|
|
&time_scales();
|
||
|
|
$timeout = $1;
|
||
|
|
$timeout *= $scale{$2} if $2;
|
||
|
|
}
|
||
|
|
|
||
|
|
if (/^-p*/)
|
||
|
|
{
|
||
|
|
$dot_vacation_prefix = $1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
&interactive() if (! scalar @ARGV);
|
||
|
|
|
||
|
|
###########################################################################
|
||
|
|
#
|
||
|
|
# Process incoming mail. Qmail provides a number of environment
|
||
|
|
# variables that detail the properties of the incoming mail message.
|
||
|
|
|
||
|
|
# Qmail always supplies $DTLINE. If it isn't set then we probably
|
||
|
|
# aren't being called by qmail.
|
||
|
|
exit(0) unless $ENV{'DTLINE'};
|
||
|
|
|
||
|
|
$rpline = $ENV{'RPLINE'};
|
||
|
|
$ufline = $ENV{'UFLINE'};
|
||
|
|
exit(0) if ($ufline =~ /-REQUEST\@/i);
|
||
|
|
exit(0) if ($rpline =~ /-REQUEST\@/i);
|
||
|
|
|
||
|
|
$home = $ENV{'HOME'};
|
||
|
|
$host = lc($ENV{'HOST'});
|
||
|
|
$sender = lc($ENV{'SENDER'});
|
||
|
|
$user = lc($ENV{'USER'});
|
||
|
|
|
||
|
|
$timeout = 60 * 60 * 24 * 7 unless $timeout;
|
||
|
|
|
||
|
|
chdir;
|
||
|
|
&get_program_details();
|
||
|
|
&check_ignores();
|
||
|
|
&check_headers();
|
||
|
|
&check_lastdate("$dbm_file");
|
||
|
|
&send_reply();
|
||
|
|
exit(0);
|
||
|
|
|
||
|
|
###########################################################################
|
||
|
|
|
||
|
|
sub interactive
|
||
|
|
{
|
||
|
|
chdir;
|
||
|
|
&get_user_details();
|
||
|
|
|
||
|
|
if (-f "$dot_qmail_file")
|
||
|
|
{
|
||
|
|
print
|
||
|
|
"You have a $dot_qmail_file in your home directory containing:\n\n";
|
||
|
|
|
||
|
|
&cat_file("$dot_qmail_file");
|
||
|
|
|
||
|
|
print "\n";
|
||
|
|
|
||
|
|
print "Would you like to remove it and disable the vacation feature?";
|
||
|
|
|
||
|
|
if (&yesno())
|
||
|
|
{
|
||
|
|
&delete_qmail_file("$dot_qmail_file");
|
||
|
|
&show_dbm_file("$dbm_file");
|
||
|
|
&clear_dbm_file("$dbm_file");
|
||
|
|
print "\nBack to normal reception of mail.\n";
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
|
||
|
|
print << "EOF";
|
||
|
|
Mail is still under the control of your $dot_qmail_file file.
|
||
|
|
EOF
|
||
|
|
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
|
||
|
|
print << "EOF";
|
||
|
|
This program can be used to answer your mail automatically
|
||
|
|
when you go away on vacation.
|
||
|
|
|
||
|
|
EOF
|
||
|
|
|
||
|
|
if (-f "$message_file")
|
||
|
|
{
|
||
|
|
print "You already have a message file in $home/$message_file.\n";
|
||
|
|
|
||
|
|
if (&yesno("Would you like to see it?"))
|
||
|
|
{
|
||
|
|
&show_file("$message_file");
|
||
|
|
}
|
||
|
|
|
||
|
|
if (&yesno("Would you like to edit it?"))
|
||
|
|
{
|
||
|
|
&edit_file("$message_file");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
&create_msg_file("$message_file", "$vacation_msg");
|
||
|
|
|
||
|
|
print << "EOF";
|
||
|
|
A default vacation message has been created in $home/$message_file.
|
||
|
|
This message will be automatically returned to anyone sending you mail
|
||
|
|
while you're away.
|
||
|
|
|
||
|
|
EOF
|
||
|
|
|
||
|
|
if (&yesno("Would you like to see it?"))
|
||
|
|
{
|
||
|
|
&show_file("$message_file");
|
||
|
|
}
|
||
|
|
|
||
|
|
if (&yesno("Would you like to edit it?"))
|
||
|
|
{
|
||
|
|
&edit_file("$message_file");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
print << "EOF";
|
||
|
|
|
||
|
|
To enable the vacation feature a $home/$dot_qmail_file file is created.
|
||
|
|
EOF
|
||
|
|
|
||
|
|
if (&yesno("Would you like to enable the vacation feature now?"))
|
||
|
|
{
|
||
|
|
&create_qmail_file("$dot_qmail_file", "$dot_qmail_commands");
|
||
|
|
&clear_dbm_file("$dbm_file");
|
||
|
|
|
||
|
|
print << "EOF";
|
||
|
|
|
||
|
|
The vacation feature has been enabled. Please remember to turn it off
|
||
|
|
when you return. Bon voyage!
|
||
|
|
EOF
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
print "\nThe vaction feature has not been enabled.\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub initialise
|
||
|
|
{
|
||
|
|
chdir;
|
||
|
|
&get_user_details();
|
||
|
|
&clear_dbm_file("$dbm_file");
|
||
|
|
&create_msg_file("$message_file", "$vacation_msg");
|
||
|
|
&create_qmail_file("$dot_qmail_file", "$dot_qmail_commands");
|
||
|
|
exit(0);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub edit_file
|
||
|
|
{
|
||
|
|
my($file) = @_;
|
||
|
|
|
||
|
|
system("$editor $file");
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cat_file
|
||
|
|
{
|
||
|
|
my($file) = @_;
|
||
|
|
|
||
|
|
open(FILE, "$file");
|
||
|
|
print while(<FILE>);
|
||
|
|
close(FILE);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub show_file
|
||
|
|
{
|
||
|
|
my($file) = @_;
|
||
|
|
|
||
|
|
system("$pager $file");
|
||
|
|
}
|
||
|
|
|
||
|
|
sub show_dbm_file
|
||
|
|
{
|
||
|
|
my($file) = @_;
|
||
|
|
local(%DBM); # Can't be my()
|
||
|
|
my($key);
|
||
|
|
require "ctime.pl";
|
||
|
|
|
||
|
|
open(PAGER, "| $pager");
|
||
|
|
|
||
|
|
print PAGER << "EOF";
|
||
|
|
Welcome back!
|
||
|
|
While you were away, vacation mail was sent to the following addresses:
|
||
|
|
|
||
|
|
EOF
|
||
|
|
|
||
|
|
dbmopen(%DBM, "$file", 0644);
|
||
|
|
|
||
|
|
foreach $key (sort keys %DBM)
|
||
|
|
{
|
||
|
|
print PAGER "$key\n";
|
||
|
|
print PAGER " ", ctime(unpack("L", $DBM{$key}));
|
||
|
|
}
|
||
|
|
|
||
|
|
dbmclose(%DBM);
|
||
|
|
close(PAGER);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub clear_dbm_file
|
||
|
|
{
|
||
|
|
my($file) = @_;
|
||
|
|
local(%DBM); # Can't be my()
|
||
|
|
|
||
|
|
dbmopen(%DBM, "$file", 0644);
|
||
|
|
|
||
|
|
undef %DBM;
|
||
|
|
|
||
|
|
dbmclose(%DBM);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub create_msg_file
|
||
|
|
{
|
||
|
|
my($file, $msg) = @_;
|
||
|
|
|
||
|
|
open(MSG, "> $file");
|
||
|
|
|
||
|
|
print MSG $msg;
|
||
|
|
close(MSG);
|
||
|
|
chmod(0644, $file);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub create_qmail_file
|
||
|
|
{
|
||
|
|
my($file, $msg) = @_;
|
||
|
|
|
||
|
|
open(MSG, "> $file");
|
||
|
|
|
||
|
|
print MSG $msg;
|
||
|
|
close(MSG);
|
||
|
|
chmod(0644, $file);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub delete_qmail_file
|
||
|
|
{
|
||
|
|
my($file) = @_;
|
||
|
|
|
||
|
|
unlink("$file");
|
||
|
|
}
|
||
|
|
|
||
|
|
sub yesno
|
||
|
|
{
|
||
|
|
my($msg) = @_;
|
||
|
|
my($answer);
|
||
|
|
|
||
|
|
while (1)
|
||
|
|
{
|
||
|
|
print "$msg [y/n] ";
|
||
|
|
$answer = <STDIN>;
|
||
|
|
last if $answer =~ /^[yn]/i;
|
||
|
|
}
|
||
|
|
|
||
|
|
$answer =~ /^y/i;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_common_details
|
||
|
|
{
|
||
|
|
$message_file = $dot_vacation_prefix . ".vacation.msg";
|
||
|
|
$dbm_file = $dot_vacation_prefix . ".vacation";
|
||
|
|
|
||
|
|
$vacation_msg = << 'EOF'; # Must use single quotes
|
||
|
|
Subject: away from my mail
|
||
|
|
|
||
|
|
I will not be reading my mail for a while. Your mail regarding
|
||
|
|
|
||
|
|
"$SUBJECT"
|
||
|
|
|
||
|
|
will be read when I return.
|
||
|
|
EOF
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_program_details
|
||
|
|
{
|
||
|
|
&get_common_details();
|
||
|
|
|
||
|
|
$mailprog = "/var/qmail/bin/datemail -t";
|
||
|
|
$aliases = $dot_vacation_prefix . ".vacation.aliases";
|
||
|
|
$noreply = $dot_vacation_prefix . ".vacation.noreply";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_user_details
|
||
|
|
{
|
||
|
|
&get_common_details();
|
||
|
|
|
||
|
|
$user = $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwuid($>))[0];
|
||
|
|
$dot_qmail_file = ".qmail";
|
||
|
|
$editor = $ENV{'VISUAL'} || $ENV{'EDITOR'} || 'vi';
|
||
|
|
$home = (getpwnam($user))[7];
|
||
|
|
$mailbox = "$home/Maildir/";
|
||
|
|
$pager = $ENV{'PAGER'} || 'less';
|
||
|
|
$vacation = "/usr/local/bin/vacation";
|
||
|
|
|
||
|
|
$dot_qmail_commands = << "EOF"; # Must use double quotes
|
||
|
|
| $vacation $user
|
||
|
|
$mailbox
|
||
|
|
EOF
|
||
|
|
}
|
||
|
|
|
||
|
|
sub time_scales
|
||
|
|
{
|
||
|
|
%scale =
|
||
|
|
(
|
||
|
|
's', 1,
|
||
|
|
'm', 60,
|
||
|
|
'h', 60 * 60,
|
||
|
|
'd', 60 * 60 * 24,
|
||
|
|
'w', 60 * 60 * 24 * 7,
|
||
|
|
);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub check_ignores
|
||
|
|
{
|
||
|
|
&get_aliases();
|
||
|
|
push(@ignores, @aliases);
|
||
|
|
|
||
|
|
push(@ignores,
|
||
|
|
'daemon',
|
||
|
|
'postmaster',
|
||
|
|
'mailer-daemon',
|
||
|
|
'mailer',
|
||
|
|
'root',
|
||
|
|
'',
|
||
|
|
);
|
||
|
|
|
||
|
|
if (-f "$noreply")
|
||
|
|
{
|
||
|
|
open(NOREPLY, "$noreply");
|
||
|
|
|
||
|
|
while(<NOREPLY>)
|
||
|
|
{
|
||
|
|
chomp;
|
||
|
|
next if (/^\s*#|^$/);
|
||
|
|
push(@ignores, lc($_));
|
||
|
|
}
|
||
|
|
|
||
|
|
close(NOREPLY);
|
||
|
|
}
|
||
|
|
|
||
|
|
for (@ignores)
|
||
|
|
{
|
||
|
|
exit(0) if ($sender eq $_);
|
||
|
|
exit(0) if ($sender =~ /^$_\@/);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub check_headers
|
||
|
|
{
|
||
|
|
my($header);
|
||
|
|
|
||
|
|
$/ = ''; # Read in paragraph mode
|
||
|
|
|
||
|
|
$header = <STDIN>;
|
||
|
|
$header =~ s/\n\s+/ /g; # Join continuation lines
|
||
|
|
|
||
|
|
exit(0) if ($header =~ /^Precedence:\s+(bulk|junk|list)/im);
|
||
|
|
exit(0) if ($header =~ /^From.*-REQUEST\@/im);
|
||
|
|
exit(0) if ($header =~ /^Mailing-List:/im);
|
||
|
|
exit(0) if ($header =~ /^X-Spam-Status:\s+Yes/im);
|
||
|
|
|
||
|
|
if ($check_to_and_cc)
|
||
|
|
{
|
||
|
|
($to) = ($header =~ /To:\s+(.*)/im);
|
||
|
|
($cc) = ($header =~ /Cc:\s+(.*)/im);
|
||
|
|
$to .= ', ' . $cc if $cc;
|
||
|
|
$to = lc($to);
|
||
|
|
|
||
|
|
for (@aliases)
|
||
|
|
{
|
||
|
|
++$alias_match if $to =~ /\b$_\b/im;
|
||
|
|
}
|
||
|
|
|
||
|
|
exit(0) unless $alias_match;
|
||
|
|
}
|
||
|
|
|
||
|
|
($subject) = ($header =~ /^Subject:\s+(.*)/im);
|
||
|
|
$subject =~ s/\s*$//m; # Remove trailing spaces
|
||
|
|
|
||
|
|
$subject = "(No subject)" unless $subject;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_aliases
|
||
|
|
{
|
||
|
|
@aliases =
|
||
|
|
(
|
||
|
|
"$user\@$host",
|
||
|
|
);
|
||
|
|
|
||
|
|
if (-f "$aliases")
|
||
|
|
{
|
||
|
|
open(ALIASES, "$aliases");
|
||
|
|
|
||
|
|
while(<ALIASES>)
|
||
|
|
{
|
||
|
|
chomp;
|
||
|
|
next if (/^\s*#|^$/);
|
||
|
|
push(@aliases, lc($_));
|
||
|
|
}
|
||
|
|
|
||
|
|
close(ALIASES);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub check_lastdate
|
||
|
|
{
|
||
|
|
my($file) = @_;
|
||
|
|
|
||
|
|
dbmopen(%DBM, "$file", 0644);
|
||
|
|
|
||
|
|
$now = time;
|
||
|
|
$then = unpack("L", $DBM{"$sender"});
|
||
|
|
|
||
|
|
exit(0) if (($now - $then) <= $timeout);
|
||
|
|
|
||
|
|
$DBM{$sender} = pack("L", $now);
|
||
|
|
close(%DBM);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub send_reply()
|
||
|
|
{
|
||
|
|
if (-f "$message_file")
|
||
|
|
{
|
||
|
|
open(MSG, "$message_file");
|
||
|
|
undef $/; # Read in the entire file
|
||
|
|
$vacation_msg = <MSG>;
|
||
|
|
close(MSG);
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
# Do not generate a reply if the user doesn't have a message file
|
||
|
|
# and -n was supplied on the command line.
|
||
|
|
|
||
|
|
exit(0) if ($no_msg_no_reply);
|
||
|
|
}
|
||
|
|
|
||
|
|
my $type = ($vacation_msg =~ m/<html/ && $vacation_msg =~ m/<\/html>/ ) ? 'html':'plain';
|
||
|
|
|
||
|
|
$vacation_msg =~ s/\$SUBJECT/$subject/g;
|
||
|
|
|
||
|
|
open(MAILPROG, "| $mailprog");
|
||
|
|
|
||
|
|
print MAILPROG << "EOF";
|
||
|
|
To: $sender
|
||
|
|
Precedence: junk
|
||
|
|
Content-Type: text/$type; charset="UTF-8"
|
||
|
|
EOF
|
||
|
|
|
||
|
|
print MAILPROG $vacation_msg;
|
||
|
|
|
||
|
|
close(MAILPROG);
|
||
|
|
}
|