Acting like (x)inetd

[mantager]

Hi monks,
I'm trying to act like the (x)inetd daemon and launch an external program after I got a connection from a client and fork()ed. This is my code:

#!/usr/bin/env perl

use strict;
use warnings;
use Socket qw(TCP_NODELAY);
use IO::Socket;
use IO::Socket::INET;
use IPC::Open2;

$|++;

my @cmd = ('ls', '-l');

my $sock = IO::Socket::INET::->new(
    Listen    => 20,
    LocalAddr => '0.0.0.0',
    LocalPort => 10101,
    Proto     => 'tcp',
    Reuse     => 1,
);

die "Unable to create socket: $!" unless $sock;

$sock->sockopt(TCP_NODELAY, 1);

$SIG{CHLD} = 'IGNORE';

while (1) {        # Go on forever!
    my $connection = $sock->accept();    # Blocking
    my $child = fork();
    unless (defined($child)) {
        $connection->close();        # Not enough resources to fork();
        next;
    }
    if ($child) {
        # I'm the parent
        next;
    } else {
        # I'm the child, I serve this connection
        print "Connection accepted\n";
        print "Starting command...\n";

        my $cmd_pid = open2('<&'.fileno($connection), '>&'.fileno($con
+nection), @cmd);
        unless ($cmd_pid) {
            $connection->close();
            die "command failed!";
        }
        waitpid($cmd_pid, 0);

        print "Closing connection.\n";
        $connection->close();
        exit 0;
    }
}

a simple
telnet localhost 10101
gets the output from ls -l, but on the script's STDOUT i read:

open2: close(4) failed: Bad file descriptor at ./daemon_simple.pl line
+ 43

and when I try with a command that needs to get input from the client, it seems that the input never arrives.

Does someone known if it's possible to get it working?

Thanks.

[mantager]

Ok, I'll answer myself on this, just in case someone comes here later searching for an answer.

The easiest way I found to do this is way easier than I thought: just connect STDIN, STDOUT and STDERR to the socket of the accepted connection and then leave the control to the child process. Here is an example implementation that just uses cat to verify the script is working:

#!/usr/bin/env perl

use strict;
use warnings;
use Socket qw/TCP_NODELAY/;
use IO::Socket::INET;

my @cmd = (qw(/bin/cat));

my $sock = IO::Socket::INET::->new(
   Listen    => 20,
   LocalAddr => '0.0.0.0',
   LocalPort => 20202,
   Proto     => 'tcp',
   Reuse     => 1,
);

die "Unable to create socket: $!" unless $sock;

$sock->sockopt(TCP_NODELAY, 1);

$SIG{CHLD} = 'IGNORE';

while (1) {      # Go on forever!
   my $client = $sock->accept();   # Blocking
   my $child = fork();
   next unless defined $child;     # Not enough resources to fork() - 
+ignore silently
   if ($child) {
      # I'm the parent
      close($client);
      next;
   } else {
      # I'm the child, I serve this connection
      close($sock);
      open (STDIN, "<&".fileno($client)) 
         or die "Cannot dup STDIN to connection: $!";
      open (STDOUT,">&".fileno($client)) 
         or die "Cannot dup STDOUT to connection: $!";
      open (STDERR,">&".fileno($client)) 
         or die "Cannot dup STDERR to connection: $!";
      # Now leave the rest to CHILD process
      exec(@cmd);
   }
}

A simple telnet localhost 20202 will echo back any string you write on it.

Cheers.