1## 2# /toggle whitelist_notify [default ON] 3# Print a message in the status window if someone not on the whitelist messages us 4# 5# /toggle whitelist_log_ignored_msgs [default ON] 6# if this is on, ignored messages will be logged to ~/.irssi/whitelist.log 7# 8# /set whitelist_nicks phyber etc 9# nicks that are allowed to msg us (whitelist checks for a valid nick before a valid host) 10# 11# /toggle whitelist_nicks_case_sensitive [default OFF] 12# do we care which case nicknames are in? 13# 14# Thanks to Geert for help/suggestions on this script 15# 16# Karl "Sique" Siegemund's addition: 17# Managing the whitelists with the /whitelist command: 18# 19# /whitelist add nick <list of nicks> 20# puts new nicks into the whitelist_nicks list 21# 22# /whitelist add host <list of hosts> 23# puts new hosts into the whitelist_hosts list 24# 25# /whitelist add chan[nel] <list of channels> 26# puts new channels into the whitelist_channels list 27# 28# /whitelist add net[work] <list of chatnets/servers> 29# puts new chatnets or irc servers into the whitelist_networks list 30# 31# /whitelist del nick <list of nicks> 32# removes the nicks from whitelist_nicks 33# 34# /whitelist del host <list of hosts> 35# removes the hosts from whitelist_hosts 36# 37# /whitelist del chan[nel] <list of channels> 38# removes the channels from whitelist_channels 39# 40# /whitelist del net[work] <list of chatnets/servers> 41# removes the chatnets or irc servers from whitelist_networks 42# 43# Instead of the 'del' modifier you can also use 'remove': 44# /whitelist remove [...] 45# 46# /whitelist nick 47# shows the current whitelist_nicks 48# 49# /whitelist host 50# shows the current whitelist_hosts 51# 52# /whitelist chan[nel] 53# shows the current whitelist_channels 54# 55# /whitelist net[work] 56# shows the current whitelist_networks 57# 58# Additional feature for nicks, channels and hosts: 59# You may use <nick>@<network>/<ircserver>, <host>@<network>/<ircserver> 60# and <channel>@<network>/<ircserver> to restrict the whitelisting to the 61# specified network or ircserver. 62# 63# The new commands are quite verbose. They are so for a reason: The commands 64# should be easy to remember and self explaining. If someone wants shorter 65# commands, feel free to use 'alias'. 66## 67# /whitelist upgrade 68# convert the old style settings to the new hash/config file based settings. 69# you MUST run this if you haven't generated a config file yet. 70# 71# /whitelist show 72# shows you all of the whitelisted entries. 73 74use strict; 75use Irssi; 76use Irssi::Irc; 77use IO::File; 78 79use vars qw($VERSION %IRSSI); 80$VERSION = "1.0"; 81%IRSSI = ( 82 authors => "David O\'Rourke, Karl Siegemund", 83 contact => "phyber \[at\] #irssi, q \[at\] spuk.de", 84 name => "whitelist", 85 description => "Whitelist specific nicks or hosts and ignore messages from anyone else.", 86 license => "GPLv2", 87 changed => "12/03/2007 15:20 GMT" 88); 89 90# location of the settings file 91my $settings_file = Irssi::get_irssi_dir.'/whitelist.conf'; 92# This hash stores our various whitelists. 93my %whitelisted; 94 95# A mapping to convert simple regexp (* and ?) into Perl regexp 96my %htr = ( ); 97foreach my $i (0..255) { 98 my $ch = chr($i); 99 $htr{$ch} = "\Q$ch\E"; 100} 101$htr{'?'} = '.'; 102$htr{'*'} = '.*'; 103 104# A list of settings we can use and change 105my %types = ( 106 'nick' => 'nicks', 107 'host' => 'hosts', 108 'chan' => 'channels', 109 'channel' => 'channels', 110 'net' => 'networks', 111 'network' => 'networks', 112); 113 114sub host_to_regexp { 115 my ($mask) = @_; 116 $mask = lc_host($mask); 117 $mask =~ s/(.)/$htr{$1}/g; 118 return $mask; 119} 120 121sub lc_host { 122 my ($host) = @_; 123 $host =~ s/(.+)\@(.+)/sprintf("%s@%s", $1, lc($2));/eg; 124 return $host; 125} 126 127# Show the current config 128sub print_config { 129 foreach my $listtype (keys %whitelisted) { 130 my $str = join ' ', @{$whitelisted{$listtype}}; 131 Irssi::print "Whitelisted $listtype: $str"; 132 } 133} 134 135# Read in the whitelist.conf 136sub read_config { 137 # nicks, hosts, channels, networks 138 my $f = IO::File->new($settings_file, 'r'); 139 #die "Couldn't open $settings_file for reading" if (!defined $f); 140 if (!defined $f) { 141 Irssi::print "Couldn't open $settings_file for reading. Do you need to generate a config file with '/whitelist upgrade' ?"; 142 return; 143 } 144 145 while (<$f>) { 146 chomp; 147 my ($listtype, @list) = split / /, $_; 148 @{$whitelisted{$listtype}} = map { $_ } @list; 149 150 # Make sure there is no duplicate weirdness 151 undef my %saw; 152 @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}}); 153 } 154 $f = undef; 155} 156 157# Write out the whitelist.conf 158sub write_config { 159 my $f = IO::File->new($settings_file, 'w'); 160 die "Couldn't open $settings_file for writing" if (!defined $f); 161 162 foreach my $listtype (keys %whitelisted) { 163 # Make sure we arn't writing duplicates 164 undef my %saw; 165 @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}}); 166 167 my $str = join ' ', @{$whitelisted{$listtype}}; 168 print {$f} "$listtype $str\n"; 169 } 170 $f = undef; 171} 172 173# convert old settings to new settings (/whitelist upgrade) 174sub old2new { 175 my $nicks = Irssi::settings_get_str('whitelist_nicks'); 176 my $hosts = Irssi::settings_get_str('whitelist_hosts'); 177 my $channels = Irssi::settings_get_str('whitelist_channels'); 178 my $networks = Irssi::settings_get_str('whitelist_networks'); 179 180 foreach my $nick (split /\s+/, $nicks) { 181 next if not length $nick; 182 push @{$whitelisted{'nicks'}}, $nick; 183 } 184 185 foreach my $host (split /\s+/, $hosts) { 186 next if not length $host; 187 push @{$whitelisted{'hosts'}}, $host; 188 } 189 190 foreach my $channel (split /\s+/, $channels) { 191 next if not length $channel; 192 push @{$whitelisted{'channels'}}, $channel; 193 } 194 195 foreach my $network (split /\s+/, $networks) { 196 next if not length $network; 197 push @{$whitelisted{'networks'}}, $network; 198 } 199 200 write_config(); 201} 202# This one gets called from IRSSI if we get a private message (PRIVMSG) 203sub whitelist_check { 204 my ($server, $msg, $nick, $address) = @_; 205 # these four settings are stored in a hash now after reading the config file. 206 #my $nicks = Irssi::settings_get_str('whitelist_nicks'); 207 #my $hosts = Irssi::settings_get_str('whitelist_hosts'); 208 #my $channels = Irssi::settings_get_str('whitelist_channels'); 209 #my $networks = Irssi::settings_get_str('whitelist_networks'); 210 my $warning = Irssi::settings_get_bool('whitelist_notify'); 211 my $casesensitive = Irssi::settings_get_bool('whitelist_nicks_case_sensitive'); 212 my $logging = Irssi::settings_get_bool('whitelist_log_ignored_msgs'); 213 my $logfile = Irssi::get_irssi_dir.'/whitelist.log'; 214 215 my $hostmask = "$nick!$address"; 216 217 my $tag = $server->{chatnet}; 218 $tag = $server->{tag} unless defined $tag; 219 $tag = lc($tag); 220 221 # Handle servers first, because they are the most significant, 222 # Nicks, Channels and Hostmasks are always local to a network 223 foreach my $network (@{$whitelisted{'networks'}}) { 224 # Change it to lower case 225 $network = lc($network); 226 # Kludge. Sometimes you get superfluous '', you have to ignore 227 next if ($network eq ''); 228 # Rewrite simplified regexp (* and ?) to Perl regexp 229 $network =~ s/(.)/$htr{$1}/g; 230 # Either the server tag matches 231 return if ($tag =~ /$network/); 232 # Or its address 233 return if ($server->{address} =~ /$network/); 234 } 235 236 # Nicks are the easiest to handle with the least computational effort. 237 # So do them before hosts and networks. 238 foreach my $whitenick (@{$whitelisted{'nicks'}}) { 239 if (!$casesensitive) { 240 $nick = lc($nick); 241 $whitenick = lc($whitenick); 242 } 243 # Simple check first: Is the nick itself whitelisted? 244 return if ($nick eq $whitenick); 245 # Second check: We have to look if the nick was localized to a network 246 # or irc server. So we have to look at <nick>@<network> too. 247 ($whitenick, my $network) = split /@/, $whitenick, 2; 248 # Ignore nicks without @<network> 249 next if !defined $network; 250 # Convert simple regexp to Perl regexp 251 $network =~ s/(.)/$htr{$1}/g; 252 # If the nick matches... 253 if ($nick eq $whitenick) { 254 # ...allow if the server tag is right... 255 return if ($tag =~ /$network/); 256 # ...or the server address matches 257 return if ($server->{address} =~ /$network/); 258 } 259 } 260 261 # Hostmasks are somewhat more sophisticated, because they allow wildcards 262 foreach my $whitehost (@{$whitelisted{'hosts'}}) { 263 # Kludge, sometimes you get '' 264 next if ($whitehost eq ''); 265 # First reconvert simple regexp to Perl regexp 266 $whitehost = host_to_regexp($whitehost); 267 # Allow if the hostmask matches 268 return if ($hostmask =~ /$whitehost/); 269 # Check if hostmask is localized to a network 270 (my $whitename, $whitehost, my $network) = split /@/, $whitehost, 3; 271 # Ignore hostmasks without attached network 272 next if !defined $network; 273 # We don't need to convert the network address again 274 # $network =~ s/(.)/$htr{$1}/g; 275 # But we have to reassemble the hostmask 276 $whitehost = "$whitename\@$whitehost"; 277 # If the hostmask matches... 278 if ($hostmask eq $whitehost) { 279 # ...allow if the server tag is ok... 280 return if ($tag =~ /$network/); 281 # ... or the server address 282 return if ($server->{address} =~ /$network/); 283 } 284 } 285 286 # Channels require some interaction with the server, so we do them last, 287 # hoping that some ACCEPT cases are already done, thus saving computation 288 # time and effort 289 foreach my $channel (@{$whitelisted{'channels'}}) { 290 # Check if we are on the specified channel 291 my $chan = $server->channel_find($channel); 292 # If yes... 293 if (defined $chan) { 294 # Check if the nick in question is also on that channel 295 my $chk = $chan->nick_find($nick); 296 # Allow the message 297 return if defined $chk; 298 } 299 # Check if we are talking about a localized channel 300 ($chan, my $network) = split /@/, $_, 2; 301 # Ignore not localized channels 302 next if !defined $network; 303 # Convert simple regexp to Perl regexp 304 $network =~ s/(.)/$htr{$1}/g; 305 # Ignore channels from a differently tagged server or from a different 306 # address 307 next if (!($tag =~ /$network/ || $server->{address} =~ /$network/)); 308 # Check if we are on the channel 309 $chan = $server->channel_find($chan); 310 # Ignore if not 311 next unless defined $chan; 312 # Check if $nick is on that channel too 313 my $chk = $chan->nick_find($nick); 314 # Allow if yes 315 return if defined $chk; 316 } 317 318 # Do we want a notice about this message attempt? 319 if ($warning) { 320 Irssi::print "[$tag] $nick [$address] attempted to send private message."; 321 } 322 323 # Do we want to make a log entry for it? 324 if ($logging) { 325 my $f = IO::File->new($logfile, '>>'); 326 return if (!defined $f); 327 print {$f} localtime().": [$tag] $nick [$address]: $msg\n"; 328 $f = undef; 329 } 330 331 # stop if the message isn't from a whitelisted address 332 Irssi::signal_stop(); 333 return; 334} 335 336sub usage { 337 Irssi::print "Usage: whitelist (add|del|remove) (nick|host|chan[nel]|net[work]) <list>"; 338 Irssi::print " whitelist (nick|host|chan[nel]|net[work])"; 339 Irssi::print " whitelist upgrade"; 340 Irssi::print " whitelist show"; 341} 342 343# This is bound to the /whitelist command 344sub whitelist_cmd { 345 my ($args, $server, $winit) = @_; 346 my ($cmd, $type, $rest) = split /\s+/, $args, 3; 347 348 # What type of settings we want to change? 349 my $listtype = $types{$type}; 350 351 # If we didn't get a syntactically correct command, put out an error 352 if(!defined $listtype && defined $type) { 353 usage; 354 return; 355 } 356 357 # What are we doing? 358 if ($cmd eq 'add') { 359 # split $rest into a list. 360 my @list = split /\s+/, $rest; 361 362 # Add the entries to the whitelist and then make sure it's unique 363 foreach my $entry (@list) { 364 push @{$whitelisted{$listtype}}, $entry; 365 undef my %saw; 366 @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}}); 367 } 368 } elsif ($cmd eq 'del' || $cmd eq 'remove') { 369 # Escape all letters to protect the Perl Regexp special characters 370 $rest =~ s/(.)/$htr{$1}/g; 371 372 # Make a list of things we want removing. 373 my @list = split /\s+/, $rest; 374 375 # Use grep to remove the list of things we don't want anymore. 376 foreach my $removal (@list) { 377 @{$whitelisted{$listtype}} = grep {!/^$removal$/} @{$whitelisted{$listtype}}; 378 } 379 } elsif ($cmd eq 'upgrade') { 380 Irssi::print "Converting old style /settings to new config file based settings"; 381 old2new(); 382 read_config(); 383 print_config(); 384 return; 385 } elsif ($cmd eq 'show') { 386 print_config(); 387 return; 388 } elsif(!defined $type) { 389 # Look if we just want to see the current values 390 $listtype = $types{$cmd}; 391 if (defined $listtype) { 392 # Print them 393 Irssi::print "Whitelist ${cmd}s: ".join ' ', @{$whitelisted{$listtype}}; 394 } else { 395 # Or give error message 396 usage; 397 } 398 return; 399 } else { 400 # If we felt through until here, something went wrong 401 usage; 402 return; 403 } 404 # Display the changed value and store it in the settings 405 Irssi::print "Whitelist ${type}s: ".join ' ', @{$whitelisted{$listtype}}; 406 # Save the new settings 407 write_config(); 408 return; 409} 410 411Irssi::settings_add_bool('whitelist', 'whitelist_notify' => 1); 412Irssi::settings_add_bool('whitelist', 'whitelist_log_ignored_msgs' => 1); 413Irssi::settings_add_bool('whitelist', 'whitelist_nicks_case_sensitive' => 0); 414 415foreach (keys(%types)) { 416 Irssi::settings_add_str('whitelist', 'whitelist_'.$types{$_}, ''); 417} 418 419Irssi::signal_add_first('message private', \&whitelist_check); 420 421Irssi::command_bind('whitelist', \&whitelist_cmd); 422 423# Read the config 424\&read_config(); 425######################### 426####### Changelog ####### 427### 1.0: David O'Rourke 428# Changed how whitelists are stored. We no longer use the settings_*_str for them. 429# We now store them in a hash and write/read a config file. 430# Added '/whitelist old2new' function, for converting to the new style list. 431# Added '/whitelist show' for showing everything that's been whitelisted. 432### 0.9g: David O'Rourke 433# Cleanups. 434### 0.9f: David O'Rourke 435# Cleanups. 436### 0.9e: David O'Rourke 437# Changed print -> Irssi::print 438# Fixed '' in $whitehost 439######################### 440# 0.9d: David O'Rourke 441# General cleanup of script. 442# Removed pointless function timestamp() 443# Removed pointless global variables $tstamp, $whitenick, $whitehost 444# Created whitelist logging directory in ~/.irssi with option to rotate log daily. 445# Fixed comparison of whitelist_networks to $tag. $tag was being lowercased, whitelist_networks was not. 446