Last active
December 18, 2015 15:29
-
-
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
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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. |
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
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.