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

I have a subroutine that is for timing out a traceroute attempt to a host. The routine is called like this, get_traceroute( 'microsoft.com' ).

For some hosts that often hang indefinately on the last hop to the host, I've implemented a timeout in the subroutine to stop the traceroute call after 10 seconds. However I am still seeing a LONG period of hanging for some hosts that is happening AFTER the timeout is reached, and when the subroutine is trying to CLOSE the pipe.

Why is this? By code is below

sub get_traceroute() {
    my $hostname = $_[0];

    my $buf = '';
    if( open my $pipe, "traceroute -I -n $hostname |" ) {
        my $start = [gettimeofday];
        while(1) {
            my $vin = '';
            vec($vin, fileno($pipe), 1 ) = 1;
            if( select($vin,undef,undef,1) ) {
                sysread $pipe, $buf, 2048, length $buf
                    or last;
            }
            last if tv_interval($start, [gettimeofday]) >= 2;
        }
        close $pipe;
    }
    return $buf;
}

[download]

UPDATE:

Talking with tye he's pointed out that close() does a wait() which is still waiting for the traceroute child to end. The best way, since I don't need any further output from the traceroute, is to kill the process. Open() returns the process id, so I can easily kill the traceroute.

Replies are listed 'Best First'.
Re: Timing out a traceroute
by McDarren (Abbot) on Sep 16, 2006 at 05:24 UTC
    I understand that you have pretty much already solved your own problem - but just as an alternative, have you considered using Net::Traceroute?

    Timeouts would be taken care of for you, and your code could be significantly simplified. Here is a short example script to illustrate, that does basically the same as your get_traceroute sub. 

    #!/usr/bin/perl -wl
use strict;
use Net::Traceroute;

my $host = shift;

my $trace = get_trace($host,3,30);
print $trace->{_text_accumulator} and exit;

sub get_trace {
    my ($host, $query_timeout, $timeout) = @_;

    my $trace = Net::Traceroute->new(
        host           => $host,
        query_timeout  => $query_timeout,
        timeout        => $timeout,
        );

    return $trace;
}

    [download]

    Hope this helps,
    Darren :)

[reply]
[d/l]
[select]
Re: Timing out a traceroute
by msk_0984 (Friar) on Sep 16, 2006 at 05:38 UTC
    Hi

    Not much alteration but hope i could jus help you out. i have just tried to get the output and omitted the time. And as Darren said Net::Traceroute is also a very good option.

    a small change to your code 

    
use strict;

  my $host = <STDIN>;
  chomp($host);
  my  @data = &traceroute($host);

  print " Data :@data \n";


 sub traceroute()
  {

    my ($ht) = @_;
    open EXE," traceroute -m 10 $ht  |" or die " Error Running command
+ $! ";
    my @output =  <EXE>;

    close(EXE);
    ##print " Data : \n @output \n";
    return (@output);
    }

    [download]
    Work Hard Party Harderrr!!
    Sushil Kumar
[reply]
[d/l]
Re: Timing out a traceroute
by shmem (Chancellor) on Sep 16, 2006 at 07:35 UTC
    However I am still seeing a LONG period of hanging for some hosts that is happening AFTER the timeout is reached, and when the subroutine is trying to CLOSE the pipe.

    Why is this? By code is below

    That's because perl is being too polite to the traceroute process whilst closing the pipe: it just sends SIGPIPE (see close) - which traceroute ignores - then waits till the other process closes the pipe, just in case you were interested in it's output.

    The piped open to a command returns that's processes PID.

    You could use that to be unpolite and then close the pipe: 

        if( my $pid = open my $pipe, "traceroute -I -n $hostname |" ) {
        while(1) {
            last if ...
        }
        kill 2, $pid;
        close $pipe;
    }

    [download]

    --shmem 

    _($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
[reply]
[d/l]
      Killing the process is what i settled for, as it does seem the most effective way to deal with the situation.

      Thanks for everyone's comments!
[reply]

Back to Seekers of Perl Wisdom