Question

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

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

可重新启动的系统调用

在支持它的系统上，旧版本   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
interrupt = 1
line = bar

如果你在打字稿中看到^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; 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.

在<$fh>和全球销毁期间都有，但是你的程序中没有任何关于它的内容。

您引用的文档包含：

请注意，默认:perlio图层将重试read，write和close，如上所述，并且中断了wait和waitpid来电将永远重试。

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

Answer 2

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

<小时/>

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

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

使用Perl的readline，＆lt;＆gt;具有TCP套接字和信号的功能

2 个答案: