[rt-devel] Contrib: UpdateMessageId (RT2.0.x)

Bruce Campbell bruce_campbell at ripe.net
Wed Feb 27 15:55:41 EST 2002

The attached ScripAction will update the Attachments.MessageId field of
the parent attachment of a given mail (ie, the first one).  It is designed
to operate as part of a Global Scrip:

	OnIncomingEmail UpdateMessageId with template Blank

( The OnIncomingEmail condition is available from the RT2 2.0 contrib
  directory )

Caution: This functionality will be replaced by code in rt-mailgate in a
later release of RT2.  This is merely how I have chosen to implement
MessageId tracking on my own installation due to other factors.  Your
milage may vary.  May contain traces of nuts.

Caution: You will need to allow write access to the MessageId field in the
_ClassAccessible method of RT::Attachment .  You must know what you are
doing to take this step, or have certif{ied/able} RT technicians standing


                             Bruce Campbell                            RIPE
                   Systems/Network Engineer                             NCC
                 www.ripe.net - PGP562C8B1B                      Operations

-------------- next part --------------
# UpdateMessageId.pm - Updates an attachment's message id.
# $Id: UpdateMessageId.pm,v 1.3 2002/02/27 20:37:57 rt2 Exp $
# Bruce Campbell, RIPE NCC.

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

use RT::Interface::Email qw(ParseAddressFromHeader);

# We override the Prepare routine and return (0) if the condition is met.

sub Prepare  {
	my $self = shift;
        # We're only Prepare()d if we don't have a MessageId already.

	my $retval = undef;
	if( defined( $self->TransactionObj->Message->First->MessageId ) ){
		if( $self->TransactionObj->Message->First->MessageId =~ /^\s*$/ ){
			$retval = 1;
		$retval = 1;

	return( $retval );

sub Commit {
	my $self = shift;

	# We're going to find a MessageId from the Headers, and set it.
	my $retval = undef;

	# Suck the address and Name of the sender out of the header
	my @Headers = split( /\n/, $self->TransactionObj->Message->First->Headers);

	my $ln_mtch = undef;
	foreach my $ln( @Headers ){
		if( $ln =~ m/^(Message-Id):\s+(.*)$/ ){
			my $mtmp = $1;
			my $mtch = $2;
			$mtch =~ s/^\s*//g;
			$mtch =~ s/\s*$//g;
			$mtch =~ s/^<//g;
			$mtch =~ s/>$//g;
			# Only grab the first one.
			if( ! defined( $ln_mtch ) ){
				$ln_mtch = $mtch;

	if( defined( $ln_mtch ) ){				

		$retval = $self->TransactionObj->Message->First->SetMessageId( $ln_mtch );

		$RT::Logger->debug("$self: Added $ln_mtch to attachment id#" . $self->TransactionObj->Message->First->id . "\n");


	return( $retval );

-------------- 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 => 'UpdateMessageId',
			Description =>  'Updates the MessageId field of the primary attachment if blank.',
			ExecModule => 'UpdateMessageId',
			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