view release on metacpan or  search on metacpan

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

      @_[KERNEL, OBJECT,];
	$self->Verbose("_stop: ".$self->name." stopping",2);

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

=item ping

This POE Event handler executes the ping command.

=cut

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

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

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

	$self->Verbose("ping: param dump",1,$param);

	my $target;

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

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

	$self->Verbose("ping: target(".$target.") ",2);

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

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


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

	# execution
	$kernel->post( 'pinger' => 'ping' => 'Pong' =>
		$target->addr,
		$param->{'timeout'},
		$param->{'retry_count'},
  	);

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

=item Pong

This POE Event handler receives and processes the events generated by
PoCo::Client::PIng and turns them in to appropriate Responses.

=back

=cut

sub Pong {
	my ($kernel,  $self, $ping, $pong) =
	  @_[KERNEL, OBJECT,  ARG0,  ARG1];

    my ($req_address, $req_timeout, $req_time)      = @$ping;
    my ($resp_address, $roundtrip_time, $resp_time, $resp_ttl) = @$pong;

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

    # The response address is defined if ping successful
    if (defined $resp_address)
    {
    	$txt = sprintf(
        	"ping to %-15.15s at %10d. pong from %-15.15s in %6.3f s\n",
        	$req_address, $req_time,
        	$resp_address, $roundtrip_time,
    	);
    	$code = 200;
    }
    # Otherwise the timeout period has ended and we failed
    else
    {
		$txt = "No response from ".$req_address." in ".$req_timeout;
		$code = 408;  # request_timeout
    }

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


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