#!/usr/bin/perl -w

use strict;
use Fcntl ':flock';
use IO::Select;
use IO::Socket;
use IO::Socket::INET;
use File::Copy;
use POSIX;

my $progName  = $0;
   $progName  =~ s/^\.\///g;
my $SEMAPHORE = "./.$progName.$$";
my $spoolFile = "./$progName.spool" || shift;
my $pipeFile  = "./genpipe"  || shift;
my $serverPort= 4509 || shift;
my %childhash;
my $waitedpid;
my $pid;

local $SIG{INT} = sub {
          kill('TERM',(keys(%childhash)));
          unlink $SEMAPHORE;
          exit;
          };

# Fork the pipe reader process.

unless ($pid = fork)
{
    my $buffer;
    my $bytes  = 1;
# open the SEMAPHORE file so flock will work.
    open(SEMAPHORE,">$SEMAPHORE") or die
       "Cannot open semaphore file, $SEMAPHORE: $!\n";

    sysopen(SPOOL,"$spoolFile",O_RDWR|O_CREAT) or die
       "Cannot open spool file, $spoolFile: $!\n";

    sysopen(PIPE,"$pipeFile",O_RDWR|O_NONBLOCK) or die
       "Cannot open pipe file, $pipeFile: $!\n";
        PIPE->autoflush(1);

    while (1)
    {
      flock(SEMAPHORE,LOCK_EX) or die
       "Cant lock SP in reader: $!\n";

      while ( defined(sysread(PIPE,$buffer,8192) ) > 0)
      {
        syswrite(SPOOL,$buffer);
        syswrite(STDOUT,"WRITING TO SPOOL FILE\n");
      }
      flock(SEMAPHORE,LOCK_UN);
      select(undef,undef,undef,.25);
    }
    close(PIPE);
    close(SPOOL);
    exit;
}
$childhash{$pid} = 1;

while (1)
{
    # Fork the listen/accept loop.
    unless($pid = fork)
    {
        my $listenSocket =
            IO::Socket::INET->new(LocalPort => $serverPort,
                                  Listen    => '0',
                                  Proto     => 'tcp',
                                  Reuse     => 1,
                                  timeout   => 60*60,
                              )or die "LSOCKET: $!\n";
        handleAccept(\*$listenSocket);
        exit;
    }
    $childhash{$pid} = 1;
    $waitedpid = wait();
    if (exists $childhash{$waitedpid})
    {
        delete $childhash{$waitedpid}
    }
    else
    {
        syswrite(STDOUT,"1. Why did I see pid $waitedpid?\n");
    }
    
}
$waitedpid = wait();
    if (exists $childhash{$waitedpid})
    {
        delete $childhash{$waitedpid}
    }
    else
    {
        syswrite(STDOUT,"2. Why did I see pid $waitedpid?\n");
    }


sub handleAccept
{
# open the SEMAPHORE file so flock will work.
my $selector = IO::Select->new();
my $buffer;
open(SEMAPHORE,">$SEMAPHORE") or die
    "Cannot open semaphore file, $SEMAPHORE: $!\n";
    my $lsocket  = shift;
    my $incoming = $lsocket->accept();
    $incoming->autoflush(1);
    my $sel = IO::Select->new($incoming);
    close($lsocket);
    while (1)
    {
        ###
        # This if block ends the process if the
        # client has disconnected
        if ($sel->can_read(0))
        {
           my $bytes = sysread($incoming,$buffer,8192);
           if (! $bytes )
           {
           syswrite(STDOUT,"CLIENT DISCONNECTED\n");
           exit;
           }
        }
        #
        ###
        my $bytes = 1;
        flock(SEMAPHORE,LOCK_EX);
        copy($spoolFile,"$spoolFile.tmp");
        truncate($spoolFile,0);
        flock(SEMAPHORE,LOCK_UN);
        sysopen(TMP,"$spoolFile.tmp",O_RDWR|O_NONBLOCK) or die
            "Cannot open temp spool file $spoolFile.tmp: $!\n";

        while ($bytes > 0)
        {
            $bytes = sysread(TMP,$buffer,8192);
            last if ($bytes == 0);
            syswrite($incoming,$buffer);
            syswrite(STDOUT,"WRITING $bytes TO CLIENT FROM $spoolFile.
+tmp\n");
        }
        close(TMP);
        unlink("$spoolFile.tmp");
        select(undef,undef,undef,.25);
    }
}
[download]