html/trustweb.pl
1 use strict;
2
3 use vars qw($VERSION %IRSSI);
4 $VERSION = "2003020801";
5 %IRSSI = (
6 authors => "Stefan 'tommie' Tomanek",
7 contact => "stefan\@pico.ruhr.de",
8 name => "TrustWeb",
9 description => "Illustrates the trust between ops",
10 license => "GPLv2",
11 modules => "Data::Dumper IO::File POSIX",
12 changed => "$VERSION",
13 commands => "trustweb"
14 );
15
16
17 use Irssi 20020324;
18 use Irssi::TextUI;
19 use Data::Dumper;
20 use IO::File;
21 use POSIX;
22 use vars qw(%database);
23
24 sub draw_box ($$$$) {
25 my ($title, $text, $footer, $colour) = @_;
26 my $box = '';
27 $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
28 foreach (split(/\n/, $text)) {
29 $box .= '%R|%n '.$_."\n";
30 } $box .= '%R`--<%n'.$footer.'%R>->%n';
31 $box =~ s/%.//g unless $colour;
32 return $box;
33 }
34
35 sub show_help() {
36 my $help = $IRSSI{name}." ".$VERSION."
37 /trustweb help
38 Display this help
39 /trustweb save/load
40 Load or save the database
41 /trustweb show <nick>
42 Display the trust for <nick>
43 /trustweb scan
44 Scan all buffers for modechanges
45 /trustweb trace <nick1> <nick2>
46 Search the shortest connection between two nicks
47 /trustweb merge <nick1> <nick2>
48 Move all trustdata from nick1 to nick2
49 ";
50 my $text = "";
51 foreach (split(/\n/, $help)) {
52 $_ =~ s/^\/(.*)$/%9\/$1%9/;
53 $text .= $_."\n";
54 }
55 print CLIENTCRAP draw_box($IRSSI{name}, $text, "Help", 1);
56 }
57
58
59 sub save_db {
60 my $filename = Irssi::settings_get_str('trustweb_db_file');
61 my $io = new IO::File $filename, "w";
62 if (defined $io) {
63 my $dumper = Data::Dumper->new([\%database]);
64 $dumper->Purity(1)->Deepcopy(1);
65 $io->print($dumper->Dump);
66 $io->close;
67 }
68 print CLIENTCRAP "%B>>%n Trustweb database saved to ".$filename;
69 }
70
71 sub load_db {
72 my $filename = Irssi::settings_get_str('trustweb_db_file');
73 my $io = new IO::File $filename, "r";
74 if (defined $io) {
75 no strict 'vars';
76 my $text;
77 $text .= $_ foreach ($io->getlines);
78 my $database = eval "$text";
79 %database = %$database if ref $database;
80 }
81 print CLIENTCRAP "%B>>%n Trustweb database loaded from ".$filename;
82 }
83
84 sub scan_buffers {
85 foreach my $channel (Irssi::channels()) {
86 my $win = $channel->window();
87 my $name = $channel->{name};
88 my $server = $channel->{server};
89 my $view = $win->view();
90 my $line = $view->get_lines();
91 my $lines = 0;
92 while (defined $line) {
93 my $text = $line->get_text(0);
94 if ($line->{info}{level} == 2048) {
95 if ($text =~ /\[([\+\-].*?)\] by (.*)/) {
96 sig_message_irc_mode($server, $name, $2, undef, $1);
97 }
98 }
99 $line = $line->next;
100 $lines++;
101 }
102 }
103 }
104
105 sub sig_message_irc_mode ($$$$$) {
106 my ($server, $channel, $nick, $addr, $mode) = @_;
107 return if ($nick =~ /\./);
108 my $state;
109 my @pipe;
110 my %result;
111 my $tag = lc $server->{tag};
112 my ($modes, $nicks) = split(/ /, $mode, 2);
113 foreach (split(//, $modes)) {
114 if ($_ eq '+' || $_ eq '-') {
115 $state = $_;
116 } else {
117 push @pipe, $state.$_;
118 }
119 }
120
121 foreach (split(/ /, $nicks)) {
122 my $change = shift(@pipe);
123 if ($change eq '+o') {
124 foreach my $active (split /, ?/, $nick) {
125 $database{$tag}{lc $active}{lc $_} = 1;
126 }
127 } elsif ($change eq '-o') {
128 foreach my $active (split /, ?/, $nick) {
129 $database{$tag}{lc $active}{lc $_} = -1;
130 }
131 }
132 }
133 }
134
135 sub sig_nicklist_changed ($$$) {
136 my ($channel, $nick, $old) = @_;
137 my $server = $channel->{server};
138 my $new = lc $nick->{nick};
139 my $tag = lc $server->{tag};
140 merge_nicks($tag, $old, $new);
141 }
142
143 sub merge_nicks ($$$) {
144 my ($tag, $old, $new) = @_;
145 $tag = lc $tag;
146 $new = lc $new;
147 $old = lc $old;
148 return if $old eq $new;
149 if (defined $database{$tag}{$old}) {
150 foreach (keys %{ $database{$tag}{$old} }) {
151 $database{$tag}{$new}{$_} = $database{$tag}{$old}{$_};
152 }
153 delete $database{$tag}{$old}
154 }
155 foreach (keys %{ $database{$tag} }) {
156 if (defined $database{$tag}{$_}{$old}) {
157 $database{$tag}{$_}{$new} = $database{$tag}{$_}{$old};
158 delete $database{$tag}{$_}{$old};
159 }
160 }
161 }
162
163 sub show_trust ($$) {
164 my ($nicks, $tag) = @_;
165 my $text;
166 foreach (@$nicks) {
167 $text .= draw_trust($_, $tag);
168 }
169 print CLIENTCRAP &draw_box('TrustWeb', $text, $tag, 1);
170 }
171
172 sub draw_trust ($$) {
173 my ($nick, $tag) = @_;
174 my (@opfrom, @opto);
175 my $text;
176 #return unless $database{$nick};
177 my ($maxfrom, $maxto) = (0, 0);
178 my $distrust = Irssi::settings_get_bool('trustweb_show_distrust');
179 foreach (sort keys %{ $database{$tag} }) {
180 next unless defined $database{$tag}{$_}{lc $nick};
181 push @opfrom, [$_,1] if $database{$tag}{$_}{lc $nick} > 0;
182 push @opfrom, [$_,-1] if ($database{$tag}{$_}{lc $nick} < 0 && $distrust);
183 $maxfrom = length($_) if length($_) > $maxfrom;
184 }
185 if (defined $database{$tag}{lc $nick}) {
186 foreach (sort keys %{$database{$tag}{lc $nick}}) {
187 push @opto, [$_,1] if $database{$tag}{lc $nick}{$_} > 0;
188 push @opto, [$_,-1] if ($database{$tag}{lc $nick}{$_} < 0 && $distrust);
189 $maxto = length($_) if length($_) > $maxto;
190 }
191 }
192 my $items = @opfrom > @opto ? @opfrom-1 : @opto-1;
193 my $i = 0;
194 my $center = sprintf("%.0f", $items/2);
195 $center = @opfrom-1 if (@opfrom && not(defined $opfrom[$center]));
196 $center = @opto-1 if (@opto && not(defined $opto[$center]));
197 foreach (0..$items) {
198 my $line;
199 if (defined $opfrom[$_]) {
200 $line .= '<'.$opfrom[$_][0];
201 $line .= ' ' x ($maxfrom - length($opfrom[$_][0]));
202 $line .= '>';
203 $line .= '-' if $opfrom[$_][1] > 0;
204 $line .= '%' if $opfrom[$_][1] < 0;
205 $line .= "," if $_ < $center;
206 $line .= "+" if $_ == $center;
207 $line .= "'" if $_ > $center;
208 } else {
209 $line .= ' ' x ($maxfrom+4) if $maxfrom;
210 }
211 if ($_ == $center) {
212 $line .= '-' if @opfrom;
213 $line .= '(%9'.$nick.'%9)';
214 $line .= '-' if @opto;
215 } else {
216 $line .= ' ' if @opfrom;
217 $line .= ' ' x (length($nick)+2);
218 $line .= ' ' if @opto;
219 }
220 if (defined $opto[$_]) {
221 $line .= "," if $_ < $center;
222 $line .= "+" if $_ == $center;
223 $line .= "'" if $_ > $center;
224 $line .= '-' if $opto[$_][1] > 0;
225 $line .= '%' if $opto[$_][1] < 0;
226 $line .= '<'.$opto[$_][0];
227 $line .= ' ' x ($maxto - length($opto[$_][0]));
228 $line .= '>';
229 } else {
230 $line .= ' ' x ($maxto+4) if $maxto;
231 }
232 $text .= $line."\n";
233 $i++;
234 }
235 return $text;
236 }
237
238 sub bg_trace ($$$) {
239 my ($tag, $from, $to) = @_;
240 my ($rh, $wh);
241 pipe($rh, $wh);
242 my $pid = fork();
243 if ($pid > 0) {
244 close $wh;
245 Irssi::pidwait_add($pid);
246 my $pipetag;
247 my @args = ($tag, $from, $to, $rh, \$pipetag);
248 $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
249 } else {
250 my $result = walk($from, $to, $database{$tag}, {}, [], [], 0);
251 my $dumper = Data::Dumper->new([$result]);
252 $dumper->Purity(1)->Deepcopy(1);
253 print($wh $dumper->Dump());
254 close $wh;
255 POSIX::_exit(1);
256 }
257 }
258
259 sub pipe_input ($) {
260 my ($tag, $from, $to, $rh, $pipetag) = @{$_[0]};
261 my $text;
262 $text .= $_ foreach (<$rh>);
263 close($rh);
264 Irssi::input_remove($$pipetag);
265 no strict 'vars';
266 my $result = eval "$text";
267 draw_trace($tag, $from, $to, $result);
268 }
269
270 sub walk ($$$$$$) {
271 my ($pos, $goal, $data, $visited, $street, $ideal) = @_;
272 my @road = @$street;
273
274 return $ideal if $visited->{$pos};
275 return $ideal if (@$ideal && not(Irssi::settings_get_bool('trustweb_trace_find_shortest_path')));
276 return \@road if ($pos eq $goal);
277 return $ideal if (@$ideal && @$street >= @$ideal);
278 return $ideal if (Irssi::settings_get_int('trustweb_trace_max_depth') && @road > Irssi::settings_get_int('trustweb_trace_max_depth'));
279
280 $visited->{$pos} = 1;
281 my $nodistrust = not Irssi::settings_get_bool('trustweb_trace_distrust');
282 foreach (keys %{ $data->{$pos} }) {
283 next if ($data->{$pos}{$_} < 1 && $nodistrust);
284 push @road, [ $_, 1, $data->{$pos}{$_} ];
285 $ideal = walk($_, $goal, $data, $visited, \@road, $ideal);
286 pop @road;
287 }
288 foreach (keys %$data) {
289 next unless defined $data->{$_}{$pos};
290 next if ($data->{$_}{$_} < 1 && $nodistrust);
291 push @road, [ $_, 0, $data->{$_}{$pos} ];
292 $ideal = walk($_, $goal, $data, $visited, \@road, $ideal);
293 pop @road;
294 }
295 $visited->{$pos} = 0;
296 return $ideal;
297 }
298
299
300 sub draw_trace ($$$$) {
301 my ($tag, $from, $to, $route) = @_;
302 my $line = "%B<<%n ";
303 if (ref $route && @$route) {
304 $line .= $from;
305 foreach (@$route) {
306 if ($_->[1]) {
307 $line .= ' ';
308 $line .= $_->[2] > 0 ? '=' : '%%';
309 $line .= '> ';
310 } else {
311 $line .= ' <';
312 $line .= $_->[2] > 0 ? '=' : '%';
313 $line .= ' ';
314 }
315 $line .= $_->[0];
316 }
317 } else {
318 $line .= "No connection between ".$from." and ".$to." could be found.";
319 }
320 print $line;
321 }
322
323 sub pre_unload {
324 save_db();
325 }
326
327 sub cmd_trustweb ($$$) {
328 my ($args, $server, $witem) = @_;
329 my $tag = ref $server ? lc $server->{tag} : lc Irssi::settings_get_str('trustweb_default_ircnet');
330 my @arg = split(/ +/, $args);
331 if (not(@arg) || $arg[0] eq 'help') {
332 show_help();
333 } elsif ($arg[0] eq 'scan') {
334 scan_buffers();
335 print CLIENTCRAP "%R>>%n All buffers scanned for modes";
336 } elsif ($arg[0] eq 'show' && defined $arg[1]) {
337 shift @arg;
338 show_trust(\@arg, $tag);
339 } elsif ($arg[0] eq 'save') {
340 save_db;
341 } elsif ($arg[0] eq 'load') {
342 load_db;
343 } elsif ($arg[0] eq 'trace' && defined $arg[1] && defined $arg[2]) {
344 bg_trace($tag, lc $arg[1], lc $arg[2]);
345 print CLIENTCRAP "%B>>%n Searching connection between ".$arg[1]." and ".$arg[2]."...";
346 } elsif ($arg[0] eq 'merge' && defined $arg[1] && defined $arg[2]) {
347 return unless ref $server;
348 merge_nicks($server->{tag}, $arg[1], $arg[2]);
349 print CLIENTCRAP "%B>>%n '".$arg[1]."' has been merged with '".$arg[2]."'";
350 }
351 }
352
353 Irssi::settings_add_str($IRSSI{name}, 'trustweb_default_ircnet', '');
354 Irssi::settings_add_str($IRSSI{name}, 'trustweb_db_file', Irssi::get_irssi_dir()."/trustweb_database");
355 Irssi::settings_add_bool($IRSSI{name}, 'trustweb_show_distrust' , 1);
356
357 Irssi::settings_add_bool($IRSSI{name}, 'trustweb_trace_distrust' , 1);
358 Irssi::settings_add_bool($IRSSI{name}, 'trustweb_trace_find_shortest_path' , 1);
359 Irssi::settings_add_int($IRSSI{name}, 'trustweb_trace_max_depth' , 0);
360
361 Irssi::signal_add('setup saved', 'save_db');
362 Irssi::signal_add('message irc mode', \&sig_message_irc_mode);
363 Irssi::signal_add_first('nicklist changed', \&sig_nicklist_changed);
364
365 Irssi::command_bind('trustweb', \&cmd_trustweb);
366
367 foreach my $cmd ('save', 'load', 'scan', 'show', 'help', 'trace', 'merge') {
368 Irssi::command_bind('trustweb '.$cmd =>
369 sub { cmd_trustweb("$cmd ".$_[0], $_[1], $_[2]); } );
370 }
371
372 load_db();
373
374 print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /trustweb help for help';