#!/usr/bin/perl
# MoleSter tiny P2P file sharing program
# Version 0.0.1
# This file is released to the public domain by its author, Matthew Skala.
# Contact mskala@ansuz.sooke.bc.ca
# Home page for this project is http://ansuz.sooke.bc.ca/software/molester/
# A "minimal" version of this file also exists, which attempts to be the
# same code with some debugging messages removed and shaved down to as few
# bytes as possible; see the home page.
# To set up a MoleSter peer:
# perl molester password 192.168.1.1:2222 10.2.2.2:3333
# replace password with the password for your network, 192.168.1.1:2222 with
# the local address and port to run on, 10.2.2.2:3333 with the remote
# address and port of another MoleSter peer; if the other peer doesn't
# exist, your peer will still go up, but you'll have to wait for others to
# connect to you.
# port numbers must be greater than 2000, as prophylaxis against some kinds
# of security problems. it's recommended that you identify hosts only by
# their numeric IP addresses, although other things will probably work too.
# You can add commands to get files or advertise your presence by adding
# additional command line arguments of the form <cmdchar><arg>/
# Example, to connect to a network, link solidly in with three layers of
# peers, and request a file:
# perl molester password 192.168.1.1:2222 10.2.2.2:3333 \
# h/ h/ h/ i/ gkernel-sources.tar.bz2/
# Note that you probably should not really use this to distribute the kernel
# sources, unless you have a LOT of memory and bandwidth to spare.
# command reference:
# i/ advertises your presence to the peer, which is a nice thing to do if
# you plan to be up for a while
# g<filename>/ requests a filename
# h/ gets all your peers' peer lists and merges those into yours
# f<message> broadcasts the message to the peer's peers, useful for casting
# a wider net if the peer doesn't have the file you want, e.g.:
# fgfilename/
# f may be used multiple times, but it's friendlier to the network to just
# use h/ a bunch of times so that you'll peer with more of the network
# note that the e command ("expect" file) could theoretically be used from
# the command line to push a small text file to your peers, but that will
# probably NOT work correctly and is not recommended
# note that if you want to run a share-only peer that can send but not
# receive files, (might be useful to prevent disk-space DoS attack, or
# illegal-material "hot potato" attacks), you can do it by deleting the
# subroutine named "e" below, and changing [e-i] in the regular expression
# inside the while loop, to [f-i].
# parse command line arguments
# $p = password
# $a = my address, as 31416.127.0.0.1
$p=shift;
$a=shift;
# load the first peer
i(shift);
# open a listening socket
# S = filehandle of listening socket
# 6 = tcp
# would it be safe to eliminate these other calls to long-name constants,
# and maybe the use Socket; ? Or would that harm portability?
use Socket;
socket(S,PF_INET,SOCK_STREAM,6) || die $!;
bind(S,&a($a)) || die $!;
listen(S,5) || die $!;
# loop, accepting connections or commands from the command line
$/=undef;
while (@ARGV&&($_="$p $a f".shift)||accept(C,S)&&($_=<C>)&&close C) {
m!^(.*?) (.*?) ([e-i])([^/]*)/(.*)$!s && $1 eq $p
&& (print("$a: $1 $2 $3$4/ (".join(',',keys %k).")\n")|| 1)
&& &$3($2,$4,$5);
}
# subroutines to actually do stuff
# each takes three parameters - peer's address, filename, data
# E: Expect an incoming file
sub e {
open F,'>',$_[1];
print F $_[2];
close F;
}
# F: Forward this request to your peers
sub f {
&s($_,@_) foreach keys %k;
}
# G: Give me a file
sub g {
open(F,'<',$_[1])&&
&s($_[0],$a,"e$_[1]",<F>);
close F;
}
# H: Help me find peers
sub h {
&s($_[0],$_,'i') foreach keys %k;
}
# I: I am a peer
sub i {
$k{$_[0]}=1;
}
# helper function, A for Address
# returns packed in_addr of argument, which is "port.a.b.c.d"
# sub a {pack('SCCCC',split('.',$_[0]))}
sub a {
$_[0]=~/^(.*):(\d+)$/ && $2>2e3 &&
sockaddr_in($2,inet_aton($1));
}
# helper function, S for Send
# usage destaddr, sourceaddr, req.filename, data
sub s {
socket X,PF_INET,SOCK_STREAM,6;
$w=shift;if (connect X,&a($w)){
print X "$p $_[0] $_[1]/$_[2]";
close X; } else {undef $k{$p}}
}
