🚀 go-pugleaf

In article <3A3F25B5.936991B3@enpl.es>, Dani Pardo wrote:
> Tengo un servidor TCP en perl, que hace de "echo" de lo que le envias.
>  La cosa funciona bien si hay una sola conexi�n, pero si hay 2
> conexiones concurrentes, la segunda se queda esperando a que finalize la
> primera. 
>  En principio esto no es problema por el problema que tengo que
> resolver. El caso es que si la primera conexi�n se queda en CLOSE_WAIT o
> algo asi, los dem�s clientes no pueden hacer nada, y es como si el
> servicio estuviese inactivo.
>   C�mo podria modificar el programa para que sirviese m�ltiples
> conexiones a la vez?
>

haz proceso hijo con fork por ejeplo para cada nueva conexion entrante una cosa 
asi 
#!/usr/bin/perl
#
# recoje datos del puerto #6668 y los saca por la salida estandar
#ideal para los clientes
#
$AF_UNIX = 1;
$AF_INET=2; # Use AF_INET instead of AF_UNIX.
$SOCK_STR = 1; # Use STREAMS.
$PROTOCOL = 0; # stick to the default protocols (IP).

$port = 6668 unless $port;
$| = 1;
#
# The pattern for packing into a sockaddr structure
#
$PACKIT='S n C4 x8';

#
# Disable any buffering on any newly created sockets.
#
select(NEWSOCKET);
$| = 1;
select(stdout);

#
# Create the socket.
#
socket(MY_SOCKET, $AF_INET, $SOCK_STR, $PROTOCOL) ||
die "\n $0: Cannot open socket: $!";
print "Socket successfully opened\n";

#
# Get the host address for this node
#
# usamos localhost
#($name, $aliases, $addrtype, $len, @addrs) = gethostbyname("jpddb2");
#($a,$b,$c,$d) = unpack('C4',$addrs[0]);
#print "Server Name=$name, Server Address= $a.$b.$c.$d\n";
#$my_ip_addr = pack($PACKIT,$AF_INET,$port,$addrs[0]);

#
# If you just want to test with the localhost, try this line
# instead of the above.
$my_ip_addr = pack($PACKIT,$AF_INET,$port,127,0,0,1);

#
# Bind to the socket and listen on this port
#
bind(MY_SOCKET, $my_ip_addr) || die "$0: Cannot bind .. $!\n";
print "\n Bound to socket";
listen(MY_SOCKET,5) || die "$0: Cannot listen: $!\n";
print "\n Listening \n";

while(1) {
   $remote = accept(NEWSOCKET, MY_SOCKET) || die "$0: Unacceptable: $!\n";

   #
   # In case you have to display incoming connection
   # information, you can uncomment the next three lines of code:

   # @remoteInfo = unpack($PACKIT,$remote);
   # $, = ' ';
   # print @remoteInfo; print "\n";

   # $pid = fork || &cleanup;

   if ($pid == fork) { # I'm a child
      #sleep 3;
      #print NEWSOCKET "Welcome to this server\n";
      # in child,.. you can do other stuff here.
      # no queremos saber nada  nos fiamos y removemos la linea
      #@remoteInfo = unpack($PACKIT,$remote);
      # separador para campos $,
      $, = ' ';
       
      # mientras la conexion este abierta
      while  (<NEWSOCKET> ) {
           $entrada = $_;
         # No imprimimos quien nos envia las cosas
         #  print @remoteInfo; 
           print  $entrada;
      }
      #Bueno hemos acabado con nuestro trabajo cerramos las vias para nosotros
      #que somos el hijo y salimos
      close NEWSOCKET;
      close MY_SOCKET;
      exit;
   } else { # parent
      #sleep 10;
      #close MY_SOCKET;
      close NEWSOCKET; # in parent
      print "$pid Doing it again \n";
      #exit;
   }

}
sub cleanup { close NEWSOCKET; close(MY_SOCKET); die "$0: Cannot fork : $!\n"; 
}