#!/usr/bin/perl -Tw

package ch::inodes::bulkmail; @ISA=qw(Exporter);

use constant copyright=><<'EOF';
bulkmail.pm optimizes local deliver of mail to a lot/all users.
Copyright (C) 2000-2008 iNodes AG, Zurich

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

EOF

# Standard intro
################

use 5.005_03;	# Request the one it was developed with and is known to work.

use strict;	# Need safety belts
use Carp;
BEGIN {
 for my $key (keys(%SIG)) {
  $SIG{$key}=sub { my ($sig)=@_; Carp::confess("SIG$key: Caught signal '$sig'\n"); };
 }
 $SIG{__WARN__}=sub { }; # ignore warnings from imports
 $SIG{__DIE__}=\&Carp::confess;
 $SIG{CHLD}='DEFAULT';
 $SIG{PIPE}='IGNORE';
 $SIG{WINCH}='IGNORE';
 $SIG{HUP}='IGNORE';
}
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS);

$VERSION='$Id: bulkmail.pm,v 1.1 2008/02/10 21:40:58 claudio Exp $';

=head1 NAME

bulkmail - Send a mail to a list of customers

=head1 SYNOPSIS

B<bulkmail> [-help|-man] [-local] [-remote] [-all] [-err=I<errorfile>] [-log=I<logfile>] I<mail> I<userlist>

B<bulkmail> [-help|-man] -addresses=I<filename>

use B<bulkmail>;

=head1 DESCRIPTION

B<bulkmail> delivers the mail contained in the file specified by the
first argument to all users listed in the file specified by the second
argument. Depending on whether the user has a .forward file containing
an external e-mail address (a line user@host where host is neither
swissonline.ch nor hispeed.ch) it will either send it to this e-mail
address using sendmail or deliver it to the users local mailbox using
procmail, or do nothing, in case of a forwarding to a @hispeed.ch or
@swissonline.ch address.

The mail file must contain a valid mail, i.e. the header part an empty
line and the body part. The header should contain the lines "From:",
"To:", "Subject:" and optionally a "Return-To:". B<bulkmail> will add
the "Date:" line.

The user list contains the userid (e.g. claudio.nieder) to which the
mail should be delivered, one userid per line.

The options -local, -remote and -all define to who the mail is actually
delivered. If neither of these is supplied, no actual delivery takes
place, B<bulkmail> will do all processing except delivery. This can be
used to do a dry run.

With the addresses option you can get a list of all the e-mail addresses
contained in the database.

=head1 OPTIONS

=over 4

=item -help

Print a description on how to use the command.

=item -man

Print the whole man page for the command.

=item -local

Deliver mail to all user which do not have a forwarding using 
procmail.

=item -remote

Deliver mail to all those users with a forwarding to an external
address.

=item -all

Same as specifying both -local and -remote.

=item -err=I<errorfile>

Log error messages to I<errorfile>.

=item -log=I<logfile>

Log startup information and final statistics to I<logfile>.

=item -addresses=I<filename>

Generate a list of all e-mail addresses an store it into I<filename>.

=back

=head1 ARGUMENTS

=over 4

=item mail

Name of the file containing the mail.

=item userlist

Name of the file listing the users to which the mail shall be sent.

=back

=head1 MESSAGES/ERRORS

At startup, B<bulkmail> will display the mail file and a note saying if
it will do none, local, remote or complete delivery. During execution it
will display a progress indication as well as error messages if delivery
is not possible. 

An error reading the mail file will cause immediate termination of the
script.

An error opening the user list file will cause immediate termination of
the script.

An error in delivering a mail will cause an error message to be
written to stderr. This can be redirected to a file.

=cut

# Imports
#########

use Getopt::Long ();
use IO::File ();
use Pod::Usage ();
use POSIX ();

BEGIN {
 $SIG{__WARN__}=\&Carp::confess; # Make warns deadly.
}

# Configuration
###############

=head1 CONFIGURATION ITEMS

=head2 procmail

Define the full path to procmail

=cut

use constant procmail=>'/usr/local/bin/procmail';
# use constant procmail=>'/usr/bin/echo PROCMAIL';	# For testing

=head2 sendmail

Define the full path to sendmail

=cut

use constant sendmail=>'/usr/lib/sendmail';
# use constant sendmail=>'/usr/bin/echo SENDMAIL';	# For testing

=head2 databaseHome

Directory where the password database resides

=cut

# use constant databaseHome=>'/var/mail-data/pwdb'
use constant databaseHome=>'/var/tmp/pwdb_migration';	# For testing

=head2 databaseName

Name of the database file

=cut

use constant databaseName=>'database';

# Global variables
##################

=head1 ATTRIBUTES / VARIABLES

When used as package, you can access these variables:

=head2 %ORIGINAL_ENV

The original environment is stored in here before replacing it with a
reduced safe one.

=cut

my %ORIGINAL_ENV;

=head2 $errFile

File to which log the error messages.

=cut

my $errorFile=undef;

=head2 $logFile

File to which log the execution messages.

=cut

my $logFile=undef;

# Procedures
############

=head1 METHODS / SUBROUTINES

When used as package, you can call these subroutines:

=head2 errMsg($msg)

Write message to stderr and to error file, if one was specified.

=over 2

=item $msg

The message to write.

=back

=cut

push(@EXPORT_OK,'errMsg');

sub errMsg($)
{
 my ($msg)=@_;

 $msg.="\n";
 STDERR->print("\n".$msg);
 if ($errorFile) {
  $errorFile->print($msg) or die("Error writing to error file\n");
  $errorFile->flush();
 }
}

=head2 logMsg($msg;$both)

Write message to stdout and/or to log file, if one was specified.
Normally, when a log file is specified no output is sent to stdout,
unless the second parameter is set true.

=over 2

=item $msg

The message to write.

=item $both (optional)

If true instructs to write a message to stdout even when a lof file is
in use.

=back

=cut

push(@EXPORT_OK,'logMsg');

sub logMsg($;$)
{
 my ($msg,$both)=@_;

 $msg.="\n";
 if ($logFile) {
  $logFile->print($msg) or die("Error writing to log file\n");
  $logFile->flush();
 }
 if ($both or not $logFile) {
  STDOUT->print($msg);
 }
}

=head2 translateExitCode($rc)

Translate the numeric sendmail/procmail exit code into a short message.

=over 2

=item $rc

The exit code

=back

=cut

push(@EXPORT_OK,'translateExitCode');

sub translateExitCode($)
{
 my ($rc)=@_;

 my $msg;

 if ($rc==64) {
  $msg='wrong arguments';
 } elsif ($rc==65) {
  $msg='data format error';
 } elsif ($rc==66) {
  $msg='cannot open input';
 } elsif ($rc==67) {
  $msg='no such user';
 } elsif ($rc==68) {
  $msg='unknown host';
 } elsif ($rc==69) {
  $msg='service unavailable';
 } elsif ($rc==70) {
  $msg='internal software error';
 } elsif ($rc==71) {
  $msg='system error';
 } elsif ($rc==72) {
  $msg='critical OS file missing';
 } elsif ($rc==73) {
  $msg='cannot create file';
 } elsif ($rc==74) {
  $msg='input/output error';
 } elsif ($rc==75) {
  $msg='temporary failure';
 } elsif ($rc==76) {
  $msg='protocol error';
 } elsif ($rc==77) {
  $msg='permission denied';
 } elsif ($rc==78) {
  $msg='configuration error';
 } elsif ($rc==79) {
  $msg='entry not found';
 } else {
  $msg=sprintf('unkown code %d',$rc);
 }
 return($msg);
}

=head2 deliverLocal($user,$TO,$mail)

Send the mail to local user.

=over 2

=item $user

The name of the user to which the mail is sent.

=item $TO

The address to the mail is originally addressed.

=item $mail

The mail to be delivered.

=back

=cut

push(@EXPORT_OK,'deliverLocal');

sub deliverLocal($$$)
{
 my ($user,$TO,$mail)=@_;

 my @result;
 my $toIn=new IO::Handle;
 my $toOut=new IO::Handle;

 $mail=~s"\$EMAIL"$TO"g;
 my $pid=IPC::Open3::open3($toIn,$toOut,'',procmail,'-Y','-a','""','-d',$user)
  or die("Error $^E executing procmail\n");
 $toIn->print($mail) or die("Error $^E writing to procmail\n");
 $toIn->close() or  die("Error $^E cloing pipe to procmail\n");
 @result=$toOut->getlines();
 my $pid2=waitpid($pid,0);
 my $rc=$?>>8;
 if ($pid2!=$pid) {
  die("pid mismatch ($pid2)!=($pid)\n");
 }
 return($rc,join('',@result));
}

=head2 deliverRemote($address,$TO,$mail)

Send the mail to remote user.

=over 2

=item $address

The address to which the mail must be sent.

=item $TO

The address to the mail is originally addressed.

=item $mail

The mail to be delivered.

=back

=cut

push(@EXPORT_OK,'deliverRemote');

sub deliverRemote($$$)
{
 my ($address,$TO,$mail)=@_;

 my @result;
 my $toIn=new IO::Handle;
 my $toOut=new IO::Handle;

 $mail=~s"\$EMAIL"$TO"g;
 my $pid=IPC::Open3::open3($toIn,$toOut,'',sendmail,'-oi',$address)
  or die("Error $^E executing sendmail\n");
 $toIn->print($mail) or die("Error $^E writing to sendmail\n");
 $toIn->close() or  die("Error $^E cloing pipe to sendmail\n");
 @result=$toOut->getlines();
 my $pid2=waitpid($pid,0);
 my $rc=$?>>8;
 if ($pid2!=$pid) {
  die("pid mismatch ($pid2)!=($pid)\n");
 }
 return($rc,join('',@result));
}

=head2 getForwardingAddress($filename)

Extract the forwarding address from file. This procedure ignores
any errors.

=over 2

=item $filename

The name of the .forward file to inspect.

=back

=cut

push(@EXPORT_OK,'getForwardingAddress');

sub getForwardingAddress($)
{
 my ($filename)=@_;

 my $address=undef;
 my $error;
 my $file=new IO::File;
 my $ok;

 my @forwards=();

 $ok=$file->open($filename);
 if ($ok) {
  @forwards=grep(m'^[\w\-\.]+@[\w\-\.]+$',$file->getlines());
  $file->close();
 }
 if (@forwards>1) {
  $address='';
 } elsif (@forwards==1)  {
  $address=$forwards[0];
  chomp($address);
 } else {
  $address=undef;
 }
 return($address);
}

=head2 bulkmail($mailfile,$userfile,$local,$remote)

Open the mailfile and userfile and send the mail to each user listed in
the user file. Find, if the mail needs to delivered locally or remote
and perform the appropriate deliver if the corresponding paramter $local
or $remote is true.

=over 2

=item $mailfile

The name of the file containing the mail.

=item $userfile

The name of the file containing the user list.

=item $local

Flag indicating, if local delivery shall really be performed.

=item $remote

Flag indicating, if remote delivery shall really be performed.

=back

=cut

push(@EXPORT_OK,'bulkmail');

sub bulkmail($$$$)
{
 my ($mailfile,$userfile,$local,$remote)=@_;

 my $cmd;
 my $file=new IO::File;
 my $mail;
 my $modeMsg;
 my $msg;
 my $rc;
 my $rcMsg;
 my $time;

 my @addresses;

 # Read in mail file, prepend Date: and Message-Id: line to it.

 $file->open('<'.$mailfile) or die("Cannot open mail file '$mailfile'.\n");
 $mail=join('',$file->getlines());
 $file->close() or die("Error $! closing mail file '$mailfile'.\n");

 $time=time();
 $mail='Date: '.POSIX::strftime('%a, %e %b %Y %T +0000',gmtime($time))
  ."\nX-Mailer: iNodes-bulkmail"
  ."\nMessage-Id: <".$time.'.'.$$.'.inodes_bulkmail@swissonline.ch>'
  ."\n".$mail;

 $file->open('<'.$userfile) or die("Cannot open user file '$userfile'.\n");
 @addresses=$file->getlines() or die("Error $! reading user file '$userfile'.\n");
 $file->close() or die("Error $! closing user file '$userfile'.\n");

 if ($local) {
  if ($remote) {
   $modeMsg='NORMAL DELIVERY: The mail is delivered into local mailboxes as well as to forwarded addresses.';
  } else {
   $modeMsg='LOCAL DELIVERY: The mail will not be sent to users which forward there mail.';
  }
 } else {
  if ($remote) {
   $modeMsg='REMOTE DELIVERY: The mail is only sent to forwarded addresses, but not delivered into local mailboxes.';
  } else {
   $modeMsg='SIMULATED MODE: No delivery takes place.';
  }
 }

 logMsg("$mail\n$modeMsg\n\n",1);
 my $localDelivery=0;
 my $remoteDelivery=0;
 my $ignoredDelivery=0;
 my $errorDelivery=0;
 my $lastTime=time();
 my $startTime=$lastTime;
 my $lastCount=0;

 for my $userid (@addresses) {
  chomp($userid);
  # given an e-mail address find the local user.
  my @dbRes=mailif::dbQuerySingle("select unix_account_id from mail_aliases where alias='$userid'");
  my $localUser;
  if (not @dbRes) {
   $localUser=undef;
  }else{
   $localUser=$dbRes[0];
  }
  if (not defined($localUser)) {
   logMsg("$userid does not exist in user database.");
   errMsg("$userid does not exist in user database.");
   $errorDelivery++;
  } else {
   # Given a local user find its home directory
   my $home=mailif::getHomeDir($localUser);
   if (not defined($home)) {
    logMsg("$localUser does not exist in /etc/passwd.");
    errMsg("$localUser does not exist in /etc/passwd.");
    $errorDelivery++;
   } else {
    my $remoteAddress=getForwardingAddress($home.'/.forward');
    if ($remoteAddress) {
     if ($remoteAddress=~m'@swissonline.ch$') {
      logMsg("$userid forwarding to $remoteAddress ignored.");
      $ignoredDelivery++;
     } elsif ($remoteAddress=~m'@hispeed.ch$') {
      logMsg("$userid forwarding to $remoteAddress ignored.");
      $ignoredDelivery++;
     } else {
      if ($remote) {
       ($rc,$msg)=deliverRemote($remoteAddress,$userid.'@swissonline.ch',$mail);
       if ($rc) {
	$rcMsg=translateExitCode($rc);
	logMsg("$userid forwarding to $remoteAddress failed because $rcMsg.");
	errMsg("$userid forwarding to $remoteAddress failed because $rcMsg, sendmail exited with code $rc.\n---sendmail output---\n$msg\n--end sendmail output---\n");
	$errorDelivery++;
       } else {
	logMsg("$userid forwarding to $remoteAddress was successful.");
	$remoteDelivery++;
       }
      } else {
       logMsg("$userid forwarding to $remoteAddress was successful.");
       $remoteDelivery++;
      }
     }
    } elsif (defined($remoteAddress)) {
     errMsg("$userid had more than one forwarding address in $home.'/.forward.\n");
     $errorDelivery++;
    } else {
     if ($local) {
      ($rc,$msg)=deliverLocal($localUser,$userid.'@swissonline.ch',$mail);
      if ($rc) {
       $rcMsg=translateExitCode($rc);
       logMsg("$userid delivery to $localUser failed because $rcMsg.");
       errMsg("$userid delivery to $localUser failed because $rcMsg, procmail exited with code $rc.\n---procmail output---\n$msg\n--end procmail output---\n");
       $errorDelivery++;
      } else {
       logMsg("$userid delivery to $localUser was successful.");
       $localDelivery++;
      }
     } else {
      logMsg("$userid delivery to $localUser was successful.");
      $localDelivery++;
     }
    }
   }
  }
  if ($logFile) {
   my $time=time();
   if ($time>$lastTime) {
    my $count;
    my $elapsedTime;

    $count=$localDelivery+$remoteDelivery+$errorDelivery+$ignoredDelivery;
    $elapsedTime=$time-$startTime;

    printf(
     "\r%d msgs in %d s (%d msg/s) %d local %d remote %d skipped %d error".(' 'x10)
     ,$count,$elapsedTime,$count/$elapsedTime
     ,$localDelivery,$remoteDelivery,$ignoredDelivery,$errorDelivery
    );
    $lastCount=$count;
    $lastTime=$time;
   }
  }
 }
 if ($logFile) {
  my $time=time();
  my $count;
  my $elapsedTime;

  $count=$localDelivery+$remoteDelivery+$errorDelivery+$ignoredDelivery;
  $elapsedTime=$time-$startTime;

  $msg=sprintf(
   "\n%d msgs in %d s (%d msg/s) %d local %d remote %d skipped %d error\n"
   ,$count,$elapsedTime,$count/($elapsedTime+1e-4),$localDelivery,$remoteDelivery,$ignoredDelivery,$errorDelivery
  );
  logMsg($msg,1);
 }
}

# Main (executed only if called as script)
##########################################

=head2 main

Description what main does.

=cut

sub main()
{
 my $addresses;
 my $all;
 my $errname;
 my $local;
 my $logname;
 my $password_db_env;
 my $remote;

 my %hash;

 print(copyright);

 STDOUT->autoflush();
 STDERR->autoflush();
 Getopt::Long::GetOptions(
  'help|?'=>sub { Pod::Usage::pod2usage(-verbose=>1,-exitval=>0); }
  ,'man'=>sub { Pod::Usage::pod2usage(-verbose=>2,-exitval=>0); }
  ,'addresses=s'=>\$addresses
  ,'local'=>\$local
  ,'remote'=>\$remote
  ,'all'=>\$all
  ,'log=s'=>\$logname
  ,'err=s'=>\$errname
 ) or Pod::Usage::pod2usage(-verbose=>0);

 if ($addresses) {
  
  # Store all addresses into a file suitable for use by bulkmail.

  if (@ARGV<0 or 0<@ARGV) {
   Pod::Usage::pod2usage(-verbose=>0);
  }
  if ($addresses!~m/^(\w+)$/) {
   die("Illegal character in file name ($addresses)\n");
  } else {
   $addresses=$1;
  }
  # Get all e-mail addresses
  my @res=mailif::dbQuery("SELECT ALIAS FROM MAIL_ALIASES");
  my $count=0;
  STDOUT->autoflush(1);
  my $file=new IO::File;
  $file->open(">$addresses") or die("Error $^E opening $addresses\n");
  for my $ref (@res) {
   $file->print($ref->[0]."\n") or die("Error $^E writing to $addresses\n");
   $count++;
   if ($count%1000==0) {
    printf("\r %7d addresses stored.",$count);
   }
  }
  printf("\r %7d addresses stored.\n",$count);
  $file->close() or die("Error $^E closing $addresses\n");
   
 } else {
  
  # Deliver mail to selected addresses

  if (@ARGV<2 or 2<@ARGV) {
   Pod::Usage::pod2usage(-verbose=>0);
  }
  if ($all) {
   $local=1;
   $remote=1;
  }
  if ($errname) {
   $errorFile=new IO::File;
   $errorFile->open('>'.$errname) or die ("Cannot open error file '$errname' error '$^E'\n");
  }
  if ($logname) {
   $logFile=new IO::File;
   $logFile->open('>'.$logname) or die ("Cannot open log file '$logname' error '$^E'\n");
  }
  bulkmail($ARGV[0],$ARGV[1],$local,$remote);
  if ($errorFile) {
   $errorFile->close() or warn("Error $^E when closing error file '$errname'\n");;
  }
  if ($logFile) {
   $logFile->close() or warn("Error $^E when closing log file '$logname'\n");;
  }
 }
}

# Call main only if this module is executed as script. Replace the
# original environment by a simplified, safe one. This is the paranoids
# approach and might be too restrictive in certain situations.

if (not caller()) {
 %ORIGINAL_ENV=%ENV;
 %ENV=(PATH=>'/usr/bin:/bin');
 main();
} else {
 %EXPORT_TAGS=(all=>\@EXPORT_OK);
}

1;

=head1 BUGS

None yet.

=cut

__DATA__