Приглашаем посетить
form_processor
#!/usr/local/bin/perl
# Name: form_processor.cgi
#
# Version: 4.01
#
# Last Modified: 02-04-97
#
# Copyright Information: This application was written by Selena Sol
# (selena@eff.org, http://www.eff.org/~erict) and Gunther Birznieks
# (birzniek@hlsun.redcross.org) having been inspired by
# countless other Perl authors. Feel free to copy, cite, reference,
# sample, borrow, resell or plagiarize the contents. However, if you
# don't mind, please let me know where it goes so that I can at least
# watch and take part in the development of the memes. Information wants
# to be free, support public domain freware. Donations are appreciated
# and will be spent on further upgrades and other public domain scripts.
#######################################################################
# Flush the Perl Buffer. #
#######################################################################
# The script begins by telling the Perl interpreter that
# it should continuously flush its buffer so that text
# from this script is sent directly to the Web Browser.
# We do this to streamline debugging and make sure that
# the script operates with the flow we want it to.
$| = 1;
#######################################################################
# Read and Parse Form Data #
#######################################################################
# Next, the ReadParse subroutine in cgi-lib.pl is used to
# read the incoming form data. However, the subroutine is
# sent "form_data" as a parameter so that the associative
# array of form keys/values comes back with a descriptinve
# name rather than just %in.
&require_supporting_libraries (__FILE__, __LINE__,
"./Library/cgi-lib.pl");
&ReadParse(*form_data);
#######################################################################
# Load Supporting Files #
#######################################################################
# Once it has read the incoming form data, the script
# will be able to determine which setup file it should
# use to process the incoming form data.
#
# Perhaps a bit of explanation is in order.
#
# Every HTML form which utilizes this application as a
# backend MUST include a "hidden" form variable called
# "setup_file" using the following syntax somewhere
# between the <FORM> and </FORM> tags:
#
# <INPUT TYPE = "hidden" NAME = "setup_file"
# VALUE = "[NAME OF SETUP FILE]">
#
# For example, the following code would define a setup
# file called download.setup:
#
# <INPUT TYPE = "hidden" NAME = "setup_file"
# VALUE = "download.setup">
#
# This variable will provide the name of the file which
# this script will use to define all of the customizable
# aspects of its operation. For example, the setup file
# defines who the script should E-mail form responses to
# and what the script should send to the Web Browser as a
# response when a user submits some information.
#
# The reason for this is that this one script can handle
# an infinite amount of unique forms.
#
# Each form has a corresponding setup file which defines
# how the script performs. The logic (and programming)
# remains the same for all forms. All that changes are
# the variables and subroutines in the setup files. This
# makes it very easy for you to quickly generate diverse
# forms with the one backend.
#
# So the script first takes the value of "setup_file"
# coming in from the form (which cgi-lib.pl has already
# parsed into the %form_data associative array) and
# assigns it to the variable $setup_file.
#
# Then it uses the subroutine
# require_supporting_libraries documented later in this
# script to actually load the setup file and all of itsd
# configuration options.
#
# Once the setup file has been loaded, the script also
# uses the require_supporting_libraries subroutine to
# load the mail library which we will use to send email to
# the form administrator.
$setup_file = $form_data{'setup_file'};
&require_supporting_libraries (__FILE__, __LINE__,
"./Setup_/files/010/$setup_file");
&require_supporting_libraries (__FILE__, __LINE__,
"$location_of_mail_lib");
#######################################################################
# Display Verification Screen #
#######################################################################
# Next the script checks to see if the admin has requested
# that it give the user a data confirmation screen so that
# they can make one final review of what they entered into
# the form fields. This routine takes advantage of two
# administratively defined variables: $should_user_verify
# which is defined in the setup file as either yes
# or no and the HTML form submit tag "verified" which
# looks something like:
#
# <INPUT TYPE = "submit" NAME = "verified"
# VALUE = "Correct!">
#
# If the button has been depressed (thus, the value is
# not equal (ne) to nothing ("")), then the script knows
# that it should see if the admin has set
# $should_user_verify equal to yes. If both are true, it
# simply displays the confirmation screen which is
# discussed in the setup file. Thus, you may not change
# the NAME parameter of the submit tag, only the VALUE.
if ($form_data{'verified'} eq "" && $should_user_verify eq "yes")
{
&display_verification_screen;
exit;
}
#######################################################################
# Check Required Fields #
#######################################################################
# Now that the script has loaded all of the supporting
# libraries it is time to start processing the incoming
# form data.
#
# The first thing that the script does is to make sure
# that the user has filled in data for every field
# that the administrator has defined as "required". The
# list of required fields are defined in the setup file
# array @required_variables for each separate form to be
# processed.
#
# The script simply goes through each of the fields and
# checks to see if it has a value coming in as form data
# (as stored in the form_data associative aray by
# cgi-lib.pl). If the field was left blank, the script
# accesses the subroutine required_fields_error_message in
# the setup file which sends the user a note regarding the
# error and then exits.
foreach $variable (@required_variables)
{
if ($form_data{$variable} eq "")
{
&required_fields_error_message;
exit;
}
}
#######################################################################
# Email the Results to the Admin #
#######################################################################
# If, on the other hand, the user filled in all the
# fields, the script checks to see if the setup file
# instructs it to mail the customer-submitted form data to
# the form administrator. If the setup variable
# $should_i_mail has been set equal to "yes", the script
# will prepare and mail the results of the form to the
# email address $email_to also defined in the setup file.
if ($should_i_mail eq "yes")
{
# If the script has been instructed to send the form data
# to a form administrator, it begins building the body of
# the email message that it will send.
#
# The body of the email will be temporarily stored
# in a working variable called $email_body.
#
# First, the script notes the time and date of the
# form submission using the get_date subroutine documented
# later in this script.
#
# Notice the use of the ".=" operator which tells the
# script to "append" the new information to the end of the
# existing variable rather than overwrite it. Thus
# $email_body just keeps getting longer and longer as new
# info is tagged to the end of the old.
#
# Notice also that we will use the environment variable
# HTTP_REFERER to send the administrator the url of the
# form from which they are receiving a response.
$current_date = &get_date;
$email_body = "On $current_date, the following data was submitted from $ENV{'HTTP_REFERER'}";
$email_body .="\n\n";
# Then, for every form variable, the script adds the
# variable names and their values to the email body.
# @form_variables and %form_variable_name_map are both
# defined in the setup file. The order in which the
# variables appear on the email will depend on the order
# in which they are placed in @form_variables. Also, we
# will use the &format_text_field to format the email so
# that it will contain two columns with the second column
# left justified to 25 spaces.
foreach $variable (@form_variables)
{
$form_data{$variable} =~ s/"/"/g;
$form_data{$variable} =~ s/</\</g;
$form_data{$variable} =~ s/>/\>/g;
$form_data{$variable} =~ s/\<P\>/\n/g;
$email_body .= &format_text_field($form_variable_name_map{$variable});
$email_body .= "$form_data{$variable}\n";
}
# Next, we will check for the special variable
# "client_email". This variable is used so that mail sent
# to the store administrator can be sent from the actual
# user instead of from our default email address. This
# makes it easier to reply directly to users if reply
# is appropriate. If you have a form field in your HTML
# such as:
#
# <INPUT TYPE = "text" NAME = "client_email">
#
# the script will know to send mail to the admin as if it
# were coming from the email that the user inputs.
#
# If this special input field is not defined in the HTML,
# the script will use the value of $email_of_sender
# defined in the setup file.
if ($form_data{'client_email'} ne "")
{
$email_of_sender = "$form_data{'client_email'}";
}
# Next, the script checks to see if the admin has
# configured it to encrypt the mail. If the admin has
# defined $should_i_use_pgp to be yes in the setup file,
# the script will load the pgp library and encrypt the
# email body using the &make_pgp_file library.
if ($should_i_use_pgp eq "yes")
{
&require_supporting_libraries(__FILE__, __LINE__,
"$pgp_lib_path");
$email_body = &make_pgp_file($email_body,
"$pgp_temp_file_path/$$.pgp");
$email_body = "\n" . $email_body . "\n";
}
if ($form_data{'mailto'} ne "")
{
$email_to = $form_data{'mailto'};
}
# Finally, the script uses the send_mail routine in
# mail-lib.pl to send the data. The send_mail routine
# takes 6 parameters, all of which have already been
# defined and explained.
&send_mail("$email_of_sender","$email_to", "$email_subject", "$email_body");
} # End of if ($should_i_mail eq "yes")
#######################################################################
# Append a Database #
#######################################################################
# Next, the4 script determines if it has been instructed
# in the setup file to append the user-submitteed data to
# a database file.
#
# If the $should_I_append_a_database variable has been set
# to yes, the script appends to the database specified by
# $location_of_database using the database delimiter
# $database_delimiter which are both defined in the setup
# file.
if ($should_I_append_a_database eq "yes")
{
# Before appending to the database, the script checks to
# make sure that the database file is actually writable by
# it.
#
# If the file is indeed writable, the script creates a new
# database row made up of field values delimited by the
# delimter specified in the setup file.
#
# For example, if...
#
# @form_variables = ("fname", "lname", "email");
#
# and
#
# $database_delimiter = ":"
#
# then $database_row might look something like:
#
# Selena:Sol:selena@eff.org:
#
# Notice that because of the quirks of the foreach loop,
# we will end each database row with a final database
# delimiter. Because we do not want this final delimiter,
# the script utilizes the chop operator to remove it.
#
# Finally, notice that we will modify client submitted
# data if it includes the newline character. Since we are
# using the newline character to delineate database rows,
# we do not want the customer to have the ability to embed
# those characters in their data,. Thus, we will use
# the regular expression operator to change all occurances
# of newlines (\n) with the tag "~nl~". When we manage
# the database later, we need only do a find and
# replace on ~nl~.
if (-w $location_of_database)
{
foreach $variable (@form_variables)
{
$form_data{$variable} =~ s/\n/~nl~/g;
$database_row .= "$form_data{$variable}$database_delimiter";
} # End of foreach $variable (@form_variables)
chop $database_row;
# Next, the script appends the newly created database to
# the existing database. However, before actually
# modifying the database file, the script makes sure to
# use the lockfile routines discussed later in this script
# to assure that only one instance of the script can
# modify the file at one time. Afterall, it would not do
# for two instances of the script to modify the file at
# one time. At best, one of the forms would not be
# processed correctly. At worst, the data file might
# become corrupt. The lockfile routines prevent more than
# one instance of the script from accessing the file at
# one time.
&get_file_lock ("$location_of_database.lock");
# Once the lock file has been created, the script opens up
# the datafile for appending using the (>>) operator.
# However, if it has a problem opening the database file,
# it sends a useful debugging message to the Web Browser
# using the subroutine &file_open_error discussed later in
# this script.
#
# Once the database is opened, the script appends the new
# database row to the end of the file and closes the file
# again, removing the lockfile as well.
open (DATABASE, ">>$location_of_database") ||
&file_open_error("$location_of_database", "Append a Database",
_FILE__, __LINE__);
print DATABASE "$database_row\n";
close (DATABASE);
&release_file_lock ("$location_of_database.lock");
} # End of if (-w $location_of_database)
# If the database file was not writable, the script
# sends an error message back to the user.
else
{
&cannot_find_database;
exit;
}
} # End of if ($should_I_append_a_database eq "yes")
#######################################################################
# Respond to the Client #
#######################################################################
# Finally, the script sends a response to the client.
# There are two types of responses possible. Firstly, the
# client should receive and HTML thank you response. This
# is done using several subroutines defined in the setup
# file so that you can easily customize this HTML code.
&html_reply_header;
&html_reply_body;
&html_reply_footer;
# The second type of response is an email response.
# Perhaps you want to send the user a separate email
# notification letting them know that their info was sent
# in. In this case, provided that you had the
# client_email filed, we will simply create an email
# message just as we did for the administartor and mail
# it.
if ($should_i_send_user_email eq "yes")
{
if ($form_data{'client_email'} ne "")
{
$email_body = "Thank you very much for taking the time to fill
out our survey. As a reminder, you submitted the following data at
$ENV{'HTTP_REFERER'} on: ";
$email_body .= &get_date;
$email_body .="\n\n";
foreach $variable (@form_variables)
{
$form_data{$variable} =~ s/"/"/g;
$form_data{$variable} =~ s/</\</g;
$form_data{$variable} =~ s/>/\>/g;
$form_data{$variable} =~ s/\<P\>/\n/g;
$form_data{$variable} =~ s/~nl~/\n/g;
$email_body .= &format_text_field($form_variable_name_map{$variable});
$email_body .= "$form_data{$variable}\n";
}
&send_mail("$email_of_sender","$form_data{'client_email'}",
"$email_subject", "$email_body");
}
}
exit;
#################################################################
# get_date Subroutine #
#################################################################
# get_date is used to get the current date and time and
# format it into a readable form. The subroutine takes no
# arguments and is called with the following syntax:
#
# $date = &get_date;
#
# It will return the value of the current date, so you
# must assign it to a variable in the calling routine if
# you are going to use the value.
sub get_date
{
# The subroutine begins by defining some local working
# variables
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,$date);
local (@days, @months);
@days = ('Sunday','Monday','Tuesday','Wednesday','Thursday',
'Friday','Saturday');
@months = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
# Next, it uses the localtime command to get the current
# time, from the value returned by the time
# command, splitting it into variables.
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
# Then the script formats the variables and assign them to
# the final $date variable. Note that $current_century
# is defined in web_store.setup. Since the 20th centruy
# is really 1900-1999, we'll need to subtract 1 from this
# value in order to format the year correctly.
if ($hour < 10)
{
$hour = "0$hour";
}
if ($min < 10)
{
$min = "0$min";
}
if ($sec < 10)
{ $sec = "0$sec";
}
$year = ($current_century-1) . "$year";
$date = "$days[$wday], $months[$mon] $mday, $year at $hour\:$min\:$sec";
return $date;
}
#######################################################################
# Require Supporting Libraries. #
#######################################################################
# require_supporting_libraries is used to read in some of
# the supporting files that this script will take
# advantage of.
#
# require_supporting_libraries takes a list of arguments
# beginning with the current filename, the current line
# number and continuing with the list of files which must
# be required using the following syntax:
#
# &require_supporting_libraries (__FILE__, __LINE__,
# "file1", "file2",
# "file3"...);
#
# Note: __FILE__ and __LINE__ are special Perl variables
# which contain the current filename and line number
# respectively. We'll continually use these two variables
# throughout the rest of this script in order to generate
# useful error messages.
sub require_supporting_libraries
{
# The incoming file and line arguments are split into
# the local variables $file and $line while the file list
# is assigned to the local list array @require_files.
#
# $require_file which will just be a temporary holder
# variable for our foreach processing is also defined as a
# local variable.
local ($file, $line, @require_files) = @_;
local ($require_file);
# Next, the script checks to see if every file in the
# @require_files list array exists (-e) and is readable by
# it (-r). If so, the script goes ahead and requires it.
foreach $require_file (@require_files)
{
if (-e "$require_file" && -r "$require_file")
{
require "$require_file";
}
# If not, the scripts sends back an error message that
# will help the admin isolate the problem with the script.
else
{
print "Content-type: text/html\n\n";
print "I am sorry but I was unable to require $require_file at line
$line in $file. Would you please make sure that you have the
path correct and that the permissions are set so that I have
read access? Thank you.";
exit;
}
} # End of foreach $require_file (@require_files)
} # End of sub require_supporting_libraries
#######################################################################
# get_file_lock #
#######################################################################
# get_file_lock is a subroutine used to create a lockfile.
# Lockfiles are used to make sure that no more than one
# instance of the script can modify a file at one time. A
# lock file is vital to the integrity of your data.
# Imagine what would happen if two or three people
# were using the same script to modify a shared file (like
# the error log) and each accessed the file at the same
# time. At best, the data entered by some of the users
# would be lost. Worse, the conflicting demands could
# possibly result in the corruption of the file.
#
# Thus, it is crucial to provide a way to monitor and
# control access to the file. This is the goal of the
# lock file routines. When an instance of this script
# tries to access a shared file, it must first check for
# the existence of a lock file by using the file lock
# checks in get_file_lock.
#
# If get_file_lock determines that there is an existing
# lock file, it instructs the instance that called it to
# wait until the lock file disappears. The script then
# waits and checks back after some time interval. If the
# lock file still remains, it continues to wait until some
# point at which the admin has given it permissios to just
# overwrite the file because some other error must have
# occurred.
#
# If, on the other hand, the lock file has dissappeared,
# the script asks get_file_lock to create a new lock file
# and then goes ahead and edits the file.
#
# The subroutine takes one argumnet, the name to use for
# the lock file and is called with the following syntax:
#
# &get_file_lock("file.name");
sub get_file_lock
{
local ($lock_file) = @_;
local ($endtime);
$endtime = 20;
$endtime = time + $endtime;
# We set endtime to wait 20 seconds. If the lockfile has
# not been removed by then, there must be some other
# problem with the file system. Perhaps an instance of
# the script crashed and never could delete the lock file.
while (-e $lock_file && time < $endtime)
{
sleep(1);
}
open(LOCK_FILE, ">$lock_file") || &file_open_error ("$lock_file",
"Lock File Routine",
__FILE__, __LINE__);
# Note: If flock is available on your system, feel free to
# use it. flock is an even safer method of locking your
# file because it locks it at the system level. The above
# routine is "pretty good" and it will server for most
# systems. But if youare lucky enough to have a server
# with flock routines built in, go ahead and uncomment
# the next line and comment the one above.
# flock(LOCK_FILE, 2); # 2 exclusively locks the file
}
#######################################################################
# release_file_lock #
#######################################################################
# release_file_lock is the partner of get_file_lock. When
# an instance of this script is done using the file it
# needs to manipulate, it calls release_file_lock to
# delete the lock file that it put in place so that other
# instances of the script can get to the shared file. It
# takes one argument, the name of the lock file, and is
# called with the following syntax:
#
# &release_file_lock("file.name");
sub release_file_lock
{
local ($lock_file) = @_;
# flock(LOCK_FILE, 8); # 8 unlocks the file
# As we mentioned in the discussion of get_file_lock,
# flock is a superior file locking system. If your system
# has it, go ahead and use it instead of the hand rolled
# version here. Uncomment the above line and comment the
# two that follow.
close(LOCK_FILE);
unlink($lock_file);
}
#######################################################################
# file_open_error Subroutine #
#######################################################################
# If there is a problem opening a file or a directory, it
# is useful for the script to output some information
# pertaining to what problem has occurred. This
# subroutine is used to generate those error messages.
#
# file_open_error takes four arguments: the file or
# directory which failed, the section in the code in which
# the call was made, the current file name and
# line number, and is called with the following syntax:
#
# &file_open_error("file.name", "ROUTINE", __FILE__,
# __LINE__);
sub file_open_error
{
# The subroutine simply uses the update_error_log
# subroutine discussed later to modify the error log and
# then uses CgiDie in cgi-lib.pl to gracefully exit the
# application with a useful debugging error message sent
# to the browser window.
local ($bad_file, $script_section, $this_file, $line_number) = @_;
print "Content-type: text/html\n\n";
&CgiDie ("I am sorry, but I was not able to access $bad_file in the
$script_section routine of $this_file at line number $line_number.
Would you please make sure the path is correctly defined in
web_store.setup and that the permissions are correct.")
}
#######################################################################
# format_text_field Subroutine #
#######################################################################
sub format_text_field
{
local($value) = @_;
#
# Very simple. We return the value in
# $value plus a string of 25 spaces which
# has been truncated by the length of
# the $value string.
#
# This results in a left justified
# field of width = 25.
#
return($value . substr((" " x 25), length($value)));
} # End of format_text_field
