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