#!/usr/bin/env perl # Guestbook CGI Program # Daniel Bowling # 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->findvalue('/credentials/username'); my $pass = $dom->findvalue('/credentials/password'); my $url = $dom->findvalue('/credentials/base_url'); my $chan = $dom->findvalue('/credentials/channel_id'); my $spam = $dom->findvalue('/credentials/spam_chan_id'); # 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(' '), # 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(), "\n" # Closing footer tag ); # Close body print $q->end_html() . "\n";