Использование Perl readline, функция <> с сокетом TCP и Сигналы

Question

Я использую Perl 5.8.8 и пытаюсь определить, будет ли Perl автоматически и последовательно перезапускать функцию readline (более известную как <>), если она прерывается сигналом.

Я хочу безопасно читать завершающие строки новой строки '\ n' из сокета TCP, используя readline.

В разделе Отложенные сигналы (безопасные сигналы) написано:

Перезапускаемые системные вызовы

В системах, которые его поддерживали, более старые версии 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 правильно перезапускается при прерывании.

Answer 2

Я также считаю, что это излишне - я не могу заставить readline быть прерванным (в Cygwin, Linux, Perl v5.8 и v5.10) ¹ . Я думаю, что слой perlio позаботится об этом, так как ваша ссылка документы.

---

¹ Процедура тестирования состоит в том, чтобы: (1) установить обработчик сигналов (в моем случае SIGCHLD обработчик), (2) запланировать процесс приема сигналов (в моем случае вызов fork() сотни раз, когда дочерние процессы спят в течение короткого, но случайного времени), (3) вызывают интересующую функцию Perl, пока поступают сигналы и прерывают основной поток выполнения (4), наблюдают, завершился ли вызов нормально или нет установить $! и $!{EINTR}.

Легко показать, что вызов sleep может быть прерван следующим образом. Если вы терпеливы, вы также можете увидеть, что можете прервать connect звонок. Заключение этих тестов состоит в том, что вы не можете прервать вызов readline даже в случае истощенного ввода-вывода сокета. Я вижу, что сигналы обрабатываются (то есть система не откладывает сигналы, ожидая завершения readline, прежде чем доставить их). Надеюсь, это поможет.