Index: [Article Count Order] [Thread]

Date:  Wed, 19 Dec 2007 16:52:07 +0200
From:  Arthur Sherman <arturs (at mark) netvision.net.il>
Subject:  [coba-e:11561] Re: vacation.pl - Version 1.1.1.2.stable.sendmail.07
To:  coba-e (at mark) bluequartz.org
Message-Id:  <02eb01c8424e$ba233150$e5b418ac@dell>
In-Reply-To:  <20071219172401.53728604@patricko>
X-Mail-Count: 11561


Thanks a lot for this.

Could you re-post the script within attachment?
Some lines are garbled.


Best,
--

Arthur Sherman 

> -----Original Message-----
> From: patricko [mailto:patricko (at mark) staff.singnet.com.sg] 
> Sent: Wednesday, December 19, 2007 11:24 AM
> To: coba-e (at mark) bluequartz.org
> Subject: [coba-e:11556] vacation.pl - Version 
> 1.1.1.2.stable.sendmail.07
> 
> 
> 
> Hi Blues,
> 
>  Some updates on vacation.pl.
> 
>  Recently, I got a newer bluequartz box and seem sendmail 
> permission is stopping me.
>  Dump info show all fields are correct.
> 
>  So I have to loosen sendmail permission by hardcoding 
> Envelope fields.
> 
> 
> 
> #!/usr/bin/perl -w -I/usr/sausalito/perl # $Id: vacation.pl,v 
> 1.1.1.2 2004/01/03 06:28:35 shibuya Exp $ # Copyright 2000, 
> 2001 Sun Microsystems, Inc., All rights reserved.
> 
> # usage: vacation.pl [message] [from-address]
> 
> # Version 1.1.1.2.stable.sendmail.07
> # modified by patricko (at mark) staff.singnet.com.sg 20071219 # 
> Changelog: Try 1: fixed local loop. eg: auto-reply to 
> mailer-daemon # Changelog: Try 2: Fixed compat issue with MS 
> Outlook 2003 webmail # Changelog: Try 3: Drop invalid from: 
> entries # Changelog: Try 4: Parse mailto: entries, let .db 
> handle 1 notice for n days # Changelog: Try 5: Detection 
> changed to 'From ' instead of 'From: ', try 4 is void # 
> Changelog: Try 6: Move STDIN code section up # Changelog: Try 
> 7: Reduce one CCE lockup See: 1.0 #################### 
> Special, custom NON RFC only for Sendmail ################### 
> # ps: By doing so, no changes to existing CCE schema and 
> sendmail build
> #     This script will reply via RCPT TO:(derived) from the 
> 'for' field
> #     *** In another word, this version taken care of 
> email/domain aliases ***
> #
> # Changelog: Try 8: Factor in Sendmail >= 8.12 log format, 
> /for/ # Changelog: Try 9: Use Sendmail 'for' TAG to reply 
> mail 
> ##############################################################
####################
> # Changelog: Try 10: If 'for' TAG doesnt exist then revert 
> back to OLD CODE # Changelog: Try 11: Speed up email <header> 
> passing as <body> is dropped # Changelog: Try 12: Set 'for' 
> TAG to null when address is invalid # Changelog: Try 13: 
> Re-Commented and adjusted some whitespace # Changelog: Try 
> 14: Unbuffered output for STDIN # Changelog: Try 15: 
> Commented out Breakloop and use proper loop exit # Changelog: 
> Try 16: Fixed Cannot send out vacation msg coz sendmail 
> permission on some platforms
> #                    - dsn=5.6.0, stat=Data format error, 
> from=<username>@<DOMAIN is missing>
> #                    Workaround: HARDCODED the Envelope, 
> From: root and To: Receipent on $Sendmail -froot -oi $sendto
> #                    NOTE: add 'root' to /etc/mail/trusted-users
> # Changelog: Try 17: Add Log4perl perl module for debugging - 
> COMMENTED OUT
> #                    NOTE: you have to install 
> Log-Dispatch-2.20.tar.gz, Log-Log4perl-1.14.tar.gz
> use strict;
> use lib qw( /usr/sausalito/perl );
> use Sauce::Config;
> use CCE;
> use I18n;
> use Jcode;
> use DB_File;
> use Fcntl qw(O_RDWR O_CREAT F_SETLKW F_UNLCK); use 
> FileHandle; use I18nMail;
> 
> # Declare DEBUGGING
> #use Log::Log4perl;
> 
> #my $log_conf = q/
> #    log4perl.category = INFO, Logfile, Screen
> #
> #    log4perl.appender.Logfile = Log::Log4perl::Appender::File
> #    log4perl.appender.Logfile.filename = debug-vacation-pl.log
> #    log4perl.appender.Logfile.mode = append
> #    log4perl.appender.Logfile.layout = 
> Log::Log4perl::Layout::SimpleLayout
> #
> #    log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
> #    log4perl.appender.Screen.layout = 
> Log::Log4perl::Layout::SimpleLayout
> #/;
> 
> #Log::Log4perl::init( \$log_conf );
> #my $logger = Log::Log4perl::get_logger();
> 
> # TESTING - Test variables
> #$logger->info("Starting $0");
> #$logger->error("Bad thing happened");
> 
> ### Add by patricko (at mark) staff.singnet.com.sg 20060725 my  (at mark) ignores = (
>            'mailer-daemon',
>            'mailer',
>            'daemon',
>            'postmaster',
>            'root',
>            );
> 
> my ($opt_d)=(0);
> ### End Add by patricko (at mark) staff.singnet.com.sg 20060725
> 
> my ($message_file,$user_from) = @ARGV;
> 
> my $Sendmail = Sauce::Config::bin_sendmail;
> 
> my @pwent = getpwnam($user_from);
> my $Vaca_dir = $pwent[7];
> 
> my $i18n=new I18n;
> 
> ##### READ from STDIN and parse for variables, patricko
> 
> # set up variables for below
> my ($sendto,$sender,$returnpath,$from,$replyto,$precedence,$for);
> my $crlf = qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; # We are liberal 
> in what we accept.
>                                             # But then, so is 
> a six dollar whore.
> 
> # Chop email message into <header> portion and discard the 
> <body> # # RFC 822 states that the 1st blank line is start of 
> message body # RFC 2822 ie.
> # (optional)  From:
> # (optional)  Sender:
> # (optional)  To:
> # (optional)  Subject:
> # (Mandatory) Date:
> #
> # or reverse
> #
> 
> $|=1; # Use unbuffered output for STDIN
> while (<STDIN>)
> {
>    
>     #if    (/^From:\s*(.+)/)        { $from = $1;       }
>     if    (/^From\s+(\S+)/)        { $from = $1;       }
>     elsif (/^Reply-To:\s*(.+)/)    { $replyto = $1;    }
>     elsif (/^Sender:\s*(.+)/)       { $sender = $1;     }
>     elsif (/^Return-path:\s*(.+)/)  { $returnpath = $1; }
>     elsif (/^Precedence:\s*(.+)/)   { $precedence = $1; }
>     elsif (/^\tfor\s+(\S+)/)        { $for = $1;        }
>     #elsif (/^$crlf/)                { goto breakloop    } 
>     elsif (/^$crlf/)                { last;             } 
> 
> }
> 
> # Dirty way of breaking a loop
> # 100% confirmed that variables after this line dont have <body>
> breakloop:
> 
> # Discard <precedence> mail, no (auto-)reply exit if (defined 
> $precedence && $precedence =~ /bulk|junk/oi);
> 
> # Pass variables to crafted (auto-)reply
> if    ($replyto)     { $sendto = $replyto;     }
> elsif ($from)        { $sendto = $from;        }
> elsif ($sender)      { $sendto = $sender;      }
> elsif ($returnpath)  { $sendto = $returnpath;  }
> else                 { exit;                   }
> 
>    # Super safe - email address malform checks
>    # Error control - Fuzzy logic, FROM:  MUST be valid else exit 
>    ## Extract <for> value: address, if any
>    ### DONT EXIT below condtion 'See 1.0' check again
>    if ($for !~ /@/i)                             { $for = ""; }
>    elsif ($for =~ /[\w_\.\-]+[ (at mark) %][\w_\.\-]+/)    { $for = $&; }
>    else                                          { $for = ""; }
> 
>    # Super safe - email address malform checks
>    # Error control - Fuzzy logic, TO:  MUST be valid else exit
>    ## Check for @ and extract email address, if any 
>    if ($sendto !~ /@/i)                          { exit;         }
>    elsif ($sendto =~ /[\w_\.\-]+[ (at mark) %][\w_\.\-]+/) { $sendto = $&; }
>    else                                          { exit;         }
> 
>    # Prevent local mail loop
>    ## Ignore local email users, prevent loop
>    for (@ignores) {if ($sendto =~ /^$_/i)        { exit;         }}
> 
> 
> ##### END READ from STDIN and parse for variables, patricko
> 
> 
> ### START CCE Session, patricko
> 
> # gather info from cce
> my $cce = new CCE;
> $cce->connectuds();
> 
> my $username = $user_from;
> 
> my ($oid) = $cce->find("User", { 'name' => $user_from }); my 
> ($ok, $user) = $cce->get($oid);
> 
> if( not $ok ) { 
>         $cce->bye('FAIL', '[[base-email.cantGetUserInfo]]'); 
>         exit(255);
> }
> 
> #### See 1.0
> if ($for) {$user_from = $for;}
> else
> {
>  if ($user->{site} ne '')
>  {
>         my ($v_oid) = $cce->find('Vsite', { 'name' => 
> $user->{site} });
>         my ($v_ok, $vsite) = $cce->get($v_oid);
>         
>         $user_from .= ' (at mark) ' . $vsite->{fqdn};  } }
> 
> # set locale for i18n
> my $locale = $user->{localePreference};
> if( not -d "/usr/share/locale/$locale" && not -d 
> "/usr/local/share/locale/$locale" ) {
>         $locale = I18n::i18n_getSystemLocale($cce); }
> 
> my $fullname = $user->{fullName};
> $fullname ||= $user_from;
> 
> $cce->bye('SUCCESS');
> 
> $i18n->setLocale($locale);
> 
> ### End CCE Session and related, patricko
> 
> #
> # Snip and move up
> #
> 
> my %vacadb;
> 
> my $vacadb = 
> tie(%vacadb,'DB_File',"$Vaca_dir/.$username.db",O_RDWR|O_CREAT,0666)
>     || die "Cannot open vacation database: $!\n";
> 
> $vacadb{$sendto} ||= 0;
> 
> if ($vacadb{$sendto} >= ($^T - 604800))
> {
>     # They've been given a reply recently
>     untie %vacadb;
>     exit;
> }
> else
> {
>     # lock the db just to be safe, this returns a filehandle 
> that needs
>     # to be closed after vacadb is untied
>     my $fh = &lock($vacadb);
> 
>     $vacadb{$sendto} = $^T;
> 
>     &unlock($vacadb, $fh);  # this also undefines $vacadb
>     untie %vacadb;
>     $fh->close();
> }
> 
> 
> 
> my $mail = new I18nMail;
> $mail->setLang($locale);
> 
> my $subject=$i18n->get("[[base-email.vacationSubject]]");
> my $format=$i18n->getProperty("vacationSubject","base-email");
> my %data=(NAME=>$fullname,EMAIL=>"<$user_from>",MSG=>$subject);
> $format=~s/(NAME|EMAIL|MSG)/$data{$1}/g;
> 
> $mail->setSubject($format);
> $mail->setFrom("$fullname <$user_from>"); $mail->addRawTo($sendto);
> 
> open (INMESSAGE, "$message_file") || die "Can't open message 
> file $!\n"; my $msg; {local $/=undef;$msg=<INMESSAGE>}; close 
> INMESSAGE;
> 
> $mail->setBody($msg);
> 
> open (OUT, "|$Sendmail -froot -oi $sendto") || die "Can't 
> open sendmail $!\n"; print OUT $mail->toText(); close OUT;
> 
> #DEBUGGING
> #$logger->info("Sendmail: $Sendmail");
> #$logger->info("User_from: $user_from");
> #$logger->info("Fullname: $fullname");
> #$logger->info("Send to: $sendto");
> #$logger->info("Subject: $format");
> #$logger->info("Body: $msg");
> 
> 
> # database locking sub-routine
> # returns a filehandle that will need to be closed after 
> unlock is called sub lock {
>         my $db = shift;
>         my $fd = $db->fd;
>         my $fh = new FileHandle("+<&=$fd");
> 
>         my $return_buffer;
>         fcntl($fh, F_SETLKW, $return_buffer);
> 
>         return $fh;
> }
> 
> # database unlocking sub-routine
> sub unlock {
>         my $db = shift;
>         my $fh = shift;
> 
>         $db->sync;  # just in case
> 
>         # remove the lock on the filehandle
>         my $return_buffer;
>         fcntl($fh, F_UNLCK, $return_buffer);
>         
>         undef $db;
> }
> 
> 
> 
> 
>