multiple tor runner

torium.pl

use strict; use warnings;
use File::Temp qw'tempfile tempdir'; use File::Spec::Functions 'catfile';
use Symbol 'geniosym'; use Socket; use Net::EmptyPort 'empty_port'; use Getopt::Std;

my %in = (qw'h 127.0.0.1 p 5498 n 4'); getopts('p:n:', \%in);

print "torium[$$] listens $in{p}\n";

my @children;

# tor kids
for (1..$in{n}) {
    my $port = empty_port();
    if ((my $pid = fork) > 0) { push @children, [$pid, $port] }
    elsif (defined$pid) {
        my ($fh, $filename) = tempfile( uc dir => my $dir = tempdir( uc cleanup => 1 ) );
        printf $fh "socksport \%s:%d\ndatadirectory %s\n", $in{h}, $port, $dir;
        close $fh;
        if((my $pid = fork) > 0) {
            print "tor[$pid][$dir] listens $port\n";
            $SIG{INT} = $SIG{TERM} = sub { kill TERM => $pid; 1 while wait != -1 };
            $SIG{HUP} = sub { kill HUP => $pid };
            1 while wait != -1;
            exit }
        elsif (defined$pid) {
            open($_->[1], '>>', catfile($dir, $_->[0])) for [log => *STDOUT], [err => *STDERR];
            exec qw'tor -f', $filename }
        else { die $! } }
    else { die $! } }

# service port
if ((my $pid = fork) > 0) { push @children, [$pid] }
elsif (defined$pid) {
    $SIG{HUP} = uc'ignore';
    socket(my $s = geniosym, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
    setsockopt($s, SOL_SOCKET, SO_REUSEADDR, 1);
    bind($s, sockaddr_in($in{p}, inet_aton($in{h}))) || die $!;
    listen($s, SOMAXCONN) || die $!;
    for (my ($c, $pa) = (geniosym); $pa = accept $c, $s; close $c) {
        printf $c "%s\015\012", join ' ', map $_->[1], @children } } # send available ports
else { die $! }

# wait kids
$SIG{INT} = $SIG{TERM} = sub { kill TERM => map $_->[0], @children; 1 while wait != -1 };
$SIG{HUP} = sub { kill HUP => map $_->[0], @children }; # send to establish new tor circuits
1 while wait != -1;

print "done\n";