#!perl
## Version 2.0.1
## Laurence R. Taylor taylor.2@nd.edu www.nd.edu/~taylor
## Copyright (C) 2000
## Freely distributed under the standard GNU Copyleft agreement
use strict;
use Socket;
use Net::SMTP;
use File::Basename;
my($default_returnaddress, $default_addr_dir,$mysmtp,$APPL,%emails);
####### BE SURE TO SET THESE VARIABLES TO CORRECT VALUES ##########
my(%mail_servers)=('XXXX'=>'XXXX'); # local_ip=>SMTP hash
my(@return_addresses)=('XXXX'); # return address(es)
$default_addr_dir='XXXX'; # my path to address files
$APPL='XXXX'; # MacOS creator for saved files
####################################################################
if( -l $default_addr_dir) {$default_addr_dir=readlink($default_addr_dir);}
$default_returnaddress=$return_addresses[0];
my($packed_ip)=inet_aton("localhost");
my($ee);
if(length($packed_ip)!=4) {
print"WARNING - Not connected to the internet!\n"; #error
$mysmtp=$mail_servers{default};
}
else {
$packed_ip=inet_ntoa($packed_ip);
foreach $ee (keys(%mail_servers)) {
if( $packed_ip=~m/^$ee/ ) {$mysmtp=$mail_servers{$ee};last;}
}
if($mysmtp eq "") {
print $packed_ip," is an unlisted IP number. ";
print "Be sure you have set the SMTP server using the Via: line";
print "or a default SMTP server you know will work.\n"; #error
$mysmtp=$mail_servers{default};
}
}
File::Basename::fileparse_set_fstype($^O); # set file routines to handle OS
my($do_not_send_flag,$save_as_name,$save_as_end,$array_or_hash);
my($st)="###########################";
$st.=$st;$st.=$st;$st.=$st;
my($NON_FILE_NAME_CHAR)="\xFF";
if($#ARGV < 0) {
print"Need files/folders to accomplish anything!\n"; #error
if($^O eq "MacOS") {
print"Drop some files/folders onto the pmail droplet.\n";
}
else{
print"Useage: pmail filename1 filename2 ...\n";
}
exit(1);
}
my($message_file,@line,$err);
foreach $message_file (@ARGV) {
if( -l $message_file ) {$message_file=readlink($message_file);}
if(-f $message_file ) {
$err=&handle_one_message_file($default_returnaddress,$message_file);
if($err!=0) {caP("file",$message_file);} #error
else {
print sx(21),"\n";
}
}
elsif( -d $message_file) {
$err=&handle_one_dir($default_returnaddress,$message_file);
if($err!=0) {caP("directory",$message_file);} #error
}
}
exit();
sub handle_one_dir{
my($from_address,$dir)=@_;
my($err);my($ferr)=0;
chomp($dir);
if( opendir(DIR,$dir) ) {
my(@files)=readdir(DIR);
closedir(DIR);
my($message_file);
if( substr($dir,length($dir),1) ne":") {$dir.=":";}
foreach $message_file (@files) {
chomp($message_file);
$message_file=$dir.$message_file;
if( -l $message_file ) {$message_file=readlink($message_file);}
if(-f $message_file ) {
$err=&handle_one_message_file($default_returnaddress,$message_file);
if($err!=0) {caP("file",$message_file);$ferr=1;} #error
else { print sx(21),"\n";}
}
elsif( -d $message_file) {
$err=&handle_one_dir($default_returnaddress,$message_file);
if($err!=0) {caP("directory",$message_file);$ferr=1;} #error
}
else {print "Bad file \"",$message_file,"\".\n";$ferr=2;} #error
}
undef(@files);
}
else {
print"Failed to open directory \"",$dir,"\"\n";$ferr=3; #error
}
return($ferr);
}
sub caP{
my($first,$me)=@_;
print "The ",$first," \"",$me,"\" caused the problem.\n";
}
##### Handle each message file ##########
sub handle_one_message_file{
my($from_address,$file)=@_;
my(@lines);
undef(@lines);
undef(%emails);
my($stA)="Starting to process file \"".$file."\".";
my($eee);
print "\n",sx(length($stA)),"\n",sx(length($stA)),"\n",$stA,"\n";;
if( open(IN, $file) ) {
@lines = ;
close(IN);
if($#lines<0) { print "The file contains no data.\n";return(1);} #error
}
else {
print "Woops - couldn't open \"$file\".\n"; #error
return(1);
}
# initialize globals
$do_not_send_flag=0;$save_as_name="";$save_as_end="";$array_or_hash="";
my($subject,$type,$ii,$ToLine,$message_start,$comment);
my($smtp);
#### Clip to !END! and check for already sent
for($ii=0;$ii<=$#lines;$ii++) {
if($lines[$ii]=~m/!END!/) {
$ToLine=$`;
last;
}
}
if( $ii<=$#lines) {$lines[$ii++]=$ToLine."\n";}
my($jj,$send_again);
my($sent_list)='#';
$send_again=0;
for($jj=$ii;$jj<=$#lines;$jj++) {
if( $lines[$jj]=~m/^To:( .+\@.+)sent: /) {
$send_again=1;$sent_list=$sent_list.$1.'#';
$sent_list=~s/ +//g;
}
}
splice(@lines,$ii);
#### COLLECT THE To: LINE
if($lines[0]!~m/(Ag|To|XX|TT): */) {
print "First line of email message must be a \"To: \" line.\n";return(1); #error
}
$type=$1;
if($send_again==1) {
if($type eq "Ag" ) {$type="To";$sent_list='#';}
elsif($type eq "To") {
print"This message has already been sent. Will only send to new addresses.\n"; #error
}
}
else{
if($type eq "Ag" ) {
print"This message has never been emailed so Ag: is not valid.\n"; #error
$type="XX";
}
}
$ToLine=$';chomp($ToLine);$ToLine.=$NON_FILE_NAME_CHAR;
$comment=$`;$comment=~s/\*/\\*/g;
if($comment ne "") {
for($ii=0;$ii<=$#lines;$ii++) {
$lines[$ii]=~s/^$comment//;
}
}
$ii=1;
while($lines[$ii]!~m/Subject:/ && $ii<=$#lines && $lines[$ii]!~m/!END!/ ) {
$ToLine.=$lines[$ii];
chomp($ToLine);$ToLine.=$NON_FILE_NAME_CHAR;
$ii++;}
if($lines[$ii]!~m/Subject:/) {
print "Second line of email message must be the \"Subject:\" line.\n";return(2); #error
}
else{
$subject=$lines[$ii];
$subject=~s/^.*Subject: *//;
chomp($subject);
}
## To: line and Subject: collected
## Collect From: and Via: lines
$ii++;
if(get_From_Via($lines[$ii],\$default_returnaddress,\@return_addresses,\$mysmtp,\%mail_servers)==0) {
$ii++;
if(get_From_Via($lines[$ii],\$default_returnaddress,\@return_addresses,\$mysmtp,\%mail_servers)==0) {
$ii++;
}
}
$message_start=$ii;
if($ToLine=~m/\t/) {$ToLine=~s/\t/$NON_FILE_NAME_CHAR/g;}
else{$ToLine=~s/ /$NON_FILE_NAME_CHAR/g;}
$ToLine=~s/$NON_FILE_NAME_CHAR+/$NON_FILE_NAME_CHAR/g;
## Replace the delineator with $NON_FILE_NAME_CHAR
# Now check for CC or BCC
while($lines[$ii]!~m/^(BC|C)C:/ && $ii<=$#lines && $lines[$ii]!~m/!END!/ ) {$ii++;}
my($CCType,$CCLine);
$CCType="";
$CCLine="";
if($ii<=$#lines) {
if($lines[$ii]=~m/^(CC|BCC):/){$CCType=$1;$CCLine=$';chomp($CCLine);$CCLine.="$NON_FILE_NAME_CHAR";
$ii++;
while($lines[$ii] ne "" && $ii<=$#lines && $lines[$ii]!~m/!END!/ ) {
$CCLine.=$lines[$ii];chomp($CCLine);$CCLine.="$NON_FILE_NAME_CHAR";
$ii++;
}
}
if($CCLine=~m/\t/) {$CCLine=~s/\t/$NON_FILE_NAME_CHAR/g;}
else{$CCLine=~s/ /$NON_FILE_NAME_CHAR/g;}
$CCLine=~s/$NON_FILE_NAME_CHAR+/$NON_FILE_NAME_CHAR/g;
}
# Collect CC:-line and replace delineator with $NON_FILE_NAME_CHAR
my(%CCs,$err,@CCs,$a_or_h);
# get data off the To:-line
$err=Mail_Line_Assemble($ToLine,\%emails,$file,0,$sent_list,\$a_or_h);
if($err!=0) {
print"Error occurred with the main address.\n"; #error
return($err);
}
if($CCLine ne "") {
$err=Mail_Line_Assemble($CCLine,\@CCs,$file,1,0,0);
if($err!=0) {
print"Error occurred with the CC's. Here is the data I am trying to resolve.\n"; #error
print"..",$CCLine,"..\n";
return($err);
}
}
my(@message,$perl_code,$exclamations);
$perl_code=$exclamations=0;
for($ii=$message_start;$ii<=$#lines;$ii++) {
if($lines[$ii]=~m/^(!END!$|CC:|BCC:)/) {last;}
push(@message,$lines[$ii]);
if($lines[$ii]=~m/!\[\d+\]!/) {
if($a_or_h eq "a") {$exclamations=1;} else {$exclamations-=10;;last;}
}
if($lines[$ii]=~m/!\{.+\}!/) {
if($a_or_h eq "h") {$exclamations=2;} else {$exclamations-=20;last;}
}
if($lines[$ii]=~m/\[\[\[/) {$perl_code=1;}
}
if($exclamations<0) {
if($exclamations=>-8) {
if($a_or_h=~m/(A|H)/) {
print"Collecting email addresses broke down, but you have substitutions.\n";
}
else {
print"You have collected by array but your replacements are by hash.\n";
}
}
elsif($exclamations=>-18) {
if($a_or_h=~m/(A|H)/) {
print"Collecting email addresses broke down, but you have substitutions.\n";
}
else {
print"You have collected by hash but your replacements are by array.\n";
}
}
return($exclamations);
}
my($haveEND)=0;
for($ii=$message_start;$ii<=$#lines;$ii++) {
if($lines[$ii]=~m/^!END!$/) {$haveEND=1;last;}
}
undef(@lines);
my($ee,$yy,$zz,$ss,$tmpmessage,@tmpmessage);
my($blank,$firstblank,$ll,$tt);
### MAILER LOOP ######
my($send_flag,$add_flag,$message_counter,$OK);
$add_flag=0;$message_counter=0;
foreach $ee (sort(keys(%emails))){
$send_flag=$type;$message_counter++;
@tmpmessage=@message;
## Do the !! substitutions
if($exclamations==1) {
for($zz=0;$zz<=$#tmpmessage;$zz++) {
while($tmpmessage[$zz]=~m/!\[(\d+?)\]!/) {
$ss=$1;
if($ss<0) {$ss+=$#{$emails{$ee}}+1;}
if($ss>$#{$emails{$ee}} || $ss<0) {
print"The substitution ![",$ss,"]! is out of range [0-"; #error
print$#{$emails{$ee}},"] data items.\n";
if($type eq "To" || $type eq "Ag") {return(10);}
}
elsif(${$emails{$ee}}[$ss] eq "") {
print"WARNING: substitution ![",$ss,"]! is empty in message to ",$ee,"\n"; #error
}
$tmpmessage[$zz]=~s/!\[$ss\]!/${$emails{$ee}}[$ss]/g;
}
}
}
elsif($exclamations==2) {
for($zz=0;$zz<=$#tmpmessage;$zz++) {
while($tmpmessage[$zz]=~m/!\{(.+?)\}!/) {
$ss=$1;
print$ee,"------\n";
print$emails{$ee},"------\n";
if( ! exists(${$emails{$ee}}{$ss}) ) {
print"The key for the subsitution !{",$ss,"}! is undefined.\n"; #error
if($type eq "To" || $type eq "Ag") {return(10);}
}
elsif(${$emails{$ee}}{$ss} eq "") {
print"WARNING: substitution !{",$ss,"}! is empty in message to ",$ee,"\n"; #error
}
$tmpmessage[$zz]=~s/!\{$ss\}!/${$emails{$ee}}{$ss}/g;
}
}
}
## do the code evaluations
$tmpmessage=join('',@tmpmessage);
if($perl_code==1) {
if($tmpmessage=~m/\[\[\[/) {
$err=do_the_perl_code(\$tmpmessage,\%emails,$ee,$file,$exclamations);
if($err!=0) {
print"Perl code evaluation failed for the message to ",$ee,"\n"; #error
return($err);
}
if($do_not_send_flag==1 || $do_not_send_flag==2 ) {
$send_flag="DNS";
}
}
}
## add CC's if needed
if($CCType eq "CC") {
$tmpmessage.="CC:";$blank=" ";
$firstblank=" ";
foreach $tt (@CCs) {
$tmpmessage.=$firstblank.$tt."\n";
$firstblank=$blank;
}
}
if($send_flag eq "To" || $send_flag eq "XX" || $send_flag eq "TT" ) {
if($message_counter==1) {print"Sending\n\nTo: ";} else {print"To: ";}
$OK=send_a_message_to($ee,$from_address,$subject,\$tmpmessage,\$file,\$haveEND,"",$CCType,$send_flag);
if($OK!=0) {return($OK);}
if($CCType ne "") {
my($printLine);
if($CCType eq "CC" ) {$blank=" ";$printLine="CC: ";}
else {$blank=" ";$printLine="BCC: ";}
$firstblank=" ";
foreach $tt (@CCs) {
print$printLine;
$OK=send_a_message_to($tt,$from_address,$subject,\$tmpmessage,\$file,\$haveEND,$CCType,$firstblank,$send_flag);
$firstblank=$blank;
}
}
if($send_flag eq "To") {$add_flag=1;}else{$add_flag=0;}
print"##\n";
}
elsif($send_flag eq "DNS") {
if($do_not_send_flag==1) {
print"Your Perl code has requested that the message not be sent to \"",$ee,"\".\n"; #error
print"##\n";
}
}
undef(@tmpmessage);
}
print "using mail server ",$mysmtp," and return address ",$default_returnaddress,".\n";
print"Finished\n",sx(14),"\n\n";
if($add_flag==1) {
open(ADD,">>$file") or die("Died trying to write \"".$file."\" to add final ***.\n"); #error
print ADD "*****************************\n";
close(ADD);
}
undef(%emails);
undef(@lines);
return(0);
}
sub Mail_Line_Assemble{
my($string,$email_record,$message_file,$CC,$sent_list,$a_or_h)=@_;
my(@mails,$err,$ii,$jj,%sanity,$filter,$file);
@mails=split($NON_FILE_NAME_CHAR,$string);
if($string=~m/.+\@.+/) {
for($ii=0;$ii<=$#mails;$ii++) {
if($mails[$ii] eq "") {next;}
if($mails[$ii]!~m/.+\@.+/) {
print "\nAt least one field looks like an email address, but not all of them do.\n";#error
print "\"",$mails[$ii],"\" is the first non-email field.\n";
for($jj=0;$jj<=$#mails;$jj++) {
if($mails[$jj]=~m/.+\@.+/) {
print"\"",$mails[$jj],"\" is the first email field.\n"; #error
}
}
return(3);
}
if($CC==0) {
if($sent_list!~m/$mails[$ii]/i) {
${$email_record}{$mails[$ii]}[0]=$mails[$ii];
}
}
else {
push(@$email_record,$mails[$ii]);
}
}
if($a_or_h!=0) {$$a_or_h="a";}
}
else { #each @mails is a file name of a file merge or a filter
## at the moment we do not support files with lists of files!
$filter="";
#initialize sanity check
$sanity{max}=0;$sanity{address_column}="";$sanity{a_or_h}="";$sanity{hashes}="";
$err=0;
for($ii=0;$ii<=$#mails;$ii++) {
if( $mails[$ii] eq "" ) {next;} #skip any blank file names that have crept in
if($mails[$ii]=~m/~m\/(.+)\/$/) {$filter=$1;next;} ## Get a ~m/.../ $filter
elsif($mails[$ii]=~m/^\[(.+)\{(.+)\}=>\{(.+)\}\]$/) { ## append data
if($CC==1) {
print"CC/BCC lists do not support appending data.\n",$mails[$ii];
print" is the offending statement.\n";
next;
}
$file=get_file($1,$message_file);
$err=Append_data_to_email_record($file,$2,$3,$email_record,\%sanity);
}
else{ ## add addresses
$file=get_file($mails[$ii],$message_file);
$err=Add_addresses_to_email_record($file,$email_record,\%sanity,$filter,$CC,$sent_list);
}
if($err!=0) {
print"File \"",$mails[$ii],"\" was the cause of the problem.\n"; #error
return($err);
}
}
}
if( $CC==0 && keys(%$email_record) <1) {print"There are no email addresses.\n";}#error
elsif( $CC==1 && $#$email_record <0 ) {print"There are no CC/BCC addresses.\n";}#error
if($a_or_h!=0) {$$a_or_h=$sanity{a_or_h};}
undef(%sanity);
return(0);
}
sub get_file{
my($file,$message_file)=@_;
my($dir)=`pwd`;chomp($dir);
my(@fname)=File::Basename::fileparse($message_file);
my($tfile)=$fname[0];if($fname[2] ne "") {$tfile.=".".$fname[2];}
my($message_dir)=$fname[1];
$file=~s/^ +//;$file=~s/ +$//; # stip leading and trailing spaces
if( $tfile ne $file && -f $message_dir.$file) {
$file=$message_dir.$file;
}
else {
$file=$default_addr_dir.$file;
}
return($file);
}
sub Add_addresses_to_email_record{
my($file,$email_record,$sanity,$filter,$CC,$sent_list)=@_;
my(@data,@line,$max,@hash_array,$data_start);
my($address_column,$delineator,$err);
if( open(IN,$file) ) {
@data=;
close(IN);
}
else{print"Unable to open file \"",$file,"\".\n"; return(999);}
$err=&get_switch_data(\$array_or_hash,\$delineator,\$address_column,
\$max,\@hash_array,\$data_start,\@data);
if($err!=0) {return(1000+$err);}
if($CC==0) {
$err=sanity_check($sanity,$max,$array_or_hash,$address_column,\@hash_array);
if($err!=0) {return($err);}
$array_or_hash=${$sanity}{a_or_h};
## DO NOT RESET $address_column=${$sanity}{address_column};;
$max=${$sanity}{max};
@hash_array=@{${$sanity}{hashes}};
}
my($ii,$uu);
for($ii=$data_start;$ii<=$#data;$ii++) {
chomp($data[$ii]);
if($data[$ii] eq "") {next;} ## Blank lines in address file are skipped.
if( $filter ne "" && $data[$ii]!~m/$filter/) {next;} ## Filter addresses.
@line=split($delineator,$data[$ii]);
if($line[$address_column]!~m/.+\@.+/) {
print"\"",$line[$address_column],"\" does not look like an email address to me.\n"; #error
return(2);
}
if( $CC==0 && $sent_list=~m/$line[$address_column]/i) {
print"Already sent to ",$line[$address_column],"\n";
next;
} ## Filter addresses.
while($#line<$max) {push(@line,"");}
if($array_or_hash eq "a" ) {
if($CC==0) {${$email_record}{$line[$address_column]}=[@line];}
else{
push(@$email_record,$line[$address_column]);
}
}
elsif($array_or_hash eq "A" ) { ## Problem with sanity check, just collecting by array[0]
my($rr);
foreach $rr (keys(%{$email_record})) {
undef(@{${$email_record}{$rr}});
${${$email_record}{$rr}}[0]=$rr;
}
${$email_record}{$line[$address_column]}=[$line[$address_column]];
}
elsif($array_or_hash eq "H" ) {## Problem with sanity check, just collecting by hash
${${$email_record}{$line[$address_column]}}{$hash_array[0]}=$line[$address_column];
}
elsif($array_or_hash eq "h" ) {
if($CC==0) {
for($uu=0;$uu<=$#hash_array;$uu++) {
${${$email_record}{$line[$address_column]}}{$hash_array[$uu]}=$line[$uu];
}
}
else{
push(@$email_record,$line[$address_column]);
}
}
undef(@line);
}
undef(@data);
return(0);
}
sub Clean_Key{
my($key)=shift(@_);
$key=~s/^ +//;$key=~s/ +$//;
$key=~s/ +,/,/g;$key=~s/, +/,/g;
return($key);
}
sub get_start_and_delineator{
my($data,$start_data,$local_delineator)=@_;
if($$data[0]=~m/\#!address/) {
$$start_data=2;
if( $$data[0]=~m/-d\'(.+?)\'/) {
$$local_delineator=$1;
if($$local_delineator eq " ") {$$local_delineator='\t';} ## there's a TAB there
}
}
else{$$start_data=1;}
if($$local_delineator eq "") {
if($$data[$$start_data-1]=~m/\t/){$$local_delineator='\t';}
elsif($$data[$$start_data-1]=~m/ /){$$local_delineator=' ';}
elsif($$data[$$start_data-1]=~m/:/){$$local_delineator=':';}
else{$$local_delineator=0xFF;} ## no local_delineator found - use unlikely vlaue.
}
}
sub Append_data_to_email_record{
my($file,$keyA,$keyB,$email_record,$sanity)=@_;
my(@data);
if( open(IN,$file) ) {
@data=;
close(IN);
}
else{print"Unable to open file \"",$file,"\".\n"; return(998);}
## Cleanup keys
$keyA=Clean_Key($keyA);if($keyA eq "") {return(997);}#error
$keyB=Clean_Key($keyB);if($keyA eq "") {return(996);}#error
if( ${$sanity}{a_or_h} ne "h") {
print"Can not append because we are not collecting by hash - ",${$sanity}{a_or_h},"\n"; #error
return(400);
}
my(%append,$ii,$uu,@line,$key,$local_delineator,@hash_fields,@number_hash,$start_data);
## get delineator and fields
get_start_and_delineator(\@data,\$start_data,\$local_delineator);
@hash_fields=split($local_delineator,$data[$start_data-1]);
chomp(@hash_fields);
my(%moose,@hashA,$kk);
@hashA=split(",",$keyB);chomp(@hashA);
for($uu=0;$uu<=$#hashA;$uu++) {
for($kk=0;$kk<=@hash_fields;$kk++) {
if( $hashA[$uu] eq $hash_fields[$kk]) {
$number_hash[$uu]=$kk;
}
}
}
## collect data with $keyB hash
for($ii=$start_data;$ii<=$#data;$ii++) {
@line=split($local_delineator,$data[$ii]);chomp(@line);
$key="";
for($uu=0;$uu<=$#number_hash;$uu++) {
$key.="#".$line[$number_hash[$uu]];
}
for($uu=0;$uu<=$#line;$uu++) {
${$append{$key}}{$hash_fields[$uu]}=$line[$uu];
}
}
## append data",
# put $keyA into array
@hashA=split(",",$keyA);;chomp(@hashA);
foreach $ii (keys(%{$email_record})) {
%moose=%{${$email_record}{$ii}};
$key="";
for($uu=0;$uu<=$#hashA;$uu++){
$key.="#".$moose{$hashA[$uu]};
}
foreach $kk (sort(keys(%{$append{$key}}))){
${${$email_record}{$ii}}{$kk}=${$append{$key}}{$kk};
}
}
@hashA=split(",",$keyB);;chomp(@hashA);
my($uuu);
for($uu=0;$uu<=$#hashA;$uu++){
$uuu=join("\t",@{${$sanity}{hashes}});
if($uuu!~m/$hashA[$uu]/) {
push(@{${$sanity}{hashes}},$hashA[$uu]);
}
}
undef(@data);
undef(%append);
undef(%moose);
undef(@hashA);
return(0);
}
sub sanity_check{
my($sanity,$max,$array_or_hash,$address_column,$hashes)=@_;
my($ii);
if(${$sanity}{a_or_h} eq "") {
${$sanity}{max}=$max;${$sanity}{address_column}=$address_column;
${$sanity}{a_or_h}=$array_or_hash;${$sanity}{hashes}=$hashes;
return(0);
}
else{
if(${$sanity}{a_or_h} ne $array_or_hash) {
print"Sanity check error; ",${$sanity}{a_or_h}," ne ",$array_or_hash,"\n"; #error
## Collect address by ${$sanity}{a_or_h} only. Reset $max, $hash_array
if(${$sanity}{a_or_h} eq "a") {
print"Just collecting email addresses by array.\n";#error
${$sanity}{a_or_h}="A";
}
elsif(${$sanity}{a_or_h} eq "h") {
print"Just collecting email addresses by hash.\n"; #error
${$sanity}{a_or_h}="H";
}
${$sanity}{max}=0;
return(0);
}
if($array_or_hash eq "a") {
if(${$sanity}{max} ne $max) { ## Wrong number of entries
print"Sanity check error: ",${$sanity}{max}," ne ",$max,"\n"; #error
print"Just collecting email addresses by array.\n"; #error
${$sanity}{hashes}=0;
${$sanity}{max}=0;
${$sanity}{a_or_h}="A";
return(0);}
if(${$sanity}{address_column} ne $address_column) { ## Wrong address column
print"Sanity check error: ",${$sanity}{address_column}," ne ",$address_column,"\n"; #error
print"Just collecting email addresses by array.\n";#error
${$sanity}{hashes}=0;
${$sanity}{max}=0;
${$sanity}{a_or_h}="A";
return(0);
}
else{return(0);}
}
else {
if(${${$sanity}{hashes}}[${$sanity}{address_column}] ne ${$hashes}[$address_column]) {
print"Sanity check error: ",${${$sanity}{hashes}}[${$sanity}{address_column}]; #error
print" ne ",${$hashes}[$address_column],"\n"; #error
print"Just collecting email addresses by hash.\n"; #error
my($tmp)=${${$sanity}{hashes}}[${$sanity}{address_column}];
undef(@{${$sanity}{hashes}});
${${$sanity}{hashes}}[0]=$tmp;
${$sanity}{address_column}=0;
${$sanity}{max}=0;
${$sanity}{a_or_h}="H";
return(0);
}
my($hashx)=join("\0xFF",@$hashes);$hashx="\0xFF".$hashx."\0xFF";
for($ii=0;$ii<=$#{${$sanity}{hashes}};$ii++) {
if($hashx!~m/\0xFF${${$sanity}{hashes}}[$ii]\0xFF/) {
print"Sanity check error: ",${${$sanity}{hashes}}[$ii],
" is not a hash in the most recent file.\n"; #error
## Drop this field from ${$sanity}{hashes}}
splice(@{${$sanity}{hashes}},$ii,1);
return(0);
}
}
return(0);
}
}
return(100);
}
my(@fields,%fields);
sub do_the_perl_code {
my($mess,$emails,$send_address,$file,$aoh)=@_;
my($start,$end,$middle,$startc,$endc,$middleA);
if($aoh==2 ) {
%fields=%{${$emails}{$send_address}};
}
else {
@fields=@{${$emails}{$send_address}};
}
$startc=0;
undef($save_as_name);
while( ($startc=index($$mess,"\[\[\[",$startc))>=0) {
$endc=index($$mess,"\]\]\]",$startc+3);
if( $endc>$startc) {
$start=substr($$mess,0,$startc);
$end=substr($$mess,$endc+3);
$middleA=substr($$mess,$startc+3,$endc-$startc-3);
$middle="\0";
$middleA='$middle=\'\';'.$middleA;
$do_not_send_flag=0;
$middle=eval $middleA;
if( $@ ne '' || $middle eq "\0" ) {
chomp($@);
print"Perl code evaluation failed: start of error message\n$@\nEnd of error message.\n";#error
return(2);
}
else {
if($do_not_send_flag==1 || $do_not_send_flag==2 ) {return(0);}
$$mess=$start.$middle.$end;
$startc=length($start)+length($middle);
}
}
else {
$middle=substr($mess,$startc);
print"Failed to find closing \]\]\]\n$middle"; #error
return(3);
}
}
return(0);
}
sub send_a_message_to{
my($ee,$from_address,$subject,$tmpmessage,$file,$haveEND,$CCtype,$CCblank,$ToLine)=@_;
my($smtp);
my($OK);
if( $ToLine eq "To") {
$OK=1;
if($mysmtp ne "") {
$OK=mail_it($mysmtp,$ee,$from_address,$subject,$tmpmessage);
}
else{
print"\nThe SMTP server address is empty.\n"; #error
}
if($OK==1) {return(1);}
## if we want to save it as another file do that here!
if($save_as_name ne "") {
my(@dname)=File::Basename::fileparse($$file);
my($dir)=$dname[1];
$$file=$dir.$save_as_name;
open(OUT,">$$file") or die("Died trying to save the message as ",$$file,".\n"); #error
print OUT "To: ",$ee,"\n";
print OUT "Subject: ",$subject,"\n";
print OUT $$tmpmessage;
if($save_as_end ne "") {
print OUT "\n!END!\n";
$$haveEND=1;
print OUT $save_as_end;
}
close(OUT);
if($^O eq "MacOS") {MacPerl::SetFileInfo($APPL,'TEXT',$$file);}
$save_as_name="";$save_as_end="";
}
### append !END!
if(open(ADD,">>$$file") ) {
my(@times)=localtime();
if($$haveEND==0) {
print ADD "\n!END!\n";
$$haveEND=1;
}
if($CCtype eq "") {
Info_Line("\nTo: ",$ee,\@times,\*ADD);
# printf ADD ("\nTo: %-40s sent: %02u/%02u/%04u at %02u:%02u:%02u\n",$ee,
# $times[4]+1,$times[3],$times[5]+1900,$times[2],$times[1],$times[0]);
print ADD "using mail server ",$mysmtp," and return address ",$default_returnaddress,".\n";
}
else{
if($CCblank eq " ") {
Info_Line($CCtype.":".substr(" ",0,4-length($CCtype)),$ee,\@times,\*ADD);
}
else {Info_Line($CCblank,$ee,\@times,\*ADD);}
# if($CCblank eq " ") {
# print ADD $CCtype,":",substr(" ",0,4-length($CCtype));
# }
# else {
# print ADD $CCblank;
# }
# printf ADD ("%-40s sent: %02u/%02u/%04u at %02u:%02u:%02u\n",$ee,
# $times[4]+1,$times[3],$times[5]+1900,$times[2],$times[1],$times[0]);
}
close(ADD);
}
else {
print("\nUnable to write \"".$$file."\" to add !END! or time stamp.\n"); #error
print("This often means the file is open.\n\n"); #error
}
}
elsif($ToLine eq "XX") {
if(open(ADD,">>$$file") ) {
close(ADD);
}
else {
print("\nWould have been unable to write \"".$$file."\" to add !END! or time stamp.\n");#error
print("This often means the file is open.\n\n");#error
}
if($CCtype eq ""){
print$ee,"\n";
print"Subject: ",$subject,"\n";
print$$tmpmessage;
if($CCblank eq "" ) {print"#### end of message ####\n\n";}
else {print" ## end of message ##\n\n";}
if($save_as_name ne "") {
print"Would have saved the message as \"",$save_as_name,"\".\n";
$save_as_name="";
}
}
else{
print$ee,"\n";
}
}
elsif($ToLine eq "TT") {
print "$ee\n";
}
return(0);
}
sub Info_Line{
my($first,$ee,$times,$fh)=@_;
printf $fh ("%-5s%-40s sent: %02u/%02u/%04u at %02u:%02u:%02u\n",$first,$ee,
$$times[4]+1,$$times[3],$$times[5]+1900,$$times[2],$$times[1],$$times[0]);
}
sub mail_it{
my($mysmtp,$ee,$from_address,$subject,$tmpmessage)=@_;
##print "LOCKED $ee\n";return(0); ## LOCK OUT MAILING DURING TESTING!
$subject="Subject:".$subject."\n";
my($smtp) = Net::SMTP->new($mysmtp);
if(!$smtp) {print "\nSMTP startup failed for $mysmtp\n";return(1);}
print "$ee\n"; # print the current email address
$smtp->mail($from_address);
$ee=~s/<\w+>//;$ee=~s/ +//g;
$smtp->to($ee);
$smtp->data();
$smtp->datasend($subject);
$smtp->datasend($$tmpmessage);
$smtp->dataend();
$smtp->quit();
sleep(5);
return(0);
}
sub get_switch_data{
my($array_or_hash,$delineator,$address_column,$max,$hash_array,$data_start,$data)=@_;
# GET SWITCH DATA FOR THIS ARRAY OF $data
# $array_or_hash can be 'a' or 'h'
# OR 'A' or 'H' which means collect just email address by array or hash
# read shebang line
if($$data[0]!~m/#!address/) {
print"Line 1 of an address file needs to begin\n";
print"Line 1='#!address ...'\n";
chomp($$data[0]);
print"Line 1='",$$data[0],"'\n";
print"is what you actually have on line 1.\n";
return(1);
}
## get switches -x -d -t and -a
$$address_column=0;$$delineator='';
if( $$data[0]=~m/-x\'(\d\d\/\d\d\/\d\d\d\d)\'/) {
## check expiration date
my(@lt)=split(/\//,$1);
my(@time)=localtime();
$time[5]+=1900-$lt[2];
$time[4]+=1-$lt[0];
if( ($time[5]>0) ||
($time[5]==0 && $time[4]>0) ||
($time[5]==0 && $time[4]==0 && $time[3]>$lt[1]) ) {
print"File expired on $1.\n";
return(1);
}
undef(@time);undef(@lt);
}
get_start_and_delineator($data,$data_start,$delineator); ## $data_start is not right
if( $$data[0]=~m/-t\'(h|H|a|A)\'/) {
$$array_or_hash=lc($1);
if($$array_or_hash eq "a") {$$data_start=1;}
else {$$data_start=2;}
}
else{
if($$data[1]=~m/\@/) {
$$array_or_hash="a";
$$data_start=1;
}
else {
$$array_or_hash="h";
$$data_start=2;
}
}
my($uu,@line);
if($$data_start==2) {
@$hash_array=split($$delineator,$$data[1]);
chomp(@$hash_array);
}
if( $$data[0]=~m/-a\'(.+?)\'/) {
$$address_column=$1;
}
else{
@line=split($$delineator,$$data[$$data_start]);
for($$address_column=0;$$address_column<=$#line;$$address_column++) {
if($line[$$address_column]=~m/.+\@.+/) {last;}
}
}
$$max=0;my($ii);
for($ii=$$data_start;$ii<=$#$data;$ii++) {
@line=split($$delineator,$$data[$ii]);
if($$max<$#line) {$$max=$#line;}
undef(@line);
}
if($$address_column>$$max) {
print"Can find no column with email addresses.\n";
return(4);
}
if($$address_column<0) {$$address_column=$$max+$$address_column+1;}
return(0);
}
sub get_From_Via{
my($line,$default_returnaddress,$return_addresses,$mysmtp,$mail_servers)=@_;
my(@tmp,$eee);
if($line=~m/^(From|Via):/) {
chomp($line);
@tmp=split(':',$line);
$tmp[1]=~s/^ +//;
if($line=~m/^From:/) {
if(length($tmp[1])<3) {
$$default_returnaddress=$$return_addresses[$tmp[1]];
}
else {
$$default_returnaddress=$tmp[1];
for($eee=0;$eee<=$#$return_addresses;$eee++) {
if($$return_addresses[$eee]=~m/$tmp[1]/) {
$$default_returnaddress=$$return_addresses[$eee];last;
}
}
}
}
else {
$$mysmtp=$tmp[1];
foreach $eee (keys(%$mail_servers)) {
if($$mail_servers{$eee}=~m/$tmp[1]/) {
$$mysmtp=$$mail_servers{$eee};last;
}
}
}
return(0);
}
else{return(1);}
}
sub sx{
my($m)=shift(@_);
return(substr($st,0,$m));
}
## can be used by Perl code in messages.
sub do_not_send {
$do_not_send_flag=1;
}
sub Do_not_send {
$do_not_send_flag=2;
}
sub quote{
my($ss,$data)=@_;
chomp($data);
$data=~s/\n/\n$ss/gi;
return($ss.$data."\n");
}
sub save_as{
($save_as_name,$save_as_end)=@_;
}
####### END #############