summaryrefslogtreecommitdiffstats
path: root/scripts/poison.pl
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/poison.pl')
-rw-r--r--scripts/poison.pl341
1 files changed, 341 insertions, 0 deletions
diff --git a/scripts/poison.pl b/scripts/poison.pl
new file mode 100644
index 0000000..f04da33
--- /dev/null
+++ b/scripts/poison.pl
@@ -0,0 +1,341 @@
+# by Stefan 'tommie' Tomanek
+#
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003020801";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "Poison",
+ description => "equips Irssi with an interface to giFT",
+ license => "GPLv2",
+ changed => "$VERSION",
+ modules => "IO::Socket::INET Data::Dumper",
+ commands => "poison"
+);
+
+use vars qw($forked %ids);
+use IO::Socket::INET;
+use Data::Dumper;
+use Irssi;
+use POSIX;
+
+sub show_help() {
+ my $help = $IRSSI{name}." $VERSION
+/poison
+ List current downloads
+/poison search <query>
+ Search for files on the network
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box($IRSSI{name}, $text, "help", 1);
+}
+
+sub giftconnect {
+ my $host = Irssi::settings_get_str('poison_host');
+ my $port = Irssi::settings_get_int('poison_port');
+ my $sock = IO::Socket::INET->new(PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp');
+ return $sock;
+}
+
+sub draw_box ($$$$) { my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ unless ($colour) {
+ $box =~ s/%(.)/$1 eq '%'?$1:''/eg;
+ }
+ return $box;
+}
+
+sub round ($$) {
+ return $_[0] unless Irssi::settings_get_bool('poison_round_filesize');
+ if ($_[1] > 100000) {
+ return sprintf "%.2fMB", $_[0]/1024/1024;
+ } else {
+ return sprintf "%.2fKB", $_[0]/1024;
+ }
+}
+
+sub array2table {
+ my (@array) = @_;
+ my @width;
+ foreach my $line (@array) {
+ for (0..scalar(@$line)-1) {
+ my $l = $line->[$_];
+ $l =~ s/%[^%]//g;
+ $l =~ s/%%/%/g;
+ $width[$_] = length($l) if $width[$_]<length($l);
+ }
+ }
+ my $text;
+ foreach my $line (@array) {
+ for (0..scalar(@$line)-1) {
+ my $l = $line->[$_];
+ $text .= $line->[$_];
+ $l =~ s/%[^%]//g;
+ $l =~ s/%%/%/g;
+ $text .= " "x($width[$_]-length($l)+1) unless ($_ == scalar(@$line)-1);
+ }
+ $text .= "\n";
+ }
+ return $text;
+}
+
+sub bg_do ($$) {
+ my ($id, $sub) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ return if $forked;
+ $forked = 1;
+ my $pid = fork();
+ if ($pid > 0) {
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag); $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ eval {
+ my $result;
+ $result->{$id} = &$sub();
+ my $dumper = Data::Dumper->new([$result]);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ print($wh $data);
+ close($wh);
+ };
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input ($) {
+ my ($rh, $pipetag) = @{$_[0]};
+ my $text;
+ $text .= $_ foreach (<$rh>);
+ close($rh);
+ Irssi::input_remove($$pipetag);
+ $forked = 0;
+ return unless($text);
+ no strict;
+ my $result = eval "$text";
+ return unless ref $result;
+ print_results($result->{search}) if defined $result->{search};
+ print CLIENTCRAP '%R>>%n Added '.$result->{sources}.' source(s) for download' if defined $result->{sources};
+}
+
+sub search_file ($) {
+ my ($query) = @_;
+ my $sock = giftconnect();
+ return unless $sock;
+ $sock->print("SEARCH query(".$query.");\n");
+ my %results;
+ my %item;
+ my $meta = 0;
+ while ($_ = $sock->getline()) {
+ if ((not $meta) && / *(.*?)\((.*?)\)[^;]/) {
+ my ($key, $value) = ($1, $2);
+ $value =~ s/\\(.)/$1/g;
+ $item{$key} = $value;
+ } elsif (/META/) {
+ $meta = 1;
+ } elsif (/ITEM;/) {
+ $sock->close();
+ last;
+ } elsif (/;/) {
+ $meta = 0;
+ my %foo = %item;
+ %item = ();
+ $results{$foo{hash}} = \%foo;
+ }
+ }
+ return \%results;
+}
+
+sub get_file ($) {
+ my ($id) = @_;
+ return unless $ids{$id};
+ my $data = $ids{$id};
+ add_source($data);
+ bg_do('sources', sub { retrieve_sources($data->{hash}) } );
+}
+
+sub retrieve_sources ($) {
+ my ($hash) = @_;
+ my %sources;
+ foreach (@{ find_sources($hash) }) {
+ add_source($_);
+ $sources{$_->{user}} = 1;
+ }
+ return scalar keys %sources;
+}
+
+sub add_source (\%) {
+ my ($data) = @_;
+ my $sock = giftconnect();
+ return unless $sock;
+ my @bar = split('/', $data->{url});
+ my $file = $bar[-1];
+
+ my $line = "ADDSOURCE ";
+ $line .= "user(".$data->{user}.") ";
+ $line .= "hash(".$data->{hash}.") ";
+ $line .= "size(".$data->{size}.") ";
+ $line .= "url(".$data->{url}.") ";
+ $line .= "save(".$file.");";
+ $sock->print($line."\n");
+ $sock->close();
+}
+
+sub find_sources ($) {
+ my ($hash) = @_;
+ my $sock = giftconnect();
+ return unless $sock;
+ $sock->print("LOCATE query(".$hash.");\n");
+ my %item;
+ my @sources;
+ my $meta = 0;
+ while ($_ = $sock->getline()) {
+ if ((not $meta) && (/ *(.*?)\((.*?)\)[^;]/)) {
+ my ($key, $value) = ($1, $2);
+ #print $key." => ".$value;
+ $value =~ s/\\(.)/$1/g;
+ $item{$key} = $value;
+ } elsif (/META/) {
+ $meta = 1;
+ } elsif (/ITEM;/) {
+ $sock->close();
+ last;
+ } elsif (/;/) {
+ $meta = 0;
+ my %foo = %item;
+ %item = ();
+ push @sources, \%foo;
+ }
+ }
+ return \@sources;
+}
+
+sub get_downloads {
+ my %downloads;
+ my $sock = giftconnect();
+ return unless $sock;
+ $sock->print("ATTACH client(".$IRSSI{name}.") version(".$VERSION."); DETACH;");
+ my %downloads;
+ my ($add, $source) = (0,0);
+ my %item;
+ while ($_ = $sock->getline()) {
+ if (/^DOWNLOAD_ADD\((\d+)\)/) {
+ $add = 1;
+ $item{sessionid} = $1;
+ } elsif (/SOURCE/) {
+ $source = 1;
+ } elsif (/};/) {
+ $source = 0;
+ $add = 0;
+ my %foo = %item;
+ $downloads{$foo{file}} = \%foo;
+ } else {
+ if (($add && not $source) && /^ (.*?)\((.*?)\)$/) {
+ my ($key, $value) = ($1, $2);
+ $value =~ s/\\(.)/$1/g;
+ $item{$key} = $value;
+ }
+ }
+ }
+ return \%downloads;
+}
+
+sub print_results ($) {
+ my ($results) = @_;
+ my @array;
+ %ids = ();
+ my $i = 1;
+ foreach (sort {uc($a) cmp uc($b)} keys %$results) {
+ my @bar = split('/', $results->{$_}{url});
+ my $file = $bar[-1];
+ $file =~ s/%20/ /g;
+ $file =~ s/%/%%/g;
+ my @line;
+ push @line, "%9".$i."%9";
+ push @line, "%9".$file."%9";
+ push @line, $results->{$_}{size};
+ push @line, $results->{$_}{availability};
+ push @array, \@line;
+ $ids{$i} = $results->{$_};
+ $i++;
+ }
+ my $text = array2table(@array);
+ print CLIENTCRAP draw_box("Poison", $text, "Results", 1) if $text;
+}
+
+sub print_downloads ($) {
+ my ($downloads) = @_;
+ my $text;
+ foreach (sort {uc($a) cmp uc($b)} keys %$downloads) {
+ if ($downloads->{$_}{state} eq 'Active') {
+ $text .= '%bo%n';
+ } elsif ($downloads->{$_}{state} eq 'Paused') {
+ $text .= '%yo%n';
+ }
+ my $percent = $downloads->{$_}{size} > 0 ? ($downloads->{$_}{transmit} / $downloads->{$_}{size}) * 100 : 0;
+ my $file = $_;
+ $file =~ s/%20/ /g;
+ $file =~ s/%/%%/g;
+ $text .= " %9".$file."%9";
+ $text .= "\n";
+ $text .= ' ';
+ $text .= round($downloads->{$_}{transmit}, $downloads->{$_}{size}).'/';
+ $text .= round($downloads->{$_}{size}, $downloads->{$_}{size});
+ $percent =~ s/(\..).*/$1/g;
+ $text .= " (".$percent."%%)";
+ $text .= "\n"
+ }
+ print CLIENTCRAP draw_box("Poison", $text, "Downloads", 1);
+}
+
+
+
+sub cmd_poison ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @args = split(/ /, $args);
+ if (@args == 0) {
+ print_downloads(get_downloads());
+ } elsif ($args[0] eq 'search') {
+ shift @args;
+ if ($forked) {
+ print CLIENTCRAP '%R>>%n Already searching...';
+ } else {
+ print CLIENTCRAP '%R>>%n Search in progress...';
+ }
+ bg_do 'search', sub { search_file(join(' ', @args)) };
+ #print_results search_file(join(' ', @args));
+ } elsif ($args[0] eq 'get' && $args[1]) {
+ get_file($args[1]);
+ } elsif ($args[0] eq 'help') {
+ show_help();
+ }
+}
+
+Irssi::settings_add_str('poison', 'poison_host', 'localhost');
+Irssi::settings_add_int('poison', 'poison_port', 1213);
+Irssi::settings_add_bool('poison', 'poison_round_filesize', 1);
+
+Irssi::command_bind('poison', \&cmd_poison);
+
+foreach my $cmd ('help', 'search', 'get') {
+ Irssi::command_bind('poison '.$cmd => sub {
+ cmd_poison("$cmd ".$_[0], $_[1], $_[2]); });
+}
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded, /poison help';
+
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-31 10:28:14 +0000