Приглашаем посетить
Feedback
#!/usr/local/bin/perl
############################################################################
# #
# Feedback Version 3.0 #
# Written by Matthew Wright mattw@worldwidemart.com #
# Created 6/5/96 Last Modified 3/24/97 #
# #
# Copyright 1997 Craig Patchett & Matthew Wright. All Rights Reserved. #
# This program is part of The CGI/Perl Cookbook from John Wiley & Sons. #
# License to use this program or install it on a server (in original or #
# modified form) is granted only to those who have purchased a copy of The #
# CGI/Perl Cookbook. (This notice must remain as part of the source code.) #
# #
############################################################################
############################################################################
# Define configuration constants #
############################################################################
# This URL, if filled in, will link to important information in the
# README HTML file, when Feedback generates an error.
$README = 'http://www.domain.com/feedback/README.html';
# $WEB_SERVER is the host name of your web server. If the name of your web
# server is host.xxx, set this to 'host.xxx'.
$WEB_SERVER = 'domain.com';
# $CONFIG_DIR is the path where config files can be stored.
$CONFIG_DIR = '/home/protected/feedback/';
# $SMTP server is the server name of your SMTP server.
$SMTP_SERVER = 'smtp.domain.com';
# $LOCK_DIR is the default directory where all lock files will be placed.
$LOCK_DIR = '/tmp/';
# $MAX_WAIT is the max seconds lock will wait before removing the lock file.
$MAX_WAIT = 5;
# This is the directory in which all of the required routines are stored.
# By default these are placed in the require directory.
$REQUIRE_DIR = 'require';
############################################################################
# Initialize other constants #
############################################################################
@DAYS = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday',
'Saturday');
@MONTHS = ('January', 'February', 'March', 'April', 'May', 'June', 'July',
'August', 'September', 'October', 'November', 'December');
############################################################################
# Get Required subroutines which need to be included. #
############################################################################
# Push the $REQUIRE_DIR onto the @INC array for include file directories.
if ($REQUIRE_DIR ne '') {
push(@INC, $REQUIRE_DIR);
}
# Require Necessary Routines for this script to run.
require 'parsform.pl';
require 'template.pl';
require 'locksubs.pl';
require 'chkemail.pl';
require 'sendmail.pl';
require 'formdate.pl';
############################################################################
# Parse the form contents and put configuration fields into %CONFIG and #
# other fields in %FORM. #
############################################################################
if (!(&parse_form)) {
&error($Error_Message);
}
############################################################################
# Check to see if a configuration file has been specified and is in a #
# valid directory. If so, require it. #
############################################################################
if ($FORM{'config_file'} !~ /^$CONFIG_DIR/) {
&error("Invalid Configuration File. Must appear in $CONFIG_DIR");
}
require "$FORM{'config_file'}" || &error('config_file');
############################################################################
# Get the date for templates to use and also configure the month archive #
# file in case they are archiving messages by month automatically. #
############################################################################
# Get the month and year from localtime and set the month archive filename.
($mon, $year) = (localtime)[4, 5];
$year += 1900;
$month = substr($MONTHS[$mon], 0, 3);
$month_archive_file = "$ARCHIVE_MONTH_DIR$month_$year.html";
# Put the date in the form fields so it can be used with templates.
$FORM{'date'} = &format_date(time, "<mh>:<0n>:<0s> <mon>/<0d>/<year>");
############################################################################
# Check the hostname and IP address to make sure that the visitor who is #
# posting hasn't been banned from doing so. #
############################################################################
if ($BANNED_HOSTS_FILE ne '') {
# Read in the banned hosts and banned IP address.
open(BANNED_HOSTS_FILE, $BANNED_HOSTS_FILE);
# For each entry remove any line breaks and split the banned host and IP
# fields.
while ($banned_host = <BANNED_HOSTS_FILE>) {
if ($banned_host =~ /\n$/) {
chop($banned_host);
}
@banned_host = split(/,/, $banned_host);
# If these are the same as the current person adding an entry to
# your Feedback, send them an error.
if ($ENV{'REMOTE_HOST'} eq $banned_host[0]
|| $ENV{'REMOTE_ADDR'} eq $banned_host[1]) {
&error('banned_host');
}
}
}
############################################################################
# This checks to make sure the user was not one of the last X number of #
# users to post to the Feedback as defined by the last log file. #
############################################################################
# If a Last log file is present, check the last entries to make sure this
# person did not just add to the Feedback.
if ($LAST_LOG_FILE ne '') {
# Check the last log for latest entries.
open(LAST_ENTRIES, $LAST_LOG_FILE)
|| &error('open->last_log_file', $LAST_LOG_FILE);
while ($last_entry = <LAST_ENTRIES>) {
if ($last_entry =~ /\n$/) {
chop($last_entry);
}
@last_entry = split(/,/, $last_entry);
# If the IP or domain equal the current IP or domain, give the
# user an error since they just recently added to the Feedback.
if ($ENV{'REMOTE_HOST'} eq $last_entry[0]
|| $ENV{'REMOTE_ADDR'} eq $last_entry[1]) {
&error('repeat_entry');
}
# Form a last_entries array for later use.
push(@last_entries, $last_entry);
}
}
############################################################################
# Require any form fields which may be listed in the @REQUIRED array. #
############################################################################
# Require any of the fields they wish to require.
if (@REQUIRED) {
# If this is not a valid e-mail address in the email form field, set
# it to null.
if (&email_check($FORM{'email'}) == 0 && $FORM{'email'}) {
$FORM{'email'} = "";
}
# If the url form field does not have a valid URL, set to null.
if ($FORM{'url'} !~ /(ht|f)tp(s?)\:\/\/(\w+)\.(\w+)/ && $FORM{'url'}) {
$FORM{'url'} = "";
}
# For any fields which are required, but missing from %FORM, add to
# @missing_required_fields array.
foreach $required (@REQUIRED) {
if (!($FORM{$required})) {
push(@missing_required_fields, $required);
}
}
# If the @missing_required_fields array exists, thrown an error.
if (@missing_required_fields) {
&error('missing_required_fields');
}
}
############################################################################
# Check for bad words in their post if a bad word list is supplied. #
############################################################################
if ($BAD_WORD_FILE ne '') {
# Open and read in the bad word file.
open(BAD_WORD_FILE, $BAD_WORD_FILE)
|| &error('open->bad_word_file', $BAD_WORD_FILE);
while ($bad_words = <BAD_WORD_FILE>) {
if ($bad_words =~ /\n$/) {
chop($bad_words);
}
push(@bad_words, $bad_words);
}
# For each of the bad words
foreach $bad_word (@bad_words) {
# If certain fields are specified to be checked for bad words,
# look only in there.
if (@BAD_WORD_FIELDS) {
foreach $bad_word_field (@BAD_WORD_FIELDS) {
if ($FORM{$bad_word_field} =~ /$bad_word/i) {
if ($BAD_WORD_ACTION eq 'reject') {
push(@bad_words_used, $bad_word);
}
else {
$FORM{$bad_word_field} =~ s/$bad_word//gi;
}
}
}
}
# Otherwise, check for bad words in the whole entry and all %FORM
# fields.
else {
foreach $key (sort keys %FORM) {
if ($FORM{$key} =~ /$bad_word/i) {
if ($BAD_WORD_ACTION eq 'reject') {
push(@bad_words_used, $bad_word);
}
else {
$FORM{$key} =~ s/$bad_word//gi;
}
}
}
}
}
# If the @bad_words_used array is present, throw an error.
if (@bad_words_used) {
&error('bad_words');
}
}
############################################################################
# If certain HTML tags are not allowed, check the entry for those and #
# respond accordingly. #
############################################################################
if (@LIMIT_HTML) {
# If @LIMIT_HTML = ('all');, then check all of the %FORM elements for
# and HTML tags.
if ($LIMIT_HTML[0] eq 'all') {
foreach $key (keys %FORM) {
$FORM{$key} =~ s/<([^>]|\n)*>//g;
}
}
# Otherwise, for each tag listed in @LIMIT_HTML check each form
# element form that tag.
else {
foreach $tag (@LIMIT_HTML) {
foreach $key (keys %FORM) {
$FORM{$key} =~ s/<(\/)?$tag([^>]|\n)*>//gi;
}
}
}
}
############################################################################
# The following section of code decides whether a preview HTML page should #
# be printed out, the entry should be written to the admin file, or if the #
# script should add the entry directly to the Feedback. #
############################################################################
# If they wish to preview their entry, print out the preview template.
if ($FORM{'preview'} eq 'YES' && $PREVIEW_TEMPLATE ne '') {
# Parse the preview template and print it to STDOUT.
print "Content-type: text/html\n\n";
if (!&parse_template($PREVIEW_TEMPLATE, *STDOUT)) {;
&error('open->preview_html_template', $PREVIEW_TEMPLATE);
}
exit;
}
# Otherwise, if they are using the Admin features of Feedback, log the
# entry to the admin file.
elsif ($USE_ADMIN eq 'YES' & $APPROVE_FILE ne '') {
# Assign a unique number to this entry.
&get_num_entry;
# Lock the approve file.
if (&lock($APPROVE_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open the admin file for appending.
open(ADMIN_FILE, ">>$APPROVE_FILE")
|| &error('write->approve_file', $APPROVE_FILE);
# Form a string containing all of the information in the %FORM array.
foreach $key (keys %FORM) {
$key =~ tr/&/--amp--/;
$key =~ tr/=/--eq--/;
$FORM{'key'} =~ tr/&/--amp--/;
$FORM{'key'} =~ tr/=/--eq--/;
if ($form_string) {
$form_string .= "\&$key\=$FORM{$key}";
}
else {
$form_string = "$key\=$FORM{$key}";
}
}
# Write the unique number, date, remote host, remore ip and form
# string to admin file.
print ADMIN_FILE "$Num_Entries\|\|$date\|\|$ENV{'REMOTE_HOST'}\|\|$ENV{'REMOTE_ADDR'}\|\|$form_string\n";
close(ADMIN_FILE);
&unlock($APPROVE_FILE, $LOCK_DIR);
# Increment the entry number.
&increment_num_entry;
}
# Otheriwse, write the entry to the Feedback if it was not a preview and
# they aren't using the Admin.
else {
# Get unique entry number.
&get_num_entry;
# Lock the Feedback file, so that in the time before we read and write
# the new information, it is not opened by another application for
# reading.
if (&lock($FEEDBACK_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open the Feedback and read it in. Get lock on the file at this time.
open(FEEDBACK, $FEEDBACK_FILE)
|| &error('open->Feedback_file', $FEEDBACK_FILE);
@Feedback_lines = <FEEDBACK>;
# Open Feedback for writing now that we have the lock.
open(FEEDBACK, ">$FEEDBACK_FILE")
|| &error('write->Feedback_file', $FEEDBACK_FILE);
# Cycle through all current Feedback lines.
foreach $Feedback_line (@Feedback_lines) {
# If the Feedback line has the <!--begin--> key, then print the
# new entry.
if ($Feedback_line =~ /<!--begin-->/) {
# Unless the entry order is from oldest to newest, put the
# begin line back above the current entry, so that other entries
# will be added to the top of the document.
if ($ENTRY_ORDER ne 'oldest->newest') {
print FEEDBACK "<!--begin-->\n";
}
print FEEDBACK "<!--Begin Entry: $Num_Entries\|\|$date\|\|$ENV{'REMOTE_HOST'}\|\|$ENV{'REMOTE_ADDR'}-->\n";
if (!&parse_template($FEEDBACK_TEMPLATE, *FEEDBACK)) {
&error('open->Feedback_template', $FEEDBACK_TEMPLATE);
}
print FEEDBACK "<!--End Entry: $Num_Entries-->\n";
# Otherwise, if they want newest entries on the bottom, write
# the <!--begin--> line below the newest entry.
if ($ENTRY_ORDER eq 'oldest->newest') {
print FEEDBACK "<!--begin-->\n";
}
}
# If the Feedback line doesn't equal <!--begin-->, just print
# the line to the Feedback, as there is no need to change it.
else {
print FEEDBACK $Feedback_line;
}
}
# Unlock the Feedback file now. We're done with it.
close(FEEDBACK);
&unlock($FEEDBACK_FILE, $LOCK_DIR);
# Increment the unique entry number.
&increment_num_entry;
}
############################################################################
# If there is a reply message template and the user's e-mail passes the #
# email_check, then send the reply message. #
############################################################################
if ($REPLY_TEMPLATE ne '' && &email_check($FORM{'email'})) {
# Determine the subject for the reply message.
if ($REPLY_SUBJECT eq '') {
$REPLY_SUBJECT = "Feedback Reply/Confirmation";
}
# Determine who this reply message should be from.
if ($REPLY_FROM eq '') {
$REPLY_FROM = "Feedback Admin";
}
# Send the reply message.
&send_email($REPLY_SUBJECT, $REPLY_FROM, $FORM{'email'}, '', '',
$REPLY_TEMPLATE, '', '');
}
# If there is an email template and the $emasil_to checks out as a calid
# e-mail address, send out the email.
if ($EMAIL_TEMPLATE ne '' && &email_check($EMAIL_TO)) {
# Determine who the email is from.
if ($EMAIL_FROM eq '') {
$EMAIL_FROM = $FORM{'email'};
}
# Send the email message to owner specifying that an entry has been
# added and using the email_template.
&send_email($EMAIL_SUBJECT, $EMAIL_FROM, $EMAIL_TO, '', '',
$EMAIL_TEMPLATE, '', '');
}
############################################################################
# If archiving by month is turned on, add the entry to the appropriate #
# month file. #
############################################################################
if ($ARCHIVE_TYPE eq 'by_month' && $USE_ADMIN ne 'YES') {
#Check to see if the archive file exists, create if not
if (!(-e $month_archive_file)) {
if (&lock($month_archive_file, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
open(MONTH_ARCHIVE, ">$month_archive_file")
|| &error('open->month_archive_file', $month_archive_file);
# Make a new month_archive_file
print MONTH_ARCHIVE "<html>\n";
print MONTH_ARCHIVE " <head>\n";
print MONTH_ARCHIVE " <title>Monthly Feedback Archive: $MONTHS[$mon] $year</title>\n";
print MONTH_ARCHIVE " </head>\n";
print MONTH_ARCHIVE " <body bgcolor=#FFFFFF text=#000000>\n";
print MONTH_ARCHIVE " <center><h1>Feedback Archive: $MONTHS[$mon] $year</h1></center>\n";
print MONTH_ARCHIVE " Below is an archive of the Feedback for $MONTHS[$mon] $year.<p><hr><p>\n";
print MONTH_ARCHIVE "<!--begin-->\n";
print MONTH_ARCHIVE " <p><hr><p>\n";
print MONTH_ARCHIVE " </body>\n";
print MONTH_ARCHIVE "</html>";
# Close and unlock the month_archive_file
close(MONTH_ARCHIVE);
&unlock($month_archive_file, $LOCK_DIR);
}
# If the month archive file exists, lock the month_archive_file, so
# that in the time between we read and write the new information, it
# is not opened by another application for reading.
if (&lock($month_archive_file, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open and read in the month_archive_file
open(MONTH_ARCHIVE, $month_archive_file)
|| &error('open->month_archive_file', $month_archive_file);
@month_archive_lines = <MONTH_ARCHIVE>;
# Open the month_archive_file for writing.
open(MONTH_ARCHIVE, ">$month_archive_file")
|| &error('write->month_archive_file', $month_archive_file);
# For each of the lines in the month_archive_file
foreach $month_archive_line (@month_archive_lines) {
# If the line is the begin marker, print the new entry.
if ($month_archive_line =~ /<!--begin-->/) {
if ($ENTRY_ORDER ne 'oldest->newest') {
print MONTH_ARCHIVE "<!--begin-->\n";
}
print MONTH_ARCHIVE "<!--Begin Entry: $Num_Entries\|\|$date\|\|$ENV{'REMOTE_HOST'}\|\|$ENV{'REMOTE_ADDR'}-->\n";
if (!&parse_template($FEEDBACK_TEMPLATE, *MONTH_ARCHIVE)) {
&error('open->Feedback_template', $FEEDBACK_TEMPLATE);
}
print MONTH_ARCHIVE "<!--End Entry: $Num_Entries-->\n";
if ($ENTRY_ORDER eq 'oldest->newest') {
print MONTH_ARCHIVE "<!--begin-->\n";
}
}
# Otherwise, just print the line to the file.
else {
print MONTH_ARCHIVE $month_archive_line;
}
}
# Unlock and close the month_archive_file
close(MONTH_ARCHIVE);
&unlock($month_archive_file, $LOCK_DIR);
}
############################################################################
# Otherwise, if it is archiving by number, check to see if the number #
# exceeds what is allowed, and if so archive entries by number. #
############################################################################
elsif ($ARCHIVE_TYPE eq 'by_num' && $MAX_ENTRIES && $ARCHIVE_BY_NUM_FILE
&& $USE_ADMIN ne 'YES') {
# Loop through the Feedback lines (retrieved earlier in the script) and
# add any entries to the @entries array
foreach $Feedback_line (@Feedback_lines) {
if ($Feedback_line =~ /<!--Begin Entry: (.*)\|\|(.*)\|\|(.*)\|\|(.*)-->/) {
push(@entries, $1);
}
}
# Get the number of entries.
$Num_Entries = @entries;
# If the number of entries exceeds the maximum allowed entries,
# remove each entry one by one.
if ($Num_Entries >= $MAX_ENTRIES) {
$diff = ($Num_Entries - $MAX_ENTRIES);
$diff++;
for ($i = 1;$i <= $diff;$i++) {
if ($ENTRY_ORDER eq 'oldest->newest') {
$remove_entry = shift(@entries);
}
else {
$remove_entry = pop(@entries);
}
# Lock the Feedback file.
if (&lock($FEEDBACK_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open the Feedback, read in the new Feedback_lines.
open(FEEDBACK, $FEEDBACK_FILE)
|| ('open->Feedback_file', $FEEDBACK_FILE);
@Feedback_lines = <FEEDBACK>;
close(FEEDBACK);
# Write to the Feedback, removing the remove_entry when we
# come to it.
open(FEEDBACK, ">$FEEDBACK_FILE")
|| &error('write->Feedback_file', $FEEDBACK_FILE);
foreach $Feedback_line (@Feedback_lines) {
if ($Feedback_line =~ /<!--Begin Entry: $remove_entry\|\|.*\|\|.*\|\|.*-->/) {
$archive_entry = $Feedback_line;
$archive_flag = "1";
}
elsif ($Feedback_line =~ /<!--End Entry: $remove_entry-->/) {
$archive_entry .= $Feedback_line;
$archive_flag = "0";
}
elsif ($archive_flag == 1) {
$archive_entry .= $Feedback_line;
}
else {
print FEEDBACK $Feedback_line;
}
}
# Close and unlock the Feedback file.
close(FEEDBACK);
&unlock($FEEDBACK_FILE, $LOCK_DIR);
# Lock the Archive by Number File.
if (&lock($ARCHIVE_BY_NUM_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open the archive by number file and try to obtain lock.
# Also read in all of the archive_lines.
open(ARCHIVE_BY_NUM, $ARCHIVE_BY_NUM_FILE)
|| &error('open->archive_by_num_file', $ARCHIVE_BY_NUM_FILE);
@archive_lines = <ARCHIVE_BY_NUM>;
# Open for writing the archive by number file.
open(ARCHIVE_BY_NUM, ">$ARCHIVE_BY_NUM_FILE")
|| &error('write->archive_by_num_file', $ARCHIVE_BY_NUM_FILE);
foreach $archive_line (@archive_lines) {
# Print the new entry if the begin marker is here.
if ($archive_line =~ /<!--begin-->/) {
if ($ENTRY_ORDER ne 'oldest->newest') {
print ARCHIVE_BY_NUM "<!--begin-->\n";
}
print ARCHIVE_BY_NUM $archive_entry;
if ($ENTRY_ORDER eq 'oldest->newest') {
print ARCHIVE_BY_NUM "<!--begin-->\n";
}
}
# Otherwise, just print the line.
else {
print ARCHIVE_BY_NUM $archive_line;
}
}
close(ARCHIVE_BY_NUM);
&unlock($ARCHIVE_BY_NUM_FILE, $LOCK_DIR);
}
}
}
############################################################################
# If there is a last log file, add this user to it and remove a previous #
# user if $LAST_LOG_MAX has been reached. #
############################################################################
if ($LAST_LOG_FILE ne '') {
# If the last log mac variable is not defined, set it to a default of 5.
if (!($LAST_LOG_MAX)) {
$LAST_LOG_MAX = "5";
}
# Add the current entry to list of last entries. (Retrived earlier in
# the script.)
$current_entry = "$ENV{'REMOTE_HOST'}, $ENV{'REMOTE_ADDR'}";
push(@last_entries, $current_entry);
# If the length of the number of last entries exceed last log max,
# then we have to purge some of the last entries and write the new
# ones to the file.
if (@last_entries > $LAST_LOG_MAX) {
$diff = ($LAST_LOG_MAX - length(@last_entries));
for ($i = 1;$i <= $diff;$i++) {
shift(@last_entries);
}
}
# Lock the Last Log File.
if (&lock($LAST_LOG_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open last log for writing.
open(LAST_LOG, ">$LAST_LOG_FILE")
|| &error('write->last_log_file', $LAST_LOG_FILE);
# Foreach of the entries left in @last_entries, print them to the
# last log file.
foreach $last_entry (@last_entries) {
print LAST_LOG "$last_entry\n";
}
# Unlock and close the last log file.
close(LAST_LOG);
&unlock($LAST_LOG_FILE, $LOCK_DIR);
}
############################################################################
# Determine whether to print a success HTML template or a generic response #
# to the user. #
############################################################################
# If there is a success html template, print it to the user.
if ($SUCCESS_TEMPLATE ne '') {
print "Content-type: text/html\n\n";
if (!&parse_template($SUCCESS_TEMPLATE, *STDOUT)) {
&error('open->success_html_template', $SUCCESS_TEMPLATE);
}
}
# Otherwise print a generic response.
else {
# Print the generic HTML success response.
print "Content-type: text/html\n\n";
print "<html><head><title>Feedback Entry Added</title></head>\n";
print "<body><center><h1>Feedback Entry Added</h1></center>\n";
print "Your Feedback entry has been successfully added.<p>\n";
if ($USE_ADMIN eq 'YES') {
print "The owner of the Feedback has the administrative option\n";
print "turned on and therefore your entry must be approved by the\n";
print "administrator before being added to the public Feedback\n";
print "file.<p>\n";
}
else {
print "When you return to the Feedback file you will need to reload\n";
print "the Web page to see your comments.<p>\n";
}
print "Below is a copy of your Feedback entry:<p>\n";
if (!&parse_template($FEEDBACK_TEMPLATE, *STDOUT)) {
&error('open->Feedback_template', $FEEDBACK_TEMPLATE);
}
print "Thank you.<p>\n";
print "</body></html>";
}
############################################################################
# Get the entry number, as each entry requires a unique number for admin #
# purposes. #
############################################################################
sub get_num_entry {
# Open the Unique Number File and read in the current number.
open(NUM_LOG, $FEEDBACK_NUM)
|| &error('open->Feedback_num', $FEEDBACK_NUM);
$Num_Entries = <NUM_LOG>;
close(NUM_LOG);
# Remove any new lines that may exist.
if ($Num_Entries =~ /\n$/) {
chop($Num_Entries);
}
# Increment the number so we have a new unique number.
$Num_Entries++;
}
############################################################################
# Print the incremented number, so a new one can be used instead of the #
# old one we just used. #
############################################################################
sub increment_num_entry {
# Lock the number file.
if (&lock($FEEDBACK_NUM, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open the unique number file for writing.
open(NUM_LOG, ">$FEEDBACK_NUM")
|| &error('write->Feedback_num', $FEEDBACK_NUM);
# Print the new incremented number.
print NUM_LOG $Num_Entries;
# Unlock and close the unique number log.
close(NUM_LOG);
&unlock($FEEDBACK_NUM, $LOCK_DIR);
}
############################################################################
# This is the Error subroutine. Should anything go wrong in the script #
# it will hopefully be caught and passed to this routine where it will #
# be printed to the screen and help may be offerred. #
############################################################################
sub error {
# declare and assign local values to variables.
local($error, $file) = @_;
# Print content-type header.
print "Content-type: text/html\n\n";
# If the error is missing_required fields, create an error_fields
# config field for use in the templates and then either print the error
# template or print a generic HTML error response explaining the
# problem.
if ($error eq 'missing_required_fields') {
$CONFIG{'error_fields'} .= "<ul>\n";
foreach $missing_required_field (@missing_required_fields) {
$CONFIG{'error_fields'} .= "<li>$missing_required_field\n";
}
$CONFIG{'error_fields'} .= "</ul>\n";
if ($ERROR_TEMPLATE) {
if (!&parse_template($ERROR_TEMPLATE, *STDOUT)) {
&error('open->error_html_template', $ERROR_TEMPLATE);
}
}
else {
&error_header('Feedback User Error: Missing Required Fields');
print "You left the following fields blank:<p><hr><p>\n";
print "$CONFIG{'error_fields'}";
print "<p><hr><p>\n";
print "Please hit the back button on your browser and continue\n";
print "filling in the form.\n";
print "</body></html>\n";
}
exit;
}
# If the problem is that no configuration file was specified,
# Supply the error and link tothe config_file section of the README if
# available.
elsif ($error eq 'config_file') {
&error_header('Feedback Fatal Error: Config File Form Field Not Defined!');
print "The <tt>";
if ($README) {
print "<a href=\"$README\#config_file\">config_file</a>\n";
}
else {
print "config_file";
}
print "</tt> form field was not defined. This field must contain\n";
print "the path to your Feedback configuration file.\n";
&error_footer;
exit;
}
# If the host is banned, explain that this host name has been banned
# to posting to the Feedback by the admin.
elsif ($error eq 'banned_host') {
&error_header('Feedback Error: YOU ARE BANNED!');
print "We're sorry, but the host or IP address you are using\n";
print "has been banned from posting messages to this program\n";
print "by the program administrator.\n";
print "</body></html>\n";
exit;
}
# If this is a repeat entry from the last_log file, then send them
# the notice.
elsif ($error eq 'repeat_entry') {
&error_header('Feedback Error: No Repeat Entries');
print "The host or IP address you are using posted a message\n";
print "to this program within the last $LAST_LOG_MAX posts and\n";
print "your post has therefore been ignored. This routine is here\n";
print "to prevent spammers from posting multiple times.\n";
print "</body></html>\n";
exit;
}
# If they used bad words, explain to them they used illegal words in
# their post.
elsif ($error eq 'bad_words') {
&error_header('Feedback Error: No Bad Words!');
print "Your posting contained words which are considered\n";
print "inappropriate for this site. Please return to the form\n";
print "by pressing the back button on your browser and edit\n";
print "your response.\n";
print "</body></html>\n";
exit;
}
# If the problem was with opening the file, print out a header for
# specific file that failed, then print a generic response telling the
# user if the file exists or is just chmoded incorrectly. If either
# one is the problem give ways to fix it.
elsif ($error =~ /^open->(.*)/) {
if ($1 eq 'last_log_file') {
&error_header('Feedback Fatal Error: Last Log File Unopenable');
}
elsif ($1 eq 'bad_word_file') {
&error_header('Feedback Fatal Error: Bad Word File Unopenable');
}
elsif ($1 eq 'preview_html_template') {
&error_header('Feedback Fatal Error: Preview HTML Template Unopenable');
}
elsif ($1 eq 'Feedback_template') {
&error_header('Feedback Fatal Error: Feedback Entry Template Unopenable');
}
elsif ($1 eq 'success_html_template') {
&error_header('Feedback Fatal Error: Success HTML Template Unopenable');
}
elsif ($1 eq 'error_html_template') {
&error_header('Feedback Fatal Error: Error HTML Template Unopenable');
}
elsif ($1 eq 'Feedback_file') {
&error_header('Feedback Fatal Error: Feedback File Unopenable');
}
elsif ($1 eq 'Feedback_num') {
&error_header('Feedback Fatal Error: Feedback Number File Unopenable');
}
elsif ($1 eq 'month_archive_file') {
&error_header('Feedback Fatal Error: Month Archive File Unopenable');
}
elsif ($1 eq 'archive_by_num_file') {
&error_header('Feedback Fatal Error: Archive by Number File Unopenable');
}
print "The file: <b>$file</b> could not be opened for reading.<p>\n";
if (-e $file) {
print "The file does exist so please check to make sure you have\n";
print "correctly chmoded the file or made it readable by the\n";
print "Web server. Type the following command at your Unix\n";
print "prompt:<pre>\n";
print " chmod 777 $file\n";
print "</pre>\n";
}
else {
print "The file does not exist. Check the value of the <tt>";
if ($README) {
print "<a href=\"$README\#$1\">\$$1</a>";
}
else {
print "\$$1";
}
print "</tt> variable to make sure you have correctly typed in\n";
print "the filename.\n";
}
&error_footer;
exit;
}
# If the file could not be opened for writing, do the same thing as
# we did for the opening error, only state that it was a write error and
# things need to be chmoded differently.
elsif ($error =~ /write->(.*)/) {
if ($1 eq 'last_log_file') {
&error_header('Feedback Fatal Error: Could not Write to Last Log File');
}
elsif ($1 eq 'Feedback_file') {
&error_header('Feedback Fatal Error: Could not Write to Feedback File');
}
elsif ($1 eq 'Feedback_num') {
&error_header('Feedback Fatal Error: Could not Write to Feedback Number File');
}
elsif ($1 eq 'month_archive_file') {
&error_header('Feedback Fatal Error: Could not Write to Month Archive File');
}
elsif ($1 eq 'archive_by_num_file') {
&error_header('Feedback Fatal Error: Could not Write to Archive by Number File');
}
elsif ($1 eq 'approve_file') {
&error_header('Feedback Fatal Error: Could not Write to Approve File');
}
print "The file: <b>$file</b> could not be opened for writing.<p>\n";
if (-e $file) {
print "The file does exist so please check to make sure you\n";
print "have correctly chmoded the file or made it writeable\n";
print "by the web server. Type the following command at your\n";
print "Unix prompt:<pre>\n";
print " chmod 777 $file\n";
print "</pre>\n";
}
else {
print "The file does not exist. Check the value of the <tt>";
if ($README) {
print "<a href=\"$README\#$1\">\$$1</a>";
}
else {
print "\$$1";
}
print "</tt> variable to make sure you have correctly typed in\n";
print "the filename.\n";
}
&error_footer;
exit;
}
else {
&error_header($error);
&error_footer;
}
}
############################################################################
# This is useful for starting out an error message. It takes the #
# specified error title and turns that into the HTML title and header. #
############################################################################
sub error_header {
local($title) = $_[0];
print <<HTML_END;
<html>
<head>
<title>$title</title>
</head>
<body bgcolor=#FFFFFF text=#000000>
<center>
<h1>$title</h1>
</center>
HTML_END
}
############################################################################
# This ends the HTML page and links to the readme file on appropriate #
# pages and if available. #
############################################################################
sub error_footer {
if ($README) {
print "<p><hr><p>\n";
print "<ul>\n";
print "<li><a href=\"$README\">Feedback README (Installation and Usage Intructions)</a>\n";
print "</ul>\n";
}
print " </body>\n";
print "</html>\n";
}