Skip to content

Instantly share code, notes, and snippets.

@LifeIsPain
Last active December 18, 2015 15:29
Show Gist options
  • Save LifeIsPain/5804895 to your computer and use it in GitHub Desktop.
Save LifeIsPain/5804895 to your computer and use it in GitHub Desktop.
XChat script to determine and list why a user is unable to join or speak on a channel
# Name: whybanned.pl
# Version: 004
# Author: LifeIsPain < idontlikespam (at) orvp [dot] net >
# Date: 2013-07-12
# Description: Determine and list why a user is unable to join or speak on a channel
# License: zlib (text at end of file)
# Version History
# 001 2013-06-18 Initial Code
# 002 2013-06-18 Fix issue where only worked if in channel (increased priority)
# Fix simultaneous queries of same channel resulting in inconsistent result
# 003 2013-07-11 Major rework. Less requests for redundant data.
# Avoid potential sigfault
# Resolves hosts to IP for normal users if possible
# 004 2013-07-12 Fix uninitialized value when user not online
# Features:
# Functionality inspired by bansearch.pl for irssi, but extended considerably
# Check a users details against a channels mode, ban list, and quiet list
# If run by an ircop, checks ban and and quiet list against user's actual host and IP
# (tested on charybdis and ircd-seven ircds)
# Allows for verbose mode which lists who set the ban and when
# If no quiet list is available, still lists other matches
# Handles extbans: arxz
# Checks against RFC1459 case mappings for bans and quiets
# Known Issues:
# CIDR notation of bans is not handled
# No changes needed within this file
use strict;
use warnings;
use Xchat qw(:all);
use Getopt::Long qw(GetOptionsFromString);
my $NAME = 'Why Banned Search';
my $VERSION = '004';
my $COMMAND = 'whybanned';
my $USAGE = "$COMMAND [--channel <#targetchannel>] [--verbose] --nick <nicknametocheck>";
my $TIMEOUT = 10; # as long as a line we care about comes from server every 10 seconds
# Special Strings
my $INFO_PREFACE = "\002Why Banned:\002 ";
my $INFO_SPECIAL_PRIVS = "\002!! DO NOT PASTE !!\002 (found by special privileges)";
register($NAME, $VERSION, 'List why a user is banned/cannot talk in a channel');
hook_command($COMMAND, \&cmd_whybanned, { help_text => $USAGE });
my $bank = []; # databank for each check, context, whatnot
# for keeping track of the different items already hooked and removing
my $whois_hooks;
my $mode_hooks;
my $ban_hooks;
my $quiet_hooks;
my $trace_hooks;
my $timeout_hook;
my %trace_track = (); # /trace is silly, have to look backwards
# Main sub, called directly from
sub cmd_whybanned {
my ($nick, $channel, $type);
my $verbose = '';
my $context_info = context_info();
# setup the command parsing
my ($ret, $args) = GetOptionsFromString($_[1][1], 'channel|chan|c:s' => \$channel, 'user|nick|u|n=s' => \$nick, 'verbose|details|v!' => \$verbose);
# the channel wasn't provided, but is optional, as long in a channel tab, set to current channel
if ( ( ! defined $channel || $channel eq '' ) && $context_info->{'type'} == 2 && $context_info->{'channel'} ne '') {
$channel = $context_info->{'channel'};
}
# if the $nick isn't explicity set, check for unused args and get nick as first word
if ( ! defined $nick || $nick eq '' && scalar @$args ) {
$nick = @$args[0];
}
# still don't have the nick? Not actually in a Channel? Warn!
unless (defined $nick && defined $channel) {
info_alert("Please specify who to check. Usage: $USAGE");
}
# we have a user and channel, now to figure out why cannot see.
else {
# keep track of data we are checking for
my $retrieved = {};
push (@$bank, $retrieved);
$retrieved->{'channel'} = $channel;
$retrieved->{'nick'} = $nick;
$retrieved->{'verbose'} = $verbose;
$retrieved->{'context'} = get_context;
$retrieved->{'stage'} = 'whois'; # keep track of stage to help simultaneous runs
$retrieved->{'time'} = time; # for timeout
$retrieved->{'done'} = 0;
$retrieved->{'continue'} = 1;
# Store which server id we should be on for comparison
$retrieved->{'serverid'} = $context_info->{'id'};
$retrieved->{'instance'} = $retrieved; # self reference for comparison
# make sure the timeout check is running
unless (defined $timeout_hook) {
$timeout_hook = hook_timer( $TIMEOUT * 1000, \&reply_timed_out_callback );
}
# full process starts by whoising the nick, everything else results on line replies
run_whois($retrieved);
}
return EAT_ALL;
}
# This sub gets called when we want to remove the hooks for whatever event and clear their items from that list
# remove_hooks($hook_list_hash_reference)
# or called from a timeout
sub remove_hooks {
# if called via flat call, hook_list will be $_[0]
# if called from a callback, it becomes... hey guess what? still $_[0]!
my $hook_list = $_[0];
for my $event ( keys %$hook_list ) {
my $unhook = delete $hook_list->{$event};
unhook $unhook if ($unhook);
}
return REMOVE;
}
# If we don't get a response in timely manner, need to alert user
sub reply_timed_out_callback {
my @initial_bank = @$bank;
for my $entry (@initial_bank) {
if ($entry->{'time'} < time - $TIMEOUT) {
if ($entry->{'done'}) {
remove_from_bank($entry);
}
else {
abort_run($entry, "Operation timed out while waiting for $entry->{'stage'} while checking about \002$entry->{'nick'}\002 in \002$entry->{'channel'}\002. Aborting query.");
}
}
}
# if cleared out, and $bank now empty, remove all hooks
unless (scalar @$bank) {
remove_hooks($whois_hooks);
remove_hooks($mode_hooks);
remove_hooks($ban_hooks);
remove_hooks($quiet_hooks);
remove_hooks($trace_hooks);
$timeout_hook = undef;
return REMOVE;
}
else {
return KEEP;
}
}
# handle all hook_print lines from the whois events
sub whois_callback {
my $serverid = context_info->{'id'};
my @concerned;
for my $entry (@$bank) {
if ( $entry->{'serverid'} == $serverid && defined $entry->{'stage'} && $entry->{'stage'} eq 'whois' && nickcmp($entry->{'nick'}, $_[0][0]) == 0 ) {
push @concerned, $entry;
}
}
# leave callback if line came from a nick we aren't concerned about
return EAT_NONE unless (scalar @concerned);
my %careabout = ();
my $evt = $_[1];
# get different things based on event
if ($evt eq 'WhoIs Name Line') {
$careabout{'nick'} = $_[0][0]; # already have, yes, but lets get with capitalization
$careabout{'ident'} = $_[0][1];
$careabout{'host'} = $_[0][2];
$careabout{'fullhost'} = $_[0][0] . '!' . $_[0][1] . '@' . $_[0][2];
$careabout{'realname'} = $_[0][3];
}
elsif ($evt eq 'WhoIs Authenticated') {
$careabout{'account'} = $_[0][2];
}
# There may be an event for Real Host, may not
elsif ($evt eq 'WhoIs Real Host') {
# all of the concerned whois items should be the same up to this point, so grab rom first
$careabout{'connectedip'} = $_[0][0] .'!'. $concerned[0]->{'ident'} .'@'. $_[0][2];
# only store connectedhost if different from connectedip
if ("$_[0][1]" ne "*\@$_[0][2]") {
my $connectedhost = $_[0][1];
$connectedhost =~ s/^\*/$concerned[0]->{'ident'}/;
$careabout{'connectedhost'} = $_[0][0] .'!'. $connectedhost;
}
}
elsif ($evt eq 'WhoIs Special') {
# Check for connected from
if ($_[0][1] =~ /^is connecting from (\S+) (\S+)/) {
# we better already have the nick and ident at this point
$careabout{'connectedip'} = $_[0][0] .'!'. $concerned[0]->{'ident'} .'@'. $2;
# only store connectedhost if different from connectedip
if ("$1" ne "*\@$2") {
my $connectedhost = $1;
$connectedhost =~ s/^\*/$concerned[0]->{'ident'}/;
$careabout{'connectedhost'} = $_[0][0] .'!'. $connectedhost;
}
}
# Check for SSL
elsif ($_[0][1] =~ /^is using a secure connection/) {
$careabout{'ssl'} = 1;
}
}
# put the stuff we care about into each concerned entry
for my $entry (@concerned) {
for my $key (keys %careabout) {
$entry->{$key} = $careabout{$key};
}
$entry->{'time'} = time; # reset timeout
}
return EAT_ALL;
}
# clean up whois hooks and possibly progress
sub whois_end_callback {
my $serverid = context_info->{'id'};
my @concerned;
my $whoiscount = 0;
for my $entry (@$bank) {
if ( defined $entry->{'stage'} && $entry->{'stage'} eq 'whois' ) {
$whoiscount++;
if ( $entry->{'serverid'} == $serverid && nickcmp($entry->{'nick'}, $_[0][0]) == 0 ) {
push @concerned, $entry;
}
}
}
# leave callback if line came from a nick we aren't concerned about
return EAT_NONE unless (scalar @concerned);
# Run a lookup for /trace if host looks like a valid host rather than an IP and don't have from the whois
if (!defined $concerned[0]->{'ip'} && $concerned[0]->{'continue'} &&
$concerned[0]->{'host'} =~ m/^(?:(?:[a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])$/) {
for my $entry (@concerned) {
$entry->{'time'} = time; # reset timeout
run_trace($entry);
}
}
# if already looks like an ip, go to the mode for each whois item we are done with now
else {
for my $entry (@concerned) {
$entry->{'time'} = time; # reset timeout
if ($entry->{'continue'} != 0) {
run_mode($entry);
}
}
}
# need to clear up hooks if we aren't waiting for anymore whois items
if (scalar @concerned == $whoiscount) {
remove_hooks($whois_hooks);
}
return EAT_XCHAT;
}
sub whois_401_callback {
my $serverid = context_info->{'id'};
my @concerned;
my $whoiscount = 0;
for my $entry (@$bank) {
if ( defined $entry->{'stage'} && $entry->{'stage'} eq 'whois' ) {
$whoiscount++;
if ( $entry->{'serverid'} == $serverid && nickcmp($entry->{'nick'}, $_[0][3]) == 0 ) {
push @concerned, $entry;
}
}
}
# leave callback if line came from a nick we aren't concerned about
return EAT_NONE unless (scalar @concerned);
for my $entry (@concerned) {
abort_run($entry, "The nick \002$_[0][3]\002 is not online. Aborting script.");
}
return EAT_XCHAT;
}
# a callable sub to get the whois info
sub run_whois {
my $retrieved = shift;
my $needwhois = 1;
my $needwhoiswait = 1;
return unless $retrieved->{'continue'};
$retrieved->{'stage'} = 'whois';
# check to see if this whois is being done on another check, or has already been completed
# don't look at this entry if it has aborted
for my $entry (@$bank) {
if ( $entry->{'instance'} != $retrieved && $entry->{'serverid'} == $retrieved->{'serverid'}
&& $entry->{'continue'} && nickcmp($entry->{'nick'}, $retrieved->{'nick'}) == 0 ) {
# it matched, lets pull that data if available, but it may even be in progress
$needwhois = 0;
$retrieved->{'nick'} = $entry->{'nick'}; # set to this based on possible case
$retrieved->{'ident'} = $entry->{'ident'} if (defined $entry->{'ident'});
$retrieved->{'host'} = $entry->{'host'} if (defined $entry->{'host'});
$retrieved->{'fullhost'} = $entry->{'fullhost'} if (defined $entry->{'fullhost'});
$retrieved->{'realname'} = $entry->{'realname'} if (defined $entry->{'realname'});
$retrieved->{'account'} = $entry->{'account'} if (defined $entry->{'account'});
$retrieved->{'ip'} = $entry->{'ip'} if (defined $entry->{'ip'});
$retrieved->{'connectedip'} = $entry->{'connectedip'} if (defined $entry->{'connectedip'});
$retrieved->{'connectedhost'} = $entry->{'connectedhost'} if (defined $entry->{'connectedhost'});
$retrieved->{'ssl'} = $entry->{'ssl'} if (defined $entry->{'ssl'});
# other entry has completed whois stage, we will have all, and can skip
if ( defined $entry->{'stage'} && $entry->{'stage'} ne 'whois' ) {
$needwhoiswait = 0;
last; # leave for loop
}
}
}
if ($needwhois) {
# hooks are cleared after they aren't needed, so if they don't exist, put them back in place
unless (defined $whois_hooks && scalar %$whois_hooks) {
my @whois_events = (
"WhoIs Authenticated", "WhoIs Away Line",
"WhoIs Channel/Oper Line", "WhoIs Identified",
"WhoIs Idle Line", "WhoIs Idle Line with Signon",
"WhoIs Name Line", "WhoIs Real Host",
"WhoIs Server Line", "WhoIs Special",
"WhoIs Real Host",
);
for my $whois_event ( @whois_events ) {
$whois_hooks->{$whois_event} =
hook_print($whois_event, \&whois_callback, { data => $whois_event , priority => PRI_HIGH });
}
$whois_hooks->{ 'WhoIs End' } = hook_print('WhoIs End', \&whois_end_callback, { priority => PRI_HIGH });
# If the nick we try isn't actually on the server, get a 401 server event, so abort and clear hooks
$whois_hooks->{ "401" } = hook_server("401", \&whois_401_callback);
}
command("quote WHOIS $retrieved->{'nick'}");
}
unless ($needwhoiswait) {
run_mode($retrieved);
}
}
#>> :server.network.net 205 mynick User users nick[ident@host] (127.0.0.1) <num> :<num>
#>> :server.network.net 262 mynick nick :End of TRACE
#>> :server.network.net 421 mynick trace :Unknown command
# Trace is quite tricky, as the $_[0][5] normally would compare to isn't accurate. Uses []s to separate
# the nick from ident and host, but both the nick and ident could have '[' in them, so cannot split
# instead, have to store the first line, then find if this is right by the next 262 event
# because other items could potentially want the trace as well, have to then re-receive these lines
sub trace_callback {
my $serverid = context_info->{'id'};
# let it go through without stop if waiting for it, as this means it is the re-entry
return EAT_NONE if defined $trace_track{$serverid};
for my $entry (@$bank) {
if ( $entry->{'serverid'} == $serverid && $entry->{'done'} == 0 ) {
# store the line, the ip we care about, and marker to break recursion
$trace_track{$serverid} = [ $_[1][0], $_[0][6], 1 ];
return EAT_ALL;
}
}
return EAT_NONE;
}
# we won't know if we should have eaten last line until the 262 comes through
sub trace_end_callback {
my $serverid = context_info->{'id'};
# have a marker in place that we can skip this line in
return EAT_NONE if (! defined $trace_track{$serverid} || $trace_track{$serverid}[2] == 0 );
my @concerned;
for my $entry (@$bank) {
if ( $entry->{'serverid'} == $serverid && nickcmp($entry->{'nick'}, $_[0][3]) == 0) {
push @concerned, $entry;
$entry->{'time'} = time; # reset timeout
}
}
# if from a nick we don't care about, have to make the events go through in right order again so as to not eat
# painful being considerate of other scripts
unless (scalar @concerned) {
$trace_track{$serverid}[2] = 0;
command('recv ' . $trace_track{$serverid}[0]);
command('recv ' . $_[1][0]);
return EAT_ALL;
}
# We survived? Ok, so $trace_track{$serverid}[1] is the IP with ()s around it (most likely), possibly 255.255.255.255
my $ip = $trace_track{$serverid}[1];
$ip =~ s/^\(//;
$ip =~ s/\)$//;
# 262 Has form: :server.network.net 205 mynick TargetNick :End of TRACE
for my $entry (@concerned) {
$entry->{'ip'} = $ip;
if ($entry->{'continue'} != 0) {
run_mode($entry);
}
}
# clear our tracking so we can catch more later
$trace_track{$serverid} = undef;
return EAT_XCHAT;
}
# trace is handled different from other items
# may not even get a result, this is a benefit run, not guaranteed, but helpful
sub run_trace {
my $retrieved = shift;
my $needtrace = 1;
my $needtracerequest = 1;
return unless $retrieved->{'continue'};
$retrieved->{'stage'} = 'trace';
# really don't want to do a trace if can help it, quite evil. So see if can get IP
# from other run, and skip ahead
for my $entry (@$bank) {
if ( $entry->{'instance'} != $retrieved && $entry->{'serverid'} == $retrieved->{'serverid'}
&& $entry->{'continue'} && nickcmp($entry->{'nick'}, $retrieved->{'nick'}) == 0
&& defined $entry->{'stage'} ) {
# after that, three cases.
# 1) No one has hit the trace (use default, they are all at whois)
# 2) other instance already asked for trace and waiting
# 3) Already did this stage, can grab and go
if ($entry->{'stage'} eq 'whois') {
}
elsif ($entry->{'stage'} eq 'trace') {
$needtracerequest = 0;
}
# past those stages, so all done here
else {
$needtrace = 0;
$needtracerequest = 0;
$retrieved->{'ip'} = $entry->{'ip'} if (defined $entry->{'ip'});
last;
}
}
}
if ($needtracerequest) {
unless (defined $trace_hooks && scalar %$trace_hooks) {
$trace_hooks->{205} = hook_server('205', \&trace_callback, { priority => PRI_HIGHEST });
$trace_hooks->{262} = hook_server('262', \&trace_end_callback, { priority => PRI_HIGHEST });
# unknown command handle
$trace_hooks->{'421'} = hook_server('421', sub {
if (lc $_[0][3] eq 'trace') {
# move on anything that is still waiting for a trace
for my $entry (@$bank) {
if ( $entry->{'continue'} != 0 && defined $entry->{'stage'} && $entry->{'stage'} eq 'trace' ) {
$entry->{'time'} = time; # reset timeout
run_mode($entry);
}
}
return EAT_XCHAT;
}
else {
return EAT_NONE;
}
});
}
command("quote TRACE $retrieved->{'nick'}");
}
elsif ($needtrace == 0) {
run_mode($retrieved);
}
}
sub quietlist_callback {
my $serverid = context_info()->{'id'};
my @concerned;
my $quietlist_count = 0;
for my $entry (@$bank) {
if ( defined $entry->{'stage'} && $entry->{'stage'} eq 'quietlist' ) {
$quietlist_count++;
if ( $entry->{'serverid'} == $serverid && nickcmp($entry->{'channel'}, $_[0][3]) == 0) {
push @concerned, $entry;
$entry->{'time'} = time; # reset timeout
}
}
}
# leave callback if line came from a channel we aren't concerned about
return EAT_NONE unless (scalar @concerned);
my $evt = $_[2];
my $done_with = 1;
my $continue = 1;
# quiets may come in as either 367 (looks just like a ban reply), or 728 (prefaced with a "q")
if ($evt eq '367' || $evt eq '728') {
$done_with = 0;
my @words = @{$_[0]};
# if it is a 728, we just need to remove one of the words to make the indexes line up
shift @words if ($evt eq '728');
my $quiet_details = {
'pattern' => $words[4],
'setter' => $words[5],
'timestamp' => $words[6]
};
# all concerned quietlists will be the same array reference
# if this is the first entry, need to make sure all concerned get the same
if ( ! defined $concerned[0]->{'quietlist'} ) {
my $quietlist_ref = [];
for my $entry (@concerned) {
$entry->{'quietlist'} = $quietlist_ref;
}
}
push @{$concerned[0]->{'quietlist'}}, $quiet_details;
}
# Channel somehow dissapeared since the initial mode
elsif ($evt eq '403') {
$continue = 0;
for my $entry (@concerned) {
# only report if didn't already report
if ($entry->{'continue'} > 0) {
abort_run($entry, "Channel $_[0][3] doesn't exist. Aborting query.");
}
}
}
# requires being in the channel, so we cannot check for others
elsif ($evt eq '442') {
$continue = 0;
for my $entry (@concerned) {
# only report if didn't already report
if ($entry->{'continue'} > 0) {
abort_run($entry, "You are not in $_[0][3]. Unable to ubtain information. Aborting query.");
}
}
}
# may get a 472 event, but don't actually care, as this just means that a user cannot be quieted
if ($done_with == 1) {
# clear the hooks if no other channels waiting
if (scalar @concerned == $quietlist_count) {
remove_hooks($quiet_hooks);
}
# if we don't have error, display results of what we have
if ($continue) {
for my $entry (@concerned) {
display_results($entry);
}
}
}
# should still allow other scripts to catch list if they want it
return EAT_XCHAT;
}
# a callable sub to get the quiets of channel
sub run_quiet_listing {
my $retrieved = shift;
my $needquietlist = 1;
my $needquietlistwait = 1;
return unless $retrieved->{'continue'};
$retrieved->{'stage'} = 'quietlist';
# check to see if this quiet listing is being done on another check
for my $entry (@$bank) {
if ( $entry->{'instance'} != $retrieved && $entry->{'serverid'} == $retrieved->{'serverid'}
&& nickcmp($entry->{'channel'}, $retrieved->{'channel'}) == 0
&& (defined $entry->{'quietlist'} || $entry->{'stage'} eq 'quietlist') ) {
$needquietlist = 0;
# one quietlist is the same as another, don't need to duplicate dereferenced array reference
if (defined $entry->{'quietlist'}) {
$retrieved->{'quietlist'} = $entry->{'quietlist'};
}
# potentially was retrieved from a completed run
$needquietlistwait = 0 if ( defined $entry->{'stage'} && $entry->{'stage'} ne 'banlist' );
last; # leave for loop
}
}
if ($needquietlist) {
# hooks are cleared after they aren't needed, so if they don't exist, put them back in place
unless (defined $mode_hooks && scalar %$mode_hooks) {
# uses some of the same numerics as ban on some ircds, additional ones on others
my @quiet_raws = (
'403', # No such channel
'367', # listing
'368', # End list
'728', # listing, prefaced by q
'729', # End list
'442', # If on a network that cannot list quiets when not in that channel
'472', # network doesn't know this mode
);
for my $quiet_raw ( @quiet_raws ) {
$quiet_hooks->{$quiet_raw} =
hook_server($quiet_raw, \&quietlist_callback, { data => $quiet_raw , priority => PRI_HIGH });
}
}
command("quote MODE $retrieved->{'channel'} q");
}
elsif ( ! $needquietlistwait ) {
display_results($retrieved);
}
# otherwise, we are still waiting for quiet listings to come in, and that is being auto handled
}
# The callback for when receiving expected ban listing replies
sub banlist_callback {
my $serverid = context_info->{'id'};
my @concerned;
my $banlist_count = 0;
for my $entry (@$bank) {
if ( defined $entry->{'stage'} && $entry->{'stage'} eq 'banlist' ) {
$banlist_count++;
if ( $entry->{'serverid'} == $serverid && nickcmp($entry->{'channel'}, $_[0][3]) == 0) {
push @concerned, $entry;
$entry->{'time'} = time; # reset timeout
}
}
}
# leave callback if line came from a channel we aren't concerned about
return EAT_NONE unless (scalar @concerned);
my $evt = $_[2];
my $done_with = 1;
my $continue = 1;
# each ban line has a 367 event
if ($evt eq '367') {
$done_with = 0;
my $ban_details = {
'pattern' => $_[0][4],
'setter' => $_[0][5],
'timestamp' => $_[0][6]
};
# all concerned banlists will be the same array reference
# if this is the first entry, need to make sure all concerned get the same
if ( ! defined $concerned[0]->{'banlist'} ) {
my $banlist_ref = [];
for my $entry (@concerned) {
$entry->{'banlist'} = $banlist_ref;
}
}
push @{$concerned[0]->{'banlist'}}, $ban_details;
}
# Channel doesn't exist
elsif ($evt eq '403') {
$continue = 0;
for my $entry (@concerned) {
# only report if didn't already report
if ($entry->{'continue'} > 0) {
abort_run($entry, "Channel $_[0][3] doesn't exist. Aborting query.");
}
}
}
# requires being in the channel, so we cannot check for others
elsif ($evt eq '442') {
$continue = 0;
for my $entry (@concerned) {
# only report if didn't already report
if ($entry->{'continue'} > 0) {
abort_run($entry, "You are not in $_[0][3]. Unable to ubtain information. Aborting query.");
}
}
}
if ($done_with == 1) {
# clear the hooks if no other channels waiting
if (scalar @concerned == $banlist_count) {
remove_hooks($ban_hooks);
}
if ($continue) {
for my $entry (@concerned) {
run_quiet_listing($entry);
}
}
}
# should still allow other scripts to catch list if they want it
return EAT_XCHAT;
}
# a callable sub to get the bans of channel
sub run_ban_listing {
my $retrieved = shift;
my $needbanlist = 1;
my $needbanlistwait = 1;
$retrieved->{'stage'} = 'banlist';
# check to see if this ban listing is being done on another check, or has already been completed
for my $entry (@$bank) {
if ( $entry->{'instance'} != $retrieved && $entry->{'serverid'} == $retrieved->{'serverid'}
&& nickcmp($entry->{'channel'}, $retrieved->{'channel'}) == 0
&& (defined $entry->{'banlist'} || $entry->{'stage'} eq 'banlist') ) {
$needbanlist = 0;
# one banlist is the same as another, don't need to duplicate dereferenced array reference
if (defined $entry->{'banlist'}) {
$retrieved->{'banlist'} = $entry->{'banlist'};
}
# if other run is past the banlist, we can move on as well
$needbanlistwait = 0 if ( defined $entry->{'stage'} && $entry->{'stage'} ne 'banlist' );
last; # leave for loop
}
}
if ($needbanlist) {
# hooks are cleared after they aren't needed, so if they don't exist, put them back in place
unless (defined $ban_hooks && scalar %$ban_hooks) {
# raw numerics that potentially could come based on a 'mode $channel b'
my @ban_raws = (
'403', # No such channel
'367', # listing
'368', # End list
'442', # If on a network that cannot list bans when not in that channel
);
for my $ban_raw ( @ban_raws ) {
$ban_hooks->{$ban_raw} =
hook_server($ban_raw, \&banlist_callback, { data => $ban_raw , priority => PRI_HIGH });
}
}
command("quote MODE $retrieved->{'channel'} b");
}
elsif ( ! $needbanlistwait ) {
run_quiet_listing($retrieved);
}
# otherwise, we are still waiting for ban listings to come in, and that is being auto handled
}
# The callback for when receiving expected mode replies
sub mode_callback {
my $serverid = context_info->{'id'};
my @concerned;
my $mode_count = 0;
for my $entry (@$bank) {
if ( defined $entry->{'stage'} && $entry->{'stage'} eq 'mode' ) {
$mode_count++;
if ( $entry->{'serverid'} == $serverid && nickcmp($entry->{'channel'}, $_[0][3]) == 0) {
push @concerned, $entry;
$entry->{'time'} = time; # reset timeout
}
}
}
# leave callback if line came from a channel we aren't concerned about
return EAT_NONE unless (scalar @concerned);
my $evt = $_[2];
my $done_with = 1;
my $continue = 1;
# The actual mode, have a line after this we expect.
if ($evt eq '324') {
for my $entry (@concerned) {
$entry->{'chanmode'} = $_[1][4];
}
$done_with = 0;
}
# Channel doesn't exist
elsif ($evt eq '403') {
$continue = 0;
for my $entry (@concerned) {
# only report if didn't already report
if ($entry->{'continue'} > 0) {
abort_run($entry, "Channel $_[0][3] doesn't exist. Aborting query.");
}
}
}
# requires being in the channel, so we cannot check for others
elsif ($evt eq '442') {
$continue = 0;
for my $entry (@concerned) {
# only report if didn't already report
if ($entry->{'continue'} > 0) {
abort_run($entry, "You are not in $_[0][3]. Unable to obtain information. Aborting query.");
}
}
}
# if we have a terminating event, clean up as not expecting other lines
if ($done_with == 1) {
# clear the hooks if no other channels waiting
if (scalar @concerned == $mode_count) {
remove_hooks($mode_hooks);
}
if ($continue) {
for my $entry (@concerned) {
run_ban_listing($entry);
}
}
}
# only eating XChat if some other script had also wanted this
return EAT_XCHAT;
}
# a callable sub to get the mode of channel
sub run_mode {
my $retrieved = shift;
my $needmode = 1;
return unless $retrieved->{'continue'};
$retrieved->{'stage'} = 'mode';
# check to see if this mode is being done on another check, or has already been completed
for my $entry (@$bank) {
if ( $entry->{'instance'} != $retrieved && $entry->{'serverid'} == $retrieved->{'serverid'}
&& nickcmp($entry->{'channel'}, $retrieved->{'channel'}) == 0 && defined $entry->{'chanmode'}) {
$needmode = 0;
$retrieved->{'chanmode'} = $entry->{'chanmode'};
last; # leave for loop
}
}
if ($needmode) {
# hooks are cleared after they aren't needed, so if they don't exist, put them back in place
unless (defined $mode_hooks && scalar %$mode_hooks) {
my @mode_raws = (
'403', # No such channel
'324', # The mode reply
'329', # Time Stamp
'442', # If on a network that cannot list bans when not in that channel
);
for my $mode_raw ( @mode_raws ) {
$mode_hooks->{$mode_raw} =
hook_server($mode_raw, \&mode_callback, { data => $mode_raw });
}
}
command("quote MODE $retrieved->{'channel'}");
}
# have the mode? move on to ban list
else {
run_ban_listing($retrieved);
}
}
# Say why aborting, set to done, shouldn't continue
# abort_run $instance, $reason
sub abort_run {
my $instance = shift;
my $reason = shift;
info_alert($reason, $instance->{'context'});
$instance->{'done'} = 1;
$instance->{'continue'} = 0;
}
sub remove_from_bank {
my $removeme = shift;
my $index = 0;
$index++ until $$bank[$index] == $removeme;
splice(@$bank, $index, 1);
}
# Print incoming line in right context with info preface
sub info_alert {
# keep track of current context, and if one is passed in, print there
my $current_context;
if (defined $_[1]) {
$current_context = get_context;
$current_context = undef if ($current_context == $_[1] || ! set_context($_[1]));
}
prnt $INFO_PREFACE . $_[0];
# set the context back to be polite
if (defined $current_context) {
set_context($current_context);
}
}
# Actually determine the reasons here, and then display them
sub display_results {
my $retrieved = shift;
my $reasons = [];
# Set as done so if another script is going up until the timeout, it can populate without query
$retrieved->{'done'} = 1;
$retrieved->{'stage'} = 'finished';
# start by checking the mode
$retrieved->{'chanmode'} =~ /^\+?(\S*)/;
my $chanmode = $1;
my $channel = $retrieved->{'channel'};
my $nick = $retrieved->{'nick'};
# Check channel mode as to why user cannot join/talk
if ( $chanmode =~ /m/ ) {
push @$reasons, [ "The channel \002$channel\002 is +m. Make sure \002$nick\002 is voiced or higher." ];
}
if ( $chanmode =~ /i/ ) {
push @$reasons, [ "The channel \002$channel\002 is invite only." ];
}
if ( $chanmode =~ /k/ ) {
push @$reasons, [ "The channel \002$channel\002 has a key." ];
}
if ( $chanmode =~ /r/ && ! defined $retrieved->{'account'} ) {
push @$reasons, [ "The channel \002$channel\002 is +r and \002$nick\002 is not identified to services, so cannot join." ];
}
# for both Ban and Quiet, farm out to get the reasons
list_parse($retrieved, $reasons, 'Ban', $retrieved->{'banlist'});
list_parse($retrieved, $reasons, 'Quiet', $retrieved->{'quietlist'});
# Actually display what we found out
# keep track of current context, so we can set back to it if different
my $current_context = get_context;
# unset the context (as don't need to change) if it is the same context as currently in, or cannot set a new context
$current_context = undef unless ($current_context != $retrieved->{'context'} && set_context($retrieved->{'context'}));
if ( scalar @$reasons == 0 ) {
info_alert ("Nothing appears to be restricting \002$nick\002 from \002$channel\002");
}
else {
info_alert ("Found the following issue".(scalar @$reasons > 1 ? 's' : '')." with \002$nick\002 and \002$channel\002 :");
# reasons are grouped together based on row for verbose purposes
foreach my $reason_group ( @$reasons ) {
foreach ( @$reason_group ) {
prnt $_;
}
}
}
# set the context back to be polite
if (defined $current_context) {
set_context($current_context);
}
}
# a simple rfc1459 regex for use in s//rfc1459($1)/ge to deal with odd casemapping
sub rfc1459_regex {
my $in = shift;
my $ret;
if ($in eq '[' || $in eq '{') {
$ret = '[\[\{]';
}
elsif ($in eq ']' || $in eq '}') {
$ret = '[\]\}]';
}
elsif ($in eq '\\' || $in eq '|') {
$ret = '[\\\\\|]';
}
return $ret;
}
# list_parse( $retrieved_reference, $reasons_reference, $named, $list_reference )
sub list_parse {
my $retrieved = shift;
my $reasons = shift;
my $kind = shift;
my $list = shift;
# setup extban x, and potential items only self and oppers se
my ($extb_x, $extb_x_ip, $extb_x_host_priv, $extb_x_ip_priv, $connectedip, $connectedhost, $public_ip);
# get the array reference ready, gets set each row
my $row_reason;
# these two are only seen on self whois and by oppers, but if we already have the public version, no need for oper only version
if ( defined $retrieved->{'connectedip'} && $retrieved->{'connectedip'} ne $retrieved->{'fullhost'} ) {
$connectedip = $retrieved->{'connectedip'};
}
if ( defined $retrieved->{'connectedhost'} && $retrieved->{'connectedhost'} ne $retrieved->{'fullhost'} ) {
$connectedhost = $retrieved->{'connectedhost'};
}
# put together items from /trace to make a full mask if it is there and not 255.255.255.255
if ( defined $retrieved->{'ip'} && $retrieved->{'ip'} ne '255.255.255.255' ) {
$public_ip = $retrieved->{'nick'} .'!'. $retrieved->{'ident'} . '@' . $retrieved->{'ip'};
}
# compiling extban x items
if ( defined $retrieved->{'realname'} ) {
$extb_x = $retrieved->{'fullhost'} .'#'. $retrieved->{'realname'};
# these two depend on same conditions as already checked above
if ( defined $connectedip ) {
$extb_x_ip_priv = $connectedip .'#'. $retrieved->{'realname'};
}
if ( defined $connectedhost ) {
$extb_x_host_priv = $connectedhost .'#'. $retrieved->{'realname'};
}
if ( defined $public_ip ) {
$extb_x_ip = $public_ip .'#'. $retrieved->{'realname'};
}
}
# loop through each of the ban or quiet entries to compare
foreach my $item (@$list) {
# convert the pattern into a goodish regular expression version
my $pattern = $item->{'pattern'};
$pattern =~ s/\$\#.*$//; # strip ban forwards
# handling RFC1459 case mappings is assumed as don't have 005 storred yet
$pattern =~ s/([\[\{\]\}\\\|])/rfc1459_regex($1)/ge;
$pattern =~ s/\./\\./g;
$pattern =~ s/([\|\@\/\^])/\\$1/g;
$pattern =~ s/\?/\./g;
$pattern =~ s/\*/\.\*/g;
# clear out previous row reasons
$row_reason = [];
# Check extbans
if ($pattern =~ m/^\$/) {
# check to see if account is banned
if ($pattern =~ m/^\$a:(.*?)$/i) {
if ( defined $retrieved->{'account'} && $retrieved->{'account'} =~ m/$1/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches account \002$1\002";
}
}
# check to see if restricted to accounts matching pattern
elsif ($pattern =~ m/^\$~a:(.*?)$/i) {
if ( ! defined $retrieved->{'account'} || $retrieved->{'account'} !~ m/$1/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 affects non matches, such as account \002$1\002";
}
}
# check to see if restricted to users with accounts
elsif ($pattern =~ m/^\$~a$/i) {
if ( ! defined $retrieved->{'account'} ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches user not signed in";
}
}
# compare against the real name
elsif ($pattern =~ m/^\$r:(.*?)$/i) {
if ( defined $retrieved->{'realname'} && $retrieved->{'realname'} =~ m/$1/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches real name: $retrieved->{'realname'}";
}
}
# compare against real name not matching
elsif ($pattern =~ m/^\$~r:(.*?)$/i) {
if ( ! defined $retrieved->{'realname'} || $retrieved->{'realname'} !~ m/$1/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 affects non matches, such as real name: $retrieved->{'realname'}";
}
}
# compare on x extban, which is a combination of full host and real name
elsif ($pattern =~ m/^\$x:(.*?)$/i) {
my $compare = $1;
if ( defined $extb_x && $extb_x =~ m/$compare/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $extb_x";
}
# not private info, but based on IP. Already had been likely compared to not be the same as above
if ( defined $extb_x_ip && $extb_x_ip =~ m/$compare/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $extb_x_ip";
}
# these items are only determined if either an ircop or is the user checking theirself
if ( defined $extb_x_ip_priv && $extb_x_ip_priv =~ m/$compare/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $extb_x_ip_priv $INFO_SPECIAL_PRIVS";
}
if ( defined $extb_x_host_priv && $extb_x_host_priv =~ m/$compare/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $extb_x_host_priv $INFO_SPECIAL_PRIVS";
}
}
# This extban is trickier, as if any of the patterns match, the whole row doesn't
elsif ($pattern =~ m/^\$~x:(.*?)$/i) {
my $matched = 0;
my $compare = $1;
# increment if matched for any of options
$matched++ if ( defined $extb_x && $extb_x =~ m/$compare/i );
$matched++ if ( defined $extb_x_ip && $extb_x_ip =~ m/$compare/i );
$matched++ if ( defined $extb_x_ip_priv && $extb_x_ip_priv =~ m/$compare/i );
$matched++ if ( defined $extb_x_host_priv && $extb_x_host_priv =~ m/$compare/i );
if ( $matched ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 doesn't match $extb_x";
if ( defined $extb_x_ip ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 doesn't match $extb_x_ip";
}
if ( defined $extb_x_ip_priv ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 doesn't match $extb_x_ip_priv $INFO_SPECIAL_PRIVS";
}
if ( defined $extb_x_host_priv ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 doesn't match $extb_x_host_priv $INFO_SPECIAL_PRIVS";
}
}
}
# check for if channel bans/quiets SSL users
elsif ($pattern =~ m/^\$z$/i) {
if ( defined $retrieved->{'ssl'} && $retrieved->{'ssl'} ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002, SSL connections are affected. $retrieved->{'nick'} is on an SSL connection.";
}
}
# check for if channel bans/quiets non-SSL users
elsif ($pattern =~ m/^\$~z$/i) {
if ( ! defined $retrieved->{'ssl'} || ! $retrieved->{'ssl'} ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002, non-SSL connections are affected. $retrieved->{'nick'} is not on an SSL connection.";
}
}
}
# check normal patterns
else {
# compare based on host as reported in whois
if ( defined $retrieved->{'fullhost'} && $retrieved->{'fullhost'} =~ m/$pattern/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $retrieved->{'fullhost'}";
}
# compare based on ip version of host from /trace
if ( defined $public_ip && $public_ip =~ m/$pattern/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $public_ip";
}
# these items are only determined if either an ircop or is the user checking theirself
if ( defined $connectedip && $connectedip =~ m/$pattern/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $connectedip $INFO_SPECIAL_PRIVS";
}
if ( defined $connectedhost && $connectedhost =~ m/$pattern/i ) {
push @$row_reason, "$kind on \002$item->{'pattern'}\002 matches $connectedhost $INFO_SPECIAL_PRIVS";
}
}
# if we found a reason, add to actual reasons list
if ( scalar @$row_reason ) {
# only add in the setter and timestamp if in verbose mode
if ($retrieved->{'verbose'} ) {
push @$row_reason, ' set by '.$item->{'setter'}.' '.gmtime($item->{'timestamp'});
}
# add the rows reason to the list of reasons
push @$reasons, $row_reason;
}
}
}
__END__
zib License:
Copyright (c) 2013 Brian Evans
whybanned.pl is provided 'as-is', without any express or implied
warranty. In no event will the authors be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not
be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
distribution.
@LifeIsPain
Copy link
Author

There is a bug in XChat and HexChat that can be triggered by this script that causes either to crash. This risk is minimized in the latest version of the script, but it still exists. To completely remove this risk, use the SVN version of XChat, or 2.8.10 when it is released.

@AwwCookies
Copy link

Bug? _HexChat_: Sometimes I have to do /whybanned twice for it to work.

using: '/whybanned --channel ##foo --user foo'

First time gives:

Why Banned: Nothing appears to be restricting foo from ##foo

Second time gives:

Why Banned: Found the following issue with foo and ##foo :
Ban on *!*@gateway/web/freenode/* matches foo!null@gateway/web/freenode/ip.127.0.0.1

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment