From d552a28ed9cc08a5c46d7be2baf207533bb712b4 Mon Sep 17 00:00:00 2001 From: swaggboi Date: Tue, 11 Jan 2022 20:59:27 -0500 Subject: [PATCH] New guestbook --- cgi-bin/guest_mm.cgi | 206 +------------------------------------------ cpanfile | 2 - t/basic.t | 12 ++- 3 files changed, 6 insertions(+), 214 deletions(-) diff --git a/cgi-bin/guest_mm.cgi b/cgi-bin/guest_mm.cgi index c130773..5b918e0 100755 --- a/cgi-bin/guest_mm.cgi +++ b/cgi-bin/guest_mm.cgi @@ -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(), - "\n" # Closing footer tag - ); - -# Close body -print $q->end_html() . "\n"; +print CGI->redirect('https://guestbook.swagg.net'); diff --git a/cpanfile b/cpanfile index 6a20d91..d641ebf 100644 --- a/cpanfile +++ b/cpanfile @@ -4,5 +4,3 @@ requires 'Mojolicious'; requires 'Mojolicious::Plugin::CGI'; requires 'Number::Format'; requires 'Regexp::Common'; -requires 'WebService::Mattermost', '>= 0.25'; -requires 'XML::LibXML'; diff --git a/t/basic.t b/t/basic.t index 2974e27..84c2301 100644 --- a/t/basic.t +++ b/t/basic.t @@ -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);