#!/usr/bin/perl -wT # # Generic web form mailer back-end script. # 27 Oct 2000 - Jacques Delsemme # 16 Oct 2002 - update printlog function - jd # 29 Jun 2007 - accept multiple param - jd # 9 Jun 2008 - add csv - jd # 10 Jun 2008 - add save to file - jd # 30 Sep 2008 - add captcha - jd # 13 Apr 2010 - add sortkeys and sortvalues fields - jd # # The following field is required: # mailform-notify e-mail address to sent form # # The following fields are optional: # mailform-title Title string for # mailform-bgcolor Background color for tag # mailform-h1 Primary heading for

# mailform-address Address string for

# mailform-reply Reply sent to user, or URL for redirect # mailform-required List of required fields # mailform-wrapmargin List of textarea fields to be wrapped # mailform-environment List of environment variables to mail # mailform-csv Return CSV lines (for spreadsheet) # mailform-file Save CSV lines in a file # mailform-confirm Send email confirmation to E-Mail address # mailform-captcha Require captcha to prevent spambots # mailform-sortkeys Sort keys (i.e. names of fields) # mailform-sortvalues Sort values (i.e. contents of fields) # # If there is a field named "Email" or "E-mail", it will be used as the # return address, otherwise mail will come from the default $Email variable. # # Any fieldname beginning with mailform- is assumed to be internal to # the mailform program, and will not be mailed. my $ProgName = "mailform"; my $ProgVersion = "2.0.9"; my $ProgAdmin = "websupport\@ucsc.edu"; my $ProgUrl = "/its/cgi-bin/$ProgName"; my $ProgInfoUrl = "http://people.ucsc.edu/~jacques/scripts/$ProgName"; ##################################################################### # required packages use strict; use CGI qw/:standard :html3/; use Text::Wrap; # use CGI::Carp 'fatalsToBrowser'; $ENV{PATH} = "/usr/lib"; # for sendmail # captcha (get your own keys from //http://www.google.com/recaptcha) use Captcha::reCAPTCHA; use constant PUBLIC_KEY => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'; use constant PRIVATE_KEY => 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy'; ##################################################################### # global variables # form variables my $Notify = ""; my $BgColor = "#FFFFFF"; my $Title = "Mailform"; my $H1 = $Title; my $Address = ""; my $Reply = "The form was sent."; my $Required = ""; my $WrapMargin = ""; my $Environment = ""; my $Csv = ""; my $File = ""; my $Confirm = ""; my $Captcha = ""; my $SortKeys = 0; my $SortValues = 0; # default From: address used when mailing form anonymously my $Email = "Mailform Program "; # accept only these characters in email addresses (reject all others) my $MailSafeChars = '\w\s\-\.,@<>'; my $FileSafeChars = '\w\-\./_'; # process forms coming only from these domains my $Domains = "ucsc.edu|ucolick.org"; # format data my $CsvKeys = ''; my $CsvData = ''; my $FmtData = ''; # constants my $Debug = 0; # =1 for debug in logfile my $Log = 1; # =1 for logfile output my $LogFile = "/opt/app/apache/logs/scripts/$ProgName"."_log"; # messages my $Referer = $ENV{'HTTP_REFERER'} ? $ENV{'HTTP_REFERER'} : ""; my $RefererMsg = <Sorry, this server cannot process your form.

It can only process forms from the $Domains domains, and your form comes from $Referer.

Ask your webmaster to install mailform on your local server. EOF my $Sendmail = "/usr/lib/sendmail"; # path to sendmail my $SendmailMsg = <Cannot send mail.

Please try again later. If this problem persists, please contact the program administrator $ProgAdmin. EOF my $TryAgain = "Go back, and try again"; ##################################################################### # main program # print form if no data &printform if (! param('mailform-notify')); # check form &checkreferer; &checkform; # do captcha if requested if (param('mailform-captcha')) { &printcaptcha if (! param('recaptcha_response_field')); &checkcaptcha; } # save/mail data &savedata if ($File); &maildata; # redirect answer to URL or standard reply page if ($Reply =~ /^http:\/\//) { print redirect($Reply); } else { &message($Reply); } exit 0; ##################################################################### # printform sub printform { printlog("debug", "in sub printform") if ($Debug); print header; print < $Title

$H1

This is a very simple form to show you how to get started. Feel free to copy the code, save it, and modify it to fit your needs. For a description of all the mailform fields, and additional details, please check the mailform documentation.

E-mail where to send the form:
Save data in file:
Use CSV format:	(In a real form, these fields would be hidden fields)
Sample comment form
Enter your name:
Enter your email address:
Select topic:	Linux, MacOs, MS-Windows, Other
Enter comments:

EOF &print_footer; exit 0; } ##################################################################### # check referer field sub checkreferer { printlog("debug", "in sub checkreferer") if ($Debug); return if ($Referer =~ /\.($Domains)\//); &printlog($Referer, "error: cannot process referer"); &message($RefererMsg); } ##################################################################### # check form entries sub checkform { printlog("debug", "in sub checkform") if ($Debug); my $msg = ""; # check mandatory notify field $Notify = param('mailform-notify') if (param('mailform-notify')); $Notify = &untaint($Notify, $MailSafeChars); if (! $Notify or $Notify !~ /^.+@.+$/) { &printlog($Referer, "error: mailform-notify field is not valid"); $msg .= "Notify the form administrator that ". "the mailform-notify address in this form is not valid!
"; } # check optional mailform fields $BgColor = param('mailform-bgcolor') if (param('mailform-bgcolor')); $Title = param('mailform-title') if (param('mailform-title')); $H1 = param('mailform-h1') if (param('mailform-h1')); $Address = param('mailform-address') if (param('mailform-address')); $Reply = param('mailform-reply') if (param('mailform-reply')); $Environment = param('mailform-environment') if (param('mailform-environment')); $Required = param('mailform-required') if (param('mailform-required')); $WrapMargin = param('mailform-wrapmargin') if (param('mailform-wrapmargin')); $Csv = param('mailform-csv') if (param('mailform-csv')); $File = param('mailform-file') if (param('mailform-file')); $File = &untaint($File, $FileSafeChars); $Confirm = param('mailform-confirm') if (param('mailform-confirm')); $Captcha = param('mailform-captcha') if (param('mailform-captcha')); $SortKeys = param('mailform-sortkeys') if (param('mailform-sortkeys')); $SortValues = param('mailform-sortvalues') if (param('mailform-sortvalues')); # check required fields if ($Required) { foreach my $req (split(/[\s,]+/, $Required)) { my $field = param($req); if (! $field or $field eq "...") { $msg .= "You did not fill-in the $req field!
\n"; } } } # check email address - optional except if confirmation is requested my $email = ""; $email = param('E-mail') if (param('E-mail')); $email = param('Email') if (param('Email')); if ($email) { $email = &untaint($email, $MailSafeChars); if ($email =~ /^.+@.+$/) { $Email = $email; } else { $msg .= "Your e-mail address is not valid!
\n"; } } elsif ($Confirm) { $msg .= "Your e-mail address is required for confirmation!
\n"; } # format data if first time through if (param('mailform-fmtdata')) { $FmtData = param('mailform-fmtdata'); } else { $FmtData = &formatdata; } if ($msg) { &message("$msg". "

Press the Back button in your browser ". "to return to the form to correct it, and resubmit it."); } } ##################################################################### # print captcha sub printcaptcha { printlog("debug", "in sub printcaptcha") if ($Debug); # initialize captcha my $c = Captcha::reCAPTCHA->new; # print captcha form my $out = start_form(); $out .= hidden(-name=>'E-mail', -value=>$Email); $out .= hidden(-name=>'mailform-notify', -value=>$Notify); $out .= hidden(-name=>'mailform-title', -value=>$Title); $out .= hidden(-name=>'mailform-bgcolor', -value=>$BgColor); $out .= hidden(-name=>'mailform-h1', -value=>$H1); $out .= hidden(-name=>'mailform-address', -value=>$Address); $out .= hidden(-name=>'mailform-reply', -value=>$Reply); $out .= hidden(-name=>'mailform-wrapmargin', -value=>$WrapMargin); $out .= hidden(-name=>'mailform-environment', -value=>$Environment); $out .= hidden(-name=>'mailform-confirm', -value=>$Confirm); $out .= hidden(-name=>'mailform-fmtdata', -value=>$FmtData); $out .= $c->get_html( PUBLIC_KEY ); $out .= submit(-name=>'mailform-captcha', -value=>'Submit answer'); $out .= end_form(); &message($out); } ##################################################################### # check captcha sub checkcaptcha { printlog("debug", "in sub checkcaptcha") if ($Debug); # initialize captcha my $c = Captcha::reCAPTCHA->new; # check answer my $result = $c->check_answer( PRIVATE_KEY, $ENV{'REMOTE_ADDR'}, param('recaptcha_challenge_field'), param('recaptcha_response_field') ); if ( $result->{is_valid} ) { printlog($Referer, "status: captcha solved"); return; } else { printlog($Referer, "status: captcha failed"); &message("$TryAgain: $result->{error}"); } } ##################################################################### # format data sub formatdata { printlog("debug", "in sub formatdata") if ($Debug); my $data = ''; # get all keys with data my @keys = param(); @keys = sort(@keys) if ($SortKeys); foreach my $key (@keys) { # ignore mailform, recaptcha, and submit fields next if ($key =~ /^mailform-/); next if ($key =~ /^recaptcha_/); next if ($key =~ /^submit$/); # format message my @values = param($key); @values = sort(@values) if ($SortValues); foreach my $value (sort @values) { # format mail data if ($WrapMargin and grep(/$key/, $WrapMargin)) { $data .= wrap("$key\t", "\t", "$value\n"); } else { $data .= "$key\t$value\n"; } # format CSV data if ($Csv) { my $fmtkey = &formatcsv($key); my $fmtdata = &formatcsv($value); $CsvKeys .= $CsvKeys ? ",$fmtkey" : $fmtkey; $CsvData .= $CsvData ? ",$fmtdata" : $fmtdata; } } } # send requested environmental variables if ($Environment) { foreach my $key (split(/[\s,]+/, $Environment)) { my $value = $ENV{$key}; $data .= "$key\t$value\n"; if ($Csv) { my $fmtkey = &formatcsv($key); my $fmtdata = &formatcsv($value); $CsvKeys .= $CsvKeys ? ",$fmtkey" : $fmtkey; $CsvData .= $CsvData ? ",$fmtdata" : $fmtdata; } } } if ($Csv) { $data .= "\n$CsvKeys\n"; $data .= "$CsvData\n"; } return $data; } ##################################################################### # save data sub savedata { printlog("debug", "in sub savedata") if ($Debug); # if first time use, create new file with keys unless (-e $File) { if (open(FILE, ">$File")) { print FILE "$CsvKeys\n" if ($Csv); close FILE; } else { &printlog($Referer, "error: cannot create file $File"); $FmtData .= "\n*** Cannot create file $File ***\n"; } } # save data (append) in file if (open(FILE, ">>$File")) { if ($Csv) { print FILE "$CsvData\n"; } else { print FILE "$FmtData\n"; } printlog($Referer, "status: data saved in file $File"); close FILE; } else { &printlog($Referer, "error: cannot append data to file $File"); $FmtData .= "\n*** Cannot append to file $File ***\n"; } } ##################################################################### # mail data sub maildata { printlog("debug", "in sub maildata") if ($Debug); # send mail my $sendmail = &untaint($Sendmail, '\w/'); if (open (MAIL, "|$sendmail -oi -t")) { print MAIL "From: $Email\n". "Subject: (WWW) $Title\n". "To: $Notify\n"; print MAIL "Cc: $Email\n" if ($Confirm); print MAIL "\n"; print MAIL $FmtData; close MAIL; } else { &printlog($Referer, "error: cannot open sendmail $sendmail"); &message($SendmailMsg); } # log if ($Log) { my $remotehost = $ENV{'REMOTE_HOST'} ? $ENV{'REMOTE_HOST'} : '-'; my $remoteip = $ENV{'REMOTE_ADDR'} ? $ENV{'REMOTE_ADDR'} : '-'; &printlog($Referer, "status: $remotehost $remoteip from $Email to $Notify"); } } ##################################################################### # format csv value # remove returns and newlines, escape quotes sub formatcsv { printlog("debug", "in sub formatcsv") if ($Debug); my ($value) = @_; $value =~ s/[\n\r]/ /g; $value =~ s/\"/\\"/g; $value = "\"$value\""; return $value; } ##################################################################### # message page sub message { printlog("debug", "in sub message") if ($Debug); my ($msg) = @_; print header, start_html( "-title"=>$Title, -bgcolor=>$BgColor ), h1($H1), $msg; &print_footer; exit; } ################################################################### # untaint variable sub untaint { printlog("debug", "in sub untaint") if ($Debug); my ($var, $safe) = @_; # remove unsafe characters $var =~ s/[^$safe]//g; return "" if (! $var); # untaint variable with $1 construct unless ($var =~ m/^([$safe]+)$/) { # this should never happen, since we've just removed all bad characters &printlog($Referer, "error: tainted variable $var"); &message( "Cannot send mail.". "

Notify form administrator that some variables are tainted." ); } return $1; } ################################################################### # print web page footer. # # 30 Sep 2000 - Jacques Delsemme # # Arguments # none # # Global variables # $ProgName name of program # $ProgVersion version number of program # $ProgInfoUrl URL with information about the program # # Returns # none # # External functions # none # # Modules # CGI sub print_footer { my $date = localtime(time); print <

Created by $ProgName $ProgVersion on $date.

EOF print end_html; } ##################################################################### # printlog: print dated entry in log file. # # 16 Oct 2002 - Jacques Delsemme # # Arguments # $short short description # $long longer comments # # Global variables # $LogFile name of log file # $ProgName name of program # # Returns # none # # External functions # &isodate # # Modules # none sub printlog { my ($short, $long) = @_; # date my ($sec, $min, $hour, $mday, $mon, $year, undef, undef, undef) = localtime(time); my $date = &isodate($year + 1900, $mon + 1, $mday, $hour, $min, $sec); $short = "$ProgName $short"; $short =~ s/\s+/_/g; my $logline = "$date $short $long\n"; unless (open(LOG, ">>$LogFile")) { my $date = localtime(time); print STDERR "[$date] error in __FILE__ at line __LINE__: ". "cannot open log file: $LogFile\n"; print STDERR $logline; return; } flock(LOG, 2); seek(LOG, 0, 2); print LOG $logline; flock(LOG, 8); close(LOG); } ######################################################################## # standardize date in ISO format # use current year to convert 2 digit years into 4 digit year # # 30 Sep 2000 - Jacques Delsemme # # Arguments # $year # $month # $day # $hour # $min # $sec # # Returns # "YYYY-MM-DD HH:MM:SS" ISO formatted date and time # "" if $year or $month or $day are incorrect # # External functions # none # # Modules # none sub isodate { my ($year, $month, $day, $hour, $min, $sec) = @_; # check for reasonable values $year = "" if ($year < 1); $month = "" if ($month < 1 or $month > 12); $day = "" if ($day < 1 or $day > 31); return "" if (! $year or ! $month or ! $day); # make ad hoc assumptions for 2 digit years based on current year # hopefully this never happens, since everyone uses 4 digit years if ($year < 100) { my $currentyear = 0; (undef, undef, undef, undef, undef, $currentyear, undef, undef, undef) = localtime(time); $currentyear += 1900; if ($currentyear < 2000) { $year += 1900; } else { $year += 2000; } } # add leading zeroes $month = "0$month" if ($month < 10); $day = "0$day" if ($day < 10); $hour = "0$hour" if ($hour < 10); $min = "0$min" if ($min < 10); $sec = "0$sec" if ($sec < 10); return "$year-$month-$day $hour:$min:$sec"; }

$H1

Sample comment form