#!/usr/bin/perl
#Neil H Watson on Sun May 11 09:22:55 EDT 2003
#usage: sender -f <from address> -t <to address (file allowed)> -s <s
+ubject> -b <body file> -h <header type "text" or "html">
#or sender -i for interactive mode
use strict;
use warnings;
use Getopt::Std;
use Mail::Sender;
use Term::ANSIColor;
use LWP::Simple;
use Cwd;
use Tie::Syslog;
use Mail::CheckUser;
# log STDERR to syslog
my $stderr = tie *STDERR, 'Tie::Syslog', 'mail.info', 'Sender', 'pid',
+ 'unix' or die "cannot tie $!";
$stderr->ExtendedSTDERR();
# get username
my $user = getpwuid $<;
# log if an interrupt is caught
$SIG{INT} = \&sig;
$SIG{QUIT} = \&sig;
$SIG{TERM} = \&sig;
print STDERR "Started by $user";
my (@time, %filelist, $x, $tempto, @body, $key, @to, $top, $count, $se
+nder);
my ($sendtime, $regex, $confirm, $from, $to, $testto, $subject, $bodyf
+ile, $htype);
# administration monitoring email
my $sysadmin = 'sysadmin@example.com';
# what smtp host will send the mailing
my $smtp = "mail";
my %opt= ( #set default options
f => "x",
t => "x",
s => "x",
b => "x",
h => "x",
i => "n");
getopts("f:t:s:b:h:i", \%opt);
# go to interactive mode
if ($opt{i} ne "n"){
print color("yellow"), "Entering Interactive mode\n\n", color("res
+et");
# WHO
print "\nWho will the message be From, e.g Sender <marketing\@exam
+ple.com>.\n";
print color("yellow"), "1. Sender\n2. Web Report\n or, type someth
+ing: ", color("reset");
$from = <STDIN>;
chomp $from;
if ($from eq '1'){
$from = 'Sender <marketing@example.com>';
}elsif ($from eq '2'){
$from = 'Web Report <marketing@example.com>';
}elsif ($from !~ m/\@example\.com/){
die "\n From must contain a example.com email address. Exitin
+g.\n";
}
# SUBJECT
print "\nEnter the Subject for your message: ";
$subject = <STDIN>;
chomp $subject;
# RECIPIENTS
$regex = qr/\.csv/;
dirlist();
print "\nEnter the name of the recipient file or, select a number
+from the above file list or, email addresses separated by commas: ";
$to = <STDIN>;
chomp $to;
if ($to =~ m/^\d+$/){
$to = $filelist{$to};
# check recipient file for import errors (e.g. ,,,,,)
print "\nChecking recipient file. Please wait...";
rcheck();
}elsif ($to !~ m/\@/){ #if to is a file check for existance
-e $to or die "\nThe file $to does not exist (check for a typo
+)";
}
# TESTING RECIPIENTS
print "\nEnter testing email addresses, separated by commas: ";
$testto = <STDIN>;
chomp $testto;
# TEXT OR HTML MAIL
print "\nAre you sending text or html email? Enter text or html:
+";
$htype = <STDIN>;
chomp $htype;
# BODY FILE
if ($htype eq "html"){
$regex = qr/\.html?/;
}else { # must be a text file
$regex = qr/\.txt/;
}
dirlist();
print "\nEnter the name of the file containing the body of your me
+ssage or,\n";
print "the URL of the body file starting with http:// or,\n";
print "select a number from the above file list: ";
$bodyfile = <STDIN>;
chomp $bodyfile;
if ($bodyfile =~ m/^\d+$/){
$bodyfile = $filelist{$bodyfile};
}
# send test email
$tempto = $to;
$to = $testto;
check_header();
body();
to();
# TEST MESSAGE AND APPROVAL
print "\nA test message has been sent to your email address.\n";
print "If you are happy with it, type \"Yes, I want to send this m
+ail now\" to send the mail to the real recipients.\n";
print color("yellow"), "WARNING: Once you type \"Yes, I want to se
+nd this mail now\", the sending of this message CANNOT be stopped: ",
+ color("reset");
$confirm = <STDIN>;
chomp $confirm;
# if confirmed, send messages
if ($confirm eq "Yes, I want to send this mail now"){
$to = $tempto;
print "\nSending Messages...\n\n";
# fork and free the user
fork && exit;
# do not send until 17:00 or
# do not send for at least 2 hours
@time = localtime();
# if time is less than 2 hours before 17:00
# then add two hours to send time
if ($time[2] >= 15){
$sendtime = $time[2]+2;
# else send time is at 17 hours
}else{
$sendtime = 17;
}
# send warning to sysadmin
admin() or die "admin() failed $!";
sleep (($sendtime - $time[2]) * 3600);
to();
}else{
die "Confirmation to send not given. Exiting...\n";
exit;
}
# must be command line mode
}else{
$from = $opt{f};
$to = $opt{t};
$subject = $opt{s};
$bodyfile = $opt{b};
$htype = $opt{h};
check_header();
body();
to();
}
undef $stderr;
untie *STDERR;
###############
# SUBS
###############
# grabs file list for user to select
sub dirlist {
$x=0;
opendir(DIR, ".") or die "can't open dir name $!";
while (defined(my $file = readdir(DIR))){
if ($file =~ m/$regex/){
$x++;
print color("yellow"), $x,": ",$file,"\n", color("reset");
$filelist{$x} = $file;
}
}
closedir(DIR);
}
# prints usage on errors
sub usage {
print "Error\n";
print "Usage: sender -f <from address> -t <to address (file allow
+ed)> ";
print "-s <subject> -b <body file> -h <header type text or html>";
print "\nOR\nsender -i for interactive mode\n\n";
}
#determine proper hearder type
sub check_header {
chomp $htype;
if ($htype eq "text"){
$htype = "text/plain";
} elsif ($htype eq "html"){
$htype = "text/html";
} else {
usage(), die "Error: wrong hearder ($htype given) type. O
+nly text or html allowed.\n\n";
}
}
#create body string
sub body{
# body is found at URL
if ($bodyfile =~ m/^http/i){
if (defined get $bodyfile){
@body = get $bodyfile;
}else{
die "Could not get bodyfile $bodyfile\n" unless @body ;
}
# body is a local file
}else{
open BODY, "$bodyfile" or usage(), die "Could not open bodyfil
+e: $bodyfile\n";
while (<BODY>){
# chomp();
# $_ = $_."\r";
$_ =~ s/\w+$/\n/g;
push @body, $_;
# $body .= $_;
}
close BODY;
}
}
#create to header and mail
sub to {
#if to is a single address
if ($to =~ m/\@/){
mailout() or usage(), warn "$!\n";
} else { # to is a file
open (TO, "$to") or usage(), die "Could not open tofile: $to\
+n";
while (<TO>){
chomp $_;
push @to, $_;
$count ++;
#spits bcc into small chuncks
if ($count == 80){
$to = join ",", @to;
mailout() or usage(), warn "$!\n";
$count = 0;
@to = ();
}
}
$to = join ",", @to;
$to .= ','.$user.'@example.com';
mailout() or usage(), warn "$!\n";
print STDERR "Messages sent successfully to mail server\n";
}
}
# build email and send
sub mailout {
$sender = new Mail::Sender;
$sender->Open({
smtp => $smtp,
skip_bad_recipients => 'true',
from => "market_bounce\@example.com",
fake_from => $from,
to => "subscribers\@example.com",
bcc => $to,
encoding => "quoted-printable",
subject => $subject,
ctype => $htype,
headers => "Errors-To: market_bounce\@example.com",
}) or usage(), warn "Sender error: $sender, $Mail::Sender::Err
+or!\n";
# body of email. USE Send only for plain/text messages
if ($htype eq "text"){
$sender->Send(@body) or usage(), warn "Sender error: $sender,
+$Mail::Sender::Error!\n";
}else{
$sender->SendEnc(@body) or usage(), warn "Sender error: $sende
+r, $Mail::Sender::Error!\n";
}
# send email
$sender->Close or usage(), warn "Sender error: $sender, $Mail::Sen
+der::Error!\n";
}
# check recipient file for import errors (e.g. ,,,,,)
sub rcheck{
my (%invalid, $key, $error, $str);
open TO, $to or die "Cannot open file $to $!";
$x = 1;
print "\n";
# we want to syntax check recipients only. No network checks.
$Mail::CheckUser::Skip_Network_Checks = 'true';
while (<TO>){
chomp;
# remove extra windows white space that may
# upset error message printing
$_ =~ s/\s*$//g;
unless (Mail::CheckUser::check_email($_)){
$invalid{$x} = $_;
}
$x++;
}
close TO;
# were there errors?
$error = keys %invalid;
$x = 1;
if ($error > 1){
foreach $key (sort {$a<=>$b} keys %invalid){
$str = "The email address $invalid{$key} in your recipient
+ file $to at line $key is invalid.\n";
print STDOUT $str;
print STDERR $str;
# print only the first 10 errors
if ($x > 10){ last }
$x++
}
print "Your recipient file has $error errors\n";
print "The entire file may be corrupt. You should check the e
+ntire file carefully\n";
die;
}
print "\nRecipient list looks good. Continuing";
}
# send warning mail to sysadmin
sub admin {
my $now = localtime; # timestamp
my $pid = $$; # get PID in case you need to kill
my $time = $sendtime." hours ".$time[1]." minutes"; # time mailing
+ will go out
my $pwd = cwd; # get pwd
my $recip; # number of recipients
# to contains actual addresses
if ($to =~ m/\@/){
$recip = scalar (() = $to =~ m/\@/g);
# to is a file
}else{
open (TO, "$to") or die "Could not open tofile: $to $!\n";
while (<TO>){
$recip++;
}
close (TO);
}
# log information
print STDERR (<<"*END*");
$now Sender log for
user = $user
PID = $pid
Scheduled sending time = $time
PWD = $pwd
bodyfile = $bodyfile
Recipient file = $to
Recipients = $recip
*END*
$sender = new Mail::Sender;
$sender->Open({
smtp => $smtp,
to => $sysadmin,
from => "$user\@example.com",
encoding => "quoted-printable",
subject => "Sender mailing scheduled",
}) or die "Sender error: $sender, $Mail::Sender::Error!\n";
$sender->SendEnc(<<"*END*");
A sender process is scheculed to send a mailing:
user = $user
PID = $pid
Scheduled sending time = $time
PWD = $pwd
bodyfile = $bodyfile
Recipient file = $to
Recipients = $recip
Fake from = $from
*END*
$sender->Close or die "Sender error: $sender, $Mail::Sender::Error
+!\n";
}
sub sig {
print STDERR "Died by Interrupt: @_, $!\n";
exit;
};
#for debugging
#sub mailout{
# print "$to\n\n";
#}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.