#  SocketDaemon.pl
#  Example: 7.22
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script emulates a fork() function by redirecting socket handles to 
#  STDOUT and creating new process that inherits Win32 handles.

use IO::Socket;
$iProcessCount = 0;
$Port = 8080;
if( ( $iChildNum ) = ( $ARGV[0] =~ /child:(\d+)/i ) )
{
    ProcessAsChild( fileno( STDOUT ) );
    exit();
}
if( $Socket = IO::Socket::INET->new( LocalPort => $Port, Listen => 5 ) )
{
    while( 1 )
    {
        print "\nListening for a connection...\n";
        last unless ( $Connection = $Socket->accept() );
        $iProcessCount++;
        print STDERR "Server: Connection $iProcessCount\n";
        
        MyFork( $Connection );
        $Connection->close();
    }
}

sub ProcessAsChild
{
    my( $SocketHandle ) = @_;
    my $Socket;
    
    if( $Socket = IO::Socket::INET->new_from_fd( $SocketHandle, "+>" ) )
    {
        $Socket->send( "Child process $iChildNum has started at " . localtime() . "\n" );
        while(1)
        {
            $Socket->recv( $In, 100 );
            last if( $In eq "\n" || $In eq "" );
            $Socket->send( "You entered: $In" );
        }
    }
    $Socket->close();
}

sub MyFork
{
    my( $Socket ) = @_;

    use Win32::Process;
    my $Process;
    my $App = 'c:\perl\bin\perl.exe';
    my $Cmd = "perl \"$0\" child:$iProcessCount";
    my $bInherit = 1;
    my $Dir = ".";
    my $Flags = 0;
    my $Child = 0;

    open( OLD_STDOUT, ">&STDOUT" ) || die "Can not backup STDOUT: $!\n";
    open( STDOUT, ">&" . $Socket->fileno() ) 
                || die "Can not redirect STDOUT: $!\n";
    if( ! Win32::Process::Create( $Process,
                                  $App,
                                  $Cmd,
                                  $bInherit,
                                  $Flags,
                                  $Dir ) )
    {
        print STDERR "Server: unable to create process.\n";
    }
    open( STDOUT, ">&OLD_STDOUT" ) 
                     || die "Can not redir STDIN to orig value: $!\n";
    close( OLD_STDOUT );
}

END
{
    if( $iChildNum )
    {
        print STDERR " Child $iChildNum: Terminating.\n";
    }
    else
    {
        print STDERR "Server: Terminating.\n";
    }
}