将 Perl 的 readline 、 <> 函数与 TCP 套接字和信号一起使用

Question

我正在使用 Perl 5.8.8 并尝试确定如果 Perl 被信号中断，它是否会自动且持续地重新启动 readline 函数（更广为人知的 <> ）。

我想使用 readline 从 TCP 套接字安全地读取换行符 '\n' 终止的字符串。

在Deferred Signals (Safe Signals) 部分它说：

可重新启动的系统调用

在支持它的系统上，较旧的 Perl 版本使用SA_RESTART 安装 %SIG 处理程序时的标志。 这意味着可重新启动的系统 通话将继续而不是 信号到达时返回。在 为了传递延迟信号 很快，Perl 5.7.3 和更高版本不 使用SA_RESTART。所以， 可重新启动的系统调用可能会失败 （将 $! 设置为 EINTR ）在一些地方 他们以前会有的地方 成功了。

注意默认的 :perlio 层 将重试read、write 和close 如上所述，并且 中断wait 和waitpid 通话 将始终重试。

现在它还在其他地方说readline 是根据read 实现的。

我在想，如果我执行以下操作，它应该做我想做的事，因为我假设 readline 要么返回整行，要么返回 undef：

sub Readline {
    my $sockfd = shift;

    my $line;

    while (!defined($line = readline($sockfd))) {
        next if $!{EINTR};
        last if eof($sockfd); # socket was closed
        die "readline: $!";
    }
    return $line;
}

这会做我想要的吗？

Answer 1

根据这个简单的测试（至少对于 Linux）来说，这似乎是矫枉过正：

#! /usr/bin/perl

use warnings;
use strict;

my $interrupt = 0;
sub sigint {
  ++$interrupt;
}

$SIG{INT} = \&sigint;

my $line = <STDIN>;

print "interrupt = $interrupt\n",
      "line = $line";

运行它：

$ ./prog.pl
foo^Cbar
中断 = 1
线=条

你在打字稿中看到^C，我按下了Ctrl-C。

中断套接字读取有点棘手，所以全力以赴：

#! /usr/bin/perl

use warnings;
use strict;

use IO::Select;
use IO::Socket;
use IPC::SysV qw/ IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT /;
use IPC::Semaphore;
use Time::HiRes qw/ usleep /;

# Keep $SEND_INTERVAL larger than $KILL_INTERVAL to
# allow many signals to be sent.
my $PORT = 55555;
my $INTERFACE = "eth0";
my $DEFAULT_MTU = 1500;
my $KILL_INTERVAL = 0; # microseconds
my $SEND_INTERVAL = 200_000; # microseconds
my $NUM_READLINES = 100;

sub addr_mtu {
  my($interface) = @_;

  my($addr,$mtu);
  if (open my $ifcfg, "-|", "ifconfig $interface") {
    while (<$ifcfg>) {
      $addr = $1 if /inet\s+addr\s*:\s*(\S+)/;
      $mtu  = $1 if /MTU\s*:\s*(\d+)/;
    }
  }

  die "$0: no address" unless defined $addr;
  unless (defined $mtu) {
    $mtu = $DEFAULT_MTU;
    warn "$0: defaulting MTU to $mtu";
  }

  ($addr,$mtu);
}

sub build_packet {
  my($len) = @_;

  my $seed = join "" => 0 .. 9, 'A' .. 'Z', 'a' .. 'z';
  my $packet = "";
  $packet .= $seed while length($packet) < $len;

  substr($packet, 0, $len-2) . "\r\n";
}

sub take {
  my($sem) = @_;
  while (1) {
    $sem->op(
      0, 0, 0,
      0, 1, 0,
    );
    return unless $!;
    next if $!{EINTR};
    die "$0: semop: $!";
  }
}

sub give {
  my($sem) = @_;
  while (1) {
    $sem->op(0, -1, 0);
    return unless $!;
    next if $!{EINTR};
    die "$0: semop: $!";
  }
}

my($addr,$mtu) = addr_mtu $INTERFACE;
my $pkt = build_packet $mtu;

my $lsn = IO::Socket::INET->new(Listen => 1, LocalAddr => "$addr:$PORT", ReuseAddr => 1);
die "$0: create listen socket: $!" unless defined $lsn;

my $interrupt = 0;
sub sigint {
  ++$interrupt;
}
$SIG{INT} = \&sigint;

my $sem = IPC::Semaphore->new(IPC_PRIVATE, 1, S_IRUSR|S_IWUSR|IPC_CREAT);
die unless defined $sem;
$sem->setall(1);

my $parent = $$;
my $pid = fork;
die "$0: fork: $!" unless defined $pid;
if ($pid == 0) {
  warn "$0: [$$] killer\n";
  my $sent;
  while (1) {
    my $n = kill INT => $parent;
    ++$sent;
    unless ($n > 0) {
      warn "$0: kill INT $parent: $!" if $!;
      warn "$0: [$$] killer exiting; sent=$sent\n";
      exit 0;
    }

    # try to stay under 120 pending-signal max
    if ($sent % 100 == 0) {
      usleep $KILL_INTERVAL;
    }
  }
}

$pid = fork;
die "$0: fork: $!" unless defined $pid;
if ($pid == 0) {
  warn "$0: [$$] sender\n";
  my $s = IO::Socket::INET->new(PeerAddr => "$addr:$PORT");
  unless (defined $s) {
    warn "$0: failed to connect to $addr:$PORT";
    kill TERM => $parent;
    exit 1;
  }

  warn "$0: [$$]: connected to parent\n";
  give $sem;

  my $n;
  while (1) {
    my $bytes = $s->send($pkt, 0);
    warn("$0: send: $!"), last unless defined $bytes;
    warn("$0: short send ($bytes vs. $mtu)"), last unless $bytes == $mtu;
    ++$n;
    warn "$0: [$$] sent $n" if $n % 50 == 0;
    usleep $SEND_INTERVAL;
  }

  $s->close;
  warn "$0: [$$]: sender exiting\n";
  exit 1;
}

take $sem;
my $fh = $lsn->accept;
$lsn->close;
$/ = "\r\n";
for (my $n = 1; $n <= $NUM_READLINES; ++$n) {
  warn "$0: [$$] n=$n; interrupt=$interrupt\n";
  my $line = <$fh>;
  my $len = length $line;
  warn "$0: FAILED: mtu=$mtu; got $len\n" unless $len == $mtu;
}
$fh->close;

warn "$0: parent exiting; interrupt=$interrupt\n";
exit 0;

这不会在我的 Linux 主机上产生短读。其输出结束：

./server: [28633] n=97;中断=104665
./服务器：[28633] n=98；中断=105936
./服务器：[28633] n=99；中断=107208
./服务器：[28633] n=100；中断=108480
./server: [28637] 在 ./server 第 132 行发送了 100。
./server: 父级退出；中断=109751
./server: kill INT 28633: ./server 第 100 行没有这样的进程。
./server: [28636] 杀手退出；发送=11062802

如果我真的提高信号速率，我会收到警告

已超过挂起信号的最大计数 (120)。

与<$fh> 在线以及在全球销毁期间，但在您的程序中您无能为力。

您引用的文档包含：

请注意，默认的:perlio 层将重试read、write 和close，如上所述，中断的wait 和waitpid 调用将始终重试。

以上两个测试程序的行为表明，这很可能是正在发生的事情，即，readline 中的read 在中断时会正常重启。

Answer 2

我也认为这太过分了——我不能让readline 被中断（在 Cygwin、Linux、Perl v5.8 和 v5.10 下）¹。我认为 perlio 层正在处理这个问题，就像your link 文档一样。

---

¹ 测试过程是：（1）安装一个信号处理程序（在我的情况下是SIGCHLD 处理程序），（2）安排进程接收信号（在我的情况下，调用fork() 数百次，子进程休眠一小段但随机的时间），（3）在信号到达并中断主执行线程时调用感兴趣的 Perl 函数（4）观察调用是否正常完成或是否它设置了$! 和$!{EINTR}。

很容易证明sleep 调用可以像这样被中断。如果您有耐心，您还可以看到您可以中断connect 呼叫。这些测试的结论是您不能中断readline 调用，即使是在I/O 不足的套接字上。我确实看到信号已被处理（也就是说，系统没有延迟信号，等待readline 在传递它们之前完成）。希望这会有所帮助。