This Guest Book program was publically available on the WWW, but I've
(sadly) lost the author's name.
The customization to your own location is obvious.
Where `cdavid' or `uconnvm.uconn.edu' exists, you need to make a change.
I have taken the HTML and converted it to Perl, customizing it where
needed.
As a result, the original comments contained in the .html are
included, but should be ignored.
I will break into the listing to comment where needed.
#!/usr/local/bin/perl
use CGI;
$query = new CGI;
print $query->header;
print $query->start_html("BOOK-Guest Book");
print $query->start_form;
##########################
## guestbook v1.2
##########################
## This first script is called by the user with the appropriate Q_STRING
## that includes their login name, guest page path (relative to their
## local public_html directory), and desired return page.
## It creates the forms page necessary for input to the addguest script,
## which actually adds the guest to the noted guest page. Note that the
## guest page of a user must be in their own public_html directory and
## be readable/writeable by whatever group/user the http server is run as
## (this generally means world readable/writeable).
## The first thing you probably should change in these scripts is the
## path to the PERL executable.
##########################
#
# QUERY_STRING should be of the form:
# http://domain/scriptname?owner!guestpage!returnpage
#
# This gets the necessary info from the QUERY_STRING
# ($owner, $guestpage, $returnpage) = split('!', $ENV{QUERY_STRING});
$owner = cdavid;
$guestpage = "guests.dat";
$returnpage = "guest.dat" ;
#die "Content-type: text/plain
#Lack of info sent to $ENV{SCRIPT_NAME}, stopped"
# unless ($owner && $guestpage);
# W3 root addresses (http version & server version) no trailing slashes
$wwwroot = "http://www.sp.uconn.edu.edu";
# This is the DocumentRoot of the W3 server, for root guestbooks
$wwwserverroot = "~cdavid";
# domain name for addressing
$domain = "@uconnvm.uconn.edu";
# path to addguest script (called when submitting guest book form)
# NOTE: This is a virtual http path, not absolute UNIX path
#$addguest = "/htbin/addguest";
$addguest = "addguest.pl";
As you can see, I commented out parts of this and just assigned
permanent values as I saw fit.
%countryid = ('edu', 'USA', 'org', 'USA', 'com', 'USA', 'net', 'USA',
'gov', 'USA', 'mil', 'USA', 'us', 'USA', 'um', 'USA',
'af', 'Afghanistan', 'al', 'Albania',
'dz', 'Algeria', 'as', 'American Samoa',
'ad', 'Andorra', 'ao', 'Angola',
'ai', 'Anguilla', 'aq', 'Antarctica',
'ag', 'Antigua and Barbuda', 'ar', 'Argentina',
'am', 'Armenia', 'aw', 'Aruba',
'au', 'Australia', 'at', 'Austria',
'az', 'Azerbaijan', 'bs', 'Bahamas',
'bh', 'Bahrain', 'bd', 'Bangladesh',
'bb', 'Barbados', 'by', 'Belarus',
'be', 'Belgium', 'bz', 'Belize',
'bj', 'Benin', 'bm', 'Bermuda',
'bt', 'Bhutan', 'bo', 'Bolivia',
'ba', 'Bosnia and Herzegowina', 'bw', 'Botswana',
'bv', 'Bouvet Island', 'br', 'Brazil',
'io', 'British Indian Ocean Territory',
'bn', 'Brunei Darussalam', 'bg', 'Bulgaria',
'bf', 'Burkina Faso', 'bi', 'Burundi',
'kh', 'Cambodia', 'cm', 'Cameroon',
'ca', 'Canada', 'cv', 'Cape Verde',
'ky', 'Cayman Islands', 'cf', 'Central African Republic',
'td', 'Chad', 'cl', 'Chile',
'cn', 'China', 'cx', 'Christmas Island',
'cc', 'Cocos (Keeling) Islands',
'co', 'Colombia', 'km', 'Comoros',
'cg', 'Congo', 'ck', 'Cook Islands',
'cr', 'Costa Rica', 'ci', 'Cote d'Ivoire',
'hr', 'Croatia (Hrvatska)', 'cu', 'Cuba',
'cy', 'Cyprus', 'cz', 'Czech Republic',
'dk', 'Denmark', 'dj', 'Djibouti',
'dm', 'Dominica', 'do', 'Dominican Republic',
'tp', 'East Timor', 'ec', 'Ecuador',
'eg', 'Egypt', 'sv', 'El Salvador',
'gq', 'Equatorial Guinea', 'er', 'Eritrea',
'ee', 'Estonia', 'et', 'Ethiopia',
'fk', 'Falkland Islands', 'fo', 'Faroe Islands',
'fj', 'Fiji', 'fi', 'Finland',
'fr', 'France', 'fx', 'France,',
'gf', 'French Guiana', 'pf', 'French Polynesia',
'tf', 'French Southern Territories',
'ga', 'Gabon', 'gm', 'Gambia',
'ge', 'Georgia', 'de', 'Germany',
'gh', 'Ghana', 'gi', 'Gibraltar',
'gr', 'Greece', 'gl', 'Greenland',
'gd', 'Grenada', 'gp', 'Guadeloupe',
'gu', 'Guam', 'gt', 'Guatemala',
'gn', 'Guinea', 'gw', 'Guinea-Bissau',
'gy', 'Guyana', 'ht', 'Haiti',
'hm', 'Heard and McDonald Islands',
'hn', 'Honduras', 'hk', 'Hong Kong',
'hu', 'Hungary', 'is', 'Iceland',
'in', 'India', 'id', 'Indonesia',
'ir', 'Iran', 'iq', 'Iraq',
'ie', 'Ireland', 'il', 'Israel',
'it', 'Italy', 'jm', 'Jamaica',
'jp', 'Japan', 'jo', 'Jordan',
'kz', 'Kazakhstan', 'ke', 'Kenya',
'ki', 'Kiribati',
'kp', 'Democratic People's Republic of Korea',
'kr', 'Republic of Korea', 'kw', 'Kuwait',
'kg', 'Kyrgyzstan', 'la', 'Lao Democratic Republic',
'lv', 'Latvia', 'lb', 'Lebanon',
'ls', 'Lesotho', 'lr', 'Liberia',
'ly', 'Libya', 'li', 'Liechtenstein',
'lt', 'Lithuania', 'lu', 'Luxembourg',
'mo', 'Macau', 'mk', 'Macedonia,',
'mg', 'Madagascar', 'mw', 'Malawi',
'my', 'Malaysia', 'mv', 'Maldives',
'ml', 'Mali', 'mt', 'Malta',
'mh', 'Marshall Islands', 'mq', 'Martinique',
'mr', 'Mauritania', 'mu', 'Mauritius',
'yt', 'Mayotte', 'mx', 'Mexico',
'fm', 'Micronesia', 'md', 'Moldova',
'mc', 'Monaco', 'mn', 'Mongolia',
'ms', 'Montserrat', 'ma', 'Morocco',
'mz', 'Mozambique', 'mm', 'Myanmar',
'na', 'Namibia', 'nr', 'Nauru',
'np', 'Nepal', 'nl', 'Netherlands',
'an', 'Netherlands Antilles', 'nc', 'New Caledonia',
'nz', 'New Zealand', 'ni', 'Nicaragua',
'ne', 'Niger', 'ng', 'Nigeria',
'nu', 'Niue', 'nf', 'Norfolk Island',
'mp', 'Northern Mariana Islands',
'no', 'Norway', 'om', 'Oman',
'pk', 'Pakistan', 'pw', 'Palau',
'pa', 'Panama', 'pg', 'Papua New Guinea',
'py', 'Paraguay', 'pe', 'Peru',
'ph', 'Philippines', 'pn', 'Pitcairn',
'pl', 'Poland', 'pt', 'Portugal',
'pr', 'Puerto Rico', 'qa', 'Qatar',
're', 'Reunion', 'ro', 'Romania',
'ru', 'Russian Federation', 'rw', 'Rwanda',
'kn', 'Saint Kitts and Nevis', 'lc', 'Saint Lucia',
'vc', 'Saint Vincent and the Grenadines',
'ws', 'Samoa', 'sm', 'San Marino',
'st', 'Sao Tome and Principe', 'sa', 'Saudi Arabia',
'sn', 'Senegal', 'sc', 'Seychelles',
'sl', 'Sierra Leone', 'sg', 'Singapore',
'sk', 'Slovakia', 'si', 'Slovenia',
'sb', 'Solomon Islands', 'so', 'Somalia',
'za', 'South Africa', 'gs', 'South Georgia',
'es', 'Spain', 'lk', 'Sri Lanka',
'sh', 'St. Helena', 'pm', 'St. Pierre and Miquelon',
'sd', 'Sudan', 'sr', 'Suriname',
'sj', 'Svalbard and Jan Mayen Islands',
'sz', 'Swaziland', 'se', 'Sweden',
'ch', 'Switzerland', 'sy', 'Syria',
'tw', 'Taiwan', 'tj', 'Tajikistan',
'tz', 'Tanzania', 'th', 'Thailand',
'tg', 'Togo', 'tk', 'Tokelau',
'to', 'Tonga', 'tt', 'Trinidad and Tobago',
'tn', 'Tunisia', 'tr', 'Turkey',
'tm', 'Turkmenistan', 'tc', 'Turks and Caicos Islands',
'tv', 'Tuvalu', 'ug', 'Uganda',
'ua', 'Ukraine', 'ae', 'United Arab Emirates',
'gb', 'United Kingdom', 'uk', 'United Kingdom',
'uy', 'Uruguay', 'uz', 'Uzbekistan',
'vu', 'Vanuatu', 'va', 'Vatican City',
've', 'Venezuela', 'vn', 'Viet Name',
'vg', 'British Virgin Islands', 'vi', 'US Virgin Islands',
'wf', 'Wallis and Futina Islands',
'eh', 'Western Sahara', 'ye', 'Yemen',
'yu', 'Yugoslavia', 'zr', 'Zaire',
'zm', 'Zambia', 'zw', 'Zimbabwe',
);
if ($owner ne "root") {
@val = getpwnam($owner);
$dir = @val[7];
if (!$dir) {
die "Content-type: text/plain
$owner is not a valid user, stopped";
}
# $htmlpage = "$wwwroot/~$owner/$guestpage";
$htmlpage = "http://www.sp.uconn.edu/~cdavid/guests.dat";
$address = "$owner$domain";
}
else {
$dir = $wwwserverroot;
$htmlpage = "$wwwroot/$guestpage";
$owner = "webmaster";
$address = "$owner$domain";
}
@tmp = split(/./, $ENV{REMOTE_HOST});
$country = @tmp[$#tmp];
$country =~ tr/A-Z/a-z/;
$country = $countryid{$country};
print"<HEAD><TITLE>Guest Book Entry Form</TITLE></HEAD>";
print "<H2>Thank you for registering.</H2>";
print "All the information below is optional, except for your name.";
print "<P>";
print "Your name:" ,$query->textfield('name','',44,44);
print "<br>Your locale:",$query->textfield('from','',44,74);
print "<br> in (country):",$query->textfield('country',$country,15);
print "<br>Your email address:",$query->textfield('email','',44,44);
#print "<br>Leave a note for all to see (will be shown in <PRE> tags):",
#$query->textarea('public_comment','',3,60);
#print "<br>Leave a private note (this is only seen by $owner):",
#$query->textarea('private_comment','',3,60);
print "<br>";
print $query->submit('submit_name','Submit above for recording');
print $query->reset;
print $query->end_form;
if($query->param){
#$date = `date`;
#chop $date;
%weekday=(
"0","Sunday",
"1","Monday",
"2","Tuesday",
"3","Wednesday",
"4","Thursday",
"5","Friday",
"6","Saturday",
"7","Sunday");
open(GUESTS, ">>guests.dat")||die "Can't open newfile :$!
";
print GUESTS "Guest Name = ",$query->param('name'),"
";
print GUESTS "Guest Address = ",$query->param('from');
print GUESTS ", {country}",$query->param('country'),"
";
print GUESTS "Electronic Mail Address = ",$query->param('email'),"
";
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
print GUESTS qq/Signed on: $hour hours, $min minutes, $weekday{"$wday"},$mon,$mday, 19$year
/;
print GUESTS "-------------------end of entry -----------------
";
close(GUESTS);
#print "<a href=http://www.sp.uconn.edu/~cdavid/home.html>Click here to return to the home page.</a><br>";
print "<br> Use the `BACK' button to return to Opening Screen";
}
This is addguest.pl.
As you can see, I actually don'y use it, but the original GuestBook did.
#!/usr/local/bin/perl
#
###############################
## addguest
################################
## This script, which I denoted "addguest", is called by submitting an entry
## from the guestbook page. This script mails the owner that a person has
## signed the guest book, unless no name is specified, in which case an
## error page is shown to the guest. Otherwise the guest gets a thank you
## page with a pointer to his name in the guestbook, the guestbook itself,
## and the return page specified.
################################
#
# keys: name, from, email, html, pname, note, comment
# QUERY_STRING should be of the form:
# http://domain/scriptname?owner!guestpage!returnpage
# W3 root addresses (http version & server version) no trailing slashes
$wwwroot = "http://www.sp.uconn.edu";
# This is the DocumentRoot of the W3 server, needed for root guestbooks only
$wwwserverroot = "~cdavid";
# domain name for addressing
$domain = "@uconnvm.uconn.edu";
# mail program that is opened with a pipe
$mailprog = "/usr/lib/sendmail -t -oi -oem";
# This gets the necessary info from the QUERY_STRING
($owner, $guestpage, $returnpage) = split('!', $ENV{QUERY_STRING});
#the following was commented out, but should be there fore protection,
# I think.
#die "Content-type: text/plain
Lack of information sent to $ENV{SCRIPT_NAME}, stopped"
# unless ($owner && $guestpage);
if ($owner ne "root") {
@val = getpwnam($owner);
$dir = @val[7];
# commented out, but most likely should be there
# if (!$dir) {
# die "Content-type: text/plain
$owner is not a valid user, stopped";
# }
$returnpage = "$wwwroot/~$owner/$returnpage";
$htmlpage = "$wwwroot/~$owner/$guestpage";
$guestpage = "$dir/public_html/$guestpage";
$address = "$owner$domain";
}
else {
$dir = $wwwserverroot;
$returnpage = "$wwwroot/$returnpage";
$htmlpage = "$wwwroot/$guestpage";
$guestpage = "$dir/$guestpage";
$owner = "webmaster";
$address = "$owner$domain";
}
$date = `date`;
chop $date;
# Get info from form and parse it
read(STDIN, $raw_data, $ENV{CONTENT_LENGTH});
$items = split('&', $raw_data);
for ($i = 0; $i < $items; $i++) {
($key,$value) = split('=', $_[$i]);
$value =~ tr/+/ /;
$value =~ s/%(..)/pack("C", hex($1))/eg;
$data{"$key"} = $value;
}
$rname = $data{name};
$rname =~ tr/ /+/;
$rname =~ tr/[A-Z]/[a-z]/;
if ($data{name}) {
if (!$data{pname}) { $data{pname} = $data{html}; }
#open(GUESTS, ">> $guestpage") ||
# die "Content-type: text/plain
Can't open guest book $guestpage: $!
";
#print GUESTS "<HR>
";
#print GUESTS "<A NAME="$rname"><B>$data{name}</B></A><BR>
";
#print GUESTS "$data{from} " if $data{from};
#print GUESTS "$data{country}" if $data{country};
#print GUESTS "<BR>
";
#print GUESTS "<I>$data{email}</I><BR>
" if $data{email};
#if ($data{html} ne "http://") {
# print GUESTS "<A HREF="$data{html}">$data{pname}</A><BR>
";
#}
#print GUESTS "<PRE>$data{note}</PRE>
" if $data{note};
#print GUESTS "Signed on: $date<BR>
";
#close(GUESTS);
print <<NEWPAGE;
Content-type: text/html
<HTML>
<HEAD><TITLE>Thank You</TITLE></HEAD>
<BODY>
<H3>Thank you $data{name}.</H3>
<br>owner = $owner
<br>guestpage = $guestpage
<br>returnpage = $returnpage
<br>
Feel free to view <A HREF="$htmlpage#$rname">your entry</A> in the
<A HREF="$htmlpage">guest book</A> or <A HREF="$returnpage">return to
$returnpage</A>. <P>
<HR>
<ADDRESS>$address</A></ADDRESS></BODY>
</HTML>
NEWPAGE
open(MAIL, "| $mailprog") ||
die "Content-type: text/plain
Can't open mailprog $mailprog, stopped";
print MAIL <<"STOP";
To: $owner
From: $data{email}
Subject: $data{name} signed guest book
Precedence: junk
Name: $data{name}
From: $data{from}, $data{country}
HREF: $data{html}, $data{pname}
Email: $data{email}
Host: $ENV{REMOTE_HOST}
Note:
$data{note}
Comment:
$data{comment}
STOP
close(MAIL) || die "Content-type: text/plain
pipe exited $?";
}
else {
print <<NEWPAGE;
Content-type: text/html
<HTML>
<HEAD><TITLE>Oops...</TITLE></HEAD>
<BODY>
<H3>Oops...</H3>
You did not specify your name. If you would like to submit
an entry, please specify your name. <P>
Thank you. <P>
# This gets the necessary info from the QUERY_STRING<br>
(owner = $owner, guestpage = $guestpage, returnpage = $returnpage)
<HR>
<ADDRESS>$address</A></ADDRESS></BODY>
</HTML>
NEWPAGE
}
exit;