TCP Server using fork to accept multiple requests

Lucas Rey has asked for the wisdom of the Perl Monks concerning the following question:

Dear community, I'm trying to create a little server who handles multiple clients connections (at least 10). Below the current code that works perfect using fork. At least it accepts several connections from clients.

With the below code, I have the following behaviour:
- Client ask for connection ==> Accepted ==> OK
- Client sent packet ==> Received and printed ==> OK
- Client sent another packet ==> Not received ==> NOK

Most probably, the while cicle will be activated only for each connection request, so that's the reason because I cannot retrieve other packets.

Could someone help me please to adjust the below code? What I need is establish one (or more) client connection, then client send data continuosly (without disconnection) and server should reply on each packet it receives.

Thank you
Lucas

#!/usr/bin/perl -w
use IO::Socket::INET;

$SIG{CHLD} = sub {wait ()};
my $socket = new IO::Socket::INET (
    LocalHost => '0.0.0.0',
    LocalPort => '5000',
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1);
die "cannot create socket $!n" unless $socket;

while ($new_sock = $socket->accept()) {
   $pid = fork();
   die "Cannot fork: $!" unless defined($pid);

   if ($pid == 0) {     # This is the fork child
      $new_sock->recv(my $data, 500);
      print "$data\n";
   }
}
[download]

Comment on TCP Server using fork to accept multiple requests Download Code

Replies are listed 'Best First'.
Re: TCP Server using fork to accept multiple requests by Corion (Patriarch) on Aug 17, 2022 at 07:59 UTC
You likely want to add an inner loop to keep on reading: `... if ($pid == 0) { # This is the fork child while( $new_sock->connected ) { $new_sock->recv(my $data, 500); print "$data\n"; } }` [download]	[reply] [d/l]
Re^2: TCP Server using fork to accept multiple requests by Lucas Rey (Sexton) on Aug 17, 2022 at 09:41 UTC
Thank you Corion, this is working perfect!!	[reply]
Re: TCP Server using fork to accept multiple requests by tybalt89 (Monsignor) on Aug 17, 2022 at 09:22 UTC
My preferred way of doing this (although I'd rather use an async package). #!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11146183 use warnings; use IO::Socket::INET; $SIG{CHLD} = 'IGNORE'; # NOTE my $socket = new IO::Socket::INET ( LocalHost => '0.0.0.0', LocalPort => '5000', Proto => 'tcp', Listen => 5, Reuse => 1); die "cannot create socket $!n" unless $socket; while( 1 ) # NOTE because you don't want Interrupted system call to ex +it the server { if( my $new_sock = $socket->accept() ) { if( my $pid = fork() ) { # parent, nothing to do } elsif( defined $pid ) { print while <$new_sock>; # child exit; } else { die "Cannot fork: $!"; } } elsif( $! =~ /Interrupted system call/i ) { # just ignore } else { die "$! on accept call"; # some serious error } } [download]	[reply] [d/l]
Re^2: TCP Server using fork to accept multiple requests by NERDVANA (Deacon) on Aug 20, 2022 at 14:40 UTC
`# parent, nothing to do` ~~Um, except close the socket which is fairly important.~~ Nevermind, This is perl, not C, I'm a moron.	[reply] [d/l]
Re^3: TCP Server using fork to accept multiple requests by tybalt89 (Monsignor) on Aug 20, 2022 at 16:29 UTC
The socket is closed when $new_sock goes out of its scope, which is the "if" statement, so the socket IS closed when the outer "while" repeats. All the parent has to do is exit the "if".	[reply]
Re^4: TCP Server using fork to accept multiple requests by NERDVANA (Deacon) on Aug 20, 2022 at 23:26 UTC
Re: TCP Server using fork to accept multiple requests by Anonymous Monk on Aug 17, 2022 at 09:14 UTC
In your example, the child process keeps executing the code outside the `if` branch. Eventually, all your child processes spawned after a successful `accept()` end up waiting in another `accept()` call for more clients and creating more children as they connect. You should probably put an `exit()` at the end of the `if ($pid == 0)` branch.	[reply] [d/l] [select]


Syntactic Confectionery Delight
	PerlMonks