view release on metacpan or  search on metacpan

lib/Agent/TCLI/Package/Net/Traceroute.pm  view on Meta::CPAN

=over

=item new ( hash of attributes )

Usually the only attributes that are useful on creation are the
verbose and do_verbose attrbiutes that are inherited from Agent::TCLI::Base.

=cut

sub _start {
	my ($kernel,  $self,  $session) =
      @_[KERNEL, OBJECT,   SESSION];
	$self->Verbose("_start: tcli traceroute starting");

	# are we up before OIO has finished initializing object?
	if (!defined( $self->name ))
	{
		$kernel->yield('_start');
		return;
	}

	# There is only one command object per TCLI
    $kernel->alias_set($self->name);

	# Keep the pinger session so we can shut it down

	# Create a pinger component.
	POE::Component::Client::Traceroute->spawn(
    	Alias          => 'tracer',   # Defaults to tracer
    	FirstHop       => 1,          # Defaults to 1
    	MaxTTL         => 32,         # Defaults to 32 hops
    	Timeout        => 0,          # Defaults to never
    	QueryTimeout   => 3,          # Defaults to 3 seconds
    	Queries        => 3,          # Defaults to 3 queries per hop
    	BasePort       => 33434,      # Defaults to 33434
    	PacketLen      => 128,        # Defaults to 68
    	SourceAddress  => '0.0.0.0',  # Defaults to '0.0.0.0'
    	PerHopPostback => 0,          # Defaults to no PerHopPostback
    	Device         => undef,     # Defaults to undef
    	UseICMP        => 0,          # Defaults to 0
    	Debug          => 0,          # Defaults to 0
    	DebugSocket    => 0,          # Defaults to 0
	);

	return($self->name.":_start complete ");
} #end start

sub _shutdown {
    my ($kernel,  $self,) =
      @_[KERNEL, OBJECT,];
	$self->Verbose("_shutdown: ".$self->name." shutting down",2);
	$kernel->post('tracer' => 'shutdown');

	$kernel->alarm_remove_all();

	return($self->name.":_shutdown complete ");
}

=item trace

This POE event handler processes the trace command

=cut

sub trace {
    my ($kernel,  $self, $session, $request, ) =
      @_[KERNEL, OBJECT,  SESSION,     ARG0, ];

	my $txt = '';
	my $param;
	my $command = $request->command->[0];
	my $cmd = $self->commands->{'traceroute'};

	return unless ( $param = $cmd->Validate($kernel, $request, $self) );

	$self->Verbose("trace: param dump",4,$param);

	my $target;

	if ( defined( $param->{'target'} ) && ref( $param->{'target'} ) eq 'NetAddr::IP' )
	{
		$target = $param->{'target'}
	}
	else
	{
		$self->Verbose('trace: target not specified ');
		$request->Respond($kernel,  "Target must be defined in command line or in default settings.",412);
		return;
	}

	if ( $param->{'target'}->version() == 6 )
	{
		$request->Respond($kernel,  "IPv6 currently not supported.",400);
		return;
	}
	if ( $param->{'target'}->masklen() != 32 )
	{
		$request->Respond($kernel,  "Address blocks not supported.",400);
		return;
	}

	$self->Verbose("trace: target(".$param->{'target'}.") \n",2);

	# only one traceroute per host at a time
	if (defined($self->requests->{$param->{'target'}->addr}{'request'} ))
	{
		$self->Verbose('trace: trace in progress for target'.$param->{'target'}->addr);
		$request->Respond($kernel,"trace already in progress for ".$param->{'target'}->addr,409);
		return;
	}

	# $txt will be populated if there was an error.
	if ($txt)
	{
		$self->Verbose('trace: argument error '.$txt);
		$request->Respond($kernel, $txt,412);
		return;
	}

	my @trace_options;
	push(@trace_options,
		'MaxTTL'   		=> $param->{'max_ttl'},
		'FirstHop' 		=> $param->{'firsthop'},
    	'Timeout'  		=> $param->{'timeout'},
    	'QueryTimeout'  => $param->{'querytimeout'},
    	'Queries'		=> $param->{'queries'},
    	'BasePort'		=> $param->{'baseport'},
 		);
	push(@trace_options,'PerHopPostBack','TraceHopResponse')
		if $param->{'trace_verbose'};

	push(@trace_options,'UseICMP',1)
		if ($param->{'useicmp'} || ($^O eq "MSWin32"));

  	$self->requests->{$param->{'target'}->addr}{'request'} = $request;

	$self->Verbose(" target ".$param->{'target'}->addr." options ",
		1,\@trace_options );

	# execution
    $kernel->post(
        "tracer",           # Post request to 'tracer' component
        "traceroute",       # Ask it to traceroute to an address
        "TraceResponse",    # Post answers to 'trace_response'
        $param->{'target'}->addr, 	    # This is the host to traceroute to
        \@trace_options
#        [
#          PerHopPostback  => 'TraceHopResponse',
#          Queries   => 5,         # Override the global queries parameter
#          MaxTTL    => 30,        # Override the global MaxTTL parameter
#          Callback  => [ $args ], # Data to send back with postback event
#        ]
    );

	return($self->name.":trace done");
}

=item TraceResponse

This POE event handler processes the return data from the PoCo::Client::Traceroute.

=cut

sub TraceResponse {
	my ($kernel,  $self, $trace, $reply) =
	  @_[KERNEL, OBJECT,   ARG0,  ARG1];

    my ($destination, $options, $callback) = @$trace;
    my ($hops, $data, $error)              = @$reply;

	$self->Verbose("TraceResponse: destination(".$destination.")");
	my ($txt,$code);
	my $request = delete($self->requests->{$destination}{'request'});

	# define code first, so that error can include hops that might
	# have been successful.
	$code = 200;

	if ($error)
	{
		$txt = "trace failed for ".$destination.": ".$error;
		$code = 400;  # request_timeout
	}

	# Hops are returned whether success of failure.
	if ($hops)
	{
		$txt .= "Traceroute results for $destination\n";

		foreach my $hop (@$data)
		{
			my $hopnumber = $hop->{hop};
        	my $routerip  = $hop->{routerip};
        	my @rtts      = @{$hop->{results}};

        	$txt .= "$hopnumber\t$routerip";
        	foreach (@rtts)
        	{
          		if ($_ eq "*") { $txt .= "\t   *     "; }
          		else { $txt .= "\t".sprintf "%0.3fms ", $_*1000; }
        	}
        	$txt .= "\n";
		}
	}

	$request->Respond($kernel, $txt, $code );

	return($self->name.":TraceResponse done");
}

=item TraceHopResponse

This POE event handler processes the per hop return data from the
PoCo::Client::Traceroute.

=cut

sub TraceHopResponse {
	my ($kernel,  $self, $trace, $reply) =
	  @_[KERNEL, OBJECT,   ARG0,  ARG1];

    my ($destination, $options, $callback) = @$trace;
    my ($hops, $data, $error)              = @$reply;

	$self->Verbose("TraceResponse: destination(".$destination.")");
	my ($txt,$code);
	my $request = delete($self->requests->{$destination}{'request'});

	# define code first, so that error can include hops that might
	# have been successful.
	$code = 206;  # partial content

	if ($error)
	{
		$txt = "trace failed for ".$destination.": ".$error;
		$code = 400;  # request_timeout
	}

	# Hops are returned whether success of failure.
	if ($hops)
	{
		$txt .= "Traceroute results for $destination\n";

		foreach my $hop (@$data)
		{
			my $hopnumber = $hop->{hop};
        	my $routerip  = $hop->{routerip};
        	my @rtts      = @{$hop->{results}};

        	$txt .= "$hopnumber\t$routerip\t";
        	foreach (@rtts)
        	{
          		if ($_ eq "*") { $txt .= "* "; }
          		else { $txt .= sprintf "%0.3fms ", $_*1000; }
        	}
        	$txt .= "\n";
		}
	}

	$request->Respond($kernel, $txt, $code );

	return($self->name.":TraceResponse done");
}

sub _preinit :PreInit {
	my ($self,$args) = @_;

	$args->{'name'} = 'tcli_trace';

	$args->{'session'} = POE::Session->create(
      object_states => [
          $self => [qw(
          	_start