Browse Source

Add pushover login alerts for registered users

Oliver Youle 3 years ago
parent
commit
e06262347a

+ 1 - 3
bin/mumble-bot

@@ -4,6 +4,4 @@ use strictures 2;
 
 use MumbleBot;
 
-my $bot = MumbleBot->new;
-
-$bot->start;
+MumbleBot->new->connect;

+ 18 - 4
etc/mumble-bot/config.yml

@@ -1,6 +1,20 @@
-auth:
+server:
+  hostname: ''
+  port: 64738
   username: 'MumbleBot'
   password: ''
-servers:
-  - hostname: ''
-    port: 64738
+databases:
+  read_write:
+    hostname: ''
+    port: 3306
+    username: ''
+    password: ''
+  read_only:
+    hostname: ''
+    port: 3306
+    username: ''
+    password: ''
+pushover:
+  key: ''
+  endpoint: 'https://api.pushover.net/1/messages.json'
+  cooldown: 120

+ 9 - 39
lib/MumbleBot.pm

@@ -5,11 +5,9 @@ use strictures 2;
 use Moo;
 
 use Carp;
-use LWP::UserAgent;
 use POSIX qw(uname);
-use Try::Tiny;
-use YAML::XS qw(LoadFile);
 
+use MumbleBot::Config;
 use MumbleBot::Client;
 use MumbleBot::Event::Manager;
 use MumbleBot::State;
@@ -34,37 +32,9 @@ has 'config' => (
 sub _build_config {
     my $self = shift;
 
-    try {
-        my $config = LoadFile($self->CONFIG_FILE);
-
-        croak "Missing 'servers' key"
-            unless exists $config->{servers};
-        croak "Server entry list is not an array"
-            unless ref $config->{servers} eq 'ARRAY';
-
-        foreach my $server (@{ $config->{servers} }) {
-            foreach my $key (qw(hostname port)) {
-                croak "Missing required key '$key' in server list entry"
-                    unless exists $server->{$key};
-            }
-        }
-
-        croak "Missing 'auth' key"
-            unless exists $config->{auth};
-        croak "Auth entry list is not a map"
-            unless ref $config->{auth} eq 'HASH';
-
-        foreach my $key (qw(username password)) {
-            croak "Missing required key '$key' in auth entry"
-                unless exists $config->{auth}->{$key};
-        }
-
-        return $config;
-    }
-    catch {
-        croak "Failed to load config from "
-            . $self->CONFIG_FILE . ": $_";
-    };
+    return MumbleBot::Config->new(
+        source => $self->CONFIG_FILE,
+    );
 }
 
 has 'client' => (
@@ -111,14 +81,14 @@ sub BUILD {
     our $instance = $self;
 }
 
-sub start {
+sub connect {
     my $self = shift;
-    
-    my $server = $self->config->{servers}->[0];
+
+    my $config = $self->config->server;
 
     $self->client->connect(
-        address => $server->{hostname},
-        port    => $server->{port},
+        address => $config->{hostname},
+        port    => $config->{port},
     );
 }
 

+ 31 - 0
lib/MumbleBot/Client/Packet/Handler/UserRemove.pm

@@ -0,0 +1,31 @@
+package MumbleBot::Client::Packet::Handler::UserRemove;
+
+use strictures 2;
+
+use Moo;
+
+with 'MumbleBot::Client::Packet::Handler';
+
+use MumbleBot::Client::Packet::Type;
+
+around BUILDARGS => sub {
+    my ($orig, $class, %args) = @_;
+
+    $args{type} = MumbleBot::Client::Packet::Type::USER_REMOVE;
+
+    return $class->$orig(%args);
+};
+
+sub handle {
+    my ($self, $packet) = @_;
+
+    my $bot = MumbleBot->instance;
+
+    my $user = $bot->state->user(
+        id => $packet->payload->{session},
+    );
+
+    $bot->state->remove_user($user);
+}
+
+1;

+ 15 - 2
lib/MumbleBot/Client/Packet/Handler/UserState.pm

@@ -8,6 +8,7 @@ with 'MumbleBot::Client::Packet::Handler';
 
 use MumbleBot::Client::Packet::Type;
 use MumbleBot::Event::UserJoinEvent;
+use MumbleBot::State::RegisteredUser;
 use MumbleBot::State::User;
 
 around BUILDARGS => sub {
@@ -32,7 +33,7 @@ sub handle {
         # TODO update existing fields
     }
     else {
-        $user = MumbleBot::State::User->new(
+        my %args = (
             id             => $payload->{session},
             name           => $payload->{name},
             is_mute        => $payload->{mute} || $payload->{self_mute} || $payload->{suppress},
@@ -42,10 +43,22 @@ sub handle {
             is_priority    => $payload->{priority_speaker},
             is_recording   => $payload->{recording},
             _channel_id    => $payload->{channel_id} || 0,
-            _registered_id => $payload->{user_id},
         );
+
+        my $user;
+        if ($payload->{user_id}) {
+            $user = MumbleBot::State::RegisteredUser->new(
+                _id => $payload->{user_id},
+                %args,
+            );
+        } else {
+            $user = MumbleBot::State::User->new(%args);
+        }
+
         $bot->state->add_user($user);
 
+        return unless $bot->state->bot_user;
+
         $bot->event->dispatch(
             MumbleBot::Event::UserJoinEvent->new(
                 user => $user,

+ 176 - 0
lib/MumbleBot/Command/Pushover.pm

@@ -0,0 +1,176 @@
+package MumbleBot::Command::Pushover;
+
+use strictures 2;
+
+use Moo;
+
+with 'MumbleBot::Command';
+
+use HTML::Table;
+use Try::Tiny;
+
+around BUILDARGS => sub {
+    my ($orig, $class, %args) = @_;
+
+    $args{name} = 'pushover';
+
+    return $class->$orig(%args);
+};
+
+sub execute {
+    my ($self, $channel, $sender, @args) = @_;
+
+    unless (ref $sender eq 'MumbleBot::State::RegisteredUser') {
+        $sender->send_message(
+            "You must be a registered user to run this command.",
+        );
+        return;
+    }
+
+    unless (@args) {
+        $sender->send_message(
+            "Missing arguments, see '/mb help pushover' for more info.",
+        );
+        return;
+    }
+
+    my $command = shift @args;
+    if ($command eq 'add') {
+        $self->_add($sender, @args);
+    }
+    elsif ($command eq 'remove') {
+        $self->_remove($sender, @args);
+    }
+    elsif ($command eq 'list') {
+        $self->_list($sender, @args);
+    }
+    else {
+        $sender->send_message(
+            "Unrecognised argument '$command', see"
+                . "'/mb help pushover' for more info.",
+        );
+    }
+}
+
+sub help_text {
+    my $self = shift;
+}
+
+sub _add {
+    my ($self, $sender, $name, $key) = @_;
+
+    unless ($name) {
+        $sender->send_message(
+            "Missing device name, see '/mb help pushover for more info.",
+        );
+        return;
+    }
+    unless ($key) {
+        $sender->send_message(
+            "Missing device key, see '/mb help pushover for more info.",
+        );
+        return;
+    }
+
+    if (length $name > 128) {
+        $sender->send_message(
+            "Device name too long, max length is 128 characters.",
+        );
+        return;
+    }
+
+    if ($key !~ /^[0-9a-z]{30}$/i) {
+        $sender->send_message(
+            "Device key is invalid.",
+        );
+        return;
+    }
+
+    if ($self->_device_exists($sender, $name)) {
+        $sender->send_message(
+            "You already have a device added under '$name'.",
+        );
+        return;
+    }
+
+    try {
+        $sender->add_pushover_device($name, $key);
+        $sender->send_message(
+            "Device added successfully.",
+        );
+    }
+    catch {
+        $sender->send_message(
+            "Error adding device: $_",
+        );
+    };
+}
+
+sub _remove {
+    my ($self, $sender, $name) = @_;
+
+    unless ($name) {
+        $sender->send_message(
+            "Missing device name, see '/mb help pushover for more info.",
+        );
+        return;
+    }
+
+    if (!$self->_device_exists($sender, $name)) {
+        $sender->send_message(
+            "No devices found with name '$name'.",
+        );
+        return;
+    }
+
+    try {
+        $sender->remove_pushover_device($name);
+        $sender->send_message(
+            "Device removed successfully",
+        );
+    }
+    catch {
+        $sender->send_message(
+            "Error removing device: $_",
+        );
+    };
+}
+
+sub _list {
+    my ($self, $sender) = @_;
+
+    my @devices = @{ $sender->pushover_devices };
+
+    unless (@devices) {
+        $sender->send_message(
+            "You have no pushover devices.<br><br>"
+                . "See '/mb pushover add' to add some.",
+        );
+        return;
+    }
+
+    my $table = HTML::Table->new(-head => ['Name', 'Key']);
+    foreach my $device (@devices) {
+        $table->addRow(
+            $device->{name},
+            $device->{key},
+        );
+    }
+
+    $sender->send_message(
+        "Your devices:<br>" . $table->getTable,
+    );
+}
+
+sub _device_exists {
+    my ($self, $sender, $name) = @_;
+
+    my @devices = @{ $sender->pushover_devices };
+    foreach my $device (@devices) {
+        return 1 if $device->{name} eq $name;
+    }
+
+    return 0;
+}
+
+1;

+ 117 - 0
lib/MumbleBot/Config.pm

@@ -0,0 +1,117 @@
+package MumbleBot::Config;
+
+use strictures 2;
+
+use Moo;
+
+use Carp;
+use Try::Tiny;
+use YAML::XS qw(LoadFile);
+
+has 'pushover' => (
+    is => 'rwp',
+);
+
+has 'source' => (
+    is => 'ro',
+    required => 1,
+);
+
+has 'server' => (
+    is => 'rwp',
+);
+
+has '_databases' => (
+    is => 'rw',
+);
+
+sub BUILD {
+    my $self = shift;
+
+    try {
+        my $data = LoadFile($self->source);
+
+        $self->_set_pushover($self->_load_pushover($data));
+
+        $self->_set_server($self->_load_server($data));
+
+        $self->_databases($self->_load_databases($data));
+    }
+    catch {
+        croak "Failed to load config from "
+            . $self->source . ": $_";
+    };
+}
+
+sub database {
+    my ($self, $database) = @_;
+
+    croak "No config found for database '$database'"
+        unless exists $self->_databases->{$database};
+
+    return $self->_databases->{$database};
+}
+
+sub _load_pushover {
+    my ($self, $data) = @_;
+
+    croak "Missing 'pushover' key"
+        unless exists $data->{pushover};
+    croak "Pushover details are not a map"
+        unless ref $data->{pushover} eq 'HASH';
+
+    my $p = $data->{pushover};
+
+    my $config = {};
+    foreach my $key (qw(key endpoint cooldown)) {
+        croak "Missing required key '$key' in pushover entry"
+            unless exists $p->{$key};
+        $config->{$key} = $p->{$key};
+    }
+
+    return $config;
+}
+
+sub _load_server {
+    my ($self, $data) = @_;
+
+    croak "Missing 'server' key"
+        unless exists $data->{server};
+    croak "Server details are not a map"
+        unless ref $data->{server} eq 'HASH';
+
+    my $s = $data->{server};
+
+    my $config = {};
+    foreach my $key (qw(username password hostname port)) {
+        croak "Missing required key '$key' in server entry"
+            unless exists $s->{$key};
+        $config->{$key} = $s->{$key};
+    }
+
+    return $config;
+}
+
+sub _load_databases {
+    my ($self, $data) = @_;
+
+    croak "Missing 'databases' key"
+        unless exists $data->{databases};
+    croak "Database list is not a map"
+        unless ref $data->{databases} eq 'HASH';
+
+    my $d = $data->{databases};
+
+    my $config = {};
+    foreach my $database (keys %$d) {
+        foreach my $key (qw(username password hostname port)) {
+            croak "Missing required key '$key' in database list entry '$database'"
+                unless exists $d->{$database}->{$key};
+            $config->{$database}->{$key} = $d->{$database}->{$key};
+        }
+    }
+
+    return $config;
+}
+
+1;

+ 33 - 0
lib/MumbleBot/Database.pm

@@ -0,0 +1,33 @@
+package MumbleBot::Database;
+
+use strictures 2;
+
+use Moo;
+
+extends 'Exporter';
+
+our @EXPORT_OK = qw(dbi);
+
+use Carp;
+use DBI;
+
+sub dbi {
+    my $handle = shift;
+
+    croak "No handle given" unless $handle;
+
+    my $config = MumbleBot->instance->config->database($handle);
+
+    my $dbh = DBI->connect(
+        'dbi:mysql:database=mumblebot;'
+            . "host=$config->{hostname};"
+            . "port=$config->{port}",
+        $config->{username},
+        $config->{password},
+        { RaiseError => 1 },
+    ) or croak $DBI::errstr;
+
+    return $dbh;
+}
+
+1;

+ 3 - 3
lib/MumbleBot/Event/Handler/Connect.pm

@@ -39,12 +39,12 @@ sub on_event {
     ));
 
     # Attempt to authenticate with the server
-    my $conf = $bot->config;
+    my $conf = $bot->config->server;
     $bot->client->send(MumbleBot::Client::Packet->new(
         type => MumbleBot::Client::Packet::Type::AUTHENTICATE,
         payload => {
-            username => $conf->{auth}->{username},
-            password => $conf->{auth}->{password},
+            username => $conf->{username},
+            password => $conf->{password},
         },
     ));
 

+ 93 - 0
lib/MumbleBot/Event/Handler/LoginAlert.pm

@@ -0,0 +1,93 @@
+package MumbleBot::Event::Handler::LoginAlert;
+
+use strictures 2;
+
+use Moo;
+
+with 'MumbleBot::Event::Handler';
+
+use LWP::UserAgent;
+use JSON::XS;
+
+use MumbleBot::Database qw(dbi);
+use MumbleBot::Event::Priority;
+
+has 'ua' => (
+    is => 'ro',
+    default => sub {
+        LWP::UserAgent->new
+    },
+);
+
+has '_alerts' => (
+    is => 'ro',
+    default => sub { {} },
+);
+
+around BUILDARGS => sub {
+    my ($orig, $class, %args) = @_;
+
+    $args{event}    = 'UserJoinEvent';
+    $args{priority} = MumbleBot::Event::Priority::NORMAL;
+
+    return $class->$orig(%args);
+};
+
+sub on_event {
+    my ($self, $event) = @_;
+
+    my $user = $event->user;
+
+    return unless ref $user eq 'MumbleBot::State::RegisteredUser';
+
+    if (exists $self->_alerts->{$user->name}) {
+        my $secs = time() - $self->_alerts->{$user->name};
+        return if $secs < MumbleBot->instance->config->pushover->{cooldown};
+    }
+
+    $self->_alerts->{$user->name} = time();
+    
+    my $dbh = dbi('read_only');
+    my $user_keys = $dbh->selectall_arrayref(q{
+        SELECT u.name, d.`key`
+        FROM user u
+        JOIN pushover_device d
+            ON u.id = d.user_id
+    }, { Slice => {} }) || [];
+
+    foreach my $row (@$user_keys) {
+        next if $event->user->name eq $row->{name};
+
+        $self->ua->request(
+            $self->_build_request(
+                $event->user,
+                $row->{key},
+            )
+        );
+    }
+}
+
+sub _build_request {
+    my ($self, $user, $key) = @_;
+
+    my $bot = MumbleBot->instance;
+    my $conf = $bot->config->pushover;
+
+    my $users_online = $bot->state->users_online;
+
+    return HTTP::Request->new(
+        POST => $conf->{endpoint}, [
+            'Content-Type' => 'application/json'
+        ],
+        encode_json({
+            token   => $conf->{key},
+            user    => $key,
+            title   => $user->name . " joined the server.",
+            message => $users_online
+                . ($users_online > 1 ? ' users' : ' user')
+                . ' online.',
+        }),
+    );
+}
+
+1;

+ 32 - 0
lib/MumbleBot/Event/Handler/UpdateLastLogin.pm

@@ -0,0 +1,32 @@
+package MumbleBot::Event::Handler::UpdateLastLogin;
+
+use strictures 2;
+
+use Moo;
+
+with 'MumbleBot::Event::Handler';
+
+use DateTime;
+
+use MumbleBot::Event::Priority;
+
+around BUILDARGS => sub {
+    my ($orig, $class, %args) = @_;
+
+    $args{event} = 'UserJoinEvent';
+    $args{priority} = MumbleBot::Event::Priority::HIGH;
+
+    return $class->$orig(%args);
+};
+
+sub on_event {
+    my ($self, $event) = @_;
+
+    my $user = $event->user;
+
+    return unless ref $user eq 'MumbleBot::State::RegisteredUser';
+
+    $user->last_login(DateTime->now);
+}
+
+1;

+ 1 - 0
lib/MumbleBot/Event/Handler/YouTubeLink.pm

@@ -7,6 +7,7 @@ with 'MumbleBot::Event::Handler';
 use Carp;
 use HTML::TreeBuilder;
 use Image::Magick;
+use LWP::UserAgent;
 use MIME::Base64;
 use Try::Tiny;
 

+ 17 - 0
lib/MumbleBot/State.pm

@@ -117,9 +117,26 @@ sub user {
     return;
 }
 
+sub users_online {
+    my $self = shift;
+
+    my $bot_user = $self->bot_user;
+
+    my @names;
+    foreach my $user (values %{ $self->_users }) {
+        push @names, $user->name
+            unless $user->name eq $bot_user->name;
+    }
+
+    return @names;
+}
+
 sub bot_user {
     my $self = shift;
 
+    return undef
+        unless defined $self->_session_id;
+
     return $self->user(
         id => $self->_session_id,
     );

+ 118 - 0
lib/MumbleBot/State/RegisteredUser.pm

@@ -0,0 +1,118 @@
+package MumbleBot::State::RegisteredUser;
+
+use strictures 2;
+
+use Moo;
+
+extends 'MumbleBot::State::User';
+
+use DateTime::Format::Strptime;
+
+use MumbleBot::Database qw(dbi);
+
+has '_id' => (
+    is => 'ro',
+    required => 1,
+);
+
+has '_df' => (
+    is => 'ro',
+    default => sub {
+        DateTime::Format::Strptime->new(
+            pattern => '%Y-%m-%d %T',
+        )
+    },
+);
+
+sub BUILD {
+    my $self = shift;
+
+    my $dbh = dbi('read_write');
+
+    my ($exists) = $dbh->selectrow_array(q{
+        SELECT COUNT(*)
+        FROM user
+        WHERE id = ?
+    }, undef, $self->_id);
+
+    return if $exists;
+
+    $dbh->do(q{
+        INSERT INTO user (id, name)
+        VALUES (?, ?)
+    }, undef, $self->_id, $self->name);
+}
+
+sub last_login {
+    my ($self, $datetime) = @_;
+
+    if ($datetime) {
+        my $dbh = dbi('read_write');
+
+        $dbh->do(q{
+            UPDATE user
+            SET last_login = ?
+            WHERE id = ?
+        }, undef, $self->_df->format_datetime($datetime), $self->_id);
+    }
+    else {
+        my $dbh = dbi('read_only');
+
+        my ($last_login) = $dbh->selectrow_array(q{
+            SELECT last_login
+            FROM user
+            WHERE id = ?
+        }, undef, $self->_id);
+
+        return $self->_df->parse_datetime($last_login);
+    }
+}
+
+sub pushover_devices {
+    my $self = shift;
+
+    my $dbh = dbi('read_only');
+
+    my $rows = $dbh->selectall_arrayref(q{
+        SELECT *
+        FROM pushover_device
+        WHERE user_id = ?
+    }, { Slice => {} }, $self->_id);
+
+    my @devices;
+    foreach my $row (@$rows) {
+        push @devices, {
+            id   => $row->{id},
+            name => $row->{name},
+            key  => $row->{key},
+        };
+    }
+
+    return \@devices;
+}
+
+sub add_pushover_device {
+    my ($self, $name, $key) = @_;
+
+    my $dbh = dbi('read_write');
+
+    $dbh->do(q{
+        INSERT INTO pushover_device (`user_id`, `name`, `key`)
+        VALUES (?, ?, ?)
+    }, undef, $self->_id, $name, $key);
+}
+
+sub remove_pushover_device {
+    my ($self, $name) = @_;
+
+    my $dbh = dbi('read_write');
+
+    $dbh->do(q{
+        DELETE FROM pushover_device
+        WHERE user_id = ?
+            AND name = ?
+    }, undef, $self->_id, $name);
+}
+
+
+1;

+ 0 - 4
lib/MumbleBot/State/User.pm

@@ -51,10 +51,6 @@ has '_channel_id' => (
     required => 1,
 );
 
-has '_registered_id' => (
-    is => 'rw',
-);
-
 sub channel {
     my ($self, $channel) = @_;
 

+ 20 - 0
meta/schema.sql

@@ -0,0 +1,20 @@
+DROP TABLE IF EXISTS `pushover_device`;
+DROP TABLE IF EXISTS `user`;
+
+CREATE TABLE `user` (
+    `id` INT UNSIGNED NOT NULL,
+    `name` VARCHAR(128) NOT NULL UNIQUE,
+    `last_login` DATETIME DEFAULT NULL,
+    PRIMARY KEY (`id`)
+) ENGINE=InnoDB DEFAULT CHARSET=utf8;
+
+CREATE TABLE `pushover_device` (
+    `id` INT UNSIGNED NOT NULL AUTO_INCREMENT,
+    `user_id` INT UNSIGNED NOT NULL,
+    `name` VARCHAR(128) NOT NULL,
+    `key` CHAR(30) NOT NULL,
+    PRIMARY KEY (`id`),
+    FOREIGN KEY (`user_id`)
+        REFERENCES `user`(`id`)
+        ON DELETE CASCADE
+) ENGINE=InnoDB DEFAULT CHARSET=utf8;

+ 4 - 2
mumble-bot.spec

@@ -14,7 +14,9 @@ Requires: perl(LWP::UserAgent) perl(MIME::Base64) perl(Module::Find)
 Requires: perl(Mojo::IOLoop::Client) perl(Mojo::IOLoop::Stream) perl(Moo)
 Requires: perl(Moo::Role) perl(POSIX) perl(Scalar::Util) perl(YAML::XS)
 Requires: perl(LWP::Protocol::https) perl(Google::ProtocolBuffers)
-Requires: perl(Time::HiRes) perl(List::Util)
+Requires: perl(Time::HiRes) perl(List::Util) perl(DBI) perl(HTML::Table)
+Requires: perl(DateTime) perl(DateTime::Format::Strptime)
+Requires: perl(JSON::XS) perl(HTTP::Request) perl(DBD::mysql)
 
 BuildRequires: systemd
 
@@ -46,7 +48,7 @@ cp -a etc/mumble-bot/*.yml %{buildroot}%{_sysconfdir}/mumble-bot/
 %{_datarootdir}/perl5/vendor_perl/MumbleBot.pm
 %{_bindir}/mumble-bot
 %config(noreplace) %{_sysconfdir}/mumble-bot
-%{_unitdir}/mumble-bot.service
+%config(noreplace) %{_unitdir}/mumble-bot.service
 
 %post
 %systemd_post mumble-bot.service