[rt-devel] [contrib] ScripAction: IsPattern
Bruce Campbell
bruce_campbell at ripe.net
Sun Dec 22 13:35:29 EST 2002
The attached ScripAction is basically, a range-based grep as applicable to
RT Transactions. It takes its patterns and ranges from the Template
object, and matches them against the current Transaction, eg:
body : -10 : : /^X-SamSpade-Version:\s*1\.14/
Search up to line 10 of the body for 'X-SamSpade-Version: 1.14'.
head : 5-15: : /^X-Mailer:\s*Sam\s*Spade/
Search the headers (lines 5 to 15) for 'X-Mailer: Sam Spade'
body : +30- : : /foo bar/
Search the last 30 lines for 'foo bar' (a contrived example)
all : : : ! /fnord/
Search all the text for any non-occurences of the word 'fnord'.
( If there are two blank lines immediately above, seek brighter attention )
Further documentation on specifying patterns is available in a 'perldoc'
of the attached file.
Suggested usage:
OnCreate IsPattern with template DieSamSpadeDie
Caution:
By itself, this ScripAction is pretty pointless. It doesn't send any
email; it doesn't set the status of the ticket, it just returns an
indicator as to whether the current transaction matched all of the
patterns in the template.
Dependencies:
Requires the usage of ScripDependencies ([fsck.com #1551]) to actually be
of use, which basically modifies RT::Transaction to allow you to chain
Scrips together to have rather complicated conditionals ( eg bouncing
messages matching particular patterns (in this case spam complaints
generated by an out of date Windows version of Sam Spade which is very
irritating) to another address, and auto-resolving the ticket without
bothering to send an autoreply to the requestor ).
( As a side note, I could have implemented this particular functionality
in the .procmailrc which is in front of the queue. However, there are
other reasons for doing it this way. ;) )
--
Bruce Campbell RIPE
Systems/Network Engineer NCC
www.ripe.net - PGP562C8B1B Operations/Security
-------------- next part --------------
# IsPattern - Checks the User's Comment field if they've sent too many
# mails to us recently. Has an implicit dependency on UpdateSquelch working.
# Copyright 2002 - Bruce Campbell <bruce_campbell at ripe.net>
=head1 NAME
RT::Action::IsPattern - Looks for a particular pattern.
=cut
package RT::Action::IsPattern;
require RT::Action::Generic;
@ISA = qw(RT::Action::Generic);
use RT::Date;
=head1 SYNOPSIS
This is an RT ScripAction, designed to be invoked as a Scrip (we're really
using it as a Conditional, but we get to use the patterns in the Template).
=head2 OnAnything IsPattern with template ParticularPatterns
All that it does is to check the template for particular patterns.
The IsApplicable returns undef if there are no patterns, or the number of
patterns.
The Commit returns 1 if they do all match, or undef if they do not.
This is intended to be part of a Scrip which is Depended on by AutoReplies
and Correspondence to see whether we need to send email. (see RT::ScripLink)
=head1 ARGUMENT OPTIONS
No Argument options are processed.
=head1 TEMPLATE OPTIONS
The acceptable patterns are defined in the Template in the following
format for each line:
=head2 all|head|body|sig : line-range : unspecified : /pattern/
The fields are separated by ':'. The first field can be 'head' or
'body', to search through the 'head' or 'body' of the message respectively.
Also, the 'sig' can also be searched, being defined as a subset of the body
after the first occurence of '^-- ', or 'all' can be searched, applying to
both the 'head' and the 'body'.
B<NOTE>: Ref BUGS section.
The second field is a range of lines to search, following the cut(1)
standard for lines, ie: 'N' - search only line N, begining from 1.
'N-' search from line N to end of section, inclusive.
'N-M' search from line N to line M, inclusive.
'-M' search from beginning of section to line M, inclusive.
B<NOTE>: By default, 'N' and 'M' are line numbers counting from the start
of the section. If '+' is prepended, they are used as line numbers counting
backwards from the end of the section.
If unspecified, assumes the entire section.
The third field is unspecified. Eventually the Author wishes to have
the possibilities of multiple pattern sets within one Template object,
and logical conditionals (AND, OR, XOR) within the sets, however hasn't
gotten around to writing this section of code.
The fourth field is a standard perl regex, inclosed in '/'. A '!' can be
placed before the beginning '/' to indicate the inverse of the condition.
Pattern modifiers can be placed after the closing '/'.
B<NOTE>: Placing a 's' or 'm' as a pattern modifier will apply the pattern
to the whole range specified, rather than the default line by line.
As the 'pattern' is eval'd, you will need to \ escape the @ symbol, and other
common gotchas.
=head1 EXAMPLE LINES
=head2 body : -10 : : /^X-SamSpade-Version:\s*1\.14/
Search up to line 10 of the body for 'X-SamSpade-Version: 1.14'.
=head2 head : : : /^X-Mailer:\s*Sam\s*Spade/
Search the headers for 'X-Mailer: Sam Spade'
=head2 body : -20 : : /^\s*ripe\.net::/
Search up to line 20 of the body for 'ripe.net::' (something that SamSpade
does)
=head2 body : +30- : : /foo bar/
Search the last 30 lines for 'foo bar' (a contrived example)
=head1 METHODS
=cut
=head2 Prepare
This checks the template for any patterns. It returns undef if no patterns
were found.
=cut
sub Prepare {
my $self=shift;
# Be default, we don't want to be Applicable to anything.
my $retval = undef;
my $msg = "No action done.";
# We want patterns.
my @patlist = ();
@patlist = split( '\n', $self->TemplateObj->Content );
my $loop=0;
foreach my $poppy( @patlist ){
# Easy elimination of baddies.
next if( $poppy !~ /^\s*(all|head|body|sig)\s*:/i );
# Split them apart. Note pattern can have ':' characters,
# so join them immediately.
my ($ltype, $lrange, $llogic, @tsplit) = split( /:/, $poppy );
my $lpat = join( ':', @tsplit );
# lowercase things
$ltype = lc( $ltype );
# Are things numeric?
next unless( $lrange =~ /^\s*[0-9\-\+ ]+\s*$/ );
# Is the pattern a pattern?
next unless( $lpat =~ /^\s*!?\s*\/.*\/[ismx]*\s*$/ );
# Yay. Add it to ourselves.
$self->{'_section'}[$loop] = $ltype;
$self->{'_range'}[$loop] = $lrange;
$self->{'_logic'}[$loop] = $llogic;
$self->{'_pattern'}[$loop] = $lpat;
# Increment counters.
$loop++;
$retval++;
}
if( ! defined( $retval ) ){
# $RT::Logger->debug( "$self: Prepare: Returning undef with $msg" );
}else{
$msg = "Found $loop patterns for evaluation";
# $RT::Logger->debug( "$self: Prepare: Returning $retval with $msg" );
}
return( $retval, $msg );
}
=head2 Commit
Returns undef if some or all of the patterns did NOT match, and returns
a count of matching patterns if all of them did match.
=cut
sub Commit {
my $self = shift;
my $retval = undef;
my $msg = "Nothing done";
## Grab the head, body and signature ahead of time.
my @headers = split( /\n/, $self->TransactionObj->Message->First->Headers() );
my $headmin = 0;
my $headmax = ( scalar @headers ) - 1;
#### XXXX - Ref BUGS section, this may not get everything.
my @body = split( /\n/, $self->TransactionObj->Content() );
my $bodymin = 0;
my $bodymax = ( scalar @body ) - 1;
## Deal with the sig - loop backwards until we find '-- ' as a line,
## and then loop forwards until the end for the sig.
my $gotsig = 0;
my @lsig = ();
my $loop=( scalar( @body ) ) - 1;
while( ( $loop >= 0 ) && ( $gotsig == 0 ) ) {
if( $body[$loop] =~ /^-- $/ ){
$gotsig=1;
while( $loop < scalar( @body ) ){
push @lsig, $body[$loop];
$loop++;
}
}
$loop--;
}
my $lsigmin = 0;
my $lsigmax = ( scalar @body ) - 1;
## Loop through our patterns.
$loop=0;
my $totmatched = 0;
while( defined( $self->{'_section'}[$loop] ) ){
my $curloop=$loop;
$loop++;
# $RT::Logger->debug("$self: Considering pattern $curloop" );
## Set up our current section.
my @curinput = ();
if( $self->{'_section'}[$curloop] eq 'all' ){
@curinput = (@headers, "\n", @body);
}elsif( $self->{'_section'}[$curloop] eq 'head' ){
@curinput = @headers;
}elsif( $self->{'_section'}[$curloop] eq 'body' ){
@curinput = @body;
}elsif( $self->{'_section'}[$curloop] eq 'sig' ){
@curinput = @lsig;
}else{
## We shouldn't get here.
# $RT::Logger->debug("$self: type is incorrect" );
next;
}
my $curmin = 0;
my $curmax = ( scalar( @curinput ) ) - 1;
## See whether we start on the range.
my $lmin = 0;
my $lmax = $curmax;
if( $self->{'_range'}[$curloop] =~ /^\s*(\+)?(\d+)\s*$/ ){
$lmin = $2;
if( defined( $1 ) ){
$lmin = $curmax - $lmin;
}
$lmax = $lmin;
}elsif( $self->{'_range'}[$curloop] =~ /^\s*-\s*(\+)?(\d+)\s*$/ ){
$lmax = $2;
if( defined( $1 ) ){
$lmax = $curmax - $lmax;
}
}elsif( $self->{'_range'}[$curloop] =~ /^\s*(\+)?(\d+)\s*-\s*(\+)?(\d+)\s*$/ ){
$lmin = $2;
$lmax = $4;
if( defined( $1 ) ){
$lmin = $curmax - $lmin;
}
if( defined( $3 ) ){
$lmax = $curmax - $lmax;
}
}elsif( $self->{'_range'}[$curloop] =~ /^\s*(\+)?(\d+)\s*-\s*$/ ){
$lmin = $2;
if( defined( $1 ) ){
$lmin = $curmax - $lmin;
}
}
## Make sure we can continue.
if( $lmax < $lmin ){
## Pah.
my $ltmp = $lmin;
$lmin = $lmax;
$lmax = $ltmp;
}
## If we're below 0.
if( $lmin < 0 ){
# $RT::Logger->debug("$self: min ($lmin) is < 0 " );
$lmin = 0;
}
## If we're exceeding our input.
if( $lmax > $curmax ){
# $RT::Logger->debug("$self: max ($lmax) is > the input " );
$lmax = $curmax;
}
## If something strange has gone wrong.
if( $lmin > $lmax ){
# $RT::Logger->debug("$self: min ($lmin) is > the max ($lmax) ");
next;
}
## We don't do anything with logic.
# $self->{'_logic'}[$curloop] = $llogic;
## Deal with the pattern. Finally.
next unless( $self->{'_pattern'}[$curloop] =~ /^\s*(!)?\s*\/(.+)\/([ismx]*)\s*$/ );
my $negation = $1;
my $pattern = $2;
my $modifer = $3;
my $lop = "=~";
# $RT::Logger->debug("$self: pattern is a pattern" );
if( defined( $negation ) ){
if( $negation =~ /^\s*!\s*$/ ){
$lop = "!~";
}
}
if( ! defined( $modifier ) ){
$modifier = "";
}
## Loop through doing matches, or collecting for the
## blob.
my $curblob = "";
my $this_loop = $lmin;
my $matched = 0;
while( $this_loop <= $lmax ){
my $this_line = $curinput[$this_loop];
# $RT::Logger->debug("$self: this_line is $this_line ");
if( $modifier =~ /[sm]/ ){
$curblob .= $this_line . "\n";
}else{
my $for_eval = "\$this_line $lop /$pattern/$modifier";
# $RT::Logger->debug("$self: this eval is $for_eval ");
if( eval $for_eval ){
# It matched.
$matched++;
}
}
$this_loop++;
}
## Test the whole lot if needed.
if( $modifier =~ /[sm]/ ){
chomp( $curblob );
my $for_eval = "\$curblob $lop /$pattern/$modifier";
# $RT::Logger->debug("$self: this eval is $for_eval ");
if( eval $for_eval ){
$matched++;
}
}
## Did we match?
if( $matched > 0 ){
$totmatched++;
}
}
## Did we get the right number of matches?
if( $totmatched == $loop ){
$retval = $totmatched;
$msg = "Matched $totmatched of expected $loop patterns";
}else{
$retval = undef;
$msg = "Only matched $totmatched of expected $loop patterns";
}
$RT::Logger->debug( "$self: Commit: Returning $retval with $msg" );
return( $retval, $msg );
}
=head1 BUGS
By default, only the body of the first attachment is parsed when 'body' is
specified (which met the Author's needs). Additional attachments are not
parsed. This would be a good thing to do, and it also would be a nice thing
to be able to parse an individual attachment (yet, this is a hint).
The Windows Version (1.14) of Sam Spade is infernally annoying in sending
complaints to the wrong entities.
=head1 AUTHOR
Bruce Campbell (F<bruce_campbell at ripe.net>),
the RIPE NCC (F<http://www.ripe.net/>).
All rights reserved. This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=head1 VERSION
$Revision: 1.2 $ $Date: 2002/12/22 17:44:25 $
=cut
1;
More information about the Rt-devel
mailing list