#!/usr/bin/perl -w

use strict; 
use Carp qw(croak); 
use POSIX qw(setsid);

$|++; 

my $Debug = 1;
my $Verbose = 1;

my $NOFORK = 0; 
our $MAILER = "/usr/sbin/sendmail -t"; 

my %EXPECT = ( 
  body => 1, 
  subject => 1, 
  from => 1,
  max => 1,
  rmax => 1,
  nofork => 1,
  help => 0
); 

#massmail.pl -from your@host.com [-body <file>] [-subject <file>] [-rmax <int>] [-max <#emails#>:<#per sec#>] [-verbose] [-debug] -- <email_dict.txt [email_dict.txt [...]]>

my %HELP = ( 
  '' => "\tMarks the end of arguments, the parameters following this will be considered email address dictionaries.",
  subject => "[file]\t (Optional) Filename containing the Subject to be sent with the emails. (This defaults to subject.txt", 
  body => "[file]\t (Optional) HTML file to send, this defaults to body.txt",
  rmax 	=> "<int>\tHow many addresses a single email that is sent, should be sent to. (Defaults to 25)",
  max => "<int>:<int>\tHow many emails at to be sent within <secs> (Defaults to 25:0) - no delay",
  from 	=> "fbi\@fbi.gov\t - this is a manatory argument."
); 

sub help {
  print "\n   Available arguments:\n\n"; 
  foreach(keys %HELP) { 
    print " --$_ $HELP{$_}\n";
  }  
  print "\n\nExample usage: ./massmail.pl -from security\@fbi.gov -rmax 5 -max 10:1 -- emails.txt emails2.txt ... ..\n";
#  <email_dict.txt [email_dict.txt [...]]>

} 

my $OPT = {
  body => 'body.txt', 
  subject => 'subject.txt', 
  max => '25:0',
  rmax => 25, 
  nofork => 0,  
}; 

sub die_nicely { 
  local $\ = "\n"; 
  print STDERR
    foreach(@_);  
  exit(1); 
}


ARG: while((local $_ = lc $ARGV[0]) =~ /^-/) {
 shift; 
 last ARG
    if /^--$/; 
  s/^-{1,2}//;
  if($_ eq 'help') { help(); exit(0); } 
  $OPT->{$_} = 1, next ARG 
    unless $EXPECT{$_}; 
  $OPT->{$_} = shift; 
} 

not scalar grep {!exists $EXPECT{$_}} keys %$OPT
  or die_nicely "Unknown argument suppled (--help?)"; 
  
$NOFORK = 1 
  if $^O =~ /mswin/i; # regardless of what is sent
$Verbose = 1
  unless exists $OPT->{verbose};

die_nicely "Required argument 'from' was not supplied" 
  unless($OPT->{from}); 
  
do { 
  print "OPT: $_\t=>\t$OPT->{$_}\n"
    foreach(keys %$OPT); 
  print "ARGV: $_\n" 
    foreach(@ARGV); 
  print "\$Debug = $Debug\n"; 
  print "\$Verbose = $Verbose\n";
} if $Debug;

die_nicely "Invalid parameter supplied for argument 'max', should be <emails>:<sec>" 
 unless !defined $OPT->{max} || $OPT->{max} =~ /^\d+:\d+$/; 
 
my($LIMIT, $DELAY) =  split /:/, $OPT->{max};   
$LIMIT ||= 25;
$DELAY ||= 0; 

my $Body = slurp($OPT->{body}); 
(my $Subject = slurp($OPT->{subject})) =~ s/[\r\n]//g; 

sub mail { 
  my($From, $To, $Subject, $Body, $Headers) = @_; 
  defined $Body 
    or croak "Required argument was not supplied"; 
  open(MAIL, "|$MAILER")
    or die_nicely "Failed to open mailer, where is it?\n"; 
  $To = join ', ', @$To 
    if(ref $To eq 'ARRAY');  
  print MAIL 
    "From: $From\n",
    "To: $To\n", 
    "Subject: $Subject\n"; 
  print MAIL
    foreach(@$Headers);
  print MAIL "Content-Type: text/html\n\n"; 
  print MAIL $Body; 
  close(MAIL) 
    or warn "Mailer did not exit nicely ($!)", return;                                              
}

sub slurp { 
  local $/ = undef; 
  open(FILE, "<${_[0]}") 
   or die "cannot open file $_[0] ($!)";
  my $contents = <FILE>;
  close(FILE);
  $contents;
}

sub valid { foreach(@_) { return 0 unless /^.+\@.+\.\w{2,4}$/i } 1; } 

 
sub display(\@) { 
  my $preped = shift or 
    croak "send(); requires an array"; 
  print $preped . "=\n"; 
  foreach(@$preped) { 
    print "\t" . $_ . "\n"; 
  }  
} 

do { 
  local $, = "\n"; 
  print "\n - Subject:\t(" . ((defined $Subject) ? $Subject : 'No Subject') . ") <" . $OPT->{subject} . ">",
    " - Body (HTML):\t" . $OPT->{body}, 
    " - Emails:\t" . join(", ", @ARGV) . "\n";  
  printf("\n - Operating at an interval of %d sec%s, %d emails per.\n\n", $DELAY, ($DELAY == 1) ? '' : 's', $LIMIT);  
};

sub creader { 
  my $FILE = shift;
  (-F($FILE))
    or die_nicely "File '$FILE' does not exist, or is not ASCII"; 
} 

FORK: {
 unless($NOFORK) { 
  print "Attempting to detach from the terminal.\n";
  last FORK 
    unless $^O =~ /mswin/i;
  defined(my $pid = fork)
    or die "Cannot fork into the background ($!)";  
  open(STDIN, '/dev/null') 
    or die "Cannot read /dev/null: ($!)"; 
  open(STDOUT, '>/dev/null')
    or die "Cannot write to /dev/null/: ($!)"; 
  exit if $pid; 
  setsid 
    or die "Cannot create a new session!"; 
  open(STDERR, '>&STDOUT')
     or die "Cannot duplicate STDOUT! ($!)";  
 } 
}


my $start = time; 
foreach my $file (@ARGV) {
  print "Reading file: $file\n" if $Debug;  
  open(EMAILS, "<$file")
    or die "Cannot open file $file\n";  
  my @stack;
  my @emails;  
  my $count = 0; 
  STACK: while(<EMAILS>) {
    chomp; 
    next STACK 
      if !defined($_) || $_ eq ''; 
    $count++; 
    push @emails, $_; 
    unless($count % $OPT->{rmax}) { 
      push @stack, [ @emails ]
        if(@emails); 
      @emails = (); 
      
    }
    unless(@stack % $LIMIT) {
      mailem(@stack); 
      sleep(($DELAY / 2)) 
        if(($DELAY > 0) && ($count)); 
      @stack = (); 
    }
  } 
  if(scalar @stack) { mailem(@stack); }; 
  print "\n- $count emails queued in " . (time() - $start) . " sec(s)\n"; 
  close(EMAILS);  
}

sub mailem {   
  my $i = 0;
  foreach(@_) { 
    print " - Mailing to " . join(", ", @$_) . "\n" if $Verbose;  
   mail($OPT->{from}, $_, $Subject, $Body);
  }  
 # sleep($DELAY)
  #  if($DELAY > 0);  
} 
sleep(1),
  print " Done!\n";
exit(0); 

1;
__END__