anthony4513
MIS
Dear All,
Thank you for any support in advanced. I come here for help because our perl programmer has left and we are left with a script that we do not know how to add to or modify. He has created a html form that sends out email based on user imput (they enter the email address that the form
should be sent to... Anyway, We have modify the form to add some checkboxes (9 groups) that has a SMTP address associated to them - for example,
If I select checkbox 1 and 3 the form should be sent via email to user1@domain.com and user3@domain.com.... and so on, in addition to the smtp address that's entered in the input field.
checkbox 1 = user1@domain.com
checkbox 2 = user2@domain.com
checkbox3 = user3@domain.com
below is the code from the html form....
<form name="Not_Out" method="post" action="/cgi-bin/form_email.pl">
<table border="0" cellspacing="0" cellpadding="0">
<tr>
<td colspan="2" class="maintext" bgcolor="#006699"> <b><font color="#FFFFFF">Select group(s)
to email ::</font></b></td>
</tr>
<tr>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User1">
Inttra All</font></td>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User2">
Integration & Operations </font></td>
</tr>
<tr>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User3 ">
EDI </font></td>
</table>
<p><font size="2">
<input type="submit" name="Submit" value="..:: SUBMIT ::.." class="buttons"> <input type="reset" name="reset" value="..:: RESET ::.." class="buttons">
</form>
-------------------------------------------------
Perl script "form_email.pl"
**** We need to add the ability to email based on checkbox
selection from the html form to this Perl Script...If there
are any Perl expert that can interpret this script and make sense of it - Please help....We need it. ****************
#!c:/perl/bin
#!/usr/bin/perl
# init default values
@Months= qw(January February March April May June July August September October November December); unshift @Months, "";
@Weekdays= qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
#$base_path = "./";
$error_loop = 0;
$browser_out = 0;
$cfg_file = "settings.cfg";
$cfg_form = "form.cfg";
$content_type = "Content-Type: text/html\n\n";
$multi_separator = ", ";
##############################################################################
use CGI::Carp qw (fatalsToBrowser);
use CGI qw/:cgi/;
$ENV{'UPDATED'}= ' ';
$query = new CGI;
# default message
if ($ENV{'REQUEST_METHOD'} eq 'GET' and not $ENV{'QUERY_STRING'}) {
&StartPage;
exit(0);
}
@lines = ReadFile2('Configuration File', $cfg_file);
foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "push \@$1, \"$2\";";}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$$1 = \"$2\";"; }
}
# we can inherit base path if drawn through several pages in page sequence
$base_path = $query->param('base_path').'/' if defined(($query->param('base_path')));
$base_path = $query->param('_base_path').'/' if defined(($query->param('_base_path')));
#NOT The following reads the form config. TMP var - "base_path" still remains
#NOT Say GoodBye to form hidden fields
@lines=ReadFile2('Form Configuration File', $base_path . $cfg_form);
foreach $line (@lines) {
if ($line =~ /^(attachments_path)\s*=\s*(.+?)\s*(\x23|$)/)
{eval "\$$1 = \"$2\";";}
if ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$FORM{$1} = \"$2\";";}
}
$attachments_path=$base_path . $attachments_path;
#exit;
# let's party
&ParseForm;
&CheckRef;
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/\/|\.)aol\.com/);
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/|\.)not/);
$FORM{'_format_decimals'} = "0" unless ($FORM{'_format_decimals'});
$FORM{'GMT_OFFSET'} = "0" unless ($FORM{'GMT_OFFSET'});
## DATE FORMATTING
$date_format = 'dd.mm.yyyy' unless defined($date_format);
$date = $date_format;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $FORM{'GMT_OFFSET'}*3600);
$mon++; $year+=1900; $syear="0".($year-2000);
$mday="0".$mday if length($mday)<2 ;
$date=~s/weekday/$Weekdays[$wday]/i;
$date=~s/wee/substr($Weekdays[$wday],0,3)/ei;
$date=~s/Month/$Months[$mon]/i;
$date=~s/mmm/substr($Months[$mon],0,3)/ei;
$mon=(length($mon)<2?"0":"".$mon; # "0" schreiben oder nicht?
$date=~s/yyyy/$year/i;
$date=~s/yy/$syear/io;
$date=~s/dd/$mday/io;
$date=~s/mm/$mon/eio;
$ENV{'DATE_GMT'} = sprintf("%02d:%02d:%02d %s GMT%+d",$hour,$min,$sec,$date,$FORM{'GMT_OFFSET'});
## END DATE FORMATTING
srand(time ^ $$);
$rnd1 = sprintf("%04d", int(rand 10000));
$rnd2 = sprintf("%04d", int(rand 10000));
$FORM{'unique_reference_number'} = "$year$mon$mday-$rnd1-$rnd2" unless ($FORM{'unique_reference_number'});
if (@missing_values or @bad_emails or @only_digits or @only_words) { Error('evil values') }
foreach $key (keys %FORM)
{
$FORM{$key} =~s/\0//g;
$FORM{$key} =~s/\"(\s|\.|\)|\Z)/»$1/g;
$FORM{$key} =~s/(\A|\s|\.|\()\"/$1«/g;
#NOT Page number
$pn=$FORM{'page_no'}; $pn++;
#NOT
# start_email is hidden field in the form which email has to been sent after
if ($key =~ /^_send_email/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Email Template',$FORM{$key});
@lines = ParseText(@lines);
@lines = ParseEmail(@lines);
if ($mailserver ne '') {SendMailBySmtp(@lines);} else {SendMail(@lines);}
# BrowserOut("Mail ($FORM{$key}) was sent OK!<br>" ;
}
}
elsif ($key =~ /^_out_file/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Log File',$FORM{$key});
@lines = ParseText(@lines);
LogFile('LogFile Template',@lines);
}
}
elsif ($key =~ /^_browser_out$FORM{page_no}$/ and $browser_out < 2)
{
#NOT Loading template:
$browser_out++;
@lines = ReadFile('Browser Template', $FORM{$key});
@lines = ParseText(@lines);
#NOT Appending POST variables as hidden fields
foreach $line (@lines) {
if ($line=~/(<\/form>)/) {
$hfields="";
foreach $k (keys %FORM) {
$v=$FORM{$k};
if ($k =~ /^page_no/) {$v++;}
$hfields .= '<input type="hidden" name="'.$k.'" value="'.$v.'">'."\n";
}
if (!defined($FORM{page_no})) {$hfields .= '<input type="hidden" name="page_no" value="1">'."\n";}
$line=$`.$hfields.$1.$';
}
}
BrowserOut(@lines);
}
elsif ($key =~ /^_redirect/ and $browser_out < 2)
{
$browser_out++;
print "Location: $FORM{$key}\n\n";
}
}
unless ($browser_out) {
@msg = (<DATA>);
$ENV{'OUT_TITLE'} = "Submission Successful";
$ENV{'OUT_MSG'} = "Your submission was successful. Thank you.";
@msg = ParseText(@msg);
BrowserOut(@msg);
}
opendir(DIR, $attachments_path) || exit(0);
@files_list = grep { /^\d{8}_(.*)_\._file$/ && -f "$attachments_path$_" } readdir(DIR);
closedir DIR;
foreach $attachment_file (@files_list) {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($attachments_path.$attachment_file);
if (time() >= $mtime + $attachments_ttl) {
unlink($attachments_path.$attachment_file);
}
}
exit(0);
### Subroutines ###
sub round
{
$value = shift @_;
$round_dec = shift @_;
$round_dec = $FORM{'_format_decimals'} if ($round_dec eq ""
return sprintf("%.".$round_dec."f", $value);
}#round
sub BrowserOut
{
print "$content_type@_\n";
}#BrowserOut
sub CheckRef
{
my ($valid_referer, @terms);
if ((@Referers) and ($ENV{'HTTP_REFERER'})) {
foreach $referer (@Referers) {
if ($ENV{'HTTP_REFERER'} =~ m|http.*?://$referer|i) {
$valid_referer++;
last;
}
}
} else {
$valid_referer++;
}
unless ($valid_referer) {
@terms = split(/\//,$ENV{'HTTP_REFERER'});
Error ('Bad Referer',
"'$ENV{'HTTP_REFERER'}' is not authorised to use this script. If you want them to be able to,
you should add '$terms[2]' to the referer list."
);
}
}#CheckRef
sub Error
{
++$error_loop;
my $title = shift @_;
my $msg = shift @_;
my @error;
if ($title eq 'evil values') {
my $val;
if (@missing_values) {
$msg = qq|<p>The following field(s) are required to be filled in before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@missing_values) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@bad_emails) {
$msg .= qq|<p>The following field(s) are required to be filled in with valid email addresses before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@bad_emails) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_digits) {
$msg .= qq|<p>The following field(s) are required to be filled in only with digits (0-9) and decimal point before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_digits) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_dig_and_dolar) {
$msg .= qq|<p>The following field(s) are required to be filled in only with digits (0-9) a decimal point, or a dollar sign before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_dig_and_dolar) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_words) {
$msg .= qq|<p>The following field(s) are required to be filled in only with word characters (A-Z, 0-9) before successful submission:</p>\n<ol type="i">\n|;
foreach $val (@only_words) { $msg .= "<li>$val\n" }
$msg .= "</ol>\n";
}
$title = 'Error - Incorrect Values';
$msg .= qq|<p>Please go back and fill in the fields accordingly.</p>\n|;
}
if ($FORM{'_error_url'}) {
print "Location: $FORM{'_error_url'}\n\n"
} elsif ($FORM{'_error_path'} and $error_loop < 2) {
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ReadFile('Error Template',$FORM{'_error_path'});
@error = ParseText(@error);
BrowserOut(@error);
} else {
@error = (<DATA>);
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ParseText(@error);
BrowserOut(@error);
}
exit(0);
}#Error
sub LogFile
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
# $file =~ s#\.\./##g;
# $file =~ s/[^\w-\.]//g;
$file = $base_path . $file;
open(FILE,">>$file" or Error('File Access Error',"An error occurred when trying to append to the $msg ($file): $!"
if (!defined($ENV{'COMSPEC'})) { # flock ain't needed on Windows !NT based systems
flock(FILE,2) or Error('File Lock Error',"An error occured when locking the $msg ($file): $!."
}
print FILE @_;
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!."
}#LogFile
sub ReadFile
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
# $file =~ s#\.\./##g;
# $file =~ s/[^\w-\.]//g;
$file = $base_path . $file;
open(FILE, "$file" or Error('File Access Error',"An error occurred when opening the $msg ($file): $!."
my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!."
return @lines;
}#ReadFile
sub ReadFile2
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
open(FILE, "$file" or Error('File Access Error',"An error occurred when opening the $msg ($file): $!."
my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!."
return @lines;
}#ReadFile2
sub ParseForm
{
my ($key, $prefs, $buffer, $file, $local_file, $value, $name, $file_name);
@names = $query->param;
foreach $name (@names)
{
$value = $query->param($name);
$FORM{$name} = $value;
if ($bytesread = read($value, $buffer, 1024)) {
$file_name = $value;
if ($file_name =~ /([^\/\\:]*)$/) {
$file_name = $1;
}
my $t_size = 0;
srand(time ^ $$);
my $rnd = sprintf("%08d", int(rand 100000000));
$local_file = $attachments_path . $rnd . "_" . $file_name . "_._file";
$FORM{$name."_uploaded"} = $rnd . "_" . $file_name . "_._file";
open (OUTFILE,">$local_file" or Error('File Access Error',"An error occurred when trying to save attachments ($local_file): $!"
binmode OUTFILE;
$t_size = length($buffer);
print OUTFILE $buffer;
while ($bytesread = read($value, $buffer, 1024)) {
$t_size += length($buffer);
print OUTFILE $buffer;
}
close OUTFILE;
my $f_size = 1024 * $max_file_size;
if($t_size > $f_size && $f_size != 0) {
unlink($local_file);
Error("Uploading file is too large. It must to be less than $max_file_size KB."
}
} else {
if ($name =~ /^([rs]*[edwmcn]?[rs]*)_/) {
($prefs, $key) = split /_/, $name, 2;
if ($prefs =~ /s/i and $value) {
$value =~ s/^(\s)*//;
$value =~ s/(\s)*$//;
$FORM{$name} = $value;
}
if ($prefs =~ /m/i and $value) {
$multi_separator = $FORM{'_multi_separator'} if defined($FORM{'_multi_separator'});
@value = $query->param($name);
$value = join($multi_separator,@value);
$value =~ s/^default$multi_separator|^default//ig;
$FORM{$name} = $value;
}
if ($prefs =~ /n/i and $value) {
$value =~ s/\n//ig;
$value =~ s/\r//ig;
$FORM{$name} = $value;
}
if ($prefs =~ /r/i and $value eq ""
{ push @missing_values, $key }
if ($prefs =~ /e/i and $value and isEmailBad($value))
{ push @bad_emails, $key }
if ($prefs =~ /d/i and $value and !($value =~ /^(\d+|\d+\.\d+)$/))
{ push @only_digits, $key }
if ($prefs =~ /c/i and $value and !($value =~ /^(\$?\d+\$?|\$?\d+\.\d+\$?)$/))
{ push @only_dig_and_dolar, $key }
if ($prefs =~ /w/i and $value and $value =~ /\W/)
{ push @only_words, $key }
}
}
}
}#ParseForm
sub ParseText
{
my ($line, $key, $value, $sub);
foreach $line (@_) {
while (($key => $value) = each %FORM)
{ $line =~ s/\[$key\]/$value/ig }
while (($key => $value) = each %ENV)
{ $line =~ s/\[\%$key\]/$value/ig }
$line =~ s/\x7e(\w+)((\[)(\d)(\]))?/eval "\$$1$3$4$5"/e;
#remove blank vars
# $line =~ s/\[[^<](.)*?[^>]\]//g;
}
foreach $line (@_) {
while ($line =~ /\[<((.)*?)>\]/) {
$sub = $1;
if ($sub !~ /^([\d\+\*\/\-%\.,x<>\(\)\s]|round|ifcond)*$/s) {
Error("Error in expression", $sub);
}
$sub = eval $sub;
$line =~ s/\[<(.)*?>\]/$sub/s
}
}
return @_;
}#ParseText
sub ifcond
{
$cond = shift @_;
$res1 = shift @_;
$res2 = shift @_;
if($cond) {
return sprintf("%s", $res1);
} else {
return sprintf("%s", $res2);
}
}#ifcond
sub ParseEmail
{
my ($line, $attachment_file, $add2email, $real_name, @email);
$add2email = "";
foreach $line (@_)
{
if (($line =~ /^Subject: (.+)\n$/i) and ($mail_format eq "html") {
$sline = $line."Content-Type: text\/html\n";
$line =~ s/^Subject: (.+)\n$/$sline/i;
}
if ($line =~ /^Attachment: (.+)$/i)
{
my @files = split (/,/, $1);
foreach $attachment_file (@files)
{
$attachment_file =~ s/(^\s*|\s*$)//g;
if ($attachment_file =~ /([^\/\\:]*)$/)
{
$attachment_file = $1;
}
if ($attachment_file =~ /^\d{8}_(.*)_\._file$/)
{$real_name = $1;}
else {$real_name = $attachment_file;}
#FIX
if (-e $attachments_path . $attachment_file)
{
$add2email .= "---2099962873-1165733044-991133573=:5283\n";
$add2email .= "Content-Transfer-Encoding: BASE64\n";
$add2email .= "Content-Disposition: attachment; filename=\"$real_name\"\n\n";
open(FILE, $attachments_path . $attachment_file) or Error("Error while opening attchment file", "\'$attachments_path$attachment_file\'"
binmode FILE;
while (read(FILE, my $buf, 60*57))
{
$add2email .= encode_base64($buf);
}
close FILE;
}
}
push @email, "MIME-Version: 1.0\n";
push @email, "Content-Type: MULTIPART/MIXED; BOUNDARY=\"-2099962873-1165733044-991133573=:5283\"\n\n";
push @email, " This message is in MIME format. The first part should be readable text,\n";
push @email, " while the remaining parts are likely unreadable without MIME-aware tools.\n";
push @email, " Send mail to mime\@docserver.cac.washington.edu for more info.\n\n";
push @email, "---2099962873-1165733044-991133573=:5283\n";
} else {
#NOT
# Strip tags if mail format is plain, skipping service info lines
$line=~s/<(?:[^>'"]*|(['"]).*?\1)*>//gs if ($mail_format eq "plain" && $line !~ /^(From|To|Cc|Bcc):/i);
push @email, $line;
}
}
if ($add2email)
{
push @email, "\n$add2email";
push @email, "---2099962873-1165733044-991133573=:5283--\n";
}
return @email;
}#ParseEmail
sub isEmailBad
{
$value = shift @_;
return (($value =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/) or
($value !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,6}|[0-9]{1,3})(\]?)$/));
}#isEmailBad
sub SendMailBySmtp
{
my($line, $var_name, @message);
unless ($smtp_used) {
eval "use Net::SMTP";
if ($@) {
Error('Net::SMTP init error', "Can't load Net::SMTP module"
return 0;
}
$smtp_used = 1;
}
@message = @_;
foreach $line (@message)
{
if ($line =~ /^(to|from|b?cc): (.+)$/i)
{
$mail_param = $1;
$mail_val = $2;
if ($mail_val =~ /<(.+)>/)
{
$mail_val = $1;
}
$var_name = "mail_".lc($mail_param);
# $$var_name = $mail_val;
@$var_name = split(/\x2c(\s*)?/,$mail_val);
}
}
$smtp = Net::SMTP->new($mailserver);
$smtp->mail($mail_from);
foreach $mt (@mail_to) {$smtp->recipient($mt);}
foreach $mt (@mail_cc) {$smtp->recipient($mt);}
foreach $mt (@mail_bcc) {$smtp->recipient($mt);}
$smtp->data();
$smtp->datasend(@_);
$smtp->dataend();
$smtp->quit;
}#SendMailBySmtp
sub SendMail
{
if ($mail_cmd ne "" {
open(MAIL,"|$mail_cmd" or Error('Mailer Open Error',"An error occurred when trying to open the mailer ($mail_cmd): $!."
print MAIL @_;
# print "\n\n",@_;
close(MAIL) or Error('Mail Send Error',"An error occurred when sending the email: $?. Please check the email's headers."
}
}#SendMail
sub encode_base64
{
my $res = "";
pos($_[0]) = 0;
while ($_[0] =~ /(.{1,45})/gs) {
$res .= substr(pack('u', $1), 1);
chop($res);
}
$res =~ tr|` -_|AA-Za-z0-9+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
$res =~ s/(.{1,76})/$1\n/g;
return $res;
}#encode_base64
sub ManagePage
{
$ENV{'OUT_TITLE'} = "eMail Form Script Administrative Section";
$ENV{'OUT_MSG'} = "";
open (CFILE, "<cform.html" or Error('Config Form Open Error',"An error occurred when opening config form (cform.html): $!. Please check paths and file."
@msg = <CFILE>;
close (CFILE) or Error('Config Form Close Error','An error occured while closing the file (cform.html): $!.');
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#ManagePage
sub SavePage {
&ParseForm;
$mas=0;
@lines = ReadFile2('Configuration File', $cfg_file);
#BrowserOut($cfg_file."<br>"
open (FILE, ">$cfg_file" or Error('Config Form Open Error',"An error occurred when opening config file($cfg_file): $!. Please check paths and file permissions (Must be 766)."
foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name.$mas}/ if defined($FORM{$var_name.$mas});
#print "$var_name === $FORM{$var_name.$mas}<br>";
$mas++;
}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name}/ if defined($FORM{$var_name});
}
print FILE $line;
}
close (FILE) or Error('Config Form Close Error','An error occured while closing the file ($cfg_file): $!.');
1;
}#SavePage
sub StartPage {
$ENV{'UPDATED'} = "" unless ($ENV{'UPDATED'});
$ENV{'OUT_TITLE'} = "INTTRA - Outage Notification Form";
$ENV{'OUT_MSG'} = qq~The latest version of this script and documentation is available from. <form action=$ENV{'SCRIPT_NAME'} method=POST><p align=center>To access configuration, please enter password: <br>
<input type=password name="pass09123" value="" style="border: 1 outset rgb(50,50,50);">
<input type="Submit" value=" ..:: OK ::.. " style="font: bold 8pt Verdana; color: #FFFFFF;background-color: #666699"></form></p>
~;
@msg = (<DATA>);
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#StartPage
__END__
<html>
<head>
<title>[%OUT_TITLE]</title>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="navy" vlink="navy" alink="red"
style="font-family: verdana, arial, sans-serif; font-size: 8;">
<center>
<table border="0" cellpadding="0" cellspacing="0" width="500"
style="font-family: verdana, arial, sans-serif; font-size: 12;">
<tr>
<td><h2 align="center">[%OUT_TITLE]</h2>
[%UPDATED]
<p align="center">[%OUT_MSG]</p>
</tr>
</table>
</center>
</body>
</html>
Thank you for any support in advanced. I come here for help because our perl programmer has left and we are left with a script that we do not know how to add to or modify. He has created a html form that sends out email based on user imput (they enter the email address that the form
should be sent to... Anyway, We have modify the form to add some checkboxes (9 groups) that has a SMTP address associated to them - for example,
If I select checkbox 1 and 3 the form should be sent via email to user1@domain.com and user3@domain.com.... and so on, in addition to the smtp address that's entered in the input field.
checkbox 1 = user1@domain.com
checkbox 2 = user2@domain.com
checkbox3 = user3@domain.com
below is the code from the html form....
<form name="Not_Out" method="post" action="/cgi-bin/form_email.pl">
<table border="0" cellspacing="0" cellpadding="0">
<tr>
<td colspan="2" class="maintext" bgcolor="#006699"> <b><font color="#FFFFFF">Select group(s)
to email ::</font></b></td>
</tr>
<tr>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User1">
Inttra All</font></td>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User2">
Integration & Operations </font></td>
</tr>
<tr>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User3 ">
EDI </font></td>
</table>
<p><font size="2">
<input type="submit" name="Submit" value="..:: SUBMIT ::.." class="buttons"> <input type="reset" name="reset" value="..:: RESET ::.." class="buttons">
</form>
-------------------------------------------------
Perl script "form_email.pl"
**** We need to add the ability to email based on checkbox
selection from the html form to this Perl Script...If there
are any Perl expert that can interpret this script and make sense of it - Please help....We need it. ****************
#!c:/perl/bin
#!/usr/bin/perl
# init default values
@Months= qw(January February March April May June July August September October November December); unshift @Months, "";
@Weekdays= qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
#$base_path = "./";
$error_loop = 0;
$browser_out = 0;
$cfg_file = "settings.cfg";
$cfg_form = "form.cfg";
$content_type = "Content-Type: text/html\n\n";
$multi_separator = ", ";
##############################################################################
use CGI::Carp qw (fatalsToBrowser);
use CGI qw/:cgi/;
$ENV{'UPDATED'}= ' ';
$query = new CGI;
# default message
if ($ENV{'REQUEST_METHOD'} eq 'GET' and not $ENV{'QUERY_STRING'}) {
&StartPage;
exit(0);
}
@lines = ReadFile2('Configuration File', $cfg_file);
foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "push \@$1, \"$2\";";}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$$1 = \"$2\";"; }
}
# we can inherit base path if drawn through several pages in page sequence
$base_path = $query->param('base_path').'/' if defined(($query->param('base_path')));
$base_path = $query->param('_base_path').'/' if defined(($query->param('_base_path')));
#NOT The following reads the form config. TMP var - "base_path" still remains
#NOT Say GoodBye to form hidden fields
@lines=ReadFile2('Form Configuration File', $base_path . $cfg_form);
foreach $line (@lines) {
if ($line =~ /^(attachments_path)\s*=\s*(.+?)\s*(\x23|$)/)
{eval "\$$1 = \"$2\";";}
if ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$FORM{$1} = \"$2\";";}
}
$attachments_path=$base_path . $attachments_path;
#exit;
# let's party
&ParseForm;
&CheckRef;
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/\/|\.)aol\.com/);
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/|\.)not/);
$FORM{'_format_decimals'} = "0" unless ($FORM{'_format_decimals'});
$FORM{'GMT_OFFSET'} = "0" unless ($FORM{'GMT_OFFSET'});
## DATE FORMATTING
$date_format = 'dd.mm.yyyy' unless defined($date_format);
$date = $date_format;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $FORM{'GMT_OFFSET'}*3600);
$mon++; $year+=1900; $syear="0".($year-2000);
$mday="0".$mday if length($mday)<2 ;
$date=~s/weekday/$Weekdays[$wday]/i;
$date=~s/wee/substr($Weekdays[$wday],0,3)/ei;
$date=~s/Month/$Months[$mon]/i;
$date=~s/mmm/substr($Months[$mon],0,3)/ei;
$mon=(length($mon)<2?"0":""
.$mon; # "0" schreiben oder nicht?$date=~s/yyyy/$year/i;
$date=~s/yy/$syear/io;
$date=~s/dd/$mday/io;
$date=~s/mm/$mon/eio;
$ENV{'DATE_GMT'} = sprintf("%02d:%02d:%02d %s GMT%+d",$hour,$min,$sec,$date,$FORM{'GMT_OFFSET'});
## END DATE FORMATTING
srand(time ^ $$);
$rnd1 = sprintf("%04d", int(rand 10000));
$rnd2 = sprintf("%04d", int(rand 10000));
$FORM{'unique_reference_number'} = "$year$mon$mday-$rnd1-$rnd2" unless ($FORM{'unique_reference_number'});
if (@missing_values or @bad_emails or @only_digits or @only_words) { Error('evil values') }
foreach $key (keys %FORM)
{
$FORM{$key} =~s/\0//g;
$FORM{$key} =~s/\"(\s|\.|\)|\Z)/»$1/g;
$FORM{$key} =~s/(\A|\s|\.|\()\"/$1«/g;
#NOT Page number
$pn=$FORM{'page_no'}; $pn++;
#NOT
# start_email is hidden field in the form which email has to been sent after
if ($key =~ /^_send_email/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Email Template',$FORM{$key});
@lines = ParseText(@lines);
@lines = ParseEmail(@lines);
if ($mailserver ne '') {SendMailBySmtp(@lines);} else {SendMail(@lines);}
# BrowserOut("Mail ($FORM{$key}) was sent OK!<br>"
;}
}
elsif ($key =~ /^_out_file/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Log File',$FORM{$key});
@lines = ParseText(@lines);
LogFile('LogFile Template',@lines);
}
}
elsif ($key =~ /^_browser_out$FORM{page_no}$/ and $browser_out < 2)
{
#NOT Loading template:
$browser_out++;
@lines = ReadFile('Browser Template', $FORM{$key});
@lines = ParseText(@lines);
#NOT Appending POST variables as hidden fields
foreach $line (@lines) {
if ($line=~/(<\/form>)/) {
$hfields="";
foreach $k (keys %FORM) {
$v=$FORM{$k};
if ($k =~ /^page_no/) {$v++;}
$hfields .= '<input type="hidden" name="'.$k.'" value="'.$v.'">'."\n";
}
if (!defined($FORM{page_no})) {$hfields .= '<input type="hidden" name="page_no" value="1">'."\n";}
$line=$`.$hfields.$1.$';
}
}
BrowserOut(@lines);
}
elsif ($key =~ /^_redirect/ and $browser_out < 2)
{
$browser_out++;
print "Location: $FORM{$key}\n\n";
}
}
unless ($browser_out) {
@msg = (<DATA>);
$ENV{'OUT_TITLE'} = "Submission Successful";
$ENV{'OUT_MSG'} = "Your submission was successful. Thank you.";
@msg = ParseText(@msg);
BrowserOut(@msg);
}
opendir(DIR, $attachments_path) || exit(0);
@files_list = grep { /^\d{8}_(.*)_\._file$/ && -f "$attachments_path$_" } readdir(DIR);
closedir DIR;
foreach $attachment_file (@files_list) {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($attachments_path.$attachment_file);
if (time() >= $mtime + $attachments_ttl) {
unlink($attachments_path.$attachment_file);
}
}
exit(0);
### Subroutines ###
sub round
{
$value = shift @_;
$round_dec = shift @_;
$round_dec = $FORM{'_format_decimals'} if ($round_dec eq ""
;return sprintf("%.".$round_dec."f", $value);
}#round
sub BrowserOut
{
print "$content_type@_\n";
}#BrowserOut
sub CheckRef
{
my ($valid_referer, @terms);
if ((@Referers) and ($ENV{'HTTP_REFERER'})) {
foreach $referer (@Referers) {
if ($ENV{'HTTP_REFERER'} =~ m|http.*?://$referer|i) {
$valid_referer++;
last;
}
}
} else {
$valid_referer++;
}
unless ($valid_referer) {
@terms = split(/\//,$ENV{'HTTP_REFERER'});
Error ('Bad Referer',
"'$ENV{'HTTP_REFERER'}' is not authorised to use this script. If you want them to be able to,
you should add '$terms[2]' to the referer list."
);
}
}#CheckRef
sub Error
{
++$error_loop;
my $title = shift @_;
my $msg = shift @_;
my @error;
if ($title eq 'evil values') {
my $val;
if (@missing_values) {
$msg = qq|<p>The following field(s) are required to be filled in before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@missing_values) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@bad_emails) {
$msg .= qq|<p>The following field(s) are required to be filled in with valid email addresses before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@bad_emails) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_digits) {
$msg .= qq|<p>The following field(s) are required to be filled in only with digits (0-9) and decimal point before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_digits) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_dig_and_dolar) {
$msg .= qq|<p>The following field(s) are required to be filled in only with digits (0-9) a decimal point, or a dollar sign before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_dig_and_dolar) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_words) {
$msg .= qq|<p>The following field(s) are required to be filled in only with word characters (A-Z, 0-9) before successful submission:</p>\n<ol type="i">\n|;
foreach $val (@only_words) { $msg .= "<li>$val\n" }
$msg .= "</ol>\n";
}
$title = 'Error - Incorrect Values';
$msg .= qq|<p>Please go back and fill in the fields accordingly.</p>\n|;
}
if ($FORM{'_error_url'}) {
print "Location: $FORM{'_error_url'}\n\n"
} elsif ($FORM{'_error_path'} and $error_loop < 2) {
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ReadFile('Error Template',$FORM{'_error_path'});
@error = ParseText(@error);
BrowserOut(@error);
} else {
@error = (<DATA>);
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ParseText(@error);
BrowserOut(@error);
}
exit(0);
}#Error
sub LogFile
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
# $file =~ s#\.\./##g;
# $file =~ s/[^\w-\.]//g;
$file = $base_path . $file;
open(FILE,">>$file"
or Error('File Access Error',"An error occurred when trying to append to the $msg ($file): $!"if (!defined($ENV{'COMSPEC'})) { # flock ain't needed on Windows !NT based systems
flock(FILE,2) or Error('File Lock Error',"An error occured when locking the $msg ($file): $!."
;}
print FILE @_;
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!."
;}#LogFile
sub ReadFile
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
# $file =~ s#\.\./##g;
# $file =~ s/[^\w-\.]//g;
$file = $base_path . $file;
open(FILE, "$file"
or Error('File Access Error',"An error occurred when opening the $msg ($file): $!."my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!."
;return @lines;
}#ReadFile
sub ReadFile2
{
my $msg = shift @_;
my $file = shift @_;
$file =~ s#^(\s)#./$1#;
open(FILE, "$file"
or Error('File Access Error',"An error occurred when opening the $msg ($file): $!."my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!."
;return @lines;
}#ReadFile2
sub ParseForm
{
my ($key, $prefs, $buffer, $file, $local_file, $value, $name, $file_name);
@names = $query->param;
foreach $name (@names)
{
$value = $query->param($name);
$FORM{$name} = $value;
if ($bytesread = read($value, $buffer, 1024)) {
$file_name = $value;
if ($file_name =~ /([^\/\\:]*)$/) {
$file_name = $1;
}
my $t_size = 0;
srand(time ^ $$);
my $rnd = sprintf("%08d", int(rand 100000000));
$local_file = $attachments_path . $rnd . "_" . $file_name . "_._file";
$FORM{$name."_uploaded"} = $rnd . "_" . $file_name . "_._file";
open (OUTFILE,">$local_file"
or Error('File Access Error',"An error occurred when trying to save attachments ($local_file): $!"binmode OUTFILE;
$t_size = length($buffer);
print OUTFILE $buffer;
while ($bytesread = read($value, $buffer, 1024)) {
$t_size += length($buffer);
print OUTFILE $buffer;
}
close OUTFILE;
my $f_size = 1024 * $max_file_size;
if($t_size > $f_size && $f_size != 0) {
unlink($local_file);
Error("Uploading file is too large. It must to be less than $max_file_size KB."
;}
} else {
if ($name =~ /^([rs]*[edwmcn]?[rs]*)_/) {
($prefs, $key) = split /_/, $name, 2;
if ($prefs =~ /s/i and $value) {
$value =~ s/^(\s)*//;
$value =~ s/(\s)*$//;
$FORM{$name} = $value;
}
if ($prefs =~ /m/i and $value) {
$multi_separator = $FORM{'_multi_separator'} if defined($FORM{'_multi_separator'});
@value = $query->param($name);
$value = join($multi_separator,@value);
$value =~ s/^default$multi_separator|^default//ig;
$FORM{$name} = $value;
}
if ($prefs =~ /n/i and $value) {
$value =~ s/\n//ig;
$value =~ s/\r//ig;
$FORM{$name} = $value;
}
if ($prefs =~ /r/i and $value eq ""
{ push @missing_values, $key }
if ($prefs =~ /e/i and $value and isEmailBad($value))
{ push @bad_emails, $key }
if ($prefs =~ /d/i and $value and !($value =~ /^(\d+|\d+\.\d+)$/))
{ push @only_digits, $key }
if ($prefs =~ /c/i and $value and !($value =~ /^(\$?\d+\$?|\$?\d+\.\d+\$?)$/))
{ push @only_dig_and_dolar, $key }
if ($prefs =~ /w/i and $value and $value =~ /\W/)
{ push @only_words, $key }
}
}
}
}#ParseForm
sub ParseText
{
my ($line, $key, $value, $sub);
foreach $line (@_) {
while (($key => $value) = each %FORM)
{ $line =~ s/\[$key\]/$value/ig }
while (($key => $value) = each %ENV)
{ $line =~ s/\[\%$key\]/$value/ig }
$line =~ s/\x7e(\w+)((\[)(\d)(\]))?/eval "\$$1$3$4$5"/e;
#remove blank vars
# $line =~ s/\[[^<](.)*?[^>]\]//g;
}
foreach $line (@_) {
while ($line =~ /\[<((.)*?)>\]/) {
$sub = $1;
if ($sub !~ /^([\d\+\*\/\-%\.,x<>\(\)\s]|round|ifcond)*$/s) {
Error("Error in expression", $sub);
}
$sub = eval $sub;
$line =~ s/\[<(.)*?>\]/$sub/s
}
}
return @_;
}#ParseText
sub ifcond
{
$cond = shift @_;
$res1 = shift @_;
$res2 = shift @_;
if($cond) {
return sprintf("%s", $res1);
} else {
return sprintf("%s", $res2);
}
}#ifcond
sub ParseEmail
{
my ($line, $attachment_file, $add2email, $real_name, @email);
$add2email = "";
foreach $line (@_)
{
if (($line =~ /^Subject: (.+)\n$/i) and ($mail_format eq "html"
) {$sline = $line."Content-Type: text\/html\n";
$line =~ s/^Subject: (.+)\n$/$sline/i;
}
if ($line =~ /^Attachment: (.+)$/i)
{
my @files = split (/,/, $1);
foreach $attachment_file (@files)
{
$attachment_file =~ s/(^\s*|\s*$)//g;
if ($attachment_file =~ /([^\/\\:]*)$/)
{
$attachment_file = $1;
}
if ($attachment_file =~ /^\d{8}_(.*)_\._file$/)
{$real_name = $1;}
else {$real_name = $attachment_file;}
#FIX
if (-e $attachments_path . $attachment_file)
{
$add2email .= "---2099962873-1165733044-991133573=:5283\n";
$add2email .= "Content-Transfer-Encoding: BASE64\n";
$add2email .= "Content-Disposition: attachment; filename=\"$real_name\"\n\n";
open(FILE, $attachments_path . $attachment_file) or Error("Error while opening attchment file", "\'$attachments_path$attachment_file\'"
;binmode FILE;
while (read(FILE, my $buf, 60*57))
{
$add2email .= encode_base64($buf);
}
close FILE;
}
}
push @email, "MIME-Version: 1.0\n";
push @email, "Content-Type: MULTIPART/MIXED; BOUNDARY=\"-2099962873-1165733044-991133573=:5283\"\n\n";
push @email, " This message is in MIME format. The first part should be readable text,\n";
push @email, " while the remaining parts are likely unreadable without MIME-aware tools.\n";
push @email, " Send mail to mime\@docserver.cac.washington.edu for more info.\n\n";
push @email, "---2099962873-1165733044-991133573=:5283\n";
} else {
#NOT
# Strip tags if mail format is plain, skipping service info lines
$line=~s/<(?:[^>'"]*|(['"]).*?\1)*>//gs if ($mail_format eq "plain" && $line !~ /^(From|To|Cc|Bcc):/i);
push @email, $line;
}
}
if ($add2email)
{
push @email, "\n$add2email";
push @email, "---2099962873-1165733044-991133573=:5283--\n";
}
return @email;
}#ParseEmail
sub isEmailBad
{
$value = shift @_;
return (($value =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/) or
($value !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,6}|[0-9]{1,3})(\]?)$/));
}#isEmailBad
sub SendMailBySmtp
{
my($line, $var_name, @message);
unless ($smtp_used) {
eval "use Net::SMTP";
if ($@) {
Error('Net::SMTP init error', "Can't load Net::SMTP module"
;return 0;
}
$smtp_used = 1;
}
@message = @_;
foreach $line (@message)
{
if ($line =~ /^(to|from|b?cc): (.+)$/i)
{
$mail_param = $1;
$mail_val = $2;
if ($mail_val =~ /<(.+)>/)
{
$mail_val = $1;
}
$var_name = "mail_".lc($mail_param);
# $$var_name = $mail_val;
@$var_name = split(/\x2c(\s*)?/,$mail_val);
}
}
$smtp = Net::SMTP->new($mailserver);
$smtp->mail($mail_from);
foreach $mt (@mail_to) {$smtp->recipient($mt);}
foreach $mt (@mail_cc) {$smtp->recipient($mt);}
foreach $mt (@mail_bcc) {$smtp->recipient($mt);}
$smtp->data();
$smtp->datasend(@_);
$smtp->dataend();
$smtp->quit;
}#SendMailBySmtp
sub SendMail
{
if ($mail_cmd ne ""
{open(MAIL,"|$mail_cmd"
or Error('Mailer Open Error',"An error occurred when trying to open the mailer ($mail_cmd): $!."print MAIL @_;
# print "\n\n",@_;
close(MAIL) or Error('Mail Send Error',"An error occurred when sending the email: $?. Please check the email's headers."
;}
}#SendMail
sub encode_base64
{
my $res = "";
pos($_[0]) = 0;
while ($_[0] =~ /(.{1,45})/gs) {
$res .= substr(pack('u', $1), 1);
chop($res);
}
$res =~ tr|` -_|AA-Za-z0-9+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
$res =~ s/(.{1,76})/$1\n/g;
return $res;
}#encode_base64
sub ManagePage
{
$ENV{'OUT_TITLE'} = "eMail Form Script Administrative Section";
$ENV{'OUT_MSG'} = "";
open (CFILE, "<cform.html"
or Error('Config Form Open Error',"An error occurred when opening config form (cform.html): $!. Please check paths and file."@msg = <CFILE>;
close (CFILE) or Error('Config Form Close Error','An error occured while closing the file (cform.html): $!.');
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#ManagePage
sub SavePage {
&ParseForm;
$mas=0;
@lines = ReadFile2('Configuration File', $cfg_file);
#BrowserOut($cfg_file."<br>"
;open (FILE, ">$cfg_file"
or Error('Config Form Open Error',"An error occurred when opening config file($cfg_file): $!. Please check paths and file permissions (Must be 766)."foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name.$mas}/ if defined($FORM{$var_name.$mas});
#print "$var_name === $FORM{$var_name.$mas}<br>";
$mas++;
}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name}/ if defined($FORM{$var_name});
}
print FILE $line;
}
close (FILE) or Error('Config Form Close Error','An error occured while closing the file ($cfg_file): $!.');
1;
}#SavePage
sub StartPage {
$ENV{'UPDATED'} = "" unless ($ENV{'UPDATED'});
$ENV{'OUT_TITLE'} = "INTTRA - Outage Notification Form";
$ENV{'OUT_MSG'} = qq~The latest version of this script and documentation is available from. <form action=$ENV{'SCRIPT_NAME'} method=POST><p align=center>To access configuration, please enter password: <br>
<input type=password name="pass09123" value="" style="border: 1 outset rgb(50,50,50);">
<input type="Submit" value=" ..:: OK ::.. " style="font: bold 8pt Verdana; color: #FFFFFF;background-color: #666699"></form></p>
~;
@msg = (<DATA>);
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#StartPage
__END__
<html>
<head>
<title>[%OUT_TITLE]</title>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="navy" vlink="navy" alink="red"
style="font-family: verdana, arial, sans-serif; font-size: 8;">
<center>
<table border="0" cellpadding="0" cellspacing="0" width="500"
style="font-family: verdana, arial, sans-serif; font-size: 12;">
<tr>
<td><h2 align="center">[%OUT_TITLE]</h2>
[%UPDATED]
<p align="center">[%OUT_MSG]</p>
</tr>
</table>
</center>
</body>
</html>