timeout a print to stdout?

Discussion in 'Perl Misc' started by Dave Saville, Apr 20, 2013.

  1. Dave Saville

    Dave Saville Guest

    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?
    --
    Regards
    Dave Saville
     
    Dave Saville, Apr 20, 2013
    #1
    1. Advertising

  2. "Dave Saville" <> writes:

    [...]

    > 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 ...
     
    Rainer Weikusat, Apr 20, 2013
    #2
    1. Advertising

  3. On 4/20/2013 7:07 AM, Dave Saville wrote:
    > 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: ....";



    --
    Charles DeRykus
     
    Charles DeRykus, Apr 21, 2013
    #3
  4. Charles DeRykus <> writes:
    > 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'.
     
    Rainer Weikusat, Apr 21, 2013
    #4
  5. Dave Saville

    Dave Saville Guest

    On Sat, 20 Apr 2013 16:45:16 UTC, Rainer Weikusat
    <> wrote:

    > "Dave Saville" <> writes:
    >
    > [...]
    >
    > > 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.

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


    That looks interesting. Never heard of that thanks.

    --
    Regards
    Dave Saville
     
    Dave Saville, Apr 21, 2013
    #5
  6. "Dave Saville" <> writes:
    > On Sat, 20 Apr 2013 16:45:16 UTC, Rainer Weikusat
    >> "Dave Saville" <> 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.

    >> die $! unless defined($rc)
    >>
    >> or
    >>
    >> $rc // die $!
    >>
    >> Because of this, your script should really exit after the first
    >> iteration ...
    >>

    >
    > 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};
    }
    ----------------------------

    on the system I'm using to write this, it does exit after printing the
    first 4096-byte block of the /var/log/syslog file ...
     
    Rainer Weikusat, Apr 21, 2013
    #6
  7. On 4/21/2013 6:00 AM, Rainer Weikusat wrote:
    > Charles DeRykus <> writes:
    >> 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.


    --
    Charles DeRykus
     
    Charles DeRykus, Apr 21, 2013
    #7
  8. Dave Saville

    Dave Saville Guest

    On Sun, 21 Apr 2013 17:01:58 UTC, Rainer Weikusat
    <> wrote:

    > "Dave Saville" <> writes:
    > > On Sat, 20 Apr 2013 16:45:16 UTC, Rainer Weikusat
    > >> "Dave Saville" <> 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.
    >
    > >> die $! unless defined($rc)
    > >>
    > >> or
    > >>
    > >> $rc // die $!
    > >>
    > >> Because of this, your script should really exit after the first
    > >> iteration ...
    > >>

    > >
    > > 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};
    > }
    > ----------------------------
    >
    > on the system I'm using to write this, it does exit after printing the
    > first 4096-byte block of the /var/log/syslog file ...


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

    --
    Regards
    Dave Saville
     
    Dave Saville, Apr 22, 2013
    #8
  9. Charles DeRykus <> writes:
    > 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.
     
    Rainer Weikusat, Apr 22, 2013
    #9
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Elad
    Replies:
    0
    Views:
    437
  2. keto
    Replies:
    0
    Views:
    1,055
  3. David Cournapeau

    print a vs print '%s' % a vs print '%f' a

    David Cournapeau, Dec 30, 2008, in forum: Python
    Replies:
    0
    Views:
    407
    David Cournapeau
    Dec 30, 2008
  4. Mark Probert

    Timeout::timeout and Socket timeout

    Mark Probert, Oct 6, 2004, in forum: Ruby
    Replies:
    1
    Views:
    1,367
    Brian Candler
    Oct 6, 2004
  5. Andreas S
    Replies:
    3
    Views:
    288
    Eric Hodel
    Dec 9, 2006
Loading...

Share This Page