html/scriptassist.pl
1 # by Stefan "tommie" Tomanek
2 #
3 # scriptassist.pl
4
5
6 use strict;
7
8 use vars qw($VERSION %IRSSI);
9 $VERSION = '2003020803';
10 %IRSSI = (
11 authors => 'Stefan \'tommie\' Tomanek',
12 contact => 'stefan@pico.ruhr.de',
13 name => 'scriptassist',
14 description => 'keeps your scripts on the cutting edge',
15 license => 'GPLv2',
16 url => 'http://irssi.org/scripts/',
17 changed => $VERSION,
18 modules => 'Data::Dumper LWP::UserAgent (GnuPG)',
19 commands => "scriptassist"
20 );
21
22 use vars qw($forked %remote_db $have_gpg);
23
24 use Irssi 20020324;
25 use Data::Dumper;
26 use LWP::UserAgent;
27 use POSIX;
28
29 # GnuPG is not always needed
30 use vars qw($have_gpg @complist);
31 $have_gpg = 0;
32 eval "use GnuPG qw(:algo :trust);";
33 $have_gpg = 1 if not ($@);
34
35 sub show_help() {
36 my $help = "scriptassist $VERSION
37 /scriptassist check
38 Check all loaded scripts for new available versions
39 /scriptassist update <script|all>
40 Update the selected or all script to the newest version
41 /scriptassist search <query>
42 Search the script database
43 /scriptassist info <scripts>
44 Display information about <scripts>
45 /scriptassist ratings <scripts>
46 Retrieve the average ratings of the the scripts
47 /scriptassist top <num>
48 Retrieve the first <num> top rated scripts
49 /scriptassist new <num>
50 Display the newest <num> scripts
51 /scriptassist rate <script> <stars>
52 Rate the script with a number of stars ranging from 0-5
53 /scriptassist contact <script>
54 Write an email to the author of the script
55 (Requires OpenURL)
56 /scriptassist cpan <module>
57 Visit CPAN to look for missing Perl modules
58 (Requires OpenURL)
59 /scriptassist install <script>
60 Retrieve and load the script
61 /scriptassist autorun <script>
62 Toggles automatic loading of <script>
63 ";
64 my $text='';
65 foreach (split(/\n/, $help)) {
66 $_ =~ s/^\/(.*)$/%9\/$1%9/;
67 $text .= $_."\n";
68 }
69 print CLIENTCRAP &draw_box("ScriptAssist", $text, "scriptassist help", 1);
70 #theme_box("ScriptAssist", $text, "scriptassist help", 1);
71 }
72
73 sub theme_box ($$$$) {
74 my ($title, $text, $footer, $colour) = @_;
75 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_header', $title);
76 foreach (split(/\n/, $text)) {
77 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_inside', $_);
78 }
79 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_footer', $footer);
80 }
81
82 sub draw_box ($$$$) {
83 my ($title, $text, $footer, $colour) = @_;
84 my $box = '';
85 $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
86 foreach (split(/\n/, $text)) {
87 $box .= '%R|%n '.$_."\n";
88 } $box .= '%R`--<%n'.$footer.'%R>->%n';
89 $box =~ s/%.//g unless $colour;
90 return $box;
91 }
92
93 sub call_openurl ($) {
94 my ($url) = @_;
95 no strict "refs";
96 # check for a loaded openurl
97 if (defined %{ "Irssi::Script::openurl::" }) {
98 &{ "Irssi::Script::openurl::launch_url" }($url);
99 } else {
100 print CLIENTCRAP "%R>>%n Please install openurl.pl";
101 }
102 use strict;
103 }
104
105 sub bg_do ($) {
106 my ($func) = @_;
107 my ($rh, $wh);
108 pipe($rh, $wh);
109 if ($forked) {
110 print CLIENTCRAP "%R>>%n Please wait until your earlier request has been finished.";
111 return;
112 }
113 my $pid = fork();
114 $forked = 1;
115 if ($pid > 0) {
116 print CLIENTCRAP "%R>>%n Please wait...";
117 close $wh;
118 Irssi::pidwait_add($pid);
119 my $pipetag;
120 my @args = ($rh, \$pipetag, $func);
121 $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
122 } else {
123 eval {
124 my @items = split(/ /, $func);
125 my %result;
126 my $ts1 = $remote_db{timestamp};
127 my $xml = get_scripts();
128 my $ts2 = $remote_db{timestamp};
129 if (not($ts1 eq $ts2) && Irssi::settings_get_bool('scriptassist_cache_sources')) {
130 $result{db} = $remote_db{db};
131 $result{timestamp} = $remote_db{timestamp};
132 }
133 if ($items[0] eq 'check') {
134 $result{data}{check} = check_scripts($xml);
135 } elsif ($items[0] eq 'update') {
136 shift(@items);
137 $result{data}{update} = update_scripts(\@items, $xml);
138 } elsif ($items[0] eq 'search') {
139 shift(@items);
140 #$result{data}{search}{-foo} = 0;
141 foreach (@items) {
142 $result{data}{search}{$_} = search_scripts($_, $xml);
143 }
144 } elsif ($items[0] eq 'install') {
145 shift(@items);
146 $result{data}{install} = install_scripts(\@items, $xml);
147 } elsif ($items[0] eq 'debug') {
148 shift(@items);
149 $result{data}{debug} = debug_scripts(\@items);
150 } elsif ($items[0] eq 'ratings') {
151 shift(@items);
152 @items = @{ loaded_scripts() } if $items[0] eq "all";
153 #$result{data}{rating}{-foo} = 1;
154 my %ratings = %{ get_ratings(\@items, '') };
155 foreach (keys %ratings) {
156 $result{data}{rating}{$_}{rating} = $ratings{$_}->[0];
157 $result{data}{rating}{$_}{votes} = $ratings{$_}->[1];
158 }
159 } elsif ($items[0] eq 'rate') {
160 #$result{data}{rate}{-foo} = 1;
161 $result{data}{rate}{$items[1]} = rate_script($items[1], $items[2]);
162 } elsif ($items[0] eq 'info') {
163 shift(@items);
164 $result{data}{info} = script_info(\@items);
165 } elsif ($items[0] eq 'echo') {
166 $result{data}{echo} = 1;
167 } elsif ($items[0] eq 'top') {
168 my %ratings = %{ get_ratings([], $items[1]) };
169 foreach (keys %ratings) {
170 $result{data}{rating}{$_}{rating} = $ratings{$_}->[0];
171 $result{data}{rating}{$_}{votes} = $ratings{$_}->[1];
172 }
173 } elsif ($items[0] eq 'new') {
174 my $new = get_new($items[1]);
175 $result{data}{new} = $new;
176 } elsif ($items[0] eq 'unknown') {
177 my $cmd = $items[1];
178 $result{data}{unknown}{$cmd} = get_unknown($cmd, $xml);
179 }
180 my $dumper = Data::Dumper->new([\%result]);
181 $dumper->Purity(1)->Deepcopy(1)->Indent(0);
182 my $data = $dumper->Dump;
183 print($wh $data);
184 };
185 close($wh);
186 POSIX::_exit(1);
187 }
188 }
189
190 sub get_unknown ($$) {
191 my ($cmd, $db) = @_;
192 foreach (keys %$db) {
193 next unless defined $db->{$_}{commands};
194 foreach my $item (split / /, $db->{$_}{commands}) {
195 return { $_ => $db->{$_} } if ($item =~ /^$cmd$/i);
196 }
197 }
198 return undef;
199 }
200
201 sub script_info ($) {
202 my ($scripts) = @_;
203 no strict "refs";
204 my %result;
205 my $xml = get_scripts();
206 foreach (@{$scripts}) {
207 next unless (defined $xml->{$_.".pl"} || (defined %{ 'Irssi::Script::'.$_.'::' } && defined %{ 'Irssi::Script::'.$_.'::IRSSI' }));
208 $result{$_}{version} = get_remote_version($_, $xml);
209 my @headers = ('authors', 'contact', 'description', 'license', 'source');
210 foreach my $entry (@headers) {
211 $result{$_}{$entry} = ${ 'Irssi::Script::'.$_.'::IRSSI' }{$entry};
212 if (defined $xml->{$_.".pl"}{$entry}) {
213 $result{$_}{$entry} = $xml->{$_.".pl"}{$entry};
214 }
215 }
216 if ($xml->{$_.".pl"}{signature_available}) {
217 $result{$_}{signature_available} = 1;
218 }
219 if (defined $xml->{$_.".pl"}{modules}) {
220 my $modules = $xml->{$_.".pl"}{modules};
221 #$result{$_}{modules}{-foo} = 1;
222 foreach my $mod (split(/ /, $modules)) {
223 my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
224 $mod = $1 if $1;
225 $result{$_}{modules}{$mod}{optional} = $opt;
226 $result{$_}{modules}{$mod}{installed} = module_exist($mod);
227 }
228 } elsif (defined ${ 'Irssi::Script::'.$_.'::IRSSI' }{modules}) {
229 my $modules = ${ 'Irssi::Script::'.$_.'::IRSSI' }{modules};
230 foreach my $mod (split(/ /, $modules)) {
231 my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
232 $mod = $1 if $1;
233 $result{$_}{modules}{$mod}{optional} = $opt;
234 $result{$_}{modules}{$mod}{installed} = module_exist($mod);
235 }
236 }
237 if (defined $xml->{$_.".pl"}{depends}) {
238 my $depends = $xml->{$_.".pl"}{depends};
239 foreach my $dep (split(/ /, $depends)) {
240 $result{$_}{depends}{$dep}{installed} = 1; #(defined ${ 'Irssi::Script::'.$dep });
241 }
242 }
243 }
244 return \%result;
245 }
246
247 sub rate_script ($$) {
248 my ($script, $stars) = @_;
249 my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
250 $ua->agent('ScriptAssist/'.$VERSION);
251 my $request = HTTP::Request->new('GET', 'http://ratings.irssi.de/irssirate.pl?&stars='.$stars.'&mode=rate&script='.$script);
252 my $response = $ua->request($request);
253 unless ($response->is_success() && $response->content() =~ /You already rated this script/) {
254 return 1;
255 } else {
256 return 0;
257 }
258 }
259
260 sub get_ratings ($$) {
261 my ($scripts, $limit) = @_;
262 my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
263 $ua->agent('ScriptAssist/'.$VERSION);
264 my $script = join(',', @{$scripts});
265 my $request = HTTP::Request->new('GET', 'http://ratings.irssi.de/irssirate.pl?script='.$script.'&sort=rating&limit='.$limit);
266 my $response = $ua->request($request);
267 my %result;
268 if ($response->is_success()) {
269 foreach (split /\n/, $response->content()) {
270 if (/<tr><td><a href=".*?">(.*?)<\/a>/) {
271 my $entry = $1;
272 if (/"><\/td><td>([0-9.]+)<\/td><td>(.*?)<\/td><td>/) {
273 $result{$entry} = [$1, $2];
274 }
275 }
276 }
277 }
278 return \%result;
279 }
280
281 sub get_new ($) {
282 my ($num) = @_;
283 my $result;
284 my $xml = get_scripts();
285 foreach (sort {$xml->{$b}{last_modified} cmp $xml->{$a}{last_modified}} keys %$xml) {
286 my %entry = %{ $xml->{$_} };
287 $result->{$_} = \%entry;
288 $num--;
289 last unless $num;
290 }
291 return $result;
292 }
293 sub module_exist ($) {
294 my ($module) = @_;
295 $module =~ s/::/\//g;
296 foreach (@INC) {
297 return 1 if (-e $_."/".$module.".pm");
298 }
299 return 0;
300 }
301
302 sub debug_scripts ($) {
303 my ($scripts) = @_;
304 my %result;
305 foreach (@{$scripts}) {
306 my $xml = get_scripts();
307 if (defined $xml->{$_.".pl"}{modules}) {
308 my $modules = $xml->{$_.".pl"}{modules};
309 foreach my $mod (split(/ /, $modules)) {
310 my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
311 $mod = $1 if $1;
312 $result{$_}{$mod}{optional} = $opt;
313 $result{$_}{$mod}{installed} = module_exist($mod);
314 }
315 }
316 }
317 return(\%result);
318 }
319
320 sub install_scripts ($$) {
321 my ($scripts, $xml) = @_;
322 my %success;
323 #$success{-foo} = 1;
324 my $dir = Irssi::get_irssi_dir()."/scripts/";
325 foreach (@{$scripts}) {
326 if (get_local_version($_) && (-e $dir.$_.".pl")) {
327 $success{$_}{installed} = -2;
328 } else {
329 $success{$_} = download_script($_, $xml);
330 }
331 }
332 return \%success;
333 }
334
335 sub update_scripts ($$) {
336 my ($list, $database) = @_;
337 $list = loaded_scripts() if ($list->[0] eq "all" || scalar(@$list) == 0);
338 my %status;
339 #$status{-foo} = 1;
340 foreach (@{$list}) {
341 my $local = get_local_version($_);
342 my $remote = get_remote_version($_, $database);
343 next if $local eq '' || $remote eq '';
344 if (compare_versions($local, $remote) eq "older") {
345 $status{$_} = download_script($_, $database);
346 } else {
347 $status{$_}{installed} = -2;
348 }
349 $status{$_}{remote} = $remote;
350 $status{$_}{local} = $local;
351 }
352 return \%status;
353 }
354
355 sub search_scripts ($$) {
356 my ($query, $database) = @_;
357 my %result;
358 #$result{-foo} = " ";
359 foreach (sort keys %{$database}) {
360 my %entry = %{$database->{$_}};
361 my $string = $_." ";
362 $string .= $entry{description} if defined $entry{description};
363 if ($string =~ /$query/i) {
364 my $name = $_;
365 $name =~ s/\.pl$//;
366 if (defined $entry{description}) {
367 $result{$name}{desc} = $entry{description};
368 } else {
369 $result{$name}{desc} = "";
370 }
371 if (defined $entry{authors}) {
372 $result{$name}{authors} = $entry{authors};
373 } else {
374 $result{$name}{authors} = "";
375 }
376 if (get_local_version($name)) {
377 $result{$name}{installed} = 1;
378 } else {
379 $result{$name}{installed} = 0;
380 }
381 }
382 }
383 return \%result;
384 }
385
386 sub pipe_input {
387 my ($rh, $pipetag) = @{$_[0]};
388 my @lines = <$rh>;
389 close($rh);
390 Irssi::input_remove($$pipetag);
391 $forked = 0;
392 my $text = join("", @lines);
393 unless ($text) {
394 print CLIENTCRAP "%R<<%n Something weird happend";
395 return();
396 }
397 no strict "vars";
398 my $incoming = eval("$text");
399 if ($incoming->{db} && $incoming->{timestamp}) {
400 $remote_db{db} = $incoming->{db};
401 $remote_db{timestamp} = $incoming->{timestamp};
402 }
403 unless (defined $incoming->{data}) {
404 print CLIENTCRAP "%R<<%n Something weird happend";
405 return;
406 }
407 my %result = %{ $incoming->{data} };
408 @complist = ();
409 if (defined $result{new}) {
410 print_new($result{new});
411 push @complist, $_ foreach keys %{ $result{new} };
412 }
413 if (defined $result{check}) {
414 print_check(%{$result{check}});
415 push @complist, $_ foreach keys %{ $result{check} };
416 }
417 if (defined $result{update}) {
418 print_update(%{ $result{update} });
419 push @complist, $_ foreach keys %{ $result{update} };
420 }
421 if (defined $result{search}) {
422 foreach (keys %{$result{search}}) {
423 print_search($_, %{$result{search}{$_}});
424 push @complist, keys(%{$result{search}{$_}});
425 }
426 }
427 if (defined $result{install}) {
428 print_install(%{ $result{install} });
429 push @complist, $_ foreach keys %{ $result{install} };
430 }
431 if (defined $result{debug}) {
432 print_debug(%{ $result{debug} });
433 }
434 if (defined $result{rating}) {
435 print_ratings(%{ $result{rating} });
436 push @complist, $_ foreach keys %{ $result{rating} };
437 }
438 if (defined $result{rate}) {
439 print_rate(%{ $result{rate} });
440 }
441 if (defined $result{info}) {
442 print_info(%{ $result{info} });
443 }
444 if (defined $result{echo}) {
445 Irssi::print "ECHO";
446 }
447 if ($result{unknown}) {
448 print_unknown($result{unknown});
449 }
450
451 }
452
453 sub print_unknown ($) {
454 my ($data) = @_;
455 foreach my $cmd (keys %$data) {
456 print CLIENTCRAP "%R<<%n No script provides '/$cmd'" unless $data->{$cmd};
457 foreach (keys %{ $data->{$cmd} }) {
458 my $text .= "The command '/".$cmd."' is provided by the script '".$data->{$cmd}{$_}{name}."'.\n";
459 $text .= "This script is currently not installed on your system.\n";
460 $text .= "If you want to install the script, enter\n";
461 my ($name) = /(.*?)\.pl$/;
462 $text .= " %U/script install ".$name."%U ";
463 my $output = draw_box("ScriptAssist", $text, "'".$_."' missing", 1);
464 print CLIENTCRAP $output;
465 }
466 }
467 }
468
469 sub check_autorun ($) {
470 my ($script) = @_;
471 my $dir = Irssi::get_irssi_dir()."/scripts/";
472 if (-e $dir."/autorun/".$script.".pl") {
473 if (readlink($dir."/autorun/".$script.".pl") eq "../".$script.".pl") {
474 return 1;
475 }
476 }
477 return 0;
478 }
479
480 sub array2table {
481 my (@array) = @_;
482 my @width;
483 foreach my $line (@array) {
484 for (0..scalar(@$line)-1) {
485 my $l = $line->[$_];
486 $l =~ s/%[^%]//g;
487 $l =~ s/%%/%/g;
488 $width[$_] = length($l) if $width[$_]<length($l);
489 }
490 }
491 my $text;
492 foreach my $line (@array) {
493 for (0..scalar(@$line)-1) {
494 my $l = $line->[$_];
495 $text .= $line->[$_];
496 $l =~ s/%[^%]//g;
497 $l =~ s/%%/%/g;
498 $text .= " "x($width[$_]-length($l)+1) unless ($_ == scalar(@$line)-1);
499 }
500 $text .= "\n";
501 }
502 return $text;
503 }
504
505
506 sub print_info (%) {
507 my (%data) = @_;
508 my $line;
509 foreach my $script (sort keys(%data)) {
510 my ($local, $autorun);
511 if (get_local_version($script)) {
512 $line .= "%go%n ";
513 $local = get_local_version($script);
514 } else {
515 $line .= "%ro%n ";
516 $local = undef;
517 }
518 if (defined $local || check_autorun($script)) {
519 $autorun = "no";
520 $autorun = "yes" if check_autorun($script);
521 } else {
522 $autorun = undef;
523 }
524 $line .= "%9".$script."%9\n";
525 $line .= " Version : ".$data{$script}{version}."\n";
526 $line .= " Source : ".$data{$script}{source}."\n";
527 $line .= " Installed : ".$local."\n" if defined $local;
528 $line .= " Autorun : ".$autorun."\n" if defined $autorun;
529 $line .= " Authors : ".$data{$script}{authors};
530 $line .= " %Go-m signed%n" if $data{$script}{signature_available};
531 $line .= "\n";
532 $line .= " Contact : ".$data{$script}{contact}."\n";
533 $line .= " Description: ".$data{$script}{description}."\n";
534 $line .= "\n" if $data{$script}{modules};
535 $line .= " Needed Perl modules:\n" if $data{$script}{modules};
536
537 foreach (sort keys %{$data{$script}{modules}}) {
538 if ( $data{$script}{modules}{$_}{installed} == 1 ) {
539 $line .= " %g->%n ".$_." (found)";
540 } else {
541 $line .= " %r->%n ".$_." (not found)";
542 }
543 $line .= " <optional>" if $data{$script}{modules}{$_}{optional};
544 $line .= "\n";
545 }
546 #$line .= " Needed Irssi scripts:\n";
547 $line .= " Needed Irssi Scripts:\n" if $data{$script}{depends};
548 foreach (sort keys %{$data{$script}{depends}}) {
549 if ( $data{$script}{depends}{$_}{installed} == 1 ) {
550 $line .= " %g->%n ".$_." (loaded)";
551 } else {
552 $line .= " %r->%n ".$_." (not loaded)";
553 }
554 #$line .= " <optional>" if $data{$script}{depends}{$_}{optional};
555 $line .= "\n";
556 }
557 }
558 print CLIENTCRAP draw_box('ScriptAssist', $line, 'info', 1) ;
559 }
560
561 sub print_rate (%) {
562 my (%data) = @_;
563 my $line;
564 foreach my $script (sort keys(%data)) {
565 if ($data{$script}) {
566 $line .= "%go%n %9".$script."%9 has been rated";
567 } else {
568 $line .= "%ro%n %9".$script."%9 : Already rated this script";
569 }
570 }
571 print CLIENTCRAP draw_box('ScriptAssist', $line, 'rating', 1) ;
572 }
573
574 sub print_ratings (%) {
575 my (%data) = @_;
576 my @table;
577 foreach my $script (sort {$data{$b}{rating}<=>$data{$a}{rating}} keys(%data)) {
578 my @line;
579 if (get_local_version($script)) {
580 push @line, "%go%n";
581 } else {
582 push @line, "%yo%n";
583 }
584 push @line, "%9".$script."%9";
585 push @line, $data{$script}{rating};
586 push @line, "[".$data{$script}{votes}." votes]";
587 push @table, \@line;
588 }
589 print CLIENTCRAP draw_box('ScriptAssist', array2table(@table), 'ratings', 1) ;
590 }
591
592 sub print_new ($) {
593 my ($list) = @_;
594 my @table;
595 foreach (sort {$list->{$b}{last_modified} cmp $list->{$a}{last_modified}} keys %$list) {
596 my @line;
597 my ($name) = /^(.*?)\.pl$/;
598 if (get_local_version($name)) {
599 push @line, "%go%n";
600 } else {
601 push @line, "%yo%n";
602 }
603 push @line, "%9".$name."%9";
604 push @line, $list->{$_}{last_modified};
605 push @table, \@line;
606 }
607 print CLIENTCRAP draw_box('ScriptAssist', array2table(@table), 'new scripts', 1) ;
608 }
609
610 sub print_debug (%) {
611 my (%data) = @_;
612 my $line;
613 foreach my $script (sort keys %data) {
614 $line .= "%ro%n %9".$script."%9 failed to load\n";
615 $line .= " Make sure you have the following perl modules installed:\n";
616 foreach (sort keys %{$data{$script}}) {
617 if ( $data{$script}{$_}{installed} == 1 ) {
618 $line .= " %g->%n ".$_." (found)";
619 } else {
620 $line .= " %r->%n ".$_." (not found)\n";
621 $line .= " [This module is optional]\n" if $data{$script}{$_}{optional};
622 $line .= " [Try /scriptassist cpan ".$_."]";
623 }
624 $line .= "\n";
625 }
626 print CLIENTCRAP draw_box('ScriptAssist', $line, 'debug', 1) ;
627 }
628 }
629
630 sub load_script ($) {
631 my ($script) = @_;
632 Irssi::command('script load '.$script);
633 }
634
635 sub print_install (%) {
636 my (%data) = @_;
637 my $text;
638 my ($crashed, @installed);
639 foreach my $script (sort keys %data) {
640 my $line;
641 if ($data{$script}{installed} == 1) {
642 my $hacked;
643 if ($have_gpg && Irssi::settings_get_bool('scriptassist_use_gpg')) {
644 if ($data{$script}{signed} >= 0) {
645 load_script($script) unless (lc($script) eq lc($IRSSI{name}));
646 } else {
647 $hacked = 1;
648 }
649 } else {
650 load_script($script) unless (lc($script) eq lc($IRSSI{name}));
651 }
652 if (get_local_version($script) && not lc($script) eq lc($IRSSI{name})) {
653 $line .= "%go%n %9".$script."%9 installed\n";
654 push @installed, $script;
655 } elsif (lc($script) eq lc($IRSSI{name})) {
656 $line .= "%yo%n %9".$script."%9 installed, please reload manually\n";
657 } else {
658 $line .= "%Ro%n %9".$script."%9 fetched, but unable to load\n";
659 $crashed .= $script." " unless $hacked;
660 }
661 if ($have_gpg && Irssi::settings_get_bool('scriptassist_use_gpg')) {
662 foreach (split /\n/, check_sig($data{$script})) {
663 $line .= " ".$_."\n";
664 }
665 }
666 } elsif ($data{$script}{installed} == -2) {
667 $line .= "%ro%n %9".$script."%9 already loaded, please try \"update\"\n";
668 } elsif ($data{$script}{installed} <= 0) {
669 $line .= "%ro%n %9".$script."%9 not installed\n";
670 foreach (split /\n/, check_sig($data{$script})) {
671 $line .= " ".$_."\n";
672 }
673 } else {
674 $line .= "%Ro%n %9".$script."%9 not found on server\n";
675 }
676 $text .= $line;
677 }
678 # Inspect crashed scripts
679 bg_do("debug ".$crashed) if $crashed;
680 print CLIENTCRAP draw_box('ScriptAssist', $text, 'install', 1);
681 list_sbitems(\@installed);
682 }
683
684 sub list_sbitems ($) {
685 my ($scripts) = @_;
686 my $text;
687 foreach (@$scripts) {
688 no strict 'refs';
689 next unless defined %{ "Irssi::Script::${_}::" };
690 next unless defined %{ "Irssi::Script::${_}::IRSSI" };
691 my %header = %{ "Irssi::Script::${_}::IRSSI" };
692 next unless $header{sbitems};
693 $text .= '%9"'.$_.'"%9 provides the following statusbar item(s):'."\n";
694 $text .= ' ->'.$_."\n" foreach (split / /, $header{sbitems});
695 }
696 return unless $text;
697 $text .= "\n";
698 $text .= "Enter '/statusbar window add <item>' to add an item.";
699 print CLIENTCRAP draw_box('ScriptAssist', $text, 'sbitems', 1);
700 }
701
702 sub check_sig ($) {
703 my ($sig) = @_;
704 my $line;
705 my %trust = ( -1 => 'undefined',
706 0 => 'never',
707 1 => 'marginal',
708 2 => 'fully',
709 3 => 'ultimate'
710 );
711 if ($sig->{signed} == 1) {
712 $line .= "Signature found from ".$sig->{sig}{user}."\n";
713 $line .= "Timestamp : ".$sig->{sig}{date}."\n";
714 $line .= "Fingerprint: ".$sig->{sig}{fingerprint}."\n";
715 $line .= "KeyID : ".$sig->{sig}{keyid}."\n";
716 $line .= "Trust : ".$trust{$sig->{sig}{trust}}."\n";
717 } elsif ($sig->{signed} == -1) {
718 $line .= "%1Warning, unable to verify signature%n\n";
719 } elsif ($sig->{signed} == 0) {
720 $line .= "%1No signature found%n\n" unless Irssi::settings_get_bool('scriptassist_install_unsigned_scripts');
721 }
722 return $line;
723 }
724
725 sub print_search ($%) {
726 my ($query, %data) = @_;
727 my $text;
728 foreach (sort keys %data) {
729 my $line;
730 $line .= "%go%n" if $data{$_}{installed};
731 $line .= "%yo%n" if not $data{$_}{installed};
732 $line .= " %9".$_."%9 ";
733 $line .= $data{$_}{desc};
734 $line =~ s/($query)/%U$1%U/gi;
735 $line .= ' ('.$data{$_}{authors}.')';
736 $text .= $line." \n";
737 }
738 print CLIENTCRAP draw_box('ScriptAssist', $text, 'search: '.$query, 1) ;
739 }
740
741 sub print_update (%) {
742 my (%data) = @_;
743 my $text;
744 my @table;
745 my $verbose = Irssi::settings_get_bool('scriptassist_update_verbose');
746 foreach (sort keys %data) {
747 my $signed = 0;
748 if ($data{$_}{installed} == 1) {
749 my $local = $data{$_}{local};
750 my $remote = $data{$_}{remote};
751 push @table, ['%yo%n', '%9'.$_.'%9', 'upgraded ('.$local.'->'.$remote.')'];
752 foreach (split /\n/, check_sig($data{$_})) {
753 push @table, ['', '', $_];
754 }
755 if (lc($_) eq lc($IRSSI{name})) {
756 push @table, ['', '', "%R%9Please reload manually%9%n"];
757 } else {
758 load_script($_);
759 }
760 } elsif ($data{$_}{installed} == 0 || $data{$_}{installed} == -1) {
761 push @table, ['%yo%n', '%9'.$_.'%9', 'not upgraded'];
762 foreach (split /\n/, check_sig($data{$_})) {
763 push @table, ['', '', $_];
764 }
765 } elsif ($data{$_}{installed} == -2 && $verbose) {
766 my $local = $data{$_}{local};
767 push @table, ['%go%n', '%9'.$_.'%9', 'already at the latest version ('.$local.')'];
768 }
769 }
770 $text = array2table(@table);
771 print CLIENTCRAP draw_box('ScriptAssist', $text, 'update', 1) ;
772 }
773
774 sub contact_author ($) {
775 my ($script) = @_;
776 no strict 'refs';
777 return unless defined %{ "Irssi::Script::${script}::" };
778 my %header = %{ "Irssi::Script::${script}::IRSSI" };
779 if (defined $header{contact}) {
780 my @ads = split(/ |,/, $header{contact});
781 my $address = $ads[0];
782 $address .= '?subject='.$script;
783 $address .= '_'.get_local_version($script) if defined get_local_version($script);
784 call_openurl($address);
785 }
786 }
787
788 sub get_scripts {
789 my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
790 $ua->agent('ScriptAssist/'.$VERSION);
791 $ua->env_proxy();
792 my @mirrors = split(/ /, Irssi::settings_get_str('scriptassist_script_sources'));
793 my %sites_db;
794 my $fetched = 0;
795 my @sources;
796 foreach my $site (@mirrors) {
797 my $request = HTTP::Request->new('GET', $site);
798 if ($remote_db{timestamp}) {
799 $request->if_modified_since($remote_db{timestamp});
800 }
801 my $response = $ua->request($request);
802 next unless $response->is_success;
803 $fetched = 1;
804 my $data = $response->content();
805 my ($src, $type);
806 if ($site =~ /(.*\/).+\.(.+)/) {
807 $src = $1;
808 $type = $2;
809 }
810 push @sources, $src;
811 #my @header = ('name', 'contact', 'authors', 'description', 'version', 'modules', 'last_modified');
812 if ($type eq 'dmp') {
813 no strict 'vars';
814 my $new_db = eval "$data";
815 foreach (keys %$new_db) {
816 if (defined $sites_db{script}{$_}) {
817 my $old = $sites_db{$_}{version};
818 my $new = $new_db->{$_}{version};
819 next if (compare_versions($old, $new) eq 'newer');
820 }
821 #foreach my $key (@header) {
822 foreach my $key (keys %{ $new_db->{$_} }) {
823 next unless defined $new_db->{$_}{$key};
824 $sites_db{$_}{$key} = $new_db->{$_}{$key};
825 }
826 $sites_db{$_}{source} = $src;
827 }
828 } else {
829 ## FIXME Panic?!
830 }
831
832 }
833 if ($fetched) {
834 # Clean database
835 foreach (keys %{$remote_db{db}}) {
836 foreach my $site (@sources) {
837 if ($remote_db{db}{$_}{source} eq $site) {
838 delete $remote_db{db}{$_};
839 last;
840 }
841 }
842 }
843 $remote_db{db}{$_} = $sites_db{$_} foreach (keys %sites_db);
844 $remote_db{timestamp} = time();
845 }
846 return $remote_db{db};
847 }
848
849 sub get_remote_version ($$) {
850 my ($script, $database) = @_;
851 return $database->{$script.".pl"}{version};
852 }
853
854 sub get_local_version ($) {
855 my ($script) = @_;
856 no strict 'refs';
857 return unless defined %{ "Irssi::Script::${script}::" };
858 my $version = ${ "Irssi::Script::${script}::VERSION" };
859 return $version;
860 }
861
862 sub compare_versions ($$) {
863 my ($ver1, $ver2) = @_;
864 my @ver1 = split /\./, $ver1;
865 my @ver2 = split /\./, $ver2;
866 #if (scalar(@ver2) != scalar(@ver1)) {
867 # return 0;
868 #}
869 my $cmp = 0;
870 ### Special thanks to Clemens Heidinger
871 $cmp ||= $ver1[$_] <=> $ver2[$_] || $ver1[$_] cmp $ver2[$_] for 0..scalar(@ver2);
872 return 'newer' if $cmp == 1;
873 return 'older' if $cmp == -1;
874 return 'equal';
875 }
876
877 sub loaded_scripts {
878 no strict 'refs';
879 my @modules;
880 foreach (sort grep(s/::$//, keys %Irssi::Script::)) {
881 #my $name = ${ "Irssi::Script::${_}::IRSSI" }{name};
882 #my $version = ${ "Irssi::Script::${_}::VERSION" };
883 push @modules, $_;# if $name && $version;
884 }
885 return \@modules;
886
887 }
888
889 sub check_scripts {
890 my ($data) = @_;
891 my %versions;
892 #$versions{-foo} = 1;
893 foreach (@{loaded_scripts()}) {
894 my $remote = get_remote_version($_, $data);
895 my $local = get_local_version($_);
896 my $state;
897 if ($local && $remote) {
898 $state = compare_versions($local, $remote);
899 } elsif ($local) {
900 $state = 'noversion';
901 $remote = '/';
902 } else {
903 $state = 'noheader';
904 $local = '/';
905 $remote = '/';
906 }
907 if ($state) {
908 $versions{$_}{state} = $state;
909 $versions{$_}{remote} = $remote;
910 $versions{$_}{local} = $local;
911 }
912 }
913 return \%versions;
914 }
915
916 sub download_script ($$) {
917 my ($script, $xml) = @_;
918 my %result;
919 my $site = $xml->{$script.".pl"}{source};
920 $result{installed} = 0;
921 $result{signed} = 0;
922 my $dir = Irssi::get_irssi_dir();
923 my $ua = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1,timeout => 30);
924 $ua->agent('ScriptAssist/'.$VERSION);
925 my $request = HTTP::Request->new('GET', $site.'/scripts/'.$script.'.pl');
926 my $response = $ua->request($request);
927 if ($response->is_success()) {
928 my $file = $response->content();
929 mkdir $dir.'/scripts/' unless (-e $dir.'/scripts/');
930 local *F;
931 open(F, '>'.$dir.'/scripts/'.$script.'.pl.new');
932 print F $file;
933 close(F);
934 if ($have_gpg && Irssi::settings_get_bool('scriptassist_use_gpg')) {
935 my $ua2 = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1,timeout => 30);
936 $ua->agent('ScriptAssist/'.$VERSION);
937 my $request2 = HTTP::Request->new('GET', $site.'/signatures/'.$script.'.pl.asc');
938 my $response2 = $ua->request($request2);
939 if ($response2->is_success()) {
940 local *S;
941 my $sig_dir = $dir.'/scripts/signatures/';
942 mkdir $sig_dir unless (-e $sig_dir);
943 open(S, '>'.$sig_dir.$script.'.pl.asc');
944 my $file2 = $response2->content();
945 print S $file2;
946 close(S);
947 my $sig;
948 foreach (1..2) {
949 # FIXME gpg needs two rounds to load the key
950 my $gpg = new GnuPG();
951 eval {
952 $sig = $gpg->verify( file => $dir.'/scripts/'.$script.'.pl.new', signature => $sig_dir.$script.'.pl.asc' );
953 };
954 }
955 if (defined $sig->{user}) {
956 $result{installed} = 1;
957 $result{signed} = 1;
958 $result{sig}{$_} = $sig->{$_} foreach (keys %{$sig});
959 } else {
960 # Signature broken?
961 $result{installed} = 0;
962 $result{signed} = -1;
963 }
964 } else {
965 $result{signed} = 0;
966 $result{installed} = -1;
967 $result{installed} = 1 if Irssi::settings_get_bool('scriptassist_install_unsigned_scripts');
968 }
969 } else {
970 $result{signed} = 0;
971 $result{installed} = -1;
972 $result{installed} = 1 if Irssi::settings_get_bool('scriptassist_install_unsigned_scripts');
973 }
974 }
975 if ($result{installed}) {
976 my $old_dir = "$dir/scripts/old/";
977 mkdir $old_dir unless (-e $old_dir);
978 rename "$dir/scripts/$script.pl", "$old_dir/$script.pl.old" if -e "$dir/scripts/$script.pl";
979 rename "$dir/scripts/$script.pl.new", "$dir/scripts/$script.pl";
980 }
981 return \%result;
982 }
983
984 sub print_check (%) {
985 my (%data) = @_;
986 my $text;
987 my @table;
988 foreach (sort keys %data) {
989 my $state = $data{$_}{state};
990 my $remote = $data{$_}{remote};
991 my $local = $data{$_}{local};
992 if (Irssi::settings_get_bool('scriptassist_check_verbose')) {
993 push @table, ['%go%n', '%9'.$_.'%9', 'Up to date. ('.$local.')'] if $state eq 'equal';
994 }
995 push @table, ['%mo%n', '%9'.$_.'%9', "No version information available on network."] if $state eq "noversion";
996 push @table, ['%mo%n', '%9'.$_.'%9', 'No header in script.'] if $state eq "noheader";
997 push @table, ['%bo%n', '%9'.$_.'%9', "Your version is newer (".$local."->".$remote.")"] if $state eq "newer";
998 push @table, ['%ro%n', '%9'.$_.'%9', "A new version is available (".$local."->".$remote.")"] if $state eq "older";;
999 }
1000 $text = array2table(@table);
1001 print CLIENTCRAP draw_box('ScriptAssist', $text, 'check', 1) ;
1002 }
1003
1004 sub toggle_autorun ($) {
1005 my ($script) = @_;
1006 my $dir = Irssi::get_irssi_dir()."/scripts/";
1007 mkdir $dir."autorun/" unless (-e $dir."autorun/");
1008 return unless (-e $dir.$script.".pl");
1009 if (check_autorun($script)) {
1010 if (readlink($dir."/autorun/".$script.".pl") eq "../".$script.".pl") {
1011 if (unlink($dir."/autorun/".$script.".pl")) {
1012 print CLIENTCRAP "%R>>%n Autorun of ".$script." disabled";
1013 } else {
1014 print CLIENTCRAP "%R>>%n Unable to delete link";
1015 }
1016 } else {
1017 print CLIENTCRAP "%R>>%n ".$dir."/autorun/".$script.".pl is not a correct link";
1018 }
1019 } else {
1020 symlink("../".$script.".pl", $dir."/autorun/".$script.".pl");
1021 print CLIENTCRAP "%R>>%n Autorun of ".$script." enabled";
1022 }
1023 }
1024
1025 sub sig_script_error ($$) {
1026 my ($script, $msg) = @_;
1027 return unless Irssi::settings_get_bool('scriptassist_catch_script_errors');
1028 if ($msg =~ /Can't locate (.*?)\.pm in \@INC \(\@INC contains:(.*?) at/) {
1029 my $module = $1;
1030 $module =~ s/\//::/g;
1031 missing_module($module);
1032 }
1033 }
1034
1035 sub missing_module ($$) {
1036 my ($module) = @_;
1037 my $text;
1038 $text .= "The perl module %9".$module."%9 is missing on your system.\n";
1039 $text .= "Please ask your administrator about it.\n";
1040 $text .= "You can also check CPAN via '/scriptassist cpan ".$module."'.\n";
1041 print CLIENTCRAP &draw_box('ScriptAssist', $text, $module, 1);
1042 }
1043
1044 sub cmd_scripassist ($$$) {
1045 my ($arg, $server, $witem) = @_;
1046 my @args = split(/ /, $arg);
1047 if ($args[0] eq 'help' || $args[0] eq '-h') {
1048 show_help();
1049 } elsif ($args[0] eq 'check') {
1050 bg_do("check");
1051 } elsif ($args[0] eq 'update') {
1052 shift @args;
1053 bg_do("update ".join(' ', @args));
1054 } elsif ($args[0] eq 'search' && defined $args[1]) {
1055 shift @args;
1056 bg_do("search ".join(" ", @args));
1057 } elsif ($args[0] eq 'install' && defined $args[1]) {
1058 shift @args;
1059 bg_do("install ".join(' ', @args));
1060 } elsif ($args[0] eq 'contact' && defined $args[1]) {
1061 contact_author($args[1]);
1062 } elsif ($args[0] eq 'ratings' && defined $args[1]) {
1063 shift @args;
1064 bg_do("ratings ".join(' ', @args));
1065 } elsif ($args[0] eq 'rate' && defined $args[1] && defined $args[2]) {
1066 shift @args;
1067 bg_do("rate ".join(' ', @args)) if ($args[2] >= 0 && $args[2] < 6);
1068 } elsif ($args[0] eq 'info' && defined $args[1]) {
1069 shift @args;
1070 bg_do("info ".join(' ', @args));
1071 } elsif ($args[0] eq 'echo') {
1072 bg_do("echo");
1073 } elsif ($args[0] eq 'top') {
1074 my $number = defined $args[1] ? $args[1] : 10;
1075 bg_do("top ".$number);
1076 } elsif ($args[0] eq 'cpan' && defined $args[1]) {
1077 call_openurl('http://search.cpan.org/search?mode=module&query='.$args[1]);
1078 } elsif ($args[0] eq 'autorun' && defined $args[1]) {
1079 toggle_autorun($args[1]);
1080 } elsif ($args[0] eq 'new') {
1081 my $number = defined $args[1] ? $args[1] : 5;
1082 bg_do("new ".$number);
1083 }
1084 }
1085
1086 sub sig_command_script_load ($$$) {
1087 my ($script, $server, $witem) = @_;
1088 no strict;
1089 $script = $2 if $script =~ /(.*\/)?(.*?)\.pl$/;
1090 if (defined %{ "Irssi::Script::${script}::" }) {
1091 if (defined &{ "Irssi::Script::${script}::pre_unload" }) {
1092 print CLIENTCRAP "%R>>%n Triggering pre_unload function of $script...";
1093 &{ "Irssi::Script::${script}::pre_unload" }();
1094 }
1095 }
1096 }
1097
1098 sub sig_default_command ($$) {
1099 my ($cmd, $server) = @_;
1100 return unless Irssi::settings_get_bool("scriptassist_check_unknown_commands");
1101 bg_do('unknown '.$cmd);
1102 }
1103
1104 sub sig_complete ($$$$$) {
1105 my ($list, $window, $word, $linestart, $want_space) = @_;
1106 return unless $linestart =~ /^.script(assist)? (install|rate|ratings|update|check|contact|info|autorun)/;
1107 my @newlist;
1108 my $str = $word;
1109 foreach (@complist) {
1110 if ($_ =~ /^(\Q$str\E.*)?$/) {
1111 push @newlist, $_;
1112 }
1113 }
1114 foreach (@{loaded_scripts()}) {
1115 push @newlist, $_ if /^(\Q$str\E.*)?$/;
1116 }
1117 $want_space = 0;
1118 push @$list, $_ foreach @newlist;
1119 Irssi::signal_stop();
1120 }
1121
1122
1123 Irssi::settings_add_str($IRSSI{name}, 'scriptassist_script_sources', 'http://www.irssi.org/scripts/scripts.dmp');
1124 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_cache_sources', 1);
1125 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_update_verbose', 1);
1126 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_check_verbose', 1);
1127 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_catch_script_errors', 1);
1128
1129 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_install_unsigned_scripts', 1);
1130 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_use_gpg', 1);
1131 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_integrate', 1);
1132 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_check_unknown_commands', 1);
1133
1134 Irssi::signal_add_first("default command", \&sig_default_command);
1135 Irssi::signal_add_first('complete word', \&sig_complete);
1136 Irssi::signal_add_first('command script load', \&sig_command_script_load);
1137 Irssi::signal_add_first('command script unload', \&sig_command_script_load);
1138
1139 if (defined &Irssi::signal_register) {
1140 Irssi::signal_register({ 'script error' => [ 'Irssi::Script', 'string' ] });
1141 Irssi::signal_add_last('script error', \&sig_script_error);
1142 }
1143
1144 Irssi::command_bind('scriptassist', \&cmd_scripassist);
1145
1146 Irssi::theme_register(['box_header', '%R,--[%n$*%R]%n',
1147 'box_inside', '%R|%n $*',
1148 'box_footer', '%R`--<%n$*%R>->%n',
1149 ]);
1150
1151 foreach my $cmd ( ( 'check', 'install', 'update', 'contact', 'search', '-h', 'help', 'ratings', 'rate', 'info', 'echo', 'top', 'cpan', 'autorun', 'new') ) {
1152 Irssi::command_bind('scriptassist '.$cmd => sub {
1153 cmd_scripassist("$cmd ".$_[0], $_[1], $_[2]); });
1154 if (Irssi::settings_get_bool('scriptassist_integrate')) {
1155 Irssi::command_bind('script '.$cmd => sub {
1156 cmd_scripassist("$cmd ".$_[0], $_[1], $_[2]); });
1157 }
1158 }
1159
1160 print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /scriptassist help for help';