Implement guestbook

.gitignore

@@ -37,3 +37,8 @@ inc/
 
 # Visitor counter
 /.counts
+
+# Guestbook dotfiles
+/.mmCreds.xml
+/.msg.bans
+/.name.bans

cgi-bin/guest_mm.cgi

@@ -0,0 +1,212 @@
+#!/usr/bin/env perl
+
+# Guestbook CGI Program
+# Daniel Bowling <swaggboi@slackware.uk>
+# Sep 2020
+
+use strict;
+use warnings;
+use utf8;
+use open qw{:std :utf8}; # Fix "Wide character in print" warning
+use CGI qw{-utf8};       # Needed to parse unicode params
+use CGI::Carp qw{fatalsToBrowser};
+use XML::LibXML;
+use WebService::Mattermost;
+#use Data::Dumper;        # Uncomment for debugging
+
+## Variables ##
+
+# Create CGI object (query)
+my $q = CGI->new();
+
+# Open banned phrases file
+open(my $thoughtCrimes, '.msg.bans') or die "$@";
+# Open banned users file
+open(my $nameBans, '.name.bans')     or die "$@";
+
+# Get creds file
+my $dotfile = ".mmCreds.xml";
+# Create XML::LibXML object
+my $dom = XML::LibXML->load_xml(location => $dotfile);
+# Grab the values from creds file
+my $user = $dom->findnodes('/credentials/username')->to_literal();
+my $pass = $dom->findnodes('/credentials/password')->to_literal();
+my $url  = $dom->findnodes('/credentials/base_url')->to_literal();
+my $chan = $dom->findnodes('/credentials/channel_id')->to_literal();
+my $spam = $dom->findnodes('/credentials/spam_chan_id')->to_literal();
+# Put the values into place
+my %conf = (
+    authenticate => 1,
+    username     => "$user",
+    password     => "$pass",
+    base_url     => "$url"
+    );
+# Create new WebService::Mattermost objects (mm && resource)
+my $mm       = WebService::Mattermost->new(%conf);
+my $resource = $mm->api->posts;
+
+## Functions ##
+
+# Print the form
+sub form_out {
+    # Begin printing the form
+    print $q->div(
+        {-class => "inner"},
+
+        # Little bit of text
+        $q->p("Use the form below to sign the guestbook and send
+              SwaggNet a message. Please be patient after submitting
+              as messages are checked for spam via cutting-edge
+              Swagg::AI blockchain techmology."),
+        "\n", # Newlines to make it pretty
+
+        # Opening form tag
+        $q->start_form(
+            -name   => 'main',
+            -method => 'POST'
+        ), "\n",
+
+        # Opening table tag
+        $q->start_table(), "\n",
+
+        # Name field
+        $q->Tr(
+            $q->th("Name:"),
+            $q->td(
+                $q->textfield(
+                    -name => "name",
+                    -size => 40
+                )
+            )
+        ), "\n",
+
+        # Location field
+        $q->Tr(
+            $q->th("Location:"),
+            $q->td(
+                $q->textfield(
+                    -name => "location",
+                    -size => 40
+                )
+            )
+        ), "\n",
+
+        # Message box
+        $q->Tr(
+            $q->th("Message:"),
+            $q->td(
+                $q->textarea(
+                    -name    => "message",
+                    -columns => 50,
+                    -rows    => 10
+                )
+            )
+        ), "\n",
+
+        # Submit button
+        $q->Tr(
+            $q->th('&nbsp;'), # Non-breaking space
+            $q->td($q->submit(-value => "Submit"))
+        ), "\n",
+
+        # Closing table tag
+        $q->end_table(), "\n",
+
+        # Closing form tag
+        $q->end_form(), "\n"
+        ) . "\n";
+}
+
+# Process params & say thanks
+sub params_in {
+    # Params to variables
+    my $name     = $q->param("name");
+    my $location = $q->param("location");
+    my $message  = $q->param("message");
+
+    # Enforce max length for params
+    if (length($name) < 1 || (length($name) >= 40)) {
+        die "Name field must be between 1 and 40 characters\n"
+    } elsif (length($location) < 1 || length($location) >= 40) {
+        die "Location field must be between 1 and 40 characters\n"
+    } elsif (length($message) < 1 || length($message) >= 1900) {
+        die "Message field must be between 1 and 1900 characters\n"
+    }
+    
+    # Variable set for banned user
+    my $ban;
+
+    # Parse the banned names list
+    chomp(my @nameBan = <$nameBans>);
+    for (@nameBan) {
+        last     if $ban  == 1; 
+        $ban = 1 if $name =~ /$_/;
+    }
+    
+    # Parse the banned phrases list
+    chomp(my @thoughtCrime = <$thoughtCrimes>);
+    for (@thoughtCrime) {
+        last     if $ban     == 1;
+        $ban = 1 if $message =~ /$_/;
+    }
+
+    # Send it unless ban is true; else send it to spam if spam chan is
+    # defined
+    unless ($ban) {
+        $resource->create(
+            {
+                channel_id => "$chan",
+                message    => "$name from $location says: $message"
+            }
+            );
+    } elsif ($spam) {
+        $resource->create(
+            {
+                channel_id => "$spam",
+                message    => "$name from $location says: $message"
+            }
+            );
+    }
+
+    # Say thanks (even if banned, e.g. shadow ban)
+    print $q->div(
+        {-class => "inner"},
+        $q->h2("Thanks!"),
+        $q->p("Your note has been sent, thanks for using the
+              guestbook.")
+        ) . "\n";
+}
+
+## Begin script ##
+
+# Print header
+print $q->header(-charset => 'UTF-8');
+
+# Print the head & title, begin the body
+print $q->start_html(
+    -title => 'SwaggNet Guestbook',
+    -style => '/css/swagg.css'
+    );
+
+# Heading
+print $q->div(
+    {-class => "outer"},
+    $q->h1("Swagg::Net Guestbook"),
+    $q->br(),
+    "\n"
+    ) . "\n";
+
+# Process returned params if present; else print form
+($q->param()) ? params_in() : form_out();
+
+# Print link to go back to homepage in footer
+print $q->div(
+    {-class => "inner"},
+    $q->br(),
+    "<footer>Go back to", # CGI.pm doesn't have footer tag?
+    $q->a({-href => "/"}, "homepage"),
+    "</footer>\n"         # Closing footer tag
+    );
+
+# Close body
+print $q->end_html() . "\n";

templates/index.html.ep

@@ -90,6 +90,17 @@
 <div class="outer">
   +--------------------------+<br>
 </div>
+<div class="inner" id="guest">
+  <p>Please sign the guestbook and let SwaggNet know what you <em>really</em>
+    think.</p>
+  <a href="/cgi-bin/guest.cgi">
+    <img alt="Sign the Guestbook!" src="/Pictures/guest.gif">
+  </a>
+</div>
+<br>
+<div class="outer">
+  +--------------------------+<br>
+</div>
 <div class="inner">
   <p>You are visitor number <%= $count %>.</p>
 </div>

www-swagg.pl

@@ -40,6 +40,9 @@ get '/' => sub {
 # Deprecation of IE page
 get '/die';
 
+# guest.cgi script
+plugin CGI => ['/cgi-bin/guest' => './cgi-bin/guest_mm.cgi'];
+
 get '/me';
 
 get '/news';