Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
package Agent::TCLI::Package::Tail;
#
# $Id: Tail.pm 59 2007-04-30 11:24:24Z hacker $
#
=pod
=head1 NAME
Agent::TCLI::Package::Tail - A Tail command
=head1 SYNOPSIS
# Within a test script
use Agent::TCLI::Package::Tail;
# set the list of packages
my @packages = (
Agent::TCLI::Package::Tail->new({
'verbose' => \$verbose,
'do_verbose' => sub { diag( @_ ) },
}),
);
=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.
B<Agent::TCLI::Package::Tail> provides commands to set up filtered tails of files.
Tails can be established as a I<watch> which will report on every match, or as
a I<test> which supports use in a functional testing activity with discrete
matching and reporting characteristics. It supports regex matching of the lines.
It should support more complex testing where POE Filters deliver objects
that can be queryied in an OK test, but that has not been tested and is likely
buggy. An example of this use would be to have a POE Filter deliver Snort Alert
objects which could then be queried if their source addresess was in a range.
=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.
=cut
use warnings;
use strict;
use Object::InsideOut qw( Agent::TCLI::Package::Base );
use POE qw(Wheel::FollowTail);
use Agent::TCLI::Command;
use Agent::TCLI::Parameter;
use Agent::TCLI::Package::Tail::Line;
use Agent::TCLI::Package::Tail::Test;
use Getopt::Lucid qw(:all);
our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: Tail.pm 59 2007-04-30 11:24:24Z hacker $))[2];
=head2 ATTRIBUTES
These attrbiutes are generally internal and are probably only useful to
someone trying to enhance the functionality of this Package module.
It would be unusual to set any of these attributes on creation of the
package for an Agent. That doesn't mean you can't.
=over
=item files
A hash of the 'files' being tailed.
B<files> will only contain hash values.
=cut
my @files :Field
:Type('hash')
:All('files');
=item line_cache
An array for holding the last few lines to enable lookbacks
B<line_cache> will only contain Array values.
=cut
my @line_cache :Field
:Type('Array')
:Arg('name'=>'line_cache', 'default' => [ ] )
:Acc('line_cache');
=item test_queue
A queue of all the tests waiting to be activated by triggers
B<test_queue> will only contain Array values.
=cut
my @test_queue :Field
:Type('Array')
:All('test_queue');
=item active
A hash keyed on num of all the tests currently active.
B<active> will only contain hash values.
=cut
my @active :Field
:Type('hash')
:Arg('name'=>'active', 'default'=> { '0' => 1 } )
:Acc('active');
=item ordered
The default setting for ordered test processing.
B<ordered> should only contain boolean values.
=cut
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
}
elsif ( defined($params->{'seek'}) && $params->{'seek'} ne '' )
{
$seek{'Seek'} = $params->{'seek'}
}
my $wheel = POE::Wheel::FollowTail->new(
Filename => $params->{'file'}, # File to tail
Filter => $filter, # How to parse it
PollInterval => $interval, # How often to check it
InputEvent => 'Append', # Event to emit upon input
ErrorEvent => 'RunError', # Event to emit upon error
ResetEvent => 'FileReset', # Event to emit on file reset
%seek, # Can't have both seek & seekback
);
# TODO error checking
$self->Verbose('File ('.$params->{'file'}.') being watched by wheel ID('.$wheel->ID.') ' );
$self->SetWheel($wheel);
$self->SetWheelKey($wheel, 'source' => $params->{'file'} );
$files[$$self]{ $params->{'file'} } = { 'wheel' => $wheel->ID };
return (1);
}
=item Wally
This POE event handler doesn't do anything, because sometimes
we must have a state that doesn't respond to work requests.
For one never knows when we just throw some event out there if someone
else might pick it up by _default and do something with it.
This way we KNOW it won't get done.
=cut
sub Wally {
return 0;
# This way we KNOW it won't get done.
}
=item test
This POE event handler executes the test/watch commands. It is called by the
Control and takes a Request as an argument.
=cut
sub test {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
$self->Verbose("test: request ".$request->id." input(".$request->input.") ",1);
my $txt = '';
my $opt;
my $sub_command = $request->command->[0];
my $command = $request->command->[1];
# break down args
eval { $opt = Getopt::Lucid->getopt( [
Param("like"),
Param("unlike"),
Param("ok"),
Param("name"),
Param("max_lines|l"),
Param("match_times|t"),
Param("ttl"),
Switch('ordered'),
Switch('cache')->default(1),
Switch("verbose|v"),
Switch("feedback|f"),
], $request->args )};
if( $@ )
{
$self->Verbose('set: getopt lucid got ('.$@.') ');
$request->Respond($kernel, "Invalid Args: $@ !", 400);
return;
}
# Validate args
# Need to evolve this into being more automated code but not sure how yet.
# Probably should check that like and unlike and ok are not all set at once.
# someday....
$txt .= $self->NotRegex(qr($opt->get_like), "like" );
$txt .= $self->NotRegex(qr($opt->get_unlike), "unlike");
$txt .= $self->NotType($opt->get_ok, "ok", qr(code)i);
$txt .= $self->NotScalar($opt->get_name, "name" );
$txt .= $self->NotPosInt($opt->get_max_lines, "max_lines");
$txt .= $self->NotPosInt($opt->get_match_times, "match_times");
$txt .= $self->NotPosInt($opt->get_ttl, "ttl" );
$txt .= $self->NotPosInt($opt->get_verbose, "verbose",);
$txt .= $self->NotPosInt($opt->get_feedback, "feedback",);
if( $txt )
{
$self->Verbose('test: paramter validation failed txt('.$txt.') ');
$request->Respond($kernel, "Invalid Args: ".$txt, 400);
return;
}
my ($testsub, $expr);
if ( defined( $opt->get_like ) )
{
$expr = $opt->get_like;
$testsub = sub { $_[0] =~ qr($expr); };
}
elsif ( defined( $opt->get_unlike ) )
{
$expr = $opt->get_unlike;
$testsub = sub { $_[0] !~ qr($expr); };
}
elsif ( defined( $opt->get_ok ) )
{
$expr = $opt->get_ok;
$testsub = $expr ;
}
unless ($testsub->($expr))
{
$self->Verbose('test: Whoops result is not true!!! ');
$self->Verbose('test: $expr('.$expr.') result('.$testsub->($expr).') ');
}
my $num = $self->depth_test_queue + 1;
my $name = defined( $opt->get_name ) && $opt->get_name ne ''
? $opt->get_name
: 'tail '.$expr;
my $birthtime = defined( $request->get_time )
? $request->get_time
: time();
my ($match_times, $max_lines, $ttl, $verbose, $feedback, $ordered,
$cache);
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
{
#I'm very tired....
# Need to get test num, and mark complete, cause if we delete it
# it will mess up numbering, but will marking as complete and not
# returning it suffice?
# mark complete
# remove state
}
return (1);
}
=item clear
This POE event handler executes the clear command. It is called by the
Control and takes a Request as an argument.
=cut
sub clear {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
$self->Verbose("clear: request ".$request->id );
my ($txt, $subtxt, $what);
$what = $request->command->[0];
if ( $what eq 'lines' )
{
$txt .= "Removing ".$self->depth_line_cache." lines.";
$self->set(\@line_cache,[ ]);
$self->Verbose("clear: ".$txt);
}
if (!defined($txt) || $txt eq '' )
{
$txt = "Cannot clear ".$what
}
$request->Respond($kernel, $txt, 200);
}
=item file
This POE event handler executes the file commands. It is called by the
Control and takes a Request as an argument.
=cut
sub file {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
my $txt = '';
my $opt;
my $command = $request->command->[0];
# break down args
eval { $opt = Getopt::Lucid->getopt( [
Param("file")->required(),
Param("filter"),
Param("interval"),
Param("seek"),
Param("seekback"),
], $request->args )};
if( $@ )
{
$self->Verbose('file: getopt lucid got ('.$@.') ');
$request->Respond($kernel, "Invalid Args: $@ !", 400);
return;
}
# Validate args
# Need to evolve this into being more automated code but not sure how yet.
$txt .= $self->NotScalar($opt->get_file, "file" );
$txt .= $self->NotType($opt->get_filter, "filter", qr(POE::Filter));
$txt .= $self->NotPosInt($opt->get_interval, "interval" );
$txt .= $self->NotPosInt($opt->get_seek, "seek");
$txt .= $self->NotPosInt($opt->get_seekback, "seekback");
if( $txt )
{
$self->Verbose('set: paramter validation failed txt('.$txt.') ');
$request->Respond($kernel, "Invalid Args: ".$txt, 400);
return;
}
elsif ($command eq 'add')
{
$kernel->yield( SetFollowTailWheel => {
'file' => $opt->get_file,
'filter' => $opt->get_filter,
'interval' => $opt->get_interval,
'seek' => $opt->get_seek,
'seekback' => $opt->get_seekback,
});
$request->Respond($kernel, "file ".$opt->get_file." added", 200);
}
elsif ($command eq 'delete')
{
my $wheel = $self->files->{ $opt->get_file }{'wheel'};
# SetWheel on a wheel ID removes the wheel reference, which
# should cause it to stop.
$self->SetWheel($wheel);
}
return (1);
}
=item settings
This POE event handler executes the set commands.
=cut
sub settings { # Can't call it set
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
my $txt = '';
my $opt;
my $command = $request->command->[0];
# TODO a way to unset/restore defaults....
# break down args
eval { $opt = Getopt::Lucid->getopt( [
Counter("test_verbose"),
Counter("test_feedback"),
Param("ordered"),
Param("interval"),
Param("line_max_cache"),
Param("line_hold_time"),
Param("test_max_lines"),
Param("test_match_times"),
Param("test_ttl"),
], $request->args )};
if( $@ )
{
$self->Verbose('set: getopt lucid got ('.$@.') ');
$request->Respond($kernel, "Invalid Args: $@ !", 400);
return;
}
# Validate args
# Need to evolve this into being more automated code but not sure how yet.
$txt .= $self->NotPosInt($opt->get_test_verbose, "test_verbose", 'set');
$txt .= $self->NotPosInt($opt->get_test_feedback, "test_feedback", 'set');
$txt .= $self->NotPosInt($opt->get_ordered, "ordered", 'set');
$txt .= $self->NotPosInt($opt->get_interval, "interval", 'set');
$txt .= $self->NotPosInt($opt->get_line_max_cache, "line_max_cache", 'set');
$txt .= $self->NotPosInt($opt->get_line_hold_time, "line_hold_time", 'set');
$txt .= $self->NotPosInt($opt->get_test_max_lines, "test_max_lines", 'set');
$txt .= $self->NotPosInt($opt->get_test_match_times, "test_match_times", 'set');
$txt .= $self->NotPosInt($opt->get_test_ttl, "test_ttl", 'set');
if( $txt )
{
$self->Verbose('set: paramter validation failed txt('.$txt.') ');
$request->Respond($kernel, "Invalid Args: ".$txt, 400);
return;
}
else
{
$request->Respond($kernel, 'ok', 200);
}
}
=item show
This POE event handler executes the show commands. It is called by the
Control and takes a Request as an argument.
=cut
#
# Now handled in base class
=item log
This POE event handler executes the log commands. It is called by the
Control and takes a Request as an argument.
=cut
sub log {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
$self->Verbose("log: request ".$request->id." input(".$request->input.") ");
my $txt = '';
my $opt;
my $command = $request->command->[0];
my $num = $self->depth_test_queue + 1;
if ($command eq 'log')
{
$self->Verbose("log: args dump \n 'name' => $request->input,\n 'num' => $num,\n'handler' => 'Log',\n'log_name' => 'Append',\n ",2);
$self->Verbose("log: self dump (".$self->dump(1).") ",4);
( run in 2.140 seconds using v1.01-cache-2.11-cpan-0d23b851a93 )