#!/opt/bin/perl


package main; # For Perl 6 forward-compatability


#   The following constants are used to define server timeout and sock
+et 
#   timeout behaviour.

sub TIMEOUT_PEER    ()  { 60 }
sub TIMEOUT_SERVER  ()  { 300 }


use IO::Socket;
use POSIX qw( WNOHANG );
use SOAP::Transport::IO;
use Socket qw( :crlf );

use vars qw( $VERSION );


$VERSION = sprintf( "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/ );


#   Define signal handlers for timeout and child events

$SIG{'ALRM'} = sub { exit 0 };
$SIG{'CHLD'} = sub { while ( waitpid( -1, WNOHANG ) > 0) {} };


#   Create IO socket from STDIN file descriptor on which the network 
#   communication socket is duplicated for the server process by the i
+netd 
#   daemon.

my $socket = IO::Socket->new_from_fd( STDIN, 'r+' );
unless ( defined $socket ) {

    croak( 'Cannot create socket from STDIN -- ', $! );
}
while ( my $connection = $socket->accept ) {

    my $child = undef;
    unless ( defined ( $child = fork() ) ) {
    
        croak( 'Cannot fork process to handle new connection -- ', $! 
+);
    }
    if ( $child == 0 ) {

        #   Clear the alarm timeout, close the parent socket and initi
+ate 
        #   communication with POP3 client.

        alarm(0);
        $socket->close;

        STDIN->fdopen( $connection, 'r' ) or
            croak( 'Cannot re-open STDIN for input -- ', $! );
        STDOUT->fdopen( $connection, 'w' ) or
            croak( 'Cannot re-open STDOUT for output -- ', $! );
        STDERR->fdopen( $connection, 'w' ) or
            croak( 'Cannot re-open STDERR for output -- ', $! );
        STDOUT->autoflush(1);


        SOAP::Transport::IO::Server
                ->new
                ->dispatch_to('/path/to/modules', 'Local::Module')
                ->handle;
    }
}
continue {

    $connection->close;
    alarm( TIMEOUT_SERVER );
    exit 0;
}


1;


__END__
[download]