Using Perl's readline , <> function with TCP socket and Signals

Question

I'm using Perl 5.8.8 and trying to determine if Perl automatically and consistently restarts the readline function ( better known as <> ) if it's interrupted by a signal.

I want to safely read newline '\n' terminated strings from a TCP socket using readline.

In the section Deferred Signals (Safe Signals) it says:

Restartable system calls

On systems that supported it, older versions of Perl used the SA_RESTART flag when installing %SIG handlers. This meant that restartable system calls would continue rather than returning when a signal arrived. In order to deliver deferred signals promptly, Perl 5.7.3 and later do not use SA_RESTART. Consequently, restartable system calls can fail (with $! set to EINTR ) in places where they previously would have succeeded.

Note that the default :perlio layer will retry read, write and close as described above and that interrupted wait and waitpid calls will always be retried.

Now it also says elsewhere that readline is implemented in terms of read.

I'm thinking that if I do the following it should do what I want as I assume readline either returns a full line or 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;
}

Will this do what I want?

Answer 1

It appears to be overkill based on this simple test (at least for 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";

Running it:

$ ./prog.pl
foo^Cbar
interrupt = 1
line = bar

Where you see ^C in the typescript, I pressed Ctrl-C.

Interrupting a socket read is a little trickier, so go all out:

#! /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;

This produced no short reads on my Linux host. The end of its output:

./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

If I really cranked up the signal rate, I'd get a warning of

Maximal count of pending signals (120) exceeded.

both on the line with <$fh> and during global destruction, but there's nothing you'd be able to do about that in your program.

The doc you quoted contains:

Note that the default :perlio layer will retry read, write and close as described above and that interrupted wait and waitpid calls will always be retried.

The behavior of the above two test programs show it highly likely that this is what's going on, i.e., the read inside readline is restarting properly when interrupted.