Приглашаем посетить
Feedback Admin
#!/usr/local/bin/perl
############################################################################
# #
# FeedbackAdmin 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 #
############################################################################
# If you are on a Unix machine, set this to 1, otherwise, if you are on
# another platform it must be set to 0 so that the encrypt function will not
# be activated.
$ENCRYPT = 1;
# 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';
############################################################################
# Get Required subroutines which need to be included. #
############################################################################
# Push the $REQUIRED_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';
############################################################################
# Parse the form contents and put configuration fields into %CONFIG and #
# other fields in %FORM. #
############################################################################
if (!(&parse_form)) {
&error($Error_Message);
}
############################################################################
# If the config_file form field was found in valid path, require it. #
############################################################################
if ($FORM{'config_file'} !~ /^$CONFIG_DIR/) {
&error('Invalid Configuration File. Must appear in ' . $CONFIG_DIR);
}
require "$FORM{'config_file'}" || &error('config_file');
############################################################################
# If the user has selected Approve Posts, print out the form to do so. # #
############################################################################
if ($FORM{'type'} eq 'Approve Entries' && $APPROVE_FILE) {
open(APPROVE, $APPROVE_FILE)
|| &error('open->approve_file', $APPROVE_FILE);
# Print out the header for the HTML approve page.
&html_header('Feedback Admin: Approve Feedback Entries');
print "Use the entries below to specify whether you wish to Approve,\n";
print "Hold, or Remove the Entry from the Admin File. This form also\n";
print "allows you to specify users you wish to ban from posting to\n";
print "the feedback page. Simply check the checkbox next the Ban this\n";
print "hostname and IP address and the hostnames and IP addresses\n";
print "shown in parentheses on the line above will be banned from\n";
print "posting.<p>\n";
print "<form method=POST action=\"$ADMIN_CGI_URL\">\n";
print "<input type=hidden name=\"config_file\" value=\"$FORM{'config_file'}\">\n";
print "<input type=hidden name=\"action\" value=\"$FORM{'type'}\">\n";
if ($USE_PASSWD eq 'YES') {
print "Username: <input type=text name=\"username\"><br>\n";
print "Password: <input type=password name=\"password\"><p>\n";
}
print "<hr size=7 width=75%>\n";
# For each entry in the approve file, split it into it's contents.
while ($approve_line = <APPROVE>) {
# Localize variables and assign values.
local($entry_num, $date, $remote_host, $remote_addr, $form_string) =
split(/\|\|/, $approve_line);
# Get rid of previous config stuff from last loop through.
undef(%CONFIG);
# Define the new CONFIG variables for this loop through.
&define_config($form_string);
# Print the radio buttons allowing them to approve post, remove post
# or hold post and checkbox allowing for host banning.
print "<input type=radio name=\"$entry_num\" value=\"approve\"";
print "CHECKED> Approve Entry submitted on $date. ";
print "($remote_host - $remote_addr)<br>\n";
print "<input type=radio name=\"$entry_num\" value=\"hold\"> ";
print "Hold Entry For A Later Approval. <input type=radio ";
print "name=\"$entry_num\" value=\"remove\"> ";
print "Remove Entry from Admin File.<br>\n";
print "<input type=checkbox name=\"ban_host\"";
print "value=\"$remote_host||$remote_addr\">";
print "Ban this hostname and IP address from posting to the ";
print "feedback forum again.<p>\n";
# Show the entry as it will appear by calling the template parser.
if (!&parse_template($FEEDBACK_TEMPLATE, *STDOUT)) {
&error('open->feedback_template', $FEEDBACK_TEMPLATE);
}
# Print an entry separator.
print "<hr size=7>\n";
}
# Print the end of HTML page.
print "<center><input type=submit value=\"Approve Posts\"> ";
print "<input type=reset></center>\n";
print "</form>\n";
print "</body></html>\n";
close(APPROVE);
}
############################################################################
# If the user has selected to Remove Posts from the main admin page, print #
# out the form to do so. #
############################################################################
elsif ($FORM{'type'} eq 'Remove Entries' && $FEEDBACK_FILE) {
# Localize variables used in this subroutine.
local($entry_num, $date, $remote_host, $remote_addr);
# Open the feedback file and read in the lines.
open(FEEDBACK, $FEEDBACK_FILE)
|| &error('open->feedback_file', $FEEDBACK_FILE);
@feedback_lines = <FEEDBACK>;
close(FEEDBACK);
# Print the header of the feedback and top paragraph explaining page.
&html_header('Feedback Admin: Remove Feedback Entries');
print "Use the checkboxes below to specify which messages you\n";
print "wish to remove from the feedback page. This form also allows\n";
print "you to specify users you wish to ban from posting. Simply\n";
print "check the checkbox next to Ban this hostname and IP address\n";
print "and the hostnames and IP addresses shown in the parentheses\n";
print "on the line above will be banned from posting.<p>\n";
print "<form method=POST action=\"$ADMIN_CGI_URL\">\n";
print "<input type=hidden name=\"config_file\" ";
print "value=\"$FORM{'config_file'}\">\n";
print "<input type=hidden name=\"action\" value=\"$FORM{'type'}\">\n";
# If they are using a username/password verification, print these
# form fields.
if ($USE_PASSWD eq 'YES') {
print "Username: <input type=text name=\"username\"><br>\n";
print "Password: <input type=password name=\"password\"><p>\n";
}
# Print entry separator
print "<hr size=7>\n";
# Loop through feedback lines pulling out entries and displaying
# them for removal.
foreach $feedback_line (@feedback_lines) {
if ($feedback_line =~ /<!--Begin Entry: (.*)\|\|(.*)\|\|(.*)\|\|(.*)-->/) {
$entry_num = $1; $date = $2; $remote_host = $3; $remote_addr = $4;
$entry_status = "1";
print "<input type=checkbox name=\"$entry_num\" ";
print "value=\"remove\"> Remove Feedback Entry Number $entry_num ";
print "($remote_host - $remote_addr)<br>\n";
print "<input type=checkbox name=\"ban_host\" ";
print "value=\"$remote_host||$remote_addr\"> ";
print "Ban hostname and IP address from posting to feedback<p>\n";
}
elsif ($feedback_line =~ /<!--End Entry: $entry_num-->/) {
$entry_status = 0;
print "<hr size=7 width=75%>\n";
}
elsif ($entry_status == 1) {
print $feedback_line;
}
}
# Print submit buttons and end of page.
print "<center><input type=submit value=\"Remove Posts\"> ";
print "<input type=reset></center>\n";
print "</form>\n";
print "</body></html>\n";
}
############################################################################
# If the user has selected to Archive Posts from the main admin page, #
# print out the form to do so. #
############################################################################
elsif ($FORM{'type'} eq 'Archive Entries' && $FEEDBACK_FILE) {
# Localize variables used in this subroutine.
local($entry_num, $date, $remote_host, $remote_addr);
# Read in feedback lines.
open(FEEDBACK, $FEEDBACK_FILE)
|| &error('open->feedback_file', $FEEDBACK_FILE);
@feedback_lines = <FEEDBACK>;
close(FEEDBACK);
# Print page header and paragraph explaining this page's function.
&html_header('Feedback Admin: Archive Feedback Entries');
print "Check the checkboxes next to each entry if you wish to place\n";
print "it in the archive file specified in the \$MANUAL_ARCHIVE_FILE\n";
print "of your configuration file. This form also allows you to\n";
print "specify users you wish to ban from posting to the feedback.\n";
print "Simply check the checkbox next the the Ban this hostname and\n";
print "IP address and the hostnames and IP addresses shown in the ()\n";
print "on the line above will be banned from posting.<p>\n";
print "<form method=POST action=\"$ADMIN_CGI_URL\">\n";
print "<input type=hidden name=\"config_file\" ";
print "value=\"$FORM{'config_file'}\">\n";
print "<input type=hidden name=\"action\" value=\"$FORM{'type'}\">\n";
# If using username/password verifitcaion, print these form fields.
if ($USE_PASSWD eq 'YES') {
print "Username: <input type=text name=\"username\"><br>\n";
print "Password: <input type=password name=\"password\"><p>\n";
}
# Allow them to change the manual archive file on the fly or leave it
# as the default in their config file.
print "Manual Archive File: <input type=text name=\"manual_archive_file\" value=\"$MANUAL_ARCHIVE_FILE\" size=45><p>\n";
# Print separator for entries
print "<hr size=7>\n";
# Loop through feedback lines pulling out entries and creating the
# checkboxes and radio buttons for archiving.
foreach $feedback_line (@feedback_lines) {
if ($feedback_line =~ /<!--Begin Entry: (.*)\|\|(.*)\|\|(.*)\|\|(.*)-->/) {
$entry_num = $1;
$date = $2;
$remote_host = $3;
$remote_addr = $4;
$entry_status = 1;
print "<input type=checkbox name=\"$entry_num\" ";
print "value=\"archive\"> Archive Feedback Entry Number ";
print "$entry_num ($remote_host - $remote_addr)<br>\n";
print "<input type=checkbox name=\"ban_host\" ";
print "value=\"$remote_host||$remote_addr\"> ";
print "Ban hostname and IP address from posting to feedback<p>\n";
}
elsif ($feedback_line =~ /<!--End Entry: $entry_num-->/) {
$entry_status = 0;
print "<hr size=7 width=75%>\n";
}
elsif ($entry_status == 1) {
print $feedback_line;
}
}
# Print end of page and submit buttons.
print "<p><center><input type=submit value=\"Archive Posts\"> ";
print "<input type=reset></center>\n";
print "</form>\n";
print "</body></html>\n";
}
############################################################################
# If the user has selected to Change their username or password, print out #
# the form to do so. #
############################################################################
elsif ($FORM{'type'} eq 'Change Password' && $PASSWD_FILE) {
# Just a simple series of print's to get the password form out there.
&html_header('Feedback Admin: Change Password');
print "<form method=POST action=\"$ADMIN_CGI_URL\">\n";
print "<input type=hidden name=\"config_file\" ";
print "value=\"$FORM{'config_file'}\">\n";
print "<input type=hidden name=\"action\" value=\"$FORM{'type'}\">\n";
print "Old Username: <input type=text name=\"old_username\"><br>\n";
print "Old Password: <input type=password name=\"old_password\"><p>\n";
print "New Username: <input type=text name=\"new_username\"><br>\n";
print "New Password: <input type=password ";
print "name=\"new_password1\"><br>\n";
print "Re-Type New Password: ";
print "<input type=password name=\"new_password2\"><p>\n";
print "<p><center><input type=submit value=\"Change Password\"> ";
print "<input type=reset></center>\n";
print "</form>\n";
print "</body></html>\n";
}
############################################################################
# The action form field will be filled in if the user has completed a form #
# printed out in an earlier stage. In this case, the form is for #
# approving entries, and we will do so below. #
############################################################################
elsif ($FORM{'action'} eq 'Approve Entries') {
# If they are using username/password verification, check it.
if ($USE_PASSWD eq 'YES') {
&check_passwd;
}
# Open Approve file.
open(APPROVE, $APPROVE_FILE)
|| &error('open->approve_file', $APPROVE_FILE);
# Loop through each approve entry.
while ($approve_line = <APPROVE>) {
# Localize variables and give them their values.
local($entry_num, $date, $remote_host, $remote_addr, $form_string) = split(/\|\|/, $approve_line);
# Chop if there is a new line.
chop($form_string) if ($form_string =~ /\n$/);
# Undefine %CONFIG from last time through.
undef(%CONFIG);
# Define %CONFIG for this time through for use in templates.
&define_config($form_string);
# If this entry has been approved, write the feedback entry and
# push it onto an array for reporting back.
if ($FORM{$entry_num} eq 'approve') {
&write_feedback_entry($entry_num, $date, $remote_host, $remote_addr);
push(@approved, $entry_num);
# if any archiving of this is required automatcally, do so now.
if ($ARCHIVE_TYPE eq 'by_month') {
&archive_by_month;
}
elsif ($ARCHIVE_TYPE eq 'by_num' && $MAX_ENTRIES ne ''
&& $ARCHIVE_BY_NUM_FILE ne '') {
&archive_by_num;
}
}
# If the entry is to be held, push it onto a hold_approve array.
elsif ($FORM{$entry_num} eq 'hold') {
push(@hold_approve, $approve_line);
push(@held, $entry_num);
}
# Otherwise, don't do anything and it will just not be printed
# back.. Push it onto the @removed array for reporting back results.
else {
push(@removed, $entry_num);
}
}
close(APPROVE);
# Lock the approve file.
if (&lock($APPROVE_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open the file while we still have a lock and write any of the
# entries they asked to hold back into the approve file.
open (APPROVE, ">$APPROVE_FILE")
|| &error('write->approve_file', $APPROVE_FILE);
foreach $hold_line (@hold_approve) {
print APPROVE $hold_line;
}
# Unlock the file and close it again.
close(APPROVE);
&unlock($APPROVE_FILE, $LOCK_DIR);
# Print the successful result page and results.
&html_header('Feedback Admin: Posts Approved');
print "The following is a summary of the actions taken by Feedback\n";
print "Admin. The numbers represent the entry number. (A unique\n";
print "entry number is assigned to every post.\n";
print "<p><hr><p>\n";
print "<b>Approved:</b> ";
foreach $approved (@approved) {
print "$approved, ";
}
print "<p>\n<b>Removed:</b> ";
foreach $removed (@removed) {
print "$removed, ";
}
print "<p>\n<b>Held in Queue:</b> ";
foreach $held (@held) {
print "$held, ";
}
print "<p><hr><p>\n";
print "Return to <a href=\"$ADMIN_URL\">Feedback Admin</a>.\n";
print "</body></html>\n";
}
############################################################################
# The action form field will be filled in if the user has completed a form #
# printed out in an earlier stage. In this case, the form is for removing #
# entries, and we will do so below. #
############################################################################
elsif ($FORM{'action'} eq 'Remove Entries') {
# If they wish to use username/password verification, check it.
if ($USE_PASSWD eq 'YES') {
&check_passwd;
}
# Lock the feedback file.
if (&lock($FEEDBACK_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open feedback, read it in and get lock.
open(FEEDBACK, $FEEDBACK_FILE)
|| &error('open->feedback_file', $FEEDBACK_FILE);
@feedback_lines = <FEEDBACK>;
close(FEEDBACK);
# Open Feedback for writing.
open (FEEDBACK, ">$FEEDBACK_FILE")
|| &error('write->feedback_file', $FEEDBACK_FILE);
# For each line in the feedback file...
foreach $feedback_line (@feedback_lines) {
# If it begins an entry that is to be removed, , set the
# entry_status flag to 1 and don't print it back to the feedback.
if ($feedback_line =~ /<!--Begin Entry: (.*)\|\|.*\|\|.*\|\|.*-->/) {
$entry_num = $1;
if ($FORM{$entry_num} eq 'remove') {
$entry_status = 1;
}
else {
print FEEDBACK $feedback_line;
}
}
# Remove the end line and set the flag back to 0.
elsif ($feedback_line =~ /<!--End Entry: $entry_num-->/ && $entry_status == 1) {
$entry_status = 0;
}
# Print any other lines if the entry status is not 1.
elsif ($entry_status == 0) {
print FEEDBACK $feedback_line;
}
}
close(FEEDBACK);
&unlock($FEEDBACK_FILE, $LOCK_DIR);
# Print confirmation web page.
&html_header('Feedback Admin: Posts Removed');
print "The posts you requested to have removed have been.<p>\n";
print "Back to <a href=\"$ADMIN_URL\">Feedback Admin</a>.\n";
print "</body></html>";
}
############################################################################
# The action form field will be filled in if the user has completed a form #
# printed out in an earlier stage. In this case, the form is for #
# archiving entries, and we will do so below. #
############################################################################
elsif ($FORM{'action'} eq 'Archive Entries') {
# If they have username/password verification turned on, check it.
if ($USE_PASSWD eq 'YES') {
&check_passwd;
}
# Lock the feedback file so information read from the file will not
# change before we write it back.
if (&lock($FEEDBACK_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open and read in feedback file.
open(FEEDBACK, $FEEDBACK_FILE)
|| &error('open->feedback_file', $FEEDBACK_FILE);
@feedback_lines = <FEEDBACK>;
close(FEEDBACK);
# Lock the manual archive file.
if (&lock($FORM{'manual_archive_file'}, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open and read in the manual archive file.
open(ARCHIVE, "$FORM{'manual_archive_file'}")
|| &error('open->manual_archive_file', $FORM{'manual_archive_file'});
@archive_lines = <ARCHIVE>;
close(ARCHIVE);
# Open for writing the manual archive file.
open (ARCHIVE, ">$FORM{'manual_archive_file'}")
|| &error('write->manual_archive_file', $FORM{'manual_archive_file'});
# For each of the existing lines in the manual archive file...
foreach $archive_line (@archive_lines) {
# If this line is the begin marker, go through the feedback
# lines and archive any entries which were selected from the admin
# form. Anything that is not to be added to the archive file
# should be added to an array which will be re-written to the
# feedback file later.
if ($archive_line =~ /<!--begin-->/) {
if ($order_entry ne 'oldest->newest') {
print ARCHIVE "<!--begin-->\n";
}
foreach $feedback_line (@feedback_lines) {
if ($feedback_line =~ /<!--Begin Entry: (.*)\|\|.*\|\|.*\|\|.*-->/) {
$entry_num = $1;
if ($FORM{$entry_num} eq 'archive') {
$entry_status = 1;
print ARCHIVE $feedback_line;
}
else {
push(@keep_feedback_lines, $feedback_line);
}
}
elsif ($feedback_line =~ /<!--End Entry: $entry_num-->/
&& $entry_status ==1) {
$entry_status = 0;
print ARCHIVE $feedback_line;
}
elsif ($entry_status == 1) {
print ARCHIVE $feedback_line;
}
else {
push(@keep_feedback_lines, $feedback_line);
}
}
if ($order_entry eq 'oldest->newest') {
print ARCHIVE "<!--begin-->\n";
}
$begin_line = 1;
}
else {
print ARCHIVE $archive_line;
}
}
close(ARCHIVE);
&unlock($FORM{'manual_archive_file'}, $LOCK_DIR);
# If it can't find the begin marker in the manual_archive_file, it
# will throw an error.
if ($begin_line != 1) {
&error('begin_line', 'manual_archive_file');
}
# Open the feedback for writing.
open(FEEDBACK, ">$FEEDBACK_FILE")
|| &error('write->feedback_file', $FEEDBACK_FILE);
# For all of the feedback lines we shoul dkeep, write them back to
# the feedback.
foreach $keep_feedback_line (@keep_feedback_lines) {
print FEEDBACK $keep_feedback_line;
}
# Unlock the feedback and close it.
close(FEEDBACK);
&unlock($FEEDBACK_FILE, $LOCK_DIR);
# Print out a confirmation web page.
&html_header('Feedback Admin: Posts Archived');
print "The posts you requested to have archived have been.<p>\n";
print "Back to <a href=\"$ADMIN_URL\">Feedback Admin</a>.\n";
print "</body></html>";
}
############################################################################
# The action form field will be filled in if the user has completed a form #
# printed out in an earlier stage. In this case, the form is for changing #
# the admin's username and password. #
############################################################################
elsif ($FORM{'action'} eq 'Change Password') {
# Open the password file and obtain lock.
if (&lock($PASSWD_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
open(PASSWD, $PASSWD_FILE) || &error('open->passwd_file', $PASSWD_FILE);
$old_password = <PASSWD>;
close(PASSWD);
# Chop any new lines off of the old username/password combination
if ($old_password =~ /\n$/) {
chop($old_password);
}
# Split username and password, localize
local($username, $old_passwd) = split(/:/, $old_password);
# If the encrypt flag is set, encrypt the old password and both new
# passwords from the form.
if ($ENCRYPT == 1) {
$FORM{'old_password'} = crypt($FORM{'old_password'}, substr($old_passwd, 0, 2));
$FORM{'new_password1'} = crypt($FORM{'new_password1'}, substr($old_passwd, 0, 2));
$FORM{'new_password2'} = crypt($FORM{'new_password2'}, substr($old_passwd, 0, 2));
}
# If the old password entered in the form doesn't match the old
# password in the file, throw an error.
if ($old_passwd ne $FORM{'old_password'}) {
&error('bad_password');
}
# If the old username entered in the form doesn't equal the old
# username from the file, throw an error.
if ($username ne $FORM{'old_username'}) {
&error('bad_password');
}
# If the new passwords (entered twice to make sure there was no
# mis-type), do not match, throw an error.
if ($FORM{'new_passwd1'} ne $FORM{'new_passwd2'}) {
&error('new_passwd_match');
}
# Open the password file for writing and write the new
# username/password combo.
open(PASSWD, ">$PASSWD_FILE")
|| &error('write->passwd_file', $PASSWD_FILE);
print PASSWD "$FORM{'new_username'}\:$FORM{'new_password1'}\n";
close(PASSWD);
&unlock($PASSWD_FILE, $LOCK_DIR);
# Print out a confirmation web page.
&html_header('Feedback Admin: Password Changed');
print "Your password and username have been changed.<p>\n";
print "<a href=\"$ADMIN_URL\">Back to Feedback Admin Main Page</a>\n";
print "</body></html>\n";
}
############################################################################
# If it doesn't fit above, then it is not a valid action. Send out an error#
############################################################################
else {
&error('bad_args');
}
# If banned hosts are checked in any of the forms, ban them now.
if ($FORM{'ban_host'}) {
# Get and localize the entry numbers from the ban_host form field.
local(@banned_hosts) = split(/,/, $FORM{'ban_host'});
# Lock the banned hosts file.
if (&lock($BANNED_HOSTS_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open banned hosts file for appending.
open(BANNED, ">>$BANNED_HOSTS_FILE")
|| &error('open->banned_hosts_file', $BANNED_HOSTS_FILE);
# Print out the new banned host record.
foreach $banned_host (@banned_hosts) {
$banned_host =~ s/\|\|/\,/;
print BANNED "$banned_host\n";
}
# Unlock and close the file.
close(BANNED);
&unlock($BANNED_HOSTS_FILE, $LOCK_DIR);
}
############################################################################
# Define a configuration array which can be used by the template parsing #
# routines. #
############################################################################
sub define_config {
# Localize variables.
local($name, $value, $pair, @pairs);
# Get pairs from the form string passed into this subroutine.
@pairs = split(/&/, $_[0]);
# For each of the pairs of information passed....
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
# Decode any & or = that were encoded so as not to mess up the
# parsing.
$name =~ s/--amp--/&/g;
$name =~ s/--eq--/=/g;
$value =~ s/--amp--/&/g;
$value =~ s/--eq--/=/g;
# Create a configuration field based on it so the templates can
# read this information when they are parsed.
if ($CONFIG{$name}) {
$CONFIG{$name} .= ",$value";
}
else {
$CONFIG{$name} = $value;
}
}
}
############################################################################
# Generate an HTML header for a specified title. #
############################################################################
sub html_header {
local($title) = $_[0];
print <<"END_HTML";
Content-type: text/html
<html>
<head>
<title>$title</title>
</head>
<body bgcolor=#FFFFFF text=#000000>
<center>
<h1>$title</h1>
</center>
END_HTML
}
############################################################################
# Write the feedback entry to the feedback file. #
############################################################################
sub write_feedback_entry {
# Localize incoming information and put it into variables.
local($num_entries, $date, $remote_host, $remote_addr) = @_;
# Lock the feedback file.
if (&lock($FEEDBACK_FILE, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
# Open Feedback, read it in and lock it.
open(FEEDBACK, $FEEDBACK_FILE)
|| &error('open->feedback_file', $FEEDBACK_FILE);
@feedback_lines = <FEEDBACK>;
close(FEEDBACK);
# Open feedback for writing.
open(FEEDBACK, ">$FEEDBACK_FILE")
|| &error('write->feedback_file', $FEEDBACK_FILE);
# For each line, if it hits the begin marker, it will insert the new
# entry.
foreach $feedback_line (@feedback_lines) {
if ($feedback_line =~ /^<!--begin-->/) {
if ($ENTRY_ORDER ne 'oldest->newest') {
print FEEDBACK "<!--begin-->\n";
}
print FEEDBACK "<!--Begin Entry: $num_entries||$date||$remote_host||$remote_addr-->\n";
if (!&parse_template($FEEDBACK_TEMPLATE, *FEEDBACK)) {
&error('open->feedback_template', $FEEDBACK_TEMPLATE);
}
print FEEDBACK "<!--End Entry: $num_entries-->\n";
if ($ENTRY_ORDER eq 'oldest->newest') {
print FEEDBACK "<!--begin-->\n";
}
}
else {
print FEEDBACK $feedback_line;
}
}
# Unlock the feedback and close it.
close(FEEDBACK);
&unlock($FEEDBACK_FILE, $LOCK_DIR);
}
############################################################################
# If archiving by month is turned on, add the entry to the appropriate #
# month file. #
############################################################################
sub archive_by_month {
# Set the name of the archive file
@MON = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep',
'Oct','Nov','Dec');
($mon, $year) = (localtime)[4, 5];
$year += 1900;
$month_archive_file = "$ARCHIVE_MONTH_DIR$MON[$mon]_$year.html";
# If the month archive file exists...
if (-e $month_archive_file) {
# Lock it, open it, read it in
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);
@month_archive_lines = <MONTH_ARCHIVE>;
close(MONTH_ARCHIVE);
# Open the month archive fle for writing. When we hit the begin
# marker, add the entry into this file as well
open(MONTH_ARCHIVE, ">$month_archive_file")
|| &error('write->month_archive_file', $month_archive_file);
foreach $month_archive_line (@month_archive_lines) {
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";
}
}
else {
print MONTH_ARCHIVE $month_archive_line;
}
}
close(MONTH_ARCHIVE);
&unlock($month_archive_file, $LOCK_DIR);
}
# Otherwise create a template file and call the subroutine again
else {
# Lock the month archive file.
if (&lock($month_archive_file, $LOCK_DIR, $MAX_WAIT)) {
&error($Error_Message);
}
open (MONTH_ARCHIVE, ">$month_archive_file")
|| &error('write->month_archive_file', $month_archive_file);
print MONTH_ARCHIVE <<END_MONTH_ARCHIVE;
<html>
<head>
<title>Monthly Feedback Archive: $months[$mon-1]/$year</title>
</head>
<body bgcolor=#FFFFFF text=#000000>
<center><h1>Feedback Archive: $months[$mon-1]/$year</h1></center>
Below is an archive of the feedback for $months[$mon-1]/$year.<p><hr><p>
<!--begin-->
<p><hr><p>
</body>
</html>
END_MONTH_ARCHIVE
close(MONTH_ARCHIVE);
&unlock($month_archive_file, $LOCK_DIR);
&archive_by_month;
}
}
############################################################################
# Otherwise, if it is archiving by number, check to see if the number #
# exceeds what is allowed, and if so archive entries by number. #
############################################################################
sub archive_by_num {
# For each line in the feedback (lines have already been read in
# from the script before.) if it begins an entry, push it onto 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)
|| &error('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(FEEDBACK);
&unlock($FEEDBACK_FILE, $LOCK_DIR);
# Lock the archive by num 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>;
close(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);
}
}
}
############################################################################
# This checks the admin's username and password to make sure it is valid. #
############################################################################
sub check_passwd {
# Open the password file, get username and password and chop if there
# is a new line.
open(PASSWD, $PASSWD_FILE) || &error('open->passwd_file', $PASSWD_FILE);
($username, $password) = split(/:/, <PASSWD>);
chop($password) if ($password =~ /\n$/);
# Check for valid username and password if encrypt is turned on.
if (($ENCRYPT == 1 && (crypt($FORM{'password'}, substr($password, 0, 2)) ne $password))
|| $username ne $FORM{'username'}) {
&error('bad_password');
}
# Check for valid username and password if crypt is turned off.
elsif ($ENCRYPT != 1 && ($FORM{'password'} ne $password)
|| ($FORM{'username'} ne $username)) {
&error('bad_password');
}
}
############################################################################
# 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 {
# Get and localize the error and optional file error occurred with.
($error, $file) = @_;
print "Content-type: text/html\n\n";
# If the config file is not available, supply an error and a link to
# the README fil if available.
if ($error eq 'config_file') {
&error_header('Feedback Admin 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 a bad password or username was entered supply the error
# explanation.
elsif ($error eq 'bad_password') {
&error_header('Feedback Admin Fatal Error: Bad Password or Username');
print "The username and password that you entered did not match\n";
print "the values listed in the \$PASSWD_FILE in your feedback\n";
print "configuration file. Please hit the back button on your\n";
print "browser and try again.<p>\n";
print "</body></html>\n";
}
# If the new passwords don't match, send out an error message
# explaining this.
elsif ($error eq 'new_passwd_match') {
&error_header('Feedback Admin Fatal Error: New Passwords Do Not Match');
print "The new passwords you just typed into the previous form\n";
print "do not match each other. Please return to the previous\n";
print "form and try again.<p>\n";
&error_footer;
}
# If there is no begin line in the manual archive file, send out an
# error explaining this.
elsif ($error eq 'begin_line') {
&error_header('Feedback Admin Fatal Error: No Begin Line');
if ($file eq 'manual_archive_file') {
print "There was no begin line in the Manual Archive File.\n";
print "Please check the file: $FORM{'manual_archive_file'}\n";
print "and make sure there is a line resembling:<pre>\n";
print "<!--begin-->\n";
print "</pre>\n";
}
&error_footer;
}
# If the script has a problem opening one of the files, send out a
# header with the exact problem, check to see if the file exists, and
# send out a message explaining what to do to correct this.
elsif ($error =~ /^open->(.*)/) {
if ($1 eq 'approve_file') {
&error_header('Feedback Admin Fatal Error: Approve File Unopenable');
}
elsif ($1 eq 'passwd_file') {
&error_header('Feedback Admin Fatal Error: Password File Unopenable');
}
elsif ($1 eq 'archive_by_num_file') {
&error_header('Feedback Admin Fatal Error: Archive By Number File Unopenable');
}
elsif ($1 eq 'feedback_file') {
&error_header('Feedback Admin Fatal Error: Feedback File Unopenable');
}
elsif ($1 eq 'month_archive_file') {
&error_header('Feedback Admin Fatal Error: Archive by Month File Unopenable');
}
elsif ($1 eq 'manual_archive_file') {
&error_header('Feedback Admin Fatal Error: Manual Archive 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 "command line 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 qq'<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;
}
# If there is a file writing error, send out a header explaining
# which file it was, and then give proper chmod commands or tell the
# user that the file does not exist.
elsif ($error =~ /^write->(.*)/) {
if ($1 eq 'approve_file') {
&error_header('Feedback Admin Fatal Error: Approve File Not Writeable');
}
elsif ($1 eq 'passwd_file') {
&error_header('Feedback Admin Fatal Error: Password File Not Writeable');
}
elsif ($1 eq 'archive_by_num_file') {
&error_header('Feedback Admin Fatal Error: Archive by Number File Not Writeable');
}
elsif ($1 eq 'feedback_file') {
&error_header('Feedback Admin Fatal Error: Feedback File Not Writeable');
}
elsif ($1 eq 'month_archive_file') {
&error_header('Feedback Admin Fatal Error: Month Archive File Not Writeable');
}
elsif ($1 eq 'manual_archive_file') {
&error_header('Feedback Admin Fatal Error: Manual Archive File Not Writeable');
}
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 into\n";
print "your 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 qq'<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;
}
# If there were no form arguments specified, send out a message
# explaining this.
elsif ($error eq 'bad_args') {
&error_header('Feedback Admin Fatal Error: No Arguments!');
print "There were no arguments for the Feedback Admin script to\n";
print "work with. Please make sure you submit this form from the\n";
print "admin web page.\n";
&error_footer;
}
else {
&error_header($error);
&error_footer;
}
exit;
}
############################################################################
# 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 ";
print "Usage Intructions)</a>\n";
print "</ul>\n";
}
print " </body>\n";
print "</html>\n";
}
