#!/usr/bin/perl
require 5.8.2;

use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI::apacheSSI (autotie => 'STDOUT', '_enable_exec_cmd' => 1);
use Time::HiRes qw(time);
use POSIX qw(strftime);
use Email::Valid;



    ####################################################################
    ###                                                              ###
    ###  FormMail++ v1.21  Oct  05, 2020                             ###
    ###  DOCUMENTATION =>  http://www.johnwoodruff.com/FormMail++    ###
    ###                                                              ###
    ####################################################################


    $TEMPLATE = '';
    $BASE_TAG = "_self";

    &initialize;
    &parse_stdin;
    &send_mail;
    &return_html;
    exit;


#########################################################################################################
sub initialize
    {my($i, $template, @error, @files);

     #---------------------------------------------------------------------------------------------------
     # GLOBAL DECLARATIONS
     #---------------------------------------------------------------------------------------------------
     %Data     = ();
     %Mail     = ();
     @Lines    = ();
     @Sequence = ();
	
     $Runtime  = time();

     $VERSION  = 'FormMail++ 1.21';
     $DATETIME = strftime("%a, %d %b %Y %H:%M:%S %Z", localtime); #i.e. Tue, 3 Jun 2014 00:10:14 EDT
     $PLSCRIPT = substr($ENV{SCRIPT_FILENAME}, rindex($ENV{SCRIPT_FILENAME}, "/") + 1);
 

     #---------------------------------------------------------------------------------------------------
     # PERFORM SOME CONFIGURATION CHECKS
     #---------------------------------------------------------------------------------------------------
     if ($ENV{REQUEST_METHOD} ne 'POST')
        {if ($ENV{CONTENT_LENGTH} =~ /^\s*$/gm && $ENV{QUERY_STRING} =~ /^\s*$/gm)
            {&about; exit;}
         else
            {push(@error,'Invalid method. Data must be submitted via POST');}
        }
     elsif ($ENV{REQUEST_METHOD} eq 'POST')
        {if (!$ENV{HTTP_REFERER})
            {push(@error,'The referrer page must be identified');}
         elsif ($ENV{HTTP_REFERER} !~ /$ENV{SERVER_NAME}/i)
            {push(@error,'Data cannot be submitted from a remote server');}
        }
     else
        {die;}

     if (scalar(@error) > 0)
        {&about(@error); exit;}


     #---------------------------------------------------------------------------------------------------
     # CONSTRUCT TEMPLATE   -f=file -r=readable -x=executable -T=text-only -d=directory -c=system file
     #---------------------------------------------------------------------------------------------------
     chdir($ENV{DOCUMENT_ROOT});

     if (!$BASE_TAG)
        {$BASE_TAG = substr($ENV{HTTP_REFERER}, 0, rindex($ENV{HTTP_REFERER}, '/')+1 )}

     if (!$TEMPLATE)
        {opendir(SCRIPTDIR, $ENV{DOCUMENT_ROOT});
         @files = readdir(SCRIPTDIR);
         closedir(SCRIPTDIR);

         $template = substr($PLSCRIPT, 0, index($PLSCRIPT, "."));

         foreach $i (@files)
            {if ($i =~ /^$template\.s?html?$/)
                {$template = $i; last;}
            }
        }
     else
        {$template = $TEMPLATE;}

     if ((-f $template) && ((-r $template) || (-x $template)) && (-T $template) && !(-c $template) && !(-d $template))
        {open(TEMPLATE, "<", "$template") or &about("Cannot open template - $!");
         @Lines = <TEMPLATE>;
         close (TEMPLATE);
        }
     else
        {push(@error,"Impermissible template ($template)");}

     if ($ENV{HTTPS})
        {$BASE_TAG =~ s/https?/https/i;}

     if (scalar(@error) > 0)
        {&about(@error); exit;}
    }


#########################################################################################################
sub parse_stdin
    {my($i, $f, @required, $required, @field_name_value_pairs);
     my @error = ();
     my $stdin = <STDIN>;
     my $host  = $ENV{SERVER_NAME};
     my %void  = ('redirect','', 'env_report','', 'sort','', 'print_config','', 'print_blank_fields','', 'title','', 'return_link_url','', 'return_link_title','', 'missing_fields_redirect','', 'background','', 'bgcolor','', 'text_color','', 'link_color','', 'vlink_color','', 'alink_color','', 'submit','', 'cancel','');
     my %trap  = ('realname','name', 'email','sender');

     $host =~ s/www\.//i;
     %Mail = ('name','', 'sender','', 'pseudofrom','', 'recipient','', 'cc','', 'bcc','', 'repliesto','', 'subject','', 'priority','');

     #---------------------------------------------------------------------------------------------------
     # POPULATE ASSOCIATIVE ARRAYS
     #---------------------------------------------------------------------------------------------------
     @field_name_value_pairs = split(/&/, $stdin);
     
     foreach $i (@field_name_value_pairs)
       {my($field_name, $field_value) = split(/=/, $i);
        foreach $f ($field_name,$field_value)
          {$f =~ tr/+/ /;
           $f =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
           $f =~ tr/\0//d;
          }

        if    (exists($void{$field_name}))
              {next;}
        elsif (exists($trap{$field_name}))
              {$Mail{$trap{$field_name}} = $field_value;
               $Data{$trap{$field_name}} = $field_value . "*";
               push(@Sequence,$trap{$field_name});
              }
        else
              {$Data{$field_name} .= ',' if $Data{$field_name} ne '';
               $Mail{$field_name} .= ',' if $Mail{$field_name} ne '' && exists($Mail{$field_name});

               $Data{$field_name} = $field_value;
               $Mail{$field_name} = $field_value if exists($Mail{$field_name});

               push(@Sequence,$field_name)      if $field_name ne 'bcc';
              }
       }


     #---------------------------------------------------------------------------------------------------
     # CHECK REQUIRED FIELDS
     #---------------------------------------------------------------------------------------------------
     $Data{required} =~ s/[\s\n]*,[\s\n]*/,/g;                # Remove new lines, spaces
     $Data{required} =~ s/\s*\n+\s*//g;
     @required  = split(/,/,$Data{required});

     foreach $i (qw/sender recipient message/)
        {if ($Data{required} !~ /$i/)
            {push(@required, $i);}
        }

     foreach $i (@required)
        {$required = $Data{$i};
         $required =~ s/\n//g;
         if ($required =~ /^\s*$/gm)                              # if field is space or empty
            {push(@error,'Missing Field: ' . $i);}
        }


     #---------------------------------------------------------------------------------------------------
     # VALIDATE MAIL FIELDS
     #---------------------------------------------------------------------------------------------------
     foreach $i (keys(%Mail))
        {if ($Mail{$i} =~ /(\n|\r)/m)
            {push(@error,'Prohibited characters in ' . $i);}
        }

     foreach $i (qw/recipient pseudofrom repliesto cc bcc/)
        {if ($Mail{$i} && !Email::Valid->address($Mail{$i}))
            {$Mail{$i} .= "@"       if $Mail{$i} !~ /\@$/;
             $Mail{$i} .= $host     if $host !~ /(\d{1,3}\.?){4}/;
             #Mail{$i} .= "[$host]" if $host =~ /(\d{1,3}\.?){4}/;
            }
        }

     foreach $i (qw/cc/)
        {if ($Mail{$i} && !Email::Valid->address($Mail{$i}))
            {if ($Mail{$i} =~ /1|true|yes/)
                {$Mail{$i} = $Mail{sender};}
             else
                {push(@error,"Out of range: $i is not an acceptible value for \"cc\"");}
            }
        }

     foreach $i (qw/sender recipient pseudofrom repliesto cc bcc/)
        {if ($Mail{$i} =~ /\S+/gm)
            {unless (Email::Valid->address(-address => $Mail{$i}, -mxcheck => 1))
               {push(@error,"Invalid Email: $Mail{$i} (" . $Email::Valid::Details . ")");}
            }
        }


     #---------------------------------------------------------------------------------------------------
     # POPULATE REPLY-TO
     #---------------------------------------------------------------------------------------------------
     foreach $i (qw/recipient sender/)
        {$Mail{repliesto} .= ",$Mail{$i},";
         $Mail{repliesto} =~ s/^,|,+(?=,)|,$//g;
        }


     #---------------------------------------------------------------------------------------------------
     # RETURN ERRORS
     #---------------------------------------------------------------------------------------------------
     if (scalar(@error) > 0)
        {&return_html(@error)}

     #if the script made it past missing field tests, then it is safe to delete bcc from the Data array
     #so it will not print when iterating in send_mail and return_html
     if (exists($Data{bcc}))
        {delete $Data{bcc};}
    }


#########################################################################################################
sub send_mail
    {my($i, $value, @blanks);
     my $suppress = "bcc,suppress," . $Data{suppress};
     my @sort_mail = split(/,/,$Data{sort_mail});

     #---------------------------------------------------------------------------------------------------
     # PROCESS FIELD SUPPRESSION(S)
     #---------------------------------------------------------------------------------------------------
     foreach $i (@sort_mail)
        {if ($i =~ /^\!/)
            {$suppress .= $i;
             undef($i);
            }
        }

     #not complete
     for ($i=0; $i<@sort_mail; $i++)
        {if ($i =~ /^\!/)
            {$suppress .= $i;
             delete($sort_mail[$i]);
            }
         
        }

     #---------------------------------------------------------------------------------------------------
     # CREATE MULTIPART EMAIL
     #---------------------------------------------------------------------------------------------------
     open(MAIL,"|/usr/sbin/sendmail -i -t") or die "FATAL ERROR: COULD NOT OPEN \'SENDMAIL\'";
	
     print MAIL "From: $Mail{pseudofrom}\n"               if  exists($Data{pseudofrom});
     print MAIL "From: \"$Mail{name}\" <$Mail{sender}>\n" if !exists($Data{pseudofrom});
     print MAIL "To: $Mail{recipient}\n";
     print MAIL "Cc: $Mail{cc}\n"  if  $Mail{cc} =~ /\@/;
     print MAIL "Bcc: $Mail{bcc}\n" if $Mail{bcc} =~ /\@/;
     print MAIL "Reply-To: $Mail{repliesto}\n";
     print MAIL "Subject: [FormMail++] $Mail{subject}\n";
     print MAIL "X-Mailer: $VERSION\n";
     print MAIL "X-Developer: John M. Woodruff, Ph.D.\n";
     print MAIL "Importance: High\n"        if exists($Data{priority});
     print MAIL "X-Priority: 1 (Highest)\n" if exists($Data{priority});
     print MAIL "X-MSMail-Priority: High\n" if exists($Data{priority});
     print MAIL "MIME-Version: 1.00\n";
     print MAIL "Content-Type: multipart/alternative; boundary=\"mime_message_body\"\n\n";
     print MAIL "This is a multipart message in MIME format.\n";


     #---------------------------------------------------------------------------------------------------
     # TEXT VERSION
     #---------------------------------------------------------------------------------------------------
     print MAIL "--mime_message_body\n"; 
     print MAIL "Content-Type: text/plain; charset=\"iso-8859-1\"; format=\"flowed\"\n\n";
     foreach $i (@Sequence)
        {$Data{$i} =~ s/<br>/\n/igm;
         print MAIL "$i: \n$Data{$i}\n\n\n" if $suppress !~ /$i/;
        }
     print MAIL "-" x 72 . "\n";
     print MAIL "REMOTE USER: $ENV{REMOTE_USER}\n";
     print MAIL "REMOTE HOST: $ENV{REMOTE_ADDR} ($ENV{REMOTE_HOST})\n";
     print MAIL "REMOTE CLIENT: $ENV{HTTP_USER_AGENT}\n";
     print MAIL "SERVER TIME: $DATETIME\n";
     print MAIL "-" x 45 . "\n";
     print MAIL "Powered by $VERSION in " . substr(eval(time() - $Runtime),0,4) . " sec\n";
     print MAIL "http://www.johnwoodruff.com/FormMail\+\+\n";


     #---------------------------------------------------------------------------------------------------
     # HTML VERSION
     #---------------------------------------------------------------------------------------------------
     print MAIL "--mime_message_body\n"; 
     print MAIL "Content-Type: text/html; charset=\"iso-8859-1\"\n";
     print MAIL "Content-Transfer-Encoding: 7bit\n\n";
     print MAIL "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n";
     print MAIL "<html>\n";
     print MAIL "<head>\n";
     print MAIL "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">\n";
     print MAIL "<title>$Data{subject} \| FormMail\+\+\</title>\n";
     print MAIL "</head>\n";
     print MAIL "<body>\n";

     #output form data
     if (!scalar(@sort_mail))
        {push(@sort_mail, 'message')};
     foreach $i (@sort_mail)
        {$value = $Data{$i};
         $value = &clean_html($value);
         if ($i =~ /message/)
            {$value = "<span style=\"font-variant:small-caps;color:darkblue;\">" . $value . "</span>\n";}
         print MAIL "<p><b style=\"font-variant:small-caps;color:black;\">$i:</b>&nbsp;$value</p>\n" if ($value =~ /\S/gm && $suppress !~ /$i/);
        }

     print MAIL "<hr>\n";
     print MAIL "<table>\n";

     foreach $i (@Sequence)
        {$value = $Data{$i};
         $value = &clean_html($value);
         if ($value =~ /\S/gm && $suppress !~ /$i/)
            {print MAIL "<tr>\n";
             print MAIL "  <td width=\"100\" valign=\"top\" align=\"left\"><b>$i:</b>&nbsp;</td>\n";
             print MAIL "  <td width=\"500\" valign=\"top\" align=\"left\">$value</td>\n";
             print MAIL "</tr>\n";
            }
         else
            {push(@blanks, $i) if $suppress !~ /$i/;}
        }

     foreach $i (@blanks)
        {print MAIL "<tr>\n";
         print MAIL "  <td width=\"100\" valign=\"top\" align=\"left\">$i:&nbsp;</td>\n";
         print MAIL "  <td width=\"300\" valign=\"top\" align=\"left\">&nbsp;</td>\n";
         print MAIL "</tr>\n";
        }

     print MAIL "</table>\n";
     print MAIL "<hr>\n";
     print MAIL "<p><b>REMOTE USER:</b> $ENV{REMOTE_USER}</p>\n";
     print MAIL "<p><b>REMOTE HOST:</b> $ENV{REMOTE_ADDR} ($ENV{REMOTE_HOST})</p>\n";
     print MAIL "<p><b>REMOTE CLIENT:</b> $ENV{HTTP_USER_AGENT}</p>\n";
     print MAIL "<p><b>SERVER TIME:</b> $DATETIME</p>\n";
     print MAIL "<hr>\n";
     print MAIL "<p><font size=\"1\">Powered by <a href=\"http://www.johnwoodruff.com/FormMail\+\+?ver=$VERSION\">$VERSION</a> in " . substr(eval(time() - $Runtime),0,4) . " sec</font></p>\n";
     print MAIL "</body>\n";
     print MAIL "</html>\n";


     #---------------------------------------------------------------------------------------------------
     # ATTACHMENT
     #---------------------------------------------------------------------------------------------------


     #MIME CLOSE
     print MAIL "--mime_message_body--\n"; 
     close (MAIL);
    }


#########################################################################################################
sub return_html
    {my @error = @_;
     my $error = join(',', @error);
    (my $plscript = $PLSCRIPT) =~ s/\./\\./g;
     my $suppress = "bcc,suppress," . $Data{suppress};
     my @sort_html = split(/,/,$Data{sort_html});
     my($i, $x, $boundary, $offset, $value, $suppress, @blanks);

     &return_header("html", "200 OK");

     #---------------------------------------------------------------------------------------------------
     # PROCESS FIELD SUPPRESSION(S)
     #---------------------------------------------------------------------------------------------------
     foreach $i (@sort_html)
        {if ($i =~ /^\!/)
            {$suppress .= $i;
             undef($i);
            }
        }

     #not complete
     for ($i=0; $i<@sort_html; $i++)
        {if ($i =~ /^\!/)
            {$suppress .= $i;
             delete($sort_html[$i]);
            }
         
        }

     #---------------------------------------------------------------------------------------------------
     # begin printing html; insert <base> tag when appropriate; stop when form is reached
     #---------------------------------------------------------------------------------------------------
     for ($x=0; $x<@Lines; $x++)
         {if (@Lines[$x] =~ /<head>/i)
             {@Lines[$x] =~ s/$/\n<base href=\"$BASE_TAG\" \/>/;}
          if (@Lines[$x] =~ /\b$plscript\b/i)
             {$offset = substr(@Lines[$x], 0, (index(@Lines[$x], '<'))); last;}
          print "@Lines[$x]";
         }

     print "$offset<!-- form boundary at line " . eval($x) . " -->\n";

     #---------------------------------------------------------------------------------------------------
     # output error html (if there are errors)
     #---------------------------------------------------------------------------------------------------
     if (scalar(@error))
        {print "$offset<p id=\"disposition\">Submission failed $DATETIME because of the following error(s):</p>\n";
         print "$offset<ol id=\"error\">\n";
         foreach $i (@error)
           {print "$offset  <li class=\"error\">$i</li>\n";}
         print "$offset</ol>\n";

         for ($x; $x<@Lines; $x++)
             {@Lines[$x] =~ s/<!--\#.+-->//g;
              print "@Lines[$x]";
              if ($Lines[$x] =~ /<\/form>/i)
                 {print "$offset<script type=\"text/javascript\" language=\"JavaScript\">\n";
                  foreach $i (keys(%Data))
                      {$Data{$i} =~ s/\r?\n/<br>/gm;
                       print "$offset  document.forms['contact'].$i.value=\"$Data{$i}\";\n";
                       print "$offset  document.forms['contact'].$i.checked=\"true\";\n" if $Data{$i};
                       print "$offset  document.forms['contact'].$i.style.color = \"black\";\n" if $error =~ /$i/i;
                       print "$offset  document.forms['contact'].$i.style.backgroundColor = \"MistyRose\";\n" if $error =~ /$i/;
                       print "$offset  document.forms['contact'].$i.placeholder = \"Please enter your $i\";\n" if ($error =~ /$i/i && $Data{$i} !~ /\S/);
                      }
                  print "$offset  for (x=0; x < document.forms['contact'].elements.length; x++)\n";
                  print "$offset      {document.forms['contact'].elements[x].value = document.forms['contact'].elements[x].value.replace(/<br>/g,\'\\n\');}\n";
                  print "$offset</script>\n";
                  last;
                 }
             }

         for ($x++; $x<@Lines; $x++)
             {print "@Lines[$x]";}

         exit;
        }


     #---------------------------------------------------------------------------------------------------
     # output success html
     #---------------------------------------------------------------------------------------------------
     print "$offset<p id=\"disposition\">Submission was successful as of $DATETIME.</p>\n";
     print "$offset<table id=\"cgi\">\n";

     if (scalar(@sort_html) > 0)
        {foreach $i (@sort_html)
           {$value = $Data{$i};
            $value = &clean_html($value);
            $value = &wrap_html($value,$offset,$boundary) if length($value) > 10000;
            print "$offset  <tr class=\"record\">\n";
            print "$offset    <td class=\"field\">$i:&nbsp;</td>\n";
            print "$offset    <td class=\"value\">$value</td>\n";
            print "$offset  </tr>\n";
           }
        }
     else
        {foreach $i (@Sequence)
           {$value = $Data{$i};
            $value = &clean_html($value);
            $value = &wrap_html($value,$offset,$boundary) if length($value) > 10000;
            if ($value =~ /\S/ && $suppress !~ /$i/ && $i !~ /sort|required/ig)
               {print "$offset  <tr class=\"record\">\n";
                print "$offset    <td class=\"field\">$i:&nbsp;</td>\n";
                print "$offset    <td class=\"value\">$value</td>\n";
                print "$offset  </tr>\n";
               }
            elsif ($value !~ /\S/ && $suppress !~ /$i/ && $i !~ /sort|required/ig)
               {push(@blanks, $i);}
            }
         if (scalar(@blanks))
            {print "$offset  <tr class=\"separator\">\n";
             print "$offset    <td colspan=\"2\"><hr>Empty Fields<hr></td>\n";
             print "$offset  </tr>\n";
             foreach $i (@blanks)
                {print "$offset  <tr class=\"blanks\">\n";
                 print "$offset    <td class=\"field\">$i:&nbsp;</td>\n";
                 print "$offset    <td class=\"value\">&nbsp;</td>\n";
                 print "$offset  </tr>\n";
                }
            }
        }

     print "$offset  <tr class=\"record extra\">\n";
     print "$offset    <td>&nbsp;</td>\n";
     print "$offset    <td>&nbsp;</td>\n";
     print "$offset  </tr>\n";
     print "$offset</table>\n";

     print "$offset<p align=\"center\"><font size=\"1\">Powered by <a href=\"http://www.johnwoodruff.com/FormMail\+\+?ver=$VERSION\">$VERSION</a> in " . substr(eval(time() - $Runtime),0,4) . " sec</font></p>\n";

     for ($x++; $x<@Lines; $x++)
         {last if ($Lines[$x] =~ /<\/form>/i);}

     print "$offset<!-- form boundary at line " . eval($x) . " -->\n";

     for ($x++; $x<@Lines; $x++)
         {print "@Lines[$x]";}
    }


#########################################################################################################
sub return_header
    {my($type, $code, $message) = @_;     # call as &return_header(content-type,status-string,message)
     print STDOUT "Content-type: text/$type\n";
     print STDOUT "Status: ", $code, "\n\n";
     print STDOUT "$message" if ($message);
    }

	
#########################################################################################################
sub clean_html
    {my $value = $_[0];
     $value =~ s/<br>/\n/igm; 
     $value =~ s/\&/\&amp;/gm;
     $value =~ s/</\&lt;/gm;
     $value =~ s/>/\&gt;/gm;
     $value =~ s/"/\&quot;/gm;
     $value =~ s/\$/\&#36;/gm;
     $value =~ s/\r?\n/<br>/gm;
     return $value;
    }


#########################################################################################################
sub wrap_html
    {my($y);
     my $leader = "    <td class=\"value\">";
     my($value, $offset,$boundary) = @_;

     $boundary = " " x 10000;

     if (length($value) > length($boundary)-length("$offset<t<t<td class=\"value\">"))
        {for ($y=length("$offset$boundary")-length("$offset<t<t<td class=\"value\">"); $y<length($value); $y+=length("$offset$boundary"))
             {substr($value, rindex($value, " ", $y)+1, 0) = "\n" . " " x length("$offset<t<t<td>");}
        }

     return $value;
    }


#########################################################################################################
sub about
    {my($i, $error, $html);
     my @error = @_;
     my $stdin = <STDIN>;
     my $stderr = <STDERR>;
     my $docuri = "http://www.johnwoodruff.com/FormMail++?$VERSION";


     #---------------------------------------------------------------------------------------------------
     # process any errors
     #---------------------------------------------------------------------------------------------------
     if ($stderr)
        {push(@error,$stderr);}

     if (scalar(@error))
        {$error = "<h2>Execution Error</h2>\n";
         foreach $i ($stdin, $stderr)
           {$i =~ tr/+/ /;
            $i =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
            $i =~ tr/\0//d;
            $i =~ s/\&/<br>/g;
           }
     
	    foreach $i (@error)
           {$error .= "    <h3>&raquo; $i.</h3>\n";}

         $error .= "    <h3>&raquo; The data submission was rejected with error:</h3> <blockquote>$stderr</blockquote>\n" if ($stderr);
	    $error .= "    <h3>&raquo; The following data was <u>not</u> processed:</h3> <blockquote>$stdin</blockquote>\n" if ($stdin);
         $error .= "    <script language=\"javascript\">document.getElementById(\"error\").style.display=\'block\';</script>";
        }


     #---------------------------------------------------------------------------------------------------
     # return elegant documentation (and errors, if applicable) 
     #---------------------------------------------------------------------------------------------------
     use LWP::Simple qw(get);
     $html = get($docuri) or push(@error,'Unable to retrieve documentation.');
	
     if ($html && scalar(@error))
        {$html =~ s/\$error/$error/i;}

     if (!scalar(@error))
        {&return_header("html", "200 OK");}
     else
        {&return_header("html", "400 Bad Request");}

     if ($html)
        {print STDOUT "$html";
         print "<p align=\"center\"><font size=\"1\">Powered by <a href=\"http://www.johnwoodruff.com/FormMail\+\+?ver=$VERSION\">$VERSION</a> in " . substr(eval(time() - $Runtime),0,4) . " sec</font></p>\n";
        }
     else
        {print STDOUT <<"		 END_HTML";
		 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
		 <html xmlns="http://www.w3.org/1999/xhtml">
		 <head>
		  <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
		  <meta name="Title" content="FormMail++">
		  <meta name="Author" content="John M. Woodruff, Ph.D.">
		  <meta name="Description" content="FormMail++, the next generation design of simple form data transmission.">
		  <meta name="Keywords" content="formmail,perl,email,John,Woodruff">
		  <meta name="robots" content="noindex,nofollow,noarchive">
		
		  <title>FormMail++</title>
		
		  <style>
			body {
				cursor:default;
				width:1000px;}
		
			body a {
				text-decoration:underline; 
				color:darkblue;}
		
			body a:hover {
				text-decoration:underline; 
				color:darkblue;}
				
			body p {
				font-size:0.833em;
				font-weight:normal;
				font-family:Verdana, Arial, "Times New Roman";}
				
		
			/* BRANDING */
			body div#branding {
				width:200px;
				display:block;
				white-space:nowrap;
				padding-bottom:10px;
				white-space:nowrap;
				font-variant:normal;
				font-family:Verdana, Arial, "Times New Roman";}
				
			body div#branding span#line1,
			body div#branding span#line1 a {
				display:block;
				color:darkred;
				font-size:32px;}
		
			body div#branding span#line2,
			body div#branding span#line2 a {
				display:block;
				color:darkblue;
				font-size:16px;}
				
			body div#branding span#line3,
			body div#branding span#line3 a {
				display:block;
				margin-top:10px;
				color:darkgoldenrod;
				font-size:10.5px;}
				
		
			/* MAIN BOXES */
			body div#error,
			body div#source,
			body div#notes {
				display:block;
				color:black;
				font-weight:bold;
				background-color:White;
				border: 2px solid black;
				padding:5px 5px 5px 5px;
				margin:40px 0px 20px 0px;}
			
			body div#error  h2,
			body div#source h2,
			body div#notes  h2 {
				display:block;
				color: #ffffff;
				text-align:left;
				text-transform:uppercase;
				padding:4px 5px 4px 4px;
				margin:-5px -5px 20px -5px;}
		
			body div#error  h2 a,
			body div#source h2 a,
			body div#notes  h2 a {
				color:inherit;
				text-decoration:none;}
		
			body div#error  h2 a:hover,
			body div#source h2 a:hover,
			body div#notes  h2 a:hover {
				color:inherit;
				text-decoration:none;
				border-bottom:1px solid white;}
		
			/* ERROR BOX */
			body div#error {
				display:none;
				color:maroon;
				border-color:maroon;
				background-color:MistyRose;
				margin-bottom: 60px;}
		
			body div#error h2 {
				background:maroon;}
		
			/* NOTES BOX */
			body div#notes {
				display:block;
				color:navy;
				border-color: navy;
				background-color:aliceblue;}
		
			body div#notes h2 {
				background:navy;}
				
			body div#notes p {
				font-size:0.833em;
				font-weight:normal;
				font-family:Verdana, Arial, "Times New Roman";}
		  </style>
		 </head>
		
		 <body>
		  <div id="branding">
			<span id="line1">FormMail++</span>
			<span id="line2">John M. Woodruff, Ph.D.</span>
			<span id="line3">Inspired by Matt Wright's FormMail</span>
		  </div>
		  
		  <div id="error">
			$error
		  </div>

		  <div id="notes">
			<h2>Release Notes:&nbsp; $VERSION</a></h2>
			<p>Unfortunately, documentation retrieval failed. Please consult<br />
			<a href=\"http://www.johnwoodruff.com/FormMail++/documentation\">http://www.johnwoodruff.com/FormMail++/documentation</a></p>
		  </div>
		
		 </body>
		 </html>
		 END_HTML
        }
    }