#! /usr/local/bin/perl # ------------------------------------------------------------ # Guestbook for the WWW, by Matt Wright (mattw@pr1.k12.co.us). # This package is Copyright 1995 by Matt Wright. # Parts of code taken from: # Form-mail.pl, by Reuven M. Lerner (reuven@the-tech.mit.edu). # This package is Copyright 1994 by The Tech. # Guestbook is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the # Free Software Foundation; either version 2, or (at your option) any # later version. # Guestbook is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # You should have received a copy of the GNU General Public License # along with Guestbook; see the file COPYING. If not, write to the Free # Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. # ------------------------------------------------------------ # Guestbook for the World Wide Web # Created by Matt Wright Version 2.1 # Created on: 4/21 Last Modified: 6/1/95 # History can be found in the README file. # ***************Set Following Variables Before Use!!!************* # Set this to your server address $server = "http://".$ENV{"SERVER_NAME"}."/"; # Set this to point to URL style guestbook html file location. $guestbookurl = "perldocs/guestboo.htm"; $sampleperl = "programming.html"; $code = "perlroot/samples/guestboo.pl"; # Set this to point to the actual location of the html files. $guestbookreal = "SYS:/novonyx/suitespot/docs/perldocs/guestboo.htm"; $guestlog = "SYS:/novonyx/suitespot/docs/perldocs/guestlog.htm"; # This points to the relative location of this perl script (this depends # on what you specify in srm.cfg $cgiurl = "perl/samples/guestboo.pl"; # ***************Set Above Variables Before Use!!!************* # Set Your Options: $mail = 0; # 1 = Yes; 0 = No $uselog = 1; # 1 = Yes; 0 = No $linkmail = 1; # 1 = Yes; 0 = No $separator = 1; # 1 =
; 0 =

$redirection = 0; # 1 = Yes; 0 = No ############## # If you answered 1 to $mail you will need to fill out these variables below: $mailprog = '/usr/lib/sendmail'; $recipient = 'mattw@alpha.pr1.k12.co.us'; # Get the Date for Entry #$date = `date +"%A, %B %d, %Y at %T (%Z)"`; # chop($date); #$shortdate = `date +"%D %T %Z"`; # chop($shortdate); # Get the input read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); # Un-Webify plus signs and %-encoding $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # Stop people from using subshells to execute commands # Not a big deal when using sendmail, but very important # when using UCB mail (aka mailx). # $value =~ s/~!/ ~!/g; # Uncomment for debugging purposes # print "Setting $name to $value

"; $FORM{$name} = $value; } # Print the Blank Response Subroutines &no_comments unless $FORM{'comments'}; &no_name unless $FORM{'realname'}; # Begin the Editing of the Guestbook File open (FILE,"$guestbookreal") or die "Can't open $guestbookreal: $!\n"; @LINES=; close(FILE); $SIZE=@LINES; # Open Link File to Output open (GUEST,">$guestbookreal") or die "Can't open $guestbookreal: $!\n"; for ($i=0;$i<=$SIZE;$i++) { $_=$LINES[$i]; if (//) { print GUEST "\n"; print GUEST "$FORM{'comments'}
\n"; print GUEST "$FORM{'realname'}"; if ( $FORM{'username'} ){ if ($linkmail eq '1') { print GUEST " ($FORM{'username'})"; } else { print GUEST " ($FORM{'username'})"; } } print GUEST "
\n"; if ( $FORM{'city'} ){ print GUEST "$FORM{'city'},"; } if ( $FORM{'state'} ){ print GUEST " $FORM{'state'}"; } if ( $FORM{'country'} ){ print GUEST " $FORM{'country'}"; } if ($separator eq '1') { print GUEST " - $date


\n\n"; } else { print GUEST " - $date

\n\n"; } } else { print GUEST $_; } } close (GUEST); # Log The Entry if ($uselog eq '1') { open (LOG, ">>$guestlog"); print LOG "$ENV{'REMOTE_HOST'} - [$FORM{'username'}]
\n"; close (LOG); } ############## # Sub Routines sub no_comments { print "Content-type: text/html\n\n"; print "No Comments\n"; print "\n"; print "\n"; print "

No Comment?

\n"; print "You didn't complete the Comments section. Therefore, your entry was not added to the guest book. Please enter your comments below.

\n"; print "

\n"; print "Your name:
\n"; print "E-mail address:
\n"; print "City: , State: Country:

\n"; print "Comments:
\n"; print "

\n"; print " *


\n"; print "Return to the Guest Book.\n"; print "
\n"; # Log The Error if ($uselog eq '1') { open (LOG, ">>$guestlog"); print LOG "$ENV{'REMOTE_HOST'} - [$shortdate] ERR - No Comments
\n"; close (LOG); } exit; } sub no_name { print "Content-type: text/html\n\n"; print "No Name\n"; print "\n"; print "\n"; print "

What's your name?

\n"; print "You didn't enter your name. Therefore, your name wasn't added to the guest book. Please enter your name below.

\n"; print "

\n"; print "Your name:
\n"; print "E-mail address:
\n"; print "City: , State: Country:

\n"; print "Comments have been retained.

\n"; print "\n"; print " *


\n"; print "Return to the Guest Book.\n"; print "
\n"; # Log The Error if ($uselog eq '1') { open (LOG, ">>$guestlog"); print LOG "$ENV{'REMOTE_HOST'} - [$shortdate] ERR - No Name
\n"; close (LOG); } exit; } ######### # Options # Mail Option if ($mail eq '1') { open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n"; print MAIL "Reply-to: $FORM{'username'} ($FORM{'realname'}\n"; print MAIL "From: $FORM{'username'} ($FORM{'realname'}\n"; print MAIL "Subject: Entry to Guest Book\n\n"; print MAIL "You have a new entry in your guest book:\n\n"; print MAIL "------------------------------------------------------------\n"; print MAIL "$FORM{'comments'}\n"; print MAIL "$FORM{'realname'}"; if ( $FORM{'username'} ){ print MAIL " ($FORM{'username'})"; } print MAIL "\n"; if ( $FORM{'city'} ){ print MAIL "$FORM{'city'},"; } if ( $FORM{'state'} ){ print MAIL " $FORM{'state'}"; } if ( $FORM{'country'} ){ print MAIL " $FORM{'country'}"; } print MAIL " - $date\n"; print MAIL "----------------------------------------------------------\n"; close (MAIL); } # Print Out Initial Output Location Heading if ($redirection eq '1') { print "Location: $server$guestbookurl\n\n"; } else { &redirection } # Redirection Option sub redirection { # Print Beginning of HTML print "Content-Type: text/html\n\n"; print "Thank You\n"; print "\n"; print "\n"; print "

Thank You For Signing Our Guest Book

\n"; # Print Response print "Your entry has been added to our guest book.
\n"; print "Here is what you submitted:

\n"; print "$FORM{'comments'}
\n"; print "$FORM{'realname'}"; if ( $FORM{'username'} ){ if ($linkmail eq '1') { print " ($FORM{'username'})"; } else { print " ($FORM{'username'})" } } print "
\n"; if ( $FORM{'city'} ){ print "$FORM{'city'},"; } if ( $FORM{'state'} ){ print " $FORM{'state'}"; } if ( $FORM{'country'} ){ print " $FORM{'country'}"; } print " - $date

\n"; # Print End of HTML print "


\n"; print "* Back to the Guest Book To see your entry, you may need to reload the Guest Book page.\n"; print "
\n"; print "* Back to Sample Programs\n"; print "
\n"; print "* Download Perl Source File to My Computer\n"; print "
\n"; exit; }