diff options
Diffstat (limited to 'rt')
| -rw-r--r-- | rt/etc/initialdata | 90 | ||||
| -rw-r--r-- | rt/lib/RT/Action/ExtractCustomFieldValues.pm | 234 | ||||
| -rw-r--r-- | rt/lib/RT/Action/ExtractCustomFieldValuesWithCodeInTemplate.pm | 30 | ||||
| -rw-r--r-- | rt/lib/RT/Extension/ExtractCustomFieldValues.pm | 116 | 
4 files changed, 470 insertions, 0 deletions
| diff --git a/rt/etc/initialdata b/rt/etc/initialdata index edf93fe43..ba43c775e 100644 --- a/rt/etc/initialdata +++ b/rt/etc/initialdata @@ -675,3 +675,93 @@ Hour:         { $SubscriptionObj->SubValue('Hour') }    }  ); +# -*- perl -*- + +@ScripActions = ( + +    { Name        => 'Extract Custom Field Values',          # loc +      Description => 'extract cf-values out of a message',    # loc +      ExecModule  => 'ExtractCustomFieldValues' }, + +    { Name        => 'Extract Custom Field Values With Code in Template', # loc +      Description => 'extract cf-values out of a message with a Text::Template template',    # loc +      ExecModule  => 'ExtractCustomFieldValuesWithCodeInTemplate' } + +); + +@Templates = ( +    {  Queue       => '0', +       Name        => 'CustomFieldScannerExample',                     # loc +       Description => 'Example Template for ExtractCustomFieldValues', # loc +       Content     => <<'EOTEXT' +#### Syntax: +# CF Name | Header name or "Body" | MatchString(re) | Postcmd | Options + +#### Allowed Options: + +# q - (quiet) Don't record a transaction for adding the custom field +#     value +# * - (wildcard) The MatchString regex should contain _two_ +#     capturing groups, the first of which is the CF name, +#     the second of which is the value.  If this option is +#     given, the <cf-name> field is ignored. + +#### Examples: + +# 1. Put the content of the "X-MI-Test" header into the "testcf" +#    custom field: +# testcf|X-MI-Test|.* + +# 2. Scan the body for Host:name and put name into the "bodycf" custom +#    field: +# bodycf|Body|Host:\s*(\w+) + +# 3. Scan the "X-MI-IP" header for an IP-Adresse and get the hostname +#    by reverse-resolving it: +# Hostname|X-MI-IP|\d+\.\d+\.\d+\.\d+|use Socket; ($value) = gethostbyaddr(inet_aton($value),AF_INET); + +# 4. scan the "CC" header for an many email addresses, and add them to +#    a custom field named "parsedCCs". If "parsedCCs" is a multivalue +#    CF, then this should yield separate values for all email adress +#    found. +# parsedCCs|CC|.*|$value =~ s/^\s+//; $value =~ s/\s+$//; + +# 5. Looks for an "Email:" field in the body of the email, then loads +#    up that user and makes them privileged The blank first field +#    means the automatic CustomField setting is not invoked. +# |Body|Email:\s*(.+)$|my $u = RT::User->new($RT::SystemUser); $u->LoadByEmail($value); $u->SetPrivileged(1)| + +# 6. Looks for any text of the form "Set CF Name: Value" in the body, +#    and sets the CF named "CF Name" to the given value, which may be +#    multi-line.  The '*' option controls the wildcard nature of this +#    example. +# Separator=! +# !Body!^Set ([^\n:]*?):\s*((?s).*?)(?:\Z|\n\Z|\n\n)!!* + +# 7. Looks for the regex anywhere in the headers and stores the match +#    in the AllHeaderSearch CF +# AllHeaderSearch|Headers|Site:\s*(\w+) + +# 8. If you need to dynamically build your matching, and want to trigger on headers and body +#    and invode some arbitrary code like example 5 +# Separator=~~ +# { +#    my $action = 'use My::Site; My::Site::SetSiteID( Ticket => $self->TicketObj, Site => $_ );'; +# +#    for my $regex (My::Site::ValidRegexps) { +#        for my $from ('headers', 'body') { +#            $OUT .= join '~~', +#                '', # CF name +#                $from, +#                $regex, +#                $action; +#            $OUT .= "\n"; +#        } +#    } +# } + +EOTEXT +    } +); + +1; diff --git a/rt/lib/RT/Action/ExtractCustomFieldValues.pm b/rt/lib/RT/Action/ExtractCustomFieldValues.pm new file mode 100644 index 000000000..15aa469f0 --- /dev/null +++ b/rt/lib/RT/Action/ExtractCustomFieldValues.pm @@ -0,0 +1,234 @@ +package RT::Action::ExtractCustomFieldValues; +require RT::Action; + +use strict; +use warnings; + +use base qw(RT::Action); + +our $VERSION = 2.99_01; + +sub Describe { +    my $self = shift; +    return ( ref $self ); +} + +sub Prepare { +    return (1); +} + +sub FirstAttachment { +    my $self = shift; +    return $self->TransactionObj->Attachments->First; +} + +sub Queue { +    my $self = shift; +    return $self->TicketObj->QueueObj->Id; +} + +sub TemplateContent { +    my $self = shift; +    return $self->TemplateObj->Content; +} + +sub TemplateConfig { +    my $self = shift; + +    my ($content, $error) = $self->TemplateContent; +    if (!defined($content)) { +        return (undef, $error); +    } + +    my $Separator = '\|'; +    my @lines = split( /[\n\r]+/, $content); +    my @results; +    for (@lines) { +        chomp; +        next if /^#/; +        next if /^\s*$/; +        if (/^Separator=(.+)$/) { +            $Separator = $1; +            next; +        } +        my %line; +        @line{qw/CFName Field Match PostEdit Options/} +            = split(/$Separator/); +        $_ = '' for grep !defined, values %line; +        push @results, \%line; +    } +    return \@results; +} + +sub Commit { +    my $self            = shift; +    return 1 unless $self->FirstAttachment; + +    my ($config_lines, $error) = $self->TemplateConfig; + +    return 0 if $error; + +    for my $config (@$config_lines) { +        my %config = %{$config}; +        $RT::Logger->debug( "Looking to extract: " +                . join( " ", map {"$_=$config{$_}"} sort keys %config ) ); + +        if ( $config{Options} =~ /\*/ ) { +            $self->FindContent( +                %config, +                Callback    => sub { +                    my $content = shift; +                    my $found = 0; +                    while ( $content =~ /$config{Match}/mg ) { +                        my ( $cf, $value ) = ( $1, $2 ); +                        $cf = $self->LoadCF( Name => $cf, Quiet => 1 ); +                        next unless $cf; +                        $found++; +                        $self->ProcessCF( +                            %config, +                            CustomField => $cf, +                            Value       => $value +                        ); +                    } +                    return $found; +                }, +            ); +        } else { +            my $cf; +            $cf = $self->LoadCF( Name => $config{CFName} ) +                if $config{CFName}; + +            $self->FindContent( +                %config, +                Callback    => sub { +                    my $content = shift; +                    return 0 unless $content =~ /($config{Match})/m; +                    $self->ProcessCF( +                        %config, +                        CustomField => $cf, +                        Value       => $2 || $1, +                    ); +                    return 1; +                } +            ); +        } +    } +    return (1); +} + +sub LoadCF { +    my $self = shift; +    my %args            = @_; +    my $CustomFieldName = $args{Name}; +    $RT::Logger->debug( "Looking for CF $CustomFieldName"); + +    # We do this by hand instead of using LoadByNameAndQueue because +    # that can find disabled queues +    my $cfs = RT::CustomFields->new($RT::SystemUser); +    $cfs->LimitToGlobalOrQueue($self->Queue); +    $cfs->Limit( +        FIELD         => 'Name', +        VALUE         => $CustomFieldName, +        CASESENSITIVE => 0 +    ); +    $cfs->RowsPerPage(1); + +    my $cf = $cfs->First; +    if ( $cf && $cf->id ) { +        $RT::Logger->debug( "Found CF id " . $cf->id ); +    } elsif ( not $args{Quiet} ) { +        $RT::Logger->error( "Couldn't load CF $CustomFieldName!"); +    } + +    return $cf; +} + +sub FindContent { +    my $self = shift; +    my %args = @_; +    if ( lc $args{Field} eq "body" ) { +        my $Attachments  = $self->TransactionObj->Attachments; +        my $LastContent  = ''; +        my $AttachmentCount = 0; + +        my @list = @{ $Attachments->ItemsArrayRef }; +        while ( my $Message = shift @list ) { +            $AttachmentCount++; +            $RT::Logger->debug( "Looking at attachment $AttachmentCount, content-type " +                                    . $Message->ContentType ); +            my $ct = $Message->ContentType; +            unless ( $ct =~ m!^(text/plain|message|text$)!i ) { +                # don't skip one attachment that is text/* +                next if @list > 1 || $ct !~ m!^text/!; +            } + +            my $content = $Message->Content; +            next unless $content; +            next if $LastContent eq $content; +            $RT::Logger->debug( "Examining content of body" ); +            $LastContent = $content; +            $args{Callback}->( $content ); +        } +    } elsif ( lc $args{Field} eq 'headers' ) { +        my $attachment = $self->FirstAttachment; +        $RT::Logger->debug( "Looking at the headers of the first attachment" ); +        my $content = $attachment->Headers; +        return unless $content; +        $RT::Logger->debug( "Examining content of headers" ); +        $args{Callback}->( $content ); +    } else { +        my $attachment = $self->FirstAttachment; +        $RT::Logger->debug( "Looking at $args{Field} header of first attachment" ); +        my $content = $attachment->GetHeader( $args{Field} ); +        return unless defined $content; +        $RT::Logger->debug( "Examining content of header" ); +        $args{Callback}->( $content ); +    } +} + +sub ProcessCF { +    my $self = shift; +    my %args = @_; + +    return $self->PostEdit(%args) +        unless $args{CustomField}; + +    my @values = (); +    if ( $args{CustomField}->SingleValue() ) { +        push @values, $args{Value}; +    } else { +        @values = split( ',', $args{Value} ); +    } + +    foreach my $value ( grep defined && length, @values ) { +        $value = $self->PostEdit(%args, Value => $value ); +        next unless defined $value && length $value; + +        $RT::Logger->debug( "Found value for CF: $value"); +        my ( $id, $msg ) = $self->TicketObj->AddCustomFieldValue( +            Field             => $args{CustomField}, +            Value             => $value, +            RecordTransaction => $args{Options} =~ /q/ ? 0 : 1 +        ); +        $RT::Logger->info( "CustomFieldValue (" +                . $args{CustomField}->Name +                . ",$value) added: $id $msg" ); +    } +} + +sub PostEdit { +    my $self = shift; +    my %args = @_; + +    return $args{Value} unless $args{Value} && $args{PostEdit}; + +    $RT::Logger->debug( "Running PostEdit for '$args{Value}'"); +    my $value = $args{Value}; +    local $_  = $value;    # backwards compatibility +    local $@; +    eval( $args{PostEdit} ); +    $RT::Logger->error("$@") if $@; +    return $value; +} + +1; diff --git a/rt/lib/RT/Action/ExtractCustomFieldValuesWithCodeInTemplate.pm b/rt/lib/RT/Action/ExtractCustomFieldValuesWithCodeInTemplate.pm new file mode 100644 index 000000000..e05966be2 --- /dev/null +++ b/rt/lib/RT/Action/ExtractCustomFieldValuesWithCodeInTemplate.pm @@ -0,0 +1,30 @@ +package RT::Action::ExtractCustomFieldValuesWithCodeInTemplate; +use strict; +use warnings; + +use base qw(RT::Action::ExtractCustomFieldValues); + +sub TemplateContent { +    my $self = shift; +    my $is_broken = 0; + +    my $content = $self->TemplateObj->Content; + +    my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $content); +    my $new_content = $template->fill_in( +        BROKEN => sub { +            my (%args) = @_; +            $RT::Logger->error("Template parsing error: $args{error}") +                unless $args{error} =~ /^Died at /; # ignore intentional die() +            $is_broken++; +            return undef; +        }, +    ); + +    return (undef, $self->loc('Template parsing error')) if $is_broken; + +    return $new_content; +} + +1; + diff --git a/rt/lib/RT/Extension/ExtractCustomFieldValues.pm b/rt/lib/RT/Extension/ExtractCustomFieldValues.pm new file mode 100644 index 000000000..6731cf479 --- /dev/null +++ b/rt/lib/RT/Extension/ExtractCustomFieldValues.pm @@ -0,0 +1,116 @@ +use warnings; +use strict; + +package RT::Extension::ExtractCustomFieldValues; + +=head1 NAME + +RT::Extension::ExtractCustomFieldValues - extract CF values from email headers or body + +=cut + +our $VERSION = '3.07'; + +1; + +=head1 DESCRIPTION + +ExtractCustomFieldValues is based on a scrip action +"ExtractCustomFieldValues", which can be used to scan incoming emails +to set values of custom fields. + +=head1 INSTALLATION + +    perl Makefile.PL +    make +    make install +    make initdb # first time only, not on upgrades + +When using this extension with RT 3.8, you will need to add +extension to the Plugins configuration: + +    Set( @Plugins, qw(... RT::Extension::ExtractCustomFieldValues) ); + +If you are upgrading this extension from 3.05 or earlier, you will +need to read the UPGRADING file after running make install to add  +the new Scrip Action. + +=head1 USAGE + +To use the ScripAction, create a Template and a Scrip in RT. +Your new Scrip should use a ScripAction of 'Extract Custom Field Values'. +The Template consists of the lines which control the scanner. All +non-comment lines are of the following format: + +    <cf-name>|<Headername>|<MatchString>|<Postcmd>|<Options> + +where: + +=over 4 + +=item <cf-name> - the name of a custom field (must be created in RT) If this +field is blank, the match will be run and Postcmd will be executed, but no +custom field will be updated. Use this if you need to execute other RT code +based on your match. + +=item <Headername> - either a Name of an email header, "body" to scan the body +of the email or "headers" to search all of the headers. + +=item <MatchString> - a regular expression to find a match in the header or +body if the MatchString matches a comma separated list and the CF is a multi +value CF then each item in the list is added as a separate value. + +=item <Postcmd>  - a perl code to be evaluated on C<$value>, where C<$value> is +either $1 or full match text from the match performed with <MatchString> + +=item <Options> - a string of letters which may control some aspects.  Possible +options include: + +=over 4 + +=item 'q' - (quiet) Don't record a transaction when adding the custom field value + +=item '*' - (wildcard) The MatchString regex should contain _two_ capturing +groups, the first of which is the CF name, the second of which is the value. +If this option is given, the <cf-name> field is ignored. + +=back + +=back + +=head2 Separator + +You can change the separator string (initially "\|") during the +template with: + +    Separator=<anyregexp> + +Changing the separator may be necessary, if you want to use a "|" in +one of the patterns in the controlling lines. + +=head2 Example and further reading + +An example template with some further examples is installed during +"make install" or "make insert-template". See the +CustomFieldScannerExample template for examples and further +documentation. + +=head1 AUTHOR + +This extension was originally written by Dirk Pape +E<lt>pape@inf.fu-berlin.deE<gt>. + +This version is modified by Best Practical for customer use +and maintained by Best Practical Solutions. + +=head1 BUGS + +Report bugs using L<http://rt.cpan.org> service, discuss on RT's +mailing lists, see also L</SUPPORT> + +=head1 SUPPORT + +Support requests should be referred to Best Practical +E<lt>sales@bestpractical.comE<gt>.   + +=cut | 
