client.pl 
#!/usr/bin/perl -w
use strict;
use vars qw(@files @paths @sizes);
use IO::Socket;
use File::Find;

$SIG{CHLD} = 'IGNORE';
die "Can't fork: $!" unless defined (my $s_child = fork());

if ($s_child == 0)
{
    my $sock = IO::Socket::INET->new
                                 (
                                  Listen    => SOMAXCONN,
                             LocalPort => 9004,
                            Reuse     => 1,
                              Proto     => 'tcp'
                           ) or die $!;

    while (my $connection = $sock->accept)
    {
        die "Can't fork: $!" unless defined (my $s_pid = fork());
        if ($s_pid == 0)
        {
            sysread ($connection, my $filename, 1024);
            open (FILE, $filename) or die $!;
            if ($filename)
            {
                my @stats = stat($filename);
                undef $/;
                binmode(FILE);
                syswrite ($connection, <FILE>, $stats[7]); 
                close (FILE);
                $/ = "\n";
                exit;
            }
        }
        else
        {
            $connection->close();
        }
    }
    $sock->close;
    exit 0;
}
else
{
    my $sock = IO::Socket::INET->new
                                 (
                                       Proto     => 'tcp',
                                   PeerAddr  => "plokta.ath.cx",
                                   PeerPort  => "9001",
                                 ) or die $!;

    $sock->autoflush(1);
    find (\&wanted, "/shared");
    
# I was hesitant about using Storeable (which is not part of
# the standard distribution in the client, so I hacked up a
# way to simulate it.

    my @lists;
    $lists[0] = join "*---*", @files;
    $lists[1] = join "*---*", @paths;
    $lists[2] = join "*---*", @sizes;
    my $totallist = join "^***^", @lists;

    syswrite ($sock, length($totallist), 10);
    sysread ($sock, my $confirm, 1);
    syswrite($sock, $totallist."\n", length($totallist)) if $confirm;
    sysread ($sock, $confirm, 1);

    my @commands = ("search", "dl", "exit");

    while(sysread($sock, my $next_prompt, 1024))
    {
        chomp $next_prompt;
        print $next_prompt;
        my $request_command = "";
        while ($request_command eq "")
        {
            $request_command = <>;
            chomp $request_command;

            my $temp = 1;
            foreach my $command (@commands)
            {
                $temp = 0 if ($command eq $request_command); 
            }

            $request_command = "" if $temp;
            print "\nInvalid Command.\nEnter what you would like to do
+: " if $temp;
        }

        if ($request_command =~ m/^search$/i)
        {
            send_Search(\$sock, $request_command);
        }

        elsif ($request_command =~ m/^dl$/i)
        {
            send_Download(\$sock, $request_command);
        }

        elsif ($request_command =~ m/^exit$/i)
        {
            print "exiting...\n";
            my $message = "exit";
            syswrite($sock, $message, length($message)) or die $!;
            kill 9, $s_child if $s_child;
            exit;
        }
    }
    $sock->close;
}

sub wanted
{
        my $filename = $_;
        my $fullpath = $File::Find::name;
        return if ($_ =~ /^\./);

        stat $File::Find::name;

        return if -d _;

        return unless (-w _);
        $files[@files] = $filename;
    $paths[@paths] = $fullpath;
    my @stats      = stat $fullpath;
    $sizes[@sizes] = $stats[7];
}

sub send_Search
{
    my ($sock_ref, $command) = @_;
    my $sock = $$sock_ref;

    my $prompt = wr (\$sock, $command);
    print $prompt;

    my $results = wr (\$sock, &get_Input);
    $results =~ s/\*---\*/\n/g;
    print $results, "\n";
}

sub send_Download
{
    my ($sock_ref, $command) = @_;
    my $sock = $$sock_ref;

    my $prompt = wr (\$sock, $command);
    print $prompt;
    
    my $results = wr (\$sock, &get_Input);
    my @args = split (/\*---\*/, $results);
    if (scalar(@args) == 4)
    {
          die "Can't fork: $!" unless defined (my $pid = fork());
            if ($pid == 0)
            {
            print @args;
            my $new_sock = IO::Socket::INET->new
                                              (
                                                Proto     => 'tcp',
                                                PeerAddr  => "$args[0]
+",
                                                PeerPort  => "9004",
                                              ) or die $!;
            
            chomp $args[3];
            my $song = wr (\$new_sock, $args[2], $args[3]);
            open (FILE, ">/shared/new/$args[1]") or die $!;
            binmode(FILE);
            syswrite (FILE, $song, $args[3]) or die $!;
            close(FILE);
            print "$args[1] finished.\n";

            undef $song;
            $new_sock->close;
            exit;
        }    
    }
}

sub get_Input
{
    my $input = "";
    while ($input eq "")
    {
        $input = <>;
            chomp $input;
            $input = "" unless $input =~ /.*/;
    }
    return $input;
}

sub wr
{
    my $sock_ref    = shift;
    my $message = shift;
    my $length  = shift || 1024;
    my $sock = $$sock_ref;

    syswrite($sock, $message, length($message)) or die $!;
    sysread ($sock, my $input, $length);
    chomp $input;
    return $input;
}

[download]

server.pl 
#!/usr/bin/perl -w
use strict;
use IO::Socket;
use IPC::Shareable (':lock');
$SIG{CHLD} = 'IGNORE';

my $sock = IO::Socket::INET->new
                 (
                  Listen    => SOMAXCONN,
                              LocalPort => 9001,
                              Reuse     => 1,
                              Proto     => 'tcp'
                 ) or die $!;

my %blank;
tie my %file_list, 'IPC::Shareable', 'flist', {create => 1, mode => 06
+44, delete =>1};
tie my %path_list, 'IPC::Shareable', 'fpath', {create => 1, mode => 06
+44, delete =>1};
tie my %size_list, 'IPC::Shareable', 'fsize', {create => 1, mode => 06
+44, delete =>1};
tie my %address_list, 'IPC::Shareable', 'faddy', {create => 1, mode =>
+ 0644, delete =>1};
%file_list = %path_list = %size_list = %address_list = %blank;

tie my @con_list, 'IPC::Shareable', 'fcon', {create => 1, mode => 0644
+, delete =>1};

tie my @all_files, 'IPC::Shareable', 'afile', {create => 1, mode => 06
+44, delete => 1};
tie my @all_paths, 'IPC::Shareable', 'apath', {create => 1, mode => 06
+44, delete => 1};
tie my @all_sizes, 'IPC::Shareable', 'asize', {create => 1, mode => 06
+44, delete => 1};
tie my @all_addresses, 'IPC::Shareable', 'aaddy', {create => 1, mode =
+> 0644, delete => 1};
@con_list = @all_files = @all_paths = @all_sizes = @all_addresses = ()
+;

while (my $connection = $sock->accept)
{
    my $address = $connection->peerhost;
    die "Can't fork: $!" unless defined (my $child = fork());
    if ($child == 0)
    {       
        $connection->autoflush(1);    
        
        sysread($connection, my $size_of_list, 10);
        syswrite($connection, "1", 1);
                sysread ($connection, my $totallist, $size_of_list);
        syswrite($connection, "1", 1);
        
        my ($filelist, $pathlist, $sizelist) = split /\^\*\*\*\^/, $to
+tallist;
                my @files = split /\*---\*/, $filelist;
        print "filelist recieved   ";
    
                my @paths = split /\*---\*/, $pathlist;
        print "pathlist recieved   ";
    
                my @sizes = split /\*---\*/, $sizelist;
        print "sizelist recieved   ";

                 $con_list[@con_list] = $address;
        print "File info recieved for host ", $connection->peerhost, "
+\n";
        my @address = ($address) x scalar(@files);
    
        $file_list{$address} = [@files];
        $path_list{$address} = [@paths];
        $size_list{$address} = [@sizes];
        $address_list{$address} = [@address];
    
        @all_files = @all_paths = @all_sizes = @all_addresses = ();
        foreach my $con (@con_list)
        {
            push @all_files, @{$file_list{$con}};
            push @all_paths, @{$path_list{$con}};
            push @all_sizes, @{$size_list{$con}};
            push @all_addresses, @{$address_list{$con}};
        }
        
        print $connection "Thank you for accessing perlster!\nEnter wh
+at you would like to do: \n";

        while (sysread($connection, $_, 1024))
        {
            chomp;
            if (m/^search$/i)
            {
                process_Search (\$connection, \@all_paths);
            }
            elsif (m/^dl$/i)
            {
                process_Download (\$connection, \@all_addresses, \@all
+_files, \@all_paths, \@all_sizes);
            }

            elsif (m/^exit$/i)
            {
                exit 0;
            }

            print $connection "Enter what you would like to do: \n";
        }
         exit 0;
    } 
    else
    {
                warn "Connecton recieved ... ", $address,"\n";      
        $connection->close();

        delete $file_list{$address};
        delete $path_list{$address};
        delete $size_list{$address};
        delete $address_list{$address};
        
                @all_files = @all_paths = @all_sizes = @all_addresses 
+= ();
                foreach my $con (@con_list) 
                {
                        push @all_files, @{$file_list{$con}} if define
+d (@{$file_list{$con}});
                        push @all_paths, @{$path_list{$con}} if define
+d (@{$path_list{$con}});
                        push @all_sizes, @{$size_list{$con}} if define
+d (@{$size_list{$con}});
                        push @all_addresses, @{$address_list{$con}} if
+ defined (@{$address_list{$con}});
                }
    }
}
$sock->close;
sub process_Search
{
    my ($connection_ref, $data_ref) = @_;
    my $connection = $$connection_ref;
    my @data = @$data_ref;
    $connection->autoflush(1);
    my $query = prc (\$connection, "Enter what you would like to searc
+h for: \n");

    my @hits; my @indexes;
    for (my $i=0; $i<@data; $i++)
    {
        chomp $data[$i];
        my $temp = 0;
        $temp = 1 if ($data[$i] =~ m/${query}/i);
        if($temp)
        {        
            $indexes[@hits] = $i;
            $hits[@hits] = $data[$i];
        }
    }

    my $results;
    for (my $i=0; $i<@hits; $i++)
    {
        # my @entry = split (/\*---\*/, $hits[$i]);
        $results .= "$indexes[$i] | $hits[$i]*---*";
    }

    $results .= "Number of hits: ".(scalar(@hits))."\n";    
    print $connection $results;
    print "Search for $query by client ", $connection->peerhost, " don
+e.\n";
}

sub process_Download
{
    my ($connection_ref, $address_ref, $file_ref, $path_ref, $size_ref
+) = @_;
    my $connection = $$connection_ref;
    my @files = @$file_ref;
    my @paths = @$path_ref;
    my @sizes = @$size_ref;
    my @addresses = @$address_ref;

    $connection->autoflush(1);
    my $index = prc (\$connection, "Enter line number that you wish to
+ download, -1 to esc: \n");
    
    if (defined($files[$index]) && $index > -1)
    {
        print $connection "$addresses[$index]*---*$files[$index]*---*$
+paths[$index]*---*$sizes[$index]\n";
        print "File info request for index $index by client ", $connec
+tion->peerhost, " done.\n";
    }
    else
    {
        print "File info request by client ", $connection->peerhost, "
+aborted.\n";
    }
}

sub prc
{
    my ($connection_ref, $message) = @_;
    my $connection = $$connection_ref;
    print $connection $message;
    sysread ($connection, my $input, 1024);
    chomp $input;
    return $input;
}

[download]

In reply to Peer to Peer Filesharing by jryan

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.