#!/usr/bin/perl

# Gbook 2006
# - Anti Spam
# - Includes admin function (delete/edit posts), also to link with AccesSite CMS

# Configuration is in gbook_config.pm:
do "gbook_config.pm";

# Anti SPAM:
# - give <input name=s> each time another name, based on a secret algorythm
# - check allowed/unallowed words
# - check referer
# - check field formats (ie Age fields only accepts numbers)

=pod
# view:
$html_head
(if)$sign_link
(if)$total_numer
$sepperator
@(entries)/@($sepperator)
$sepperator
(if)$displaying
(if)$view_older
(if)$view_newer
$html_foot

# sign
$html_head
Sign()
$html_foot

#preview
$html_head
$preview
$sepperator
Entry()
$sepperator
SubmitButtons()
$html_foot

=cut

# Signpage:  ?sign
# Adminpage: ?admin

use CGI; my %CGI = CGI::Vars();

my $logged_in = 0;
my ($total,$AS,@entries);
LoadGuestbook();
#print "\n\n";

if ($use_accessite) {
  eval "use lib \"$use_accessite/..\";use AccesSite;";
  $AS = new AccesSite(data_path => $accessite_data
    #, debug_to => *STDOUT
    );
  #my $user;
  my ($user,$headers) = $AS->Login();
  print "$headers";#\n\nUser='$user' - ($user->{name})\n\n";
  # = $AS->GetUser();
  foreach (@as_groups) {
    #print "$user->{name} InGroup($_)?\n\n";
    if ($user->InGroup($_)) {
      #print "Yes\n\n";
      $logged_in = $user->{name};
      #print "Logged in as '$logged_in'<br>";
      last;
      }
    }
}

if (lc($ENV{QUERY_STRING}) eq 'sign') {
  OutPutSignPage();
}
elsif ($CGI{action} eq 'preview') {
  Preview();
}
elsif ($CGI{action} eq 'sign') {
  SignBook();
}
elsif (lc($ENV{QUERY_STRING}) eq 'admin') {
  $CGI{admin} = 1;
}

my @deleted = ();
if ($CGI{admin} || $logged_in) {
  unless ($logged_in) {
    if ($use_accessite) {
      print "content-type: text/html\n".
        "pragma: no-cache\n".
        "expires: 0\n\n".
        $html_head;
      print <<"      FORM";
      <form action="$ENV{SCRIPT_NAME}" method=POST>
      <input type=hidden name=admin value=1>
        Username: <input type=text name=username><br>
        Password: <input type=password name=password><br>
        <input type=submit value=Login>
      </form>
      FORM
      print $html_foot;
      # AccesSite login page
      #$AS->SetInput('view','login');
      #print "\n\n".$AS->Auto();
      exit;
      }
    }
  $CGI{admin} = "&admin=1";
  if ($CGI{delete_entries}) {
    if ($logged_in || $CGI{password} eq $password) {
      foreach my $key (sort keys(%CGI)) {
        if ($key =~ /^delete_(\d+)$/) {
          my $i = $1;
          my $line = $i . $entries[$i-1];
          $line =~ s/\W//g;
          if ($CGI{"delete_$i"} eq $line) {
            #print "\n\n'".$CGI{"delete_$i"}."' eq '$line'<br>";
            push @deleted, $entries[$i-1];
            $entries[$i-1] = "";
            }
          }
        }
      if (@deleted) {
        # Re-write data
        open (OUTPUT, ">$datafile") || die "re-write $datafile: $!";
        foreach (@entries) {
          next if $_ eq "";
          print OUTPUT $_;
          }
        close OUTPUT;
        # Re-load data
        LoadGuestbook();
        }
      }
    else {
      print "content-type: text/html\n".
        "pragma: no-cache\n".
        "expires: 0\n\n".
        $html_head.
        "<b>You do not have permission to modify this guestbook.</b>".
        $html_foot;
      exit;
      }
    }
}
else {
  $CGI{admin} = "";
}

OutputGuestbook();

sub OutputGuestbook {
  local ($from,$to);
  $from = $CGI{sm};  # total = 98
  $from or $from = $total; # from = 88
  $from = $total if $from > $total;
  $to = $from - $max_messages + 1; # = 88 - 10 + 1 = 79
  $to = 1 if $to < 1;
  # = @entries;
  #$displaying = "Displaying message ~from~ to ~to~ of ~total~ total";
  $displaying =~ s/~from~/$from/gi;
  $displaying =~ s/~to~/$to/gi;
  $displaying =~ s/~total~/$total/gi;

  my $style = "style=\"background-color:#EEEEEE;border:1px solid #999999;".
              "padding:2px;font-color:black;font-size:10pt;font-family:sans-serif;\"";
  print "content-type: text/html\n".
        "pragma: no-cache\n".
        "expires: 0\n\n".
        $html_head;
  if ($sign_link) {
    print "<a href=\"$ENV{SCRIPT_NAME}?sign\">$sign_link</a>\n";
    }

  if ($CGI{admin}) {
    print <<"    FORM";
    <form action="$ENV{SCRIPT_NAME}" method=POST>
    <input type=hidden name=admin value=1>
    <input type=hidden name=delete_entries value=1>
    <br>
    <div $style>
    FORM
    if ($logged_in) {
      print "You are logged in as: <b>$logged_in</b>";
      }
    else {
      print "<b>Admin mode</b> Enter the password: <input type=password name=password>";
      }
    if (@deleted) {
      print "<br>Some entries have been deleted. Then are shown (for the last time) ".
            "above the regular guestbook:</div>";
      foreach my $entry (@deleted) {
        print "<br><div $style><b>Deleted:</b></div>\n";
        my ($name,$message,$age,$city,$email,$website,$date,$browser,$ip) = split(/\|/,$entry);
        chomp($ip);
        print Entry("N/A",$name,$age,$city,$email,$website,$message,$date,$ip,$browser);
        }
      print "<br><div $style>This is the end of deleted messages.</div><br><br>\n";
      }
    print "</div>\n";
    }

  if ($total_numer) {
    print "$total_numer: $total\n";
    }
  print "$sepperator";
  #@(entries)/@($sepperator)
  for (my $i = $from; $i >= $to; $i--) {
    #print "<b>$i</b><br>\n";
    #next if $entries[$i-1] eq "";
    my ($name,$message,$age,$city,$email,$website,$date,$browser,$ip) = split(/\|/,$entries[$i-1]);
    chomp($ip);
    if ($CGI{admin}) {
      my $line = $i . $entries[$i-1];
      $line =~ s/\W//g;
      print <<"      FORM";
      <div $style>
        <input type=checkbox name="delete_$i" value="$line" id="delete_$i">
        <label for="delete_$i">Delete this entry ($i)</label>
      </div>
      FORM
      }
    print Entry($i,$name,$age,$city,$email,$website,$message,$date,$ip,$browser);
    print "$sepperator";
    }
  if ($CGI{admin}) {
    print <<"    FORM";
    <div $style>
      <input type=submit value="Delete selected entries">
    </div>
    </form>
    FORM
    }

  if ($displaying) {
    print "$displaying\n";
    }
  if ($view_older) {
    if ($to > 1) {
      print "<a href=\"$ENV{SCRIPT_NAME}?sm=" . ($to - 1) . "$CGI{admin}\">$view_older</a>\n";
      }
    else {
      print "$view_older";
      }
    }
  print "$view_sepperator";
  if ($view_newer) {
    if ($from < $total) {
      print "<a href=\"$ENV{SCRIPT_NAME}?sm=" . ($from + $max_messages) . "$CGI{admin}\">$view_newer</a>\n";
      }
    else {
      print "$view_newer";
      }
    }
  print $html_foot;
  exit;
}


sub OutPutSignPage {
  my ($error,$name,$age,$city,$email,$website,$message) = @_;
  # Make up secret input name=s
  my ($code,@names) = GetNames();
  my $faker = pop(@names);
  #my $quarter = int(time / 1000);
  print "content-type: text/html\n".
        "pragma: no-cache\n".
        "expires: 0\n\n".
        $html_head.
        "<form method=POST action=\"$ENV{SCRIPT_NAME}\">\n".
        "<input type=hidden name=action value=preview>\n".
        "<input type=hidden name=$faker value=ok>\n".
        "\n".
        $code.
        Sign($error,$name,$age,$city,$email,$website,$message,@names).
        "</form>".
        $html_foot;
  exit;
}

sub Preview {
  # Check submission
  RefererCheck();
  my ($code,@names) = GetNames($CGI{k});
  if ($CGI{$names[6]} ne "ok") {
    Reject("6th CGI value ($names[6]) doesn't equal 'ok': $CGI{$names[6]}");
    }
  my %entry;
  ($entry{name},$entry{age},$entry{city},$entry{email},$entry{website},$entry{message}) =
  ($CGI{$names[0]},$CGI{$names[1]},$CGI{$names[2]},$CGI{$names[3]},$CGI{$names[4]},$CGI{$names[5]});
  my $error;
  my $counter = 0;
  foreach my $entry (keys(%entry)) {
    unless ($entry eq 'message') {
      $entry{$entry} =~ s/\n//g;
      $entry{$entry} =~ s/\cM//g;
      $entry{$entry} =~ s/\cM\n//g;
      }
    $entry{$entry} =~ s/\|/\//g;
    unless ($accept_html) {
      $entry{$entry} =~ s/&/&amp;/g;
      $entry{$entry} =~ s/</&lt;/g;
      $entry{$entry} =~ s/>/&gt;/g;
      $entry{$entry} =~ s/"/&quot;/g;
      }
    foreach (@forbidden_words) {
      my $count = $entry{$entry} =~ /$_/i;
      $counter += $count;
      last if $counter >= $reject_at;
      }
    last if $counter >= $reject_at;
    }
  #$entry{message} .= " $counter";
  if ($counter >= $reject_at) {
    Reject("Too many forbidden words ($counter) Reject at: $reject_at");
    }
  $counter = $entry{message} =~ /http:/;
  if ($counter > $allow_http) {
    Reject("Too many occurances of /http:/ ($counter) Allowed: $allow_http");
    }
  $error .= "<li>$fill_out &quot;$field_name&quot;</li>\n" if $require_name && $entry{name} eq "";
  $error .= "<li>$fill_out &quot;$field_age&quot;</li>\n" if $require_age && $entry{age} eq "";
  $error .= "<li>$fill_out &quot;$field_city&quot;</li>\n" if $require_city && $entry{city} eq "";
  $error .= "<li>$fill_out &quot;$field_email&quot;</li>\n" if $require_email && $entry{email} eq "";
  $error .= "<li>$fill_out &quot;$field_website&quot;</li>\n" if $require_website && $entry{website} eq "";
  $error .= "<li>$fill_out &quot;$field_message&quot;</li>\n" if $require_message && $entry{message} eq "";
  if ($error) {
    OutPutSignPage("<ul>$error</ul>",$entry{name},$entry{age},$entry{city},$entry{email},$entry{website},$entry{message});
    }
  $entry{website} =~ s/^http:\/\///gi;
  # Then already create the date
  #   0    1    2     3     4    5     6     7     8
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  $year += 1900;
  my $time = sprintf("%02d:%02d",$hour,$min);
  if (lc($date_format) eq "english") {
    $entry{date} = "$days[$wday] $months[$mon] $mday $year, $at $time";
    }
  else {
    $entry{date} = "$days[$wday] $mday $months[$mon] $year, $at $time";
    }
  $entry{message} =~ s/\cM\n/\n/g;
  $entry{message} =~ s/\n/ <br> /g;
  if ($expand_html) {
    my @words = split (/ /,$entry{message});
    foreach $word (@words) {
      if ($word =~ /^http:\/\//) {
        $word = "<a href=\"$word\" target=\"_blank\">".substr($word,7)."</a>";
        }
      elsif (!$accept_html && $word =~ /.*\@.*\..*/){
        $word = "<a href=\"mailto:$word\">$word</a>";
        }
      elsif ($word =~ /^www\./){
        $word = "<a href=\"http://$word\" target=\"_blank\">$word</a>";
        }
      }
    $entry{message} = join(" ",@words);
    }
=pod
        "Name: $names[0]: $CGI{$names[0]}<br>\n".
        "Age: $names[1]: $CGI{$names[1]}<br>\n".
        "City: $names[2]: $CGI{$names[2]}<br>\n".
        "Email: $names[3]: $CGI{$names[3]}<br>\n".
        "Website: $names[4]: $CGI{$names[4]}<br>\n".
        "Message: $names[5]: $CGI{$names[5]}<br>\n";
=cut

  ($code,@names) = GetNames();
  #my $quarter = int(time / 1000);
  print "content-type: text/html\n".
        "pragma: no-cache\n".
        "expires: 0\n\n".
        $html_head.
        "<form method=POST action=\"$ENV{SCRIPT_NAME}\">\n".
        "<input type=hidden name=action value=sign>\n";
  my @els = qw(name age city email website message date);
  for (my $i = 0; $i < 7; $i++) {
    my $value = $entry{$els[$i]};
    $value =~ s/&/&amp;/g;
    $value =~ s/</&lt;/g;
    $value =~ s/>/&gt;/g;
    $value =~ s/"/&quot;/g;
    print "<input type=hidden name=$names[$i] value=\"$value\">\n";
    }
  print $code.
        $preview.
        $sepperator.
        Entry(($total+1),$entry{name},$entry{age},$entry{city},$entry{email},$entry{website},$entry{message},$entry{date},$ENV{REMOTE_ADDR},$ENV{HTTP_USER_AGENT}).
        $sepperator.
        SubmitButtons().
        "</form>".
        $html_foot;
  exit;
}

sub SignBook {
  RefererCheck();
  my ($code,@names) = GetNames($CGI{k});
  if ($CGI{$names[6]} eq "") {
    Reject("6th CGI value ($names[6]) equals '': $CGI{$names[6]}");
    }
  #my %entry;
  #($entry{name},$entry{age},$entry{city},$entry{email},$entry{website},$entry{message},$entry{date}) =
  my @input = ($CGI{$names[0]},$CGI{$names[5]},$CGI{$names[1]},$CGI{$names[2]},$CGI{$names[3]},$CGI{$names[4]},$CGI{$names[6]},$ENV{HTTP_USER_AGENT},$ENV{REMOTE_ADDR});
  foreach (@input) {
    $_ =~ s/\cM\n//g;
    $_ =~ s/\n//g;
    $_ =~ s/\r//g;
    $_ =~ s/\|/\//g;
    }
  open (OUTPUT, ">>$datafile") || die "write $datafile: $!";
  print OUTPUT join("|",@input)."\n";
  close OUTPUT;

  if ($notify_mail) {
    my $email = $CGI{$names[3]};
    unless ($email) {
      $notify_mail =~ /^([^,]+)/;
      $email = $1;
      }
    if (open(MAIL, "$sendmail")) {# -s -t")) {
      print MAIL "To: $notify_mail\n";
      print MAIL "From: $email\n";
      print MAIL "Subject: New entry in $guestbook_name\n";
      print MAIL "Content-type: text/html\n\n";
      print MAIL <<"      MESSAGE";
      <a href="http://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}">$guestbook_name</a>
      $sepperator
      MESSAGE
      print MAIL Entry(($total+1),$CGI{$names[0]},$CGI{$names[1]},$CGI{$names[2]},$CGI{$names[3]},
                       $CGI{$names[4]},$CGI{$names[5]},$CGI{$names[6]},$ENV{REMOTE_ADDR},
                       $ENV{HTTP_USER_AGENT});
      print MAIL "$sepperator\n\n";
      close MAIL;
      }
    }

  print "Location: $ENV{SCRIPT_NAME}?x=".time()."\n".
        "Content-type: text/html\n\n".
        "<html><head><meta http-equiv=\"Refresh\" content=\"0; ".
        "URL=$ENV{SCRIPT_NAME}?x=".time()."\"></head><body>OK</body></html>\n";
  exit;
}

sub Reject {
  my ($why) = @_;
  print "status: 403 Forbidden\n\nYour entry is marked as SPAM. Please go away.\n";
  # log:
  if ($spamlog) {
    if (open (SPAMLOG, ">>$spamlog")) {
      my $time = time();
      print SPAMLOG "$time\t".localtime($time)."\t$why\t";
      foreach (qw(HTTP_REFERER HTTP_USER_AGENT REMOTE_ADDR QUERY_STRING)) {
        print SPAMLOG "\t$_=$ENV{$_}";
        }
      print SPAMLOG "\tCGI:";
      foreach (sort keys(%CGI)) {
        $CGI{$_} =~ s/\n/\\n/g;
        print SPAMLOG "\t$_=$CGI{$_}";
        }
      print SPAMLOG "\n";
      }
    }
  exit;
}

sub RefererCheck {
  unless ($ENV{HTTP_REFERER} =~ /$ENV{SCRIPT_NAME}/ &&
          ($ENV{HTTP_REFERER} =~ /$ENV{SERVER_NAME}/ ||
           $ENV{HTTP_REFERER} =~ /$ENV{HTTP_HOST}/
          )) {
    Reject("RefererCheck failed");
    }
}

sub GetNames {
  my ($key) = @_;
  $key or $key = int(rand() * 1000);
  $key =~ /(\d)$/;
  my $adder   = $1;
  $adder++;
  my $quarter = int(time / 1000);
  my @names;# = (qw(A B C D E F));
  foreach (qw(A B C D E F G)) {
    my $sum = ($quarter * $key * $adder);
    $sum =~ /(\d\d\d\d\d)$/;
    push @names, $_.$1;
    $adder += $adder;
    }
  my $code = <<"  SCRIPT";
  <script language="JavaScript">
    <!--
    document.write("<" + "input ty" + "pe=hid" + "den nam" +
                   "e=k valu" + "e=$key>");
    // -->
  </script>
  SCRIPT
  return ($code,@names);
}

sub LoadGuestbook {
  open (INPUT, "$datafile") || die "read $datafile: $!";
  @entries = (<INPUT>);
  close INPUT;
  $total = @entries;
}