#!/usr/local/bin/perl

require 'parseform.pl';
$sm = '/usr/lib/sendmail -t -fwebmaster@mit.edu';
print("Content-Type: text/html\n\n");

if($ENV{'REQUEST_METHOD'} eq 'POST'){
	read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	$query =~ s/\+/ /g;
	%formfields = &parseform($query);
}
else{
	print("<h1>Huh?</h1>\n");
	exit;
}


$to = $formfields{'recipient'};
delete $formfields{'recipient'};
$to =~ s/\@[^\@\%]+mit.edu//;
if($to=~/[\@\%]/ || $to eq ''){
	print("<h1>Invalid recipient of Form</h1>\n");
	exit;
}

%config = split(' ', $formfields{'config'});
for $configfield (keys %config){
    next if $configfield eq 'any';
    $options = $config{$configfield};

    $output .= ("$configfield\n");
    $output .= "-" x length($configfield);
    $output .= "\n";
    $output .= $formfields{$configfield};
    $output .=("\n\n\n");

    if($options =~/_/){
	# Long form
	if($options=~/required/){
	    &required($configfield);
	}
	if($options=~/numeric/){
	    &numeric($configfield);
	}
	if($options=~/date/){
	    &date($configfield);
	}
	if($options=~/alpha/){
	    &alpha($configfield);
	}
	if($options=~/mixed/){
	    &mixed($configfield);
	}
	if($options=~/email/){
	    &email($configfield);
	}
	if($options=~/phone/){
	    &phone($configfield);
	}
	if($options=~/credit/){
	    &credit($configfield);
	}
	if($options=~/quant(\d+)/){
	    &quant($configfield, $1);
	}
    }
    else{
	# Abbreviated form
	if($options=~/r/){
	    &required($configfield);
	}
	if($options=~/n/){
	    &numeric($configfield);
	}
	if($options=~/d/){
	    &date($configfield);
	}
	if($options=~/a/){
	    &alpha($configfield);
	}
	if($options=~/w/){
	    &mixed($configfield);
	}
	if($options=~/e/){
	    &email($configfield);
	}
	if($options=~/p/){
	    &phone($configfield);
	}
	if($options=~/c/){
	    &credit($configfield);
	}
	if($options=~/q(\d+)/){
	    &quant($configfield, $1);
	}
    }
    delete $formfields{$configfield};
}


# Deal with 'any'
if(defined $config{'any'){
    if($config{'any'} =~ /_/ && $config{'any'}=~/required/){
	delete $config{'any'};
	&remaining_fields();
    }
    elsif($config{'any'}!~/_/ && $config{'any'}=~/r/){
	delete $config{'any'};
	&remaining_fields();
    }
}

sub remaining_fields{
    for $field (keys %formfields) {
	$output .= ("$field\n");
	$output .= "-" x length($field);
	$output .= "\n";	# 
	$output .= $formfields{$field};
	$output .=("\n\n\n");	# 
    }
}

if($error){
 print("<h1>Error in Form submission</h1>\n");
 print("<ul>$errors</ul>\n");
}
else{
    open(SM, "|$sm");
    printf SM "From: Web.survey.user\nSubject: Web Survey Response\nTo: %s\n",
    $to;
    print SM "X-WebClient: $ENV{'HTTP_USER_AGENT'}\n";
    print SM $output,"\n";	# 
#Reverse resolve the machine name from the IP address:
    
    @ipaddr = split(/\./, $ENV{'REMOTE_ADDR'});
    $packipaddr = pack('C4', @ipaddr);
    $realname = (gethostbyaddr($packipaddr,2))[0];
    unless ($realname)
    {
	$realname = "could not reverse-resolve name"
	}

    printf SM "\n-----\nsubmitted by user on %s (%s)\nEmail sent via the WWW survey form gateway at %s:%s.\n\n", $ENV{'REMOTE_ADDR'}, $realname, $ENV{'SERVER_NAME'}, $ENV{'SERVER_PORT'};

    close(SM);

    print("<h1>Sent</h1>\n");
    print("<pre>$output</pre>\n");
}



sub required {
    local($f) = @_;
    if(!defined $formfields{$f}){
	$error = 1;
	$errors .= "<li>$f field missing from form.  Please go back to the form and fill out this field.";
    }
}

sub numeric {
    local($f) = @_;
    $x = $formfields{$f};
    $x =~ s/\n/0/g;
    if($x =~ /\D/){
	$error = 1;
	$errors .= "<li>$f must be numerical.  Please go back to the form and correct this.";
    }
}

sub date {
    local($f) = @_;
    if($formfields{$f} !~ m,\d+/\d+/\d+,){
	$error = 1;
	$errors .= "<li>$f must be a date of the form 1/30/70.";
    }
}

sub alpha {
    local($f) = @_;
    if($formfields{$f} =~ /[^A-Za-z]/){
	$error = 1;
	$errors .= "<li>$f must be all alphabetic characters.";
    }
}

sub mixed {
    local($f) = @_;
    if($formfields{$f} !~ /[A-Za-z]/){
	$error = 1;
	$errors .= "<li>$f must contain alphabetic characters.";
    }
}

sub email {
    local($f) = @_;
    if($formfields{$f} !~ /[^\@\%]+\@[A-Za-z\.]+/){
	$error = 1;
	$errors .= "<li>$f must be an email address of the form foo@bar.baz.";
    }
}

sub phone {
    local($f) = @_;
    if($formfields{$f} !~ /\(?\d?\d?\d?\)?[ \-]?\d\d\d[ \-]\d\d\d\d/){
	$error = 1;
	$errors .= "<li>$f must be a phone number.";
    }
}

sub credit {
    local($f) = @_;
    if($formfields{$f} !~ /[\d\-]+/){
	$error = 1;
	$errors .= "<li>$f must be a credit card number.";
    }
}

sub quant {
    local($f, $q) = @_;
    (@lines) = split("\n", $formfields{$f});
    if($#lines+1 != $q){
	$error = 1;
	$errors .= "<li>You must make $q selections in $f.";
    }
}
