Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#! /bin/env raku
use v6.*;
use API::Discord;
use IRC::Client;
use Shell::Piping;
use uniname-words; # We need to force a precomp to help Restricted.rakumod .
sub infix:<␣>(\l, \r) { l ~ ' ' ~ r }
constant term:<> = $?NL;
# On Discord bots are tied to user accounts. Control over bots can not be
# transfered. There are teams on Discord similiar to orgs on github. Not sure
# if control can be shared via those. A bot has to be invited to a server by
# the "owner" of that server. Ofc, Discord Inc. owns everything but they are
# willing to give you a crown. timotimo is involed so he should be able to help
# you to get the bot invited or take ownership of the bot and give you the
# keys.
#
# Messages can be updated on Discord. This script takes that into account.
#
# Usernames on discord have to be unique. They achive this by adding /'#' \d ** # 4/
# to usernames. This script follows suit.
# Setting up a bot is explained here:
# https://www.howtogeek.com/364225/how-to-make-your-own-discord-bot/
# https://discord.com/developers/applications/853712446660673566/information
# raku-bot-dev https://discord.com/oauth2/authorize?client_id=855866121503375370&scope=bot&permissions=68608
# my $*discord-channels = '#general#raku';
# my $*discord-channels = '#-raku-irc#-raku-dev-irc#-moarvom-irc#-webring-irc';
multi sub augment(Discord::Channel \s) {
s does role :: {
method Str { # ~ self.name }
}
}
multi sub augment(%author where { .<discriminator>:exists }, API::Discord:D $discord) {
$discord.get-user(%author<id>) does role :: {
method Str { self.username ~ '#' ~ self.discriminator }
}
}
multi sub augment(API::Discord::User $user) {
$user does role :: {
method Str { self.username ~ '#' ~ self.discriminator }
}
}
multi sub augment(|c) {
c
}
my &guilds = sub { [] }
my &discord-channels = sub { [] }
my &irc-send-message = sub (Str:D $channel, Str:D $message) { }
my &discord-user = sub ($id) { '<users not know yet>' }
constant all-channels := none();
sub discord-log-stream($token = %*ENV<DISCORD_TOKEN> // $*discord-token, Mu:D :$channels is copy = %*ENV<DISCORD_CHANNELS> // $*discord-channels // all-channels) {
my $discord = API::Discord.new(:$token);
my $result = Supplier::Preserving.new;
$channels = $channels.split('#').&{ any( .cache.grep(/^ '-'/)».subst(/^ '-'/).none, .grep(/^ <-[-]>/).any) }
$discord.connect;
# await $discord.ready;
start react {
whenever $discord.ready {
note "Logged in as { $discord.user.username }.";
&guilds = sub { $discord.guilds.values }
&discord-channels = sub { $discord.channels.values }
&discord-user = sub ($id) { $discord.get-user($id).&augment }
}
whenever $discord.messages -> $message {
# next unless $channels ~~ $message.channel.name;
$result.emit: [ $message.channel.&augment, $message.author.&augment, $message.content ];
}
whenever $discord.events -> $event {
if $event<t> eq 'MESSAGE_UPDATE' {
my $m = $event<d>;
my $channel = $discord.get-channel($m<channel_id>).&augment;
my $author = $m<author>.&augment($discord);
# next unless $channels ~~ $channel.name;
$result.emit: [ $channel, $author, $m<content>, :update ];
}
}
# FIXME
# whenever signal(SIGINT) {
# $result.done()
# }
{
use API::Discord::Debug;
whenever debug-say().merge(debug-print()) {
when HEARTBEAT { }
when CONNECTION { note now.DateTime.Str, ' ', $_ }
default {}
}
}
CATCH { default { warn .^name.Str } }
}
$result.Supply
}
my regex identifier {
<[a..z A..Z 0..9 . -]>+
}
sub irc-bridge-stream(*@channels where { .all ~~ /<identifier>+ '#' <identifier>/}, :$irc-bot-nick) {
my \irc-messages = Supplier::Preserving.new;
for @channels.map({ m/(<identifier>) '#' (<identifier>)/.list».Str }).classify(*.[0], :as(*.[1])) -> Pair (:key($server), :value(@channels)) {
start IRC::Client.new(:host($server), :channels('#' «~« @channels), :nick($irc-bot-nick), :plugins(
class {
has $.current-nick;
method irc-privmsg-channel ($_){ irc-messages.emit: [.server.host, .channel.subst(/^ '#'/, ''), .nick, .text]; Nil }
method irc-connected($self) {
note connected to {$self.server.host} as {$self.args[0]};
&irc-send-message = sub (Str:D $channel, Str:D $message) {
$self.irc.send: :where($channel) :text($message);
}
Nil
}
})
).run;
}
irc-messages.Supply
}
sub merge-spammers(Supply:D() $in --> Supply:D) {
my $out := Supplier::Preserving.new;
start react {
my @buffer;
my $flush := Supplier.new;
whenever $in -> @a {
@buffer.push: @a;
Promise.in(5).then: { $flush.emit: True }
}
whenever $flush {
next unless @buffer;
my @result;
while +@buffer {
my $left = @buffer.shift;
if +@buffer {
my $right = @buffer.head;
if $left[2] eq $right[2] {
@buffer.shift;
$left = [ |$left[0,1,2], ($left[3].starts-with(¶) ?? $left[3] !!~ $left[3]) ~~ $right[3] ];
@buffer.unshift: $left;
} else {
@result.push: $left;
}
} else {
@result.push: $left;
}
}
$out.emit: .item for @result;
@buffer = [];
}
}
$out.Supply
}
sub MAIN(:$discord-token, :$*prefix = '.') {
my %cfg = load-config($*prefix.IO.add('.discord-raku-bot.cfg'));
my $*discord-token = $discord-token // %cfg<discord><token>;
my $irc-bot-nick = %cfg<irc><nick>;
my $discord-server-name = %cfg<discord><servername>;
my $discord-bot-nick = %cfg<discord><nick>;
my $discord-client-id = %cfg<discord><clientid>;
my @discord-bridge-channels = %cfg<discord><bridge><channels>.split(' ');
my @irc-bridge-channels = %cfg<irc><channels>.split(' ');
my $start-time = now;
say "invite with: https://discord.com/oauth2/authorize?client_id=$discord-client-id&scope=bot&permissions=68608";
%*ENV<RAKUDO_ERROR_COLOR> = 0;
%*ENV{%*ENV.grep(/^ SSH/)».key}:delete;
constant $response-max-chars = 1990;
multi sub postfix:<minute>(Numeric() \seconds) { seconds * 60 }
multi sub postfix:<minutes>(Numeric() \seconds) { seconds * 60 }
multi sub postfix:<hour>(Numeric() \seconds) { seconds * 3600 }
multi sub postfix:<hours>(Numeric() \seconds) { seconds * 3600 }
multi sub postfix:<day>(Numeric() \seconds) { seconds * 86400 }
multi sub postfix:<days>(Numeric() \seconds) { seconds * 86400 }
start react whenever Supply.interval(1day) {
note taking snapshot;
use Perl6::Compiler:from<NQP>;
sub compress(Str() $file-name) { run «lz4 -BD --rm -qf $file-name» }
my $filename = 'raku-bot-' ~ now.DateTime.&{ .yyyy-mm-dd ~ '-' ~ .hh-mm-ss } ~ '.mvmheap';
Perl6::Compiler.profiler-snapshot(kind => "heap", filename => $filename<>);
$filename.&compress;
note done;
}
react {
whenever discord-log-stream() -> [ $channel, $username, $message is rw, :$update = False ] {
next without $message;
if $channel eq @discord-bridge-channels.any {
say 'bot speaking' if $username eq $discord-bot-nick;
# if $message ~~ / '<@!' (\d+) '>' / {
# try put '@' ~ discord-user($0.Str);
# }
try $message ~~ s/ '<@!' (\d+) '>' /{ '@' ~ discord-user($0.Str) }/;
my @lines = $message.Str.split(¶, :skip-empty);
irc-send-message($channel.Str.subst(/'-irc' $/, ''), <$username>.Str) for @lines;
next unless $channel eq '#raku-beginner'
}
if $message ~~ / 'use' \s+ 'nqp' / {
$channel.send-message: 'Malicious intend detected! Orbital strike authorised.';
next
}
$message = "m: $0" if $channel eq '#raku-beginner' && $message ~~ / ^ '<' \w+ '>' \s 'm:' (.*?) $ /;
$message = "m: $0" if $message ~~ / ^ 'm:```' (.*?) '```' $ /;
if $message ~~ / ^ 'm:' \s (.+) / -> Match (Str() $code, *@) {
$code |» (px«raku -Ilib -M Test -M Restricted»:timeout(10)) |» my @response :stderr(my @stderr);
my $response = @response.push(|@stderr[*;1]).join(¶);
$response = $response.substr(0..$response-max-chars) if $response.chars ≥ $response-max-chars;
$response = "```\n" ~ $response ~ "```" ~ ($response.chars ≥ $response-max-chars ?? '' !! '');
$channel.send-message: $response;
CATCH {
when X::Shell::NonZeroExitcode { $channel.send-message: "```\n" ~ @stderr[*;1].join(¶) ~ "```" }
default { $channel.send-message: "```\n" ~ .^name.message ~ "```"; }
}
next
}
if $message ~~ / '<@!' $discord-client-id '>' \s+ 'report' / {
'say $*RAKU.compiler.version' |» px<raku> |» my @response :stderr(my @stderr);
try $channel.send-message: "```\n" ~ @response.join(¶) ~ @stderr.join(¶) ~ "```";
next
}
if $message ~~ / '<@!' $discord-client-id '>' \s+ 'restart' / {
done;
}
if $message ~~ / '<@!' $discord-client-id '>' \s+ 'help' / {
my $response = q:to/EOH/;
m: my $s = "single line"; say $s;
m:`​``
my $s = "multi line";
say $s;
`​``
@raku-bot restart
EOH
try $channel.send-message: "```\n" ~ $response ~ "```";
next
}
}
whenever irc-bridge-stream(@irc-bridge-channels, :$irc-bot-nick).&merge-spammers.&limit-rate -> [$irc-server, $irc-channel, $irc-user, $message, *%_]{
# whenever irc-bridge-stream(<irc.libera.chat#gfldex-bot-test>, :$irc-bot-nick).&merge-spammers.&limit-rate -> [$irc-server, $irc-channel, $irc-user, $message, *%_]{
next if $irc-user eq $irc-bot-nick;
my $discord-channel = $irc-channel eq 'raku-beginner' ?? $irc-channel !! $irc-channel ~ '-irc';
with discord-channels.grep({ .guild.name eq $discord-server-name && .name eq $discord-channel}).head {
.send-message: <*$irc-user*> ␣ $message;
}
}
}
}
sub load-config(IO::Path() $path --> Hash) {
my %hash;
for $path.slurp.lines { m:g/ ^ \s* <?-[#]> ([ \w || <[-.]> ]+) \s* '=' \s* (.*) $ {
if $0.contains('.') {
%hash{||$0.split('.')} = $1.Str
} else {
%hash{$0.Str} = $1.Str
}
} /; }
%hash
}
sub limit-rate(Supply $in, $per-seconds = 1 --> Supply:D) {
my $out = Supplier::Preserving.new;
start react whenever $in -> \value {
$out.emit: value;
sleep(1 / $per-seconds);
}
$out.Supply;
}
# vim: expandtab shiftwidth=4
sub EXPORT {
die Malicious intend detected! Orbital strike authorised.;
}
use uniname-words;
constant $stdin-text = qq:to/EOH/;
I ♥ Raku!
1 22 333 4444 55555 6565656
3.14159265358979323846264338327950288419716939937510582097494459
A line with the number 42.
We may need some "quotes".
A backslash \\
would be nice too.
\c[END OF TEXT]
EOH
sub fake-lines {
gather .take for $stdin-text.split("\n");
}
sub fake-slurp(|) {
fake-lines
}
sub fake-stdin(|) {
$*IN = class :: is IO::Handle {
has @.lines = $stdin-text.split("\n");
method lines { gather { while @!lines { take shift @!lines } } }
method nl-in(|) { }
method chomp(|) { }
method encoding(|) { }
method IO { self }
method open { self }
method get { shift @!lines }
}.new;
}
sub fake-get(|) {
$*IN.get
}
sub EXPORT {
IO::Path.^can('new')[0].wrap( -> | { die 'Restricted in evalbot.' });
Proc::Async.^can('new')[0].wrap( -> | { die 'Restricted in evalbot.' });
fake-stdin;
Map.new:
'&slurp' => &fake-slurp,
'&lines' => &fake-lines,
'&get' => &fake-get,
'&uniname-words' => &uniname-words
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment