From 6792541f17bfe6d25dc937717b77fdbae8daf931 Mon Sep 17 00:00:00 2001 From: Adam Malone Date: Mon, 27 Apr 2026 22:59:13 -0700 Subject: [PATCH] v4.0.0: Fix NMDCClient login, separate commands, add OPChat - NMDCClient.pm: Fix login flow to handle $HubName before $GetPass/$Hello - Separate commands into commands_v4/ modules (coin, roll, time, 8ball, rr, lasercats) - dragon.pl rewritten with modular command loader and auto-discovery - opchat.pl: Standalone OP group chat bot using NMDCClient + GatewayClient - Tell delivery and watcher notifications handled by gateway, not Dragon Co-Authored-By: Claude Opus 4.6 (1M context) --- NMDCClient.pm | 56 ++++--- commands_v4/coin.pm | 14 ++ commands_v4/lasercats.pm | 26 ++++ commands_v4/magic_8ball.pm | 24 +++ commands_v4/roll.pm | 20 +++ commands_v4/russianroulette.pm | 27 ++++ commands_v4/time.pm | 14 ++ dragon.pl | 239 +++++++++++------------------ opchat.pl | 271 +++++++++++++++------------------ 9 files changed, 365 insertions(+), 326 deletions(-) create mode 100644 commands_v4/coin.pm create mode 100644 commands_v4/lasercats.pm create mode 100644 commands_v4/magic_8ball.pm create mode 100644 commands_v4/roll.pm create mode 100644 commands_v4/russianroulette.pm create mode 100644 commands_v4/time.pm diff --git a/NMDCClient.pm b/NMDCClient.pm index 79f417d..afd1f36 100644 --- a/NMDCClient.pm +++ b/NMDCClient.pm @@ -73,37 +73,49 @@ sub connect { $self->_send("\$Key $key|"); $self->_send("\$ValidateNick $self->{nick}|"); - # Read response — might be $Hello, $GetPass, or $ValidateDenide - my $response = $self->_read_message(5); - if (!$response) { - $logger->error("No response after ValidateNick"); - $self->disconnect(); - return 0; - } - - # Handle password request - if ($response =~ /\$GetPass/) { - if ($self->{password}) { - $self->_send("\$MyPass $self->{password}|"); - $response = $self->_read_message(5); - } else { - $logger->error("Hub requires password but none configured"); + # Read messages until we get $Hello, $GetPass, or $ValidateDenide. + # The hub may send $HubName, welcome, etc. first. + my $logged_in = 0; + my $attempts = 0; + while ($attempts < 20) { + my $response = $self->_read_message(5); + last unless defined $response; + $attempts++; + + if ($response =~ /\$GetPass/) { + if ($self->{password}) { + $self->_send("\$MyPass $self->{password}|"); + # Continue reading for $Hello or $BadPass + next; + } else { + $logger->error("Hub requires password but none configured"); + $self->disconnect(); + return 0; + } + } + elsif ($response =~ /\$ValidateDenide/) { + $logger->error("Nick validation denied by hub"); $self->disconnect(); return 0; } + elsif ($response =~ /\$BadPass/) { + $logger->error("Bad password for $self->{nick}"); + $self->disconnect(); + return 0; + } + elsif ($response =~ /\$Hello\s+\Q$self->{nick}\E/) { + $logged_in = 1; + last; + } + # Ignore $HubName, , $Supports, $NickList, etc. } - if ($response =~ /\$ValidateDenide/) { - $logger->error("Nick validation denied by hub"); + unless ($logged_in) { + $logger->error("Login failed after $attempts messages"); $self->disconnect(); return 0; } - # Should have $Hello at this point (possibly in the response) - unless ($response =~ /\$Hello\s+\Q$self->{nick}\E/) { - $logger->warn("Expected \$Hello, got: $response (continuing anyway)"); - } - # Send our info $self->_send("\$Version 1,0091|"); $self->_send("\$GetNickList|"); diff --git a/commands_v4/coin.pm b/commands_v4/coin.pm new file mode 100644 index 0000000..f6b0a22 --- /dev/null +++ b/commands_v4/coin.pm @@ -0,0 +1,14 @@ +package commands_v4::coin; +use strict; use warnings; + +sub name { 'coin' } +sub aliases { () } +sub help { '!coin — Flip a coin' } + +sub run { + my ($from_nick, $args, $client, $gateway) = @_; + my @options = ('Heads!', 'Tails!'); + return $options[int(rand(2))]; +} + +1; diff --git a/commands_v4/lasercats.pm b/commands_v4/lasercats.pm new file mode 100644 index 0000000..1616b54 --- /dev/null +++ b/commands_v4/lasercats.pm @@ -0,0 +1,26 @@ +package commands_v4::lasercats; +use strict; use warnings; + +sub name { 'lasercats' } +sub aliases { () } +sub help { '!lasercats — PEW PEW PEW (also kicks you)' } + +sub run { + my ($from_nick, $args, $client, $gateway) = @_; + $client->send_chat(' /\_/\ PEW PEW PEW'); + $client->send_chat(' ( o.o ) ----======='); + $client->send_chat(' > ^ <'); + # Kick the invoker (tradition!) + eval { + my $ua = $gateway->{ua}; + my $url = "$gateway->{base_url}/api/v1/users/$from_nick/kick"; + my $req = HTTP::Request->new(POST => $url); + $req->header('Content-Type' => 'application/json'); + $req->header('X-API-Key' => $gateway->{api_key}); + $req->content('{"reason":"LASERCATS PEW PEW PEW"}'); + $ua->request($req); + }; + return undef; # already sent +} + +1; diff --git a/commands_v4/magic_8ball.pm b/commands_v4/magic_8ball.pm new file mode 100644 index 0000000..558c452 --- /dev/null +++ b/commands_v4/magic_8ball.pm @@ -0,0 +1,24 @@ +package commands_v4::magic_8ball; +use strict; use warnings; + +sub name { 'magic_8ball' } +sub aliases { ('8ball') } +sub help { '!8ball — Ask the Magic 8 Ball' } + +my @ANSWERS = ( + "It is certain.", "It is decidedly so.", "Without a doubt.", + "Yes definitely.", "You may rely on it.", "As I see it, yes.", + "Most likely.", "Outlook good.", "Yes.", "Signs point to yes.", + "Reply hazy, try again.", "Ask again later.", + "Better not tell you now.", "Cannot predict now.", + "Concentrate and ask again.", "Don't count on it.", + "My reply is no.", "My sources say no.", + "Outlook not so good.", "Very doubtful.", +); + +sub run { + my ($from_nick, $args, $client, $gateway) = @_; + return $ANSWERS[int(rand(scalar @ANSWERS))]; +} + +1; diff --git a/commands_v4/roll.pm b/commands_v4/roll.pm new file mode 100644 index 0000000..3929f60 --- /dev/null +++ b/commands_v4/roll.pm @@ -0,0 +1,20 @@ +package commands_v4::roll; +use strict; use warnings; + +sub name { 'roll' } +sub aliases { () } +sub help { '!roll [NdS] — Roll dice (e.g. !roll 2d6)' } + +sub run { + my ($from_nick, $args, $client, $gateway) = @_; + my ($count, $sides) = ($args =~ /^(\d+)?d(\d+)$/i); + $count ||= 1; $sides ||= 6; + $count = 10 if $count > 10; + $sides = 1000 if $sides > 1000; + my @rolls = map { int(rand($sides)) + 1 } 1..$count; + my $total = 0; $total += $_ for @rolls; + return sprintf("%s rolled %dd%d: %s (total: %d)", + $from_nick, $count, $sides, join(', ', @rolls), $total); +} + +1; diff --git a/commands_v4/russianroulette.pm b/commands_v4/russianroulette.pm new file mode 100644 index 0000000..03ce133 --- /dev/null +++ b/commands_v4/russianroulette.pm @@ -0,0 +1,27 @@ +package commands_v4::russianroulette; +use strict; use warnings; + +sub name { 'russianroulette' } +sub aliases { ('rr') } +sub help { '!rr — Play Russian roulette (1/6 chance of kick)' } + +sub run { + my ($from_nick, $args, $client, $gateway) = @_; + if (int(rand(6)) == 0) { + $client->send_chat("*BANG* $from_nick is dead!"); + # Kick via gateway API + eval { + my $ua = $gateway->{ua}; + my $url = "$gateway->{base_url}/api/v1/users/$from_nick/kick"; + my $req = HTTP::Request->new(POST => $url); + $req->header('Content-Type' => 'application/json'); + $req->header('X-API-Key' => $gateway->{api_key}); + $req->content('{"reason":"Russian roulette"}'); + $ua->request($req); + }; + return undef; # already sent + } + return "*click* $from_nick survives!"; +} + +1; diff --git a/commands_v4/time.pm b/commands_v4/time.pm new file mode 100644 index 0000000..4ceccdb --- /dev/null +++ b/commands_v4/time.pm @@ -0,0 +1,14 @@ +package commands_v4::time; +use strict; use warnings; +use POSIX qw(strftime); + +sub name { 'time' } +sub aliases { () } +sub help { '!time — Show current UTC time' } + +sub run { + my ($from_nick, $args, $client, $gateway) = @_; + return strftime("Current time: %Y-%m-%d %H:%M:%S UTC", gmtime); +} + +1; diff --git a/dragon.pl b/dragon.pl index f6f6876..d72e31d 100644 --- a/dragon.pl +++ b/dragon.pl @@ -1,20 +1,19 @@ #!/usr/bin/perl #-------------------------- -# Dragon (ODCHBot v4) — Standalone NMDC Client +# Dragon (ODCHBot v4) — Standalone NMDC Client Bot # -# Connects to the hub as a regular DC client. +# Connects to the hub as a regular DC user. # Appears in the user list. Calls Gateway API for data. -# Optional add-on for fun commands, external integrations, and plugins. +# Commands live in commands_v4/ as separate .pm modules. #-------------------------- use strict; use warnings; use FindBin; use lib "$FindBin::Bin"; +use lib "$FindBin::Bin/commands_v4"; use Log::Log4perl qw(:levels); -use YAML::AppConfig; -use POSIX qw(strftime); use NMDCClient; use GatewayClient; @@ -42,13 +41,22 @@ # ----------------------------------------------------------------------- # Load config # ----------------------------------------------------------------------- -my $config_file = "$FindBin::Bin/odchbot.yml"; -die "Config not found: $config_file\n" unless -f $config_file; -my $app_config = YAML::AppConfig->new(file => $config_file); -my $config = $app_config->config(); +my $config; +eval { + require YAML::AppConfig; + my $config_file = "$FindBin::Bin/odchbot.yml"; + die "Config not found: $config_file\n" unless -f $config_file; + my $app_config = YAML::AppConfig->new(file => $config_file); + $config = $app_config->config(); +}; +if ($@) { + $logger->error("Config load failed: $@"); + die $@; +} my $hub_config = $config->{hub} || {}; my $gw_config = $config->{gateway} || {}; +my $nick = $hub_config->{nick} || 'Dragon'; # ----------------------------------------------------------------------- # Initialize Gateway client @@ -58,96 +66,80 @@ api_key => $gw_config->{bot_api_key} || '', ); -# Register with gateway — discover commands from handle_command dispatch -# plus any loaded command modules. Gateway disables its built-in handlers -# for commands Dragon claims. -my $nick = $hub_config->{nick} || 'Dragon'; - -$logger->info("Registered with gateway as $nick"); - # ----------------------------------------------------------------------- -# Load command modules +# Load command modules from commands_v4/ # ----------------------------------------------------------------------- -my %commands; -my $cmd_path = $config->{config}{commandPath} || 'commands'; -my $cmd_dir = "$FindBin::Bin/$cmd_path"; +my %commands; # name => module package +my %aliases; # alias => name +my $cmd_dir = "$FindBin::Bin/commands_v4"; if (-d $cmd_dir) { opendir(my $dh, $cmd_dir) or $logger->warn("Cannot open $cmd_dir: $!"); if ($dh) { - for my $file (readdir $dh) { + for my $file (sort readdir $dh) { next unless $file =~ /^(\w+)\.pm$/; - my $name = $1; - eval { - require "$cmd_dir/$file"; - $commands{$name} = 1; - $logger->debug("Loaded command: $name"); - }; + my $modname = "commands_v4::$1"; + eval { require "$cmd_dir/$file"; }; if ($@) { - $logger->warn("Failed to load command $name: $@"); + $logger->warn("Failed to load command $1: $@"); + next; + } + my $name = eval { $modname->name() } || $1; + $commands{$name} = $modname; + # Register aliases + my @al = eval { $modname->aliases() }; + for my $a (@al) { + $aliases{$a} = $name; } + $logger->debug("Loaded command: $name"); } closedir $dh; } } -$logger->info("Loaded " . scalar(keys %commands) . " command modules"); +$logger->info("Loaded " . scalar(keys %commands) . " commands: " . join(', ', sort keys %commands)); -# Auto-discover commands: built-in handlers + loaded command modules -my @dragon_commands = ('coin', 'roll', 'time', 'magic_8ball', '8ball', - 'russianroulette', 'rr', 'lasercats'); -push @dragon_commands, keys %commands; -$gateway->register($nick, @dragon_commands); -$logger->info("Registered with gateway as $nick, claiming " . scalar(@dragon_commands) . " commands"); +# Register with gateway — declare all commands Dragon handles +my @all_cmds = (keys %commands, keys %aliases); +$gateway->register($nick, @all_cmds); +$logger->info("Registered with gateway as $nick, claiming " . scalar(@all_cmds) . " commands"); # ----------------------------------------------------------------------- # Connect to hub # ----------------------------------------------------------------------- -my $client = NMDCClient->new( - host => $hub_config->{host} || '127.0.0.1', - port => $hub_config->{port} || 4012, - nick => $nick, - password => $hub_config->{password} || '', - description => $hub_config->{description} || 'Hub Bot', - email => $hub_config->{email} || '', - tag => "", - speed => 'LAN(T1)', - - on_chat => sub { - my ($from_nick, $message) = @_; - handle_chat($from_nick, $message); - }, - - on_pm => sub { - my ($from_nick, $message) = @_; - handle_pm($from_nick, $message); - }, - - on_join => sub { - my ($joined_nick) = @_; - handle_join($joined_nick); - }, - - on_quit => sub { - my ($quit_nick) = @_; - handle_quit($quit_nick); - }, -); +my $client; + +sub create_client { + $client = NMDCClient->new( + host => $hub_config->{host} || '127.0.0.1', + port => $hub_config->{port} || 4012, + nick => $nick, + password => $hub_config->{password} || '', + description => $hub_config->{description} || 'Hub Bot', + email => $hub_config->{email} || '', + tag => "", + speed => 'LAN(T1)', + + on_chat => sub { handle_chat(@_) }, + on_pm => sub { handle_pm(@_) }, + on_join => sub { handle_join(@_) }, + on_quit => sub { handle_quit(@_) }, + ); +} # ----------------------------------------------------------------------- # Main loop with reconnect # ----------------------------------------------------------------------- my $reconnect_delay = 5; +create_client(); while (1) { if ($client->connect()) { $reconnect_delay = 5; $logger->info("Connected and logged in as $nick"); - # Main event loop while ($client->is_connected()) { $client->poll(500); } - $logger->warn("Disconnected from hub"); } else { $logger->error("Failed to connect to hub"); @@ -156,6 +148,7 @@ $logger->info("Reconnecting in ${reconnect_delay}s..."); sleep($reconnect_delay); $reconnect_delay = ($reconnect_delay * 2 > 300) ? 300 : $reconnect_delay * 2; + create_client(); } # ----------------------------------------------------------------------- @@ -164,115 +157,53 @@ sub handle_chat { my ($from_nick, $message) = @_; - - # Check for command prefix if ($message =~ /^!(\w+)\s*(.*)$/) { - my ($cmd, $args) = ($1, $2 // ''); - my $response = handle_command_response($from_nick, lc($cmd), $args); - if ($response) { - $client->send_chat($response); - } + my ($cmd, $args) = (lc($1), $2 // ''); + my $response = dispatch_command($from_nick, $cmd, $args); + $client->send_chat($response) if defined $response; } } sub handle_pm { my ($from_nick, $message) = @_; $logger->debug("PM from $from_nick: $message"); - - # Handle commands via PM (same as chat but reply via PM) if ($message =~ /^!(\w+)\s*(.*)$/) { - my ($cmd, $args) = ($1, $2 // ''); - my $response = handle_command_response($from_nick, lc($cmd), $args); - if ($response) { - $client->send_pm($from_nick, $response); - } + my ($cmd, $args) = (lc($1), $2 // ''); + my $response = dispatch_command($from_nick, $cmd, $args); + $client->send_pm($from_nick, $response) if defined $response; } } sub handle_join { my ($joined_nick) = @_; $logger->debug("User joined: $joined_nick"); - # Tell delivery and watcher notifications are handled by the gateway - # event processor — Dragon doesn't need to do anything here. + # Tell delivery and watcher notifications handled by gateway event processor } sub handle_quit { my ($quit_nick) = @_; $logger->debug("User quit: $quit_nick"); - # Watcher notifications handled by gateway event processor. + # Watcher notifications handled by gateway event processor } -sub handle_command_response { +# ----------------------------------------------------------------------- +# Command dispatch +# ----------------------------------------------------------------------- + +sub dispatch_command { my ($from_nick, $cmd, $args) = @_; - # Built-in Dragon commands (fun, external, personality) - # Returns response string, or undef if not a Dragon command. - if ($cmd eq 'coin') { - my @options = ('Heads!', 'Tails!'); - return $options[int(rand(2))]; - } - elsif ($cmd eq 'roll') { - my ($count, $sides) = ($args =~ /^(\d+)?d(\d+)$/i); - $count ||= 1; $sides ||= 6; - $count = 10 if $count > 10; - $sides = 1000 if $sides > 1000; - my @rolls = map { int(rand($sides)) + 1 } 1..$count; - my $total = 0; $total += $_ for @rolls; - return sprintf("%s rolled %dd%d: %s (total: %d)", - $from_nick, $count, $sides, join(', ', @rolls), $total); - } - elsif ($cmd eq 'time') { - return strftime("Current time: %Y-%m-%d %H:%M:%S UTC", gmtime); - } - elsif ($cmd eq 'magic_8ball' || $cmd eq '8ball') { - my @answers = ( - "It is certain.", "It is decidedly so.", "Without a doubt.", - "Yes definitely.", "You may rely on it.", "As I see it, yes.", - "Most likely.", "Outlook good.", "Yes.", "Signs point to yes.", - "Reply hazy, try again.", "Ask again later.", - "Better not tell you now.", "Cannot predict now.", - "Concentrate and ask again.", "Don't count on it.", - "My reply is no.", "My sources say no.", - "Outlook not so good.", "Very doubtful.", - ); - return $answers[int(rand(scalar @answers))]; - } - elsif ($cmd eq 'russianroulette' || $cmd eq 'rr') { - if (int(rand(6)) == 0) { - $client->send_chat("*BANG* $from_nick is dead!"); - # Kick the user (via gateway API moderation endpoint) - eval { - my $ua = $gateway->{ua}; - my $url = "$gateway->{base_url}/api/v1/users/$from_nick/kick"; - my $req = HTTP::Request->new(POST => $url); - $req->header('Content-Type' => 'application/json'); - $req->header('X-API-Key' => $gateway->{api_key}); - $req->content('{"reason":"Russian roulette"}'); - $ua->request($req); - }; - return undef; # already sent chat - } else { - return "*click* $from_nick survives!"; - } - } - elsif ($cmd eq 'lasercats') { - $client->send_chat(' /\_/\ PEW PEW PEW'); - $client->send_chat(' ( o.o ) ----======='); - $client->send_chat(' > ^ <'); - # Kick the invoker (lasercats tradition!) - eval { - my $ua = $gateway->{ua}; - my $url = "$gateway->{base_url}/api/v1/users/$from_nick/kick"; - my $req = HTTP::Request->new(POST => $url); - $req->header('Content-Type' => 'application/json'); - $req->header('X-API-Key' => $gateway->{api_key}); - $req->content('{"reason":"LASERCATS PEW PEW PEW"}'); - $ua->request($req); - }; - return undef; # already sent chat - } - else { - $logger->debug("Unknown Dragon command: $cmd"); - return undef; + # Resolve alias + $cmd = $aliases{$cmd} if exists $aliases{$cmd}; + + # Look up command module + my $module = $commands{$cmd}; + return undef unless $module; + + my $response = eval { $module->run($from_nick, $args, $client, $gateway) }; + if ($@) { + $logger->warn("Command $cmd error: $@"); + return "Error running !$cmd"; } + return $response; } diff --git a/opchat.pl b/opchat.pl index 52116f3..e47c403 100644 --- a/opchat.pl +++ b/opchat.pl @@ -1,184 +1,155 @@ #!/usr/bin/perl #-------------------------- -# OPChat - Extendable, Hookable, Plugable +# OPChat — Standalone NMDC OP Group Chat Bot # -# If in doubt, read the README +# Connects to the hub as "OPChat". Operators PM this bot to talk +# in a private group chat visible only to other ops. +# Messages sent to OPChat are relayed to all other ops on the hub. #-------------------------- + use strict; use warnings; - -use Time::HiRes qw(gettimeofday tv_interval); -my $start_time = [gettimeofday()]; -use Text::Tabs; use FindBin; use lib "$FindBin::Bin"; use Log::Log4perl qw(:levels); +use JSON; -use DCBCommon; -use DCBSettings; -use DCBUser; +use NMDCClient; +use GatewayClient; -our $VERSION = '1.0.0'; +our $VERSION = '4.0.0'; -# Enable the logger and load configuration. -# Read config and resolve relative paths against the script's directory so -# the embedded Perl inside opendchub works regardless of the hub's CWD. +# ----------------------------------------------------------------------- +# Logging +# ----------------------------------------------------------------------- { - open my $fh, '<', "$FindBin::Bin/opchat.log4perl.conf" - or die "Cannot open $FindBin::Bin/opchat.log4perl.conf: $!"; - my $conf = do { local $/; <$fh> }; - close $fh; - $conf =~ s{^(log4perl\.appender\.\w+\.filename=)(?!/)(.+)$}{$1$FindBin::Bin/$2}mg; - Log::Log4perl->init(\$conf); + my $conf_file = "$FindBin::Bin/opchat.log4perl.conf"; + if (-f $conf_file) { + open my $fh, '<', $conf_file or die "Cannot open $conf_file: $!"; + my $conf = do { local $/; <$fh> }; + close $fh; + $conf =~ s{^(log4perl\.appender\.\w+\.filename=)(?!/)(.+)$}{$1$FindBin::Bin/$2}mg; + Log::Log4perl->init(\$conf); + } else { + Log::Log4perl->easy_init($INFO); + } } my $logger = Log::Log4perl->get_logger('OPChat'); +$logger->info("OPChat v$VERSION starting"); -my $oplist = {}; - +# ----------------------------------------------------------------------- +# Config +# ----------------------------------------------------------------------- +my $config; eval { - our $Settings = DCBSettings->new(); - $Settings->config_init('opchat.yml'); - - if ($DCBSettings::config->{debug}) { - $logger->level($DEBUG); - $logger->debug("Debug mode enabled."); - } + require YAML::AppConfig; + my $config_file = "$FindBin::Bin/opchat.yml"; + die "Config not found: $config_file\n" unless -f $config_file; + my $app_config = YAML::AppConfig->new(file => $config_file); + $config = $app_config->config(); }; if ($@) { - $logger->error($@); - die; + $logger->error("Config load failed: $@"); + die $@; } -sub main { - our $c = DCBCommon::common_escape_string("$DCBSettings::config->{cp}"); - odch::register_script_name($DCBSettings::config->{botname}); - my $loadtime = tv_interval ( $start_time ) ; - $logger->debug("$DCBSettings::config->{botname} version $VERSION - loaded in $loadtime seconds!"); +my $hub_config = $config->{hub} || {}; +my $gw_config = $config->{gateway} || {}; +my $nick = $hub_config->{nick} || 'OPChat'; + +# ----------------------------------------------------------------------- +# Gateway client +# ----------------------------------------------------------------------- +my $gateway = GatewayClient->new( + url => $gw_config->{url} || 'http://127.0.0.1:3000', + api_key => $gw_config->{bot_api_key} || '', +); + +# ----------------------------------------------------------------------- +# Hub connection +# ----------------------------------------------------------------------- +my $client; + +sub create_client { + $client = NMDCClient->new( + host => $hub_config->{host} || '127.0.0.1', + port => $hub_config->{port} || 4012, + nick => $nick, + password => $hub_config->{password} || '', + description => $hub_config->{description} || 'OP Group Chat', + email => $hub_config->{email} || 'opchat@dc.glo5.com', + tag => "", + speed => 'LAN(T1)', + + on_pm => sub { handle_pm(@_) }, + on_chat => sub { }, + on_join => sub { }, + on_quit => sub { }, + ); } -sub data_arrival { - my ($name, $data) = @_; - my $botname = $DCBSettings::config->{botname}; - $data =~ s/[\r\n]+/ /g; - # matches PM - if ($data =~ /^\$To:\s\Q$botname\E\sFrom:\s$name\s\$\<\Q$name\E\>\s(.*)\|/) { - my $chat = $1; - my $user = $oplist->{lc($name)}; - opchat_sendtoopchat($name, $chat); - if ($chat =~ /^(?:$::c)add\s?(\S+)/ && $user && user_is_admin($user)) { - my @chatarray = split(/\s+/, $1); - my $invitee = shift(@chatarray); - if (lc($invitee) eq lc($botname)) { - opchat_sendtoopchat($botname, "Cannot add the bot to chat."); - } - elsif ($oplist->{lc($invitee)}) { - opchat_sendtoopchat($botname, "$invitee is already in chat."); - } - else { - my %user = ( - 'name' => $invitee, - 'permission' => PERMISSIONS->{AUTHENTICATED}, - ); - $oplist->{lc($invitee)} = \%user; - $logger->debug("Added $invitee to oplist."); - opchat_sendtoopchat($botname, "Added $invitee to chat!"); - } - } - elsif ($chat =~ /^(?:$::c)remove\s?(\S+)/ && $user && user_is_admin($user)) { - my @chatarray = split(/\s+/, $1); - my $rejectee = shift(@chatarray); - if ($oplist->{lc($rejectee)}) { - if (!user_is_admin($oplist->{lc($rejectee)})) { - delete $oplist->{lc($rejectee)}; - $logger->debug("Removed $rejectee from oplist."); - opchat_sendtoopchat($botname, "Removed $rejectee from chat!"); +# ----------------------------------------------------------------------- +# Main loop +# ----------------------------------------------------------------------- +my $reconnect_delay = 5; +create_client(); + +while (1) { + if ($client->connect()) { + $reconnect_delay = 5; + $logger->info("Connected as $nick"); + + while ($client->is_connected()) { + $client->poll(500); } - } - } - elsif ($chat =~ /^(?:$::c)list$/ && $user && user_is_admin($user)) { - my %permissions; - foreach my $key (sort keys %{+PERMISSIONS}) { - $permissions{PERMISSIONS->{$key}} = $key; - } - my $message = "List of users in this chat\n"; - foreach my $op (keys %{$oplist}) { - $message .= "[$permissions{$oplist->{$op}->{permission}}] $op\n"; - } - opchat_sendtoopchat($botname, $message); - } - elsif ($chat =~ /^(?:$::c)commands$/ && $user && user_is_admin($user)) { - my $message = "$botname commands:\n"; - $message .= "-add: Adds a user to this chat. Usage -add \n"; - $message .= "-remove: Removes a user from this chat. Usage -remove \n"; - $message .= "-list: Shows the list of users in this chat.\n"; - $message .= "-commands: Shows these commands.\n"; - opchat_sendtoopchat($botname, $message); + $logger->warn("Disconnected"); + } else { + $logger->error("Failed to connect"); } - } -} -sub op_admin_connected { - my ($user) = @_; - $logger->debug("$user connected as admin"); - opchat_login($user, PERMISSIONS->{ADMINISTRATOR}); -} -sub op_connected { - my ($user) = @_; - $logger->debug("$user connected as op"); - opchat_login($user, PERMISSIONS->{OPERATOR}); -} -sub reg_user_connected { - my ($user) = @_; - $logger->debug("$user connected as registered user"); - opchat_login($user, PERMISSIONS->{AUTHENTICATED}); -} -sub new_user_connected { - my ($user) = @_; - $logger->debug("$user connected as new user"); - opchat_login($user, PERMISSIONS->{ANONYMOUS}); -} -sub user_disconnected { - my ($name) = @_; - $logger->debug("$name disconnected."); - delete $oplist->{lc($name)}; + $logger->info("Reconnecting in ${reconnect_delay}s..."); + sleep($reconnect_delay); + $reconnect_delay = ($reconnect_delay * 2 > 300) ? 300 : $reconnect_delay * 2; + create_client(); } -sub opchat_login { - my ($name, $permission) = @_; - - my %user = ( - 'name' => $name, - 'permission' => $permission, - ); - if (user_is_admin(\%user)) { - $logger->debug("Automatically adding $name to oplist."); - $oplist->{lc($name)} = \%user; - } - - my $tag = "$DCBSettings::config->{bottag} V:$VERSION,M:P,H:1/3/3,S:7"; - my $botmessage = "\$MyINFO \$ALL $DCBSettings::config->{botname} " . - "$DCBSettings::config->{botdescription}<$tag>\$\$\$$DCBSettings::config->{botspeed}>" . - "\$$DCBSettings::config->{botemail}\$$DCBSettings::config->{botshare}\$"; - odch::data_to_user($name, $botmessage."|"); +# ----------------------------------------------------------------------- +# PM handler — relay to all other ops +# ----------------------------------------------------------------------- + +sub handle_pm { + my ($from_nick, $message) = @_; + $logger->info("OP message from $from_nick: $message"); + relay_to_ops("<$from_nick> $message", $from_nick); } -sub opchat_sendtoopchat { - my ($name, $message) = @_; - $message =~ s/\r?\n/\r\n/g; - $message =~ s/\|/|/g; - $message = expand($message); - my $botname = $DCBSettings::config->{botname}; - if ($name eq $botname || ($oplist->{lc($name)} && $oplist->{lc($name)}->{name} eq $name)) { - foreach my $op (keys %{$oplist}) { - unless (lc($name) eq $op) { - my $real_nick = $oplist->{$op}->{name}; - odch::data_to_user($real_nick, "\$To: $real_nick From: $botname \$<$name> $message|"); - } - } - } +sub get_online_ops { + my @ops; + eval { + my $ua = $gateway->{ua}; + my $url = "$gateway->{base_url}/api/v1/users"; + my $req = HTTP::Request->new(GET => $url); + $req->header('X-API-Key' => $gateway->{api_key}); + my $res = $ua->request($req); + if ($res->is_success) { + my $data = decode_json($res->decoded_content); + for my $user (@{$data->{users} || []}) { + push @ops, $user->{nick} if $user->{is_op}; + } + } + }; + $logger->warn("Failed to get ops: $@") if $@; + return @ops; } -# Exit cleanly for CI boot test +sub relay_to_ops { + my ($message, $exclude_nick) = @_; + my @ops = get_online_ops(); -exit 0; + for my $op (@ops) { + next if defined $exclude_nick && $op eq $exclude_nick; + next if $op eq $nick; + $client->send_pm($op, $message); + } +}