@ -50,19 +50,25 @@
# http://www.irbs.net/internet/postfix/0707/0954.html
# (needs to be tested);
#
# Requirements:
# You need to have the DBD::Pg or DBD::mysql perl-module installed.
# You need to have the Mail::Sendmail module installed.
# You need to have the Email::Valid module installed.
# You need to have the MIME::Charset module installed.
# You need to have the MIME::EncWords module installed.
# You need to have the GetOpt::Std module installed.
# 2008-08-04 David Goodwin <david at palepurple dot co dot uk>
# Use Log4Perl
# Added better testing (and -t option)
#
# Requirements - the following perl modules are required:
# DBD::Pg or DBD::mysql
# Mail::Sendmail, Email::Valid MIME::Charset, Log::Log4perl, Log::Dispatch, MIME::EncWords and GetOpt::Std
#
# You may install these via CPAN, or through your package tool.
# CPAN: 'perl -MCPAN -e shell', then 'install Module::Whatever'
#
# On Debian based systems :
# libmail-sendmail-perl
# libdbd-pg-perl
# libemail-valid-perl
# libmime-perl
# liblog-log4perl-perl
# liblog-dispatch-perl
# libgetopt-argvfile-perl
# libmime-charset-perl (currently in testing, see instructions below)
# libmime-encwords-perl (currently in testing, see instructions below)
#
@ -93,21 +99,22 @@ my $db_type = 'Pg';
my $ db_host = '' ;
# connection details
my $ db_username = ' vacation ';
my $ db_password = ' ';
my $ db_username = ' dg ';
my $ db_password = ' gingerdog ';
my $ db_name = 'postfix' ;
# smtp server used to send vacation e-mails
my $ smtp_server = ' localhost ';
my $ smtp_server = ' 192.168.1.4 ';
my $ syslog = 1 ;
my $ syslog = 0 ;
# path to logfile, when empty logging is supressed
my $ logfile = '' ;
#my $logfile = "/var/log/vacation/vacation.log";
# path to file for debugging, debug supressed when empty
my $ debugfile = '' ;
#my $debugfile = "/var/log/vacation/vacation.debug";
# change to e.g. /dev/null if you want nothing logged.
# if we can't write to this, we try /tmp/vacation.log instead
my $ logfile = '/var/spool/vacation/vacation.log' ;
# 2 = debug + info, 1 = info only, 0 = error only
my $ log_level = 2 ;
# notification interval, in seconds
# set to 0 to notify only once
@ -118,6 +125,10 @@ my $interval = 0;
# =========== end configuration ===========
if ( ! - w $ logfile ) {
$ logfile = "/tmp/vacation.log" ;
}
use DBI ;
use MIME::Base64 ;
use MIME::EncWords qw( :all ) ;
@ -125,312 +136,365 @@ use Email::Valid;
use strict ;
use Mail::Sendmail ;
use Getopt::Std ;
use Log::Log4perl qw( get_logger :levels ) ;
my ( $ from , $ to , $ cc , , $ bcc , $ subject , $ messageid , $ lastheader , $ smtp_sender , $ smtp_recipient , % opts , $ sndrhdr , $ spam , $ test_mode , $ logger ) ;
$ subject = '' ;
# Setup a logger...
#
getopts ( 'f:t:' , \ % opts ) or die "Usage: $0 [-t yes] [-f sender] [-- [recipient]]\n -t for testing only\n" ;
$ opts { f } and $ smtp_sender = $ opts { f } ;
$ test_mode = 0 ;
$ opts { t } and $ test_mode = 1 ;
my $ log_layout = Log::Log4perl::Layout::PatternLayout - > new ( "%d %p> %F:%L %M - %m%n" ) ;
if ( $ test_mode == 1 ) {
$ logger = get_logger ( ) ;
# log to stdout
my $ appender = Log::Log4perl::Appender - > new ( 'Log::Dispatch::Screen' ) ;
$ appender - > layout ( $ log_layout ) ;
$ logger - > add_appender ( $ appender ) ;
$ logger - > debug ( "Test mode enabled" ) ;
}
else {
# log to file.
my $ appender = Log::Log4perl::Appender - > new (
'Log::Dispatch::File' ,
filename = > $ logfile ,
mode = > 'append' ) ;
my $ logger = get_logger ( ) ;
$ appender - > layout ( $ log_layout ) ;
$ logger - > add_appender ( $ appender ) ;
if ( $ syslog == 1 ) {
my $ syslog_appender = Log::Log4perl::Appender - > new (
'Log::Dispatch::Syslog' ,
Facility = > 'user' ,
) ;
$ logger - > add_appender ( $ syslog_appender ) ;
}
}
# change to $DEBUG, $INFO or $ERROR depending on how much logging you want.
$ logger - > level ( $ ERROR ) ;
if ( $ log_level == 1 ) {
$ logger - > level ( $ INFO ) ;
}
if ( $ log_level == 2 ) {
$ logger - > level ( $ DEBUG ) ;
}
binmode ( STDIN , ':utf8' ) ;
my $ dbh ;
if ( $ db_host ) {
$ dbh = DBI - > connect ( "DBI:$db_type:dbname=$db_name;host=$db_host" , "$db_username" , "$db_password" , { RaiseError = > 1 } ) ;
$ dbh = DBI - > connect ( "DBI:$db_type:dbname=$db_name;host=$db_host" , "$db_username" , "$db_password" , { RaiseError = > 1 } ) ;
} else {
$ dbh = DBI - > connect ( "DBI:$db_type:dbname=$db_name" , "$db_username" , "$db_password" , { RaiseError = > 1 } ) ;
$ dbh = DBI - > connect ( "DBI:$db_type:dbname=$db_name" , "$db_username" , "$db_password" , { RaiseError = > 1 } ) ;
}
if ( ! $ dbh ) {
panic ( "Could not connect to database" ) ;
exit ( 0 ) ;
$ logger - > error ( "Could not connect to database" ) ; # eval { } etc better here?
exit ( 0 ) ;
}
my $ db_true ; # MySQL and PgSQL use different values for TRUE, and unicode support...
if ( $ db_type eq "mysql" ) {
$ dbh - > do ( "SET CHARACTER SET utf8;" ) ;
$ db_true = '1' ;
$ dbh - > do ( "SET CHARACTER SET utf8;" ) ;
$ db_true = '1' ;
} else { # Pg
$ dbh - > do ( "SET CLIENT ENCODING 'UTF8'" ) ;
$ db_true = 'True' ;
$ dbh - > do ( "SET CLIENT _ENCODING TO 'UTF8'") ;
$ db_true = 'True' ;
}
# used to detect infinite address lookup loops
my $ loopcount = 0 ;
sub do_debug {
if ( $ debugfile ) {
my $ date ;
open ( DEBUG , ">> $debugfile" ) or die ( "Unable to open debug file" ) ;
binmode ( DEBUG , ':utf8' ) ;
chop ( $ date = `date "+%Y/%m/%d %H:%M:%S"` ) ;
print DEBUG "====== $date ======\n" ;
my $ i ;
for ( $ i = 0 ; $ i < $# _ ; $ i + + ) {
print DEBUG $ _ [ $ i ] , ' | ' ;
}
print DEBUG $ _ [ ( $# _ ) ] , "\n" ;
close ( DEBUG ) ;
}
}
sub already_notified {
my ( $ to , $ from ) = @ _ ;
my $ query = qq{ INSERT into vacation_notification (on_vacation,notified) values (?,?) } ;
my $ stm = $ dbh - > prepare ( $ query ) ;
if ( ! $ stm ) {
do_log ( '' , $ to , $ from , '' , "Could not prepare query $query" ) ;
return 1 ;
}
$ stm - > { 'PrintError' } = 0 ;
$ stm - > { 'RaiseError' } = 0 ;
if ( ! $ stm - > execute ( $ to , $ from ) ) {
my $ e = $ dbh - > errstr ;
my ( $ to , $ from ) = @ _ ;
my $ logger = get_logger ( ) ;
my $ query = qq{ INSERT into vacation_notification (on_vacation,notified) values (?,?) } ;
my $ stm = $ dbh - > prepare ( $ query ) ;
if ( ! $ stm ) {
$ logger - > error ( "Could not prepare query '$query' to: $to, from:$from" ) ;
return 1 ;
}
$ stm - > { 'PrintError' } = 0 ;
$ stm - > { 'RaiseError' } = 0 ;
if ( ! $ stm - > execute ( $ to , $ from ) ) {
my $ e = $ dbh - > errstr ;
# Violation of a primay key constraint may happen here, and that's
# fine. All other error conditions are not fine, however.
if ( $ e !~ /(?:_pkey|^Duplicate entry)/ ) {
do_log ( '' , $ to , $ from , '' , "Unexpected error: '$e' from query '$query'" ) ;
# Let's play safe and notify anyway
return 0 ;
}
if ( $ interval ) {
$ query = qq{ SELECT NOW()-notified_at FROM vacation_notification WHERE on_vacation=? AND notified=? } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ to , $ from ) or panic_execute ( $ query , "on_vacation='$to', notified='$from'" ) ;
my @ row = $ stm - > fetchrow_array ;
my $ int = $ row [ 0 ] ;
if ( $ int > $ interval ) {
do_debug ( "[Interval elapsed, sending the message]: " , $ from , $ to ) ;
$ query = qq{ UPDATE vacation_notification SET notified_at=NOW() WHERE on_vacation=? AND notified=? } ;
$ stm = $ dbh - > prepare ( $ query ) ;
if ( ! $ stm ) {
do_log ( '' , $ to , $ from , '' , "Could not prepare query $query" ) ;
return 0 ;
}
if ( ! $ stm - > execute ( $ to , $ from ) ) {
$ e = $ dbh - > errstr ;
do_log ( '' , $ to , $ from , '' , "Unexpected error: '$e' from query '$query'" ) ;
}
if ( $ e !~ /(?:_pkey|^Duplicate entry)/ ) {
$ logger - > error ( "Failed to insert into vacation_notification table (to:$to from:$from error:'$e' query:'$query')" ) ;
# Let's play safe and notify anyway
return 0 ;
} else {
do_debug ( "[Interval not elapsed, not sending the message]: " , $ from , $ to ) ;
}
if ( $ interval ) {
$ query = qq{ SELECT NOW()-notified_at FROM vacation_notification WHERE on_vacation=? AND notified=? } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ to , $ from ) or panic_execute ( $ query , "on_vacation='$to', notified='$from'" ) ;
my @ row = $ stm - > fetchrow_array ;
my $ int = $ row [ 0 ] ;
if ( $ int > $ interval ) {
$ logger - > debug ( "[Interval elapsed, sending the message]: From: $from To:$to" ) ;
$ query = qq{ UPDATE vacation_notification SET notified_at=NOW() WHERE on_vacation=? AND notified=? } ;
$ stm = $ dbh - > prepare ( $ query ) ;
if ( ! $ stm ) {
$ logger - > error ( "Could not prepare query '$query' (to: '$to', from: '$from')" ) ;
return 0 ;
}
if ( ! $ stm - > execute ( $ to , $ from ) ) {
$ e = $ dbh - > errstr ;
$ logger - > error ( "Error from running query '$query' (to: '$to', from: '$from', error: '$e')" ) ;
}
return 0 ;
} else {
$ logger - > debug ( "Notification interval not elapsed; not sending vacation reply (to: '$to', from: '$from')" ) ;
return 1 ;
}
} else {
return 1 ;
}
} else {
return 1 ;
}
}
return 0 ;
}
}
return 0 ;
}
sub do_log {
my ( $ messageid , $ to , $ from , $ subject , $ logmessage ) = @ _ ;
my $ date ;
if ( $ syslog ) {
open ( SYSLOG , "|/usr/bin/logger -p mail.info -t Vacation" ) or die ( "Unable to open logger" ) ;
binmode ( SYSLOG , ':utf8' ) ;
if ( $ logmessage ) {
printf SYSLOG "Orig-To: %s From: %s MessageID: %s Subject: %s. Log message: %s" , $ to , $ from , $ messageid , $ subject , $ logmessage ;
} else {
printf SYSLOG "Orig-To: %s From: %s MessageID: %s Subject: %s" , $ to , $ from , $ messageid , $ subject ;
}
close ( SYSLOG ) ;
}
if ( $ logfile ) {
open ( LOG , ">> $logfile" ) or die ( "Unable to open log file" ) ;
binmode ( LOG , ':utf8' ) ;
chop ( $ date = `date "+%Y/%m/%d %H:%M:%S"` ) ;
if ( $ logmessage ) {
print LOG "$date: To: $to From: $from Subject: $subject MessageID: $messageid. Log message: $logmessage\n" ;
} else {
print LOG "$date: To: $to From: $from Subject: $subject MessageID: $messageid\n" ;
}
close ( LOG ) ;
}
}
sub do_mail {
# from, to, subject, body
my ( $ from , $ to , $ subject , $ body ) = @ _ ;
my $ vacation_subject = encode_mimewords ( $ subject , 'Encoding' = > 'q' , 'Charset' = > 'utf-8' , 'Field' = > 'Subject' ) ;
my % mail ;
% mail = (
'smtp' = > $ smtp_server ,
'Subject' = > $ vacation_subject ,
'From' = > $ from ,
'To' = > $ to ,
'MIME-Version' = > '1.0' ,
'Content-Type' = > 'text/plain; charset=UTF-8' ,
'Content-Transfer-Encoding' = > 'base64' ,
'Precedence' = > 'junk' ,
'X-Loop' = > 'Postfix Admin Virtual Vacation' ,
'Message' = > encode_base64 ( $ body )
) ;
sendmail ( % mail ) or do_log ( $ Mail:: Sendmail:: error ) ;
do_debug ( 'Mail::Sendmail said :' . $ Mail:: Sendmail:: log ) ;
}
sub panic {
my ( $ arg ) = @ _ ;
do_log ( '' , '' , '' , '' , "$arg" ) ;
exit ( 0 ) ;
}
sub panic_prepare {
my ( $ arg ) = @ _ ;
do_log ( '' , '' , '' , '' , "Could not prepare '$arg'" ) ;
exit ( 0 ) ;
}
sub panic_execute {
my ( $ arg , $ param ) = @ _ ;
do_log ( '' , '' , '' , '' , "Could not execute '$arg' with parameters $param" ) ;
exit ( 0 ) ;
}
# try and determine if email address has vacation turned on; we
# have to do alias searching, and domain aliasing resolution for this.
# If found, return ($num_matches, $real_email);
sub find_real_address {
my ( $ email ) = @ _ ;
if ( + + $ loopcount > 20 ) {
do_log ( "find_real_address loop!" , "currently: $email" , "ERROR" , "ERROR" ) ;
panic ( "possible infinite loop in find_real_address for <$email>. Check for alias loop\n" ) ;
}
my $ realemail ;
my $ query = qq{ SELECT email FROM vacation WHERE email=? and active=$db_true } ;
my $ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email ) or panic_execute ( $ query , "email='$email'" ) ;
my $ rv = $ stm - > rows ;
my ( $ email ) = @ _ ;
my $ logger = get_logger ( ) ;
if ( + + $ loopcount > 20 ) {
$ logger - > error ( "find_real_address loop! (more than 20 attempts!) currently: $email" ) ;
exit ( 1 ) ;
}
my $ realemail = '' ;
my $ query = qq{ SELECT email FROM vacation WHERE email=? and active=$db_true } ;
my $ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email ) or panic_execute ( $ query , "email='$email'" ) ;
my $ rv = $ stm - > rows ;
# Recipient has vacation
if ( $ rv == 1 ) {
$ realemail = $ email ;
} else {
$ query = qq{ SELECT goto FROM alias WHERE address=? } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email ) or panic_execute ( $ query , "address='$email'" ) ;
$ rv = $ stm - > rows ;
if ( $ rv == 1 ) {
$ realemail = $ email ;
$ logger - > debug ( "Found $email has vacation active" ) ;
} else {
# XXX why aren't we doing a join here?
$ logger - > debug ( "Looking for alias records that $email resolves to with vacation turned on" ) ;
$ query = qq{ SELECT goto FROM alias WHERE address=? } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email ) or panic_execute ( $ query , "address='$email'" ) ;
$ rv = $ stm - > rows ;
# Recipient is an alias, check if mailbox has vacation
if ( $ rv == 1 ) {
my @ row = $ stm - > fetchrow_array ;
my $ alias = $ row [ 0 ] ;
$ query = qq{ SELECT email FROM vacation WHERE email=? and active=$db_true } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ alias ) or panic_prepare ( $ query , "email='$alias'" ) ;
$ rv = $ stm - > rows ;
if ( $ rv == 1 ) {
my @ row = $ stm - > fetchrow_array ;
my $ alias = $ row [ 0 ] ;
$ query = qq{ SELECT email FROM vacation WHERE email=? and active=$db_true } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ alias ) or panic_prepare ( $ query , "email='$alias'" ) ;
$ rv = $ stm - > rows ;
# Alias has vacation
if ( $ rv == 1 ) {
$ realemail = $ alias ;
}
if ( $ rv == 1 ) {
$ realemail = $ alias ;
}
# We still have to look for domain level aliases...
} else {
my ( $ user , $ domain ) = split ( /@/ , $ email ) ;
$ query = qq{ SELECT goto FROM alias WHERE address=? } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( "\@$domain" ) or panic_execute ( $ query , "address='\@$domain'" ) ;
$ rv = $ stm - > rows ;
} else {
my ( $ user , $ domain ) = split ( /@/ , $ email ) ;
$ query = qq{ SELECT goto FROM alias WHERE address=? } ;
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( "\@$domain" ) or panic_execute ( $ query , "address='\@$domain'" ) ;
$ rv = $ stm - > rows ;
$ logger - > debug ( "Looking for domain level aliases for $domain / $email / $user" ) ;
# The receipient has a domain level alias
if ( $ rv == 1 ) {
my @ row = $ stm - > fetchrow_array ;
my $ wildcard_dest = $ row [ 0 ] ;
my ( $ wilduser , $ wilddomain ) = split ( /@/ , $ wildcard_dest ) ;
if ( $ rv == 1 ) {
my @ row = $ stm - > fetchrow_array ;
my $ wildcard_dest = $ row [ 0 ] ;
my ( $ wilduser , $ wilddomain ) = split ( /@/ , $ wildcard_dest ) ;
# Check domain alias
if ( $ wilduser ) {
( $ rv , $ realemail ) = find_real_address ( $ wildcard_dest ) ;
} else {
my $ new_email = $ user . '@' . $ wilddomain ;
( $ rv , $ realemail ) = find_real_address ( $ new_email ) ;
if ( $ wilduser ) {
( $ rv , $ realemail ) = find_real_address ( $ wildcard_dest ) ;
} else {
my $ new_email = $ user . '@' . $ wilddomain ;
( $ rv , $ realemail ) = find_real_address ( $ new_email ) ;
}
}
}
}
}
return ( $ rv , $ realemail ) ;
else {
$ logger - > debug ( "No domain level alias present for $domain / $email / $user" ) ;
}
}
}
return ( $ rv , $ realemail ) ;
}
# sends the vacation mail to the original sender.
#
sub send_vacation_email {
my ( $ email , $ orig_from , $ orig_to , $ orig_messageid ) = @ _ ;
my $ query = qq{ SELECT subject,body FROM vacation WHERE email=? } ;
my $ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email ) or panic_execute ( $ query , "email='$email'" ) ;
my $ rv = $ stm - > rows ;
if ( $ rv == 1 ) {
my @ row = $ stm - > fetchrow_array ;
if ( already_notified ( $ email , $ orig_from ) ) { return ; }
do_debug ( "[SEND RESPONSE] for $orig_messageid:\n" , "FROM: $email (orig_to: $orig_to)\n" , "TO: $orig_from\n" , "VACATION SUBJECT: $row[0]\n" , "VACATION BODY: $row[1]\n" ) ;
# do_mail(from, to, subject, body);
do_mail ( $ email , $ orig_from , $ row [ 0 ] , $ row [ 1 ] ) ;
do_log ( $ orig_messageid , $ orig_to , $ orig_from , '' ) ;
}
my ( $ email , $ orig_from , $ orig_to , $ orig_messageid , $ test_mode ) = @ _ ;
my $ logger = get_logger ( ) ;
$ logger - > debug ( "Asked to send vacation reply to $email thanks to $orig_messageid" ) ;
my $ query = qq{ SELECT subject,body FROM vacation WHERE email=? } ;
my $ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email ) or panic_execute ( $ query , "email='$email'" ) ;
my $ rv = $ stm - > rows ;
if ( $ rv == 1 ) {
my @ row = $ stm - > fetchrow_array ;
if ( already_notified ( $ email , $ orig_from ) == 1 ) {
$ logger - > debug ( "Already notified $email, or some error prevented us from doing so" ) ;
return ;
}
$ logger - > debug ( "Will send vacation response for $orig_messageid: FROM: $email (orig_to: $orig_to), TO: $orig_from; VACATION SUBJECT: $row[0] ; VACATION BODY: $row[1]" ) ;
my $ subject = $ row [ 0 ] ;
my $ body = $ row [ 1 ] ;
my $ from = $ email ;
my $ to = $ orig_from ;
my $ vacation_subject = encode_mimewords ( $ subject , 'Encoding' = > 'q' , 'Charset' = > 'utf-8' , 'Field' = > 'Subject' ) ;
my % mail ;
% mail = (
'smtp' = > $ smtp_server ,
'Subject' = > $ vacation_subject ,
'From' = > $ from ,
'To' = > $ to ,
'MIME-Version' = > '1.0' ,
'Content-Type' = > 'text/plain; charset=UTF-8' ,
'Content-Transfer-Encoding' = > 'base64' ,
'Precedence' = > 'junk' ,
'X-Loop' = > 'Postfix Admin Virtual Vacation' ,
'Message' = > encode_base64 ( $ body )
) ;
if ( $ test_mode == 1 ) {
$ logger - > info ( "** TEST MODE ** : Vacation response sent to $to from $from subject $subject - NOT sent\n" ) ;
$ logger - > info ( % mail ) ;
return 0 ;
}
sendmail ( % mail ) or $ logger - > error ( "Failed to send vacation response: " . $ Mail:: Sendmail:: error ) ;
$ logger - > debug ( "Vacation response sent, Mail::Sendmail said : " . $ Mail:: Sendmail:: log ) ;
}
}
sub strip_address {
my $ arg = shift ;
$ arg =~ /([\w\-.%]+\@[\w.-]+)/ ;
return lc ( $ 1 ) ;
my ( $ arg ) = @ _ ;
if ( ! $ arg ) {
return '' ;
}
if ( $ arg =~ /([\w\-.%]+\@[\w.-]+)/ ) {
return lc ( $ 1 ) ;
}
return '' ;
}
########################### main #################################
my ( $ from , $ to , $ cc , , $ bcc , $ subject , $ messageid , $ lastheader , $ sender , $ recipient , % opts , $ sndrhdr , $ spam ) ;
sub panic_prepare {
my ( $ arg ) = @ _ ;
my $ logger = get_logger ( ) ;
$ logger - > error ( "Could not prepare sql statement: '$arg'" ) ;
exit ( 0 ) ;
}
$ subject = '' ;
sub panic_execute {
my ( $ arg , $ param ) = @ _ ;
my $ logger = get_logger ( ) ;
$ logger - > error ( "Could not execute sql statement - '$arg' with parameters '$param'" ) ;
exit ( 0 ) ;
}
########################### main #################################
# Take headers apart
#
while ( <STDIN> ) {
last if ( /^$/ ) ;
if ( /^\s+(.*)/ and $ lastheader ) { $$ lastheader . = " $1" ; }
elsif ( /^Return-Path:\s+(.*)\n$/i ) { $ sender = $ 1 ; $ lastheader = \ $ sender ; }
elsif ( /^Delivered-To:\s+(.*)\n$/i ) { $ recipient = $ 1 ; $ lastheader = \ $ recipient ; }
elsif ( /^from:\s+(.*)\n$/i ) { $ from = $ 1 ; $ lastheader = \ $ from ; }
elsif ( /^to:\s+(.*)\n$/i ) { $ to = $ 1 ; $ lastheader = \ $ to ; }
elsif ( /^cc:\s+(.*)\n$/i ) { $ cc = $ 1 ; $ lastheader = \ $ cc ; }
elsif ( /^bcc:\s+(.*)\n$/i ) { $ bcc = $ 1 ; $ lastheader = \ $ bcc ; }
elsif ( /^subject:\s+(.*)\n$/i ) { $ subject = $ 1 ; $ lastheader = \ $ subject ; }
elsif ( /^message-id:\s+(.*)\n$/i ) { $ messageid = $ 1 ; $ lastheader = \ $ messageid ; }
elsif ( /^x-spam-(flag|status):\s+yes/i ) { do_debug ( "x-spam-$1: yes found" ) ; exit ( 0 ) ; }
elsif ( /^precedence:\s+(bulk|list|junk)/i ) { do_debug ( "precedence: $1 found" ) ; exit ( 0 ) ; }
elsif ( /^x-loop:\s+postfix\ admin\ virtual\ vacation/i ) { do_debug ( "x-loop: postfix admin virtual vacation found" ) ; exit ( 0 ) ; }
elsif ( /^Auto-Submitted:\s+no/i ) { next ; }
elsif ( /^Auto-Submitted:/i ) { do_debug ( "Auto-Submitted: something found" ) ; exit ( 0 ) ; }
elsif ( /^List-(Id|Post):/i ) { do_debug ( "List-$1: found" ) ; exit ( 0 ) ; }
elsif ( /^Sender:\s+(.*)/i ) { $ sndrhdr = $ 1 ; $ lastheader = \ $ sndrhdr ; }
else { $ lastheader = "" ; }
last if ( /^$/ ) ;
if ( /^\s+(.*)/ and $ lastheader ) { $$ lastheader . = " $1" ; }
elsif ( /^Return-Path:\s+(.*)\n$/i ) { $ smtp_sender = $ 1 ; $ lastheader = \ $ smtp_sender ; }
elsif ( /^Delivered-To:\s+(.*)\n$/i ) { $ smtp_recipient = $ 1 ; $ lastheader = \ $ smtp_recipient ; }
elsif ( /^from:\s+(.*)\n$/i ) { $ from = $ 1 ; $ lastheader = \ $ from ; }
elsif ( /^to:\s+(.*)\n$/i ) { $ to = $ 1 ; $ lastheader = \ $ to ; }
elsif ( /^cc:\s+(.*)\n$/i ) { $ cc = $ 1 ; $ lastheader = \ $ cc ; }
elsif ( /^bcc:\s+(.*)\n$/i ) { $ bcc = $ 1 ; $ lastheader = \ $ bcc ; }
elsif ( /^subject:\s+(.*)\n$/i ) { $ subject = $ 1 ; $ lastheader = \ $ subject ; }
elsif ( /^message-id:\s+(.*)\n$/i ) { $ messageid = $ 1 ; $ lastheader = \ $ messageid ; }
elsif ( /^x-spam-(flag|status):\s+yes/i ) { $ logger - > debug ( "x-spam-$1: yes found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^x-facebook-notify:/i ) { $ logger - > debug ( 'Mail from facebook, ignoring' ) ; exit ( 0 ) ; }
elsif ( /^precedence:\s+(bulk|list|junk)/i ) { $ logger - > debug ( "precedence: $1 found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^x-loop:\s+postfix\ admin\ virtual\ vacation/i ) { $ logger - > debug ( "x-loop: postfix admin virtual vacation found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^Auto-Submitted:\s+no/i ) { next ; }
elsif ( /^Auto-Submitted:/i ) { $ logger - > debug ( "Auto-Submitted: something found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^List-(Id|Post):/i ) { $ logger - > debug ( "List-$1: found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^Sender:\s+(.*)/i ) { $ sndrhdr = $ 1 ; $ lastheader = \ $ sndrhdr ; }
else { $ lastheader = "" ; }
}
getopts ( 'f:' , \ % opts ) or die "Usage: $0 [-f sender] [-- [recipient]]" ;
$ opts { f } and $ sender = $ opts { f } ;
$ recipient = shift || $ recipient || $ ENV { "USER" } || "" ;
$ smtp_recipient = shift || $ smtp_recipient || $ ENV { "USER" } || "" ;
# If either From: or To: are not set, exit
if ( ! $ from || ! $ to || ! $ messageid || ! $ sender || ! $ recipient ) { do_debug ( "One of from=$from, to=$to, $messageid=$messageid, sender=$sender, recipient=$recipient is empty" ) ; exit ( 0 ) ; }
if ( $ sender =~ /^(mailer-daemon|listserv|majordomo|owner-|request-|bounces-)/i ) { do_debug ( "sender $sender contains $1" ) ; exit ( 0 ) ; }
if ( $ sender =~ /-(owner|request|bounces)\@/i ) { do_debug ( "sender $sender contains $1" ) ; exit ( 0 ) ; }
my $ ss = strip_address ( $ sender ) ;
my $ sr = strip_address ( $ recipient ) ;
my $ ssh = strip_address ( $ sndrhdr ) ;
if ( $ ss eq $ sr ) { do_debug ( "sender $ss and recipient $sr are the same" ) ; exit ( 0 ) ; }
if ( ! $ from || ! $ to || ! $ messageid || ! $ smtp_sender || ! $ smtp_recipient ) {
$ logger - > info ( "One of from=$from, to=$to, messageid=$messageid, smtp sender=$smtp_sender, smtp recipient=$smtp_recipient empty" ) ;
exit ( 0 ) ;
}
if ( $ smtp_sender =~ /^(mailer-daemon|listserv|majordomo|owner-|request-|bounces-)/i ||
$ smtp_sender =~ /-(owner|request|bounces)\@/i ) {
$ logger - > debug ( "sender $smtp_sender contains $1 - will not send vacation message" ) ;
exit ( 0 ) ;
}
$ smtp_sender = strip_address ( $ smtp_sender ) ;
$ smtp_recipient = strip_address ( $ smtp_recipient ) ;
$ sndrhdr = strip_address ( $ sndrhdr ) ;
if ( $ smtp_sender eq $ smtp_recipient ) {
$ logger - > debug ( "smtp sender $smtp_sender and recipient $smtp_recipient are the same; aborting" ) ;
exit ( 0 ) ;
}
my $ recipfound = 0 ;
for ( split ( /,\s*/ , lc ( $ to ) ) , split ( /,\s*/ , lc ( $ cc ) ) , split ( /,\s*/ , lc ( $ bcc ) ) ) {
my $ destinatario = strip_address ( $ _ ) ;
if ( $ ssh eq $ destinatario ) { do_debug ( "sender header $sender contains recipient $destinatario" ) ; exit ( 0 ) ; }
if ( $ sr eq $ destinatario ) { $ recipfound + + ; }
my $ destinatario = strip_address ( $ _ ) ;
if ( $ sndrhdr eq $ destinatario ) {
$ logger - > debug ( "sender header $sndrhdr contains recipient $destinatario (mailing myself?)" ) ;
exit ( 0 ) ;
}
if ( $ smtp_recipient eq $ destinatario ) { $ recipfound + + ; }
}
if ( ! $ recipfound ) {
$ logger - > debug ( "smtp envelope recipient $smtp_recipient not found in the header recipients (therefore they were bcc'ed, so won't send vacation message)" ) ;
exit ( 0 ) ;
}
if ( ! $ recipfound ) { do_debug ( "envelope recipient $sr not found in the header recipients" ) ; exit ( 0 ) ; }
$ from = lc ( $ from ) ;
if ( ! Email::Valid - > address ( $ from , - mxcheck = > 1 ) ) { do_debug ( "Invalid from email address: $from; exiting." ) ; exit ( 0 ) ; }
if ( ! Email::Valid - > address ( $ ss , - mxcheck = > 1 ) ) { do_debug ( "Invalid sender email address: $ss; exiting." ) ; exit ( 0 ) ; }
if ( ! Email::Valid - > address ( $ from , - mxcheck = > 1 ) ) { $ logger - > debug( "Invalid from email address: $from; exiting." ) ; exit ( 0 ) ; }
if ( ! Email::Valid - > address ( $ s mtp_ sender , - mxcheck = > 1 ) ) { $ logger - > debug( "Invalid sender email address: $s mtp_ sender ; exiting.") ; exit ( 0 ) ; }
# Check if it's an obvious sender, exit
if ( $ from =~ /([\w\-.%]+\@[\w.-]+)/ ) { $ from = $ 1 ; }
if ( $ from eq "" || $ from =~ /^(owner-|-(?:request|owner)\@|^(?:mailer-daemon|postmaster)\@)/i ) { do_debug ( "from $from contains $1" ) ; exit ( 0 ) ; }
# Does the $from address look like a mailing list etc?
if ( $ from eq "" ||
$ from =~ /^(owner-|-(?:request|owner)\@|^(?:mailer-daemon|postmaster)\@)/i ) {
$ logger - > debug ( "from $from contains $1" ) ; exit ( 0 ) ;
}
my ( $ rv , $ email ) = find_real_address ( $ sr ) ;
my ( $ rv , $ email ) = find_real_address ( $ smtp_recipient ) ;
$ logger - > debug ( "find_email_address gave: rv:$rv, email:$email" ) ;
if ( $ rv == 1 ) {
do_debug ( "[FOUND VACATION]: " , $ messageid , $ sender , $ recipient , $ email ) ;
send_vacation_email ( $ email , $ sender , $ recipient , $ messageid ) ;
$ logger - > debug ( "Attempting to send vacation response for: $messageid to: $smtp_sender, $smtp_recipient, $email (test_mode = $test_mode)" ) ;
send_vacation_email ( $ email , $ smtp_sender , $ smtp_recipient , $ messageid , $ test_mode ) ;
}
else {
$ logger - > debug ( "SMTP recipient $smtp_recipient which resolves to $email does not have an active vacation" ) ;
}
0 ;