Perl script to send form data via email using Mail::Send

#!/usr/bin/perl -Tw
#
# @author       Mizanur Rahman
#
# 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
        my $message = q`
                name: $name\n
                email: $email\n
                comments: $comments\n
        `;

        require Mail::Send;

        my $msg = Mail::Send->new;
        # Set your email here
        $msg->to($RECIP);
        $msg->subject('example subject');

        my $fh = $msg->open('sendmail');
        print $fh $message;
        $fh->close;

        # 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;
}
Advertisements

Perl script to send form data via email using Sendmail

i’ve decided to create simple form data submition via email using perl technology and here it is.

enjoy!

#!/usr/bin/perl -Tw
#
# @author       Mizanur Rahman
#
# 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
# &lt;http://www.gnu.org/licenses/&gt;.
#
# Thanks to Perl Monks members for their suggestions:
# 	Corion, moritz, runrig and pc88mxer 
#
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(\&amp;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 =&gt; "post", -action =&gt; "");
        print h4("Contact Form");
        print "Name: ", textfield(-name =&gt; "name"), br;
        print "E-mail: ", textfield(-name =&gt; "email"), br;
        print "Enter your comments:", br;
        print textarea(-name =&gt; "comments", -rows =&gt; "5", -column =&gt; "50"), br;
        print submit(-value =&gt; "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 = &lt;$fh&gt;
      	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;
}

Perl CGI file upload solution

elloo!

i've been playing around with perl to create a cgi file upload facility with upload monitoring
and i came up with this in hope it may help someone.

to do this, i've taken a bit of help from Randal L. Schwartz artical
"Watching long processes through CGI."

#!/usr/bin/perl -w
#
# 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
# .
#
# PS: Randal L. Schwartz artical,
# "Watching long processes through CGI", has been modified to
# monitor CGI file upload.
#
# URL for the artical:
# http://www.stonehenge.com/merlyn/LinuxMag/col39.html
#

$|++;

use strict;
use CGI qw(:all delete_all escapeHTML);
use Fcntl qw(:DEFAULT :flock );

####################################################################
# Some constants for the program. Change it to what ever you want
# respectively.
# Example, you can change:
# 1. UPLOAD_DIR to your own defined upload directory.
# 2. BUFFER_SIZE to what ever size you want.
# 3. MAX_FILE_SIZE to what ever size you want.
#
use constant UPLOAD_DIR =>
	"/home/user/public_html/file/uploads";
use constant BUFFER_SIZE => 10;
use constant MAX_FILE_SIZE => 100 * 1_048_576;;

$CGI::DISABLE_UPLOADS = 0;
$CGI::POST_MAX = MAX_FILE_SIZE;

####################################################################
# 			ACTION HANDLER.
####################################################################
# This section is where all actions are handled.
#
if(my $progress_key = param('progress_key')) {
	print header;
	print start_html(
		-head => [""]);
	my $cache = &get_cache();
	my $progress = $cache->get($progress_key);
	unless ($progress and ref $progress eq "ARRAY") {
	    upload_form();
	    exit 0;
	}
	my $width = sprintf("%0.2f",
		(($progress->[1]/param('size')) * 100));
	print qq`

` ;
	print p(i("... continuing ...")) unless $progress->[0];

	print end_html;
}elsif(my $file = param('file')) {
	&upload_file();
}else{
	&upload_form();
}

exit 0;

####################################################################
# 		ALL SUBROTINES FOR THE PROGRAM
####################################################################
# This a subroutine which generates upload form.
#
sub upload_form (){
	print header;
	print start_html;
	print h1("Try uploading a file...");
	print qq`

		`;

	print end_html;
}

####################################################################
# This subroutine uploads the file to your server and updates the
# progressbar.
#
sub upload_file (){
	my $file = param('file');
	my $fh = upload('file');
	my $progress_key = &get_unique_id();
	my $totalsize = $ENV{CONTENT_LENGTH};
	my $cache = &get_cache();
	$cache->set($progress_key, [0, ""]);

	my $buffer = "";

	if(my $pid = fork) {
		delete_all();
		param('progress_key', $progress_key);
		param('size', $totalsize);
		print redirect(self_url());
	}elsif(defined $pid) {
		close STDOUT;
		open STDERR, ">/dev/null";
		sysopen (OUTPUT, UPLOAD_DIR .
			"/" . $progress_key . "-" . $file,
			O_CREAT | O_RDWR | O_EXCL);
		binmode $fh;
		binmode OUTPUT;
		my $bytes = 0;
		while(my $bytesread = read($fh, $buffer, BUFFER_SIZE)) {
			print OUTPUT $buffer;
			print STDERR $bytes += $bytesread . "\n";

			$cache->set($progress_key, [0, $bytes]);
		}
		$cache->set($progress_key, [1, $bytes]);

		close OUTPUT;
		exit 0;
	} else {
		die "Cannot fork: $!";
	}
}

####################################################################
# This subroutine gets an unique id.
#
sub get_unique_id (){
	return $ENV{UNIQUE_ID} if exists $ENV{UNIQUE_ID};

	require Digest::MD5;

	my $md5 = new Digest::MD5;
	my $remote = $ENV{REMOTE_ADDR} . $ENV{REMOTE_PORT};

	my $id = $md5->md5_base64(time, $$, $remote);
	$id =~ tr|+/=|-_.|;
	return $id;
}

####################################################################
# This code is taken from Randal L. Schwartz artical,
# "Watching long processes through CGI". you can find the artical at
# http://www.stonehenge.com/merlyn/LinuxMag/col39.html
#
sub get_cache() {
	require Cache::FileCache;

	  Cache::FileCache->new
	      ({
		namespace => 'upload',
		username => 'nobody',
		default_expires_in => '30 minutes',
		auto_purge_interval => '4 hours',
	       });
}