Crackers2 has asked for the wisdom of the Perl Monks concerning the following question:

Minimal code that demonstrates the problem:

file: child.pl 

#!/usr/bin/perl
$| = 1;
sleep 10;
print "x\n";
while (1) { sleep 10; }

[download]

file: main.pl 

#!/usr/bin/perl

open my $fh, "./child.pl |";
close $fh;

[download]

Running mail.pl reliably exits after 10 seconds, i.e. right after child.pl has sent its first output. If you remove the print line from child.pl, the main program will never exit.

I'm interested in two things: an explanation of why the program behaves this way, and a solution to the concrete problem this is causing me, described below.

Here's the relevant piece of the real code: 
  ...
  my $active = 1;
  my $timeout = 20;
  my $an;

  open my $fh, "tcpdump -nn -l -e dst 224.111.111.112 and not igmp |";
  $read_set->add($fh);

  while ($active) {
    my ($rh_set) = IO::Select->select($read_set, undef, undef, 1);

    if (defined $rh_set) {
      if ($_ = <$fh>) {
        # do some parsing on the line
        $an = $1;
        last;
      } else {
        # tcpdump died. real code will sleep 2 seconds
        # and then close and reopen $fh here
      }
    }
    if (--$timeout == 0) { $active=0; }
  }
  close $fh;

[download]
What I want is to either capture the first packet that passes the tcpdump filter ($an set to the source IP), or if no packet comes in before the timeout is over, leave the loop with $an still undefined.

Currently I'm working around this problem by explicitely starting tcpdump in a fork()ed child and killing it after the timeout. This works but I have to use a temp file or a pipe to store the tcpdump output, and it's a lot more code than something like the above.

I'm open to whatever solutions the wise monks can come up with, even if it means going about it a whole other way.

Replies are listed 'Best First'.
Re: How to end a process started with open "cmd |" before it has output
by ysth (Canon) on May 07, 2004 at 00:46 UTC
    open will return child.pl's pid, which you can use to kill it.
[reply]

      This worked perfectly thanks !! I missed that line when I was reading the docs.

[reply]
Re: How to end a process started with open "cmd |" before it has output
by Zaxo (Archbishop) on May 07, 2004 at 01:39 UTC

    The strace utility shows that, with child.pl's print omitted, main.pl is stuck in the wait4() system call, waiting for child.pl to exit and emit SIGCHLD. It seems that child.pl is not receiving SIGPIPE under those circumstances (proof below). Perhaps child.pl does not set up its end of the pipe, having nothing to say.

    With the print statement in, strace shows that child.pl exits with SIGPIPE, just the way we expect.

    Changing child.pl to, 

    #!/usr/bin/perl
$SIG{PIPE} = sub { die 'SIGPIPE received' };
$| = 1;
sleep 10;
# print "x\n";
while (1) { sleep 10; }

    [download]
    does not change the behavior, so SIGPIPE is not received by child.pl. Restoring the print line yields the message, 
    $ ./main.pl
SIGPIPE received at ./child.pl line 2.
$

    As ysth suggests, you could kill the child explicitly with SIGINT.

    After Compline,
    Zaxo

[reply]
[d/l]
      Yes, SIGPIPE doesn't just occur asynchronously; the process that receives it usually has to try to use the broken pipe before getting it. (Exceptions are sockets with SO_KEEPALIVE set and explicit kills by other processes.)

      Think of it as libc's way of generating a fatal error.

[reply]
Re: How to end a process started with open "cmd |" before it has output
by mutated (Monk) on May 07, 2004 at 00:45 UTC
    Hey Crackers2, Wrap it in an eval with an alarm like so: 
    my $timeout = 5;
eval { #traps fatal alarm..
  local $SIG{ALRM} = sub { die "alarm\n" }; #\n required
  alarm $timeout;
  print "Do you suck (Y/N)?";
  $answer = <>;
  alarm 0;
};                                                                    
+         
if (!($@)) { #looks like they typed something Y?...
  if ($answer =~ /[Nn]/) { # guess they dont suck
     $suck = 0;
  } else {
     #suck = 1;
  }
} else {
  $suck = 1;
  print "You didn't type anything you suck..\n";
}

    [download]
    just replace the above $response = <> with your system call or whatever..


    daN.
[reply]
[d/l]

      That's actually how I started out, but it doesn't work in this case. If you try the below code, you'll notice it suffers the same problem as the code I posted before.

      In this case, the alarm will fire and execute the die() statement, and the program will print out the "NONE" message, but then it will hang because the program will try to close the $fh filehandle when it exits. This will, as above, hang until some input is received.

      use strict;
use warnings;
use IO::Select;

my $an;
my $timeout = 20;
my $read_set = new IO::Select();

eval {
  local $SIG{ALRM} = sub { die "Timeout\n"; };
  alarm $timeout;

  open my $fh, "tcpdump -nn -l -e dst 224.111.111.112 and not igmp 2>/
+dev/null |";
  $read_set->add($fh);

  while (1) {
    my ($rh_set) = IO::Select->select($read_set, undef, undef, 1);

    if (defined $rh_set) {
      if ($_ = <$fh>) {;
        if (s/^\S* \S* M \S* \S* 0800 \S*: (\S*\.\S*\.\S*\.\S*)\.\S* >
+ \S*\.\S*:.*$/$1/s) {
          $an = $1;
          alarm 0;
          last;
        }
      } else {
        logwarn "EOF while reading from tcpdump. sleeping 2 seconds an
+d restarting tcpdump";
        $read_set->remove($fh);
        close $fh;
        sleep 2;
        open $fh, "tcpdump -nn -l -e dst 224.111.111.112 and not igmp 
+2>/dev/null |";
        $read_set->add($fh);
      }
    }
  }
  close $fh;

};

if ($@ && ($@ ne "Timeout\n")) {
  die $@;
}

if (defined $an) {
  print "$an\n";
  exit 0;
} else {
  print "NONE\n";
  exit 1;
}

      [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom