timeout a print to stdout?

[Dave Saville]

Due to lots of reasons I won't go into here I need a cgi-script to
push out video files. I knocked up a quick and dirty test that works
but if I kill the viewer the perl instance seems to hang around
forever. Although it is killable. It did occur to me that Apache might
kill it eventually when he sees the connection is not requesting
anymore data but it seems not.

So it the interests of being tidy I want to terminate if I have not
sent anything for X.

#!d:/usr/bin/perl5.16.0.exe
use strict;
use warnings;
print "Content-type: text/plain\n\n";
open my $STREAM, '<', "t:/tmp/Foo.rec" or die $!;
binmode $STREAM;
binmode STDOUT;
my $rc = 1;

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;
eval
{
local $SIG{ALRM} = sub{die "too long" };
alarm 60;
print $buffer;
alarm 0;
};
exit if $@ =~ m{^too long};
}

But it never terminates. Any ideas? I realise that both perl and
apache and the "system" are probably buffering away but whatever, I
would have though my script would wait in the print?

 

[Rainer Weikusat]

[...]

So it the interests of being tidy I want to terminate if I have not
sent anything for X.

#!d:/usr/bin/perl5.16.0.exe
use strict;
use warnings;
print "Content-type: text/plain\n\n";
open my $STREAM, '<', "t:/tmp/Foo.rec" or die $!;
binmode $STREAM;
binmode STDOUT;
my $rc = 1;

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;

This is nonsense: It cause the value of $rc to be changed to undef and
returns false aka 'an undefined value'. What you likely wanted is
something like this

die $! unless defined($rc)

or

$rc // die $!

Because of this, your script should really exit after the first
iteration ...

eval
{
local $SIG{ALRM} = sub{die "too long" };
alarm 60;
print $buffer;
alarm 0;
};
exit if $@ =~ m{^too long};
}

But it never terminates. Any ideas?

On UNIX(*), you could be a victim of so-called 'Deferred signals', see
perlipc(1) for details. I have no idea if this affecs 0.5OS ...

 

[Charles DeRykus]

Due to lots of reasons I won't go into here I need a cgi-script to
push out video files. I knocked up a quick and dirty test that works
but if I kill the viewer the perl instance seems to hang around
forever. Although it is killable. It did occur to me that Apache might
kill it eventually when he sees the connection is not requesting
anymore data but it seems not.

So it the interests of being tidy I want to terminate if I have not
sent anything for X.

#!d:/usr/bin/perl5.16.0.exe
use strict;
use warnings;
print "Content-type: text/plain\n\n";
open my $STREAM, '<', "t:/tmp/Foo.rec" or die $!;
binmode $STREAM;
binmode STDOUT;
my $rc = 1;

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;
eval
{
local $SIG{ALRM} = sub{die "too long" };
alarm 60;
print $buffer;
alarm 0;
};
exit if $@ =~ m{^too long};
}

But it never terminates. Any ideas? I realise that both perl and
apache and the "system" are probably buffering away but whatever, I
would have though my script would wait in the print?

Normally, you'd wrap the long running operation within the eval {};

my $rc = 1;
eval {
local $SIG{ALRM} = sub { die "too long"; };
alarm 60;
while ($rc) {
read( ... );
die $! unless defined $rc;
}
alarm 0;
};
die $@ if $@;

There are race conditions so I'd encourage rewriting this to use
the suggested Try::Tiny which will handle common eval gotcha's.

While debugging, it can be helpful to see what happens:

# use following only during debug
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
...
warn "debug: ....";

 

[Rainer Weikusat]

On 4/20/2013 7:07 AM, Dave Saville wrote:
[...]

open my $STREAM, '<', "t:/tmp/Foo.rec" or die $!;

[...]

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;
eval
{
local $SIG{ALRM} = sub{die "too long" };
alarm 60;
print $buffer;
alarm 0;
};
exit if $@ =~ m{^too long};
}

[...]

Normally, you'd wrap the long running operation within the eval {};

my $rc = 1;
eval {
local $SIG{ALRM} = sub { die "too long"; };
alarm 60;
while ($rc) {
read( ... );
die $! unless defined $rc;
}
alarm 0;
};
die $@ if $@;

David did that: The operation which could just 'block forever' is the
print which sends data over a network connection, not the read from a
local file. In fact, reads from files are (on UNIX(*)) not even
interruptible because they are not considered 'blocking operations' in
the sense of 'may wait forever for an external event which never
happens'.

 

[Dave Saville]

[...]

So it the interests of being tidy I want to terminate if I have not
sent anything for X.

#!d:/usr/bin/perl5.16.0.exe
use strict;
use warnings;
print "Content-type: text/plain\n\n";
open my $STREAM, '<', "t:/tmp/Foo.rec" or die $!;
binmode $STREAM;
binmode STDOUT;
my $rc = 1;

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;

This is nonsense: It cause the value of $rc to be changed to undef and
returns false aka 'an undefined value'. What you likely wanted is
something like this

Well I did say irt was quick and dirty

die $! unless defined($rc)

or

$rc // die $!

Because of this, your script should really exit after the first
iteration ...

Which it doesn't.

On UNIX(*), you could be a victim of so-called 'Deferred signals', see
perlipc(1) for details. I have no idea if this affecs 0.5OS ...

That looks interesting. Never heard of that thanks.

 

[Rainer Weikusat]

"Dave Saville" <[email protected]> writes:

[...]

This is nonsense: It cause the value of $rc to be changed to undef and
returns false aka 'an undefined value'. What you likely wanted is
something like this

Well I did say irt was quick and dirty

The problem is not that it would be 'quick and dirty' but totally
wrong because undef is not a predicate.

Which it doesn't.

When I run the code below

----------------------------
use strict;
use warnings;
print "Content-type: text/plain\n\n";
open my $STREAM, '<', "/var/log/syslog" or die $!;
binmode $STREAM;
binmode STDOUT;
my $rc = 1;

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;
eval
{
local $SIG{ALRM} = sub{die "too long" };
alarm 60;
print $buffer;
alarm 0;
};
exit if $@ =~ m{^too long};
}

 

[Charles DeRykus]

On 4/20/2013 7:07 AM, Dave Saville wrote:
[...]

open my $STREAM, '<', "t:/tmp/Foo.rec" or die $!;

[...]

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;
eval
{
local $SIG{ALRM} = sub{die "too long" };
alarm 60;
print $buffer;
alarm 0;
};
exit if $@ =~ m{^too long};
}

[...]

Normally, you'd wrap the long running operation within the eval {};

my $rc = 1;
eval {
local $SIG{ALRM} = sub { die "too long"; };
alarm 60;
while ($rc) {
read( ... );
die $! unless defined $rc;
}
alarm 0;
};
die $@ if $@;

David did that: The operation which could just 'block forever' is the
print which sends data over a network connection, not the read from a
local file.

Ah, I missed the real stream. One other possible solution,
if the problem is intractable, is to fork a child process
which just sets an alarm and then kills the parent when it
goes off.


In fact, reads from files are (on UNIX(*)) not even

interruptible because they are not considered 'blocking operations' in
the sense of 'may wait forever for an external event which never

happens'.

Yes, I've read it too and I'm presuming that actually means
individual I/O op's on a disk file are atomic and won't be
interrupted. However it is still possible to timeout reading
a large disk file with an alarm.

 

[Dave Saville]

"Dave Saville" <[email protected]> writes:

[...]

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;

This is nonsense: It cause the value of $rc to be changed to undef and
returns false aka 'an undefined value'. What you likely wanted is
something like this

Well I did say irt was quick and dirty

The problem is not that it would be 'quick and dirty' but totally
wrong because undef is not a predicate.

Which it doesn't.

When I run the code below

----------------------------
use strict;
use warnings;
print "Content-type: text/plain\n\n";
open my $STREAM, '<', "/var/log/syslog" or die $!;
binmode $STREAM;
binmode STDOUT;
my $rc = 1;

while ( $rc )
{
$rc = read $STREAM, my $buffer, 4096;
die $! if undef $rc;
eval
{
local $SIG{ALRM} = sub{die "too long" };
alarm 60;
print $buffer;
alarm 0;
};
exit if $@ =~ m{^too long};
}

Nope hung around forever here. If it had exited that fast I might have
spotted my error re undef. I was sending a video stream and it
would be pretty obvious if the player only got the first 4096 bytes.
In any case it is now moot as I have found an alternative method of
solving the original, unspecified and unrelated to perl, problem. I
don't know what I was thinking when I coded that line. The number of
times I have written if ! defined...................

 

[Rainer Weikusat]

On 4/21/2013 6:00 AM, Rainer Weikusat wrote:
[...]

In fact, reads from files are (on UNIX(*)) not even interruptible
because they are not considered 'blocking operations' in the sense
of 'may wait forever for an external event which never happens'.

Yes, I've read it too and I'm presuming that actually means
individual I/O op's on a disk file are atomic and won't be
interrupted.

'Disk I/O ops' are something the kernel does asynchronously 'when it feels
like that' and they are invisble to applications: These always either
write to memory buffers or read from memory buffers. In case an
application wants to 'read' data which isn't already in core, it is
put into 'uninterruptible sleep' (Linux term) until the data became
available (there might be exception for 'some network file system', eg
there used to be [on Linux, again] an 'intr' mount option to enable operations on
NFS-mounted shared to be interruptible but this has been turned into a
no-op with Linux 2.6.25).

However it is still possible to timeout reading a large disk file
with an alarm.

Only if 'the [application] I/O operation' returns into user-mode in
between, eg, because an intermediate buffering layer (like stdio or
perlio) is reading a 'large' amount of data in relatively small,
fixed-size chunks.