package Agent::TCLI::Package::Net::Ping;
#
# $Id: Ping.pm 44 2007-04-03 02:28:56Z hacker $
#
=pod

=head1 NAME

Agent::TCLI::Package::Net::Ping

=head1 VERSION

This document describes Agent::TCLI::Package::Net::Ping version 0.0.x

=head1 SYNOPSIS

ping target=example.com

=head1 DESCRIPTION

Makes a standard ping.

=cut

use warnings;
use strict;

use Object::InsideOut qw(Agent::TCLI::Package::Base);

use POE;
use POE::Component::Client::Ping;
use NetAddr::IP;
use Getopt::Lucid qw(:all);
use Agent::TCLI::Command;
use Agent::TCLI::Parameter;


our $VERSION = '0.0.'.sprintf "%04d", (qw($Id: Ping.pm 44 2007-04-03 02:28:56Z hacker $))[2];

=head2 ATTRIBUTES

The following attributes are accessible through standard <attribute>
methods unless otherwise noted.

These attrbiutes are generally internal and are probably only useful to
someone trying to enhance the functionality of this Package module.

=cut

=head3 target

The default target for a ping
B<target> will only accept NetAddr::IP type values.

=cut

=head3 timeout

The default timeout for a ping
B<timeout> will only contain numeric values.

=cut

=head3 retry_count

The default number of retries before failing
B<retry_count> will only contain numeric values.

=cut

=head2 METHODS

Most of these methods are for internal use within the TCLI system and may
be of interest only to developers trying to enhance TCLI.

=head2 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

=head3 _start

This POE event handler is called when POE starts up a Package.
The B<_start> method is :Cumulative within OIO.

=cut

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

	# are we up before OIO has finished initializing object?
	if (!defined( $self->name ))
	{
		$kernel->delay('_start', 1 );
		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.
#	$self->set(\@poco_pinger,
	POE::Component::Client::Ping->spawn(
    	Alias   	=> 'pinger',    # This is the name it'll be known by.
    	Timeout 	=> 10,          # This is how long it waits for echo replies.
    	OneReply	=> 1,			# Only tell us when success or timeout
	);

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

=head3 _stop

This POE event handler is called when POE stops a Package.

=cut

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

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

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

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

=head3 _preinit

This private Object::InsideOut (OIO) method is used for object initialization.

=cut

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

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


	$args->{'session'} = POE::Session->create(
      object_states => [
          $self => [qw(
          	_start
          	_stop
          	_shutdown
          	_default
          	_child
			establish_context
			ping
			Pong
			settings
			show
			)],
      ],
	);
}

=head3 _init

This private OIO method is used for object initialization.

=cut

sub _init :Init {
	my $self = shift;

#  constraints:
#    - ASCII


	$self->LoadYaml(<<'...');
---
Agent::TCLI::Parameter:
  name: target
  class: NetAddr::IP
  help: the target ip address
  manual: >
    The target IP address for the attack. The target may
    be specified as a domain name or as a dotted quad.
  type: Param
  show_method: addr
---
Agent::TCLI::Parameter:
  name: timeout
  constraints:
    - UINT
  default: 10
  class: numeric
  help: the timeout in seconds
  manual: >
    Changes the wait before giving up on getting a response. The default
    is 10 seconds.
  type: Param
---
Agent::TCLI::Parameter:
  name: retry_count
  constraints:
    - UINT
  default: 1
  class: numeric
  help: The number of times to retry when no response is received
  manual: >
    This parameter will cause the specified number or retry attampts
    This will only happen if there is no response from prior requests.
  type: Param
---
Agent::TCLI::Command:
  name: ping
  call_style: session
  command: tcli_ping
  contexts:
    '/': ping
  handler: ping
  help: check to see if a host is alive
  manual: >
    Ping will send an ICMP echo to a target, hoping to get an ICMP
    response before a timeout. One can ping multiple hosts concurrently.
  parameters:
    target:
    timeout:
    retry_count:
  required:
    target:
  topic: network
  usage: ping target example.com
---
Agent::TCLI::Command:
  name: set
  call_style: session
  command: tcli_ping
  contexts:
    ping: set
  handler: settings
  help: set defaults for pings attacks
  parameters:
    target:
    timeout:
    retry_count:
  topic: network
  usage: ping set target=target.example.com
---
Agent::TCLI::Command:
  name: show
  call_style: session
  command: tcli_ping
  contexts:
    ping: show
  handler: show
  help: show current settings
  parameters:
    target:
    timeout:
    retry_count:
  topic: network
  usage: ping show timeout
...

}

1;
#__END__

=head3 INHERITED METHODS

This module is an Object::InsideOut object that inherits from Agent::TCLI::Package::Base. It
inherits methods from both. Please refer to their documentation for more
details.

=head1 AUTHOR

Eric Hacker	 E<lt>perl.mod at erichacker.comE<gt>

=head1 BUGS

SHOULDS and MUSTS are currently not always enforced.

Test scripts not thorough enough.

Probably many others.

=head1 LICENSE

Copyright (c) 2007, Alcatel Lucent, All rights resevred.

This package is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.

=cut
