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

“exec”函数执行系统命令，永不返回; ...

（来自引用文档的重点。）使用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是否有执行命令的方法，以便它不会阻止。
“发射后不管”的一种方法是在孩子中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;
```
分叉时通常关注的是儿童的wait。如果我们不愿意，可以通过 double -forking 或处理SIGCHLD（例如，参见waitpid）来解决。请学习上面链接的perlfaq8，Signals in perlipc，所有使用过的电话的文档，以及您可以掌握的所有其他内容。在这种情况下，父级应该首先退出，然后子进程由init重新替换，一切都很好。 exec - ed进程获得相同的$pid，但由于cd将触发shell（sh -c cd），服务器最终将使用不同的PID运行。

使用system('command &')，我们无需担心等待孩子。

这仅与您的直接问题有关，而不与所示代码的其余部分有关。

Answer 2

嗯，我认为最好的方法是分叉一个子进程并且父母存在，因此child现在可以继续运行server.pl

但它仍然无法正常工作请让我知道在这个代码中哪里出错了

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

输出是我的脚本仍然挂起，打印语句“在正在执行的孩子”运行两次，我不明白为什么，我主要使用汇编语言，所以这对我来说都是新的。将不胜感激。

Perl：实现套接字编程（system（）永远不会返回）

2 个答案: