123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534 |
- #!/usr/bin/perl
- package BotIrc;
- use common::sense;
- use Carp;
- use JSON;
- use File::Slurp;
- use POE;
- use POE::Component::IRC::State;
- use POE::Component::IRC::Plugin::AutoJoin;
- use POE::Component::IRC::Plugin::Connector;
- use POE::Component::IRC::Plugin::NickServID;
- use POE::Component::Client::DNS;
- use POE::Component::Client::HTTP;
- use POE::Component::Server::TCP;
- use POE::Filter::IRCD;
- use POE::Filter::Line;
- use Socket;
- use Socket6;
- use lib '.';
- use control;
- use db;
- use http;
- use plugin;
- our $config;
- our $config_file = 'config.json';
- $config_file = $ARGV[0] if (defined($ARGV[0]) && -f $ARGV[0]);
- our $kernel;
- our %heap;
- my %handlers = ();
- my %handler_ctx = ();
- my %timers = ();
- sub read_config {
- $config = read_file($config_file) or fatal("Config file `$config_file' missing: $!");
- $config = decode_json($config);
- if (ref($config->{channel}) eq '') {
- $config->{channel} = [$config->{channel}];
- }
- my %chans;
- $chans{lc $_} = undef for @{$config->{channel}};
- $config->{channel} = \%chans;
- }
- read_config();
- sub msg {
- print STDERR "[".localtime."] ".shift."\n";
- }
- sub info { msg("[INFO] ".shift); }
- sub warn { msg("[WARNING] ".shift); }
- sub error { msg("[ERROR] ".shift); }
- sub fatal { msg("[FATAL] ".shift); exit(1); }
- BotDb::init();
- BotCtl::init();
- BotPlugin::init();
- our $irc = POE::Component::IRC::State->spawn(
- 'alias' => "IRC",
- 'Server' => $config->{server},
- 'Port' => ($config->{server_port} // 6697),
- 'Nick' => $config->{nick},
- 'Username' => $config->{username},
- 'Ircname' => $config->{realname},
- 'Password' => $config->{server_password},
- 'LocalAddr' => $config->{local_addr},
- 'useipv6' => $config->{ipv6},
- 'UseSSL' => $config->{server_ssl} // 1,
- 'Raw' => 1,
- );
- our $ircd_parser = POE::Filter::IRCD->new(colonify => 0);
- POE::Component::Client::HTTP->spawn(
- Alias => 'http',
- Timeout => 30,
- MaxSize => 1_000_000,
- FollowRedirects => 2,
- );
- if ($config->{control_enabled}) {
- POE::Component::Server::TCP->new(
- Address => $config->{control_addr},
- Domain => $config->{control_ipv6} ? AF_INET6 : AF_INET,
- Alias => "ControlServer",
- Port => $config->{control_port},
- Started => sub { info "Control server started."; },
- ClientFilter => POE::Filter::Line->new(Literal => "\012"),
- ClientConnected => \&BotCtl::on_connected,
- ClientDisconnected => \&BotCtl::on_disconnected,
- ClientInput => \&BotCtl::on_input,
- );
- }
- our $session = POE::Session->create(
- inline_states => {
- _start => \&main_start,
- tick => \&_tick,
- },
- heap => {
- irc => $irc,
- },
- );
- sub _tick {
- my ($ctx, $key, $code, @params) = @_[ARG0..$#_];
- delete $timers{$key};
- $code->($ctx, $key, @params);
- }
- sub main_start {
- $kernel = $_[KERNEL];
- BotHttp::init();
- $irc->plugin_add('AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new(Channels => $config->{channel}));
- $irc->plugin_add('Connector', POE::Component::IRC::Plugin::Connector->new());
- $irc->plugin_add('NickServID', POE::Component::IRC::Plugin::NickServID->new(Password => $config->{nick_pwd})) if defined $config->{nick_pwd};
- add_handler('irc_socketerr', 'core', sub {
- error("IRC: socket error while connecting: ". $_[ARG0]);
- return 0;
- });
- add_handler('irc_error', 'core', sub {
- warn("IRC: general error: ". $_[ARG0]);
- return 0;
- });
- add_handler('irc_connected', 'core', sub {
- info("IRC: connected to ". $_[ARG0]);
- $irc->yield(cap => req => "account-tag");
- return 0;
- });
- add_handler('irc_disconnected', 'core', sub {
- warn("IRC: disconnected from ". $_[ARG0]);
- return 0;
- });
- add_handler('irc_raw', 'core', \&on_irc_raw);
- add_handler('irc_raw_public', 'core', \&on_irc_public);
- add_handler('irc_raw_msg', 'core', \&on_irc_msg);
- for (@{$config->{autoload_plugins}}) {
- BotPlugin::load($_);
- }
- $irc->yield(register => 'all');
- $irc->yield(connect => {});
- return;
- }
- POE::Kernel->run();
- sub splitmask {
- my $mask = shift;
- $mask =~ /^(.+)!(.+)@(.+)$/;
- if (!$1) {
- # No n!u@h, probably server event
- return { host => $mask };
- }
- return {
- nick => $1,
- user => $2,
- host => $3,
- userhost => "$2\@$3",
- };
- }
- sub nickonly {
- splitmask(shift)->{nick};
- }
- sub return_path {
- my $source = nickonly(shift);
- my $targets = shift;
- my @targets = ();
- if (ref($targets) eq 'ARRAY') {
- @targets = @$targets;
- }
- return $source if (grep { lc($irc->nick_name()) eq lc($_) } @targets);
- my @chan_targets = grep { exists($config->{channel}{lc $_}) } @targets;
- return undef unless @chan_targets;
- # Just ignore additional channels, if any
- return $chan_targets[0];
- }
- sub msg_or_notice($$) {
- my ($target, $msg) = @_;
- my $method = ($target =~ /^#/) ? 'privmsg' : 'notice';
- $irc->yield($method => $target => $msg);
- }
- sub noisy_check_priv($$$$) {
- my ($rpath, $nick, $priv, $account) = @_;
- return 0 if (!noisy_command_authed($rpath, $nick, $account));
- if (!BotDb::has_priv($account, $priv)) {
- $irc->yield(privmsg => $rpath, "$nick: you are not authorised to perform this action ($priv).");
- return 0;
- }
- return 1;
- }
- sub noisy_check_antipriv($$$$) {
- my ($rpath, $nick, $priv, $account) = @_;
- my $account //= '!guest';
- if (BotDb::has_priv($account, $priv)) {
- $irc->yield(privmsg => $rpath, "$nick: you are not authorised to perform this action (due to $priv).");
- return 0;
- }
- return 1;
- }
- sub noisy_command_authed($$$) {
- my ($rpath, $nick, $account) = @_;
- if (!$account) {
- $irc->yield(privmsg => $rpath, "$nick: you must be logged in to use this command.");
- }
- return $account;
- }
- # Convenience methods for handlers {{{
- # Called by core stuff that calls handlers; initializes the handler ctx with
- # information about which return paths are available in principle. This will
- # later be matched against what kinds of return paths a handler requires and
- # generate errors if necessary.
- sub prepare_ctx_targets($$$$) {
- my ($source, $target, $msg, $account) = @_;
- my $rpath = return_path($source, $target);
- $rpath = undef if lc($rpath) eq lc($source);
- %handler_ctx = (
- user => $source,
- channel => $rpath,
- line => $msg,
- account => $account,
- no_setup => 1,
- );
- }
- # This is the counterpart to prepare_irc_targets. It's called by handlers to
- # perform priv/target checks according to the handler's specs.
- # Yay function name overload!
- sub check_ctx(%) {
- my %cfg = @_;
- my $account = $handler_ctx{account};
- my $source = $handler_ctx{user};
- my $channel = $handler_ctx{channel};
- $account //= '!guest';
- if (!%handler_ctx) {
- carp("Trying to use uninitialized handler ctx");
- return 0;
- }
- # First, determine where to send replies to...
- # ... but reuse established values if this isn't the first invocation
- # in the current run of the handler
- my ($noise_prefer_channel, $wisdom_prefer_channel);
- if ($handler_ctx{no_setup}) {
- $noise_prefer_channel = $cfg{noise_public} // $config->{replies_public};
- $wisdom_prefer_channel = $cfg{wisdom_public} // 1;
- } else {
- $noise_prefer_channel = $cfg{noise_public} // ($handler_ctx{noise_target} eq $channel);
- $wisdom_prefer_channel = $cfg{wisdom_public} // ($handler_ctx{wisdom_target} eq $channel);
- }
- if ($noise_prefer_channel && $channel) {
- $handler_ctx{noise_type} = 'privmsg';
- $handler_ctx{noise_target} = $channel;
- } else {
- $handler_ctx{noise_type} = 'notice';
- $handler_ctx{noise_target} = $source;
- }
- if ($wisdom_prefer_channel && $channel) {
- $handler_ctx{wisdom_type} = 'privmsg';
- $handler_ctx{wisdom_target} = $channel;
- } else {
- $handler_ctx{wisdom_type} = 'notice';
- $handler_ctx{wisdom_target} = $source;
- }
- if (exists $cfg{wisdom_addressee}) {
- ctx_set_addressee($cfg{wisdom_addressee});
- } else {
- # We can do this by default without clashing with commands
- # because both only match at the start of the line and a
- # command isn't a valid nickname nor vice versa
- ctx_set_addressee('!auto');
- }
- # Don't auto-redirect by default since it might clash with command
- # syntax
- ctx_auto_redirect($handler_ctx{wisdom_auto_redirect} // 0);
- delete $handler_ctx{no_setup};
- if (($cfg{authed} || defined($cfg{priv})) && !$handler_ctx{account}) {
- send_noise("You must be logged into NickServ in order to use this command.");
- return 0;
- }
- if (defined $cfg{priv}) {
- $cfg{priv} = [$cfg{priv}] if ref($cfg{priv}) eq '';
- for (@{$cfg{priv}}) {
- if (!BotDb::has_priv($account, $_)) {
- send_noise("You are not authorised to perform this action ($_).");
- return 0;
- }
- }
- }
- if (defined $cfg{antipriv}) {
- $cfg{antipriv} = [$cfg{antipriv}] if ref($cfg{antipriv}) eq '';
- for (@{$cfg{antipriv}}) {
- if (BotDb::has_priv($account, $_)) {
- send_noise("You are not authorised to perform this action (due to $_).");
- return 0;
- }
- }
- }
- return 1;
- }
- # There are two types of messages sent from handlers: noise and wisdom. Noise
- # is stuff like "command successful" or "you lack privileges". Wisdom is stuff
- # like "here's the data you requested".
- sub send_noise($;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- my $noise = shift;
- if (!%$ctx) {
- carp("A handler tried to send this noise without valid ctx: $noise");
- return;
- }
- if ($ctx->{no_setup}) {
- carp("Handler sending noise without ctx constraints: $noise -> $ctx->{source}");
- }
- # In channels, address user
- $noise = "$ctx->{user}: $noise" if ($ctx->{noise_type} eq 'privmsg');
- $irc->yield($ctx->{noise_type} => $ctx->{noise_target} => $noise);
- }
- sub send_wisdom($;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- my $wisdom = shift;
- if (!%$ctx) {
- carp("A handler tried to send this wisdom without valid ctx: $wisdom");
- return;
- }
- if ($ctx->{no_setup}) {
- carp("Handler sending wisdom without ctx constraints: $wisdom -> $ctx->{source}");
- }
- my $a = $ctx->{wisdom_addressee};
- my $address = "";
- $address = "$a: " if (defined $a && ctx_target_has_member($ctx, $a));
- $irc->yield($ctx->{wisdom_type} => $ctx->{wisdom_target} => ($address.$wisdom));
- }
- sub set_timer {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift: \%handler_ctx;
- my ($key, $delta, $code, @params) = @_;
- my $target_time = $delta + time;
- $kernel->alarm_remove(delete $timers{$key}) if $timers{$key};
- my $id = $kernel->alarm_set(tick => $target_time, ctx_frozen(), $key, $code, @params);
- $timers{$key} = $id;
- }
- sub clear_timer {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift: \%handler_ctx;
- my $key = shift;
- my $id = delete $timers{$key};
- return if !$id;
- $kernel->alarm_remove($id);
- 1;
- }
- # Choose who to address in public wisdom. Set to undef to disable or '!auto'
- # to enable black magic.
- # Note that this is handled during check_ctx, too, and defaults to black magic
- # there.
- sub ctx_set_addressee($;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- my $a = shift;
- if ($a eq '!auto') {
- $a = undef;
- if ($ctx->{line} && $ctx->{line} =~ /^
- ([\w\[\]\{\}\\\|`^{}-]+) # nick (broad match)
- (?:[,:]|\s-+) # separator
- \s+/ix) {
- $a = $1;
- }
- }
- $ctx->{wisdom_addressee} = $a;
- }
- sub ctx_addressee(;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- return $ctx->{"wisdom_addressee"};
- }
- sub ctx_target($;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- return $ctx->{shift."_target"};
- }
- sub ctx_source(;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- return $ctx->{user};
- }
- # This works for wisdom only! Noise should only go to the actual source of a
- # message, really.
- sub ctx_target_has_member($;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- my $target = $ctx->{wisdom_target};
- return 0 if $target !~ /^#/;
- return $irc->is_channel_member($target, shift);
- }
- sub ctx_redirect_to_channel($;$$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- my ($type, $channel) = @_;
- if (exists($config->{channel}{lc $channel})) {
- $ctx->{"${type}_target"} = $channel;
- $ctx->{"${type}_type"} = 'privmsg';
- return 1;
- }
- return 0;
- }
- sub ctx_redirect_to_addressee {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift: \%handler_ctx;
- $ctx->{wisdom_target} = $ctx->{wisdom_addressee} // $ctx->{user};
- $ctx->{wisdom_type} = 'notice';
- }
- # Will redirect wisdom caused by private requests into a channel if the
- # request contains "to:#thechannel" and #thechannel is known to us.
- sub ctx_auto_redirect(;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- if ($ctx->{line} && !ctx_can_target_channel($ctx) && $ctx->{line} =~ /\bto:(#[\S]+)/) {
- ctx_redirect_to_channel($ctx, 'wisdom', $1);
- }
- }
- # Was the original message addressed to a known channel?
- # This ignores redirections.
- sub ctx_can_target_channel(;$) {
- my $ctx = (ref($_[0]) eq 'HASH') ? shift : \%handler_ctx;
- return defined($ctx->{channel});
- }
- # Get a copy of the current ctx, for use in async scripts
- sub ctx_frozen() {
- return {%handler_ctx};
- }
- # }}}
- sub on_irc_raw {
- my $raw = $_[ARG0];
- my $ev = $ircd_parser->get([$raw]);
- $ev = $ev->[0];
- if ($ev->{tags} && $ev->{tags}{account} && $ev->{tags}{account} ne '*') {
- $ev->{account} = $ev->{tags}{account}
- } else {
- $ev->{account} = undef;
- }
- my $mask = splitmask($ev->{prefix});
- $ev->{$_} = $mask->{$_} for keys %$mask;
- $irc->send_event(irc_raw_parsed => $ev);
- if ($ev->{command} eq 'PRIVMSG') {
- if ($ev->{params}[0] =~ /^#/) {
- $irc->send_event(irc_raw_public => $ev);
- } else {
- $irc->send_event(irc_raw_msg => $ev);
- }
- }
- return 0;
- }
- sub on_irc_public {
- my $ev = $_[ARG0];
- my $target = $ev->{params}[0];
- my $msg = $ev->{params}[1];
- return 1 if ($config->{hardcore_ignore} && BotDb::has_priv($ev->{nick}, 'no_react'));
- return 0 if ($msg !~ /^\.([a-z_]+)\s*(.*)$/);
- return BotPlugin::maybe_irc_command($ev->{nick}, $target, lc($1), $2, $ev->{account});
- }
- sub on_irc_msg {
- my $ev = $_[ARG0];
- my $target = $ev->{params}[0];
- my $msg = $ev->{params}[1];
- return 1 if ($config->{hardcore_ignore} && BotDb::has_priv($ev->{nick}, 'no_react'));
- return 0 if ($msg !~ /^\.([a-z_]+)\s*(.*)$/);
- return BotPlugin::maybe_irc_command($ev->{nick}, $target, lc($1), $2, $ev->{account});
- }
- sub add_handler($$$) {
- my ($ev, $origin, $code) = @_;
- if ($ev eq "irc_raw_anymsg") {
- &add_handler("irc_raw_msg", $origin, $code);
- &add_handler("irc_raw_public", $origin, $code);
- return;
- }
- if (!exists $handlers{$ev}) {
- $handlers{$ev} = [];
- $kernel->state($ev, sub {
- for (@{$handlers{$ev}}) {
- # Prepare handler ctx
- my $data = $_[ARG0];
- if ($ev =~ /^irc_raw_(?:msg|public)$/) {
- my $target = $data->{params}[0];
- my $msg = $data->{params}[1];
- my $account = $data->{account};
- if (!$account && $config->{use_masks}) {
- $account = BotDb::check_mask_auth($data->{nick}, $data->{prefix});
- }
- prepare_ctx_targets($data->{nick}, $data->{params}, $msg, $account);
- } else {
- prepare_ctx_targets($data->{nick}, $_[ARG1], "", undef);
- }
- my $res = $_->{code}(@_);
- %handler_ctx = ();
- last if ($res);
- }
- });
- }
- push @{$handlers{$ev}}, { origin => $origin, code => $code };
- }
- sub remove_handlers($) {
- my $origin = shift;
- for my $h (keys %handlers) {
- @{$handlers{$h}} = grep { $_->{origin} ne $origin } @{$handlers{$h}};
- $kernel->state($h) if (!@{$handlers{$h}});
- }
- }
|