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 and users files
open(my $thoughtCrimes, '.msg.bans') or die "$@";
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 %conf;
$conf{'authenticate'} = 1;
$conf{'username'}     = $dom->findvalue('/credentials/username');
$conf{'password'}     = $dom->findvalue('/credentials/password');
$conf{'base_url'}     = $dom->findvalue('/credentials/base_url');
my $chan              = $dom->findvalue('/credentials/channel_id');
my $spam              = $dom->findvalue('/credentials/spam_chan_id');
# 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, $trigger);

    # Parse the banned names list
    chomp(my @nameBan = <$nameBans>);
    for (@nameBan) {
        last if $ban; 

        if ($name =~ /$_/i) {
            $ban     = 1;
            $trigger = $_;
        }
    }
    
    # Parse the banned phrases list
    chomp(my @thoughtCrime = <$thoughtCrimes>);
    for (@thoughtCrime) {
        last if $ban;

        if ($message =~ /$_/i) {
            $ban     = 1;
            $trigger = $_;
        }
    }

    # 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\n\n" .
                              "Spam trigger: `$trigger`"
            }
            );
    }

    # 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";