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

Question

我的目标是:实现套接字编程，以便如果未在远程计算机上安装服务器，则客户端将尝试连接到服务器，客户端(主机)将tar文件传输到服务器(目标)计算机和perl脚本。这个perl脚本解压缩该文件夹并运行一个脚本(服务器perl脚本)，现在的问题是:该服务器脚本必须永久运行(多个客户端)，直到计算机重新启动或发生某些不良情况为止。
因此脚本可以正常运行:但是由于脚本一直在运行，因此控件不会返回到客户端，客户端将再次尝试连接到服务器(在某些预定义的套接字上)，因此基本上我希望以某种方式运行服务器，但要带回控件到我的主机(在这种情况下是客户端)

这是代码:

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;

另一个调用我们服务器脚本的脚本是:

#!/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;

服务器脚本为:

#!/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();

请帮助如何执行此操作:就设计而言，这是我想要的，但是在实现时遇到此问题，我可以围绕方法做其他一些工作。

Answer 1

更新根据要求添加了fork + exec示例。在这里，我推荐system('cmd &')。

简而言之，您的“驱动程序” sabkuch.pl使用exec启动服务器-永远不会返回。从 exec

The "exec" function executes a system command and never returns; ...

(着重于引用的文档。)一旦使用了 exec，则该进程中运行的程序将被另一个程序替换，请参见 exec wiki 。如果该服务器继续运行您拥有的 exit，则永远不会达到，除非有错误。请参阅上面链接的Perl的 exec。

因此，您的 $ssh->test()将永远阻塞(嗯，直到服务器确实退出)。您需要一种非阻塞方式来启动服务器。这里有一些选择

在后台运行驱动程序

my $rc = $ssh->test('perl sabkuch.pl &');

这将启动一个单独的子shell并在其中生成sabkuch.pl，然后返回控件，并且test可以完成。 sabkuch.pl运行exec，因此变成另一个程序(服务器)，以无限期运行。参见 Background processes in perlipc 。另请参见 it in perlfaq8 以及那里的许多良好链接。请注意，如果可以将perl ...设置为可执行文件，则无需使用sabkuch.pl。

查看Net::OpenSSH是否具有执行命令的方法，以使其不会被阻塞。

“解雇”的一种方法是先在 child 中先 fork ，然后是 exec ，而父级退出(在这种情况下)。然后还有更多要考虑的问题。在 perlipc 中找到了大量(必修)信息。例子比比皆是，搜索fork和exec。不应掉以轻心，因为错误可能导致奇怪的行为和难以置信的后果。这是一个例子。

#!/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}
exit;

通常， fork 时要考虑的是 child wait 。如果我们不愿意，那么可以通过双叉或通过处理SIGCHLD(也请参见 waitpid )来解决。请研究上面链接的perlfaq8， Signals in perlipc ，有关所有使用的电话的文档以及您可以使用的所有其他功能。在这种情况下，父级一定要先退出，然后子进程由init重新父化，一切都很好。 exec处理的进程获得相同的$pid，但是由于cd将触发 shell 程序(sh -c cd)，因此服务器最终将以不同的PID运行。

使用system('command &')，我们不必担心等待 child 。

这仅与您的直接问题有关，与其余显示的代码无关。