bitjoe - Contrib - PerlGnutella - SOURCE CODE

#!/usr/bin/perl

use IO::Socket;
use IO::Select;
use Getopt::Std;
use POSIX ":sys_wait_h";

our $pipe = 0;

$SIG{INT} = sub { print join(" - ",caller()),"\n"; exit; };
$SIG{PIPE} = sub { $pipe++ };

my %opts;
getopts('d:D:h:s:S:PW:p',\%opts);
$opts{W} ||= '.';
#my $target = shift @ARGV;
our(@targets,@exclude,@searches,%cache);
my $i = 0;
while($ARGV[$i]) {
    if($ARGV[$i] =~ s/^\!//) {
	push @exclude, qr/$ARGV[$i]/i;
    } elsif($ARGV[$i] =~ /\D/) {
	push @searches, lc($ARGV[$i]);
	if($ARGV[$i] =~ s/mpg/mpeg/i) {
	    push @searches, lc($ARGV[$i]);
	}
    } else {
	push @targets, $ARGV[$i];
    }
    $i++;
}

my %qr;
for(@searches) {
  my @tmp = split /\s+/, $_;
  $qr{$_} = sub { my $i = 0; for(@tmp) { return 0 if index($_[0],$_) == -1 } 1 };
}

print join(',',@targets),"\n";
print join(',',@searches),"\n";

our %targets = map { ($_,1) } @targets;
#open(OUT, ">>/home/ant/eg/tmp/$target");
our(%searches);

our $sock = conn();
$pipe = 1 unless $sock;
our $sel;

sub conn {

... [truncated, 219 more lines] ...

#!/usr/bin/perl

$SIG{ALRM} = sub { die };

do 'client2';

use URI::Escape;
use IO::Select;
use IO::Handle;

our %skip;
our %files;
#our 
sub download {
  my %info = ( size => shift, file => shift );
  my $list = shift;
  my $write_file = 0;
  if(-s "dlinfo/$info{size}" && open(my $i, "dlinfo/$info{size}")) {
    local $/;
    %info = split "\n", <$i>;
#    print "Using old name $info{file}\n";
  } else {
      $write_file = 1;
  }
  $info{search} = \@searches;
  return if $info{complete};
  my $start = -s $info{file};
  return if $start >= $info{size};
  if(my $pid = fork()) {
    return $pid;
  }

  for(keys %$list) { #serverlist
    my($serv,$id) = split("\t", $_);
    my $name = $list->{$_};
    next if $skip{$serv};
    $start = (-s $info{file} || 0);
    my $sock;
    print '.';
#    print "> $info{size} $serv\n";
    eval {
      alarm(3);
      $sock = new IO::Socket::INET
	PeerAddr => $serv,
	  Proto    => "tcp";
      alarm(0);
    };
#    print ".";
    if ($@) {
#      print STDERR "Sock timed out\n";

... [truncated, 165 more lines] ...

#!/usr/bin/perl

$|++;
$SIG{PIPE} = sub { my @c = caller(); die "PIPE @c\n"; };
$SIG{SEGV} = sub { my @c = caller(); print "\nSEGV @c\n"; };
$SIG{INT}  = sub { my @c = caller(); die "INT @c\n"; };
$SIG{ALRM} = sub { die };
BEGIN {
#
  our $mainpid = $$;
#  our $uipid = fork();
}


#if ($$ == $mainpid) {
  my $man = manager->new();
#} else {
# $uipid = $$;
#}

package manager;
use IO::Socket::INET;
use IO::Select;
use constant CHR => {0,'+',1,'-',2,'"',64,'=',128,'@',129,'%'};
use POSIX;
use Benchmark;
use Getopt::Std;

sub new {
  my $self = bless {}, shift;
  $self->{hpos} = 0;
  $self->{opts} = {};
  getopts('f:p:',$self->{opts});
  $self->{opts}{p} ||= 5993;
  $self->{opts}{f} ||= "/root/zoozle/gnutella/cachelist.txt";	# http://www.alpha64.info/Cache/cachelist.txt
  my $listen = IO::Socket::INET->new(Listen    => 10,
				     LocalPort => $self->{opts}{p},
				     Proto     => 'tcp',
				     Reuse => 1,
				    );

  unless($listen) {
    print "Failed to bind port:\n\t$@\n";
    exit 1;
  }
#  $SIG{INT} = sub { print "Closing $listen\n"; $listen->close(); exit(0); };
  $self->load_hosts();
  $self->{sel} = IO::Select->new($listen);
  $self->{disp}{$listen}{sub} = $self->gen_cb('accept');#sub { $self->accept(@_) };
  $self->{listen} = $listen;

... [truncated, 460 more lines] ...