2007-03-24 08:27:00 +01:00
#!/usr/bin/perl -w
#
2012-04-19 23:10:42 +02:00
# Virtual Vacation 4.0r1
#
2009-01-20 13:00:46 +01:00
# $Revision$
2008-10-21 13:08:19 +02:00
# Originally by Mischa Peters <mischa at high5 dot net>
#
2007-03-24 08:27:00 +01:00
# Copyright (c) 2002 - 2005 High5!
# Licensed under GPL for more info check GPL-LICENSE.TXT
#
# Additions:
# 2004/07/13 David Osborn <ossdev at daocon.com>
# strict, processes domain level aliases, more
# subroutines, send reply from original to address
#
# 2004/11/09 David Osborn <ossdev at daocon.com>
2010-11-01 16:48:38 +01:00
# Added syslog support
2007-03-24 08:27:00 +01:00
# Slightly better logging which includes messageid
# Avoid infinite loops with domain aliases
#
2009-10-21 10:00:07 +02:00
# 2005-01-19 Troels Arvin <troels at arvin.dk>
2007-03-24 08:27:00 +01:00
# PostgreSQL-version.
# Normalized DB schema from one vacation table ("vacation")
# to two ("vacation", "vacation_notification"). Uses
# referential integrity CASCADE action to simplify cleanup
# when a user is no longer on vacation.
# Inserting variables into queries stricly by prepare()
# to try to avoid SQL injection.
# International characters are now handled well.
#
2009-10-21 10:00:07 +02:00
# 2005-01-21 Troels Arvin <troels at arvin.dk>
2007-03-24 08:27:00 +01:00
# Uses the Email::Valid package to avoid sending notices
# to obviously invalid addresses.
#
2009-10-21 10:00:07 +02:00
# 2007-08-15 David Goodwin <david at palepurple.co.uk>
2007-08-15 11:08:25 +02:00
# Use the Perl Mail::Sendmail module for sending mail
# Check for headers that start with blank lines (patch from forum)
2007-03-24 08:27:00 +01:00
#
2009-10-21 10:00:07 +02:00
# 2007-08-20 Martin Ambroz <amsys at trustica.cz>
2007-09-20 15:56:37 +02:00
# Added initial Unicode support
#
2009-10-21 10:00:07 +02:00
# 2008-05-09 Fabio Bonelli <fabiobonelli at libero.it>
2008-07-09 14:14:06 +02:00
# Properly handle failed queries to vacation_notification.
# Fixed log reporting.
2007-09-20 22:30:07 +02:00
#
2008-07-29 22:33:30 +02:00
# 2008-07-29 Patch from Luxten to add repeat notification after timeout. See:
# https://sourceforge.net/tracker/index.php?func=detail&aid=2031631&group_id=191583&atid=937966
2010-11-01 16:48:38 +01:00
#
2008-08-03 12:09:29 +02:00
# 2008-08-01 Luigi Iotti <luigi at iotti dot biz>
# Use envelope sender/recipient instead of using
# From: and To: header fields;
# Support to good vacation behavior as in
# http://www.irbs.net/internet/postfix/0707/0954.html
# (needs to be tested);
#
2008-08-05 22:54:47 +02:00
# 2008-08-04 David Goodwin <david at palepurple dot co dot uk>
# Use Log4Perl
# Added better testing (and -t option)
#
2009-11-05 15:55:39 +01:00
# 2009-06-29 Stevan Bajic <stevan at bajic.ch>
2009-06-29 10:26:35 +02:00
# Add Mail::Sender for SMTP auth + more flexibility
#
2009-11-05 15:55:39 +01:00
# 2009-07-07 Stevan Bajic <stevan at bajic.ch>
2009-07-10 23:12:44 +02:00
# Add better alias lookups
# Check for more heades from Anti-Virus/Anti-Spam solutions
#
2009-11-05 15:55:39 +01:00
# 2009-08-10 Sebastian <reg9009 at yahoo dot de>
# Adjust SQL query for vacation timeframe. It is now possible to set from/until date for vacation message.
#
2012-04-19 23:55:36 +02:00
# 2012-04-1 Nikolaos Topp <info at ichier.de>
2012-04-19 23:00:39 +02:00
# Add configuration parameter $smtp_client in order to get mails through
# postfix helo-checks, using check_helo_access whitelist without permitting 'localhost' default style stuff
2012-04-19 23:10:42 +02:00
#
2012-04-23 22:57:54 +02:00
# 2012-04-19 Jan Kruis <jan at crossreference dot nl>
2012-04-19 23:55:36 +02:00
# change SQL query for vacation into function.
# Add sub get_interval()
# Gives the user the option to set the interval time ( 0 = one reply, 1 = autoreply, > 1 = Delay reply )
# See https://sourceforge.net/tracker/?func=detail&aid=3508083&group_id=191583&atid=937966
2012-04-19 23:00:39 +02:00
2008-08-05 22:54:47 +02:00
# Requirements - the following perl modules are required:
2010-11-01 16:48:38 +01:00
# DBD::Pg or DBD::mysql
# Mail::Sender, Email::Valid MIME::Charset, Log::Log4perl, Log::Dispatch, MIME::EncWords and GetOpt::Std
2008-08-05 22:54:47 +02:00
#
# You may install these via CPAN, or through your package tool.
# CPAN: 'perl -MCPAN -e shell', then 'install Module::Whatever'
2007-03-24 08:27:00 +01:00
#
2010-11-01 16:48:38 +01:00
# On Debian based systems :
2009-06-29 10:26:35 +02:00
# libmail-sender-perl
2007-09-20 22:30:07 +02:00
# libdbd-pg-perl
# libemail-valid-perl
# libmime-perl
2008-08-05 22:54:47 +02:00
# liblog-log4perl-perl
# liblog-dispatch-perl
# libgetopt-argvfile-perl
2007-09-20 22:30:07 +02:00
# libmime-charset-perl (currently in testing, see instructions below)
# libmime-encwords-perl (currently in testing, see instructions below)
2007-08-15 11:08:25 +02:00
#
2007-03-24 08:27:00 +01:00
# Note: When you use this module, you may start seeing error messages
# like "Cannot insert a duplicate key into unique index
# vacation_notification_pkey" in your system logs. This is expected
# behavior, and not an indication of trouble (see the "already_notified"
# subroutine for an explanation).
#
# You must also have the Email::Valid and MIME-tools perl-packages
# installed. They are available in some package collections, under the
# names 'perl-Email-Valid' and 'perl-MIME-tools', respectively.
# One such package collection (for Linux) is:
# http://dag.wieers.com/home-made/apt/packages.php
#
2009-06-29 09:58:50 +02:00
use DBI ;
use MIME::Base64 ;
use MIME::EncWords qw( :all ) ;
use Email::Valid ;
use strict ;
2009-06-29 10:26:35 +02:00
use Mail::Sender ;
2009-06-29 09:58:50 +02:00
use Getopt::Std ;
use Log::Log4perl qw( get_logger :levels ) ;
use File::Basename ;
2007-03-24 08:27:00 +01:00
# ========== begin configuration ==========
# IMPORTANT: If you put passwords into this script, then remember
# to restrict access to the script, so that only the vacation user
2007-09-19 10:41:02 +02:00
# can read it.
2007-03-24 08:27:00 +01:00
2007-09-20 15:56:37 +02:00
# db_type - uncomment one of these
2008-10-31 14:37:49 +01:00
our $ db_type = 'Pg' ;
2009-07-10 23:12:44 +02:00
#our $db_type = 'mysql';
2007-09-20 15:56:37 +02:00
2007-09-20 22:30:07 +02:00
# leave empty for connection via UNIX socket
2008-10-31 14:37:49 +01:00
our $ db_host = '' ;
2007-08-15 11:08:25 +02:00
2007-09-20 22:30:07 +02:00
# connection details
2009-06-29 09:58:50 +02:00
our $ db_username = 'user' ;
our $ db_password = 'password' ;
2008-10-31 14:37:49 +01:00
our $ db_name = 'postfix' ;
2007-03-24 08:27:00 +01:00
2008-10-31 14:37:49 +01:00
our $ vacation_domain = 'autoreply.example.org' ;
2008-09-03 10:44:36 +02:00
2008-07-02 21:51:26 +02:00
# smtp server used to send vacation e-mails
2008-10-31 14:37:49 +01:00
our $ smtp_server = 'localhost' ;
2009-06-29 10:26:35 +02:00
our $ smtp_server_port = 25 ;
2012-04-19 23:00:39 +02:00
# this is the helo we [the vacation script] use on connection; you may need to change this to your hostname or something,
# depending upon what smtp helo restrictions you have in place within Postfix.
our $ smtp_client = 'localhost' ;
2009-06-29 10:26:35 +02:00
# SMTP authentication protocol used for sending.
# Can be 'PLAIN', 'LOGIN', 'CRAM-MD5' or 'NTLM'
# Leave it blank if you don't use authentification
our $ smtp_auth = undef ;
# username used to login to the server
our $ smtp_authid = 'someuser' ;
# password used to login to the server
our $ smtp_authpwd = 'somepass' ;
2008-07-02 21:51:26 +02:00
2008-08-05 22:57:45 +02:00
# Set to 1 to enable logging to syslog.
2008-10-31 14:37:49 +01:00
our $ syslog = 0 ;
2007-09-20 22:30:07 +02:00
# path to logfile, when empty logging is supressed
2008-08-05 22:54:47 +02:00
# change to e.g. /dev/null if you want nothing logged.
2009-06-29 09:58:50 +02:00
# if we can't write to this, and $log_to_file is 1 (below) the script will abort.
our $ logfile = '/var/log/vacation.log' ;
2008-08-05 22:54:47 +02:00
# 2 = debug + info, 1 = info only, 0 = error only
2008-10-31 14:37:49 +01:00
our $ log_level = 2 ;
2009-06-29 09:58:50 +02:00
# Whether to log to file or not, 0 = do not write to a log file
2010-11-01 16:48:38 +01:00
our $ log_to_file = 0 ;
2007-03-24 08:27:00 +01:00
2008-07-29 22:33:30 +02:00
# notification interval, in seconds
# set to 0 to notify only once
2008-07-30 08:48:37 +02:00
# e.g. 1 day ...
#my $interval = 60*60*24;
# disabled by default
2008-10-31 14:37:49 +01:00
our $ interval = 0 ;
# instead of changing this script, you can put your settings to /etc/mail/postfixadmin/vacation.conf
2009-07-10 23:12:44 +02:00
# or /etc/postfixadmin/vacation.conf just use Perl syntax there to fill the variables listed above
# (without the "our" keyword). Example:
2008-10-31 14:37:49 +01:00
# $db_username = 'mail';
2010-11-01 16:46:16 +01:00
if ( - f '/etc/mail/postfixadmin/vacation.conf' ) {
require '/etc/mail/postfixadmin/vacation.conf' ;
} elsif ( - f '/etc/postfixadmin/vacation.conf' ) {
require '/etc/postfixadmin/vacation.conf' ;
2008-10-31 14:37:49 +01:00
}
2008-07-29 22:33:30 +02:00
2007-03-24 08:27:00 +01:00
# =========== end configuration ===========
2009-06-29 09:58:50 +02:00
if ( $ log_to_file == 1 ) {
if ( ( ! - w $ logfile ) && ( ! - w dirname ( $ logfile ) ) ) {
# Cannot log; no where to write to.
die ( "Cannot create logfile : $logfile" ) ;
}
2008-08-05 22:54:47 +02:00
}
2010-11-01 16:46:16 +01:00
my ( $ from , $ to , $ cc , $ replyto , $ subject , $ messageid , $ lastheader , $ smtp_sender , $ smtp_recipient , % opts , $ test_mode , $ logger ) ;
2008-08-05 22:54:47 +02:00
$ subject = '' ;
2009-01-20 12:53:54 +01:00
$ messageid = 'unknown' ;
2008-08-05 22:54:47 +02:00
# Setup a logger...
#
2009-07-10 23:12:44 +02:00
getopts ( 'f:t:' , \ % opts ) or die "Usage: $0 [-t yes] -f sender -- recipient\n\t-t for testing only\n" ;
2010-11-01 16:46:16 +01:00
$ opts { f } and $ smtp_sender = $ opts { f } or die '-f sender not present on command line' ;
2008-08-05 22:54:47 +02:00
$ test_mode = 0 ;
$ opts { t } and $ test_mode = 1 ;
2010-11-01 16:46:16 +01:00
$ smtp_recipient = shift or die 'recipient not given on command line' ;
2008-08-31 22:17:23 +02:00
2010-11-01 16:46:16 +01:00
my $ log_layout = Log::Log4perl::Layout::PatternLayout - > new ( '%d %p> %F:%L %M - %m%n' ) ;
2008-08-05 22:54:47 +02:00
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 ) ;
2010-11-01 16:46:16 +01:00
$ logger - > debug ( 'Test mode enabled' ) ;
2009-07-10 23:12:44 +02:00
} else {
2008-08-06 16:45:17 +02:00
$ logger = get_logger ( ) ;
2009-06-29 09:58:50 +02:00
if ( $ log_to_file == 1 ) {
2009-07-10 23:12:44 +02:00
# log to file
2009-06-29 09:58:50 +02:00
my $ appender = Log::Log4perl::Appender - > new (
2010-11-01 16:48:38 +01:00
'Log::Dispatch::File' ,
2009-06-29 09:58:50 +02:00
filename = > $ logfile ,
mode = > 'append' ) ;
$ appender - > layout ( $ log_layout ) ;
$ logger - > add_appender ( $ appender ) ;
}
2008-08-05 22:54:47 +02:00
if ( $ syslog == 1 ) {
my $ syslog_appender = Log::Log4perl::Appender - > new (
'Log::Dispatch::Syslog' ,
2011-06-20 14:51:02 +02:00
facility = > 'mail' ,
2008-08-05 22:54:47 +02:00
) ;
$ 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 ) ;
}
2010-11-01 16:46:16 +01:00
binmode ( STDIN , ':encoding(UTF-8)' ) ;
2007-03-24 08:27:00 +01:00
my $ dbh ;
2007-09-20 22:30:07 +02:00
if ( $ db_host ) {
2008-08-05 22:54:47 +02:00
$ dbh = DBI - > connect ( "DBI:$db_type:dbname=$db_name;host=$db_host" , "$db_username" , "$db_password" , { RaiseError = > 1 } ) ;
2007-03-24 08:27:00 +01:00
} else {
2008-08-05 22:54:47 +02:00
$ dbh = DBI - > connect ( "DBI:$db_type:dbname=$db_name" , "$db_username" , "$db_password" , { RaiseError = > 1 } ) ;
2007-03-24 08:27:00 +01:00
}
if ( ! $ dbh ) {
2010-11-01 16:46:16 +01:00
$ logger - > error ( 'Could not connect to database' ) ; # eval { } etc better here?
2008-08-05 22:54:47 +02:00
exit ( 0 ) ;
2007-03-24 08:27:00 +01:00
}
2008-08-03 12:09:29 +02:00
my $ db_true ; # MySQL and PgSQL use different values for TRUE, and unicode support...
2010-11-01 16:46:16 +01:00
if ( $ db_type eq 'mysql' ) {
$ dbh - > do ( 'SET CHARACTER SET utf8;' ) ;
2008-08-05 22:54:47 +02:00
$ db_true = '1' ;
2007-10-16 23:43:57 +02:00
} else { # Pg
2008-08-05 22:54:47 +02:00
$ dbh - > do ( "SET CLIENT_ENCODING TO 'UTF8'" ) ;
$ db_true = 'True' ;
2007-09-20 15:56:37 +02:00
}
2007-03-24 08:27:00 +01:00
# used to detect infinite address lookup loops
my $ loopcount = 0 ;
2012-04-19 23:55:36 +02:00
#
# Get interval_time for email user from the vacation table
#
sub get_interval {
my ( $ to ) = @ _ ;
my $ query = qq{ SELECT interval_time FROM vacation WHERE email=? } ;
my $ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ to ) or panic_execute ( $ query , " 'email='$to'" ) ;
my $ rv = $ stm - > rows ;
if ( $ rv == 1 ) {
my @ row = $ stm - > fetchrow_array ;
my $ interval = $ row [ 0 ] ;
return $ interval ;
} else {
return 0 ;
}
}
2007-03-24 08:27:00 +01:00
sub already_notified {
2008-08-05 22:54:47 +02:00
my ( $ to , $ from ) = @ _ ;
my $ logger = get_logger ( ) ;
2012-04-19 23:19:15 +02:00
# delete old notifications
my $ query = qq{ DELETE vacation_notification.* FROM vacation_notification LEFT JOIN vacation ON vacation.email = vacation_notification.on_vacation WHERE on_vacation = ? AND notified = ? AND notified_at < vacation.activefrom } ;
my $ stm = $ dbh - > prepare ( $ query ) ;
if ( ! $ stm ) {
$ logger - > error ( "Could not prepare query (trying to delete old vacation notifications) :'$query' to: $to, from:$from" ) ;
return 1 ;
}
$ stm - > execute ( $ to , $ from ) ;
2012-04-23 22:57:54 +02:00
$ query = qq{ INSERT into vacation_notification (on_vacation,notified) values (?,?) } ;
$ stm = $ dbh - > prepare ( $ query ) ;
2008-08-05 22:54:47 +02:00
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 ;
2007-03-24 08:27:00 +01:00
2007-08-15 11:08:25 +02:00
# Violation of a primay key constraint may happen here, and that's
# fine. All other error conditions are not fine, however.
2008-08-05 22:54:47 +02:00
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
2009-01-13 15:22:00 +01:00
return 1 ;
2008-08-05 22:54:47 +02:00
}
2012-04-19 23:55:36 +02:00
$ interval = get_interval ( $ to ) ;
2008-08-05 22:54:47 +02:00
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 ) {
2009-09-26 10:17:03 +02:00
$ logger - > info ( "[Interval elapsed, sending the message]: From: $from To:$to" ) ;
2008-08-05 22:54:47 +02:00
$ 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 {
2008-07-29 22:33:30 +02:00
return 1 ;
2008-08-05 22:54:47 +02:00
}
}
return 0 ;
2007-03-24 08:27:00 +01:00
}
2012-04-19 23:10:42 +02:00
#
# Check to see if there is a vacation record against a specific email address.
#
sub check_for_vacation {
my ( $ email_to_check ) = @ _ ;
my $ query = qq{ SELECT email FROM vacation WHERE email=? and active=$db_true and activefrom <= NOW() and activeuntil >= NOW() } ;
my $ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email_to_check ) or panic_execute ( $ query , "email='$email_to_check'" ) ;
my $ rv = $ stm - > rows ;
return $ rv ;
}
2010-11-01 16:48:38 +01:00
# try and determine if email address has vacation turned on; we
2008-08-05 22:54:47 +02:00
# have to do alias searching, and domain aliasing resolution for this.
# If found, return ($num_matches, $real_email);
2007-03-24 08:27:00 +01:00
sub find_real_address {
2008-08-05 22:54:47 +02:00
my ( $ email ) = @ _ ;
my $ logger = get_logger ( ) ;
if ( + + $ loopcount > 20 ) {
2010-11-01 16:48:38 +01:00
$ logger - > error ( "find_real_address loop! (more than 20 attempts!) currently: $email" ) ;
2008-08-05 22:54:47 +02:00
exit ( 1 ) ;
}
my $ realemail = '' ;
2012-04-19 23:10:42 +02:00
my $ rv = check_for_vacation ( $ email ) ;
2007-03-24 08:27:00 +01:00
2007-08-15 11:08:25 +02:00
# Recipient has vacation
2012-04-19 23:19:15 +02:00
if ( $ rv == 1 ) {
$ realemail = $ email ;
$ logger - > debug ( "Found '$email' has vacation active" ) ;
} else {
my $ vemail = $ email ;
$ vemail =~ s/\@/#/g ;
$ vemail = $ vemail . "\@" . $ vacation_domain ;
$ logger - > debug ( "Looking for alias records that '$email' resolves to with vacation turned on" ) ;
my $ query = qq{ SELECT goto FROM alias WHERE address=? AND (goto LIKE ? OR goto LIKE ? OR goto LIKE ? OR goto = ?) } ;
my $ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
$ stm - > execute ( $ email , "$vemail,%" , "%,$vemail" , "%,$vemail,%" , "$vemail" ) or panic_execute ( $ query , "address='$email'" ) ;
$ rv = $ stm - > rows ;
2009-11-05 15:55:39 +01:00
2007-03-24 08:27:00 +01:00
2007-08-15 11:08:25 +02:00
# Recipient is an alias, check if mailbox has vacation
2010-11-01 16:48:38 +01:00
if ( $ rv == 1 ) {
2008-08-05 22:54:47 +02:00
my @ row = $ stm - > fetchrow_array ;
my $ alias = $ row [ 0 ] ;
2009-07-10 23:12:44 +02:00
if ( $ alias =~ /,/ ) {
for ( split ( /\s*,\s*/ , lc ( $ alias ) ) ) {
my $ singlealias = $ _ ;
$ logger - > debug ( "Found alias \'$singlealias\' for email \'$email\'. Looking if vacation is on for alias." ) ;
2012-04-19 23:10:42 +02:00
$ rv = check_for_vacaton ( $ singlealias ) ;
2007-08-15 11:08:25 +02:00
# Alias has vacation
2009-07-10 23:12:44 +02:00
if ( $ rv == 1 ) {
$ realemail = $ singlealias ;
last ;
}
}
} else {
2012-04-19 23:10:42 +02:00
$ rv = check_for_vacation ( $ alias ) ;
2009-07-10 23:12:44 +02:00
# Alias has vacation
if ( $ rv == 1 ) {
$ realemail = $ alias ;
}
2008-08-05 22:54:47 +02:00
}
2007-03-24 08:27:00 +01:00
2009-07-10 23:12:44 +02:00
# We have to look for alias domain (domain1 -> domain2)
} else {
2008-08-05 22:54:47 +02:00
my ( $ user , $ domain ) = split ( /@/ , $ email ) ;
2009-07-10 23:12:44 +02:00
$ logger - > debug ( "Looking for alias domain for $domain / $email / $user" ) ;
$ query = qq{ SELECT target_domain FROM alias_domain WHERE alias_domain=? } ;
2008-08-05 22:54:47 +02:00
$ stm = $ dbh - > prepare ( $ query ) or panic_prepare ( $ query ) ;
2009-07-10 23:12:44 +02:00
$ stm - > execute ( $ domain ) or panic_execute ( $ query , "alias_domain='$domain'" ) ;
2008-08-05 22:54:47 +02:00
$ rv = $ stm - > rows ;
2009-07-10 23:12:44 +02:00
# The domain has a alias domain level alias
if ( $ rv == 1 ) {
2008-08-05 22:54:47 +02:00
my @ row = $ stm - > fetchrow_array ;
2009-07-10 23:12:44 +02:00
my $ alias_domain_dest = $ row [ 0 ] ;
( $ rv , $ realemail ) = find_real_address ( "$user\@$alias_domain_dest" ) ;
# We still have to look for domain level aliases...
2010-11-01 16:48:38 +01:00
} else {
2009-07-10 23:12:44 +02:00
my ( $ user , $ domain ) = split ( /@/ , $ email ) ;
$ logger - > debug ( "Looking for domain level aliases for $domain / $email / $user" ) ;
$ 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 ;
# The receipient has a domain level alias
2010-11-01 16:48:38 +01:00
if ( $ rv == 1 ) {
2009-07-10 23:12:44 +02:00
my @ row = $ stm - > fetchrow_array ;
my $ wildcard_dest = $ row [ 0 ] ;
my ( $ wilduser , $ wilddomain ) = split ( /@/ , $ wildcard_dest ) ;
2007-03-24 08:27:00 +01:00
2007-08-15 11:08:25 +02:00
# Check domain alias
2010-11-01 16:48:38 +01:00
if ( $ wilduser ) {
( $ rv , $ realemail ) = find_real_address ( $ wildcard_dest ) ;
2009-07-10 23:12:44 +02:00
} else {
2010-11-01 16:48:38 +01:00
( $ rv , $ realemail ) = find_real_address ( "$user\@$wilddomain" ) ;
2009-07-10 23:12:44 +02:00
}
2008-08-05 22:54:47 +02:00
} else {
2009-07-10 23:12:44 +02:00
$ logger - > debug ( "No domain level alias present for $domain / $email / $user" ) ;
2008-08-05 22:54:47 +02:00
}
2007-03-24 08:27:00 +01:00
}
2008-08-05 22:54:47 +02:00
}
}
return ( $ rv , $ realemail ) ;
2007-03-24 08:27:00 +01:00
}
2008-08-05 22:54:47 +02:00
# sends the vacation mail to the original sender.
#
2007-03-24 08:27:00 +01:00
sub send_vacation_email {
2008-08-05 22:54:47 +02:00
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 ;
2010-11-01 16:48:38 +01:00
if ( already_notified ( $ email , $ orig_from ) == 1 ) {
2008-08-05 22:54:47 +02:00
$ logger - > debug ( "Already notified $email, or some error prevented us from doing so" ) ;
2010-11-01 16:48:38 +01:00
return ;
2008-08-05 22:54:47 +02:00
}
$ 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 ;
2009-06-29 10:26:35 +02:00
my % smtp_connection ;
2012-05-24 13:14:58 +02:00
my $ friendly_from = "Vacation Service" ;
2009-06-29 10:26:35 +02:00
% smtp_connection = (
'smtp' = > $ smtp_server ,
'port' = > $ smtp_server_port ,
'auth' = > $ smtp_auth ,
'authid' = > $ smtp_authid ,
'authpwd' = > $ smtp_authpwd ,
2012-04-19 23:00:39 +02:00
'smtp_client' = > $ smtp_client ,
2009-06-29 10:26:35 +02:00
'skip_bad_recipients' = > 'true' ,
'encoding' = > 'Base64' ,
'ctype' = > 'text/plain; charset=UTF-8' ,
'headers' = > 'Precedence: junk' ,
'headers' = > 'X-Loop: Postfix Admin Virtual Vacation' ,
2012-05-24 13:14:58 +02:00
'on_errors' = > 'die' , # raise exception on error
2009-06-29 10:26:35 +02:00
) ;
2008-08-05 22:54:47 +02:00
my % mail ;
2009-06-29 10:26:35 +02:00
# I believe Mail::Sender qp encodes the subject, so we no longer need to.
2008-08-05 22:54:47 +02:00
% mail = (
2009-06-29 10:26:35 +02:00
'subject' = > $ subject ,
'from' = > $ from ,
2012-05-24 13:14:58 +02:00
'fake_from' = > $ friendly_from . " <$from>" ,
2009-06-29 10:26:35 +02:00
'to' = > $ to ,
'msg' = > encode_base64 ( $ body )
2008-08-05 22:54:47 +02:00
) ;
if ( $ test_mode == 1 ) {
2009-01-20 12:53:54 +01:00
$ logger - > info ( "** TEST MODE ** : Vacation response sent to $to from $from subject $subject (not) sent\n" ) ;
2008-08-05 22:54:47 +02:00
$ logger - > info ( % mail ) ;
return 0 ;
}
2012-05-24 13:14:58 +02:00
eval {
$ Mail:: Sender:: NO_X_MAILER = 1 ;
my $ sender = new Mail:: Sender ( { % smtp_connection } ) ;
$ sender - > Open ( { % mail } ) ;
$ sender - > SendLineEnc ( $ body ) ;
$ sender - > Close ( ) ;
$ logger - > debug ( "Vacation response sent to $to, from $from" ) ;
} ;
if ( $@ ) {
$ logger - > error ( "Failed to send vacation response: $@ / " . $ Mail:: Sender:: Error ) ;
}
2008-08-05 22:54:47 +02:00
}
2007-03-24 08:27:00 +01:00
}
2009-07-10 23:12:44 +02:00
# Convert a (list of) email address(es) from RFC 822 style addressing to
# RFC 821 style addressing. e.g. convert:
# "John Jones" <JJones@acme.com>, "Jane Doe/Sales/ACME" <JDoe@acme.com>
# to:
# jjones@acme.com, jdoe@acme.com
2008-08-03 12:09:29 +02:00
sub strip_address {
2008-08-05 22:54:47 +02:00
my ( $ arg ) = @ _ ;
if ( ! $ arg ) {
return '' ;
}
2008-08-31 22:17:23 +02:00
my @ ok ;
$ logger = get_logger ( ) ;
2009-01-20 12:53:54 +01:00
my @ list ;
2009-07-10 23:12:44 +02:00
@ list = $ arg =~ m/([\w\.\-\+\'\=_\^\|\$\/\{\}~\?\*\\&\!`\%]+\@[\w\.\-]+\w+)/g ;
2009-01-20 12:53:54 +01:00
foreach ( @ list ) {
#$logger->debug("Checking: $_");
my $ temp = Email::Valid - > address ( - address = > $ _ , - mxcheck = > 0 ) ;
2008-08-31 22:17:23 +02:00
if ( $ temp ) {
push ( @ ok , $ temp ) ;
2009-07-10 23:12:44 +02:00
} else {
2009-01-20 12:53:54 +01:00
$ logger - > debug ( "Email not valid : $Email::Valid::Details" ) ;
}
}
# remove duplicates
my % seen = ( ) ;
my @ uniq ;
2010-11-01 16:46:16 +01:00
foreach my $ item ( @ ok ) {
2009-01-20 12:53:54 +01:00
push ( @ uniq , $ item ) unless $ seen { $ item } + +
2008-08-05 22:54:47 +02:00
}
2009-01-20 12:53:54 +01:00
2010-11-01 16:46:16 +01:00
my $ result = lc ( join ( ', ' , @ uniq ) ) ;
2009-01-20 12:53:54 +01:00
#$logger->debug("Result: $result");
2008-08-31 22:17:23 +02:00
return $ result ;
2008-08-03 12:09:29 +02:00
}
2008-08-05 22:54:47 +02:00
sub panic_prepare {
my ( $ arg ) = @ _ ;
my $ logger = get_logger ( ) ;
$ logger - > error ( "Could not prepare sql statement: '$arg'" ) ;
exit ( 0 ) ;
}
2007-03-24 08:27:00 +01:00
2008-08-05 22:54:47 +02:00
sub panic_execute {
my ( $ arg , $ param ) = @ _ ;
my $ logger = get_logger ( ) ;
$ logger - > error ( "Could not execute sql statement - '$arg' with parameters '$param'" ) ;
exit ( 0 ) ;
}
2008-08-31 22:17:23 +02:00
# Make sure the email wasn't sent by someone who could be a mailing list etc; if it was,
# then we abort after appropriate logging.
sub check_and_clean_from_address {
my ( $ address ) = @ _ ;
my $ logger = get_logger ( ) ;
2010-11-01 16:48:38 +01:00
if ( $ address =~ /^(noreply|postmaster|mailer\-daemon|listserv|majordomo|owner\-|request\-|bounces\-)/i ||
$ address =~ /\-(owner|request|bounces)\@/i ) {
$ logger - > debug ( "sender $address contains $1 - will not send vacation message" ) ;
exit ( 0 ) ;
2008-08-31 22:17:23 +02:00
}
$ address = strip_address ( $ address ) ;
2010-11-01 16:46:16 +01:00
if ( $ address eq '' ) {
2008-08-31 22:17:23 +02:00
$ logger - > error ( "Address $address is not valid; exiting" ) ;
exit ( 0 ) ;
}
#$logger->debug("Address cleaned up to $address");
return $ address ;
}
2008-08-05 22:54:47 +02:00
########################### main #################################
2007-03-24 08:27:00 +01:00
# Take headers apart
2008-08-31 22:17:23 +02:00
$ cc = '' ;
$ replyto = '' ;
2009-01-20 12:53:54 +01:00
$ logger - > debug ( "Script argument SMTP recipient is : '$smtp_recipient' and smtp_sender : '$smtp_sender'" ) ;
2007-03-24 08:27:00 +01:00
while ( <STDIN> ) {
2008-08-05 22:54:47 +02:00
last if ( /^$/ ) ;
2010-11-01 16:48:38 +01:00
if ( /^\s+(.*)/ and $ lastheader ) { $$ lastheader . = " $1" ; next ; }
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 ( /^Reply\-to:\s*(.*)\s*\n$/i ) { $ replyto = $ 1 ; $ lastheader = \ $ replyto ; }
elsif ( /^subject:\s*(.*)\n$/i ) { $ subject = $ 1 ; $ lastheader = \ $ subject ; }
elsif ( /^message\-id:\s*(.*)\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 ) ; }
2009-07-10 23:12:44 +02:00
elsif ( /^x\-facebook\-notify:/i ) { $ logger - > debug ( 'Mail from facebook, ignoring' ) ; exit ( 0 ) ; }
2010-11-01 16:48:38 +01:00
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 ; }
2010-11-01 16:46:16 +01:00
elsif ( /^Auto\-Submitted:/i ) { $ logger - > debug ( 'Auto-Submitted: something found; exiting' ) ; exit ( 0 ) ; }
2011-04-19 23:49:43 +02:00
elsif ( /^List\-(Id|Post|Unsubscribe):/i ) { $ logger - > debug ( "List-$1: found; exiting" ) ; exit ( 0 ) ; }
2009-07-10 23:12:44 +02:00
elsif ( /^(x\-(barracuda\-)?spam\-status):\s+(yes)/i ) { $ logger - > debug ( "$1: $3 found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^(x\-dspam\-result):\s+(spam|bl[ao]cklisted)/i ) { $ logger - > debug ( "$1: $2 found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^(x\-(anti|avas\-)?virus\-status):\s+(infected)/i ) { $ logger - > debug ( "$1: $3 found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^(x\-(avas\-spam|spamtest|crm114|razor|pyzor)\-status):\s+(spam)/i ) { $ logger - > debug ( "$1: $3 found; exiting" ) ; exit ( 0 ) ; }
elsif ( /^(x\-osbf\-lua\-score):\s+[0-9\/\.\-\+]+\s+\[([-S])\]/i ) { $ logger - > debug ( "$1: $2 found; exiting" ) ; exit ( 0 ) ; }
2010-11-01 16:46:16 +01:00
else { $ lastheader = '' ; }
2007-03-24 08:27:00 +01:00
}
2008-09-03 10:44:36 +02:00
if ( $ smtp_recipient =~ /\@$vacation_domain/ ) {
# the regexp used here could probably be improved somewhat, for now hope that people won't use # as a valid mailbox character.
my $ tmp = $ smtp_recipient ;
$ tmp =~ s/\@$vacation_domain// ;
$ tmp =~ s/#/\@/ ;
$ logger - > debug ( "Converted autoreply mailbox back to normal style - from $smtp_recipient to $tmp" ) ;
$ smtp_recipient = $ tmp ;
undef $ tmp ;
}
2007-03-24 08:27:00 +01:00
# If either From: or To: are not set, exit
2010-11-01 16:48:38 +01:00
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 ) ;
2008-08-05 22:54:47 +02:00
}
2009-01-20 12:53:54 +01:00
$ logger - > debug ( "Email headers have to: '$to' and From: '$from'" ) ;
2008-08-31 22:17:23 +02:00
$ to = strip_address ( $ to ) ;
2009-07-10 23:12:44 +02:00
$ cc = strip_address ( $ cc ) ;
2008-08-31 22:17:23 +02:00
$ from = check_and_clean_from_address ( $ from ) ;
2010-11-01 16:46:16 +01:00
if ( $ replyto ne '' ) {
2008-08-31 22:17:23 +02:00
# if reply-to is invalid, or looks like a mailing list, then we probably don't want to send a reply.
$ replyto = check_and_clean_from_address ( $ replyto ) ;
2008-08-05 22:54:47 +02:00
}
2008-08-31 22:17:23 +02:00
$ smtp_sender = check_and_clean_from_address ( $ smtp_sender ) ;
$ smtp_recipient = check_and_clean_from_address ( $ smtp_recipient ) ;
2008-08-05 22:54:47 +02:00
2010-11-01 16:48:38 +01:00
if ( $ smtp_sender eq $ smtp_recipient ) {
$ logger - > debug ( "smtp sender $smtp_sender and recipient $smtp_recipient are the same; aborting" ) ;
exit ( 0 ) ;
2008-08-05 22:54:47 +02:00
}
2008-08-31 22:17:23 +02:00
for ( split ( /,\s*/ , lc ( $ to ) ) , split ( /,\s*/ , lc ( $ cc ) ) ) {
2009-07-10 23:12:44 +02:00
my $ header_recipient = strip_address ( $ _ ) ;
2010-11-01 16:48:38 +01:00
if ( $ smtp_sender eq $ header_recipient ) {
$ logger - > debug ( "sender header $smtp_sender contains recipient $header_recipient (mailing myself?)" ) ;
exit ( 0 ) ;
2008-08-05 22:54:47 +02:00
}
2008-08-03 12:09:29 +02:00
}
2007-03-24 08:27:00 +01:00
2008-08-05 22:54:47 +02:00
my ( $ rv , $ email ) = find_real_address ( $ smtp_recipient ) ;
2008-08-03 12:09:29 +02:00
if ( $ rv == 1 ) {
2008-08-05 22:54:47 +02:00
$ 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 ) ;
2009-07-10 23:12:44 +02:00
} else {
2008-08-31 22:17:23 +02:00
$ logger - > debug ( "SMTP recipient $smtp_recipient which resolves to $email does not have an active vacation (rv: $rv, email: $email)" ) ;
2007-03-24 08:27:00 +01:00
}
0 ;
#/* vim: set expandtab softtabstop=3 tabstop=3 shiftwidth=3: */