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.