Clear DayI tired to run the script below on my host server and it would not run.
The server cannot find Taintcheck or Timefuncs. I uploaded these
pm file to the server.
What did I do wrong?
Is Apache the problem?
SERVER INFORMATION:
Path to Perl: /usr/local/bin/perl
Path to Sendmail: /usr/sbin/sendmail
Path to home directory: /home/horace-f
Path to Date: /bin/date
What Operating System are we using? RedHat Linux
What Web Server Software is running on the server? Apache 1.3
SCRIPT:
#!/usr/bin/perl -wT
#####################
# guestbook.cgi #
#####################
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
## $ENV{'SHELL'} = '/bin/sh';
$ENV{'ENV'} = '';
$ENV{'IFS'} = '';
use lib '/home/horace-f/perl_lib';
use Taintcheck;
use Timefuncs;
use CGI;
use strict;
use vars qw($__START__ $CGI $GUESTBOOK);
####################################
# Paths Guestbook CGI & HTML files #
####################################
$CGI = "guestbook.cgi";
$GUESTBOOK= "/home/horace-f/public_html/guestbook.txt";
eval { main() }; $__START__ = __LINE__;
if ($@) {
chomp($@);
$@ =~ s/\(eval\) line (\d+)/${CGI} . " line " . ($__START__-$1-1)/e;
$@ =~ s/( at ).*( line )/$1${CGI}$2/;
my $error_message = $@;
print <<ERR
Content-type: text/html
<html>
<head><title>Error</title></head>
<body>
<h1>Error</h1><br>\n
<code>$error_message</code>
</body>
</html>
ERR
}
exit(0);
############
# MAIN #
############
sub main {
my $q = new CGI;
if ($q->param()) {
add_entry($q);
}
else {
display_guestbook($q);
}
}
#####################################################
# subroutines
#
# in: CGI object
#
# out:
#
# Description:
#
# Reads the guestbook file & prints it as html #
#####################################################
sub display_guestbook {
my $q = shift;
my ($html,$e,$num_entries,$entries,$cookie,$thanks);
$html = $q->header . $q->start_html("My Guestbook");
$html .= $q->h1("Guestbook");
open (GB, "<$GUESTBOOK") || die "Unable to read guestbook file " . "'$GUESTBOOK'
(error: $!). " . "Please try again later, or contact " . "the webmaster of this site
for assistance";
########################################
# get a read lock on the guestbook #
########################################
lock_filehandle(\*GB, 'R');
####################################
# read and process the entries #
####################################
while (!eof(GB)) {
my $e = new CGI(\*GB);
$num_entries++;
$entries .= draw_guestbook_entry($e);
###############################################
# Here's where things get 'spooky': If the user has signed #
# the guestbook, she'll have a cookie set that will tell us #
# when she signed it. #
###############################################
if ($e->param('cookie') == $q->cookie('sg_signed_at')) {
$thanks = "<p>Hello, <b>" . $e->param('name') .
"</b>! Thanks for signing my guestbook on " .
date_string($e->param('cookie')) . "</p>\n";
}
}
close (GB);
################################################
# Insert the count of entries, and the entries themselves, into #
# the html page
#
#################################################
if ($num_entries) {
$html .= "<p>Signed $num_entries time" .
(($num_entries > 1) && ("s"));
$html .= " · Last signed " .
date_string( (file_stats( $GUESTBOOK ))[0] );
$html .= $thanks if $thanks;
$html .= $entries . "</p>;
}
else {
$html .= "<h3>No entries!</h3><hr>";
}
$html .= &entry_form($q);
$html .= $q->end_html;
print $html;
}
###############################################
# in: CGI object #
# out:
#
# Description: #
# Adds entry to guestbook file, then prints guestbook html #
# Also sets a cookie with the current time #
###############################################
sub add_entry {
my $q = shift;
my ($name,$email,$homepage,$msg,$entry,$url,$cookie);
$url = $q->url;
###########################################
# it's often easier to access parameters than cookies, #
# so save the value here first #
###########################################
$q->param('cookie', time);
################################################
# then create a cookie, which we'll put in the outgoing #
# http header
#
################################################
$cookie = $q->cookie( -name=>'sg_signed_at',
-value=>$q->param('cookie') );
untaint_params($q);
#############################################
# write the submission to the guestbook #
#############################################
open (GB, ">>$GUESTBOOK") || die "Unable to write to guestbook (error: $!). " .
"Please try again later, or contact the webmaster " . "of this site for assistance";
#########################################
# get a write lock on the guestbook #
#########################################
lock_filehandle(\*GB, 'W');
$q->save(\*GB);
###################################################
# closing automatically removes the file lock #
###################################################
close GB;
########################################################
# say thanks, with a link back to the questbook #
# here's where the cookie actually gets set on the
#
# user's computer
#
########################################################
print $q->header( -cookie=>$cookie ),
$q->start_html("Thanks"),
$q->h1("Thanks!"),
$q->h3("Your message has been added to my guestbook."),
$q->p,
$q->a({href=>$q->url}, "Go back to the guestbook"),
$q->end_html;
}
###########################################
# in: guestbook entry #
# out: guestbook entry in html format #
# description: #
# Format a guestbook entry as html #
###########################################
sub draw_guestbook_entry {
my $entry = shift;
my $author;
##################################################
# import the params into a namespace, for easy #
# interpolation below.
#
##################################################
$entry->import_names('E');
##################################################
# include email & homepage links, if present #
##################################################
$author = $E::name;
if ($E::email =~ /(.*?)@((.*?)\.)+.*/) {
$author = qq|<a href="mailto:$E::email";>$E::name</a>|;
}
if ($E::homepage) {
######################################################
# make sure the homepage url begins with http:// #
######################################################
$E::homepage =~ s|^(http://)*(.*)$|http://$2|;
$author .= qq| (<a href="$E::homepage">$E::homepage</a>)|;
}
return <<ENTRY;
<p><b>$author</b>
<br/>$E::message</p>
<hr/>
ENTRY
}
sub entry_form {
my $q = shift;
my $url = $q->url;
my $form = <<E_FORM;
<h3>Sign My Guestbook:</h3>
<form action="$url" method="post">
<p><b>Name</b>: <input type="text" name="name"/></p>
<p><b>E-mail</b>: <input type="text" name="email"/></p>
<p><b>Homepage</b>: <input type="text" name="homepage"/></p>
<p><b>Message</b>:</p>
<p><textarea cols="30" rows="6" wrap="virtual" name="message"></p>
<p>Type your message here.
</textarea>
<input type="submit"></p>
</form>
E_FORM
$form;
}
#######################################################################
# lock_filehandle
#
# in: filehandle
#
# out:
#
# description: flock()s a filehandle, for concurrency-safe access
#
#######################################################################
sub lock_filehandle {
my $fh = shift;
my $lock = shift;
use Fcntl qw(:flock);
my $lock_code;
if ($lock =~ /^r/i) {
$lock_code = LOCK_SH;
} elsif ($lock =~ /^w/i) {
$lock_code = LOCK_EX;
} else {
$lock_code = LOCK_UN;
}
#########################
# give it two tries #
#########################
unless (flock ($fh, $lock_code | LOCK_NB)) {
unless (flock($fh, $lock_code)) {
die "flock: could not get $lock lock on $GUESTBOOK";
}
}
return 1;
}
