Category: Networking
Author/Contact Info Joseph Ryan - ryan.311@osu.edu
Description:

This is a command-line prototype for a peer to peer file sharing utility I have been working on. I started writing it after a certain university that attend decided to block out all file sharing utilities. As you may have guessed, this sent most of the resident students into a panic; most people my age spend most of their with 4 activities: class, sleep, partying, and downloading mp3s. So, in order to help out my fellow classmates, I've set to work on writing that they couldn't block.

It works pretty solidly so far, with the exception that the server section uses IPC::Shareable. Using that bastard of a module was only a quick hack, however; I am planning on writing a module using Storeable to act as sort of a "variable server" that would pipe variables to and from child processes without the ickiness associated with IPC::Shareable.

At any rate, heres how the server works: After starting up, the server waits for a connection from a client. When the client is started up, it finds all files stored in the /shared directory, and then submits this list to the server. The server then stores the file data in a shared hash; The hash gets broken down into several arrays that can be searched. Every file has a specific line number associated with it, which is how the user downloads the file.

Since this is only a prototype (not even beta yet), I would welcome any suggestions, or note of any bugs/security holes that I haven't taken care. So fire away - let 'er rip - tear me apart in any way you can. Who knows, if I can fix this up enough, it might actually be useful :)

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;
}

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;
}
Replies are listed 'Best First'.
Re: Peer to Peer Filesharing
by dws (Chancellor) on Nov 02, 2001 at 06:52 UTC
    You'll need to add code to properly reap child processes. reaper subroutines will get you started. Or do a Super Search for "CHLD".

    If you're serious about client server applications (or even if you're just curious), I highly recommend Lincoln Stein's book Network Programming with Perl. He provides a framework that does all of the right things.

    And if you're seriously concerned about what the University network admins might do if they catch you, identifying your server by printing "Thank you for accessing perlster" might not be your best move. It's rather like painting a bullseye on your box. University network admins can be particularly vengeful.

      Well, I have  SIG{CHLD} = 'IGNORE', but I guess that isn't really sufficient. Thanks for the tip.

      I've looked at that book, and want to buy it; however, I am a bit short on funds right now (hey, i'm a poor college kid, go figure). I'll ask for it for christmas; maybe Santa will bring it ;)

      Well, they aren't too concerned with bandwidth; My roommate regularly downloads whole movies from IRC. The server itself barely handles any of the load; its peer to peer. Hopefully, the sysadmins won't give me too much trouble...

      Thanks for the comments tho, I appreciate it :)

        My own experience of university admins is that, while they don't quite reach BOFH-level, they can be very, very nasty if they feel you're trying to outsmart them.

        Think of the ease with which urgent documents can disappear from print queues and 'mysterious' login problems can occur...

        Kevin O'Rourke