#!/usr/local/bin/perl
#
# guestbook   -- version 1.4
#
#   Sign a guestbook using the output of a guestbook form.
#
# Execute without any CGI Form Arguments for Documentation
#
# WARNING: the locking sub-routine requires perl version 5, do not use
# with perl version 4.
#
# AUTHOR
#   Original C program:  Jester  <rbyrnes@alsvid.scu.edu.au>
#   Conversion to Perl:  Anthony Thyssen <anthony@cit.gu.edu.au> 9 Nov 1994
#   Reversal Option:       `'      `'    30 Jan 1995
#   Jump URL Option:       `'      `'    12 Nov 1996
#
# --- initialize ---
$MAIL_PROG = '/usr/lib/sendmail';

# extract the owner and home pages the guestbook belongs to.
($BOOK_OWNER,$FLAG) = split(/&/, $ENV{'QUERY_STRING'});

# Location of the actual guest book file
$BOOK_FILE   = (getpwnam($BOOK_OWNER))[7] . "/www/guestbook.html";

# The Web location of the guest book (on this server)
$BOOK_URL    = "/~$BOOK_OWNER/guestbook.html";

# The owners home page to provide return links to
$OWNER_HOME  = "/~$BOOK_OWNER/";

# also mail this person to say someone signed (future)
$OWNER_MAIL   = $BOOK_OWNER;

# stuff for reversed guestbook (new at top)
$TMP_FILE    = "/tmp/guestbook.$$";          # the new book

$DATE = `date '+%d %h %y'`;
chop($DATE);

# Insert Point
$INSERT_REXP = '<HR>';    # case-insensative regular expression
$INSERT_POINT = '<HR>';   # what to insert if insert point is not found

# --- Output HTML ---

sub docs {
q*
<PRE>
<B>CGI Get String</B>
     user      The login name of the owner of the guestbook to be signed.
     user&amp;REV  Add new entries after first &lt;HR&gt; IE: at the top
                 instead of at the bottom of the guestbook.

<B>CGI Post Options</B>
   name=     STRING   guests real name
   mail=     STRING   guests email address
   url=      STRING   guests home page URL (optional)
   comment=  STRING   a one line comment by the guest
   jump_url= STRING   a URL to jump to after submition (optional)
                      This last is normally hidden from the user.

<B>Example Sign Guestbook Form</B>
    <IMG SRC="/images/divider_top.gif" ALT="----8<----" WIDTH=120 HEIGHT=10>
    &lt;FORM METHOD="POST" ACTION="/cgi-bin/guestbook?loginname&REV"&gt;
        Enter your real name:  &lt;INPUT NAME="name" SIZE=30&gt;&lt;BR&gt;
        Your E-mail address:   &lt;INPUT NAME="mail" SIZE=30&gt;&lt;BR&gt;
        Your Home Page URL (optional):&lt;BR&gt;
                    &lt;INPUT NAME="url" SIZE=60 VALUE=""&gt;&lt;BR&gt;
        Comment (optional) : &lt;BR&gt;
        &lt;INPUT NAME="comment" SIZE=60 VALUE=""&gt;&lt;BR&gt;
        &lt;INPUT TYPE="hidden" NAME="jump_url"
                  VALUE="http://www.sct.gu.edu.au/~anthony/"&gt;
        &lt;INPUT TYPE="submit" VALUE="Sign the Guestbook"&gt;
        &lt;INPUT TYPE="reset" VALUE="Clear Form"&gt;
    &lt;/FORM&gt;&lt;P&gt;
    <IMG SRC="/images/divider_bot.gif" ALT="----8<----" WIDTH=120 HEIGHT=10>
</PRE>
*
}

sub addr {
qq*
You can go to the <A HREF="$BOOK_URL"><B>guestbook</B></A> now,
or you can go back to my <A HREF="$OWNER_HOME"><B>home page</B></A>
<P><HR><P>
<ADDRESS>
Program: ``guestbook'' (v1.4)<BR>
Original Author:
  <A HREF="http://casmac.scu.edu.au/jester/jester.html">Jester</A>
  &lt;rbyrnes\@alsvid.scu.edu.au&gt; <BR>
Perl Version:
  <A HREF="http://www.cit.gu.edu.au/~anthony/anthony.html">Anthony Thyssen</A>,
  &lt;<A HREF="http://www.cit.gu.edu.au/~anthony/mail.shtml">
  anthony\@cit.gu.edu.au</A>&gt;  on 9 November 1994<BR>
Last Update: 12 November 1996 <BR>
</ADDRESS>
*
}

sub address {
  print &addr;
  exit 0;
}

sub jump_url {
  local($url) = @_;

  print "Location: $url\n";
  print "Content-type: text/html\n\n";
  print "Your client is old, you should have automatically jumped to";
  print "<A HREF=\"$url\">$url</A>.\n\n";
  &address;
}

#
# Lock File Routine
# USAGE: &lock(FILE,type) where type is either  'W', 'R' or 'U'
#
# Using Fcntl Module (perl5)
require "Fcntl.pm";
%lock_types = ( 'W', &Fcntl::F_WRLCK,     # write lock
                'R', &Fcntl::F_RDLCK,     # read lock
                'U', &Fcntl::F_UNLCK );   # unlock
sub lock {
  local(*FILE, $type) = @_;
  local($lock) = pack('sslls', $lock_types{$type}, 0, 0, 0, 0);
  die ("fcntl_lock '$type': $!\n")
    if  fcntl(*FILE, &Fcntl::F_SETLKW, $lock) == -1;
}

sub htmlize_text {
  my($text) = @_;

  # Expand tabs (if text is NOT in a <PRE>..</PRE>)
  1 while $text =~ s/\t+/ ' 'x( length($&)*8 - length($`)%8 ) /e;

  $text =~ s/\&/\&amp;/g;         # specific characters
  $text =~ s/\</\&lt;/g;
  $text =~ s/\>/\&gt;/g;

  # do the following if text is NOT in a <PRE>..</PRE>
  $text =~ s/ /&nbsp;/g;          # replace all spaces (including tabs)
  $text =~ s/\r?\n|\n/<BR>\n/g;   # replace end of lines

  # Escape any other binary characters
  $text =~ s/[\x00-\x08\x7F-\xFF\e]/sprintf("&%03o",ord($1))/eg;

  return $text;
}

sub clean_arg {
  local($_) = @_;
  # Un-Webify plus signs and %-encoding
  tr/+/ /;
  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;

  # Remove extra spaces
  s/^\s+//g;
  s/\s+$//g;
  s/\015\012/\012/;  # end of line conversion
  s/\015/\012/;

  return( $_ );
}

# --- read arguments ---

# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

foreach $pair ( split(/&/, $buffer) ) {
  ($name, $value) = split(/=/, $pair, 2 );
  $FORM{&clean_arg($name)} = &clean_arg($value);
}
# --- Check the Arguments ---
$| = 1;   # auto-flush

if ( $BOOK_OWNER !~ /^\w+/ || ! -f $BOOK_FILE || ! -w _ ) {
  print "Content-type: text/html\n\n";
  print "<HEAD><TITLE>Guest Book - Form Error</TITLE></HEAD>\n",
        "<BODY><H1>Guest Book - Form Error</H1>\n",
        "Something is wrong with the current setup of this guestbook.\n",
        "Most likely this problem is one of the following :-\n<MENU>\n",
        "<LI>The Form `action' URL did not include the guestbook owner<BR>\n",
        "    EG:  &lt;FORM ACTION=\"/cgi-bin/guestbook?owner\"&gt;\n",
        "<LI>The owner string contains bad charcaters or is not a user\n",
        "<LI>Does not have a writable guestbook file or home page\n",
        "</MENU><P>\n",
        "The following is the programs documentation (such as it is)\n",
        &docs, "\n",
        "Please contact the guestbook owner to get this fixed. <P>\n\n";
  &address;
}

$FORM{'name'} =~ s/s*<.*>\s*//sg;
$FORM{'mail'} =~ s/\s*\(none\)\s*//;
$FORM{'mail'} =~ s/\s*unregistered\s*//;

if( $FORM{"name"} eq "" || $FORM{"mail"} !~ /^[\w-.]+\@[\w-.]+$/ ) {
  print "Content-type: text/html\n\n";
  print "<HEAD><TITLE>Guest Book - Entry Error</TITLE></HEAD>\n",
        "<BODY><H1>Guest Book - Entry Error</H1>\n",
        "You must enter your name and a valid mail address to be included\n",
        "in the guestbook. <P>\n";
  &address;
}

if( $FORM{"url"} !~ /^\w+:\/\// || $FORM{"url"} =~ /[?&"'<>]/  ) {
  print "Content-type: text/html\n\n";
  print "<HEAD><TITLE>Guest Book - Entry Error</TITLE></HEAD>\n",
        "<BODY><H1>Guest Book - Entry Error</H1>\n",
        "Your given URL does not appear to be a valid URL! <BR>\n";
        "If you don't have a personal homepage, then just leave that\n";
        "field blank. CGI scripts are not permitted as a home page URL. <P>\n";
  &address;
}

# --- Open Guestbook (with lock?) ---
if( $FLAG ne "REV" ) {
  # just tack the signiture onto the end of the file
  if( ! open(BOOK, ">>$BOOK_FILE") ) {
    print "Content-type: text/html\n\n";
    print "<HEAD><TITLE>Guest Book - Update Error</TITLE></HEAD></HEAD>\n",
          "<BODY><H1>Guest Book - Update Error</H1>\n",
          "The guest book file was not able to be updated. <P>\n\n",
          "Please contact the guestbook owner to get this fixed. <P>\n\n";
    &address;
  }
} else {
  # add signature just after the insert point
  if( ! open(GBOOK, "+<$BOOK_FILE") ) {  # open READ/write
    print "Content-type: text/html\n\n";
    print "<HEAD><TITLE>Guest Book - Update Error</TITLE></HEAD></HEAD>\n",
          "<BODY><H1>Guest Book - Update Error</H1>\n",
          "The guestbook file could not be opened READ/write. <P>\n\n",
          "Please contact the guestbook owner to get this fixed. <P>\n\n";
    &address;
  }
  &lock(GBOOK, 'W');   # wait for an write lock on guestbook
  if( ! open(BOOK, "+>$TMP_FILE") ) {   # open read/WRITE (truncated)
    &lock(GBOOK, 'U'); # unlock guestbook
    close(GBOOK);
    print "Content-type: text/html\n\n";
    print "<HEAD><TITLE>Guest Book - Update Error</TITLE></HEAD></HEAD>\n",
          "<BODY><H1>Guest Book - Update Error</H1>\n",
          "Unable to open read/WRITE temporary guestbook. <P>\n\n",
          "This is a system fault as should not have happened. <P>\n\n";
    &address;
  }
  # find the insert point
  while( <GBOOK> ) {
    print BOOK $_;
    last if /$INSERT_REXP/i;
  }
  print BOOK "$INSERT_POINT\n"  unless /$INSERT_REXP/i;
}

# --- Add the Guestbook Entry ---
print BOOK "\n";
if( $FORM{"url"} ne "" ) {
  print BOOK "<A HREF=\"$FORM{'url'}\">\n<B>", &htmlize_text($FORM{'name'}),
        "</B></A>, &lt;", &htmlize_text($FORM{'mail'}), "&gt; -- $DATE\n";
} else {
  print BOOK "<B>", &htmlize_text($FORM{'name'}), "</B>, &lt;",
        &htmlize_text($FORM{'mail'}), "&gt; -- $DATE\n";
}
if( $FORM{"comment"} ne "" ) {
  print BOOK "<BR>``",&htmlize_text($FORM{'comment'}),"''\n";
}
print BOOK "<P>\n";

# --- Close/Unlock Guestbook ---
if( $FLAG ne "REV" ) {
  close BOOK;
} else {
  # copy rest of the guest book
  while( <GBOOK> ) {
    print BOOK $_;
  }
  # rewind both file pointers
  seek(GBOOK, 0, 0);
  seek(BOOK, 0, 0);
  truncate(GBOOK, 0);  # empty GBOOK (incase it gets smaller -- NOT!)
  # copy the infomation back
  while(<BOOK>) {
    print GBOOK $_;
  }
  # finalize the guestbook update
  &lock(GBOOK, 'U');  # Unlock file
  close(GBOOK);
  close(BOOK);
  unlink $TMP_FILE;
}

# --- mail the result ---
open (MAIL, "|-")  or exec $MAIL_PROG, $OWNER_MAIL  or exit(1);
print MAIL
    "To: $OWNER_MAIL\n",
    "Reply-To: $FORM{'mail'} ($FORM{'name'})\n",
    "Subject: WWW Guestbook Signed\n\n",
    "The following person signed your guestbook\n",
    "-----------------------------------------------------------\n",
    "   Signed by : $FORM{'name'}, <$FORM{'mail'}>\n",
    $FORM{'url'} ne ""     ? "   HomePage URL : $FORM{'url'}\n"    : "",
    $FORM{'comment'} ne "" ? "   Comment : ``$FORM{'comment'}''\n" : "",
    "-----------------------------------------------------------\n",
    "Remote host:        $ENV{'REMOTE_HOST'}\n",
    "Remote IP address:  $ENV{'REMOTE_ADDR'}\n",
    "Http Request from:  $ENV{'HTTP_FROM'}\n";
close (MAIL);

# --- Report success ---
#If a Jump URL was given jump to it.
if ( defined $FORM{'jump_url'} ) {
  &jump_url($FORM{'jump_url'});
}

# Default "no-jump" result output
print "Content-type: text/html\n\n";
print "<HEAD><TITLE>Guest Book - Thank You</TITLE></HEAD>\n",
      "<BODY><H1>Thank You!</H1>\n",
      "I have entered the following into the guestbook:<BR>\n",
      "   Signed by : ", &htmlize_text($FORM{'name'}), " &lt;",
      &htmlize_text($FORM{'mail'}), "&gt;<BR>\n",
      $FORM{'url'} ne ""     ? "   HomePage URL : $FORM{'url'}<BR>\n"   : "",
      $FORM{'comment'} ne "" ?
         "   Comment : ``". &htmlize_text($FORM{'comment'}). "''<BR>\n" : "",
      "<P>\n\n";
&address;