#!/usr/bin/perl -Tw
#
## Thanks to Perl Monk members for their suggestions:
#     Corion, moritz, runrig and pc88mxer 
#
# This program is free software: you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation, either version 3
# of the License, or (at your option) any later version.
#
# 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.
#
# You should have received a copy of the GNU General Public
# License along with this program.  If not, see
# <http://www.gnu.org/licenses/>.
#
use strict;
## Path set to minimal default
$ENV{PATH} = "/usr/bin:/bin:/usr/sbin";

use warnings;
use subs qw(isHostValid);
use CGI qw( :standard );
use CGI::Carp qw(fatalsToBrowser);

## Capture error message
BEGIN{
    CGI::Carp::set_message(\&carp_error);
}

## Path of nslooku. Change this to the path of your nslookup
my $NSLOOKUP = '/usr/bin/nslookup';
## Path of sendmail. change this to the path of your sendmail
my $SENDMAIL = '/usr/sbin/sendmail';
## Set your email address here
my $RECIP = 'youremail@here.com';


############################################################
#                    ACTION HANDLER                        #
############################################################
#
#
if($ENV{REQUEST_METHOD} eq 'POST'){
        ## Fetch form data input
        my $name_in = param('name');
        my $name = q{};
        my $email_in = param('email');
        my $email = q{};
        my $comments_in = param('comments');
        my $comments = q{};
        
        
        ## Check for html tags in name field
        if($name_in !~ /<.*>/){
                $name_in =~ /(.*)/;
                $name = $1;
        }else{
            die ("oops! you have html tags. naughty, naughty!");
        }
        
        ## Check to see if email is valid. 
        ## Does not match email addresses using an IP address instead 
        ## of a domain name.
        if ($email_in =~ m/\b[a-z0-9._%-]+@[a-z0-9.-]+\.[a-z]{2,4}\b/)
+{
            
            $email_in =~ /(.*)/;
            $email = $1;
        }else{
            die ("oops! your email address is not valid one");
        }
        
        ## Check for html tags in name field;
        if($comments_in !~ /<.*>/ ){
        $comments_in =~ /(.*)/;
        $comments = $1;
        }else{
            die ("oops! you have html tags. naughty, naughty!");
        }
        
        ## Okay! you have passed the tests. now the ultimate test.
        my @result = split(m/@/, $email);
        
        if(!isHostValid($result[1])) {
                die ("Oops! invalid host name");
        }
        
        ## Send form data to your email address
        open (MAIL, "|$SENDMAIL -t");
        print MAIL "To: $RECIP\n";
        print MAIL "Reply: $email\n";
        print MAIL "Subject:email from web form\n";
        print MAIL "\n\n";
        print MAIL "name: ". $name."\n" ;
        print MAIL "emial: ".$email."\n" ;
        print MAIL "comments: ".$comments."\n" ;
        print MAIL "\n\n";
        close (MAIL);

        ## Display confirmation message
        print header;
        print start_html;
        print "Thanks you for using the comment form.
                We are going to get back to you as soon
                as we can say thank you again.";
        print end_html;
}else{
    ## Display form
        print header;
        print start_html;
        print start_form(-method => "post", -action => "");
        print h4("Contact Form");
        print "Name: ", textfield(-name => "name"), br;
        print "E-mail: ", textfield(-name => "email"), br;
        print "Enter your comments:", br;
        print textarea(-name => "comments", -rows => "5", -column => "
+50"), br;
        print submit(-value => "Submit");
        print end_form;
        print end_html;
}

##
# Subroutine checks if the host is valid
#
# @param    host
#
sub isHostValid{
        my $host = shift;
    
      $/='';
    open(my $fh, "-|", $NSLOOKUP, "-type=any", $host)
          or die "unable to exec $NSLOOKUP: $!";
    my @response = <$fh>;
          close $fh;
          $/='\n';
          
          return 1 if (grep /Name:\s+$host/, @response);   
          return 0;
}

##
# Subroutine displays error message
#
# @param     error_message
#
sub carp_error{
    my $error_message = shift();
    
    print start_html("Error") .
                h1("Error") .
                p("Sorry, the following error has occurred: ") .
                p(i($error_message)) .
                end_html;
}
[download]