Using Perl readline, <> function with TCP socket and signals

Question

I am using Perl 5.8.8 and trying to determine if Perl will automatically and sequentially restart the readline function (better known as <> ) if it is interrupted by a signal.

I want to safely read lines with the terminating string '\ n' from a TCP socket using readline.

The Pending Signals (Safe Signals) section says:

Rewritable system calls

On systems that supported it, Perl versions used the SA_RESTART flag when setting %SIG handlers. This meant that a restartable system of calls would continue rather than returning when a signal arrived. In order to deliver pending signals quickly, use Perl 5.7.3 and later SA_RESTART . As a result, restarting system calls may fail (with $! Set to EINTR ) in places where they previously had succeeded.

Note that the default level: perlio will repeat read , write and close as described above, and that the interruptions of wait and waitpid will always be repeated.

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

I think that if I do the following, it should do what I want, since I assume that readline 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 seems like this simple test (at least for Linux) seems redundant:

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

Launch:

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

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

Interrupting a socket read is a bit more complicated, 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 did not produce short reads on my Linux host. End of his release:

  ./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 distorted the signal speed, I would get a warning

  Maximal count of pending signals (120) exceeded. 

both on the line with <$fh> , and during global destruction, but you can’t do anything in your program.

The specified document contains:

Note that the :perlio layer :perlio by default repeat the read , write and close tags as described above, and that interrupted calls to wait and waitpid will always be repeated.

The behavior of the above two test programs shows that this is what happens, i.e. read inside readline restarts correctly upon interruption.

Answer 2

I also think that this is too much - I can not interrupt the readline (under Cygwin, Linux, Perl v5.8 and v5.10) ¹ . I think the perlio layer takes care of this, since your links are documents.

---

¹ Testing procedure: (1) install a signal handler (in my case, a SIGCHLD handler), (2) schedule the signal reception process (in my case, call fork() hundreds of times when the child processes will save for a short but random time), (3) calls the Perl function of interest, when signals arrive and interrupt the main thread of execution (4), observe whether the call ended normally or it sets $! and $!{EINTR} .

It is easy to show that the call of a sleep can be interrupted as follows. If you are patient, you can also see that you can abort the connect call. The completion of these tests is that you cannot interrupt the readline call even on the I / O connector. I see that the signals are being processed (that is, the system does not delay the signals, waiting for the readline to complete before it is delivered). Hope this helps.