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