1# by  Stefan 'tommie' Tomanek
2#
3use strict;
4
5use vars qw($VERSION %IRSSI);
6$VERSION = "2003020801";
7%IRSSI = (
8    authors     => "Stefan 'tommie' Tomanek",
9    contact     => "stefan\@pico.ruhr.de",
10    name        => "Poison",
11    description => "equips Irssi with an interface to giFT",
12    license     => "GPLv2",
13    changed     => "$VERSION",
14    modules     => "IO::Socket::INET Data::Dumper",
15    commands	=> "poison"
16);
17
18use vars qw($forked %ids);
19use IO::Socket::INET;
20use Data::Dumper;
21use Irssi;
22use POSIX;
23
24sub show_help() {
25    my $help = $IRSSI{name}." $VERSION
26/poison
27    List current downloads
28/poison search <query>
29    Search for files on the network
30";
31    my $text = '';
32    foreach (split(/\n/, $help)) {
33        $_ =~ s/^\/(.*)$/%9\/$1%9/;
34        $text .= $_."\n";
35    }
36    print CLIENTCRAP &draw_box($IRSSI{name}, $text, "help", 1);
37}
38
39sub giftconnect {
40    my $host = Irssi::settings_get_str('poison_host');
41    my $port = Irssi::settings_get_int('poison_port');
42    my $sock = IO::Socket::INET->new(PeerAddr => $host,
43       				     PeerPort => $port,
44	     			     Proto    => 'tcp');
45    return $sock;
46}
47
48sub draw_box ($$$$) {                                                               my ($title, $text, $footer, $colour) = @_;
49    my $box = '';
50    $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
51    foreach (split(/\n/, $text)) {
52	$box .= '%R|%n '.$_."\n";
53    }
54    $box .= '%R`--<%n'.$footer.'%R>->%n';
55    unless ($colour) {
56        $box =~ s/%(.)/$1 eq '%'?$1:''/eg;
57    }
58    return $box;
59}
60
61sub round ($$) {
62    return $_[0] unless Irssi::settings_get_bool('poison_round_filesize');
63    if ($_[1] > 100000) {
64        return sprintf "%.2fMB", $_[0]/1024/1024;
65    } else {
66        return sprintf "%.2fKB", $_[0]/1024;
67    }
68}
69
70sub array2table {
71    my (@array) = @_;
72    my @width;
73    foreach my $line (@array) {
74        for (0..scalar(@$line)-1) {
75            my $l = $line->[$_];
76            $l =~ s/%[^%]//g;
77            $l =~ s/%%/%/g;
78            $width[$_] = length($l) if $width[$_]<length($l);
79        }
80    }
81    my $text;
82    foreach my $line (@array) {
83        for (0..scalar(@$line)-1) {
84            my $l = $line->[$_];
85            $text .= $line->[$_];
86            $l =~ s/%[^%]//g;
87            $l =~ s/%%/%/g;
88            $text .= " "x($width[$_]-length($l)+1) unless ($_ == scalar(@$line)-1);
89        }
90        $text .= "\n";
91    }
92    return $text;
93}
94
95sub bg_do ($$) {
96    my ($id, $sub) = @_;
97    my ($rh, $wh);
98    pipe($rh, $wh);
99    return if $forked;
100    $forked = 1;
101    my $pid = fork();
102    if ($pid > 0) {
103        close $wh;
104        Irssi::pidwait_add($pid);
105        my $pipetag;
106        my @args = ($rh, \$pipetag);                                                    $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
107    } else {
108	eval {
109	    my $result;
110	    $result->{$id} = &$sub();
111	    my $dumper = Data::Dumper->new([$result]);
112            $dumper->Purity(1)->Deepcopy(1);
113            my $data = $dumper->Dump;
114            print($wh $data);
115            close($wh);
116	};
117	POSIX::_exit(1);
118    }
119}
120
121sub pipe_input ($) {
122    my ($rh, $pipetag) = @{$_[0]};
123    my $text;
124    $text .= $_ foreach (<$rh>);
125    close($rh);
126    Irssi::input_remove($$pipetag);
127    $forked = 0;
128    return unless($text);
129    no strict;
130    my $result = eval "$text";
131    return unless ref $result;
132    print_results($result->{search}) if defined $result->{search};
133    print CLIENTCRAP '%R>>%n Added '.$result->{sources}.' source(s) for download' if defined $result->{sources};
134}
135
136sub search_file ($) {
137    my ($query) = @_;
138    my $sock = giftconnect();
139    return unless $sock;
140    $sock->print("SEARCH query(".$query.");\n");
141    my %results;
142    my %item;
143    my $meta = 0;
144    while ($_ = $sock->getline()) {
145	if ((not $meta) && / *(.*?)\((.*?)\)[^;]/) {
146    	    my ($key, $value) = ($1, $2);
147	    $value =~ s/\\(.)/$1/g;
148	    $item{$key} = $value;
149	} elsif (/META/) {
150	    $meta = 1;
151	} elsif (/ITEM;/) {
152	    $sock->close();
153	    last;
154	} elsif (/;/) {
155	    $meta = 0;
156	    my %foo = %item;
157	    %item = ();
158	    $results{$foo{hash}} = \%foo;
159	}
160    }
161    return \%results;
162}
163
164sub get_file ($) {
165    my ($id) = @_;
166    return unless $ids{$id};
167    my $data = $ids{$id};
168    add_source($data);
169    bg_do('sources', sub { retrieve_sources($data->{hash}) } );
170}
171
172sub retrieve_sources ($) {
173    my ($hash) = @_;
174    my %sources;
175    foreach (@{ find_sources($hash) }) {
176	add_source($_);
177	$sources{$_->{user}} = 1;
178    }
179    return scalar keys %sources;
180}
181
182sub add_source (\%) {
183    my ($data) = @_;
184    my $sock = giftconnect();
185    return unless $sock;
186    my @bar = split('/', $data->{url});
187    my $file = $bar[-1];
188
189    my $line = "ADDSOURCE ";
190    $line .= "user(".$data->{user}.") ";
191    $line .= "hash(".$data->{hash}.") ";
192    $line .= "size(".$data->{size}.") ";
193    $line .= "url(".$data->{url}.") ";
194    $line .= "save(".$file.");";
195    $sock->print($line."\n");
196    $sock->close();
197}
198
199sub find_sources ($) {
200    my ($hash) = @_;
201    my $sock = giftconnect();
202    return unless $sock;
203    $sock->print("LOCATE query(".$hash.");\n");
204    my %item;
205    my @sources;
206    my $meta = 0;
207    while ($_ = $sock->getline()) {
208        if ((not $meta) && (/ *(.*?)\((.*?)\)[^;]/)) {
209            my ($key, $value) = ($1, $2);
210	    #print $key." => ".$value;
211            $value =~ s/\\(.)/$1/g;
212            $item{$key} = $value;
213        } elsif (/META/) {
214            $meta = 1;
215        } elsif (/ITEM;/) {
216            $sock->close();
217            last;
218        } elsif (/;/) {
219            $meta = 0;
220            my %foo = %item;
221            %item = ();
222            push @sources, \%foo;
223        }
224    }
225    return \@sources;
226}
227
228sub get_downloads {
229    my %downloads;
230    my $sock = giftconnect();
231    return unless $sock;
232    $sock->print("ATTACH client(".$IRSSI{name}.") version(".$VERSION."); DETACH;");
233    my %downloads;
234    my ($add, $source) = (0,0);
235    my %item;
236    while ($_ = $sock->getline()) {
237	if (/^DOWNLOAD_ADD\((\d+)\)/) {
238	    $add = 1;
239	    $item{sessionid} = $1;
240	} elsif (/SOURCE/) {
241	    $source = 1;
242	} elsif (/};/) {
243	    $source = 0;
244	    $add = 0;
245	    my %foo = %item;
246	    $downloads{$foo{file}} = \%foo;
247	} else {
248	    if (($add && not $source) && /^  (.*?)\((.*?)\)$/) {
249		my ($key, $value) = ($1, $2);
250		$value =~ s/\\(.)/$1/g;
251		$item{$key} = $value;
252	    }
253	}
254    }
255    return \%downloads;
256}
257
258sub print_results ($) {
259    my ($results) = @_;
260    my @array;
261    %ids = ();
262    my $i = 1;
263    foreach (sort {uc($a) cmp uc($b)} keys %$results) {
264	my @bar = split('/', $results->{$_}{url});
265	my $file = $bar[-1];
266	$file =~ s/%20/ /g;
267	$file =~ s/%/%%/g;
268	my @line;
269	push @line, "%9".$i."%9";
270	push @line, "%9".$file."%9";
271	push @line, $results->{$_}{size};
272	push @line, $results->{$_}{availability};
273	push @array, \@line;
274	$ids{$i} = $results->{$_};
275	$i++;
276    }
277    my $text = array2table(@array);
278    print CLIENTCRAP draw_box("Poison", $text, "Results", 1) if $text;
279}
280
281sub print_downloads ($) {
282    my ($downloads) = @_;
283    my $text;
284    foreach (sort {uc($a) cmp uc($b)} keys %$downloads) {
285	if ($downloads->{$_}{state} eq 'Active') {
286	    $text .= '%bo%n';
287	} elsif ($downloads->{$_}{state} eq 'Paused') {
288	    $text .= '%yo%n';
289	}
290	my $percent = $downloads->{$_}{size} > 0 ? ($downloads->{$_}{transmit} / $downloads->{$_}{size}) * 100 : 0;
291	my $file = $_;
292        $file =~ s/%20/ /g;
293        $file =~ s/%/%%/g;
294	$text .= " %9".$file."%9";
295	$text .= "\n";
296	$text .= '     ';
297	$text .= round($downloads->{$_}{transmit}, $downloads->{$_}{size}).'/';
298	$text .= round($downloads->{$_}{size}, $downloads->{$_}{size});
299	$percent =~ s/(\..).*/$1/g;
300	$text .= " (".$percent."%%)";
301	$text .= "\n"
302    }
303    print CLIENTCRAP draw_box("Poison", $text, "Downloads", 1);
304}
305
306
307
308sub cmd_poison ($$$) {
309    my ($args, $server, $witem) = @_;
310    my @args = split(/ /, $args);
311    if (@args == 0) {
312	print_downloads(get_downloads());
313    } elsif ($args[0] eq 'search') {
314	shift @args;
315	if ($forked) {
316	    print CLIENTCRAP '%R>>%n Already searching...';
317	} else {
318	    print CLIENTCRAP '%R>>%n Search in progress...';
319	}
320	bg_do 'search', sub { search_file(join(' ', @args)) };
321	#print_results search_file(join(' ', @args));
322    } elsif ($args[0] eq 'get' && $args[1]) {
323	get_file($args[1]);
324    } elsif ($args[0] eq 'help') {
325	show_help();
326    }
327}
328
329Irssi::settings_add_str('poison', 'poison_host', 'localhost');
330Irssi::settings_add_int('poison', 'poison_port', 1213);
331Irssi::settings_add_bool('poison', 'poison_round_filesize', 1);
332
333Irssi::command_bind('poison', \&cmd_poison);
334
335foreach my $cmd ('help', 'search', 'get') {
336    Irssi::command_bind('poison '.$cmd => sub {
337        cmd_poison("$cmd ".$_[0], $_[1], $_[2]); });
338}
339
340print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded, /poison help';
341
342