#!/usr/bin/perl
# -------------------------------------------------------------------------
# fdownload.pl - Based on the HTML file, C:\download\fdownload.html
# Perl CGI generated using CGI*starPro 3.3  - to process the input from a WWW Form
# E_mail Technical support from : support@webgenie.com
# -------------------------------------------------------------------------
# WARNING: Alterations to this file must be done very carefully.
#          Any introduced error will render this script useless.

# -------------------------------------------------------------------------
# NOTES: 
#        1. If editing, make sure that the control structure of script is not altered.
#        2. Save the edited file in text form.
#        3. Transfer this file to the WWW server in ASCII mode.
#        4. Set its protection to world read, execute (e.g. chmod 755 filename)

#        5. If your form contains edit controls named 'User_name',
#        'User_email' and 'Reply_to_email' (case-sensitive) they will
#  be used in the 'From:' field(s) of the E-mail. Otherwise it will be
#  'nobody' or 'unprivileged user'. (Tip: Include one oe more of the above controls 
#  in your form and make them mandatory)

#        6. Test the script on the server:
#             As a quick test, try running it from UNIX prompt by simply 
# typing the name of this file as a shell command and see if any 
# compilation error is reported. Then install the HTML and test via the form.

# -------------------------------------------------------------------------
# FREQUENT SOURCES of ERROR:
# 1. Error 500 
#    a. Syntax error in script. Run it from UNIX commandline and check.
#    b. The 'perl' pathname is wrong. Try a 'whereis perl' from UNIX prompt.
# 2. Error sending mail
#    a. The mailer program is not correctly specified. Try 'whereis sendmail'
#    b. The /tmp directory is not writeable to the browser.
#       1. Replace 'local($filename) = "/tmp/cspro_$$.tmp";' 
#         with 'local($filename) = "/yourdir/cspro_$$.tmp";', 
#         where yourdir is the full pathname of a dir you 
#         have set protections by 'chmod 777 dirname'. 
#         If the CGI is in a dir owned by you, then set 
#         its protection and '/tmp/cspro_$$.tmp' with 'cspro_$$.tmp'
# 3. Error 403 - Insufficient privilege
#    a. Set the protection on the CGI by 'chmod 755 cgifile'
# 4. Method not implemented
#    a. The extension, '.cgi', is not recognized. Try '.pl'
#    b. Ask your sysadmin for the exact file extension for the CGI
# -------------------------------------------------------------------------
# Start of the Perl script:

sub reformat
{
  local($tmp) = $_[0] ;
  $tmp =~ s/\+/ /g ;
  while ($tmp =~ /%([0-9A-Fa-f][0-9A-Fa-f])/)
  {
   $num = $1;
   $dec = hex($num);
   $chr = pack("c",$dec);
   $chr =~ s/&/and/g;  # Replace if it is the & char.
   $tmp =~ s/%$num/$chr/g;
  }
  return($tmp);
}
sub get_fields
{
   # Get the essential details from the form. These are the hidden fields added by the program
	# If there is no address to mail to. The Owner_email is also used to verify the expiry date
   if ($Owner_email eq "")
   {
      $No_Owner_Email = 1;
   }

   # The following are optional. If the user has included these it will be taken.
   if ($pquery =~ /User_name=([^&]*)&/)
   {
        $User_name = $1;
   }

   if ($pquery =~ /User_email=([^&]*)&/)
   {
        $User_email = $1;
   }

   if ($pquery =~ /Owner_email=([^&]*)&/)
   {
        $Owner_email = $1;
   }

   if ($pquery =~ /Reply_to_email=([^&]*)&/)
   {
        $Reply_to_email = $1;
   }
}

sub md_item_missing
{
   print "<HEAD>\n";
   print "<TITLE>CGI*StarPro - Mandatory Item Missing</TITLE>\n";
   print "</HEAD>\n";
   print "<BODY BGCOLOR=\"#C0DCC0\">\n";
   print "<H1><Center>Error! - Mandatory field(s) missing </Center></H1>\n";
   print "<h2><Blink>One or more mandatory input missing.</Blink></h2>";
   print "Please fill in or select the following item(s) and press the submit button again: <br> <Font Color=red>";
   $md_item =  shift @missing_md_items;
   while ($md_item)
   {
     if (@Captions{$md_item}) { print "@Captions{$md_item}<br>\n"; }
     else { print "$md_item<br>\n"; }
     $md_item =  shift @missing_md_items;
   }
   print "</Font>";
   print "</BODY></Html>\n";
   exit;
}
sub check_mandatory_fields
{
  @mandatory_items_array = split (/\*/, "$Mandatory_Fields");  # Split it at the * char.
  $md_item =  shift @mandatory_items_array;  # The first is null. Shift this out
  $md_item =  shift @mandatory_items_array;  # The first is null. Shift this out
  @missing_md_items = ();  # Initialize the array
  while ($md_item)
  {
     $i = 0;
     # Initially add it to the array. Then remove it if found in the user input
     push (@missing_md_items, "$md_item");
     while (@user_input[$i])
     {
      $Item =  @user_input[$i];
      @Item_components = split (/=/, "$Item");
      if ($md_item eq @Item_components[0])
      {
         if (@Item_components[1])
         {
            $md_item = pop @missing_md_items;
            $i = $#user_input;  # Skip the rest of User_input. This will avoid the multiple select items from being counted more than once
         }
      }
      $i++;
     }
     $md_item =  shift @mandatory_items_array;
  }
  if (@missing_md_items) { &md_item_missing; }
}

sub parse_input
{
  if ($User_email)
  {
     if ($User_name) { print TFILE "From: \"$User_name\" <$User_email>\n"; }
     else { print TFILE "From: \"$User_email\" <$User_email>\n"; }
  }
  else
  {
     if ($User_name) { print TFILE "From: \"$User_name\" <No_Address>\n"; }
     else { print TFILE "From: \"No Name\" <No_Address>\n"; }
  }

  if ($Reply_to_email ne "")
  {
     print TFILE "Reply-To: <$Reply_to_email>\n";
  }
  else
  {
     if ($User_email) { print TFILE "Reply-To: \"$User_name\" <$User_email>\n"; }
  }
  print TFILE "To: $Owner_email\n";
  print TFILE "Subject: $Form_subject\n";

  if ($sponsorID) { print TFILE "Sponsor ID = $sponsorID\n"; }

  while (@user_input)
  {
      $Item =  shift @user_input;
      #replace the CR and LF, if any.
      $Item =~ s/\r/ /g;
      $Item =~ s/\n/ /g;
      @Item_components = split (/=/, "$Item");
      # If empty input is NOT to be sent, then check it. Otherwise reformat $Item and send it
      if ($Send_Empty_Field)
      {
         if ($Caption{@Item_components[0]})
         {
            print TFILE "$Caption{@Item_components[0]}\t=\t@Item_components[1]\n";
	          if ($DisplayMailContentToUser) { push (@DisplayOnScreen, "$Caption{@Item_components[0]}	=	@Item_components[1]<br>\n");}
         }
         else
         {
            $Item =~ s/=/   = /g;  # Put a tab between the = sign and words on either side 
            print TFILE "$Item\n";
         }
         if ($DisplayMailContentToUser) { push (@DisplayOnScreen, "$Item<br>\n");}
      }
      else
      {
         if (@Item_components[1])
         {
            if ($Caption{@Item_components[0]})
            {
               print TFILE "$Caption{@Item_components[0]}\t=\t@Item_components[1]\n";
	             if ($DisplayMailContentToUser) { push (@DisplayOnScreen, "$Caption{@Item_components[0]}	=	@Item_components[1]<br>\n");}
            }
            else
            {
               $Item =~ s/=/   = /g;  # Put a tab between the = sign and words on either side 
               print TFILE "$Item\n";
            }
            if ($DisplayMailContentToUser) { push (@DisplayOnScreen, "$Item<br>\n");}
         }
      }
  }

  print TFILE "--------------------------------------------------------\n";
  print TFILE "This CGI expires in $rem_days days\n";
  print TFILE "See http://www.webgenie.com/Order/ to register.\n";
  print TFILE "--------------------------------------------------------\n";
  print TFILE "\n-------------------------------------------------\nForm processed at $ProcessTime\n";
  close (TFILE);
}

sub find_whereis
{
	# First of all see if the whereis command can be found
	$whereis = "/usr/bin/whereis";
	$whereis = `$whereis whereis`;

   if (!$whereis)
   {
		$whereis = "/usr/ucb/whereis";
		$whereis = `$whereis whereis`;
	   if (!$whereis)
   	{
			$whereis = "/bin/whereis";
			$whereis = `$whereis whereis`;
		   if (!$whereis)
		   {
				print "Sorry, the 'whereis' command cannot be found. Giving up. Please ask your sysadmin for\n";
				print "the correct pathnames for programs: 'sendmail', 'Mail', 'mail' and 'date'<p>\n";
		      return;
			}
   	}
   }
}
sub try_othermailers
{
   print  "The mailer specified in the CGI is wrong. Attempting to locate a suitable mailer program...<br>\n";
   print  "Please recreate the CGI to avoid this message appearing again.<p>\n";
   &find_whereis;
   if (!$whereis)
   {
      return;
   }
   $whereis =~ s/\n/ /g;
   $mail = `$whereis sendmail`;
   $mail =~ s/\n/ /g;
   if ($Owner_email !~ / /) { `$mail  $Owner_email < $filename`; }
   $mailerror = $?;
   if ($mailerror)
   {
      $mail = `$whereis Mail`;
      $mail =~ s/\n/ /g;
      if ($Owner_email !~ / /) { `$mail -s "$subject" $Owner_email < $filename`; }
      $mailerror = $?;
      if ($mailerror)
      {
          $mail = `$whereis mail`;
          $mail =~ s/\n/ /g;
          if ($Owner_email !~ / /) { `$mail $Owner_email < $filename`; }
          $mailerror = $?;
          if ($mailerror)
          {
             print "<Blink><B>Tried sendmail, Mail and mail but could not find any. Please ask your sysadmin for advice<br></b></Blink>";
          }
          else
          {
             print "Mailer used is : $mail\n";
          }
          return;
      }
      else
      {
         print "Mailer used is : $mail\n";
         return;
      }
   }
   else
   {
      print "Mailer used is : $mail\n";
      return;
   }
}
sub do_mail
{
   local($filename) = "/tmp/cspro_$$.tmp";
   open(TFILE,">$filename");

   &parse_input;
   if ($Owner_email !~ / /) { `$mail $Owner_email < $filename`; }
   $mailerror = $?;
   if ($mailerror)
   {&try_othermailers;} 
   if (!$mailerror)
   {
     unlink("$filename");
     if ($Acknowledgement)
     {
      print "<HEAD>\n";
      print "<TITLE>CGI*StarPro - Acknowledgement</TITLE>\n";
      if ($RefreshHTML) { print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"5; URL=$RefreshHTML\">\n";}
      print "</HEAD>\n";
      print "<BODY BGCOLOR=\"#C0DCC0\">\n";
      print "<H1><Center>Acknowledgement</Center></H1>\n";
      if ($User_name) { print "Dear $User_name, <p>\n"; }
      print "<H2><Font Color=\"#800040\">Your input has successfully been sent.</Font></H2>\n";
      if ($DisplayMailContentToUser)
      {
         print "<Font Color=\"#008000\">\n";
         print "<h3>The following data has been sent:</H3>\n";
         foreach $displayItem (@DisplayOnScreen)
         {
            print "$displayItem";\n         }
         print "</Font>\n";
      }
      print "$Acknowledgement<br>\n";
      print "</BODY></Html>\n";
     }
     else
     {
        if ($RefreshHTML) { print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"0; URL=$RefreshHTML\">\n";}
        else
        {
           print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"0; URL=/\">\n";
        }
     }
   }
   else
   {
      print "<HEAD>\n";
      print "<TITLE>CGI*StarPro - Error Sending Mail</TITLE>\n";
      print "</HEAD>\n";
      print "<BODY BGCOLOR=\"#C0DCC0\">\n";
      print "<H1><Center>Error sending mail.</Center></H1>\n";
      print "<Blink>Error sending mail. Either the mailer program or the E_mail address is wrongly specified.</Blink>n";
      print "</BODY></Html>\n";
   }
}
sub vcv
{
   @msg = ("CGI", "in", "Expires", "This", "Expired", "Has");
   $et = 894549525;
   $ct = time();
   if ($ct < $et)
   {
      $rt = ($et - $ct) / 86400;
      $rt .= "\.";  # Append a dot in case it is a whle number
      @num = split (/\./, "$rt");
      $rem_days = @num[0];
      $cv = 1;
   }
   else
   {
      $cv = 0;
   }
}

sub InitializeVariables
{
   $Owner_email="kasra\@ezenet.com";
   $Owner_name="";
   $Acknowledgement="<h2>Thank you for your input.</h2><h3>We will contact you shortly.</h3>";
   $Form_subject="kaskasbaba";
   $RefreshHTML="http://www.webgenie.com/";
   $Mandatory_Fields="*A3-Name*A3-Company";
}

sub GetSponsorCookie
{
	# Module to obtain the sponsorID if the site has implemented Site*Sponsor
   $sponsorID = "";
   @words = ();
   $cookies  = $ENV{'HTTP_COOKIE'};
   if (!$cookies) { return; }

   @cookiesArray = split (/;/, "$cookies");
   foreach $cookieItem (@cookiesArray)
   {
      if ($cookieItem =~ /SiteSponsor/)
      {
         @words = split (/=/, "$cookieItem");
      }
   }
   $sponsorID = @words[1];
}
# Main body of the script
sub do_main
{
  $cv = 1;
  $cl = $ENV{'CONTENT_LENGTH'};
  if ($cl > 0)
  {
   print "Content-type: text/html\n\n";
   read(STDIN, $_, $cl);
   $_ .= "&"; # Append an & char so that the last item is not ignored
   $pquery = &reformat($_);

   $No_Owner_Email = 0; # Initially assume that it is available.
   &InitializeVariables;
   &get_fields;
   &GetSponsorCookie;  # Get the sponsorID if the site has implemented Site*Sponsor
   if ($No_Owner_Email)
   {
      print "<HEAD>\n";
      print "<TITLE>CGI*StarPro - No E_Mail address</TITLE>\n";
      print "</HEAD>\n";
      print "<BODY BGCOLOR=\"#C0DCC0\">\n";
      print "<H1>Error... No E_mail Address</H1>\n";
      print "<Hr><Blink>E_mail Address to send the form input is missing. Aborting the CGI... </Blink> <Hr> \n";
      print "</BODY></Html>\n";
      unlink("$filename");
      exit;
   }
   &vcv;
   if (!$cv)
   {
      print "<HEAD>\n";
      print "<TITLE>CGI*StarPro Expired</TITLE>\n";
      print "</HEAD>\n";
      print "<BODY BGCOLOR=\"#C0DCC0\">\n";
      print "<H1><Center>Error!  Invalid or Expired CGI</Center></H1>\n";
      print "<Center><Blink>@msg[0] @msg[5] @msg[4] </Center></Blink><p>";
      print "<hr><Center>The CGI for this form was auto-generated by <A HREF=\"http://www.webgenie.com/Software/Cspro/\"><b>CGI*StarPro</b></Center><hr></A>\n";
      print "</BODY></Html>\n";
      local($filename) = "/tmp/cspro_$$.tmp";
      open(TFILE,">$filename");

      print TFILE "From: $User_name <$User_email>\n";
      print TFILE "To: $Owner_email\n";
      print TFILE "Subject: Attempted use of expired CGI\n\n";
      print TFILE "I tried to send input through your form but its CGI had expired.\n";
      print TFILE "See http://www.webgenie.com/Software/Order/ to register CGI*StarPro.\n";
      close (TFILE);
      if ($Owner_email !~ / /) { `$mail $Owner_email < $filename`; }
      print "<BODY BGCOLOR=\"#C0DCC0\">\n";
      $mailerror = $?;
      if ($mailerror) { &try_othermailers; }
      unlink("$filename");
      exit;
   }
   @user_input = split (/&/, "$pquery");  # Split it at the & char.
   &check_mandatory_fields;

   &do_mail;
   unlink("$filename");
  }
}

$ProcessTime = `/bin/date`; $ProcessTime =~ s/\n//g ;
$mail = "/usr/lib/sendmail";
$|=1;
&do_main;
sleep(1);

# ***** End of the Perl Script file. *****

