#!/usr/bin/perl
##############################################################################
# FormMail                       Version 1.6                                 #
# Copyright 1995-1997            worldwidemart.com                           #
# Created 06/09/95               Last Modified 05/02/97                      #
# Scripts Archive:               https://www.worldwidemart.com/scripts/          #
##############################################################################
# COPYRIGHT NOTICE                                                           #
# This script is distributed under the Artistic License.                     #
# You may freely use and modify it, keeping this copyright notice intact.    #
##############################################################################
# SECURITY WARNING                                                           #
# This is a HISTORICAL script preserved for educational purposes.            #
# DO NOT USE IN PRODUCTION - use modern alternatives like NMS FormMail,      #
# Tectite FormMail, or PHP-based form handlers.                              #
##############################################################################

use strict;
use warnings;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);

# Configuration - MUST be set before use
my @referers = ('yourdomain.com', 'www.yourdomain.com');
my @recipients = ();  # Leave empty to use form recipient field
my @valid_ENV = ('REMOTE_HOST', 'REMOTE_ADDR', 'HTTP_USER_AGENT');

# Mail program configuration
my $mailprog = '/usr/sbin/sendmail -t -oi';

##############################################################################
# Main Script
##############################################################################

my $cgi = CGI->new;

# Check referer
check_referer();

# Get form data
my %form = $cgi->Vars;

# Validate required fields
my @required = split(/,/, $form{'required'} || '');
my @missing;
foreach my $field (@required) {
    $field =~ s/^\s+|\s+$//g;
    if (!$form{$field} || $form{$field} =~ /^\s*$/) {
        push @missing, $field;
    }
}

if (@missing) {
    error_page("Missing Required Fields", \@missing);
    exit;
}

# Validate email if provided
if ($form{'email'} && $form{'email'} !~ /^[\w\.\-]+\@[\w\.\-]+\.\w+$/) {
    error_page("Invalid Email Address", ["email"]);
    exit;
}

# Get recipient
my $recipient = $form{'recipient'} || '';

# Validate recipient against allowed list
if (@recipients && !grep { $_ eq $recipient } @recipients) {
    error_page("Invalid Recipient", []);
    exit;
}

# Security: Check for header injection
if ($recipient =~ /[\r\n]/ || ($form{'email'} && $form{'email'} =~ /[\r\n]/)) {
    error_page("Invalid Characters Detected", []);
    exit;
}

# Build and send email
send_mail(\%form, $recipient);

# Show success page or redirect
if ($form{'redirect'}) {
    print $cgi->redirect($form{'redirect'});
} else {
    success_page(\%form);
}

##############################################################################
# Subroutines
##############################################################################

sub check_referer {
    my $referer = $ENV{'HTTP_REFERER'} || '';

    return if !@referers;  # No referer check if list is empty

    foreach my $ref (@referers) {
        return if $referer =~ /https?:\/\/([^\/]*\.)?\Q$ref\E/i;
    }

    error_page("Invalid Referer", []);
    exit;
}

sub send_mail {
    my ($form, $to) = @_;

    my $from = $form->{'email'} || 'noreply@' . ($ENV{'SERVER_NAME'} || 'localhost');
    my $subject = $form->{'subject'} || 'Form Submission';
    my $realname = $form->{'realname'} || '';

    # Build message body
    my $body = "The following information was submitted:\n";
    $body .= "=" x 50 . "\n\n";

    # Sort fields (put important ones first)
    my @order = defined $form->{'print_config'}
        ? split(/,/, $form->{'print_config'})
        : sort keys %$form;

    # Fields to skip in output
    my %skip = map { $_ => 1 } qw(
        recipient subject redirect required print_config
        env_report print_blank_fields
    );

    foreach my $field (@order) {
        next if $skip{$field};
        next if !$form->{'print_blank_fields'} && (!$form->{$field} || $form->{$field} =~ /^\s*$/);

        my $value = $form->{$field} || '';
        $value =~ s/\r\n/\n/g;
        $body .= "$field: $value\n\n";
    }

    # Add environment variables if requested
    if ($form->{'env_report'}) {
        $body .= "-" x 50 . "\n";
        $body .= "Environment Information:\n\n";
        foreach my $var (split(/,/, $form->{'env_report'})) {
            $var =~ s/^\s+|\s+$//g;
            next unless grep { $_ eq $var } @valid_ENV;
            $body .= "$var: " . ($ENV{$var} || 'Not Available') . "\n";
        }
    }

    # Send email
    open(my $mail, '|-', $mailprog) or do {
        error_page("Mail Error", ["Could not send email"]);
        exit;
    };

    print $mail "To: $to\n";
    print $mail "From: $from\n";
    print $mail "Reply-To: $from\n";
    print $mail "Subject: $subject\n";
    print $mail "X-Mailer: FormMail (worldwidemart.com)\n";
    print $mail "\n";
    print $mail $body;

    close($mail);
}

sub success_page {
    my ($form) = @_;

    print $cgi->header('text/html');
    print <<HTML;
<!DOCTYPE html>
<html>
<head>
    <title>Form Submitted Successfully</title>
    <style>
        body { font-family: Arial, sans-serif; margin: 40px; background: #f5f5f5; }
        .container { max-width: 600px; margin: 0 auto; background: white; padding: 30px; border-radius: 8px; box-shadow: 0 2px 4px rgba(0,0,0,0.1); }
        h1 { color: #28a745; }
        .back { margin-top: 20px; }
        a { color: #007bff; }
    </style>
</head>
<body>
    <div class="container">
        <h1>Thank You!</h1>
        <p>Your form has been submitted successfully.</p>
        <p>Below is what was submitted:</p>
        <hr>
HTML

    foreach my $key (sort keys %$form) {
        next if $key =~ /^(recipient|subject|redirect|required|print_config|env_report)$/;
        my $value = $form->{$key} || '';
        $value = $cgi->escapeHTML($value);
        print "<p><strong>$key:</strong> $value</p>\n";
    }

    print <<HTML;
        <div class="back">
            <a href="javascript:history.back()">&larr; Go Back</a>
        </div>
    </div>
</body>
</html>
HTML
}

sub error_page {
    my ($title, $fields) = @_;

    print $cgi->header('text/html');
    print <<HTML;
<!DOCTYPE html>
<html>
<head>
    <title>Error: $title</title>
    <style>
        body { font-family: Arial, sans-serif; margin: 40px; background: #f5f5f5; }
        .container { max-width: 600px; margin: 0 auto; background: white; padding: 30px; border-radius: 8px; box-shadow: 0 2px 4px rgba(0,0,0,0.1); }
        h1 { color: #dc3545; }
        .error-list { background: #fff3cd; padding: 15px; border-radius: 4px; }
        a { color: #007bff; }
    </style>
</head>
<body>
    <div class="container">
        <h1>Error: $title</h1>
HTML

    if (@$fields) {
        print "<div class='error-list'><p>The following fields had problems:</p><ul>\n";
        foreach my $field (@$fields) {
            print "<li>" . $cgi->escapeHTML($field) . "</li>\n";
        }
        print "</ul></div>\n";
    }

    print <<HTML;
        <p><a href="javascript:history.back()">&larr; Go Back and Try Again</a></p>
    </div>
</body>
</html>
HTML
}

__END__

=head1 NAME

FormMail.pl - Form to Email Gateway

=head1 SYNOPSIS

Create an HTML form with action pointing to this script:

  <form action="/cgi-bin/FormMail.pl" method="POST">
    <input type="hidden" name="recipient" value="you@example.com">
    <input type="hidden" name="subject" value="Contact Form">
    ...
  </form>

=head1 SECURITY WARNING

This script is provided for EDUCATIONAL PURPOSES ONLY.
For production use, please use modern alternatives:

- NMS FormMail: https://nms-cgi.sourceforge.net/
- Tectite FormMail: https://www.tectite.com/
- PHP form handlers with proper validation

=head1 HIDDEN FORM FIELDS

=over 4

=item recipient

Email address to send form data to (required)

=item subject

Subject line of email

=item redirect

URL to redirect to after successful submission

=item required

Comma-separated list of required field names

=item env_report

Comma-separated list of environment variables to include

=item print_config

Comma-separated list of fields to print (in order)

=back

=head1 LICENSE

Artistic License

=cut
