<html xmlns:v="urn:schemas-microsoft-com:vml" xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:w="urn:schemas-microsoft-com:office:word" xmlns:m="http://schemas.microsoft.com/office/2004/12/omml" xmlns="http://www.w3.org/TR/REC-html40"> <head> <meta http-equiv=Content-Type content="text/html; charset=iso-8859-1"> <meta name=Generator content="Microsoft Word 12 (filtered medium)">  <style>  </style>  </head> <body lang=EN-US link=blue vlink=purple> <div class=Section1> Buenos días a todos, tengo el siguiente inconveniente:<o:p></o:p> <o:p> </o:p> He levantado un servidor de correos con postfix el cual tiene habilitada la autenticación de usuarios para el SMTP (para evitar intentos de SPAM), además he configurado el postfixadmin para la administración de la base de datos de los correos, he querido habilitar la función Vacation del postfixadmin y el problema es que el script en perl que trae no está programado con la autenticación de los usuarios (nunca he programado en Perl), en el log del vacation.pl aparece el siguiente error:<o:p></o:p> <o:p> </o:p> RCPT TO: error (554 5.7.1 <dirección@dominio.com.pe>: Relay access denied)<o:p></o:p> <o:p> </o:p> El contenido del script es el siguiente:<o:p></o:p> <o:p> </o:p> #!/usr/bin/perl -w<o:p></o:p> #<o:p></o:p> # Virtual Vacation 3.1<o:p></o:p> # by Mischa Peters <mischa at high5 dot net><o:p></o:p> # Copyright (c) 2002 - 2005 High5!<o:p></o:p> # Licensed under GPL for more info check GPL-LICENSE.TXT<o:p></o:p> #<o:p></o:p> # Additions:<o:p></o:p> # 2004/07/13 David Osborn <ossdev at daocon.com><o:p></o:p> # strict, processes domain level aliases, more<o:p></o:p> # subroutines, send reply from original to address<o:p></o:p> #<o:p></o:p> # 2004/11/09 David Osborn <ossdev at daocon.com><o:p></o:p> # Added syslog support <o:p></o:p> # Slightly better logging which includes messageid<o:p></o:p> # Avoid infinite loops with domain aliases<o:p></o:p> #<o:p></o:p> # 2005-01-19 Troels Arvin <troels@arvin.dk><o:p></o:p> # PostgreSQL-version.<o:p></o:p> # Normalized DB schema from one vacation table ("vacation")<o:p></o:p> # to two ("vacation", "vacation_notification"). Uses<o:p></o:p> # referential integrity CASCADE action to simplify cleanup<o:p></o:p> # when a user is no longer on vacation.<o:p></o:p> # Inserting variables into queries stricly by prepare()<o:p></o:p> # to try to avoid SQL injection.<o:p></o:p> # International characters are now handled well.<o:p></o:p> #<o:p></o:p> # 2005-01-21 Troels Arvin <troels@arvin.dk><o:p></o:p> # Uses the Email::Valid package to avoid sending notices<o:p></o:p> # to obviously invalid addresses.<o:p></o:p> #<o:p></o:p> # 2007-08-15 David Goodwin <david@palepurple.co.uk><o:p></o:p> # Use the Perl Mail::Sendmail module for sending mail<o:p></o:p> # Check for headers that start with blank lines (patch from forum)<o:p></o:p> #<o:p></o:p> # 2007-08-20 Martin Ambroz <amsys@trustica.cz><o:p></o:p> # Added initial Unicode support<o:p></o:p> #<o:p></o:p> # 2008-05-09 Fabio Bonelli <fabiobonelli@libero.it><o:p></o:p> # Properly handle failed queries to vacation_notification.<o:p></o:p> # Fixed log reporting.<o:p></o:p> #<o:p></o:p> # Requirements:<o:p></o:p> # You need to have the DBD::Pg or DBD::mysql perl-module installed.<o:p></o:p> # You need to have the Mail::Sendmail module installed. <o:p></o:p> # You need to have the Email::Valid module installed.<o:p></o:p> # You need to have the MIME::Charset module installed.<o:p></o:p> # You need to have the MIME::EncWords module installed.<o:p></o:p> #<o:p></o:p> # On Debian based systems : <o:p></o:p> # libmail-sendmail-perl<o:p></o:p> # libdbd-pg-perl<o:p></o:p> # libemail-valid-perl<o:p></o:p> # libmime-perl<o:p></o:p> # libmime-charset-perl (currently in testing, see instructions below)<o:p></o:p> # libmime-encwords-perl (currently in testing, see instructions below)<o:p></o:p> #<o:p></o:p> # Note: When you use this module, you may start seeing error messages<o:p></o:p> # like "Cannot insert a duplicate key into unique index<o:p></o:p> # vacation_notification_pkey" in your system logs. This is expected<o:p></o:p> # behavior, and not an indication of trouble (see the "already_notified"<o:p></o:p> # subroutine for an explanation).<o:p></o:p> #<o:p></o:p> # You must also have the Email::Valid and MIME-tools perl-packages<o:p></o:p> # installed. They are available in some package collections, under the<o:p></o:p> # names 'perl-Email-Valid' and 'perl-MIME-tools', respectively.<o:p></o:p> # One such package collection (for Linux) is:<o:p></o:p> # http://dag.wieers.com/home-made/apt/packages.php<o:p></o:p> #<o:p></o:p> <o:p> </o:p> # ========== begin configuration ==========<o:p></o:p> <o:p> </o:p> # IMPORTANT: If you put passwords into this script, then remember<o:p></o:p> # to restrict access to the script, so that only the vacation user<o:p></o:p> # can read it.<o:p></o:p> <o:p> </o:p> # db_type - uncomment one of these<o:p></o:p> #my $db_type = 'Pg';<o:p></o:p> my $db_type = 'mysql';<o:p></o:p> <o:p> </o:p> # leave empty for connection via UNIX socket<o:p></o:p> my $db_host = 'localhost';<o:p></o:p> <o:p> </o:p> # connection details<o:p></o:p> my $db_username = 'root';<o:p></o:p> my $db_password = 'xxxxxxx';<o:p></o:p> my $db_name = 'postfix';<o:p></o:p> <o:p> </o:p> # smtp server used to send vacation e-mails<o:p></o:p> my $smtp_server = 'localhost';<o:p></o:p> <o:p> </o:p> my $syslog = 1;<o:p></o:p> <o:p> </o:p> # path to logfile, when empty logging is supressed<o:p></o:p> my $logfile='/var/log/vacation/vacation.log';<o:p></o:p> #my $logfile = "/var/log/vacation/vacation.log";<o:p></o:p> # path to file for debugging, debug supressed when empty<o:p></o:p> my $debugfile='/ var/log/vacation/vacation.debug';<o:p></o:p> #my $debugfile = "/var/log/vacation/vacation.debug";<o:p></o:p> <o:p> </o:p> # =========== end configuration ===========<o:p></o:p> <o:p> </o:p> use DBI;<o:p></o:p> use MIME::Base64;<o:p></o:p> use MIME::EncWords qw(:all);<o:p></o:p> use Email::Valid;<o:p></o:p> use strict;<o:p></o:p> use Mail::Sendmail;<o:p></o:p> <o:p> </o:p> binmode (STDIN,':utf8');<o:p></o:p> <o:p> </o:p> my $dbh;<o:p></o:p> if ($db_host) {<o:p></o:p> $dbh = DBI->connect("DBI:$db_type:dbname=$db_name;host=$db_host","$db_username", "$db_password", { RaiseError => 1 });<o:p></o:p> } else {<o:p></o:p> $dbh = DBI->connect("DBI:$db_type:dbname=$db_name","$db_username", "$db_password", { RaiseError => 1 });<o:p></o:p> }<o:p></o:p> <o:p> </o:p> if (!$dbh) {<o:p></o:p> panic("Could not connect to database");<o:p></o:p> exit(0);<o:p></o:p> }<o:p></o:p> <o:p> </o:p> my $db_true; # MySQL and PgSQL use different values for TRUE<o:p></o:p> if ($db_type eq "mysql") {<o:p></o:p> $dbh->do("SET CHARACTER SET utf8;");<o:p></o:p> $db_true = '1';<o:p></o:p> } else { # Pg<o:p></o:p> # TODO: SET CHARACTER SET is mysql only, needs FIX for ALL databases<o:p></o:p> $db_true = 'True';<o:p></o:p> }<o:p></o:p> <o:p> </o:p> # used to detect infinite address lookup loops<o:p></o:p> my $loopcount=0;<o:p></o:p> <o:p> </o:p> sub do_debug {<o:p></o:p> if ( $debugfile ) {<o:p></o:p> my $date;<o:p></o:p> open (DEBUG, ">> $debugfile") or die ("Unable to open debug file");<o:p></o:p> binmode (DEBUG, ':utf8');<o:p></o:p> chop ($date = `date "+%Y/%m/%d %H:%M:%S"`);<o:p></o:p> print DEBUG "====== $date ======\n";<o:p></o:p> my $i;<o:p></o:p> for ($i=0;$i<$#_;$i++) {<o:p></o:p> print DEBUG $_[$i], ' | ';<o:p></o:p> }<o:p></o:p> print DEBUG $_[($#_)], "\n";<o:p></o:p> close (DEBUG);<o:p></o:p> }<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub already_notified {<o:p></o:p> my ($to, $from) = @_;<o:p></o:p> my $query = qq{INSERT into vacation_notification (on_vacation,notified) values (?,?)};<o:p></o:p> my $stm = $dbh->prepare($query);<o:p></o:p> if (!$stm) {<o:p></o:p> do_log('',$to,$from,'',"Could not prepare query $query");<o:p></o:p> return 1;<o:p></o:p> }<o:p></o:p> $stm->{'PrintError'} = 0;<o:p></o:p> $stm->{'RaiseError'} = 0;<o:p></o:p> if (!$stm->execute($to,$from)) {<o:p></o:p> my $e=$dbh->errstr;<o:p></o:p> <o:p> </o:p> # Violation of a primay key constraint may happen here, and that's<o:p></o:p> # fine. All other error conditions are not fine, however.<o:p></o:p> if ($e !~ /_pkey/) {<o:p></o:p> do_log('',$to,$from,'',"Unexpected error: '$e' from query '$query'");<o:p></o:p> <o:p> </o:p> # Let's play safe and notify anyway<o:p></o:p> return 0;<o:p></o:p> }<o:p></o:p> return 1;<o:p></o:p> }<o:p></o:p> return 0;<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub do_log {<o:p></o:p> my ($messageid, $to, $from, $subject, $logmessage) = @_;<o:p></o:p> my $date;<o:p></o:p> if ( $syslog ) {<o:p></o:p> open (SYSLOG, "|/usr/bin/logger -p mail.info -t Vacation") or die ("Unable to open logger"); <o:p></o:p> binmode(SYSLOG, ':utf8');<o:p></o:p> if ($logmessage) {<o:p></o:p> printf SYSLOG "Orig-To: %s From: %s MessageID: %s Subject: %s. Log message: %s", $to, $from, $messageid, $subject, $logmessage;<o:p></o:p> } else {<o:p></o:p> printf SYSLOG "Orig-To: %s From: %s MessageID: %s Subject: %s", $to, $from, $messageid, $subject;<o:p></o:p> }<o:p></o:p> close (SYSLOG); <o:p></o:p> }<o:p></o:p> if ( $logfile ) {<o:p></o:p> open (LOG, ">> $logfile") or die ("Unable to open log file");<o:p></o:p> binmode (LOG, ':utf8');<o:p></o:p> chop ($date = `date "+%Y/%m/%d %H:%M:%S"`);<o:p></o:p> if ($logmessage) {<o:p></o:p> print LOG "$date: To: $to From: $from Subject: $subject MessageID: $messageid. Log message: $logmessage\n";<o:p></o:p> } else {<o:p></o:p> print LOG "$date: To: $to From: $from Subject: $subject MessageID: $messageid\n";<o:p></o:p> }<o:p></o:p> close (LOG);<o:p></o:p> }<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub do_mail {<o:p></o:p> # from, to, subject, body<o:p></o:p> my ($from, $to, $subject, $body) = @_;<o:p></o:p> my $vacation_subject = encode_mimewords($subject, 'Encoding'=> 'q', 'Charset'=>'utf-8', 'Field'=>'Subject');<o:p></o:p> my %mail;<o:p></o:p> %mail = (<o:p></o:p> 'smtp' => $smtp_server,<o:p></o:p> 'Subject' => $vacation_subject,<o:p></o:p> 'From' => $from,<o:p></o:p> 'To' => $to,<o:p></o:p> 'MIME-Version' => '1.0',<o:p></o:p> 'Content-Type' => 'text/plain; charset=UTF-8',<o:p></o:p> 'Content-Transfer-Encoding' => 'base64',<o:p></o:p> 'Precedence' => 'junk',<o:p></o:p> 'X-Loop' => 'Postfix Admin Virtual Vacation',<o:p></o:p> 'Message' => encode_base64($body)<o:p></o:p> );<o:p></o:p> sendmail(%mail) or do_log($Mail::Sendmail::error);<o:p></o:p> do_debug('Mail::Sendmail said :' . $Mail::Sendmail::log);<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub panic {<o:p></o:p> my ($arg) = @_;<o:p></o:p> do_log('','','','',"$arg");<o:p></o:p> exit(0);<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub panic_prepare {<o:p></o:p> my ($arg) = @_;<o:p></o:p> do_log('','','','',"Could not prepare '$arg'");<o:p></o:p> exit(0);<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub panic_execute {<o:p></o:p> my ($arg,$param) = @_;<o:p></o:p> do_log('','','','',"Could not execute '$arg' with parameters $param");<o:p></o:p> exit(0);<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub find_real_address {<o:p></o:p> my ($email) = @_;<o:p></o:p> if (++$loopcount > 20) {<o:p></o:p> do_log ("find_real_address loop!", "currently: $email", "ERROR", "ERROR"); <o:p></o:p> panic("possible infinite loop in find_real_address for <$email>. Check for alias loop\n");<o:p></o:p> }<o:p></o:p> my $realemail;<o:p></o:p> my $query = qq{SELECT email FROM vacation WHERE email=? and active=$db_true};<o:p></o:p> my $stm = $dbh->prepare($query) or panic_prepare($query);<o:p></o:p> $stm->execute($email) or panic_execute($query,"email='$email'");<o:p></o:p> my $rv = $stm->rows;<o:p></o:p> <o:p> </o:p> # Recipient has vacation<o:p></o:p> if ($rv == 1) {<o:p></o:p> $realemail = $email;<o:p></o:p> } else {<o:p></o:p> $query = qq{SELECT goto FROM alias WHERE address=?};<o:p></o:p> $stm = $dbh->prepare($query) or panic_prepare($query);<o:p></o:p> $stm->execute($email) or panic_execute($query,"address='$email'");<o:p></o:p> $rv = $stm->rows;<o:p></o:p> <o:p> </o:p> # Recipient is an alias, check if mailbox has vacation<o:p></o:p> if ($rv == 1) { <o:p></o:p> my @row = $stm->fetchrow_array;<o:p></o:p> my $alias = $row[0];<o:p></o:p> $query = qq{SELECT email FROM vacation WHERE email=? and active=$db_true};<o:p></o:p> $stm = $dbh->prepare($query) or panic_prepare($query);<o:p></o:p> $stm->execute($alias) or panic_prepare($query,"email='$alias'");<o:p></o:p> $rv = $stm->rows;<o:p></o:p> <o:p> </o:p> # Alias has vacation<o:p></o:p> if ($rv == 1) {<o:p></o:p> $realemail = $alias;<o:p></o:p> }<o:p></o:p> <o:p> </o:p> # We still have to look for domain level aliases...<o:p></o:p> } else { <o:p></o:p> my ($user, $domain) = split(/@/, $email);<o:p></o:p> $query = qq{SELECT goto FROM alias WHERE address=?};<o:p></o:p> $stm = $dbh->prepare($query) or panic_prepare($query);<o:p></o:p> $stm->execute("\@$domain") or panic_execute($query,"address='\@$domain'");<o:p></o:p> $rv = $stm->rows;<o:p></o:p> <o:p> </o:p> # The receipient has a domain level alias<o:p></o:p> if ($rv == 1) { <o:p></o:p> my @row = $stm->fetchrow_array;<o:p></o:p> my $wildcard_dest = $row[0];<o:p></o:p> my ($wilduser, $wilddomain) = split(/@/, $wildcard_dest);<o:p></o:p> <o:p> </o:p> # Check domain alias<o:p></o:p> if ($wilduser) { <o:p></o:p> ($rv, $realemail) = find_real_address ($wildcard_dest); <o:p></o:p> } else {<o:p></o:p> my $new_email = $user . '@' . $wilddomain;<o:p></o:p> ($rv, $realemail) = find_real_address ($new_email); <o:p></o:p> }<o:p></o:p> }<o:p></o:p> }<o:p></o:p> }<o:p></o:p> return ($rv, $realemail);<o:p></o:p> }<o:p></o:p> <o:p> </o:p> sub send_vacation_email {<o:p></o:p> my ($email, $orig_from, $orig_to, $orig_messageid) = @_;<o:p></o:p> my $query = qq{SELECT subject,body FROM vacation WHERE email=?};<o:p></o:p> my $stm = $dbh->prepare($query) or panic_prepare($query);<o:p></o:p> $stm->execute($email) or panic_execute($query,"email='$email'");<o:p></o:p> my $rv = $stm->rows;<o:p></o:p> if ($rv == 1) {<o:p></o:p> my @row = $stm->fetchrow_array;<o:p></o:p> if (already_notified($email, $orig_from)) { return; }<o:p></o:p> 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");<o:p></o:p> <o:p> </o:p> # do_mail(from, to, subject, body);<o:p></o:p> do_mail ($email, $orig_from, $row[0], $row[1]);<o:p></o:p> do_log ($orig_messageid, $orig_to, $orig_from, ''); <o:p></o:p> }<o:p></o:p> <o:p> </o:p> }<o:p></o:p> <o:p> </o:p> ########################### main #################################<o:p></o:p> <o:p> </o:p> my ($from, $to, $cc, $subject, $messageid, $lastheader);<o:p></o:p> <o:p> </o:p> $subject='';<o:p></o:p> <o:p> </o:p> # Take headers apart<o:p></o:p> while (<STDIN>) {<o:p></o:p> last if (/^$/);<o:p></o:p> if (/^\s+(.*)/ and $lastheader) { $$lastheader .= " $1"; } <o:p></o:p> elsif (/^from:\s+(.*)\n$/i) { $from = $1; $lastheader = \$from; } <o:p></o:p> elsif (/^to:\s+(.*)\n$/i) { $to = $1; $lastheader = \$to; } <o:p></o:p> elsif (/^cc:\s+(.*)\n$/i) { $cc = $1; $lastheader = \$cc; } <o:p></o:p> elsif (/^subject:\s+(.*)\n$/i) { $subject = $1; $lastheader = \$subject; } <o:p></o:p> elsif (/^message-id:\s+(.*)\n$/i) { $messageid = $1; $lastheader = \$messageid; } <o:p></o:p> elsif (/^x-spam-(flag|status):\s+yes/i) { exit (0); } <o:p></o:p> elsif (/^precedence:\s+(bulk|list|junk)/i) { exit (0); } <o:p></o:p> elsif (/^x-loop:\s+postfix\ admin\ virtual\ vacation/i) { exit (0); } <o:p></o:p> else {$lastheader = "" ; }<o:p></o:p> }<o:p></o:p> <o:p> </o:p> # If either From: or To: are not set, exit<o:p></o:p> if (!$from || !$to || !$messageid) { exit (0); }<o:p></o:p> <o:p> </o:p> $from = lc ($from);<o:p></o:p> <o:p> </o:p> if (!Email::Valid->address($from,-mxcheck => 1)) { do_debug("Invalid from email address: $from; exiting."); exit(0); }<o:p></o:p> <o:p> </o:p> # Check if it's an obvious sender, exit<o:p></o:p> if ($from =~ /([\w\-.%]+\@[\w.-]+)/) { $from = $1; }<o:p></o:p> if ($from eq "" || $from =~ /^owner-|-(request|owner)\@|^(mailer-daemon|postmaster)\@/i) { exit (0); }<o:p></o:p> <o:p> </o:p> # Strip To: and Cc: and push them in array<o:p></o:p> my @strip_cc_array; <o:p></o:p> my @strip_to_array = split(/, */, lc ($to) );<o:p></o:p> if (defined $cc) { @strip_cc_array = split(/, */, lc ($cc) ); }<o:p></o:p> push (@strip_to_array, @strip_cc_array);<o:p></o:p> <o:p> </o:p> my @search_array;<o:p></o:p> <o:p> </o:p> # Strip email address from headers<o:p></o:p> for (@strip_to_array) {<o:p></o:p> if ($_ =~ /([\w\-.%]+\@[\w.-]+)/) { <o:p></o:p> push (@search_array, $1); <o:p></o:p> do_debug ("[STRIP RECIPIENTS]: ", $messageid, $1);<o:p></o:p> }<o:p></o:p> }<o:p></o:p> <o:p> </o:p> # Search for email address which has vacation<o:p></o:p> for (@search_array) {<o:p></o:p> /([\w\-.%]+\@[\w.-]+)/ or next; <o:p></o:p> my $addr = $1;<o:p></o:p> my ($rv, $email) = find_real_address ($addr);<o:p></o:p> if ($rv == 1) {<o:p></o:p> do_debug ("[FOUND VACATION]: ", $messageid, $from, $to, $email);<o:p></o:p> send_vacation_email( $email, $from, $to, $messageid);<o:p></o:p> }<o:p></o:p> }<o:p></o:p> <o:p> </o:p> 0;<o:p></o:p> <o:p> </o:p> #/* vim: set expandtab softtabstop=3 tabstop=3 shiftwidth=3: */<o:p></o:p> <o:p> </o:p> <o:p> </o:p> Alguna idea para solucionarlo?<o:p></o:p> <o:p> </o:p> Gracias de antemano<o:p></o:p> <table class=MsoNormalTable border=0 cellpadding=0 width=289 style='width:216.75pt'> <tr> <td width=60 style='width:45.0pt;padding:.75pt .75pt .75pt .75pt'> <img width=60 height=60 id="Imagen_x0020_1" src="cid:image001.jpg@01C99644.3F934B50" alt="http://www.fuvensa.com/images/CH&T%20-%20Logo.jpg"><o:p></o:p> </td> <td width=219 style='width:164.25pt;padding:.75pt .75pt .75pt .75pt'> Humberto Luis Salardi Chú<o:p></o:p> Telefax: (511) 243 2234<o:p></o:p> Móvil: (511) 99789 9040<o:p></o:p> Nextel: 51*415*0170<o:p></o:p> email: <a href="mailto:hsalardi@fuvensa.com">hsalardi@fuvensa.com</a><o:p></o:p> URL: <a href="http://www.fuvensa.com">http://www.fuvensa.com</a><o:p></o:p> </td> </tr> </table> <o:p> </o:p> <o:p> </o:p> </div> </body> </html>