html/poison.pl
1 # by Stefan 'tommie' Tomanek
2 #
3 use strict;
4
5 use 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
18 use vars qw($forked %ids);
19 use IO::Socket::INET;
20 use Data::Dumper;
21 use Irssi;
22 use POSIX;
23
24 sub 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
39 sub 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
48 sub 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
61 sub 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
70 sub 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
95 sub 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
121 sub 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
136 sub 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
164 sub 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
172 sub 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
182 sub 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
199 sub 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
228 sub 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
258 sub 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
281 sub 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
308 sub 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
329 Irssi::settings_add_str('poison', 'poison_host', 'localhost');
330 Irssi::settings_add_int('poison', 'poison_port', 1213);
331 Irssi::settings_add_bool('poison', 'poison_round_filesize', 1);
332
333 Irssi::command_bind('poison', \&cmd_poison);
334
335 foreach my $cmd ('help', 'search', 'get') {
336 Irssi::command_bind('poison '.$cmd => sub {
337 cmd_poison("$cmd ".$_[0], $_[1], $_[2]); });
338 }
339
340 print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded, /poison help';
341