swaggboi/www2.0
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

New guestbook

Browse source
This commit is contained in:
swagg boi 2022-01-11 20:59:27 -05:00
parent 0167bb0a51
commit d552a28ed9
3 changed files with 6 additions and 214 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

206
cgi-bin/guest_mm.cgi
View file

@ -10,209 +10,5 @@ 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(' '), # 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";
print CGI->redirect('https://guestbook.swagg.net');

2
cpanfile
View file

@ -4,5 +4,3 @@ requires 'Mojolicious';
requires 'Mojolicious::Plugin::CGI';
requires 'Number::Format';
requires 'Regexp::Common';
requires 'WebService::Mattermost', '>= 0.25';
requires 'XML::LibXML';

12
t/basic.t
View file

@ -13,20 +13,18 @@ my %guest_form = (
message => 'Ayy... lmao'
);
# GET Requests
# Routes
for my $route (@routes) {
$t->get_ok("/$route")->status_is(200)
}
# CGI Scripts
for my $script (qw{guest whoami}) {
$t->get_ok("/cgi-bin/$script.cgi")->status_is(200)
}
$t->get_ok('/cgi-bin/whoami.cgi')->status_is(200);
$t->get_ok('/cgi-bin/guest.cgi' )->status_is(302);
# ULA Tool
$t->get_ok('/ula6', form => {macaddr => 'ea:88:5e:3f:a3:34'})->status_is(200);
# POST Requests
$t->post_ok('/cgi-bin/guest.cgi', form => \%guest_form)->status_is(200);
# Resume files
$t->get_ok('/resume/dbowling-resume.odt')->status_is(200);
$t->get_ok('/resume/dbowling-resume.docx')->status_is(200);