Perl : implementing socket programming ( system() never returns) - perl

Question

My aim : implement socket programming such that client tries connecting to server if server not installed on remote machine , client(host) on its part transfers a tar file to server(target) machine and a perl script. This perl script untar the folder and runs a script (server perl script) , now the problem is : this server script has to run forever ( multiple clients ) until the machine restarts or something untoward happens.
so the script runs properly : but since it is continuously running the control doesnt go back to the client which will again try to connect to the server ( on some predefined socket) , so basically i want that somehow i run the server but bring back control to my host which is client in this case.
here is the code :
my $sourcedir = "$homedir/host_client/test.tar";
my $sourcedir2 = "$homedir/host_client/sabkuch.pl";
my $remote_path = "/local/home/hanmaghu";
# Main subroutines
my $ssh = Net::OpenSSH->new ( $hostmachine, user =>$username, password => $password);
$ssh->scp_put($sourcedir,$sourcedir2,$remote_path)
or die "scp failed \n" . $ssh->error;
# test() is similar to system() in perl openssh package
my $rc = $ssh->test('perl sabkuch.pl');
# check if test function returned or not -> this is never executed
if ($rc == 1) {
print "test was ok , server established \n";
}
else {
print "return from test = $rc \n";
}
exit;
The other script which invokes our server script is :
#!/usr/bin/perl
use strict;
use warnings;
system('tar -xvf test.tar');
exec('cd utpsm_run_automation && perl utpsm_lts_server.pl');
#system('perl utpsm_lts_server.pl');
# Tried with system but in both cases it doesn't return,
# this xxx_server.pl is my server script
exit;
The server script is :
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
#flush after every write
$| =1;
my $socket = new IO::Socket::INET (
LocalHost => '0.0.0.0',
LocalPort => '7783',
Proto => 'tcp',
Listen => 5,
Reuse => 1
);
die "cannot create socket $! \n" unless $socket;
print "server waiting for client on port $socket->LocalPort \n";
while (1)
{
# waiting for new client connection
my $client_socket = $socket->accept();
# get info about new connected client
my $client_address = $client_socket->peerhost();
my $client_port = $client_socket->peerport();
print "connection from $client_address:$client_port \n";
# read upto 1024 characters from connected client
my $data = "";
$client_socket->recv($data,1024);
print "rceeived data = $data";
# write response data to the connected client
$data = "ok";
$client_socket->send($data);
# notify client response is sent
shutdown($client_socket,1);
}
$socket->close();
Please help how to execute this : in terms of design this is what i want but having this issue while implementation, can i do it some other work around method.

Answer 1

In short, your 'driver' sabkuch.pl starts the server using exec -- which never returns. From exec
The "exec" function executes a system command and never returns; ...
(Emphasis from the quoted documentation.) Once an exec is used, the program running in the process is replaced by the other program, see exec wiki. If that server keeps running the exit you have there is never reached, that is unless there are errors. See Perl's exec linked above.
So your $ssh->test() will block forever (well, until the server does exit somehow). You need a non-blocking way to start the server. Here are some options
Run the driver in the background
my $rc = $ssh->test('perl sabkuch.pl &');
This starts a separate subshell and spawns sabkuch.pl in it, then returns control and test can complete. The sabkuch.pl runs exec and thus turns into the other program (the server), to run indefinitely. See Background processes in perlipc. Also see it in perlfaq8, and the many good links there. Note that there is no need for perl ... if sabkuch.pl can be made executable.
See whether Net::OpenSSH has a method to execute commands so that it doesn't block.
One way to 'fire-and-forget' is to fork and then exec in the child, while the parent can then do what it wants (exit in this case). Then there is more to consider. Plenty of (compulsory) information is found in perlipc, while examples abound elsewhere as well (search for fork and exec). This should not be taken lightly as errors can lead to bizarre behavior and untold consequences. Here is a trivial example.
#!/usr/bin/perl
use strict;
use warnings;
system('tar -xvf test.tar') == 0 or die "Error with system(...): $!";
my $pid = fork;
die "Can't fork: $!" if not defined $pid;
# Two processes running now. For child $pid is 0, for parent large integer
if ($pid == 0) { # child, parent won't get into this block
exec('cd utpsm_run_automation && perl utpsm_lts_server.pl');
die "exec should've not returned: $!";
}
# Can only be parent here since child exec-ed and can't get here. Otherwise,
# put parent-only code in else { } and wait for child or handle $SIG{CHLD}
# Now parent can do what it needs to...
exit; # in your case
Normally a concern when forking is to wait for children. If we'd rather not, this can be solved by double-forking or by handling SIGCHLD (see waitpid as well), for example. Please study perlfaq8 linked above, Signals in perlipc, docs for all calls used, and everything else you can lay your hands on. In this case the parent should by all means exit first and the child process is then re-parented by init and all is well. The exec-ed process gets the same $pid but since cd will trigger the shell (sh -c cd) the server will eventually run with a different PID.
With system('command &') we need not worry about waiting for a child.
This is related only to your direct question, not the rest of the shown code.

Answer 2

Well i figured the best way would be to fork out a child process and parents exists thus child can now go on forever running the server.pl
but it still is not working please let me knoe where in this code i am going wrong
#!/usr/bin/perl
use strict;
use warnings;
system('tar -xvf test.tar');
my $child_pid = fork;
if (!defined $child_pid){
print "couldn't fork \n";}
else {
print "in child , now executing \n";
exec('cd utpsm_run_automation && perl utpsm_lts_server.pl')
or die "can't run server.pl in sabkuch child \n";
}
the output is my script still hangs and the print statement "in child now executing " gets run twice , i dont understand why,
i work mostly on assembly language hence this all is new to me.
help will be appreciated.