Agent-TCLI-Package-Net

 view release on metacpan or  search on metacpan

ex/target.t  view on Meta::CPAN

$remote->ok('httpd uri add regex=/test2.* response=OK200');

# start remote web server with logging
$remote->ok('httpd set logging');
$remote->ok('httpd spawn port=8080');

# make sure those completed before proceeding
$test_master->done;

# have local query target webserver.
$local->ok('http tget url=http://'.$target.':8080/test1.htm resp=404');
$local->ok('http tget url=http://'.$target.':8080/test2.htm resp=200');

# check to see if it's in the logs
$remote->ok('tail test add like=test1', 'passed test test1');
$remote->ok('tail test add like=test2', 'passed test test2');

# shut down httpd
$remote->ok('httpd stop port=8080');

# make sure to shut down the transport or else the script will not stop.

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

=pod

=head1 NAME

Agent::TCLI::Package::Net::HTTP

=head1 SYNOPSIS

From within a TCLI Agent session:

tget url=http://example.com/bad_request resp=404

=head1 DESCRIPTION

This module provides a package of commands for the TCLI environment. Currently
one must use the TCLI environment (or browse the source) to see documentation
for the commands it supports within the TCLI Agent.

Makes standard http requests, either testing that a response code was given
or receive the response code back.

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

  command: tcli_http
  contexts:
    ROOT: http
  handler: establish_context
  help: http web cient environment
  manual: >
    Currently the http commands available only support limited capabilities.
    One can request a url and verify that a desired response code was
    received, but HTML content is not processed.
  topic: net
  usage: http tget url=http:\example.com\request resp=404
---
Agent::TCLI::Command:
  name: tget
  call_style: session
  command: tcli_http
  contexts:
    http: tget
  handler: get
  help: makes a requests and expects a specific response code
  manual: >

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

    supplied response code is returned by the http server. This is useful in
    test scripts to ensure that a request has been responeded to properly.
  parameters:
    url:
    response_code:
    retry_interval:
    retry_count:
  required:
    url:
  topic: net
  usage: tget tget url=http:\example.com\request resp=404
---
Agent::TCLI::Command:
  call_style: session
  command: tcli_http
  contexts:
    http: cget
  handler: get
  help: makes a requests and returns response code
  manual: >
    Cget makes an http request for the supplied url and returns the

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


httpd uri add regex=^/good/.* response=OK200

=head1 DESCRIPTION

This module provides a package of commands for the TCLI environment. Currently
one must use the TCLI environment (or browse the source) to see documentation
for the commands it supports within the TCLI Agent.

This package starts a specialized HTTPD on the local system. It does not
return files but does return 404 or 200 values for user defined URLs. It can
also be set to completely ignore a request. URLs may be defined with
regular expressions.

It can also log directly to the log being monitored by the Tail command
in memory with no disk writes.

=head1 INTERFACE

This module must be loaded into a Agent::TCLI::Control by an
Agent::TCLI::Transport in order for a user to interface with it.

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

          	_child

			establish_context
			settings
			show
			spawn
			stop
			uri

			OK200
			NA404
			BeGone
			Log

			)],
      ],
      'heap' => $self,
	);
}

sub _init :Init {

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

  type: Switch
---
Agent::TCLI::Parameter:
  name: response
  aliases: resp
  constraints:
    - ASCII
    -
      - IN_ARRAY
      - OK200
      - NA404
      - BeGone
  default: OK200
  help: The desired response
  manual: >
    The response must be one of the pre-defined responses. Currently these are:
    OK200, NA404, BeGone.
    The default is OK200.
  type: Param
---
Agent::TCLI::Parameter:
  name: handlers
  help: Show the active handlers
  manual: >
    The handlers are stored in a format compatible with PoCo::Server::SimpleHTTP.
    The DIR is the regex and the EVENT is the response.
  type: Switch

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

Agent::TCLI::Command:
  name: httpd
  call_style: session
  command: tcli_httpd
  contexts:
    ROOT: httpd
  handler: establish_context
  help: simple http web server
  manual: >
    httpd provides a simple web server that can respond to and log requests.
    By default it responds with a Status code 404 to all requests. One may add
    a select few other status code responses using regular expression pattern
    matching if desired. One cannot change content, only status codes.
    Httpd is useful for network testing situations where the response codes
    are being monitored by the network.
  topic: net
  usage: httpd spawn port=8080
---
Agent::TCLI::Command:
  name: spawn
  call_style: session

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

  call_style: session
  command: tcli_httpd
  contexts:
    httpd:
      uri: delete
  handler: uri
  help: removes a uri regex from the httpd
  manual: >
    This command removes an existing regex from the uri handler list.
    It must match exactly to the existing uri regex that was added. It
    does not allow removal of the default NA404 response.
  parameters:
    regex:
  required:
    regex:
  topic: net
  usage: httpd uri add regex=^/good/.* response=OK200
---
Agent::TCLI::Command:
  name: set
  call_style: session

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

		return;
	}

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

	$self->handlers( [
			{
				'DIR'		=>	'.*',
				'SESSION'	=>	$self->name,
				'EVENT'		=>	'NA404',
			},
	] ) unless defined($self->handlers);

	$self->Verbose("_start Dump ".$self->dump(1),3);

}

sub _shutdown :Cumulative {
    my ($kernel,  $self, $session) =
      @_[KERNEL, OBJECT,  SESSION];

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

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

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

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

	unless (defined( $self->ports->{ $param->{'port'} } ) )
	{
		 $request->Respond($kernel,'Unable to locate the HTTPD Server',404);
		 return;
	}

	$kernel->post( 'HTTPD'.$param->{'port'}  , 'SHUTDOWN' );

	# remove the stored control for this server
	$self->SetWheelKey( $param->{'port'} , 'control' );

	delete( $self->ports->{ $param->{'port'} } );

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

			},
			$last
		);
		$txt = 'uri added';
		$code = 200;
	}
	elsif ( $command eq 'delete' )
	{
		my $i = 0;
		$txt = "regex not found, delete failed";
		$code = 404;
		# This will loop over the handlers and removel ALL matches.
		foreach my $handler ( @{$self->handlers} )
		{
			if ( $param->{'regex'} eq $handler->{'DIR'} &&
				$i != $self->depth_handlers ) # Don't remove last one, ever.
			{
				my $goner = splice( @{$self->handlers},$i,1 );
				$txt .= "regex ".$goner->{'DIR'}." with response ".
					$goner->{'EVENT'}." deleted \n";
				$code = 200;

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


	# Do our stuff to HTTP::Response
	$response->code( 200 );
	$response->content( 'OK' );

	$kernel->call( $self->name => 'Log' => $request, $response ) if $self->logging;

	$kernel->post('HTTPD'.$port, 'DONE', $response );
}

=item NA404

This POE Event handler is used as a target event for URIs. It will
send an HTTP response code of 404 with an error message.
It will log the conenction if logging is turned on.

=cut

sub NA404 {
	# ARG0 = HTTP::Request object, ARG1 = HTTP::Response object,
	# ARG2 = the DIR that matched
	my ($kernel, $self, $request, $response, $dirmatch ) =
	  @_[KERNEL, OBJECT, ARG0 .. ARG2 ];

	my $port = $response->connection->local_port;

	# Check for errors
	if ( ! defined $request ) {
		$_[KERNEL]->post( 'HTTPD'.$port, 'DONE', $response );
		return;
	}

	# Do our stuff to HTTP::Response
	$response->code( 404 );
	$response->content( "Hi visitor from " . $response->connection->remote_ip.
		", Page not found -> '" . $request->uri->path . "'" );

	$kernel->call($self->name => 'Log' => $request, $response ) if $self->logging;

	$kernel->post('HTTPD'.$port, 'DONE', $response );
}

=item Log

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

		);

		$body = $email->as_string;
	}
	elsif ($command eq 'sendtext')
	{
		my $file = read_file( $param->{'textfile'}, err_mode => 'quiet' );

		unless (defined $file)
		{
			$request->Respond($kernel, "failed: sendtext file not found", 404);
			$self->Verbose("send: sendtext file not found (".$param->{'textfile'}.") ");
			return
		}

		$email = Email::Simple->create(
			header => [
				From    => $param->{'from'},
				To      => $param->{'to'},
				Subject => $param->{'subject'},
			],

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

		);

        $body = $email->as_string;
	}
	elsif ($command eq 'sendmsg')
	{
		my $file = read_file( $param->{'msgfile'}, err_mode => 'quiet' );

		unless (defined $file)
		{
			$request->Respond($kernel, "failed: sendmsg file not found", 404);
			$self->Verbose("send: sendmsg file not found (".$param->{'textfile'}.") ");
			return
		}

        $body = $file;
	}

    # Note that you are prohibited by RFC to send bare LF characters in e-mail
    # messages; consult: http://cr.yp.to/docs/smtplf.html
    $body =~ s/\n/\r\n/g;

t/TCLI.Package.Net.HTTP.t  view on Meta::CPAN

like($test1->Verbose("ok"),qr(ok),'$test1->Verbose returns ok');
# put it back
$test1->verbose($tv);

my $test_c1 = $test1->commands();
is(ref($test_c1),'HASH', '$test1->commands is a hash');

my $test_c1_0 = $test_c1->{'http'};

is($test_c1_0->name,'http', '$test_c1_0->name get from init args');
is($test_c1_0->usage,'http tget url=http:\example.com\request resp=404', '$test_c1_0->usage get from init args');
is($test_c1_0->help,'http web cient environment', '$test_c1_0->help get from init args');
is($test_c1_0->topic,'net', '$test_c1_0->topic get from init args');
is($test_c1_0->command,'tcli_'.$testee, '$test_c1_0->command get from init args');
is($test_c1_0->handler,'establish_context', '$test_c1_0->handler get from init args');
is($test_c1_0->call_style,'session', '$test_c1_0->call_style get from init args');


$t->is_body('http','Context now: http','Context now: http');
$t->not_ok('tget','tget no args');
$t->ok('tget url=http://testing.erichacker.com/404.html resp=404',
		'tget for 404' );
$t->like_body('tget url=http://testing.erichacker.com/404.html resp=200',
		qr(failed), 'tget failed for bad request');
$t->like_body('tget url=http://testing.erichacker.com/ resp=200',
		qr(ok), 'tget for 200');

$t->like_body('cget url=http://testing.erichacker.com/404.html',
		qr(resp=404), 'cget for 404 url' );
$t->like_body('cget url=http://testing.erichacker.com/',
		qr(resp=200), 'cget for good url');

#retries
$t->like_body('cget url=http://testing.erichacker.com/ resp=200 rc=2 ri=10',
		qr(http://testing.erichacker.com/ resp=200 try=1), 'Retry count 1 of 2');
$t->ok('','Retry count 2 of 2');

# Bad cases
$t->like_body('cget http://testing.erichacker.com/',

t/TCLI.Package.Net.HTTPD.t  view on Meta::CPAN

$t->not_ok('set address foobario');
$t->like_body('show address',qr(127.0.0.1),'show set address');

$t->ok('set hostname example.com');
$t->like_body('show hostname',qr(example.com),'show set hostname');

$t->ok('set regex ^/foo/.*');
$t->like_body('show regex',qr(\^/foo/\.\*),'show set regex');

$t->like_body('show response',qr(OK200),'show set response');
$t->ok('set response NA404');
$t->like_body('show response',qr(NA404),'show set response');
$t->not_ok('set response OK404');
$t->like_body('show response',qr(NA404),'show set response');
$t->ok('set response OK200');

$t->ok('uri add regex=foo');
$t->like_body('show handlers',qr(foo));
$t->ok('spawn' );
$t->ok('/http cget url=http://127.0.0.1:8080/foo.htm');
$t->ok('stop' );
$t->ok('uri delete regex=foo');
$t->unlike_body('show handlers',qr(foo),'foo gone');

$t->ok('set logging');
$t->like_body('show logging',qr(logging: 1) );
$t->ok('uri add regex=bar.*');
$t->like_body('show handlers',qr(bar.*));
$t->ok('spawn' );

$t->ok('/tail test add like 200.*?bar');
$t->ok('/http cget url=http://127.0.0.1:8080/bar.htm');
$t->ok('/tail test add like 404.*?foo');
$t->ok('/http cget url=http://127.0.0.1:8080/foo.htm');
$t->ok('/tail test add like 200.*?foobar');
$t->ok('/http cget url=http://127.0.0.1:8080/foobar.htm');

$t->ok('stop' );
$t->ok('uri delete regex=bar.*');
$t->unlike_body('show handlers',qr(bar),'bar gone');

# test for error on restarting on same port
$t->ok('spawn port 8000' );

t/TCLI.Package.Net.HTTPD.t  view on Meta::CPAN

$t->ok('stop port 8000' );

# Can't add handler after server up yet. Need to fix SimpleHTTP
# 13 tests
#$t->ok('spawn' );
#$t->ok('uri add regex=bar.*');
#$t->like_body('show handlers',qr(bar.*));
#
#$t->ok('/tail test add like 200.*?bar');
#$t->ok('/http cget url=http://127.0.0.1:8080/bar.htm');
#$t->ok('/tail test add like 404.*?foo');
#$t->ok('/http cget url=http://127.0.0.1:8080/foo.htm');
#$t->ok('/tail test add like 200.*?foobar');
#$t->ok('/http cget url=http://127.0.0.1:8080/foobar.htm');
#
#$t->ok('stop' );
#$t->ok('uri delete regex=bar.*');
#$t->unlike_body('show handlers',qr(bar),'bar gone');


$test_master->run;

t/dev/target.t  view on Meta::CPAN

$remote->ok('httpd uri add regex=/test2.* response=OK200');

# start remote web server with logging
$remote->ok('httpd set logging');
$remote->ok('httpd spawn port=8080');

# make sure those completed before proceeding
$test_master->done;

# have local query target webserver.
$local->ok('http tget url=http://'.$target.':8080/test1.htm resp=404');
$local->ok('http tget url=http://'.$target.':8080/test2.htm resp=200');

# check to see if it's in the logs
$remote->ok('tail test add like=test1', 'passed test test1');
$remote->ok('tail test add like=test2', 'passed test test2');

# shut down httpd
$remote->ok('httpd stop port=8080');

# make sure to shut down the transport or else the script will not stop.



( run in 1.884 second using v1.01-cache-2.11-cpan-39bf76dae61 )