#!/usr/bin/perl -w
#
# null-*.pl - a smart time-oriented ignore "nullification" manager
#
# usage:
#
# /null NICK
# /null NICK!IDENT@HOST
# Finds a good hostmask to target the given nickname,
# then adds that hostmask to the standard ignore list
# for the default given time. When the timespan has
# elapsed, that hostmask is removed from the ignore
# list automatically.
#
# /unnull NICK
# /unnull NICK!IDENT@HOST
# Finds the nullified hostmask which represents the
# given nickname, if any, and expires the nullification
# immediately.
#
# /null-time TIMESPAN
# Sets the default automatic nullification timespan.
# Give times like "1d", "2 hours" or "3 minutes".
# Supports w/week, d/day, h/hour, m/minute spans, or
# the keyword "forever" which means two years.
#
# /hmsp NICK
# /hmsp NICK!IDENT@HOST
# Simple command to find and utter the proper hostmask
# for the given nickname. The term "hmsp" stands for
# the "hostmask sharing protocol." When the auto-hmsp
# mode is turned on, any such utterance you receive
# from other people will be added to your own hostmask
# nullification for your default period. Thus, you
# and anyone else who uses this script can quickly
# and automatically share your apathy for certain
# annoying victims.
#
# /hmsp-mode BOOL
# Sets the default automatic hostmask sharing protocol
# receiver mode. Give bools like 1/y/yes/on/t/true or
# 0/n/no/f/false. When turned on, any text seen in
# channel which resembles "hmsp://nick!ident@host" will
# be automatically registered in your own nullification
# list.
#
# PRIVMSG CHANNEL "hmsp://nick!ident@host"
# If events are seen in a channel which contain an
# hmsp:// pseudo-uri, and if the auto-hmsp mode is on,
# then the given hostmask is added as an automatically
# nullified entry.
#
# Author: Speare <ed@halley.cc>
#
# Changes:
# in 0.1.1:
# - defaults to hmsp-mode OFF
# - fixed actual use of the hmsp-mode flag
# - clearer notice on first run about default config
# in 0.1.0:
# - initial release
#
package IRC::XChat::Null;
use Data::Dumper;
### config ###
my $config_file = "$ENV{'HOME'}/.xchat2/null.conf";
### end config ###
my $script_name = "null.pl";
my $script_version = '0.1.3';
my $pkg = __PACKAGE__;
IRC::register($script_name, $script_version, "${pkg}::save_config", "");
IRC::print("\nScript $script_name version $script_version loading...\n");
IRC::add_command_handler("NULL", "${pkg}::cmd_null");
IRC::add_command_handler("UNNULL", "${pkg}::cmd_unnull");
IRC::add_command_handler("NULL-TIME", "${pkg}::cmd_nulltime");
IRC::add_command_handler("HMSP", "${pkg}::cmd_hmsp");
IRC::add_command_handler("HMSP-MODE", "${pkg}::cmd_hmspmode");
IRC::add_message_handler("PRIVMSG", "${pkg}::on_privmsg");
use vars qw($conf @expirations);
load_config();
#------------------------------------------------------------------
sub trim
{
local $_ = shift;
s/^\s*//;
s/\s*$//;
return $_;
}
#------------------------------------------------------------------
sub get_nih
{
my $nick = shift;
return $nick
if ($nick =~ /.+\!.+\@.+/);
my $channel = shift || IRC::get_info(2);
my $server = shift || IRC::get_info(3);
my @users = IRC::user_list($channel, $server);
while (@users)
{
if ($users[0] eq $nick)
{
return undef if $users[1] !~ '\@';
return $nick . '!' . $users[1];
}
shift @users;
}
return undef;
}
sub get_mask
{
my $nih = get_nih(shift);
return undef
if not defined $nih;
return $nih
if ($nih =~ /\*/);
my ($nick, $ident, $host) = split(/\!|\@/, $nih, 3);
# add minimal splat to the host
#
if (1)
{
my @h = split(/\./, $host);
$h[$#h] = '*'
if ($host =~ /^[0-9.]+$/);
$h[0] = '*'
if ($host !~ /^[0-9.]+$/);
#TODO: splat small range of ipv6 [0-9A-Fa-f:.] hosts
$host = join('.', @h);
}
# splat any leading ^ ~ from ident
#
if (1)
{
$ident =~ s/^./\*/ if ($ident =~ /^[+^~]/);
}
# splat any nickname
if (1)
{
$nick = '*';
}
return $nick . '!' . $ident . '@' . $host;
}
sub expire
{
my $now = shift;
# try to be quick,
# we're called often, but find expirations seldom;
# @expirations is just a cache of (sort values %nullified)
@expirations = (sort values %{$conf->{nullified}})
if (not @expirations);
return if (not @expirations) || ($expirations[0] > $now);
foreach (keys %{$conf->{nullified}})
{
IRC::command("/unnull " . $_)
if ($conf->{nullified}->{$_} <= $now);
}
shift @expirations
while ((@expirations) && ($expirations[0] <= $now));
}
sub shownulls
{
my $now = time();
my $count = scalar keys %{$conf->{nullified}};
my $s = ($count == 1)? '' : 's';
my $status = "Currently nullifying $count hostmask$s";
if ($count)
{
@expirations = (sort values %{$conf->{nullified}});
# IRC::print('[' . join(', ', @expirations) . ']');
my $fuse = ($expirations[0] - $now);
$s = ($fuse == 1)? '' : 's';
$status .= "; next to expire in $fuse second$s";
}
$status .= ".";
IRC::print($status);
}
sub showspan
{
IRC::print("Nullification span is currently $conf->{dspan}.");
}
sub showmode
{
IRC::print("Nullification mode is " .
($conf->{mode}? "ON" : "OFF") . ".\n");
}
sub showhelp
{
IRC::print("Offers the commands " .
"/NULL, /UNNULL, /NULL-TIME, /HMSP, /HMSP-MODE.");
}
#------------------------------------------------------------------
sub cmd_null
{
my $line = trim(shift);
my $host = get_mask($line);
if (not $host)
{
shownulls();
IRC::print("NULL:\tusage: /null <nickname>");
IRC::print(" \tusage: /null <nick!ident\@host>");
IRC::print(" \tImmediately registers nullification for the hostmask");
IRC::print(" \tfor the given nickname, and adds them the ignore list.");
IRC::print(" \tAfter a timespan has elapsed, nullification is removed.");
return 1;
}
my $then = time() + $conf->{span};
my $dspan = $conf->{dspan};
$conf->{nullified}->{$host} = $then;
@expirations = ();
IRC::print("Nullifying $host for $dspan.");
IRC::command("/ignore $host all quiet");
return 1;
}
sub cmd_unnull
{
my $line = trim(shift);
my $host = get_mask($line);
if (not $host)
{
shownulls();
IRC::print("UNNULL:\tusage: /unnull <nickname>");
IRC::print(" \tusage: /unnull <nick!ident\@host>");
IRC::print(" \tImmediately removes any nullification for the hostmask");
IRC::print(" \tfor the given nickname, and removes them from the ignore list.");
return 1;
}
delete $conf->{nullified}->{$host};
IRC::print("Un-nullifying $host.");
IRC::command("/unignore $host quiet");
shownulls();
return 1;
}
sub cmd_nulltime
{
my $line = trim(shift);
my $dspan = $conf->{dspan};
my ($num, $key) = ($line =~ /(\d+)\s*(\w+)/);
if ($num == 0)
{
showspan();
IRC::print("NULL-TIME:\tusage: /null-time <number> <unit>");
IRC::print(" \tUnit may be 'seconds', 'minutes', 'hours', 'days', or 'weeks'.");
IRC::print(" \tAny new /null registration will automatically expire after the span.");
IRC::print(" \tExisting nullifications keep their original expiration times.");
return 1;
}
if ($key =~ /forever/i)
{
$num = 104;
$key = 'week';
}
my $s = ($num == 1)? '' : 's';
$dspan = "$num second$s";
if ($key =~ /^(w|weeks?)$/i)
{ $dspan = "$num week$s"; $num *= 7*24*60*60; }
if ($key =~ /^(d|days?)$/i)
{ $dspan = "$num day$s"; $num *= 1*24*60*60; }
if ($key =~ /^(h|hours?)$/i)
{ $dspan = "$num hour$s"; $num *= 1*60*60; }
if ($key =~ /^(m|minutes?)$/i)
{ $dspan = "$num minute$s"; $num *= 1*60; }
$conf->{span} = $num;
$conf->{dspan} = $dspan;
showspan();
return 1;
}
sub cmd_hmsp
{
my $line = trim(shift);
my $mask = get_mask($line);
if ((not $mask) || (not IRC::get_info(2)))
{
IRC::print("HMSP:\tusage: /hmsp <nickname>");
IRC::print(" \tusage: /hmsp <nick!ident\@host>");
IRC::print(" \tDetermines best wildcard hostmask for a given nickname or fixed host,");
IRC::print(" \tthen utters that with HMSP:// notation in the current channel.");
return 1;
}
IRC::command("/say hmsp://$mask");
return 1;
}
sub cmd_hmspmode
{
my $line = trim(shift);
my $mode;
$mode = 0 if ($line =~ /^(0|n|no|none|off|f|false)$/i);
$mode = 1 if ($line =~ /^(1|y|yes|all|on|t|true)$/i);
# fixed for 0.1.3 to both show the CHANGED mode, and to show usage and CURRENT mode when left blank
if ((not $line) || (not IRC::get_info(2)))
{
$mode = $conf->{mode};
showmode();
IRC::print(" \tWhen ON, this client will automatically nullify any mask whenever");
IRC::print(" \tanyone else mentions a proper HMSP:// notation to share.");
}
else {
$conf->{mode} = $mode;
$mode = $conf->{mode};
showmode();
}
return 1;
}
#------------------------------------------------------------------
sub on_privmsg
{
my $line = trim(shift);
expire(time());
# don't auto-ignore everyone just on someone's say-so - 0.1.2 change.
IRC::command("/null $1")
if ($conf->{mode})
&& ($line =~ m{\bhmsp://(\S+?\!\S+?\@\S+)})
&& ($line !~ m{\bhmsp://(\*+\!\*+\@\*+)});
return 0; # don't swallow this privmsg
}
#------------------------------------------------------------------
sub save_config
{
open(F, '>' . $config_file) or do
{
IRC::print("$script_name: Couldn't write config file: $!\n");
return 1;
};
do
{
print F "# $config_file - config for $script_name\n";
local $Data::Dump::Purity = 1;
local $Data::Dump::Indent = 2;
local $Data::Dump::Terse = 1;
print F Dumper($conf);
};
close F;
return 1;
}
sub load_config
{
IRC::print("$script_name: ...loading configuration:\n");
do
{
$conf =
{
mode => 0,
span => 1*60*60,
dspan => "1 hour",
nullified => { },
};
@expirations = ();
};
open(F, $config_file) or do
{
IRC::print("$script_name: Couldn't read config file: $!\n");
IRC::print("Using default values to make a new config file.");
shownulls();
showspan();
showmode();
showhelp();
return 1;
};
do
{
my @lines = <F>;
$conf = eval join('', @lines);
shownulls();
showspan();
showmode();
showhelp();
};
close F;
}
1;