summaryrefslogtreecommitdiffstats
path: root/scripts/whitelist.pl
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/whitelist.pl')
-rw-r--r--scripts/whitelist.pl445
1 files changed, 445 insertions, 0 deletions
diff --git a/scripts/whitelist.pl b/scripts/whitelist.pl
new file mode 100644
index 0000000..836eec9
--- /dev/null
+++ b/scripts/whitelist.pl
@@ -0,0 +1,445 @@
+##
+# /toggle whitelist_notify [default ON]
+# Print a message in the status window if someone not on the whitelist messages us
+#
+# /toggle whitelist_log_ignored_msgs [default ON]
+# if this is on, ignored messages will be logged to ~/.irssi/whitelist.log
+#
+# /set whitelist_nicks phyber etc
+# nicks that are allowed to msg us (whitelist checks for a valid nick before a valid host)
+#
+# /toggle whitelist_nicks_case_sensitive [default OFF]
+# do we care which case nicknames are in?
+#
+# Thanks to Geert for help/suggestions on this script
+#
+# Karl "Sique" Siegemund's addition:
+# Managing the whitelists with the /whitelist command:
+#
+# /whitelist add nick <list of nicks>
+# puts new nicks into the whitelist_nicks list
+#
+# /whitelist add host <list of hosts>
+# puts new hosts into the whitelist_hosts list
+#
+# /whitelist add chan[nel] <list of channels>
+# puts new channels into the whitelist_channels list
+#
+# /whitelist add net[work] <list of chatnets/servers>
+# puts new chatnets or irc servers into the whitelist_networks list
+#
+# /whitelist del nick <list of nicks>
+# removes the nicks from whitelist_nicks
+#
+# /whitelist del host <list of hosts>
+# removes the hosts from whitelist_hosts
+#
+# /whitelist del chan[nel] <list of channels>
+# removes the channels from whitelist_channels
+#
+# /whitelist del net[work] <list of chatnets/servers>
+# removes the chatnets or irc servers from whitelist_networks
+#
+# Instead of the 'del' modifier you can also use 'remove':
+# /whitelist remove [...]
+#
+# /whitelist nick
+# shows the current whitelist_nicks
+#
+# /whitelist host
+# shows the current whitelist_hosts
+#
+# /whitelist chan[nel]
+# shows the current whitelist_channels
+#
+# /whitelist net[work]
+# shows the current whitelist_networks
+#
+# Additional feature for nicks, channels and hosts:
+# You may use <nick>@<network>/<ircserver>, <host>@<network>/<ircserver>
+# and <channel>@<network>/<ircserver> to restrict the whitelisting to the
+# specified network or ircserver.
+#
+# The new commands are quite verbose. They are so for a reason: The commands
+# should be easy to remember and self explaining. If someone wants shorter
+# commands, feel free to use 'alias'.
+##
+# /whitelist upgrade
+# convert the old style settings to the new hash/config file based settings.
+# you MUST run this if you haven't generated a config file yet.
+#
+# /whitelist show
+# shows you all of the whitelisted entries.
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use IO::File;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "David O\'Rourke, Karl Siegemund",
+ contact => "phyber \[at\] #irssi, q \[at\] spuk.de",
+ name => "whitelist",
+ description => "Whitelist specific nicks or hosts and ignore messages from anyone else.",
+ license => "GPLv2",
+ changed => "12/03/2007 15:20 GMT"
+);
+
+# location of the settings file
+my $settings_file = Irssi::get_irssi_dir.'/whitelist.conf';
+# This hash stores our various whitelists.
+my %whitelisted;
+
+# A mapping to convert simple regexp (* and ?) into Perl regexp
+my %htr = ( );
+foreach my $i (0..255) {
+ my $ch = chr($i);
+ $htr{$ch} = "\Q$ch\E";
+}
+$htr{'?'} = '.';
+$htr{'*'} = '.*';
+
+# A list of settings we can use and change
+my %types = (
+ 'nick' => 'nicks',
+ 'host' => 'hosts',
+ 'chan' => 'channels',
+ 'channel' => 'channels',
+ 'net' => 'networks',
+ 'network' => 'networks',
+);
+
+sub host_to_regexp {
+ my ($mask) = @_;
+ $mask = lc_host($mask);
+ $mask =~ s/(.)/$htr{$1}/g;
+ return $mask;
+}
+
+sub lc_host {
+ my ($host) = @_;
+ $host =~ s/(.+)\@(.+)/sprintf("%s@%s", $1, lc($2));/eg;
+ return $host;
+}
+
+# Show the current config
+sub print_config {
+ foreach my $listtype (keys %whitelisted) {
+ my $str = join ' ', @{$whitelisted{$listtype}};
+ Irssi::print "Whitelisted $listtype: $str";
+ }
+}
+
+# Read in the whitelist.conf
+sub read_config {
+ # nicks, hosts, channels, networks
+ my $f = IO::File->new($settings_file, 'r');
+ #die "Couldn't open $settings_file for reading" if (!defined $f);
+ if (!defined $f) {
+ Irssi::print "Couldn't open $settings_file for reading. Do you need to generate a config file with '/whitelist upgrade' ?";
+ return;
+ }
+
+ while (<$f>) {
+ chomp;
+ my ($listtype, @list) = split / /, $_;
+ @{$whitelisted{$listtype}} = map { $_ } @list;
+
+ # Make sure there is no duplicate weirdness
+ undef my %saw;
+ @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}});
+ }
+ $f = undef;
+}
+
+# Write out the whitelist.conf
+sub write_config {
+ my $f = IO::File->new($settings_file, 'w');
+ die "Couldn't open $settings_file for writing" if (!defined $f);
+
+ foreach my $listtype (keys %whitelisted) {
+ # Make sure we arn't writing duplicates
+ undef my %saw;
+ @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}});
+
+ my $str = join ' ', @{$whitelisted{$listtype}};
+ print {$f} "$listtype $str\n";
+ }
+ $f = undef;
+}
+
+# convert old settings to new settings (/whitelist upgrade)
+sub old2new {
+ my $nicks = Irssi::settings_get_str('whitelist_nicks');
+ my $hosts = Irssi::settings_get_str('whitelist_hosts');
+ my $channels = Irssi::settings_get_str('whitelist_channels');
+ my $networks = Irssi::settings_get_str('whitelist_networks');
+
+ foreach my $nick (split /\s+/, $nicks) {
+ next if not length $nick;
+ push @{$whitelisted{'nicks'}}, $nick;
+ }
+
+ foreach my $host (split /\s+/, $hosts) {
+ next if not length $host;
+ push @{$whitelisted{'hosts'}}, $host;
+ }
+
+ foreach my $channel (split /\s+/, $channels) {
+ next if not length $channel;
+ push @{$whitelisted{'channels'}}, $channel;
+ }
+
+ foreach my $network (split /\s+/, $networks) {
+ next if not length $network;
+ push @{$whitelisted{'networks'}}, $network;
+ }
+
+ write_config();
+}
+# This one gets called from IRSSI if we get a private message (PRIVMSG)
+sub whitelist_check {
+ my ($server, $msg, $nick, $address) = @_;
+ # these four settings are stored in a hash now after reading the config file.
+ #my $nicks = Irssi::settings_get_str('whitelist_nicks');
+ #my $hosts = Irssi::settings_get_str('whitelist_hosts');
+ #my $channels = Irssi::settings_get_str('whitelist_channels');
+ #my $networks = Irssi::settings_get_str('whitelist_networks');
+ my $warning = Irssi::settings_get_bool('whitelist_notify');
+ my $casesensitive = Irssi::settings_get_bool('whitelist_nicks_case_sensitive');
+ my $logging = Irssi::settings_get_bool('whitelist_log_ignored_msgs');
+ my $logfile = Irssi::get_irssi_dir.'/whitelist.log';
+
+ my $hostmask = "$nick!$address";
+
+ my $tag = $server->{chatnet};
+ $tag = $server->{tag} unless defined $tag;
+ $tag = lc($tag);
+
+ # Handle servers first, because they are the most significant,
+ # Nicks, Channels and Hostmasks are always local to a network
+ foreach my $network (@{$whitelisted{'networks'}}) {
+ # Change it to lower case
+ $network = lc($network);
+ # Kludge. Sometimes you get superfluous '', you have to ignore
+ next if ($network eq '');
+ # Rewrite simplified regexp (* and ?) to Perl regexp
+ $network =~ s/(.)/$htr{$1}/g;
+ # Either the server tag matches
+ return if ($tag =~ /$network/);
+ # Or its address
+ return if ($server->{address} =~ /$network/);
+ }
+
+ # Nicks are the easiest to handle with the least computational effort.
+ # So do them before hosts and networks.
+ foreach my $whitenick (@{$whitelisted{'nicks'}}) {
+ if (!$casesensitive) {
+ $nick = lc($nick);
+ $whitenick = lc($whitenick);
+ }
+ # Simple check first: Is the nick itself whitelisted?
+ return if ($nick eq $whitenick);
+ # Second check: We have to look if the nick was localized to a network
+ # or irc server. So we have to look at <nick>@<network> too.
+ ($whitenick, my $network) = split /@/, $whitenick, 2;
+ # Ignore nicks without @<network>
+ next if !defined $network;
+ # Convert simple regexp to Perl regexp
+ $network =~ s/(.)/$htr{$1}/g;
+ # If the nick matches...
+ if ($nick eq $whitenick) {
+ # ...allow if the server tag is right...
+ return if ($tag =~ /$network/);
+ # ...or the server address matches
+ return if ($server->{address} =~ /$network/);
+ }
+ }
+
+ # Hostmasks are somewhat more sophisticated, because they allow wildcards
+ foreach my $whitehost (@{$whitelisted{'hosts'}}) {
+ # Kludge, sometimes you get ''
+ next if ($whitehost eq '');
+ # First reconvert simple regexp to Perl regexp
+ $whitehost = host_to_regexp($whitehost);
+ # Allow if the hostmask matches
+ return if ($hostmask =~ /$whitehost/);
+ # Check if hostmask is localized to a network
+ (my $whitename, $whitehost, my $network) = split /@/, $whitehost, 3;
+ # Ignore hostmasks without attached network
+ next if !defined $network;
+ # We don't need to convert the network address again
+ # $network =~ s/(.)/$htr{$1}/g;
+ # But we have to reassemble the hostmask
+ $whitehost = "$whitename\@$whitehost";
+ # If the hostmask matches...
+ if ($hostmask eq $whitehost) {
+ # ...allow if the server tag is ok...
+ return if ($tag =~ /$network/);
+ # ... or the server address
+ return if ($server->{address} =~ /$network/);
+ }
+ }
+
+ # Channels require some interaction with the server, so we do them last,
+ # hoping that some ACCEPT cases are already done, thus saving computation
+ # time and effort
+ foreach my $channel (@{$whitelisted{'channels'}}) {
+ # Check if we are on the specified channel
+ my $chan = $server->channel_find($channel);
+ # If yes...
+ if (defined $chan) {
+ # Check if the nick in question is also on that channel
+ my $chk = $chan->nick_find($nick);
+ # Allow the message
+ return if defined $chk;
+ }
+ # Check if we are talking about a localized channel
+ ($chan, my $network) = split /@/, $_, 2;
+ # Ignore not localized channels
+ next if !defined $network;
+ # Convert simple regexp to Perl regexp
+ $network =~ s/(.)/$htr{$1}/g;
+ # Ignore channels from a differently tagged server or from a different
+ # address
+ next if (!($tag =~ /$network/ || $server->{address} =~ /$network/));
+ # Check if we are on the channel
+ $chan = $server->channel_find($chan);
+ # Ignore if not
+ next unless defined $chan;
+ # Check if $nick is on that channel too
+ my $chk = $chan->nick_find($nick);
+ # Allow if yes
+ return if defined $chk;
+ }
+
+ # Do we want a notice about this message attempt?
+ if ($warning) {
+ Irssi::print "[$tag] $nick [$address] attempted to send private message.";
+ }
+
+ # Do we want to make a log entry for it?
+ if ($logging) {
+ my $f = IO::File->new($logfile, '>>');
+ return if (!defined $f);
+ print {$f} localtime().": [$tag] $nick [$address]: $msg\n";
+ $f = undef;
+ }
+
+ # stop if the message isn't from a whitelisted address
+ Irssi::signal_stop();
+ return;
+}
+
+sub usage {
+ Irssi::print "Usage: whitelist (add|del|remove) (nick|host|chan[nel]|net[work]) <list>";
+ Irssi::print " whitelist (nick|host|chan[nel]|net[work])";
+ Irssi::print " whitelist upgrade";
+ Irssi::print " whitelist show";
+}
+
+# This is bound to the /whitelist command
+sub whitelist_cmd {
+ my ($args, $server, $winit) = @_;
+ my ($cmd, $type, $rest) = split /\s+/, $args, 3;
+
+ # What type of settings we want to change?
+ my $listtype = $types{$type};
+
+ # If we didn't get a syntactically correct command, put out an error
+ if(!defined $listtype && defined $type) {
+ usage;
+ return;
+ }
+
+ # What are we doing?
+ if ($cmd eq 'add') {
+ # split $rest into a list.
+ my @list = split /\s+/, $rest;
+
+ # Add the entries to the whitelist and then make sure it's unique
+ foreach my $entry (@list) {
+ push @{$whitelisted{$listtype}}, $entry;
+ undef my %saw;
+ @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}});
+ }
+ } elsif ($cmd eq 'del' || $cmd eq 'remove') {
+ # Escape all letters to protect the Perl Regexp special characters
+ $rest =~ s/(.)/$htr{$1}/g;
+
+ # Make a list of things we want removing.
+ my @list = split /\s+/, $rest;
+
+ # Use grep to remove the list of things we don't want anymore.
+ foreach my $removal (@list) {
+ @{$whitelisted{$listtype}} = grep {!/^$removal$/} @{$whitelisted{$listtype}};
+ }
+ } elsif ($cmd eq 'upgrade') {
+ Irssi::print "Converting old style /settings to new config file based settings";
+ old2new();
+ read_config();
+ print_config();
+ return;
+ } elsif ($cmd eq 'show') {
+ print_config();
+ return;
+ } elsif(!defined $type) {
+ # Look if we just want to see the current values
+ $listtype = $types{$cmd};
+ if (defined $listtype) {
+ # Print them
+ Irssi::print "Whitelist ${cmd}s: ".join ' ', @{$whitelisted{$listtype}};
+ } else {
+ # Or give error message
+ usage;
+ }
+ return;
+ } else {
+ # If we felt through until here, something went wrong
+ usage;
+ return;
+ }
+ # Display the changed value and store it in the settings
+ Irssi::print "Whitelist ${type}s: ".join ' ', @{$whitelisted{$listtype}};
+ # Save the new settings
+ write_config();
+ return;
+}
+
+Irssi::settings_add_bool('whitelist', 'whitelist_notify' => 1);
+Irssi::settings_add_bool('whitelist', 'whitelist_log_ignored_msgs' => 1);
+Irssi::settings_add_bool('whitelist', 'whitelist_nicks_case_sensitive' => 0);
+
+foreach (keys(%types)) {
+ Irssi::settings_add_str('whitelist', 'whitelist_'.$types{$_}, '');
+}
+
+Irssi::signal_add_first('message private', \&whitelist_check);
+
+Irssi::command_bind('whitelist', \&whitelist_cmd);
+
+# Read the config
+\&read_config();
+#########################
+####### Changelog #######
+### 1.0: David O'Rourke
+# Changed how whitelists are stored. We no longer use the settings_*_str for them.
+# We now store them in a hash and write/read a config file.
+# Added '/whitelist old2new' function, for converting to the new style list.
+# Added '/whitelist show' for showing everything that's been whitelisted.
+### 0.9g: David O'Rourke
+# Cleanups.
+### 0.9f: David O'Rourke
+# Cleanups.
+### 0.9e: David O'Rourke
+# Changed print -> Irssi::print
+# Fixed '' in $whitehost
+#########################
+# 0.9d: David O'Rourke
+# General cleanup of script.
+# Removed pointless function timestamp()
+# Removed pointless global variables $tstamp, $whitenick, $whitehost
+# Created whitelist logging directory in ~/.irssi with option to rotate log daily.
+# Fixed comparison of whitelist_networks to $tag. $tag was being lowercased, whitelist_networks was not.