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

Posted 2023-03-23

【中文标题】Perl：实现套接字编程（ system() 永远不会返回）

【英文标题】：Perl : implementing socket programming ( system() never returns)

【发布时间】：2016-10-17 11:14:56

【问题描述】：

我的目标：实现套接字编程，如果服务器未安装在远程机器上，客户端尝试连接到服务器，客户端（主机）将 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();

请帮助如何执行此操作：就设计而言，这是我想要的，但在执行时遇到此问题，我可以做一些其他解决方法吗？

【参考方案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，以及那里的许多好的链接。请注意，如果可以使 sabkuch.pl 可执行，则不需要 perl ...。

看看Net::OpenSSH是否有执行命令的方法，不会阻塞。

“即发即弃”的一种方法是在子节点中先输入fork，然后再输入exec，而父节点则退出（在这种情况下）。然后还有更多需要考虑。在perlipc 中可以找到大量（强制性）信息。其他地方的例子比比皆是，搜索 fork and 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 $SIGCHLD
exit;

对于孩子来说，分叉时通常需要关注wait。如果我们不愿意，这可以通过 double-forking 或通过处理 SIGCHLD 来解决（参见waitpid），例如。请研究上面链接的perlfaq8、Signals in perlipc、所有使用的呼叫的文档，以及您可以掌握的所有其他内容。在这种情况下，父进程应该首先退出，然后子进程由init 重新作为父进程，一切都很好。 exec-ed 进程获得相同的 $pid，但由于 cd 将触发 shell (sh -c cd)，服务器最终将以不同的 PID 运行。

有了system('command &')，我们就不用担心等孩子了。

---

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

【讨论】：

你能告诉我如何在 perl 中分叉和退出吗：就像你说的火和忘记类型。你能在 perl 中分享相同的代码 sn-p

@hanish 嗯，是的，当然。然而，这是一个有点不同的领域，我也必须要求你也阅读一下。如果出现问题，它可能会变得一团糟。很可能还有另一种更简单的选择——我需要再次查看您的代码并通知您。

@hanish 我在帖子中添加了（一些）选项的细分。特别是，最简单和最简单的方法是您可以在后台启动驱动程序（即启动服务器）。请让我知道情况如何。学习 fork + exec 很好，但可能会分散你手头工作的注意力。

是的，它现在可以工作了，谢谢，我从来不知道 perl 中的后台进程（我知道 nohup），它现在可以工作了。 :) 不过，我在下面放了一个 fork-exec 案例，请让我知道我哪里出了问题。

@hanish 我添加了一个fork+exec 示例，适合您的情况，我的回答。如果您想使用它请首先以安全的方式使用它，以捕获所有这些错误和奇怪的行为，而不会损坏您的系统（或其他系统）。出于手头的目的，我建议使用test('cmd &')，因为您说它有效。告诉我进展如何。

【参考方案2】：

我认为最好的方法是分叉出一个子进程并且父母存在，因此孩子现在可以永远继续运行服务器。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";

输出是我的脚本仍然挂起，并且打印语句“正在执行的子进程中”运行了两次，我不明白为什么， 我主要研究汇编语言，因此这一切对我来说都是新的。 我们将不胜感激。

【讨论】：

就像我说的，还有更多内容。您的第一个测试检查fork 是否失败，仅此而已。孩子和父母没有分离，所以他们都运行else并且他们都启动服务器——没有人可以返回。更糟糕的是，如果出现问题，您可以累积进程（或僵尸）。我建议您阅读一下它 - 搜索 SO 并在我的答案中使用链接，如果有问题发布问题。我也可以将其添加到我的答案中，但这会偏离您的目的，最好在命令后面使用简单的&。

我想提醒大家不要在生产环境中使用fork。 例如，在这段代码中，您启动了两个服务器进程来运行在平行下。如果他们，比如说，写文件并在这样做时互相踩踏，导致文件损坏怎么办？还是乱序获取一些资源？它可能会弄乱您的文件系统，或者更糟。无论如何，玩它，但在小方面 - 编写单独的程序。如果您坚持，我可以将其包含在我的回答中，但我担心您的系统的健康状况。在你知道之前，请不要在重要的地方做。好吧，就像任何其他代码一样，只是更是如此。

@zdim，是的，我认为分叉我会避免它，因为你指出了可能存在的危险，但是如果我必须有一个代码，我想知道它哪里出错了？你能不能写一个相同的sn-p

好的，我会把它添加到我的帖子中。 （我将必须改天这样做，现在已经很晚了。）我会告诉你的。