irssi qignore -- per-mask + per-bridge-subuser ignore w/ persistence + smart cloak detection (commissioned by nextime, written by vjt-claude)

qignore.pl

use strict;
use warnings;
use Irssi;
use vars qw($VERSION %IRSSI);

$VERSION = '0.4';
%IRSSI = (
    authors     => 'vjt-claude (commissioned by nextime)',
    contact     => 'nextime on Azzurra',
    name        => 'qignore',
    description => 'Per-mask + per-bridge-subuser ignore with persistence, '
                 . 'session/forever lists, smart cloak detection, and tab-complete.',
    license     => 'MIT',
);

# ----------------------------------------------------------------------------
# Storage layout (in-memory):
#   %FOREVER : id => entry
#   %SESSION : id => entry
# entry kinds:
#   { kind => 'mask',   mask => '*!*@host', nick => 'foo',     added => ts }
#   { kind => 'bridge', bridge => 'Trillian', sub => 'mrwlff', added => ts }
#
# Forever -> ~/.irssi/qignore.conf (TSV).
# Session -> in-memory only.
# Bridge entries match by message body prefix `<sub>` (matterbridge/Trillian
# convention) when the IRC source nick equals the bridge nick.
# ----------------------------------------------------------------------------

my %FOREVER;
my %SESSION;
my $NEXT_FOREVER_ID = 1;
my $NEXT_SESSION_ID = 1;

# Pending WHOIS lookups for /qignore add|tmp
my %PENDING;

my $CONF = Irssi::get_irssi_dir() . '/qignore.conf';

# ----------------------------------------------------------------------------
# Persistence: TSV
#   MASK<TAB>id<TAB>mask<TAB>nick<TAB>epoch
#   BRIDGE<TAB>id<TAB>bridge<TAB>sub<TAB>epoch
# ----------------------------------------------------------------------------

sub load_conf {
    return unless -f $CONF;
    open(my $fh, '<', $CONF) or do {
        qprint("qignore: cannot read $CONF: $!", MSGLEVEL_CLIENTERROR);
        return;
    };
    while (my $line = <$fh>) {
        chomp $line;
        next unless length $line;
        next if $line =~ /^#/;
        my @f = split /\t/, $line;
        next unless @f >= 4;
        my $kind = shift @f;
        if ($kind eq 'MASK') {
            my ($id, $mask, $nick, $added) = @f;
            $FOREVER{$id} = { kind => 'mask', mask => $mask, nick => $nick // '', added => $added // time };
            $NEXT_FOREVER_ID = $id + 1 if $id >= $NEXT_FOREVER_ID;
        }
        elsif ($kind eq 'BRIDGE') {
            my ($id, $bridge, $sub, $added) = @f;
            $FOREVER{$id} = { kind => 'bridge', bridge => $bridge, sub => $sub, added => $added // time };
            $NEXT_FOREVER_ID = $id + 1 if $id >= $NEXT_FOREVER_ID;
        }
    }
    close $fh;
}

sub save_conf {
    open(my $fh, '>', "$CONF.tmp") or do {
        qprint("qignore: cannot write $CONF.tmp: $!", MSGLEVEL_CLIENTERROR);
        return;
    };
    print $fh "# qignore forever list -- auto-generated, edit with /qignore commands\n";
    for my $id (sort { $a <=> $b } keys %FOREVER) {
        my $e = $FOREVER{$id};
        if ($e->{kind} eq 'mask') {
            print $fh join("\t", 'MASK', $id, $e->{mask}, $e->{nick}, $e->{added}), "\n";
        } elsif ($e->{kind} eq 'bridge') {
            print $fh join("\t", 'BRIDGE', $id, $e->{bridge}, $e->{sub}, $e->{added}), "\n";
        }
    }
    close $fh;
    rename "$CONF.tmp", $CONF
        or qprint("qignore: rename failed: $!", MSGLEVEL_CLIENTERROR);
}

# ----------------------------------------------------------------------------
# Mask computation. See README/help for rules.
# ----------------------------------------------------------------------------

sub compute_mask {
    my ($nick, $user, $host, $full) = @_;
    return undef unless defined $host && length $host;

    if ($host =~ /(Azzurra[-=][0-9A-Fa-f]+)/) {
        return "*!*@*$1*";
    }

    if ($host =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
        return $full ? "*!*@$host" : "*!*@" . _ipv4_glob($host);
    }

    if ($host =~ /^\d+\..+/) {
        if ($full) {
            return "*!*@$host";
        }
        my @parts = split /\./, $host;
        shift @parts while @parts && $parts[0] =~ /^\d+$/;
        if (@parts >= 2) {
            return "*!*@*." . join('.', @parts);
        }
        return "*!*@$host";
    }

    return "*!*@$host";
}

sub _ipv4_glob {
    my ($ip) = @_;
    my @o = split /\./, $ip;
    return "$o[0].$o[1].*.*";
}

# ----------------------------------------------------------------------------
# Helpers
# ----------------------------------------------------------------------------

sub list_get { $_[0] eq 'forever' ? \%FOREVER : \%SESSION; }

# qprint: print to the active window when it's a channel/query, else status.
# Multi-line messages (e.g. /qignore help) are split per-line so each line
# carries its own MSGLEVEL_CLIENTCRAP, which keeps formatting clean.
sub qprint {
    my ($msg) = @_;
    my $win = Irssi::active_win();
    for my $line (split /\n/, $msg) {
        if ($win) {
            $win->print($line, MSGLEVEL_CLIENTCRAP);
        } else {
            Irssi::print($line, MSGLEVEL_CLIENTCRAP);
        }
    }
}

sub next_id {
    my ($which) = @_;
    return $which eq 'forever' ? $NEXT_FOREVER_ID++ : $NEXT_SESSION_ID++;
}

sub mask_in_use {
    my ($mask) = @_;
    for my $e (values %FOREVER, values %SESSION) {
        next unless $e->{kind} eq 'mask';
        return 1 if $e->{mask} eq $mask;
    }
    return 0;
}

sub bridge_in_use {
    my ($bridge, $sub) = @_;
    for my $e (values %FOREVER, values %SESSION) {
        next unless $e->{kind} eq 'bridge';
        return 1 if lc $e->{bridge} eq lc $bridge && lc $e->{sub} eq lc $sub;
    }
    return 0;
}

sub mask_match {
    my ($mask, $nick, $user, $host) = @_;
    my $re = quotemeta $mask;
    $re =~ s/\\\*/.*/g;
    $re =~ s/\\\?/./g;
    $re = '^' . $re . '$';
    return "$nick!$user\@$host" =~ /$re/i;
}

sub bridge_match {
    my ($entry, $src_nick, $msg) = @_;
    return 0 unless lc $entry->{bridge} eq lc $src_nick;
    # Common bridge prefixes: <sub>, [sub], (sub), all followed by space.
    my $sub = quotemeta $entry->{sub};
    return $msg =~ /^[<\[(]\s*$sub\s*[>\])]/i;
}

# Citation match: drop a message authored by *anyone* if it cites a muted
# entity. Two forms recognized:
#   (1) IRC direct address  -- line begins with "<name>:"  (e.g. "sarca: ma")
#   (2) Matterbridge re-block -- "(re @<bot>: <name> ...)" or any "<name>"
#       angle-quote inline anywhere in the body.
# `$name` = entry->{nick} for mask entries, entry->{sub} for bridge entries.
sub citation_match {
    my ($entry, $msg) = @_;
    my $name;
    if    ($entry->{kind} eq 'mask')   { $name = $entry->{nick}; }
    elsif ($entry->{kind} eq 'bridge') { $name = $entry->{sub}; }
    return 0 unless defined $name && length $name;
    my $q = quotemeta $name;
    return 1 if $msg =~ /^\s*$q\s*:/i;
    return 1 if $msg =~ /<\s*$q\s*>/i;
    return 0;
}

# ----------------------------------------------------------------------------
# /qignore command dispatcher
# ----------------------------------------------------------------------------

sub cmd_qignore {
    my ($args, $server, $witem) = @_;
    $args =~ s/^\s+//;
    my @tok = split /\s+/, $args;
    my $sub = lc(shift(@tok) // 'list');

    if ($sub eq 'add' || $sub eq 'tmp') {
        my $list = $sub eq 'add' ? 'forever' : 'session';
        my ($nick, @rest) = @tok;
        unless (defined $nick && length $nick) {
            qprint("qignore: usage: /qignore $sub <nick> [--full|-f]");
            return;
        }
        my $full = grep { $_ eq '--full' || $_ eq '-f' } @rest;
        unless ($server) {
            qprint("qignore: no server context, run from a server window");
            return;
        }
        $PENDING{lc $nick} = { list => $list, full => $full, server_tag => $server->{tag} };
        $server->redirect_event('whois',
            1, $nick, 0, undef,
            {
                'event 311' => 'redir qignore_whois',
                'event 318' => 'redir qignore_whois_end',
                'event 401' => 'redir qignore_whois_nosuch',
                ''           => 'event empty',
            });
        $server->send_raw("WHOIS $nick");
    }
    elsif ($sub eq 'bridge' || $sub eq 'tmpbridge') {
        my $list = $sub eq 'bridge' ? 'forever' : 'session';
        my ($bridge_nick, $sub_user) = @tok;
        unless (defined $bridge_nick && defined $sub_user && length $sub_user) {
            qprint("qignore: usage: /qignore $sub <bridge-nick> <sub-user>");
            qprint("        e.g. /qignore bridge Trillian mrwlff");
            return;
        }
        if (bridge_in_use($bridge_nick, $sub_user)) {
            qprint("qignore: bridge entry $bridge_nick/$sub_user already exists");
            return;
        }
        my $id = next_id($list);
        my $bucket = list_get($list);
        $bucket->{$id} = {
            kind => 'bridge', bridge => $bridge_nick, sub => $sub_user, added => time,
        };
        save_conf() if $list eq 'forever';
        qprint("qignore: $list [$id] bridge $bridge_nick / <$sub_user>");
    }
    elsif ($sub eq 'del' || $sub eq 'rm' || $sub eq 'remove') {
        my $target = shift(@tok);
        unless (defined $target && length $target) {
            qprint("qignore: usage: /qignore del <id|nick|sub>");
            return;
        }
        my $found = 0;
        for my $list (\%FOREVER, \%SESSION) {
            for my $id (keys %$list) {
                my $e = $list->{$id};
                my $hit = 0;
                if ($id eq $target) { $hit = 1; }
                elsif ($e->{kind} eq 'mask' && $e->{nick} && lc $e->{nick} eq lc $target) { $hit = 1; }
                elsif ($e->{kind} eq 'bridge' && lc $e->{sub} eq lc $target) { $hit = 1; }
                if ($hit) {
                    my $desc = $e->{kind} eq 'mask'
                        ? "$e->{mask} ($e->{nick})"
                        : "bridge $e->{bridge}/<$e->{sub}>";
                    qprint("qignore: removed [$id] $desc");
                    delete $list->{$id};
                    $found++;
                }
            }
        }
        save_conf() if $found;
        qprint("qignore: nothing matched '$target'") unless $found;
    }
    elsif ($sub eq 'list' || $sub eq 'ls') {
        for my $name ('forever', 'session') {
            my $bucket = list_get($name);
            Irssi::print("qignore -- $name (" . scalar(keys %$bucket) . "):");
            for my $id (sort { $a <=> $b } keys %$bucket) {
                my $e = $bucket->{$id};
                if ($e->{kind} eq 'mask') {
                    qprint(sprintf("  [%d] %-40s  (%s)", $id, $e->{mask}, $e->{nick}));
                } else {
                    qprint(sprintf("  [%d] bridge %s / <%s>", $id, $e->{bridge}, $e->{sub}));
                }
            }
        }
    }
    elsif ($sub eq 'mask') {
        my ($id, $new) = @tok;
        unless (defined $id && defined $new && length $new) {
            qprint("qignore: usage: /qignore mask <id> <new-mask>");
            return;
        }
        for my $list (\%FOREVER, \%SESSION) {
            if (exists $list->{$id} && $list->{$id}{kind} eq 'mask') {
                my $old = $list->{$id}{mask};
                $list->{$id}{mask} = $new;
                qprint("qignore: [$id] $old -> $new");
                save_conf() if $list == \%FOREVER;
                return;
            }
        }
        qprint("qignore: id '$id' not found or not a mask entry");
    }
    elsif ($sub eq 'help' || $sub eq '?') {
        qprint(<<'HELP');
qignore commands:
  /qignore add <nick> [--full|-f]            mask, forever (saved to disk)
  /qignore tmp <nick> [--full|-f]            mask, session-only
  /qignore bridge <bridge-nick> <sub-user>   sub-user via bridge, forever
  /qignore tmpbridge <bridge> <sub>          sub-user via bridge, session
  /qignore del <id|nick|sub>                 remove
  /qignore list                              show both lists
  /qignore mask <id> <new-mask>              edit mask of entry
  /qignore help                              this text

flags:
  --full / -f   use exact host instead of smart-masked one (mask entries)

bridge entries match when the source nick equals <bridge-nick> AND the
message body begins with <sub-user>, [sub-user] or (sub-user). Standard
matterbridge/Trillian convention.

citations: any message authored by anyone is also dropped if it cites a
muted entity. Matches "name:" line-prefix and angle-quote "<name>"
inline (catches matterbridge "(re @bot: <name> ...)" reply blocks).
HELP
    }
    else {
        qprint("qignore: unknown subcommand '$sub' -- try /qignore help");
    }
}

# ----------------------------------------------------------------------------
# WHOIS redirect handlers
# ----------------------------------------------------------------------------

sub sig_whois {
    my ($server, $data) = @_;
    my (undef, $nick, $user, $host) = split / /, $data;
    return unless defined $nick;
    my $key = lc $nick;
    my $p = delete $PENDING{$key};
    return unless $p;

    my $mask = compute_mask($nick, $user, $host, $p->{full});
    unless (defined $mask) {
        qprint("qignore: could not compute mask for $nick ($user\@$host)");
        return;
    }

    if (mask_in_use($mask)) {
        qprint("qignore: mask $mask already exists, skipping");
        return;
    }

    my $id = next_id($p->{list});
    my $bucket = list_get($p->{list});
    $bucket->{$id} = { kind => 'mask', mask => $mask, nick => $nick, added => time };
    save_conf() if $p->{list} eq 'forever';
    qprint("qignore: $p->{list} [$id] $mask ($nick)");
}

sub sig_whois_end { }

sub sig_whois_nosuch {
    my ($server, $data) = @_;
    my (undef, $nick) = split / /, $data;
    return unless defined $nick;
    delete $PENDING{lc $nick};
    qprint("qignore: WHOIS $nick -> no such nick");
}

# ----------------------------------------------------------------------------
# Drop incoming messages that match
# ----------------------------------------------------------------------------

sub _drop_if_match {
    my ($server, $msg, $nick, $address, $is_public) = @_;
    return 0 unless defined $address && $address =~ /^([^@]+)\@(.+)$/;
    my ($user, $host) = ($1, $2);
    for my $e (values %FOREVER, values %SESSION) {
        if ($e->{kind} eq 'mask' && mask_match($e->{mask}, $nick, $user, $host)) {
            Irssi::signal_stop();
            return 1;
        }
        if ($e->{kind} eq 'bridge' && bridge_match($e, $nick, $msg)) {
            Irssi::signal_stop();
            return 1;
        }
        if (citation_match($e, $msg)) {
            Irssi::signal_stop();
            return 1;
        }
    }
    return 0;
}

sub sig_message_public {
    my ($server, $msg, $nick, $address, $target) = @_;
    _drop_if_match($server, $msg, $nick, $address, 1);
}

sub sig_message_private {
    my ($server, $msg, $nick, $address) = @_;
    _drop_if_match($server, $msg, $nick, $address, 0);
}

# ----------------------------------------------------------------------------
# Tab-completion
# ----------------------------------------------------------------------------

sub sig_complete {
    my ($complist, $window, $word, $linestart, $want_space) = @_;
    return unless $linestart =~ /^\/qignore\s*(.*)$/i;
    my $rest = $1;

    if ($rest !~ /\s/) {
        my @subs = qw(add tmp bridge tmpbridge del list mask help);
        push @$complist, grep { /^\Q$word\E/i } @subs;
        $$want_space = 1;
        Irssi::signal_stop();
        return;
    }

    if ($rest =~ /^(add|tmp|del|rm|remove|bridge|tmpbridge)\s/i) {
        my $witem = Irssi::active_win()->{active};
        if (ref $witem && $witem->{type} eq 'CHANNEL') {
            my @nicks = map { $_->{nick} } $witem->nicks();
            push @$complist, grep { /^\Q$word\E/i } @nicks;
            $$want_space = 1;
            Irssi::signal_stop();
            return;
        }
    }
}

# ----------------------------------------------------------------------------
# Wire up
# ----------------------------------------------------------------------------

Irssi::command_bind('qignore', \&cmd_qignore);
Irssi::signal_add_first('message public',  \&sig_message_public);
Irssi::signal_add_first('message private', \&sig_message_private);
Irssi::signal_add('redir qignore_whois',         \&sig_whois);
Irssi::signal_add('redir qignore_whois_end',     \&sig_whois_end);
Irssi::signal_add('redir qignore_whois_nosuch',  \&sig_whois_nosuch);
Irssi::signal_add('complete word', \&sig_complete);

Irssi::signal_register({ 'redir qignore_whois' => [qw(iobject string)] });
Irssi::signal_register({ 'redir qignore_whois_end' => [qw(iobject string)] });
Irssi::signal_register({ 'redir qignore_whois_nosuch' => [qw(iobject string)] });

load_conf();
Irssi::print("qignore $VERSION loaded -- /qignore help", MSGLEVEL_CLIENTCRAP);