#!/usr/bin/perl

# MoleSter tiny P2P file sharing program

# Version 0.0.3
# 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/

# MoleSter should rhyme with "pollster"

# Thanks to Rob Kinyon and John Bokma for bug fixes/golfing tips

# 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.

# The port-number protection has been removed, so be cautious!  Nobody can
# make your peer connect out to random addresses without knowing your
# password, but even so, I don't really recommend running this on the
# public Internet.  Note that I considered it worthwhile to fix the
# huge-input security problem while trading off this one, because the
# huge-input attack could be mounted by an attacker who didn't have the
# password.

# New in this version is huge-input protection.  Connect to a peer and send
# more than 1e6 bytes and it'll just disconnect.  Files are limited to
# just under a megabyte as a result.  If you want to change that, you could
# replace the string '1e6' with '1e7' (just under 10 megabytes), '1e8' (just
# under 100 megabytes) or whatever, to taste.

# New in this version: stacking commands on the command line actually works.
# Sorry it didn't before.

# Addresses must be specified as dotted quad decimal, as shown above.

# 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 net, discover nearby peers, and request a file:
# perl molester password 192.168.1.1:2222 10.2.2.2:3333 \
#    h/ h/ h/ fgkernel-sources.tar.bz2/

# The files will magically appear in your directory as they're downloaded.
# Command-line parameters are processed in a 9-second cycle, so in the
# above example, you need to wait for 36 seconds (during which, hopefully,
# the peer discovery will have done its magic) before the file request is
# sent.

# if you want to share files too, include i/ on the command line

# 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 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].

# read entire files; $_ is undef at this point, so it's cheaper than undef$/
$/=$_;

# parse command line arguments
# $, = password, using $, so we can say $,eq without needing a space
# $a = my address, as 127.0.0.1:31416
$,=shift;
$w=$a=shift; # $w gets address too because &a looks in $w

# load the first peer
$k{+shift}=1;

# open a listening socket
# S = filehandle of listening socket
# 2 = PF_INET
# 1 = SOCK_STREAM
# 6 = tcp
# I'm pretty sure those numbers are universal, but if not, this may be
# Linux-specific
# The die $! isn't in the minimal version, but is useful for debugging
socket(S,2,1,6) || die $!;
bind(S,&a) || die $!;

# loop for commands; some stuff is moved into the header to save
# semicolons.
for(listen(S,5) || die $!;$SIG{ALRM}=sub{};
# now imagine these lines actually AFTER the syntactic body of the loop...
   # now command is in $_, parse it
   m!^(.*?) (.*?) ([e-i])([^/]*)/!s

   # check for correct password
   && $, eq $1

   # delete next line to remove debugging output - not included in minimal
   && (print("$a: $1 $2 $3$4/ (".join(',',keys %k).")\n")|| 1)

   # call handler subroutine - it takes its arguments from $2, $4, and $'
   && &$3
){
   # we will wait up to nine seconds for a remote input
   alarm 9;

   # and then if accept() returns a socket instead of timing out...
   (accept(C,S),alarm 0)?

      # ...then read up to 1000000 bytes from the socket
      read C,$_,1e6

      # otherwise get from the command line
      $_="$, $a f".shift);                   # здесь в начале символы  : ( слитно

   # close socket - harmlessly fails if there was none
   close C
}

# subroutines to actually do stuff
# the parameters for these are passed in the following special vars:
# $2 - peer's address
# $4 - filename
# $' - file data

# E: Expect an incoming file
sub e {
   # using three-arg open costs a byte, but good for security
   open F,'>',$4;
   print F $';
   close F
}

# F: Forward this request to your peers
sub f {
   # note we don't pass "data" ($') so can't do recursive e/ anymore
   t($_,$2,$4)for keys%k
}

# G: Give me a file
sub g {
   # see above about 3-arg open
   open(F,'<',$4)
   &&t($2,$a,"e$4",<F>);
   close F
}

# H: Help me find peers
sub h {
   # bare word id is cheaper than 'i' and the d is ignored by recipients
   t($2,$_,id)for keys%k
}

# I: I am a peer
sub i {
   $k{$2}=1
}

# helper function, A for Address
# does what sock_addr($port,inet_aton($addr)) does.  may be Linux-specific,
# but at least should not be Intel-specific.
# takes its parameter in $w
sub a {
   $w=~/:/;
   pack'CxnC4x8',2,$',split'\.',$`
}

# helper function, T for send a Telegram
# y'see, S for Send would clash with s() for substitution - thanks
# Rob Kinyon for the clue on this
# usage destaddr, sourceaddr, req.filename, data
sub t {
   socket X,2,1,6;
   $w=shift;
   # ?: is cheaper than if..else, and $k only needs to be defined or not
   # note that $/=undef but is cheaper
   $k{$w}=(connect X,&a)?print X"$, $_[0] $_[1]/".pop:$/;
   close X
}