#!/usr/bin/perl
# @(#)RELEASE VERSION 'guestbook.cgi v3.30' 13-May-97  Guestbook system
#######################################################################
#                                                                     #
#                Guestbook system v3.30 written by                    #
#                                                                     #
#                        Lars Ellingsen                               #
#                     larsell@stud.ntnu.no                            #
#                http://www.stud.ntnu.no/~larsell                     #
#                     Copyright © 1996-1997                           #
#                                                                     #
#######################################################################
#                                                                     #
# DISCLAIMER                                                          #
#                                                                     #
# You may use this guestbook-system as long as you:                   #
#   1. don't alter the copyright-notes                                #
#   2. send me an eMail and notify me that you use this system        #
#      and give me the address to your homepage                       #
#                                                                     #
#######################################################################
#                                                                     #
# This program is used together with the configfile 'guestbook.cfg'.  #
# See the readme-file for information on how to install the system.   #
#                                                                     #
#######################################################################
#                                                                     #
#               DON'T CHANGE ANYTHING IN THIS SCRIPT!                 #
#                                                                     #
#                 (Mail me and ask if you want to)                    #
#                                                                     #
#######################################################################

$0 =~ s/.*\/(.*).cgi/$1/;     # Saves the filename of the script

$cgi_version    = "3.30";     # This is the script version number
$config_version = "3.30";     # Minimum required config-file version
$lang_version   = "1.03";     # Minimum required language-file version

#######################################################################
# Read aruments and execute requested action.
#######################################################################

if ($ARGV[0] eq "form") {
    &read_config;
    &make_date;
    &make_htmlForm;
} elsif ($ARGV[0] eq "view") {
    &read_config;
    &make_date;
    &extract_forminfo;   # If there is an old datafile to be shown...
    &make_htmlView;
} elsif ($ARGV[0] eq "sign") {
    &make_date;
    &extract_forminfo;
    &test_form;

    if ($form_ok) {
	&read_config;
	&add_signature;
	&make_htmlView;
	&send_mail if ($do_sendmail && $mailprogram && ($mailaddress =~ /\@/));
    } else {
	&display_error;
    }
} else {
    $error_message = "Argument not recognized by the program.<BR>\n" .
	             "The only arguments that are allowed are: " .
	             "\"<I>view</I>\", \"<I>sign</I>\" and \"<I>form</I>\".\n";
    &display_error;
}

#######################################################################
# Read and initialize the config-file.
#######################################################################

sub read_config {
    if (open(CONFIGFILE,"<$0.config")) {
	if (($cfgline = <CONFIGFILE>) =~ /\<GUESTBOOK CONFIG FILE VERSION (.*)\>[\n]/) {
            if ($1 >= $config_version) {
	        while ($cfgline = <CONFIGFILE>) {
		    if (($cfgline =~ /^\<-guestbook-mult\./) || ($nextvariable)) {
		        if ($nextvariable) {
			    $variablename = $nextvariable;
			    $nextvariable = undef;
			    $$variablename .= $cfgline;
		        } else {
			    $variablename = $cfgline;
			    $variablename =~ s/\<-guestbook-mult\.([\w.]+)-\>.*[\n]/$1/g;
		        }
		        while ($cfgline = <CONFIGFILE>) {
			    if ($cfgline =~ /^\<-guestbook/) {
			        $nextvariable = $cfgline;
			        $nextvariable =~ s/\<-guestbook-mult\.([\w.]+)-\>.*[\n]/$1/g;
			        last;
			    } else {
			        $$variablename .= $cfgline;
			    }
		        }
		    } elsif ($cfgline =~ /^\<-guestbook\./) {
		        $cfgline =~ s/\<-guestbook\.([\w.]+)-\>.*[\n]/$1/g;
		        chop($$cfgline = <CONFIGFILE>);
		    }
                }
	        @locationarray = split (/\n/, $locationlist);
	        @stripwordarray = split (/\n/, $stripwordlist);
	        @olddatafilesarray = split (/\n/, $old_datafiles);
	        close(CONFIGFILE);
	    } else {
	        $error_message = "Need configuration-file version $config_version or higher!<P>\n"
			    ."Click on the support link below to learn how to upgrade your config-file.";
	        &display_error;
            }
	}

	#------( Read language-file, if any. )------
	if ($language) {
	    if (open(LANGUAGEFILE,"<$language")) {
		if (($languageline = <LANGUAGEFILE>) =~ /\<GUESTBOOK LANGUAGE FILE VERSION (.*)\:.*\>[\n]/) {
                    if ($1 >= $lang_version) {
		        while ($languageline = <LANGUAGEFILE>) {

			    if ($languageline =~ /^\<-guestbook-lang\./) {
			        $languageline =~ s/\<-guestbook-lang\.([\w.]+)-\>.*[\n]/$1/g;
			        chop($$languageline = <LANGUAGEFILE>);
			    }
		        }
		        close(LANGUAGEFILE);
		    } else {
	                $error_message = "Need language-file version $lang_version or higher!<P>\n"
			    ."Click on the support link below to download the newest language-file.";

	                &display_error;
	            }
	        }
	    }
	}
    } else {
	$error_message = "Couldn't read the configuration file: \"$0.config\"!<P>\n\"$!\"\n";
	&display_error;
    }
}

#######################################################################
# The correct date.
#######################################################################

sub make_date {
    ($t,$t,$t,$mday,$mon,$thisyear,$t,$t,$t) = localtime(time);
    $mon++;
    if ($thisyear < 95) {$thisyear = "20$thisyear";} {$thisyear = "19$thisyear";}
    $date = "$mday.$mon.$thisyear";
}

#######################################################################
# Read the FORM information.
# Split it into understandable data.
# Strip name, eMail and URL for <BR>-tags.
#######################################################################

sub extract_forminfo {
    if ($ENV{'REQUEST_METHOD'} eq "GET") {
	$buffer = $ENV{'QUERY_STRING'};
    } else {
	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    }

    @pairs = split(/&/, $buffer);
    foreach $pair (@pairs) {
	($name, @values) = split(/=/, $pair);
	$value = join ("=", @values);
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$FORM{$name} = $value;
	$FORM{'name'} =~ s/\<[^\>]*\>//ig;
	$FORM{'name'} =~ s/\<//g;
	$FORM{'name'} =~ s/\>//g;
	$FORM{'email'} = "\L$FORM{'email'}";
	$FORM{'email'} =~ s/\<[^\>]*\>//ig;
	$FORM{'email'} =~ s/\<//g;
	$FORM{'email'} =~ s/\>//g;
	$FORM{'homepage'} = "\L$FORM{'homepage'}";
	$FORM{'homepage'} =~ s/\<[^\>]*\>//ig;
	$FORM{'homepage'} =~ s/\<//g;
	$FORM{'homepage'} =~ s/\>//g;
    }
}

#######################################################################
# Test the guestbook-entry for errors. (No name etc.)
#######################################################################

sub test_form {
    $form_ok = 1;
    if ($FORM{'name'} eq "") {
	$form_ok = 0;
	$error_message = "You have to fill in your <I>name</I> in order to " .
	    "sign this guestbook!<P>Go back with your browser an retry.";
    } elsif ($FORM{'location'} eq "nowhere") {
	$form_ok = 0;
	$error_message = "You have to select where you're located!<P>" .
	    "Go back with your browser and retry.";
    }
}

#######################################################################
# Add new signature to the guestbook-file.
#######################################################################

sub add_signature {
    if (open(GUESTFILE,">>$data_file")) {
	if (form_ok) {
	    print GUESTFILE "<STARTSIG>\n$FORM{'name'}\n";
	    print GUESTFILE "$FORM{'location'}\n$date\n$FORM{'email'}\n";
	    print GUESTFILE "$FORM{'homepage'}\n$FORM{'message'}\n<ENDSIG>\n";
	}
	close(GUESTFILE);
    } else {
	$error_message = "Couldn't write to guestbook-file: \"$data_file\"<P>\n\"$!\"\n";
	&display_error;
    }
}

#######################################################################
# Make and show the guestbook HTML-document.
#######################################################################

sub make_htmlView {
    $data_file = $FORM{'old_datafile'} if ($FORM{'old_datafile'} && $show_old_files);
    if (open(GUESTFILE,"<$data_file")) {
	undef $/;
	$guestfile = <GUESTFILE>;
	close(GUESTFILE);

	$first = 1;
	@months = (0,'January','February','March','April','May','June','July',
		   'August','September','October','November','December');

	@entryarray = split (/\<STARTSIG\>\n/, $guestfile);
	shift (@entryarray);
	@entryarray = reverse @entryarray if $reverse_sort;

	#------( Start parsing the entries )------
	foreach $entry (@entryarray) {
	    $entry =~ s/\<ENDSIG\>\n//gs;
	    ($name, $location, $date) = ($entry, $entry, $entry);
	    ($email, $homepage, $message) = ($entry, $entry, $entry);

	    $name     =~ s/(.*?)\n.*/$1/gs;
	    $location =~ s/.*?\n(.*?)\n.*/$1/gs;
	    $date     =~ s/.*?\n.*?\n(.*?)\n.*/$1/gs;
	    $email    =~ s/.*?\n.*?\n.*?\n(.*?)\n.*/$1/s;
	    $homepage =~ s/.*?\n.*?\n.*?\n.*?\n(.*?)\n.*/$1/s;
	    $message  =~ s/.*?\n.*?\n.*?\n.*?\n.*?\n(.*?)/$1/s;

	    $name =~ s/\<[^\>]*\>//ig;
	    $name =~ s/\<//g;
	    $name =~ s/\>//g;
	    $email =~ s/\<[^\>]*\>//ig;
	    $email =~ s/\<//g;
	    $email =~ s/\>//g;
	    $homepage =~ s/\<[^\>]*\>//ig;
	    $homepage =~ s/\<//g;
	    $homepage =~ s/\>//g;

	    #------( If stripping is chosen, strip everything )------
	    if ($strip_words) {
		foreach $word (@stripwordarray) {
		    my $replacedword = $word;
		    my $firstletter = $replacedword;
		    my $lastletter = $replacedword;
		    $firstletter =~ s/\b(.)(.*?)\b/$1/;
		    $lastletter =~ s/\b(.*)(.)\b/$2/;

		    if (length($replacedword) > 2) {
			$replacedword = $firstletter . "*"x (length($replacedword)-2). $lastletter;
		    } else {
			$replacedword = "*"x length($replacedword);
		    }
		    if ($strip_words == 2) {
			$message =~ s/\b$word\b/$replacedword/isg;
			$name    =~ s/\b$word\b/$replacedword/ig;
			$email   =~ s/\b$word\b/$replacedword/ig;
			$homepage=~ s/\b$word\b/$replacedword/ig;
		    }
		    if ($strip_words == 1) {
			$message =~ s/$word/$replacedword/isg;
			$name    =~ s/$word/$replacedword/ig;
			$email   =~ s/$word/$replacedword/ig;
			$homepage=~ s/$word/$replacedword/ig;
		    }
		}
	    }

	    #------( Skip this entry if no name is written )------
	    next if ($name =~ /^$/);

	    #------( Get the date-related stuff right )------
	    ($day, $month, $bookyear) = split(/[.]/,$date);
	    $month = $months[$month];
	    $month = $$month if $$month;
	    if ($DATE_FORMAT) {
		$date = $DATE_FORMAT;
		$date =~ s/D/$day/i;
		$date =~ s/M/$month/i;
		$date =~ s/Y/$bookyear/i;
	    } else {
		$date = $month . " $day. $bookyear";
	    }

	    #------( This is only done the first entry )------
	    if ($first) {
		$first_date = $date;
		$first = 0;
	    } else {
		$all_entries .= "<HR SIZE=\"3\">\n";
	    }

	    #------( Here starts the generating of the HTML-entries )------
	    $all_entries .= "<A HREF=\"mailto:$email\">" if ($email_on_name && ($email =~ /.*@.*/));
	    $all_entries .= "<FONT SIZE=\"+1\"><B>$name</B></FONT> ";
	    $all_entries .= "</A>" if ($email_on_name && ($email =~ /.*@.*/));
	    if ($from) { $all_entries .= $from } else {$all_entries .= "from"};
	    $all_entries .= " $location ";
	    if ($message eq "\n") {
		$all_entries .= "".($signed?$signed:"signed the guestbook on")." $date.\n<DD>"; 
	    } else {
		$all_entries .= "".($wrote?$wrote:"wrote on")." $date:\n<DD>";
	    }
	    $contributions++;
	    if ((!$email_on_name) && ($email =~ /.*@.*/)) {
		$all_entries .= "E-mail: <I><A HREF=\"mailto:$email\">$email</A></I><BR>\n";
	    }
	    if (!(($homepage=~/^$/) || ($homepage=~/^http:\/\/$/)) && ($homepage=~/^http:\/\//)) {
		$all_entries .= "URL: <A HREF=\"$homepage\" TARGET=\"_top\"><I>$homepage</I></A><BR>\n";
	    }
	    $imagetext = "IMAGE";
	    $imagetext = $IMAGE if $IMAGE;
	    $linktext = "LINK";
	    $linktext = $LINK if $LINK;

	    if (!$show_images) {
		$message =~ s/\<A.*HREF\=(.*)[^\>]*\>[^\>]*\<IMG.*SRC\=(.*)[^\>]*\>[^\>]*\<\/A>/
		    \[\<A HREF\=$1\>$linktext\<\/A\>\] \[<A HREF\=$2\>$imagetext\<\/A\>\]/gi;
		$message =~ s/\<IMG.*SRC\=(.*)\>/\[\<A HREF\=$1\>$imagetext\<\/A\>\]/ig ;
		$message =~ s/\<IMG.*SRC\=(.*)[^\>]*\>/\[\<A HREF\=$1\>$imagetext\<\/A\>\]/ig ;
	    }
	    if (!($message eq "\n")) {
		$all_entries .= "--<BR><TABLE BORDER=\"0\"><TR><TD><FONT COLOR=\"$msgcolor\">\n".
		    "$message\n</FONT></TD></TR></TABLE><DT>";
	    } else {
		$all_entries .= "<BR><DT>";
	    }

	}

	#------( Generate the "x people signed..." line )------
	if ($contributions == 1) {
	    $signedline = "<P><B>( $contributions ".($person?$person:"person has");
	} else {
	    $signedline = "<P><B>( $contributions ".($people?$people:"people have");
	}
	$signedline .= " ".($signed_this?$signed_this:"signed this guestbook");
	$signedline .= " ".($since?$since:"since")." ".($reverse_sort?$date:$first_date)." )</B><P>\n";

	#------( Print the contents to screen )------
	print "Content-type: text/html\n\n";
	print "<HTML><HEAD><TITLE>$pagetitle</TITLE></HEAD>\n";
	print "<BODY BACKGROUND=\"$bgpicture\"\nBGCOLOR=\"$bgcolor\" TEXT=\"$textcolor\" ";
	print "LINK=\"$linkcolor\" ALINK=\"$alinkcolor\" VLINK=\"$vlinkcolor\"><CENTER>\n";
	print "<FONT SIZE=\"4\">$view_header</FONT><P>\n";

	if ($show_old_files && !$FORM{'old_datafile'}) {
	    my $i = 1;
	    foreach $temp (@olddatafilesarray) {
		$temp2 = $temp;
		$temp2 =~ s/.*\/(.*)\..*/$1/;
		print "<FORM ACTION=\"$script_location\?view\" METHOD=\"POST\">"
		    ."<INPUT TYPE=\"hidden\" NAME=\"old_datafile\" VALUE=\"$temp\">"
			."<INPUT TYPE=\"submit\" VALUE=\"Read Old Guestbookdata ($temp2)\"><BR>";
		$i++;
	    }
	}

	print $signedline if $show_signed =~ /top/i;
	print "</CENTER><DL><HR>\n".$all_entries."</DL><CENTER><HR>\n";
	print $signedline if $show_signed =~ /bottom/i;

	print "<FONT SIZE=2><I><A HREF=\"http://www.stud.ntnu.no/~larsell/guestbook/\">";
	print "Guestbook system</A> v$cgi_version made by ";
	print "<A HREF=\"http://www.stud.ntnu.no/~larsell/\">Lars Ellingsen</A>\n";
	print "- Copyright © $thisyear<BR></I></FONT></BODY></HTML>";
    } else {
	$error_message = "Couldn't read the guestbook datafile: \"$data_file\"<P>\n\"$!\"\n";
	&display_error;
    }
}

#######################################################################
# Make and show the HTML sign-page.
#######################################################################

sub make_htmlForm {
    print "Content-type: text/html\n\n";
    print "<HTML><HEAD><TITLE>$pagetitle</TITLE></HEAD>
    <BODY BACKGROUND=\"$bgpicture\" BGCOLOR=\"$bgcolor\" TEXT=\"$textcolor\"
    LINK=\"$linkcolor\" ALINK=\"$alinkcolor\" VLINK=\"$vlinkcolor\">";

    print $form_header;

    print "
    <CENTER><TABLE BORDER=\"0\" CELLSPACING=\"7\" WIDTH=\"80%\"><TR><TD>
    <FORM ACTION=\"$script_location\?view\" METHOD=\"POST\">
    <INPUT TYPE=\"submit\" VALUE=\"".($View?$View:"View Guestbook");
    print "\"></FORM></TD><TD><B>";
    if ($Write) {
	print $Write ." \"&lt;BR&gt;\" " . $AtTheEnd;
    } else {
	print "Write \"&lt;BR&gt;\" at the end of each line in your message!";
    }
    print "</B></TD></TR></TABLE><HR WIDTH=\"90%\"><BR>
    <FORM ACTION=\"$script_location\?sign\" METHOD=\"POST\">
    <TABLE BORDER=\"0\" CELLPADDING=\"4\"><TR><TD><B>";
    print "".($Name?$Name:"Name").":</B><BR>
    <INPUT NAME=\"name\" SIZE=\"35\" MAXLENGTH=\"40\" VALUE=\"\">
    </TD><TD ROWSPAN=\"3\" ALIGN=\"Center\">
    <INPUT TYPE=\"submit\" VALUE=\"";
    print "".($Sign?$Sign:"Sign it!");
    print "\"><P><INPUT TYPE=\"reset\" VALUE=\"";
    print "".($Clear?$Clear:"Clear")."\"></TD></TR><TR>
    <TD><B>E-mail:</B><BR>
    <INPUT NAME=\"email\" SIZE=\"35\" MAXLENGTH=\"50\" VALUE=\"\">
    </TD></TR><TR><TD><B>";
    print "".($Homepage?$Homepage:"Your homepage URL").":</B><BR>
    <INPUT NAME=\"homepage\" SIZE=\"35\" VALUE=\"http://\" MAXLENGTH=\"60\">
    </TD></TR><TR><TD><B>".($ComeFrom?$ComeFrom:"You come from");
    print ":</B><BR><FONT SIZE=\"2\"><SELECT NAME=\"location\">
    <OPTION VALUE=\"nowhere\" SELECTED>&lt;";
    print "".($Select?$Select:"Select Location")."&gt;";

    foreach $element (@locationarray) {
	print "<OPTION VALUE=\"$element\">$element\n";
    }

    print "</SELECT></FONT></TD></TR><TR><TD COLSPAN=\"2\"><B>";
    print "".($EnterMsg?$EnterMsg:"Enter message here").":</B><BR>
    <TEXTAREA NAME=\"message\" COLS=\"50\" ROWS=\"10\"></TEXTAREA>
    </TD></TR></TABLE></FORM>

<HR WIDTH=\"90%\"><FONT SIZE=\"2\"><I><A 
HREF=\"http://www.stud.ntnu.no/~larsell/guestbook/\">Guestbook system</A> v$cgi_version made by 
<A HREF=\"http://www.stud.ntnu.no/~larsell\" TARGET=\"_top\">Lars Ellingsen</A>
- Copyright © $thisyear </I></FONT></CENTER></BODY></HTML>";
}

#######################################################################
# Make HTML-page with errormessage.
#######################################################################

sub display_error {
    print "Content-type: text/html\n\n";
    print "<HTML><HEAD><TITLE>Errormessage!</TITLE>\n<BODY>";
    print "<H1>A guestbook-error was detected!</H1><P>\n";
    print $error_message;
    print "<P><I>- <A HREF=\"http://www.stud.ntnu.no/~larsell/\">The Author</A>\n";
    print " / <A HREF=\"http://www.stud.ntnu.no/~larsell/guestbook/\">Support</A>";
    print "</I> -\n</BODY></HTML>";
    exit 0;
}

#######################################################################
# Send the new guestbook-entry as eMail to recipient.
#######################################################################

sub send_mail {
    open (MAIL, "|$mailprogram $mailaddress");
    print MAIL "RETURN-PATH: \<$mailadress\>\n";
    print MAIL "FROM: message\@in_your_guest_book.org ($pagetitle)\n";
    print MAIL "SUBJECT: New guestbook entry.\n\n";
    print MAIL "$FORM{'name'} ";
    print MAIL "".($from?$from:"from");
    print MAIL " $FORM{'location'} ";
    print MAIL "".($wrote?$wrote:"wrote on");
    print MAIL " $date:\n";
    print MAIL "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n";
    if ($FORM{'message'} eq undef) {
        print MAIL "\n<".($NoMsgWritten?$NoMsgWritten:"No message was written").">\n\n";
    } else {
	print MAIL "\n$FORM{'message'}\n\n";
    }
    print MAIL "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n\n";
    close(MAIL);
}

1