Adding upstream version 20231031.upstream/20231031upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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';
+