html/whitelist.pl
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
74 use strict;
75 use Irssi;
76 use Irssi::Irc;
77 use IO::File;
78
79 use 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 licence => "GPLv2",
87 changed => "12/03/2007 15:20 GMT"
88 );
89
90 # location of the settings file
91 my $settings_file = Irssi::get_irssi_dir.'/whitelist.conf';
92 # This hash stores our various whitelists.
93 my %whitelisted;
94
95 # A mapping to convert simple regexp (* and ?) into Perl regexp
96 my %htr = ( );
97 foreach 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
105 my %types = (
106 'nick' => 'nicks',
107 'host' => 'hosts',
108 'chan' => 'channels',
109 'channel' => 'channels',
110 'net' => 'networks',
111 'network' => 'networks',
112 );
113
114 sub host_to_regexp {
115 my ($mask) = @_;
116 $mask = lc_host($mask);
117 $mask =~ s/(.)/$htr{$1}/g;
118 return $mask;
119 }
120
121 sub 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
128 sub 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
136 sub 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
158 sub 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)
174 sub 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)
203 sub 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
336 sub 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
344 sub 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
411 Irssi::settings_add_bool('whitelist', 'whitelist_notify' => 1);
412 Irssi::settings_add_bool('whitelist', 'whitelist_log_ignored_msgs' => 1);
413 Irssi::settings_add_bool('whitelist', 'whitelist_nicks_case_sensitive' => 0);
414
415 foreach (keys(%types)) {
416 Irssi::settings_add_str('whitelist', 'whitelist_'.$types{$_}, '');
417 }
418
419 Irssi::signal_add_first('message private', \&whitelist_check);
420
421 Irssi::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.