my ($new_sock, $pid, $buf);
while ($new_sock = $main_sock->accept()) {
    $new_sock->autoflush(1);       
    # In theory, new sockets are always non-blocking anyway
    # with IO::Socket::INET, which I am using here.
    $pid = fork();
    die "Cannot fork: $!" unless defined $pid;
    if ($pid == 0) {
        # Child 
        unless ($new_sock->peerhost eq $allowed_ip) {
            shutdown $new_sock, 2;
            exit 0;
        }
        print $new_sock $greeting;
        while (defined($buf = <$new_sock>)) {
            process($buf, $new_sock);
#            shutdown($new_sock, 1);
#            Works, but shuts down the whole session
        }     
        exit 0;
    } # Else 'tis the parent process, which goes back to accept()
}
close $main_sock;

my ($error, $output);                  
        
sub process {
    my $line = shift;
    $line =~ tr/\r\n//d;    # fancy chomp
    return if $line eq '';  # What's that again?
    my ($command, @args) = split /\s+/, $line;
    undef $error;
    undef $output;                 
                  
    if ($command =~ /^BYE/) {                 
        print $new_sock "OK disconnecting . . . \n";
        shutdown $new_sock, 2;
        exit 0;
    }
                   
    unless (exists $dispatch{$command}) {
        return unless defined $command; # Ignore blank lines
        print $new_sock "ERROR unknown command \"$command\"\n";
        return;
    }
              
    $dispatch{$command}->(@args);
    if ($error) { # main scope variable set by the dispatch command
        print $new_sock <<EOF;
ERROR $error     
$output                                              
EOF                                    
EOF                                    
        return;
    }        
    else {           
        print $new_sock <<EOF;           
OK
$output
EOF              
    }                                               
}

##</code><code>##

sub execute {
    my $port = 1200;
    
    my $sock = new IO::Socket::INET (
        PeerAddr => $host,
        PeerPort => $port,
        Proto    => 'tcp'
    );
    die "Couldn't connect to $host:$port : $@" unless ($sock);

# Saints preserve me from having to use this    
#    my $flags;
#    fcntl($sock, F_GETFL, $flags) or die "Couldn't get flags for socket: $!";
#    $flags |= O_NONBLOCK;
#    fcntl($sock, F_SETFL, $flags) or die "Couldn't set flags for socket: $!";
    
    my_header('Processing Command', 'wheat');
    
    printf "<b>Site %s is on %s</b><br>", param('site'), $host;
          
    my @args;
    foreach my $i ( @{ $action{$selection}{args} } ) {
        push @args, param($i);
    }
    
    my @command = join(' ', ($action{$selection}{command}, @args));

    my ($line, @output);
    
    print "Waiting for ready signal . . . <BR><PRE>";
    until ($line =~ /^READY/) {
        $line = <$sock>;  
        print $line, "\n";
    }
    print "</PRE>";
    # This part prints out fine!  But after, the web client hangs.    
    print $sock (@command, "\n");
    
    while ( $line = <$sock> ) {
        push @output, $line;
    }
    print $sock "BYE\n";
    close $sock or die "Can't close socket: $!";
    print h2("No response from server $host!<BR>") unless @output;
    print h2('Server responded:'),
          pre(@output);
    footer();
    # This all prints if I kill the server
}