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

June 24, 2008March 28, 2010 getmizanur Cool Things with Perl

#!/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;
}

Perl script to send form data via email using Sendmail

June 24, 2008January 23, 2010 getmizanur Cool Things with Perl

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

June 8, 2008January 23, 2010 getmizanur Cool Things with Perl

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',
	       });
}

M	T	W	T	F	S	S
		1	2	3	4	5
6	7	8	9	10	11	12
13	14	15	16	17	18	19
20	21	22	23	24	25	26
27	28	29	30	31

Life of Miz

train of thoughts

Cool Things with Perl

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

Perl script to send form data via email using Sendmail

Perl CGI file upload solution