#!/usr/local/bin/perl

#######################################################################
#                                                                     #
# FormFeeder Ver 1.05                                                 #
#                                                                     #
# Copyright (c)2000-2003,2005 - Issac Goldstand                       #
# All rights reserved                                                 #
#                                                                     #
# This program is free software; you can redistribute it and/or       #
# modify it under the terms of the GNU General Public License         #
# (Version 2.0) as published by the Free Software Foundation.         #
# This program is distributed in the hope that it will be useful,     #
# but WITHOUT ANY WARRANTY; without even the implied warranty of      #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU    #
# General Public License for more details.                            #
# The GNU Public License can be viewed at the following URL:          #
# http://formfeeder.sourceforge.net/gpl.html                          #
#                                                                     #
# All copies of this software MUST include the above Copyright,       #
# Licensing and Warranty information.                                 #
#                                                                     #
#######################################################################
#                                                                     #
# Author Contact Information:                                         #
#                              Issac Goldstand                        #
#                              <margol@beamartyr.net>                 #
#                              http://www.beamartyr.net               #
#                                                                     #
#######################################################################
#                                                                     #
# Instructions:                                                       #
#       http://formfeerder.sourceforge.net/                           #
#                                                                     #
#######################################################################
#
# The following variables are system dependant and should be updated
#
# If you don't know where this program is on your system, try typing
# the following at your telnet prompt:
# % whereis sendmail

$SENDMAIL='/usr/sbin/sendmail';

# The $PERM_RECIP and $PERM_SUBJ can be used to overwrite the recipient
# and subject fields of the form respectively.  This increases security,
# but makes the script less flexible.  If you don't use these, leave 
# them commented out
#
# $PERM_RECIP='name@domain.com';
# $PERM_SUBJ='Script Email';
#
# Set the next variable to your HTML root directory.  Ask your service
# provider where this is...  Or, from the telnet prompt, go to your HTML 
# directory and type:
# % pwd
# The value read in from the form for templates will use this as a base
# directory for security reasons.  If you'd like to keep your templates
# out of the html path, simply use "../foo/bar.html" as the form
# variable.  You cannot use an address on a remote machine at this time.

$HTMLROOT='/home/user/public_html';

# The following variables are for overwriting the 'template','badinput'
# and 'mailfile' fields in the form, repectively.  You are recommended
# NOT to use these variables (to ensure maximum flexibility), unless
# there is serious potential for malicious misuse of these, as the 
# purpose of this script is to be remotely controlled from the calling
# web page.  If you must use them, enter values the same way as you'd
# normally enter them from inside the form (ie, relative to the HTMLROOT
# path defined above.
#
# $PERM_TEMPLATE='/template_normal.html';
# $PERM_BADINPUT='/template_bad.html';
# $PERM_MAILFILE='/template_mail.txt';
#
# Enter YOUR name here :-)  It will be put into any internal META
# AUTHOR tags that we use...  Note that this one is just for fun and is
# not required for the script to function properly.
 
$HTMLAUTHOR='FormFeeder Default';

####################################
#                                  #
#  DO NOT EDIT BEYOND THIS POINT!  #
#                                  #
####################################

use CGI::Carp qw(fatalsToBrowser); #Carp to browser
use strict;
use vars qw($VERSION $SENDMAIL $HTMLROOT $PERM_RECIP $PERM_SUBJ $PERM_TEMPLATE $PERM_BADINPUT $PERM_MAILFILE $HTMLAUTHOR %form $to $from $subj $temp $btemp $etemp);

BEGIN {
    $VERSION="1.06";
}

sub nicedate
{
 my (%mn)=('Jan','January','Feb','February','Mar','March','Apr','April','May','May','Jun','June','Jul','July','Aug','August','Sep','September','Oct','October','Nov','November','Dec','December');
 my ($mydate)=localtime(time);
 my ($day, $month, $num, $time, $year) = split(/\s+/,$mydate);
    my ($zl)=length($num);
    if ($zl == 1)
      { $num = "0$num";}
 return "$mn{$month} $num, $year";
}

sub nicetime
{
 my ($mydate)=localtime(time);
 my ($day, $month, $num, $time, $year) = split(/\s+/,$mydate);
 return $time;
}

sub read_input
{
    my ($buffer, @pairs, $pair, $name, $value, %form);
    $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
    if ($ENV{'REQUEST_METHOD'} eq "POST")
    {
	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    } else {
	$buffer = $ENV{'QUERY_STRING'};
    }
    @pairs = split(/&/, $buffer);
    foreach $pair (@pairs)
    {
	($name, $value) = split(/=/, $pair);
	$value =~ tr/+/ /;
	$value =~ s/%(..)/pack("C", hex($1))/eg;
	$form{$name} = $value;
    }
    return %form;
}

sub checkvals
{
    my $val;
    my $ok=1;
    for (values %form )
    {if ($_ eq "") {$ok=0;}}
    if ((!($to)) || (!($subj))) {$ok=0;}
    return $ok;
}

sub checkvalslist
{
    my @list=@_;
    my ($key,$val);
    my $ok=1;
    while (($key,$val) = each %form)
    {if (($val eq "") && (!(&inarray($key,@list)))){$ok=0;}}
    if ((!($to)) || (!($subj))) {$ok=0;}
    return $ok;
}

sub printmail
{
    my ($to,$subj,%hash)=@_;
    my $md=&nicedate;
    my $mt=&nicetime;
    open (MAIL,"|$SENDMAIL -FWWW-Site -t -U") or die("Error opening mail program");
    print MAIL "To: $to\n";
    print MAIL "From: WWW-Site Script\n";
    print MAIL "Subject: $subj\n"; 
    print MAIL "X-Mailer: FormFeeder/$VERSION\n\n";
    print MAIL "Recieved at $mt on $md\n";
    print MAIL "The following information was submitted:\n";
    while (my ($key,$val)=each(%form)) {
	print MAIL "$key\t$val\n";
    }
    print MAIL "\n\n-----------\nThe preceding was generated by an";
    print MAIL "automated script.  The author of the script takes";
    print MAIL "no responsibility for the contents of this ";
    print MAIL "electronic-mail message.\n";
    close(MAIL);
}

sub mergemail
{
    my ($filename,$to,$subj,%hash)=@_;
    my $md=&nicedate;
    my $mt=&nicetime;
    my $line=undef;
    open (IN,"<$filename") or die("Error opening $filename for input");
    open (MAIL,"|$SENDMAIL -FWWW-Site -t -U") or die("Error opening mail program");
    print MAIL "To: $to\n";
    print MAIL "From: WWW-Site Script\n";
    print MAIL "Subject: $subj\n";
    print MAIL "X-Mailer: FormFeeder/$VERSION\n";
    print MAIL "MIME-Version: 1.0\n";
    print MAIL "Content-Type: text/plain; charset=ISO-8859-1\n\n";
    while (<IN>)
    {
	s/<!--\#\#(.+?)\#\#-->/$hash{$1}/g;
	print MAIL "$_";
    }
    print MAIL "\n\n-----------\nThe preceding was generated by an";
    print MAIL "automated script.  The author of the script takes";
    print MAIL "no responsibility for the contents of this ";
    print MAIL "electronic-mail message.\n";
    close (MAIL);
    close (IN);
}

sub printhtmltemplate
{
    my ($filename,%hash)=@_;
    print "Content-type: text/html\n\n";
    open (IN,"<$filename") or die("Error opening $filename for input");
    while (<IN>)
    {
	s/<\/HEAD>/<META NAME="Generator" CONTENT="FormFeeder\/$VERSION">\n<\/HEAD>/;
	s/<!--\#\#(.+?)\#\#-->/$hash{$1}/g;
	print "$_";
    }
    close(IN);
}

sub printbadinputtemplate
{
    print "Content-type: text/html\n\n";
    my ($filename,%hash)=@_;
    my ($ihash,$inar)=(undef,undef);
    my @nonreq;
    open(IN,"<$filename") or die("Error opening $filename for input");
    while (<IN>)
    {
	s/<\/HEAD>/<META NAME="Generator" CONTENT="FormFeeder\/$VERSION">\n<\/HEAD>/;
	while (/<!--\#\#(iffail|ifpass)\((.+?)\)(.+?)\#\#-->/i){
	    $ihash=&inhash($2,%hash);
	    $inar=&inarray($2,@nonreq);
	    if (($ihash && (!($inar))) && (!($hash{$2}))) {s/<!--\#\#(iffail)\((.+?)\)(.+?)\#\#-->/$3/;} elsif ($ihash && $hash{$2}) {s/<!--\#\#(ifpass)\((.+?)\)(.+?)\#\#-->/$3/;} else {s/<!--\#\#(iffail|ifpass)\((.+?)\)(.+?)\#\#-->/<!--$1 condition not met for $2 - $3-->/;}
	}
	s/<!--\#\#(.+?)\#\#-->/$hash{$1}/g;
	print "$_";
    }
    close(IN);
}

sub printbadinput
{
    print <<"EOF";
Content-type: text/html

<HTML>
<HEAD>
  <META NAME="Author" CONTENT="$HTMLAUTHOR">
  <META NAME="Generator" CONTENT="FormFeeder/$VERSION">
  <TITLE>Error</TITLE>
</HEAD>
<BODY BGCOLOR="White">
<H1>Error: Missing fields</H1>
You did not enter all of the required fields.  Please press the 
back button on your browser and enter information in all fields.
</BODY>
</HTML>

EOF
}

sub printhtml
{
    my ($key,$val);
    my %hash=@_;
{
    print <<"ENDPART1";
Content-type: text/html

<HTML>
<HEAD>
  <META NAME="Author" CONTENT="$HTMLAUTHOR">
  <META NAME="Generator" CONTENT="FormFeeder/$VERSION">
  <TITLE>Thank you</TITLE>
</HEAD>
<BODY BGCOLOR="White">
<H1>Thank you</H1>
<H3>The following information was recieved:</H3>
<TABLE ALIGN=Left>
ENDPART1
}
    while (($key,$val) = each (%hash))
    {
	print "<TR><TD><XMP>$key</XMP></TD><TD><XMP>$val</XMP></TD></TR>\n";
    }
    print <<"EOF";
</TABLE>
</BODY>
</HTML>
EOF
}

sub inhash
{
  my ($key,%hash)=@_;
  my ($found,$tkey)=(0,undef);
  foreach $tkey (keys %hash){if ($tkey eq $key) {$found=1}};
  return $found;
} 

sub inarray
{
  my ($val,@array)=@_;
  my ($i,$found)=(0,0);
  foreach $i (0..$#array) {if ($array[$i] eq $val) {$found=1;}};
  return $found;
}

# We're using GLOBALS, not LEXICALS.  Later, I can fix it up and lexicalize everything
our %form=&read_input; #read form
#remove xtra hashkeys first
our $to=delete($form{'recipient'});
our $subj=delete($form{'subject'});
our $temp=delete($form{'template'});
our $btemp=delete($form{'badinput'});
our $etemp=delete($form{'mailfile'});
#process hardwired values where applicable
if ($PERM_RECIP) {$to=$PERM_RECIP;}
if ($PERM_SUBJ) {$subj=$PERM_SUBJ;}
if ($PERM_TEMPLATE) {$temp=$PERM_TEMPLATE;}
if ($PERM_BADINPUT) {$btemp=$PERM_BADINPUT;}
if ($PERM_MAILFILE) {$etemp=$PERM_MAILFILE;}
#process non-required fields and dump other excess garbage
my @nonreq=split(/,/,delete($form{'nonrequired'})) or my @nonreg=undef;
delete($form{'submit'});
# add remote IP if special field REMOTE_ADDR is present
$form{REMOTE_ADDR}=$ENV{REMOTE_ADDR} if defined $form{REMOTE_ADDR};
#check fields for accuracy
my $allok;
if (!(@nonreq)){$allok=&checkvals;}
 else {$allok=&checkvalslist(@nonreq);}
#..and output
if (!($allok)) {
    if (!($btemp)) {&printbadinput;} 
     else {&printbadinputtemplate("$HTMLROOT$btemp",%form);}
    exit;
}
if (!($etemp)) {printmail($to,$subj,%form);}
 else {&mergemail("$HTMLROOT$etemp",$to,$subj,%form);}
if (!($temp)) {&printhtml(%form);}
 else {&printhtmltemplate("$HTMLROOT$temp",%form);}