Implement guestbook
This commit is contained in:
parent
e756ca6d6e
commit
f8f919dc37
5
.gitignore
vendored
5
.gitignore
vendored
|
|
@ -37,3 +37,8 @@ inc/
|
|||
|
||||
# Visitor counter
|
||||
/.counts
|
||||
|
||||
# Guestbook dotfiles
|
||||
/.mmCreds.xml
|
||||
/.msg.bans
|
||||
/.name.bans
|
||||
|
|
|
|||
212
cgi-bin/guest_mm.cgi
Executable file
212
cgi-bin/guest_mm.cgi
Executable file
|
|
@ -0,0 +1,212 @@
|
|||
#!/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(' '), # 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 == 1;
|
||||
$ban = 1 if $name =~ /$_/;
|
||||
}
|
||||
|
||||
# Parse the banned phrases list
|
||||
chomp(my @thoughtCrime = <$thoughtCrimes>);
|
||||
for (@thoughtCrime) {
|
||||
last if $ban == 1;
|
||||
$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";
|
||||
|
|
@ -90,6 +90,17 @@
|
|||
<div class="outer">
|
||||
+--------------------------+<br>
|
||||
</div>
|
||||
<div class="inner" id="guest">
|
||||
<p>Please sign the guestbook and let SwaggNet know what you <em>really</em>
|
||||
think.</p>
|
||||
<a href="/cgi-bin/guest.cgi">
|
||||
<img alt="Sign the Guestbook!" src="/Pictures/guest.gif">
|
||||
</a>
|
||||
</div>
|
||||
<br>
|
||||
<div class="outer">
|
||||
+--------------------------+<br>
|
||||
</div>
|
||||
<div class="inner">
|
||||
<p>You are visitor number <%= $count %>.</p>
|
||||
</div>
|
||||
|
|
|
|||
|
|
@ -40,6 +40,9 @@ get '/' => sub {
|
|||
# Deprecation of IE page
|
||||
get '/die';
|
||||
|
||||
# guest.cgi script
|
||||
plugin CGI => ['/cgi-bin/guest' => './cgi-bin/guest_mm.cgi'];
|
||||
|
||||
get '/me';
|
||||
|
||||
get '/news';
|
||||
|
|
|
|||
Loading…
Reference in a new issue