www2.0/cgi-bin/guest_mm.cgi

#!/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; 
        $ban = 1 if $name =~ /$_/;
    }
    
    # Parse the banned phrases list
    chomp(my @thoughtCrime = <$thoughtCrimes>);
    for (@thoughtCrime) {
        last     if $ban;
        $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";