[rt-devel] Contrib: ScripAction UpdateSquelch

Bruce Campbell bruce_campbell at ripe.net
Sat Feb 2 08:39:57 EST 2002

Attached is a ScripAction which will update a User's Comments field based
on the number of Transactions created by the User in a given time period.

This is intended to be used in a Scrip as:

	OnIncomingEmail UpdateSquelch with template SquelchOptions

Full documentation is in the perldoc of UpdateSquelch.pm.  The short
explanation on using it is:

	Updates a User's Comment field with a magic (settable) text string
	if the User has created a large (settable) number of transactions
	in a small (settable) time period.  Will later remove the text
	string the next time the User creates a transaction and the number
	of transactions in the previous time period is below a (settable)

	The types of Transactions checks is also (settable), but in the
	ScripAction's Argument.  It defaults to 'Create', 'Correspond' and

	Note that you will need to create a wildcard pattern at the end of
	the Template to match everyone.  Obviously give 'preferred'
	addresses a higher rate by putting their patterns to the top of
	the Template.

The text string in the User's Comment field can be used in another
ScripAction, AutoReplySquelch, to avoid replying to a given user if that
User has created a huge number of transactions in the last time period.

	End story: Its attempting to stop run-away mail loops where the
	only constant is the email address (ie, X-Loop, etc isn't working
	as its not being preserved)

                             Bruce Campbell                            RIPE
                   Systems/Network Engineer                             NCC
                 www.ripe.net - PGP562C8B1B                      Operations
-------------- next part --------------
# UpdateSquelch - Update the User's Comment field if they've sent too many 
# mails to us recently.
# Copyright 2002 - Bruce Campbell <bruce_campbell at ripe.net>

=head1 NAME

RT::Action::UpdateSquelch - Updates the Squelch field used by AutoReplySquelch


package RT::Action::UpdateSquelch;
require RT::Action::Generic;
@ISA = qw(RT::Action::Generic);

use RT::Date;


This is an RT ScripAction, designed to be invoked as a Scrip:

=head2 OnIncomingEmail UpdateSquelch with template SquelchOptions

It first selects how many transactions the User of this transactions has
created over the previous time period.  It then adds or removes a magic
line in the User's Comment if the User is above or below the defined rate.


The template contains all the options used by this ScripAction.  It 
consists of a number of patterns, processed in sequential order until
a match for the User's email address is found.  Lines beginning 
with '#' are ignored as per normal comments convention.

Each pattern line reads something like (white-space seperation)

=head2 pattern time max below  # Text to add/remove to Comment

The 'pattern' can be any valid regex, but without the surrounding '/'s.  Use '\s' instead of whitespace to match whitespace.

( Note, if the closing '/' is supplied, anything after 
  the closing '/' will be used in the pattern match as 
  expected.  '/i' is the default.  ( Match address 
  irrespective of case )  )

As the 'pattern' is eval'd, you will need to \ escape the @ symbol, and other common gotchas.

The 'time' is the number of seconds to check back through the 
transactions history to find transactions from this user.  A 'time'
of '-1' prevents this user from being Squelched.

The 'max' is the maximum number of emails that must have come
from this person in 'time' before we apply the comment.

The 'below' is the maximum number of emails that must have come
from this person in 'time' before we remove the comment.

The text after the '#' is the text to add or remove to the User's
Comment field.  AutoReplySquelch is looking for the following

=head2 /^\s*autoreply\s+on\s+transaction(s)?\s*:\s*suppress\s*/mi

I would suggest that you put your text as something like:

=head2 Autoreply on transaction: suppress (Autogenerated)

This will allow this script to avoid removing suppressions that have
been added manually.

=head1 METHODS


=head2 CountTransactions( UserId, begin, end )

Takes a User ID and two time objects.  Returns a count of 
transactions initiated by this user (selecting on Transaction.Creator)
in the relevant timespan.

By default, we look for all Create, Correspond and Comment Type 
Transactions.  This can be overridden by using the Argument when
adding the Action to SQL (',' seperated).  This ignores where
the transaction originated from (Email or Web).  TANSTAAFL.

(ie, to identify the Email-sourced transactions without 
 walking through the Transaction's first Attachment 
 object's Headers appears to be awkward to do, without 
 doing excessive SQL work.  And thats what we want to 
 avoid in this routine)


sub CountTransactions {
	my $self = shift;

	# Grab the objects.
	my( $user, $begin, $end) = (@_);

	# Prepare the search.

	# The 'CurrentUser' may not be able to count the tickets.
	# (shouldn't really be doing this as SystemUser though :( )
	my $Transactions = new RT::Transactions( $RT::SystemUser );

	# Limits and Limits.
	# $Transactions->UnLimit();

	# The Creator
	$Transactions->Limit( ALIAS => 'main',
                              FIELD => 'Creator',
                              VALUE => $user,
                              OPERATOR => '=',

	# Transaction Types.
	my @types = ( 'Create', 'Comment', 'Correspond' );
	if( defined( $self->Argument ) ){
		@types = split( ',', $self->Argument ) unless( $self->Argument =~ /^\s*$/ );

	# Walk through the Types specified.
	foreach my $type ( @types ){
		$type =~ s/^\s*//g;
		$type =~ s/\s*$//g;
		next if( $type =~ /^\s*$/ );
		$Transactions->Limit( ALIAS => 'main',
				      FIELD => 'Type',
				      VALUE => $type,
				      OPERATOR => '=',
				      ENTRYAGGREGATOR => 'OR',

	# Time limitations
	$Transactions->Limit( ALIAS => 'main',
                              FIELD => 'Created',
                              VALUE => $begin->ISO,
                              ENTRYAGGREGATOR => 'AND',
                              OPERATOR => ">=" );
	$Transactions->Limit( ALIAS => 'main',
                              FIELD => 'Created',
                              VALUE => $end->ISO,
                              ENTRYAGGREGATOR => 'AND',
                              OPERATOR => "<=" );

	$RT::Logger->debug("$self: User is " . $user . ", Begin is " . $begin->ISO . ", End if " . $end->ISO . "\n");

	# Return a count only.
	return( $Transactions->Count() );

=head2 Prepare

This walks through the patterns in the Template to find a match.  Once 
this is found, we then (unless 'time' is '-1') find out how many 
transactions this user has done in the last 'time' seconds.

Return '1' if we should proceed to the Commit, and '0' if we shouldn't.

It also stores some information on itself between the Prepare and the 
Commit to determine whether we should add or remove the Comment.


sub Prepare {
	my $self=shift;

	# Be default, we don't want to Commit ourselves to anything.
	my $retval = 0;

	my $msg = "No action done.";

	# Get the list of patterns.
	my @patlst = split( '\n', $self->TemplateObj->Content );

	# Get the Email address.
	my $this_addr = $self->TransactionObj->CreatorObj->EmailAddress;

	# Walk through the patterns
	foreach my $this_line ( @patlst ){

		# $RT::Logger->debug("$self: Testing $this_line against $this_addr\n");
		# Ignore Comments
		next if( $this_line =~ /^\s*#/ );

		# Match our particular pattern line.
		next unless( $this_line =~ /^\s*(\S+)\s+(-)?(\d+)\s+(\d+)\s+(\d+)\s+#\s*(\S+.*)\s*$/ );

		# Store them.
		my ($pat, $neg, $secs, $max, $below, $comment) = ( $1, $2, $3, $4, $5, $6);

		# Make $secs negative.  (\d doesn't match '-')
		# Love perl's loose typing.
		if( defined( $neg ) ){
			$secs = $neg . $secs;

		# Set up the desired regex modifiers
		my $regex_mod = "i";

		# Check for extra modifiers for after the closing '/'.
		if( $pat =~ /^(.*)\/([imsx]*)$/ ){
			# Of course, the main use is simply putting '/'
			# to force a case-sensitive match, hence the '*'
			# above.

			# Store'em.
			($pat, $regex_mod) = ($1,$2);


		# Now we check for a match.  
		# if( $this_addr =~ /$pat/$regex_mod){

		# Build up the pattern.
		my $for_eval = "\$this_addr =~ /$pat/$regex_mod";

		# $RT::Logger->debug("$self: for_eval is $for_eval\n");

		# Eval it.
		if( eval $for_eval ){

			# Its a match.

			# $RT::Logger->debug("$self: Matched!\n");

			# Do we have the time?
			if( $secs >= 0 ){
				# We do.	

				# Set up the search.  Best done as seperate
				# function.

				# Get the Begin and End Date objects.
				my $begin = new RT::Date($RT::Nobody);
				my $end = new RT::Date($RT::Nobody);

				# The End Is Nigh^WNow.

				# Backtrack to the beginning.
				$begin->Set(Format => 'unix', Value => ( ($end->Unix) - $secs ) );

				# Count them.
				my $cnt = $self->CountTransactions( $self->TransactionObj->CreatorObj->id, $begin, $end );

				$RT::Logger->debug("$self: got back $cnt\n");

				# Is it above the max?
				if( $cnt > $max ){
					# We need to add the line.
					$self->{'Action'} = "add";
					$self->{'Text'} = $comment;
					$msg = "Transaction count of $cnt is above $max, adding $comment";
					$retval = 1;

				}elsif( $cnt < $below ){

					# We need to remove the line
					$self->{'Action'} = "del";
					$self->{'Text'} = $comment;
					$msg = "Transaction count of $cnt is below $below, deleting $comment";
					$retval = 1;


					# If its anything else, we don't
					# have to do anything.
					$msg = "Not updating, must be in between?";


				# We don't do anything for this user
				$msg = "Time is negative, ignoring this user";


			# No more patterns to be processed.

			# No match, continue on the next pattern.

	# $RT::Logger->debug( "$self: Prepare: Returning $retval with $msg" );
	return( $retval, $msg );

=head2 Commit

Checks whether the User's Comment field already has the text, then
checks whether to add or remove it.


sub Commit {
	my $self = shift;

	my $retval = 0;
	my $msg = "Nothing happened";
	# What are we doing?  Same as we do every night I guess.
	if( defined( $self->{'Action'} ) && defined( $self->{'Text'} ) ){

		# Oh, that.  Right, check the Comment field for the Text.
		if( $self->TransactionObj->CreatorObj->Comments =~ /^\s*$self->{'Text'}\s*$/mi ){

			# Its here, 

			if( $self->{'Action'} =~ /del/i ){

				# delete it.
				my $to_set = join( '\n', grep( !/^\s*$self->{'Text'}\s*$/i, split( /\n/, $self->TransactionObj->CreatorObj->Comments ) ) );

				# $RT::Logger->debug("$self: Comments being set to $to_set\n");
				$self->TransactionObj->CreatorObj->SetComments( $to_set );

				$retval = 1;
				$msg = "Deleted " . $self->{'Text'} . " from User Comments";

			}elsif( $self->{'Action'} =~ /add/i ){

				# If the pattern is here, we don't add it again.
				$msg = "Not adding " . $self->{'Text'} . " twice";
				$msg = "Odd Action supplied " . $self->{'Action'};
			# Pattern is not here.
			if( $self->{'Action'} =~ /del/i ){

				# Can't delete it.
				$msg = "Not deleting the non-existent."

			}elsif( $self->{'Action'} =~ /add/i ){
				# Can add it.
				$self->TransactionObj->CreatorObj->SetComments( $self->TransactionObj->CreatorObj->Comments . "\n" . $self->{'Text'} );

				$retval = 1;
				$msg = "Adding " . $self->{'Text'} . " to User Comments";
				$msg = "Odd Action supplied " . $self->{'Action'};

	# $RT::Logger->debug( "$self: Commit: Returning $retval with $msg" );
	return( $retval, $msg );

-------------- next part --------------
#!/usr/bin/perl -w

package RT;
use strict;
use vars qw($VERSION $Handle $Nobody $SystemUser $item);

use lib "/home/rt2/lib";
use lib "/home/rt2/etc";

#This drags in  RT's config.pm
use config;
use Carp;

use RT::Handle;
use RT::User;
use RT::CurrentUser;

#connect to the db
$RT::Handle = new RT::Handle($RT::DatabaseType);

#Put together a current user object so we can create a User object
my $CurrentUser = new RT::CurrentUser();

#now that we bootstrapped that little bit, we can use the standard RT cli
# helpers  to do what we need

use RT::Interface::CLI  qw(CleanEnv LoadConfig DBConnect 
			   GetCurrentUser GetMessageContent);

#Clean out all the nasties from the environment

#Load etc/config.pm and drop privs

#Connect to the database and get RT::SystemUser and RT::Nobody loaded


# {{{ ScripActions

my @ScripActions = (
			Name => 'UpdateSquelch',
			Description =>  'Updates arbitary text patterns in a User Comment field',
			ExecModule => 'UpdateSquelch',
			Argument =>  '',

# }}}
print "Creating ScripActions...";

use RT::ScripAction;
for $item (@ScripActions) {
    my $new_entry = new RT::ScripAction($CurrentUser);
    my $return = $new_entry->Create(%$item);
    print $return.".";

print "done.\n";



More information about the Rt-devel mailing list