Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Command.pm view on Meta::CPAN
name => 'paramint',
type => 'Param',
);
my $cmd1 = Agent::TCLI::Command->new(
'name' => 'cmd1',
'contexts' => {'/' => 'cmd1'},
'help' => 'cmd1 help',
'usage' => 'cmd1 usage',
'topic' => 'test',
'call_style'=> 'session',
'command' => 'test1',
'handler' => 'cmd1',
'parameters' => {
'test_verbose' => $test_verbose
'paramint' => $paramint,
},
'verbose' => 0,
);
$self->parameters->{'test_verbose'} = $test_verbose;
lib/Agent/TCLI/Command.pm view on Meta::CPAN
The integer parameter.
type => Param
---
Agent::TCLI::Command:
name: cmd1
contexts:
'/' : cmd1
help: cmd1 help
usage: cmd1 usage
topic: test
call_style: session
command: test1
handler: cmd1
parameters:
test_verbose: verbose
paramint: paramint
...
}
=head1 DESCRIPTION
lib/Agent/TCLI/Command.pm view on Meta::CPAN
my @stop :Field :All('stop')
:Type('CODE');
=item handler
A code reference for a response handler if necessary for a
POE event driven command
=cut
my @handler :Field :All('handler');
=item call_style
This is a holdover to facilitate migration from the older style method
of calling commands with an oob, to the new POE parameter use. The value
'poe' means the command is called directly with the normal POE KERNEL
HEAP and ARGs. 'session' means that a POE event handler is called.
B<call_style> will only accept SCALAR type values.
=cut
my @call_style :Field :All('call_style');
=item contexts
A hash of the contexts that the command may be called from. This needs to
be written up much better in a separate section, as it is very complicated.
B<contexts> will only accept hash type values.
=cut
my @contexts :Field
:All('contexts')
lib/Agent/TCLI/Command.pm view on Meta::CPAN
#sub RawCommand {
# my $self = shift;
## my %cmd = validate( @_, {
## help_text => { type => Params::Validate::SCALAR }, #required
## usage => { type => Params::Validate::SCALAR }, #required
## topic => { optional => 1, type => Params::Validate::SCALAR },
## name => { type => Params::Validate::SCALAR }, #required
## command => { type => ( Params::Validate::SCALAR | Params::Validate::CODEREF ) }, #required
## context => { optional => 1, type => Params::Validate::ARRAYREF },
## style => { optional => 1, type => Params::Validate::SCALAR },
## start => { optional => 1, type => Params::Validate::CODEREF },
## handler => { optional => 1, type => Params::Validate::SCALAR },
## stop => { optional => 1, type => Params::Validate::CODEREF },
## } );
#
# my %cmdhash = (
# 'name' => $name[$$self],
# 'help' => $help[$$self],
# 'usage' => $usage[$$self],
# 'command' => $command[$$self],
# );
# $cmdhash{'topic'} = $topic[$$self] if (defined($topic[$$self]));
# $cmdhash{'contexts'} = $contexts[$$self] if (defined($contexts[$$self]));
# $cmdhash{'call_style'} = $call_style[$$self] if (defined($call_style[$$self]));
# $cmdhash{'handler'} = $handler[$$self] if (defined($handler[$$self]));
# $cmdhash{'start'} = $start[$$self] if (defined($start[$$self]));
# $cmdhash{'stop'} = $stop[$$self] if (defined($stop[$$self]));
#
# return ( \%cmdhash );
#}
=item GetoptLucid( $kernel, $request)
Returns an option hash keyed on parameter after the arguments have bee parsed
lib/Agent/TCLI/Control.pm view on Meta::CPAN
sub Register {
my $self = shift;
$self->Verbose("Register: params",4,@_);
my %cmd = validate( @_, {
help => { type => Params::Validate::SCALAR }, #required
usage => { type => Params::Validate::SCALAR }, #required
topic => { optional => 1, type => Params::Validate::SCALAR },
name => { type => Params::Validate::SCALAR }, #required
command => { type => ( Params::Validate::SCALAR | Params::Validate::CODEREF ) }, #required
contexts => { optional => 1, type => Params::Validate::HASHREF },
call_style => { optional => 1, type => Params::Validate::SCALAR },
# start => { optional => 1, type => Params::Validate::CODEREF },
handler => { optional => 1, type => Params::Validate::SCALAR },
# stop => { optional => 1, type => Params::Validate::CODEREF },
} );
# Set up a default contexts if one not provided.
$cmd{'contexts'} = { 'ROOT' => $cmd{'name'} } unless (defined ( $cmd{'contexts'}) );
$self->Verbose("Register: name ".$cmd{'name'} );
lib/Agent/TCLI/Control.pm view on Meta::CPAN
{
if ( !defined($request->args) || $request->depth_args == 0 )
{
$request->args( \@args );
$request->command( $context );
$self->Verbose( "Execute: Request post FindCommand".$request->dump(1),3);
}
# The response may bypass the Control's AsYouWished, and go
# directly back to the Transport if that is what is $request(ed)
if ( $cmd->call_style eq 'sub')
{
# Subs can't handle request objects.
my (@rargs, $rinput);
# subs want the command in the @rargs
push( @rargs, $request->command->[0], $request->args );
# Make sure there is input, just in case....
$rinput = defined($request->input) ? $request->input :
join(' ',$request->command->[0],$request->args);
# do it
($txt, $code) = $self->DoSub($cmd, \@rargs, $rinput );
$request->Respond( $kernel, $txt, $code);
return;
}
elsif ( $cmd->call_style eq 'state')
{
$self->Verbose("Execute: Executing state ".$cmd->handler." \n");
$kernel->yield( $cmd->handler => $request );
return;
}
elsif ( $cmd->call_style eq 'session')
{
$self->Verbose("Execute: Executing session ".$cmd->command.
"->".$cmd->handler." \n");
$kernel->post($cmd->command => $cmd->handler =>
$request );
return;
}
}
else
{
if ( $cmd->call_style eq 'sub')
{
($txt, $code) = $self->DoSub($cmd, \@args, $input );
}
else
{
my $request = Agent::TCLI::Request->new(
'args' => \@args,
'command' => $context,
'sender' => $self,
'postback' => 'AsYouWished',
'input' => $input,
'verbose' => $self->verbose,
'do_verbose' => $self->do_verbose,
);
if ( $cmd->call_style eq 'state')
{
$self->Verbose("Execute: Executing state ".$cmd->handler." \n");
$kernel->yield( $cmd->handler => $request );
return;
}
elsif ( $cmd->call_style eq 'session')
{
$self->Verbose("Execute: Executing session ".$cmd->command.
"->".$cmd->handler." \n");
$kernel->post($cmd->command => $cmd->handler =>
$request );
return;
}
}
}
}
lib/Agent/TCLI/Control.pm view on Meta::CPAN
sub _default_commands :Private {
my $self = shift;
my $dc = {
'echo' => Agent::TCLI::Command->new(
'name' => 'echo',
'help' => 'Return what was said.',
'usage' => 'echo <something> or /echo ...',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'echo'},
'call_style'=> 'state',
'handler' => 'general'
),
'Hi' => Agent::TCLI::Command->new(
'name' => 'Hi',
'help' => 'Greetings',
'usage' => 'Hi/Hello',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'ROOT' => [ qw(Hi hi Hello hello)]},
'call_style'=> 'state',
'handler' => 'general'
),
'context' => Agent::TCLI::Command->new(
'name' => 'context',
'help' => "displays the current context",
'usage' => 'context or /context',
'manual' => "Context can be somewhat difficult to understand when one thinks of normal command line interfaces that often retain context differently. ".
"Context is a way of nesting commands, much like a file directory, to make it easier to navigate. There are a few commands, such as 'help' or 'exit' that are global, ".
"but most commands are available only within specific contexts. Well written packages will collect groups of similar commands within a context. ".
"For instance, if one had package of attack commands, one would put them all in an 'attack' context. Instead of typing 'attack one target=example.com', ".
lib/Agent/TCLI/Control.pm view on Meta::CPAN
"Furthermore, a well written package will support the setting of default parameters for use within a context. One can then say: \n ".
"\tattack \n\tset target=example.com \n\tone \n\ttwo \n\t...\n\n".
"The full command 'attack one target=example.com' must always be supported, but using context makes it easier to do repetitive tasks manually as well as ".
"allow one to navigate through a command syntax that one's forgotten the details of without too much trouble. \n\n".
"Context has a sense of depth, as in how many commands one has in front of whatever one is currently typing. ".
"An alias to the context command is 'pwd' which stands for Present Working Depth. ".
"Though it may make the Unix geeks happy, they should remember that this is not a file directory structure that one is navigating within.",
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => [ qw( context pwd ) ]},
'call_style'=> 'state',
'handler' => 'general'
),
'Verbose' => Agent::TCLI::Command->new(
'name' => 'Verbose',
'help' => "changes the verbosity of output to logs",
'usage' => 'Verbose',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'Verbose'},
'call_style'=> 'state',
'handler' => 'general'
),
'debug_request' => Agent::TCLI::Command->new(
'name' => 'debug_request',
'help' => 'show what the request object contains',
'usage' => 'debug_request <some other args>',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'debug_request'},
'call_style'=> 'state',
'handler' => 'general'
),
'help' => Agent::TCLI::Command->new(
'name' => 'help',
'help' => 'Display help about available commands',
'usage' => 'help [ command ] or /help',
'manual' => 'The help command provides summary information about running a command and the parameters the command accepts. Help with no arguments will list the currently available commands. Help is currently broken in that it only operates wi...
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'help'},
'call_style'=> 'state',
'handler' => 'help'
),
'manual' => Agent::TCLI::Command->new(
'name' => 'manual',
'help' => 'Display detailed help about a command',
'usage' => 'manual [ command ]',
'manual' => 'The manual command provides detailed information about running a command and the parameters the command accepts. Manual is currently broken in that it only operates within the existing context and cannot be called with a full con...
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => ['manual', 'man'] },
'call_style'=> 'state',
'handler' => 'manual'
),
'status' => Agent::TCLI::Command->new(
'name' => 'status',
'help' => 'Display general TCLI control status',
'usage' => 'status or /status',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'status'},
'call_style'=> 'state',
'handler' => 'general'
),
'/' => Agent::TCLI::Command->new(
'name' => 'root',
'help' => "exit to root context, use '/command' for a one time switch",
'usage' => 'root or / ',
'manual' => "root, or '/' for the Unix geeks, will change the context back to root. See 'manual context' for more information on context. ".
"Unless otherwise noted, changing to root context does not normally clear out any default settings that were established in that context. \n\n".
"One can preceed a command directly with a '/' such as '/exit' to force the root context. ".
"Sometimes a context may independently process everything said within the context and, if misbehaving, doesn't provide a way to leave the context. ".
"Using '/exit' or '/help' should always work. The example package Eliza is known to have trouble saying Goodbye and exiting properly.",
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => { 'UNIVERSAL' => ['/','root'] },
'call_style'=> 'state',
'handler' => 'exit',
),
# {
# 'name' => 'load',
# 'help' => 'Load a new control package',
# 'usage' => 'load < PACKAGE >',
# 'topic' => 'admin',
# 'command' => sub {return ("load is currently diabled")}, #\&load,
# 'call_style'=> 'sub',
# },
# {
# 'name' => 'listcmd',
# 'help' => 'Dump the registered commands in their contexts',
# 'usage' => 'listcmd (<context>)',
# 'topic' => 'admin',
# 'command' => 'pre-loaded',
# 'contexts' => {'UNIVERSAL'},
# 'call_style' => 'state',
# 'handler' => 'listcmd',
# },
'dumpcmd' => Agent::TCLI::Command->new(
'name' => 'dumpcmd',
'help' => 'Dump the registered command hash information',
'usage' => 'dumpcmd <cmd>',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => 'dumpcmd'},
'call_style'=> 'state',
'handler' => 'dumpcmd',
),
'nothing' => Agent::TCLI::Command->new(
'name' => 'nothing',
'help' => 'Nothing is as it seems',
'usage' => 'nothing',
'topic' => 'general',
'contexts' => {'ROOT' => 'nothing'},
'command' => sub { return ("You said nothing, try help") },
'call_style'=> 'sub',
),
'exit' => Agent::TCLI::Command->new(
'name' => 'exit',
'help' => "exit the current context, returning to previous context",
'usage' => 'exit or /exit',
'manual' => "exit, or '..' for the Unix geeks, will change the context back one level. See 'manual context' for more information on context. ".
"Unless otherwise noted, leaving a context does not normally clear out any default settings that were established in that context. \n\n",
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => {'UNIVERSAL' => [ qw(exit ..)] },
'call_style'=> 'state',
'handler' => 'exit',
),
'ip' => Agent::TCLI::Command->new(
'name' => 'ip',
'help' => 'Returns the local ip address',
'usage' => 'ip',
'topic' => 'net',
'command' => 'pre-loaded',
'contexts' => {'ROOT' => 'ip' },
'call_style'=> 'state',
'handler' => 'net'
),
'Control' => Agent::TCLI::Command->new(
'name' => 'Control',
'help' => 'show or set Control variables',
'usage' => 'Control show local_address',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'ROOT' => 'Control' },
'call_style'=> 'state',
'handler' => 'establish_context'
),
'show' => Agent::TCLI::Command->new(
'name' => 'show',
'help' => 'show Control variables',
'usage' => 'Control show local_address',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => {'Control' => 'show' },
'call_style'=> 'state',
'handler' => 'establish_context'
),
};
return ( $dc );
}
=item _automethod
Some transports may need to store extra state information related to the
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
This could be a very long list.
type: Switch
---
Agent::TCLI::Parameter:
name: active
help: The tests and watches that are currently active.
type: Switch
---
Agent::TCLI::Command:
name: tail
call_style: session
command: tcli_tail
contexts:
ROOT: tail
handler: establish_context
help: tail a file
topic: testing
usage: tail file add file /var/log/messages
---
Agent::TCLI::Command:
name: file
call_style: session
command: tcli_tail
contexts:
tail: file
handler: establish_context
help: manipulate files for tailing
topic: testing
usage: tail file add file /var/log/messages
---
Agent::TCLI::Command:
name: file-add
call_style: session
command: tcli_tail
contexts:
tail:
file: add
handler: file
help: designate a file for tailing
topic: testing
usage: tail file add file /var/log/messages
---
Agent::TCLI::Command:
name: file-delete
call_style: session
command: tcli_tail
contexts:
tail:
file: delete
handler: file
help: delete a tailing of a file
topic: testing
usage: tail file delete file /var/log/messages
---
Agent::TCLI::Command:
name: test
call_style: session
command: tcli_tail
contexts:
tail:
- test
- watch
handler: establish_context
help: manipulate tests on tails
topic: testing
usage: tail test add like qr(alert)
---
Agent::TCLI::Command:
name: test-watch-add
call_style: session
command: tcli_tail
contexts:
tail:
test: add
watch: add
handler: test
help: add a new tests on the tails
parameters:
feedback:
test_match_times:
test_max_lines:
name:
ordered:
test_ttl:
test_verbose:
topic: testing
usage: tail test add like qr(alert) <options>
---
Agent::TCLI::Command:
call_style: session
command: tcli_tail
contexts:
tail:
test: delete
watch: delete
handler: test
help: delete a test on the tails
name: test-watch-delete
topic: testing
usage: tail test delete num 42
---
Agent::TCLI::Command:
name: set
call_style: session
command: tcli_tail
contexts:
tail: set
handler: settings
help: adjust default settings
parameters:
ordered:
interval:
line_max_cache:
line_hold_time:
test_max_lines:
test_match_times:
test_ttl:
test_verbose:
topic: testing
usage: tail set test_max_lines 5
---
Agent::TCLI::Command:
name: show
call_style: session
command: tcli_tail
contexts:
tail: show
handler: show
help: show tail default settings and state
parameters:
ordered:
interval:
line_max_cache:
line_hold_time:
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
test_ttl:
test_verbose:
test_queue:
line_cache:
active:
topic: testing
usage: tail show settings
---
Agent::TCLI::Command:
name: log
call_style: session
command: tcli_tail
contexts:
tail: log
handler: log
help: add text to the line queue
manual: >
The log command allows one to add a line of text to the queue. It helped
to facilitate testing of the tail package, but might not be useful
otherwise. Still, here it is. Any text following log appears in the line
queue as if it was coming from a tailed file.
topic: testing
usage: tail log "some text"
---
Agent::TCLI::Command:
call_style: session
command: tcli_tail
contexts:
tail: clear
handler: establish_context
help: clears out a cache
name: clear
topic: testing
usage: tail clear lines
---
Agent::TCLI::Command:
call_style: session
command: tcli_tail
contexts:
tail:
clear: lines
handler: clear
help: clears out the line cache
name: clear_lines
topic: testing
usage: tail clear lines
...
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
name: password
constraints:
- ASCII
help: A password for the user.
manual: >
A password for the user. For a private XMPP chatroom,
this is used to log on. It is not used anywhere else currently.
type: Param
---
Agent::TCLI::Command:
call_style: session
command: tcli_xmpp
contexts:
ROOT:
- jabber
- xmpp
handler: establish_context
help: 'manipulate the jabber/xmpp transport'
manual: >
This command allows one to control various aspects of the XMPP
transport.
name: xmpp
topic: admin
usage: xmpp change group_mode prefixed
---
Agent::TCLI::Command:
name: change
call_style: session
command: tcli_xmpp
contexts:
jabber: change
xmpp: change
handler: change
help: 'change the jabber/xmpp transport parameters'
manual: >
This command allows one to change one of several different parameters
that control the operation of the XMPP transport.
parameters:
group_mode:
group_prefix:
xmpp_verbose:
topic: admin
usage: xmpp change group_mode prefixed
---
Agent::TCLI::Command:
name: show
call_style: session
command: tcli_xmpp
contexts:
jabber: show
xmpp: show
handler: show
help: 'show the jabber/xmpp transport settings'
manual: >
This command will show the current setting for parameters
that control the operation of the XMPP transport. One can use all
to see all the parameters.
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
group_mode:
group_prefix:
xmpp_verbose:
controls:
peers:
topic: admin
usage: xmpp show group_mode
---
Agent::TCLI::Command:
name: shutdown
call_style: session
command: tcli_xmpp
contexts:
jabber: shutdown
xmpp: shutdown
handler: shutdown
help: 'shutdown the jabber/xmpp transport'
topic: admin
usage: xmpp shutdown
---
Agent::TCLI::Command:
name: peer
call_style: session
command: tcli_xmpp
contexts:
jabber: peer
xmpp: peer
handler: establish_context
help: 'manage peers that the transport talks to'
manual: >
The peer command allows one to add or delete users from the list of
peers that the Transport will communicate with. Currently this list of
peers is not savable.
topic: admin
usage: xmpp peer add id=peer@example.com protocol=xmpp auth=master
---
Agent::TCLI::Command:
call_style: session
command: tcli_xmpp
contexts:
jabber:
peer: add
xmpp:
peer: add
handler: peer
help: 'add peers that the transport talks to'
manual: >
The peer command allows one to add or delete users from the list of
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
password:
protocol:
required:
auth:
id:
protocol:
topic: admin
usage: xmpp peer add id=peer@example.com protocol=xmpp auth=master
---
Agent::TCLI::Command:
call_style: session
command: tcli_xmpp
contexts:
jabber:
peer: delete
xmpp:
peer: delete
handler: peer
help: 'delete peers that the transport talks to'
manual: >
The delete command allows one to delete users from the list of
lib/Agent/TCLI/Testee.pm view on Meta::CPAN
to wait for all responses to that request to come in.
B<get_param> attempts to parse the text in the responses to find the value
for the parameter being requested. It expects that the response is
formatted appropriately to extract the parameter.
Valid formats to receive the parameter are:
param=something
param something
param="a quoted string with something"
param "a quoted string with something"
param: a string yaml-ish style, no comments, to the end of the line
param: "a quoted string, just what's in quotes"
It returns the value of the parameter requested, or undefined if it
cannot be found.
=cut
sub get_param {
my ($self, $param, $id, $timeout) = @_;
$id = $self->last_request->id unless ( defined($id) && $id );
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
$request->sender([
$testee->transport,
$testee->protocol,
]);
$request->postback([
'PostRequest',
$testee->addressee,
])
}
# using make_id to faciltate changing ID style in olny one place later
$request_count[$$self]++;
$id = $self->make_id( $request_count[$$self]);
$request->id( $id );
# Put request onto stack.
$self->push_requests($request);
$last_testee[$$self] = $testee->addressee;
}
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
=item dispatch
This internal object method is used to dispatch requests and run POE timeslices
during the test script. An understanding of POE may be necessary to grok
the need for this function.
=cut
sub dispatch {
my ($self, $style) = @_;
# Clean out anything in kernel queue
$poe_kernel->run_one_timeslice;
my $post_it = $self->post_it($style);
if ( ( $post_it == 1 ) && ( my $next_request = $self->shift_requests ) )
{
$self->Verbose($self->alias.":dispatch: sending request id(".$next_request->id.") " );
$poe_kernel->post($self->alias, 'SendRequest', $next_request );
# There are problems with OIO Lvalues on some windows systems....
$requests_sent[$$self]++;
# Go ahead and send that out
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
to wait for all responses to that request to come in.
B<get_param> attempts to parse the text in the responses to find the value
for the parameter being requested. It expects that the response is
formatted appropriately to extract the parameter.
Valid formats to receive the parameter are:
param=something
param something
param="a quoted string with something"
param "a quoted string with something"
param: a string yaml-ish style, no comments, to the end of the line
param: "a quoted string, just what's in quotes"
It returns the value of the parameter requested, or undefined if it
cannot be found.
=cut
sub get_param {
my ($self, $param, $id, $timeout) = @_;
# valid formats to receive the parameter are:
# param=something
# param something
# param="a quoted string with something"
# param "a quoted string with something"
# param: a string yaml-ish style, no comments, to the end of the line
# param: "a quoted string, just what's in quotes"
my $value;
# validate id
unless ( defined($id) && $id )
{
# Use last id if not supplied
$id = $self->make_id( $request_count[$$self]);
}
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
# Maybe put in hostname and PID or some other unique ID prefix someday?
# or maybe not
$self->Verbose($self->alias.":make_id: num($num) id($id)",2);
return ( $id );
}
=item post_it
This internal method controls whether to dispatch the next test. It supports
different styles of running tests, though currently the style is not
user configurable and manipulation of the style is not tested.
For future reference and to encourage assistance in creating a user interface to style, they are:
B<default> or B<syncsend> - This allows a test to be dispacthed when the
acknoledgement is received that the previous test has been received OK. This
does not wait for the previous test to complete.
B<syncresp> or B<done> - This will not dispatch any test until the previous test
has completed. There are many testing scenarios where this makes no sense.
There may be scenarios where it does make sense, and htat is why it is here.
A similar effect can be had with the B<done> test.
B<asynch> - This dispatches a test as soon as it is ready to go. Sometimes
this may allow a local test to complete before a prior remote test has
been acknowledged, so it is not the default.
=cut
sub post_it{
my ($self, $style) = @_;
my $post_it = 0;
# Currently running partially synchronous by default.
$style = 'default' unless defined( $style );
# TODO Option to set default for all runs.
if ( $dispatch_counter[$$self] == $dispatch_retries[$$self] )
{
# if we stalled on something, then skip it
$post_it = 1;
}
elsif ( !defined($style) || $style =~ /default|syncsend/ ) # partially synchronous / ordered
# make sure we got some response to the previously sent request before sending
{
# Have we seen a response yet for the last request?
$self->Verbose($self->alias.":post_it:$style: sent(".$requests_sent[$$self].") ",1);
if ( $requests_sent[$$self] == 0 ||
exists( $responses[$$self]{ $self->make_id($requests_sent[$$self]) } )
)
{
$post_it = 1;
}
}
elsif ( $style =~ /syncresp|done|ordered/ ) # completely synchronous / ordered
#make sure all created requests have responses before sending another
{
my $rmc = $self->responses_contiguous;
if ( $request_count[$$self] == $rmc )
{
$post_it = 1;
}
$self->Verbose($self->alias.":post_it:$style: count(".
$request_count[$$self].") contiguous(".$rmc.")",);
}
elsif ( $style =~ /async/ ) # asynchrounous, no other checks necessary
# who cares, send it now.
{
$post_it = 1;
}
$self->Verbose($self->alias.":post_it: ($post_it)");
return($post_it);
}
=item responses_contiguous ( )
lib/auto/Agent/TCLI/Control/config.xml view on Meta::CPAN
<package>
<Parameter name="local_address" aliases="ip" help="local ip address" manual="" type="Param" />
<Parameter name="auth" aliases="" help="auth level within control" manual="" type="Param" />
<Parameter name="user" aliases="" help="control user" manual="" type="Param" />
<Command name="show" call_style="state" command="pre-loaded" handler="show" help="show Control variables" topic="admin" usage="Control show local_address">
<contexts Control="show" ></contexts>
<parameters user="1" local_address="1" auth="1"></parameters></Command>
<Command name="root" call_style="state" command="pre-loaded" handler="exit" help="exit to root context, use '/command' for a one time switch" manual="root, or '/' for the Unix geeks, will change the context back to root. See 'manual context' for more...
One can preceed a command directly with a '/' such as '/exit' to force the root context. Sometimes a context may independently process everything said within the context and, if misbehaving, doesn't provide a way to leave the context. Using '/exit' o...
<contexts>
<UNIVERSAL>/</UNIVERSAL>
<UNIVERSAL>root</UNIVERSAL>
</contexts>
</Command>
<Command name="manual" call_style="state" command="pre-loaded" handler="manual" help="Display detailed help about a command" manual="The manual command provides detailed information about running a command and the parameters the command accepts. Manu...
<contexts>
<UNIVERSAL>manual</UNIVERSAL>
<UNIVERSAL>man</UNIVERSAL>
</contexts>
</Command>
<Command name="ip" call_style="state" command="pre-loaded" handler="net" help="Returns the local ip address" topic="net" usage="ip">
<contexts ROOT="ip" />
</Command>
<Command name="status" call_style="state" command="pre-loaded" handler="general" help="Display general TCLI control status" topic="general" usage="status or /status">
<contexts UNIVERSAL="status" />
</Command>
<Command name="exit" call_style="state" command="pre-loaded" handler="exit" help="exit the current context, returning to previous context" manual="exit, or '..' for the Unix geeks, will change the context back one level. See 'manual context' for more...
" topic="general" usage="exit or /exit">
<contexts>
<UNIVERSAL>exit</UNIVERSAL>
<UNIVERSAL>..</UNIVERSAL>
</contexts>
</Command>
<Command name="debug_request" call_style="state" command="pre-loaded" handler="general" help="show what the request object contains" topic="admin" usage="debug_request <some other args>">
<contexts UNIVERSAL="debug_request" />
</Command>
<Command name="Hi" call_style="state" command="pre-loaded" handler="general" help="Greetings" topic="general" usage="Hi/Hello">
<contexts>
<ROOT>Hi</ROOT>
<ROOT>hi</ROOT>
<ROOT>Hello</ROOT>
<ROOT>hello</ROOT>
</contexts>
</Command>
<Command name="Verbose" call_style="state" command="pre-loaded" handler="general" help="changes the verbosity of output to logs" topic="admin" usage="Verbose">
<contexts UNIVERSAL="Verbose" />
</Command>
<Command name="Control" call_style="state" command="pre-loaded" handler="establish_context" help="show or set Control variables" topic="admin" usage="Control show local_address">
<contexts ROOT="Control" />
</Command>
<Command name="context" call_style="state" command="pre-loaded" handler="general" help="displays the current context" manual="Context can be somewhat difficult to understand when one thinks of normal command line interfaces that often retain context ...
put them all in an 'attack' context. Instead of typing 'attack one target=example.com', one could type 'attack' to change to the attack context then type 'one target=example.com' followed by 'two target=example.com' etc.
Furthermore, a well written package will support the setting of default parameters for use within a context. One can then say:
attack
set target=example.com
one
two
...
The full command 'attack one target=example.com' must always be supported, but using context makes it easier to do repetitive tasks manually as well as allow one to navigate through a command syntax that one's forgotten the details of without too muc...
Context has a sense of depth, as in how many commands one has in front of whatever one is currently typing. An alias to the context command is 'pwd' which stands for Present Working Depth. Though it may make the Unix geeks happy, they should remember...
<contexts>
<UNIVERSAL>context</UNIVERSAL>
<UNIVERSAL>pwd</UNIVERSAL>
</contexts>
</Command>
<Command name="help" call_style="state" command="pre-loaded" handler="help" help="Display help about available commands" manual="The help command provides summary information about running a command and the parameters the command accepts. Help with n...
<contexts UNIVERSAL="help" />
</Command>
<Command name="dumpcmd" call_style="state" command="pre-loaded" handler="dumpcmd" help="Dump the registered command hash information" topic="admin" usage="dumpcmd <cmd>">
<contexts UNIVERSAL="dumpcmd" />
</Command></package>
lib/auto/Agent/TCLI/Package/Base/config.xml view on Meta::CPAN
<package>
<Parameter name="int5" help="integer five" manual="This is the manual text." type="integer">
<constraints>INT</constraints>
</Parameter>
<Parameter name="int6" help="integer six" manual="This is the manual text." type="integer">
<constraints>INT</constraints>
</Parameter>
<Parameter name="int7" help="integer seven" manual="This is some longer manual text that is supposed to be parsed by xml in this format. It is unclear from the YAML.pm pod how the indenting is supposed to be done on this type of text. Also, any use...
<constraints>INT</constraints>
</Parameter>
<Command name="showx" call_style="session" command="test3" handler="show" help="shows things that need showing" topic="attack prep" usage="<context> show <something>">
<contexts meganat="showx" noresets="showx">
<test1 UNIVERSAL="showx">
<test1.1 test1.1.1="showx" test1.1.2="showx" test1.1.3="showx" />
<test1.2 UNIVERSAL="showx" />
<test1.3 UNIVERSAL="showx" />
</test1>
</contexts>
</Command>
<Command name="cmd4" call_style="session" command="test4" handler="cmd4" help="cmd4 help" topic="test" usage="cmd4 usage">
<contexts ROOT="cmd4" />
<parameters int5="" int6="" />
</Command>
<Command name="cmd5" call_style="state" command="test5" handler="cmd5" help="cmd5 help" topic="test" usage="cmd5 usage">
<contexts ROOT="cmd5" />
<parameters int1="" int5="" int6="" int7="" />
</Command>
</package>
t/TCLI.Command.BuildCommandLine.t view on Meta::CPAN
type => 'Switch',
cl_option => '-s',
);
my $test1 = Agent::TCLI::Command->new(
'name' => 'cmd1',
'contexts' => {'/' => 'cmd1'},
'help' => 'cmd1 help',
'usage' => 'cmd1 usage',
'topic' => 'test',
'call_style'=> 'session',
'command' => 'test1',
'handler' => 'cmd1',
'parameters' => {
'test_verbose' => $verbose,
'text1' => $text1,
'int1' => $int1,
'switch' => $switch,
},
'verbose' => 0,
);
my $test2 = Agent::TCLI::Command->new(
'name' => 'cmd2',
'contexts' => {'/' => 'cmd2'},
'help' => 'cmd2 help',
'usage' => 'cmd2 usage',
'topic' => 'test',
'call_style'=> 'session',
'command' => 'test2',
'handler' => 'cmd2',
'cl_options' => '--req',
'parameters' => {
'test_verbose' => $verbose,
'text1' => $text1,
'int1' => $int1,
'switch' => $switch,
},
'verbose' => 0,
t/TCLI.Command.GetoptLucid.t view on Meta::CPAN
default => 'default',
);
my %cmd1 = (
'name' => 'cmd1',
'contexts' => {'/' => 'cmd1'},
'help' => 'cmd1 help',
'usage' => 'cmd1 usage',
'topic' => 'test',
'call_style'=> 'session',
'command' => 'test1',
'handler' => 'cmd1',
'parameters' => {
'test_verbose' => $verbose,
'paramint' => $paramint,
},
'verbose' => 0,
);
my %cmd2 = (
'name' => 'cmd2',
'contexts' => {'/' => 'cmd2'},
'help' => 'cmd2 help',
'usage' => 'cmd2 usage',
'topic' => 'test',
'call_style'=> 'state',
'command' => 'test2',
'handler' => 'cmd2',
'parameters' => {
'test_verbose' => $verbose,
'paramA' => $paramA,
},
'verbose' => 0,
);
#use warnings;
t/TCLI.Command.GetoptLucid.t view on Meta::CPAN
# Test help get-set methods
is($test1->help,'cmd1 help', '$test1->help get from init args');
ok($test2->help('cmd2 help'),'$test2->help set ');
is($test2->help,'cmd2 help', '$test2->help get from set');
# Test usage get-set methods
is($test1->usage,'cmd1 usage', '$test1->usage get from init args');
ok($test2->usage('cmd2 usage'),'$test2->usage set ');
is($test2->usage,'cmd2 usage', '$test2->usage get from set');
# Test call_style get-set methods
is($test1->call_style,'session', '$test1->call_style get from init args');
ok($test2->call_style('state'),'$test2->call_style set ');
is($test2->call_style,'state', '$test2->call_style get from set');
# Test command get-set methods
is($test1->command,'test1', '$test1->command get from init args');
ok($test2->command('test2'),'$test2->command set ');
is($test2->command,'test2', '$test2->command get from set');
# Test handler get-set methods
is($test1->handler,'cmd1', '$test1->handler get from init args');
ok($test2->handler('cmd2'),'$test2->handler set ');
is($test2->handler,'cmd2', '$test2->handler get from set');
t/TCLI.Command.t view on Meta::CPAN
BEGIN {
use_ok('Agent::TCLI::Command');
}
my %cmd1 = (
'name' => 'cmd1',
'contexts' => {'/' => 'cmd1'},
'help' => 'cmd1 help',
'usage' => 'cmd1 usage',
'topic' => 'test',
'call_style'=> 'session',
'command' => 'test1',
'handler' => 'cmd1',
);
my %cmd2 = (
'name' => 'cmd2',
'contexts' => {'/' => 'cmd2'},
'help' => 'cmd2 help',
'usage' => 'cmd2 usage',
'topic' => 'test',
'call_style'=> 'state',
'command' => 'test2',
'handler' => 'cmd2',
);
#use warnings;
#use strict;
my $test1 = Agent::TCLI::Command->new(%cmd1);
my $test2 = Agent::TCLI::Command->new(%cmd2);
t/TCLI.Command.t view on Meta::CPAN
# Test help get-set methods
is($test1->help,'cmd1 help', '$test1->help get from init args');
ok($test2->help('cmd2 help'),'$test2->help set ');
is($test2->help,'cmd2 help', '$test2->help get from set');
# Test usage get-set methods
is($test1->usage,'cmd1 usage', '$test1->usage get from init args');
ok($test2->usage('cmd2 usage'),'$test2->usage set ');
is($test2->usage,'cmd2 usage', '$test2->usage get from set');
# Test call_style get-set methods
is($test1->call_style,'session', '$test1->call_style get from init args');
ok($test2->call_style('state'),'$test2->call_style set ');
is($test2->call_style,'state', '$test2->call_style get from set');
# Test command get-set methods
is($test1->command,'test1', '$test1->command get from init args');
ok($test2->command('test2'),'$test2->command set ');
is($test2->command,'test2', '$test2->command get from set');
# Test handler get-set methods
is($test1->handler,'cmd1', '$test1->handler get from init args');
ok($test2->handler('cmd2'),'$test2->handler set ');
is($test2->handler,'cmd2', '$test2->handler get from set');
t/TCLI.Control.Interactive.t view on Meta::CPAN
sub Init {
my @obj_cmds = (
Agent::TCLI::Command->new(
'name' => 'meganat',
'contexts' => {'ROOT' => 'meganat'},
'help' => 'sets up outbound NAT table from a predefined address block',
'usage' => 'meganat add target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'noreset',
'contexts' => {'ROOT' => 'noreset'},
'help' => 'sets up outbound filters to block TCP RESETS to target',
'usage' => 'noreset add target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'add',
'contexts' => {
'meganat' => 'add',
'noresets' => 'add',
},
'help' => 'adds an address block to a table',
'usage' => 'add target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'change_table',
),
Agent::TCLI::Command->new(
'name' => 'delete',
'contexts' => {
'meganat' => 'delete',
'noresets' => 'delete',
},
'help' => 'removes an address block from a table',
'usage' => 'delete target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'change_table',
),
Agent::TCLI::Command->new(
'name' => 'test_all',
'contexts' => {'ROOT' => 'test_all'},
'help' => 'under test_all is one handler for everything',
'usage' => 'test_all anything',
'topic' => 'all',
'call_style'=> 'session',
'command' => 'test_all',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'all',
'contexts' => {'test_all' => 'ALL'},
'help' => 'anything in context test_all',
'usage' => 'anything',
'topic' => 'all',
'call_style'=> 'session',
'command' => 'test_all',
'handler' => 'all',
),
Agent::TCLI::Command->new(
'name' => 'show',
'contexts' => {
'meganat' => 'show',
'noresets' => 'show',
'test1' => {
'GROUP' => 'show',
t/TCLI.Control.Interactive.t view on Meta::CPAN
'GROUP' => 'show',
},
'test1.3' => {
'GROUP' => 'show',
},
},
},
'help' => 'shows tables',
'usage' => 'show',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'show',
),
Agent::TCLI::Command->new(
'name' => 'test1',
'contexts' => {'ROOT' => 'test1'},
'help' => 'test1 help',
'usage' => 'test1 test1.1 test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'tcli-test',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'test1.1',
'contexts' => {
'test1' => ['test1.1','test1.2','test1.3',],
},
'help' => 'test1.1 help',
'usage' => 'test1.1 test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'tcli-test',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'test1.1.1',
'contexts' => {
'test1' => {
'test1.1' => ['test1.1.1','test1.1.2','test1.1.3'],
'test1.2' => ['test1.1.1','test1.1.2','test1.1.3'],
'test1.3' => ['test1.1.1','test1.1.2','test1.1.3'],
},
},
'help' => 'test1.1.1 help',
'usage' => 'test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'tcli-test',
'handler' => 'establish_context',
),
);
my @dc = (
{ #echo
name => 'echo',
help => 'Return what was said.',
usage => 'echo <something> or /echo ...',
topic => 'general',
command => 'pre-loaded',
contexts => ['UNIVERSAL'],
call_style => 'state',
handler => 'general'
},
{
name => 'Hi',
help => 'Greetings',
usage => 'Hi',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'Hello',
help => 'Greetings',
usage => 'Hello',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'hello',
help => 'Greetings',
usage => 'hello',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'hi',
help => 'Greetings',
usage => 'hi',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'context',
help => "displays the current context",
usage => 'context or /context',
topic => 'general',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
'name' => 'help',
'help' => 'Display help about available commands',
'usage' => 'help [ command ] or /help',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'help'
},
{
'help' => 'Display general CLI control status',
'usage' => 'status or /status',
'topic' => 'general',
'name' => 'status',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'general'
},
{
'name' => 'ROOT',
'help' => "restore root context, use '/command' for a one time switch",
'usage' => '/ ',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'exit',
},
{
name => 'load',
help => 'Load a new control package',
usage => 'load < PACKAGE >',
topic => 'admin',
command => sub {return ("load is currently diabled")}, #\&load,
call_style => 'sub',
},
{
'name' => 'listcmd',
'help' => 'Dump the registered commands in their contexts',
'usage' => 'listcmd (<context>)',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'listcmd',
},
{
'name' => 'dumpcmd',
'help' => 'Dump the registered command hash information',
'usage' => 'dumpcmd <cmd>',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'dumpcmd',
},
{
'name' => 'nothing',
'help' => 'Nothing is as it seems',
'usage' => 'nothing',
'topic' => 'general',
'command' => sub {return ("You said nothing, try 'help'")},
'call_style' => 'sub',
},
{
'name' => 'exit',
'help' => "exit the current context, returning to previous context",
'usage' => 'exit or /exit',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'exit',
},
);
return(@obj_cmds);
}
# put in sub so I could fold it in eclipse
my (@obj_cmds) = Init();
t/TCLI.Control.Interactive.t view on Meta::CPAN
});
# Put some extral commands in there
$test_base->AddCommands(
Agent::TCLI::Command->new(
'name' => 'test_all',
'contexts' => {'ROOT' => 'test_all'},
'help' => 'under test_all is one handler for everything',
'usage' => 'test_all anything',
'topic' => 'all',
'call_style'=> 'session',
'command' => 'base',
'handler' => 'establish_context',
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
),
Agent::TCLI::Command->new(
'name' => 'all',
'contexts' => {'test_all' => 'ALL'},
'help' => 'anything in context test_all',
'usage' => 'anything',
'topic' => 'all',
'call_style'=> 'session',
'command' => 'base',
'handler' => 'settings',
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
),
Agent::TCLI::Command->new(
'name' => 'show',
'contexts' => {
'ROOT' => 'show',
'test1' => {
t/TCLI.Control.Interactive.t view on Meta::CPAN
'GROUP' => 'show',
},
'test1.3' => {
'GROUP' => 'show',
},
},
},
'help' => 'shows configuration or other information',
'usage' => 'show',
'topic' => 'general',
'call_style'=> 'session',
'command' => 'base',
'handler' => 'show',
'parameters' => {
'name' => 1,
},
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
),
Agent::TCLI::Command->new(
'name' => 'test1',
'contexts' => {'ROOT' => 'test1'},
'help' => 'test1 is a test command',
'usage' => 'test1 test1.1 test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'base',
'handler' => 'establish_context',
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
),
Agent::TCLI::Command->new(
'name' => 'test1.x',
'contexts' => {
'test1' => ['test1.1','test1.2','test1.3',],
},
'help' => 'test1.x is a test command',
'usage' => 'test1.1 test 1.1.1',
'manual' => 'The test1.x series of commands are available within the test1 context and are containers for many subcommands. Their primary purpose if for testing TLCI.',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'base',
'handler' => 'establish_context',
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
),
Agent::TCLI::Command->new(
'name' => 'test1.1.y',
'contexts' => {
'test1' => {
'test1.1' => ['test1.1.1','test1.1.2','test1.1.3'],
'test1.2' => ['test1.1.1','test1.1.2','test1.1.3'],
'test1.3' => ['test1.1.1','test1.1.2','test1.1.3'],
},
},
'help' => 'test1.1.y is a test command',
'usage' => 'test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'base',
'handler' => 'establish_context',
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
),
Agent::TCLI::Command->new(
'name' => 'test1.2.1',
'contexts' => {
'test1' => {
'test1.1' => 'test1.2.1',
'test1.2' => 'test1.2.1',
'test1.3' => 'test1.2.1',
},
},
'help' => 'test1.2.1 is a test command',
'usage' => 'test 1.2.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'base',
'handler' => 'establish_context',
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
),
);
my $test_master = Agent::TCLI::Transport::Test->new({
'control_options' => {
t/TCLI.Control.t view on Meta::CPAN
sub Init {
my @obj_cmds = (
Agent::TCLI::Command->new(
'name' => 'meganat',
'contexts' => {'ROOT' => 'meganat'},
'help' => 'sets up outbound NAT table from a predefined address block',
'usage' => 'meganat add target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'noreset',
'contexts' => {'ROOT' => 'noreset'},
'help' => 'sets up outbound filters to block TCP RESETS to target',
'usage' => 'noreset add target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'add',
'contexts' => {
'meganat' => 'add',
'noresets' => 'add',
},
'help' => 'adds an address block to a table',
'usage' => 'add target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'change_table',
),
Agent::TCLI::Command->new(
'name' => 'delete',
'contexts' => {
'meganat' => 'delete',
'noresets' => 'delete',
},
'help' => 'removes an address block from a table',
'usage' => 'delete target=target.example.com',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'change_table',
),
Agent::TCLI::Command->new(
'name' => 'test_all',
'contexts' => {'ROOT' => 'test_all'},
'help' => 'under test_all is one handler for everything',
'usage' => 'test_all anything',
'topic' => 'all',
'call_style'=> 'session',
'command' => 'test_all',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'all',
'contexts' => {'test_all' => 'ALL'},
'help' => 'anything in context test_all',
'usage' => 'anything',
'topic' => 'all',
'call_style'=> 'session',
'command' => 'test_all',
'handler' => 'all',
),
Agent::TCLI::Command->new(
'name' => 'tshow',
'contexts' => {
'meganat' => 'tshow',
'noresets' => 'tshow',
'test1' => {
'GROUP' => 'tshow',
t/TCLI.Control.t view on Meta::CPAN
'GROUP' => 'tshow',
},
'test1.3' => {
'GROUP' => 'tshow',
},
},
},
'help' => 'shows tables',
'usage' => 'show',
'topic' => 'attack prep',
'call_style'=> 'session',
'command' => 'tcli-pf',
'handler' => 'show',
),
Agent::TCLI::Command->new(
'name' => 'test1',
'contexts' => {'ROOT' => 'test1'},
'help' => 'test1 help',
'usage' => 'test1 test1.1 test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'tcli-test',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'test1.1',
'contexts' => {
'test1' => ['test1.1','test1.2','test1.3',],
},
'help' => 'test1.1 help',
'usage' => 'test1.1 test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'tcli-test',
'handler' => 'establish_context',
),
Agent::TCLI::Command->new(
'name' => 'test1.1.1',
'contexts' => {
'test1' => {
'test1.1' => ['test1.1.1','test1.1.2','test1.1.3'],
'test1.2' => ['test1.1.1','test1.1.2','test1.1.3'],
'test1.3' => ['test1.1.1','test1.1.2','test1.1.3'],
},
},
'help' => 'test1.1.1 help',
'usage' => 'test 1.1.1',
'topic' => 'testing',
'call_style'=> 'session',
'command' => 'tcli-test',
'handler' => 'establish_context',
),
);
my @dc = (
{ #echo
name => 'echo',
help => 'Return what was said.',
usage => 'echo <something> or /echo ...',
topic => 'general',
command => 'pre-loaded',
contexts => ['UNIVERSAL'],
call_style => 'state',
handler => 'general'
},
{
name => 'Hi',
help => 'Greetings',
usage => 'Hi',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'Hello',
help => 'Greetings',
usage => 'Hello',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'hello',
help => 'Greetings',
usage => 'hello',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'hi',
help => 'Greetings',
usage => 'hi',
topic => 'Greetings',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
name => 'context',
help => "displays the current context",
usage => 'context or /context',
topic => 'general',
command => 'pre-loaded',
contexts => ['ROOT'],
call_style => 'state',
handler => 'general'
},
{
'name' => 'help',
'help' => 'Display help about available commands',
'usage' => 'help [ command ] or /help',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'help'
},
{
'help' => 'Display general CLI control status',
'usage' => 'status or /status',
'topic' => 'general',
'name' => 'status',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'general'
},
{
'name' => 'ROOT',
'help' => "restore root context, use '/command' for a one time switch",
'usage' => '/ ',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'exit',
},
{
name => 'load',
help => 'Load a new control package',
usage => 'load < PACKAGE >',
topic => 'admin',
command => sub {return ("load is currently diabled")}, #\&load,
call_style => 'sub',
},
{
'name' => 'listcmd',
'help' => 'Dump the registered commands in their contexts',
'usage' => 'listcmd (<context>)',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'listcmd',
},
{
'name' => 'dumpcmd',
'help' => 'Dump the registered command hash information',
'usage' => 'dumpcmd <cmd>',
'topic' => 'admin',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'dumpcmd',
},
{
'name' => 'nothing',
'help' => 'Nothing is as it seems',
'usage' => 'nothing',
'topic' => 'general',
'command' => sub {return ("You said nothing, try 'help'")},
'call_style' => 'sub',
},
{
'name' => 'exit',
'help' => "exit the current context, returning to previous context",
'usage' => 'exit or /exit',
'topic' => 'general',
'command' => 'pre-loaded',
'contexts' => ['UNIVERSAL'],
'call_style' => 'state',
'handler' => 'exit',
},
);
return(@obj_cmds);
}
# put in sub so I could fold it in eclipse
my (@obj_cmds) = Init();
t/TCLI.Package.Base.t view on Meta::CPAN
use_ok('Agent::TCLI::Package::Base');
use_ok('Agent::TCLI::Command');
use_ok('Agent::TCLI::Parameter');
my %cmd1 = (
'name' => 'cmd1',
'contexts' => {'/' => 'cmd1'},
'help' => 'cmd1 help',
'usage' => 'cmd1 usage',
'topic' => 'test',
'call_style'=> 'session',
'command' => 'test1',
'handler' => 'cmd1',
);
my %cmd2 = (
'name' => 'cmd2',
'contexts' => {'/' => 'cmd2'},
'help' => 'cmd2 help',
'usage' => 'cmd2 usage',
'topic' => 'test',
'call_style'=> 'session',
'command' => 'test1',
'handler' => 'cmd2',
);
my $cmd1 = Agent::TCLI::Command->new(%cmd1);
my $test1 = Agent::TCLI::Package::Base->new({
'name' => 'test1',
});
t/TCLI.Package.Base.t view on Meta::CPAN
help: integer four
type: Param
manual: >
This is some longer manual text that is supposed to be parsed by
Yaml in this format. It is unclear from the YAML.pm pod how the indenting is
supposed to be done on this type of text. Also, any use of non
alpha-numeric charaters is not described.
class: numeric
---
Agent::TCLI::Command:
call_style: session
command: tcli-pf
contexts:
meganat: show
noresets: show
test1:
'*U': show
test1.1:
test1.1.1: show
test1.1.2: show
test1.1.3: show
t/TCLI.Package.Base.t view on Meta::CPAN
'*U': show
test1.3:
'*U': show
handler: show
help: shows things that need showing
name: show
topic: attack prep
usage: '<context> show <something>'
---
Agent::TCLI::Command:
call_style: session
command: test1
contexts:
'/': cmd1
handler: cmd1
help: cmd1 help
name: cmd1
parameters:
int1:
int2:
topic: test
usage: cmd1 usage
---
Agent::TCLI::Command:
call_style: state
command: test2
contexts:
'/': cmd2
handler: cmd2
help: cmd2 help
name: cmd2
parameters:
int1:
int2:
int3:
t/TCLI.Package.Base.xml view on Meta::CPAN
<package>
<Parameter name="int5" help="integer five" manual="This is the manual text." type="integer">
<constraints>INT</constraints>
</Parameter>
<Parameter name="int6" help="integer six" manual="This is the manual text." type="integer">
<constraints>INT</constraints>
</Parameter>
<Parameter name="int7" help="integer seven" manual="This is some longer manual text that is supposed to be parsed by xml in this format. It is unclear from the YAML.pm pod how the indenting is supposed to be done on this type of text. Also, any use...
<constraints>INT</constraints>
</Parameter>
<Command name="showx" call_style="session" command="test3" handler="show" help="shows things that need showing" topic="attack prep" usage="<context> show <something>">
<contexts meganat="showx" noresets="showx">
<test1 UNIVERSAL="showx">
<test1.1 test1.1.1="showx" test1.1.2="showx" test1.1.3="showx" />
<test1.2 UNIVERSAL="showx" />
<test1.3 UNIVERSAL="showx" />
</test1>
</contexts>
</Command>
<Command name="cmd4" call_style="session" command="test4" handler="cmd4" help="cmd4 help" topic="test" usage="cmd4 usage">
<contexts ROOT="cmd4" />
<parameters int5="" int6="" />
</Command>
<Command name="cmd5" call_style="state" command="test5" handler="cmd5" help="cmd5 help" topic="test" usage="cmd5 usage">
<contexts ROOT="cmd5" />
<parameters int1="" int5="" int6="" int7="" />
</Command>
</package>
t/TCLI.Package.Tail.t view on Meta::CPAN
is($test1->name,'tcli_tail', '$test1->Name ');
my $test_c1 = $test1->commands();
is(ref($test_c1),'HASH', '$test1->Commands is a hash');
my $test_c1_0 = $test_c1->{'tail'};
is($test_c1_0->name,'tail', '$test_c1_0->name get from init args');
is($test_c1_0->usage,'tail file add file /var/log/messages', '$test_c1_0->usage get from init args');
is($test_c1_0->help,'tail a file', '$test_c1_0->help get from init args');
is($test_c1_0->topic,'testing', '$test_c1_0->topic get from init args');
is($test_c1_0->command,'tcli_tail', '$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');
my $function;
# In these tests I am mostly testing body, because I am testing the Command.
# for real test scripts using tail, testing with ok should suffice.
$t->is_body( 'tail','Context now: tail', 'Initialize context');
$t->is_body( 'file','Context now: tail file', 'tail file context');
$t->ok( 'add file README ', 'added file');
$t->like_body( 'exit',qr(Context now: tail), "Exit ok");
t/TCLI.Package.XMPP.t view on Meta::CPAN
'addressee' => 'self',
);
is($test1->name,'tcli_xmpp', '$test1->name correct');
my $test_c1 = $test1->commands();
is(ref($test_c1),'HASH', '$test1->Commands is a hash');
is($test_c1->{'xmpp'}->command,'tcli_xmpp', 'command xmpp command');
is($test_c1->{'xmpp'}->handler,'establish_context', 'command xmpp handler');
is($test_c1->{'xmpp'}->name,'xmpp', 'command xmpp name');
is($test_c1->{'xmpp'}->call_style,'session', 'command xmpp style');
$t->like_body('xmpp show group_mode',qr(named), "show group_mode");
$t->ok('xmpp change group_mode prefixed', "change group_mode prefixed");
$t->like_body('xmpp show group_mode',qr(prefixed), "show group_mode prefixed");
$t->ok('xmpp change group_mode log', "change group_mode log ");
$t->like_body('xmpp show group_mode',qr(log), "show group_mode log ");
$t->ok('xmpp change group_mode all', "change group_mode all");
$t->like_body('xmpp show group_mode',qr(all), "show group_mode all");
$t->ok('xmpp change group_mode named', "change group_mode named ");
$t->like_body('xmpp show group_mode',qr(named), "show group_mode named");
( run in 0.657 second using v1.01-cache-2.11-cpan-49f99fa48dc )