#!/usr/local/bin/perl #the perl path may need to be set if your web host is running Unix require 5.0; #the path to the sendmail program will need to be set on Un*x systems $mail_program = "/usr/lib/sendmail -t"; #on NT the name of the smtp server must be set $smtp_server = "smtp.surething.com"; use Env; # turn off output buffering for AnaServe - effect unknown Patrick 10/21/98 $| = 1; ################################################################################ # # MVForms.cgi - A form response script for use with WebExpress. # Copyright 1997 MicroVision Development, Inc. # # Version # 3.04 May 19 1999 - Deleted some html
tags from the email body. # 3.03 May 14 1999 - Changed get_date to make it handle y2k. # 3.02 Dec 08 1998 - Moved form type check for "jump" ahead of .intro # check as this was causing the script to fail for # redirection forms. # 3.01 Oct 22 1998 - Unix sendmail version had inverted to and from # addresses. # - Removed all extraneous whitespace and reformated with # spaces rather than tabs. # - Modified .thanks_url processing to allow it to be set # to either a complete URL, or a file name relative to # the directory containing the form page. # 3.00 Sep 29 1998 - Rewrote to fix "internal server error" problem on # some unix servers. # # Special thanks to Selena Sol and Sanford Morton # for examples and explanations. Thanks to William Mussatto # for posting the sendmail.pl script on the Win32-Perl-Web list, # and to C. Mallwitz for writing it. # # Permission is granted to use, modify and distribute # this script, so long as this copyright section is # included intact. # # # This script gives the option of using Un*x sendmail on systems that # have it available. To use the perl sendmail that is built in # access to an SMTP server is required. # ################################################################################ # # Program Begins Here # # # parse the form data # &ReadParse; # # set the current date # $current_date = &get_date; # # if it is a redirect menu, jump # if ( $in{'.form_type'} eq "jump" ) { &jump_url; } # # Otherwise, send an email response # Check required fields were filled by the user # if ($in{'.required'}) { &Compulsory; } if ( ! $in{'.intro'} ) { &usage("the intro for the response (.intro)"); } # # Check for required hidden fields # if ( !$in{'.email_dest'} ) { &usage("the email desitination field (.email_dest)"); } if ( ! $in{'.intro'} ) { &usage("the intro for the response (.intro)"); } if ( ! $in{'.subject'} ) { &usage("the subject for the response (.subject)"); } # # send the response # &send_response; # # Redirect to acknowledgement page # &send_acknowledgement; exit; ###################################### # Parse the cgi form data. # Adapted from cgi-lib.pl by S.E.Brenner@bioc.cam.ac.uk # Copyright 1994 Steven E. Brenner # sub ReadParse { local (*in) = @_ if @_; if ( $ENV{'REQUEST_METHOD'} eq "GET" ) { # replaced his MethGet function ## don't accept GET, to make it a little harder to spoof the script print "Content-type: text/html\n\n"; print "Sorry, this script only accepts METHOD=POST. "; print "Use that inside your <FORM ...> tag"; exit; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN,$in,$ENV{'CONTENT_LENGTH'}); } else { # Added for command line debugging # Supply name/value form data as a command line argument # Format: name1=value1\&name2=value2\&... (need to escape & for shell) # Find the first argument that's not a switch (-) $in = ( grep( !/^-/, @ARGV )) [0]; $in =~ s/\\&/&/g; } @in = split(/&/,$in); foreach $i (0 .. $#in) { # Convert plus's to spaces $in[$i] =~ s/\+/ /g; # Split into key and value. ($key, $val) = split(/=/,$in[$i],2); # splits on the first =. # Convert %XX from hex numbers to alphanumeric $key =~ s/%(..)/pack("c",hex($1))/ge; $val =~ s/%(..)/pack("c",hex($1))/ge; # Associate key and value # \0 is the multiple separator $in{$key} .= "\0" if (defined($in{$key})); $in{$key} .= $val; } return length($in); } ############################ # # sub Compulsory # # Check that the fields in the form that are required to be # filled are filled. Compulsory fields are listed in the # .required hidden field, semi-colon separated. sub Compulsory { #split them out of the list in the value field @required = split (/;/, $in{'.required'}); #check that each required field name keys to data in the input hash foreach $elem (@required) { foreach $key (keys %in) { next if ($key ne $elem); #the required field and the key match, so check that there is data if (!$in{$elem}) { $printkey = $elem; $printkey =~ s/^..//; $error .= ("
  • The $printkey field must be filled.

    \n"); } } } if ($error) { #kick them to a page telling them what was blank #use back button to get back to the form. #******************** CUSTOMIZABLE TEXT ******************** $error_page = "Content-type: text/html\n\n"; $error_page .= "Form Entries Incomplete or Invalid\n

    Make your own free website on Tripod.com

    \n"; $error_page .= "


    \n

    Form Entries Incomplete or Invalid

    \n"; $error_page .= "One or more problems exist with the data you have entered.Please use the Back button on your web browser to problems.


    "; print $error_page; exit; } } ###################################### # general usage routine # sub usage { my ($usage_error) = @_; $usage_body = "Content-type: text/html\n\n"; $usage_body .= "

    Form Processing Error

    "; $usage_body .= " Form Processing Error "; $usage_body .= "You have forgotten to include $usage_error in your form. "; $usage_body .= "Please correct the problem in your form, and try again. "; $usage_body .= "

    The following fields were included in your form:

      "; foreach (keys %in) { $usage_body .= "
    1. $_: $in{$_}\n"; } $usage_body .= "
    Press the BACK button to return to the submitting form."; print $usage_body; exit; } ###################################### sub get_date { @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); @months = ('January','February','March','April','May','June','July','August','September','October','November','December'); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($hour < 10) { $hour = "0$hour"; } if ($min < 10) { $min = "0$min"; } if ($sec < 10) { $sec = "0$sec"; } $year = 1900 + $year; $date = "$days[$wday], $months[$mon] $mday, $year at $hour\:$min\:$sec"; return $date; } ###################################### # jump to URL destination # sub jump_url { # look for destination field foreach (keys %in) { next if /^\./; # skip hidden form data in mail message if ( $_ eq "Destination" ) { $dest = $in{$_}; } } # could check destination here print "Location: $dest\n\n"; exit; } ###################################### # send repsonse # sub send_response { $email_body = $in{'.intro'} ? "$in{'.intro'}\n\n" : "The following data has been submitted:\n\n"; # added functionality to allow users to specify fields and order using the # .remove_indexing key and the .response_order hidden field. if (!$in{'.remove_indexing'} and $in{'.response_order'}) { # split them out of the list in the value field @resp_ordr = split (/;/, $in{'.response_order'}); foreach $ro_elem (@resp_ordr) { # format the text and add it to the mail message $form_name = &format_text_field("$ro_elem:"); $item = "$form_name $in{$ro_elem}"; # if multiple values, indent them on new lines $item =~ s/\0/"\n\t".(" "x(2+length($_)))/ge; $email_body .= "\t $item \n"; # grab the mail address and save it if ($ro_elem =~ /.*(email).*|.*(e-mail).*/i) { $client_email = $in{$ro_elem}; } } } else { foreach (sort keys %in) { # skip fields beginning with a period (hidden fields) next if /^\./; # save client email for return address if ( $_ eq "zzClientEmail" ) { $client_email = $in{$_}; } # don't list the send and clear buttons if ( $_ eq "xxSend" ) { next; } if ( $_ eq "xxClear" ) { next; } $form_name = &format_text_field("$_:"); $item = "$form_name $in{$_}"; if ( $in{'.remove_indexing'} ) { $item =~ s/^..//; } # if multiple values, indent them on new lines $item =~ s/\0/"\n\t".(" "x(2+length($_)))/ge; $email_body .= "\t $item \n"; } $flag = "did case two
    \n"; } #******************** CUSTOMIZABLE TEXT ******************** $email_body .= "\nSubmitted on: $current_date\n"; $email_body .= "Form page: $ENV{HTTP_REFERER}\n"; $email_body .= "User address: $ENV{REMOTE_ADDR}\n"; $email_body .= "User host: $ENV{REMOTE_HOST}\n"; $in{'.email_dest'} =~ s/,.*//; # to and from addresses are flipped between the NT and Unix versions # here Patrick 10/21/98 if ($ENV{OS} eq "Windows_NT") { &sendmail($client_email,$client_email,$in{'.email_dest'},$smtp_server,$in{'.subject'},$email_body); } else { &send_mail ($client_email,$in{'.email_dest'},$in{'.subject'},$email_body); } } ##################################### sub format_text_field { my ($value) = @_; return($value . substr((" " x 25), length($value))); } #--------------------------------------------------------------------------- # sub sendmail() # Modified 10-20-1997 to not send blank fields. # # send/fake email around the world ... # # Version : 1.21 # Environment: Hip Perl Build 105 NT 3.51 Server SP4 # Environment: Hip Perl Build 110 NT 4.00 # # arguments: # # $from email address of sender # $reply email address for replying mails # $to email address of reciever # (multiple recievers can be given separated with space) # $smtp name of smtp server (name or IP) # $subject subject line # $message (multiline) message # # return codes: # # 1 success # -1 $smtphost unknown # -2 socket() failed # -3 connect() failed # -4 service not available # -5 unspecified communication error # -6 local user $to unknown on host $smtp # -7 transmission of message failed # -8 argument $to empty # # usage examples: # # print # sendmail("Alice ", # "alice\@company.com", # "joe\@agency.com charlie\@agency.com", # $smtp, $subject, $message ); # # or # # print # sendmail($from, $reply, $to, $smtp, $subject, $message ); # # (sub changes $_) # #------------------------------------------------------------1; use Socket; use IO::Handle; sub sendmail { ($from, $reply, $to, $smtp, $subject, $message) = @_; $fromaddr = $from; $replyaddr = $reply; $to =~ s/[ \t]+/, /g; # pack spaces and add comma $fromaddr =~ s/.*<([^\s]*?)>/$1/; # get from email address $replyaddr =~ s/.*<([^\s]*?)>/$1/; # get reply email address $replyaddr =~ s/^([^\s]+).*/$1/; # use first address $message =~ s/^\./\.\./gm; # handle . as first character $message =~ s/\r\n/\n/g; # handle line ending $message =~ s/\n/\r\n/g; $smtp =~ s/^\s+//g; # remove spaces around $smtp $smtp =~ s/\s+$//g; if (!$to) { return(-8); } $proto = (getprotobyname('tcp'))[2]; $port = (getservbyname('smtp', 'tcp'))[2]; $smtpaddr = ($smtp =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) ? pack('C4',$1,$2,$3,$4) : (gethostbyname($smtp))[4]; if (!defined($smtpaddr)) { return(-1); } if (!socket(S, AF_INET, SOCK_STREAM, $proto)) { return(-2); } if (!connect(S, pack('Sna4x8', AF_INET, $port, $smtpaddr))) { return(-3); } S->autoflush(1); $_ = ; if (/^[45]/) { close(S); return(-4); } print S "helo localhost\r\n"; $_ = ; if (/^[45]/) { close(S); return(-5); } print S "mail from: <$fromaddr>\r\n"; $_ = ; if (/^[45]/) { close(S); return(-5); } foreach (split(/, /, $to)) { print S "rcpt to: <$_>\r\n"; $_ = ; if (/^[45]/){ close(S); return(-6); } } print S "data\r\n"; $_ = ; if (/^[45]/) { close S; return(-5); } print S "To: $to\r\n"; print S "From: $from\r\n"; print S "Reply-to: $replyaddr\r\n" if $replyaddr; print S "X-Mailer: Perl Sendmail Version 1.21\r\n"; print S "Subject: $subject\r\n\r\n"; print S "$message"; print S "\r\n.\r\n"; $_ = ; if (/^[45]/) { close(S); return(-7); } print S "quit\r\n"; $_ = ; close(S); return(1); } ###################################### # send mail containing the form data # sub send_mail { my ($clnt_email, $email_dst, $subject, $message) = @_; # list assignment if ( !open(MAIL, "|$mail_program") ) { &print_error_page; exit; } print MAIL <<__END_OF_MAIL__; To: $email_dst From: $clnt_email Subject: $subject $message __END_OF_MAIL__ close (MAIL); } ###################################### # mail open error message # sub print_error_page { #******************** CUSTOMIZABLE TEXT ******************** $error_page = "Content-type: text/html\n\n"; $error_page .= " System Error "; $error_page .= "

    System Error

    "; $error_page .= "The system is not responding, and the form could not be processed. "; $error_page .= "Please try again later."; $error_page .= "

    Thank you for taking the time to fill out the form. "; $error_page .= "Sorry for the inconvenience!"; if ( $in{'.back_to_url'} ) { $error_page .= "

    Return to $in{'.back_to_url'}"; } print $error_page; } ###################################### # Send an acknowledgement # sub send_acknowledgement { # Get address of page that we came from and strip page name $ENV{'HTTP_REFERER'} =~ m[(.+/)]; $new_url = $1; if ( $in{'.thanks_url'} =~ /http:\/\//) { print "Location: $in{'.thanks_url'}\n\n"; } elsif ( $in{'.thanks_url'} ) { print "Location: $new_url$in{'.thanks_url'}\n\n"; } else { &send_thanks_page; } } ###################################### # generic acknowledgement page # sub send_thanks_page { #******************** CUSTOMIZABLE TEXT ******************** $thanks_page = "Content-type: text/html\n\n"; $thanks_page .= "Form Acknowledgement"; $thanks_page .= "

    Thank You

    "; $thanks_page .= "Your information has been submitted to "; $thanks_page .= "$in{'.email_dest'}.

    \n"; $thanks_page .= "Thank you for taking the time to fill out the form!
    \n"; #$thanks_page .= "Perl Version = $]
    \n"; if ( $in{'.back_to_url'} ) { $thanks_page .= "

    Return to $in{'.back_to_url'}"; } print $thanks_page; }