使用Perl'；s readline，<&燃气轮机；具有TCP套接字和信号的函数

我正在使用Perl 5.8.8，并试图确定如果函数被信号中断，Perl是否会自动且一致地重新启动该函数（更好地称为

）

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

在这一节中，它说：

可重启系统调用

在支持它的系统上，旧的 Perl版本使用了

SA_RESTART

安装

%SIG

处理程序时的标志。 这意味着可重启系统 电话将继续而不是继续 信号到达时返回。在里面 发送延迟信号的命令 很快，Perl 5.7.3和更高版本不会 使用

SA_重新启动

。因此,， 可重启的系统调用可能会失败 （将

$！

设置为

EINTR

）的位置 他们以前会在哪里 成功了

请注意，默认设置为：perlio层 将重试

读取

，

写入

和

关闭

如上所述 中断了

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;
}

---

这会满足我的要求吗？

基于这个简单的测试（至少对于Linux来说），这似乎有些过分：

这在我的Linux主机上没有产生短读。其输出的末尾：

./server: [28633] n=97; interrupt=104665 ./server: [28633] n=98; interrupt=105936 ./server: [28633] n=99; interrupt=107208 ./server: [28633] n=100; interrupt=108480 ./server: [28637] sent 100 at ./server line 132. ./server: parent exiting; interrupt=109751 ./server: kill INT 28633: No such process at ./server line 100. ./server: [28636] killer exiting; sent=11062802 /服务器：[28633]n=97；中断=104665 /服务器：[28633]n=98；中断=105936 /服务器：[28633]n=99；中断=107208 /服务器：[28633]n=100；中断=108480 ./server:[28637]在/server第132行发送了100。 /服务器：父级正在退出；中断=109751 ./server:kill INT 28633:在。/server第100行没有这样的进程。 /服务器：[28636]正在退出；已发送=11062802 如果我真的提高信号速率，我会得到一个警告

Maximal count of pending signals (120) exceeded. 超过了挂起信号的最大计数（120）。 无论是在使用

的线路上还是在全局销毁期间，但在您的程序中都无法做到这一点

您引用的文件包含：

请注意，默认的

：perlio

层将重试

读取

、

写入

和

关闭

，中断的

等待

和

等待

调用将始终重试

---

上述两个测试程序的行为表明，这很可能就是正在发生的事情，即

readline

内部的

readline

在被中断时会正确地重新启动。

我也认为这是杀伤力过大——我不能让

readline

被中断（在Cygwin、Linux、Perl v5.8和v5.10下）1。我认为perlio层正在处理这个问题，就像文档一样

---

1测试过程是：（1）安装一个信号处理程序（在我的例子中是a

SIGCHLD

handler），（2）安排进程接收信号（在我的例子中，调用

fork（）

数百次，子进程睡眠时间很短但随机），（3）在信号到达并中断主执行线程时调用感兴趣的Perl函数（4）观察调用是否正常完成或是否设置了

$和
$！{EINTR}

很容易证明
睡眠
调用可以像这样中断。如果您有耐心，您还可以看到您可以中断
connect
呼叫。这些测试的结论是，您不能中断
readline
调用，即使在缺少I/O的套接字上也是如此。我确实看到信号得到了处理（也就是说，系统没有延迟信号，而是等待
readline
完成后再发送）。希望这有帮助。
安全总比抱歉好。我认为这是必要的，除非对我的问题有一个明确的答案，即一些Perl规范明确指出，
readline
是信号安全的。另外，我不认为你的测试证明了什么。如果我试图通过测试来证明这一点，我会做一些事情，比如让一个客户端在无限循环中向服务器发送一个MTU大小的行，该行带有一个计数器，而第三个进程正在用
SIGINT
轰炸服务器，看看服务器是否得到了部分行或松开了一行。看起来你和mobrule是可能是对的。唯一让我感到停顿的是阅读行“手册页”中的这句话：“当您从不信任的文件句柄（如tty或套接字）读取时，检查$！可能会有所帮助。”当然，他们可能会谈论其他错误，如断开的套接字/eof。正如我对gbacon所说的，安全总比抱歉好。你试过什么样的测试？我问这个问题的原因是因为我认为我的链接提供了一个模棱两可的答案，我想要一个明确的答案。谢谢你更深入的回答。看来你和巴肯可能是对的。唯一让我犹豫不决的是
readline
'manpage'中的这句话：“当您从不信任的文件句柄（如tty或套接字）读取时，检查$！可能会有所帮助。”
#! /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;

./server: [28633] n=97; interrupt=104665
./server: [28633] n=98; interrupt=105936
./server: [28633] n=99; interrupt=107208
./server: [28633] n=100; interrupt=108480
./server: [28637] sent 100 at ./server line 132.
./server: parent exiting; interrupt=109751
./server: kill INT 28633: No such process at ./server line 100.
./server: [28636] killer exiting; sent=11062802
Maximal count of pending signals (120) exceeded.