From ed1f84b4e8f626245995ecda5afcf83092c153b2 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 15 Sep 2014 20:44:48 -0700 Subject: RT 4.0.22 --- rt/lib/.RT.pm.swp | Bin 0 -> 20480 bytes rt/lib/RT.pm | 22 +- rt/lib/RT.pm.orig | 887 +++++++ rt/lib/RT/.Handle.pm.swp | Bin 0 -> 61440 bytes rt/lib/RT/.Ticket.pm.swp | Bin 0 -> 16384 bytes rt/lib/RT/Action/CreateTickets.pm | 14 +- rt/lib/RT/Action/CreateTickets.pm.orig | 1292 +++++++++ rt/lib/RT/Action/SendEmail.pm | 39 +- rt/lib/RT/Action/SendEmail.pm.orig | 1131 ++++++++ rt/lib/RT/Attachment.pm | 32 +- rt/lib/RT/Config.pm | 1 - rt/lib/RT/Config.pm.orig | 1382 ++++++++++ rt/lib/RT/Crypt/GnuPG.pm | 7 +- rt/lib/RT/CurrentUser.pm | 5 +- rt/lib/RT/CustomField.pm.orig | 2170 +++++++++++++++ rt/lib/RT/Dashboard/Mailer.pm | 21 +- rt/lib/RT/EmailParser.pm | 6 +- rt/lib/RT/EmailParser.pm.orig | 692 +++++ rt/lib/RT/Generated.pm | 2 +- rt/lib/RT/I18N.pm | 33 +- rt/lib/RT/I18N/de.pm | 61 + rt/lib/RT/I18N/fr.pm | 68 + rt/lib/RT/Interface/Email.pm | 79 +- rt/lib/RT/Interface/Email.pm.orig | 1944 ++++++++++++++ rt/lib/RT/Interface/Email/Auth/GnuPG.pm | 4 +- rt/lib/RT/Interface/Web.pm | 57 +- rt/lib/RT/Interface/Web.pm.orig | 3454 ++++++++++++++++++++++++ rt/lib/RT/Interface/Web/Handler.pm | 6 +- rt/lib/RT/ObjectCustomFieldValue.pm | 3 +- rt/lib/RT/Record.pm | 124 +- rt/lib/RT/Record.pm.orig | 2102 +++++++++++++++ rt/lib/RT/Shredder.pm | 2 + rt/lib/RT/Template.pm | 29 +- rt/lib/RT/Test.pm | 24 +- rt/lib/RT/Ticket.pm | 35 +- rt/lib/RT/Ticket.pm.orig | 4379 +++++++++++++++++++++++++++++++ rt/lib/RT/Tickets.pm | 2 +- rt/lib/RT/Tickets.pm.orig | 3892 +++++++++++++++++++++++++++ rt/lib/RT/User.pm | 42 +- rt/lib/RT/Util.pm | 19 +- rt/lib/RTx/.Calendar.pm.swp | Bin 0 -> 20480 bytes rt/lib/RTx/.Schedule.pm.swp | Bin 0 -> 16384 bytes 42 files changed, 23765 insertions(+), 297 deletions(-) create mode 100644 rt/lib/.RT.pm.swp create mode 100644 rt/lib/RT.pm.orig create mode 100644 rt/lib/RT/.Handle.pm.swp create mode 100644 rt/lib/RT/.Ticket.pm.swp create mode 100644 rt/lib/RT/Action/CreateTickets.pm.orig create mode 100755 rt/lib/RT/Action/SendEmail.pm.orig create mode 100644 rt/lib/RT/Config.pm.orig create mode 100644 rt/lib/RT/CustomField.pm.orig create mode 100644 rt/lib/RT/EmailParser.pm.orig create mode 100644 rt/lib/RT/I18N/de.pm create mode 100644 rt/lib/RT/I18N/fr.pm create mode 100755 rt/lib/RT/Interface/Email.pm.orig create mode 100644 rt/lib/RT/Interface/Web.pm.orig create mode 100755 rt/lib/RT/Record.pm.orig create mode 100755 rt/lib/RT/Ticket.pm.orig create mode 100755 rt/lib/RT/Tickets.pm.orig create mode 100644 rt/lib/RTx/.Calendar.pm.swp create mode 100644 rt/lib/RTx/.Schedule.pm.swp (limited to 'rt/lib') diff --git a/rt/lib/.RT.pm.swp b/rt/lib/.RT.pm.swp new file mode 100644 index 000000000..55a25798e Binary files /dev/null and b/rt/lib/.RT.pm.swp differ diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm index e71d6c926..ec18caf51 100644 --- a/rt/lib/RT.pm +++ b/rt/lib/RT.pm @@ -52,6 +52,7 @@ use warnings; package RT; +use Encode (); use File::Spec (); use Cwd (); @@ -263,6 +264,9 @@ sub InitLogging { $frame++ while caller($frame) && caller($frame) =~ /^Log::/; my ($package, $filename, $line) = caller($frame); + # Encode to bytes, so we don't send wide characters + $p{message} = Encode::encode("UTF-8", $p{message}); + $p{'message'} =~ s/(?:\r*\n)+$//; return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " . $p{'message'} ." ($filename:$line)\n"; @@ -278,8 +282,8 @@ sub InitLogging { $frame++ while caller($frame) && caller($frame) =~ /^Log::/; my ($package, $filename, $line) = caller($frame); - # syswrite() cannot take utf8; turn it off here. - Encode::_utf8_off($p{message}); + # Encode to bytes, so we don't send wide characters + $p{message} = Encode::encode("UTF-8", $p{message}); $p{message} =~ s/(?:\r*\n)+$//; if ($p{level} eq 'debug') { @@ -382,19 +386,9 @@ sub InitSignalHandlers { ## mechanism (see above). $SIG{__WARN__} = sub { - # The 'wide character' warnings has to be silenced for now, at least - # until HTML::Mason offers a sane way to process both raw output and - # unicode strings. # use 'goto &foo' syntax to hide ANON sub from stack - if( index($_[0], 'Wide character in ') != 0 ) { - unshift @_, $RT::Logger, qw(level warning message); - goto &Log::Dispatch::log; - } - # Return value is used only by RT::Test to filter warnings from - # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever - # starts returning 'IGNORE', we'll need to switch to something more - # clever. I don't expect that to happen. - return 'IGNORE'; + unshift @_, $RT::Logger, qw(level warning message); + goto &Log::Dispatch::log; }; #When we call die, trap it and log->crit with the value of the die. diff --git a/rt/lib/RT.pm.orig b/rt/lib/RT.pm.orig new file mode 100644 index 000000000..e71d6c926 --- /dev/null +++ b/rt/lib/RT.pm.orig @@ -0,0 +1,887 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +use strict; +use warnings; + +package RT; + + +use File::Spec (); +use Cwd (); + +use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE); + +use vars qw($BasePath + $EtcPath + $BinPath + $SbinPath + $VarPath + $LexiconPath + $PluginPath + $LocalPath + $LocalEtcPath + $LocalLibPath + $LocalLexiconPath + $LocalPluginPath + $MasonComponentRoot + $MasonLocalComponentRoot + $MasonDataDir + $MasonSessionDir); + + +RT->LoadGeneratedData(); + +=head1 NAME + +RT - Request Tracker + +=head1 SYNOPSIS + +A fully featured request tracker package. + +This documentation describes the point-of-entry for RT's Perl API. To learn +more about what RT is and what it can do for you, visit +L. + +=head1 DESCRIPTION + +=head2 INITIALIZATION + +If you're using RT's Perl libraries, you need to initialize RT before using any +of the modules. + +You have the option of handling the timing of config loading and the actual +init sequence yourself with: + + use RT; + BEGIN { + RT->LoadConfig; + RT->Init; + } + +or you can let RT do it all: + + use RT -init; + +This second method is particular useful when writing one-liners to interact with RT: + + perl -MRT=-init -e '...' + +The first method is necessary if you need to delay or conditionalize +initialization or if you want to fiddle with C<< RT->Config >> between loading +the config files and initializing the RT environment. + +=cut + +{ + my $DID_IMPORT_INIT; + sub import { + my $class = shift; + my $action = shift || ''; + + if ($action eq "-init" and not $DID_IMPORT_INIT) { + $class->LoadConfig; + $class->Init; + $DID_IMPORT_INIT = 1; + } + } +} + +=head2 LoadConfig + +Load RT's config file. First, the site configuration file +(F) is loaded, in order to establish overall site +settings like hostname and name of RT instance. Then, the core +configuration file (F) is loaded to set fallback values +for all settings; it bases some values on settings from the site +configuration file. + +In order for the core configuration to not override the site's +settings, the function C is used; it only sets values if they +have not been set already. + +=cut + +sub LoadConfig { + require RT::Config; + $Config = RT::Config->new; + $Config->LoadConfigs; + require RT::I18N; + + # RT::Essentials mistakenly recommends that WebPath be set to '/'. + # If the user does that, do what they mean. + $RT::WebPath = '' if ($RT::WebPath eq '/'); + + # fix relative LogDir and GnuPG homedir + unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) { + $Config->Set( LogDir => + File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) ); + } + + my $gpgopts = $Config->Get('GnuPGOptions'); + unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) { + $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} ); + } + + return $Config; +} + +=head2 Init + +L, L, L, L, and L. + +=cut + +sub Init { + shift if @_%2; # code is inconsistent about calling as method + my %args = (@_); + + CheckPerlRequirements(); + + InitPluginPaths(); + + #Get a database connection + ConnectToDatabase(); + InitSystemObjects(); + InitClasses(%args); + InitLogging(%args); + InitPlugins(); + RT::I18N->Init; + RT->Config->PostLoadCheck; + +} + +=head2 ConnectToDatabase + +Get a database connection. See also L. + +=cut + +sub ConnectToDatabase { + require RT::Handle; + $Handle = RT::Handle->new unless $Handle; + $Handle->Connect; + return $Handle; +} + +=head2 InitLogging + +Create the Logger object and set up signal handlers. + +=cut + +sub InitLogging { + + my %arg = @_; + + # We have to set the record separator ($, man perlvar) + # or Log::Dispatch starts getting + # really pissy, as some other module we use unsets it. + $, = ''; + use Log::Dispatch 1.6; + + my %level_to_num = ( + map( { $_ => } 0..7 ), + debug => 0, + info => 1, + notice => 2, + warning => 3, + error => 4, 'err' => 4, + critical => 5, crit => 5, + alert => 6, + emergency => 7, emerg => 7, + ); + + unless ( $RT::Logger ) { + + $RT::Logger = Log::Dispatch->new; + + my $stack_from_level; + if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) { + # if option has old style '\d'(true) value + $stack_from_level = 0 if $stack_from_level =~ /^\d+$/; + $stack_from_level = $level_to_num{ $stack_from_level } || 0; + } else { + $stack_from_level = 99; # don't log + } + + my $simple_cb = sub { + # if this code throw any warning we can get segfault + no warnings; + my %p = @_; + + # skip Log::* stack frames + my $frame = 0; + $frame++ while caller($frame) && caller($frame) =~ /^Log::/; + my ($package, $filename, $line) = caller($frame); + + $p{'message'} =~ s/(?:\r*\n)+$//; + return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " + . $p{'message'} ." ($filename:$line)\n"; + }; + + my $syslog_cb = sub { + # if this code throw any warning we can get segfault + no warnings; + my %p = @_; + + my $frame = 0; # stack frame index + # skip Log::* stack frames + $frame++ while caller($frame) && caller($frame) =~ /^Log::/; + my ($package, $filename, $line) = caller($frame); + + # syswrite() cannot take utf8; turn it off here. + Encode::_utf8_off($p{message}); + + $p{message} =~ s/(?:\r*\n)+$//; + if ($p{level} eq 'debug') { + return "[$$] $p{message} ($filename:$line)\n"; + } else { + return "[$$] $p{message}\n"; + } + }; + + my $stack_cb = sub { + no warnings; + my %p = @_; + return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level; + + require Devel::StackTrace; + my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] ); + return $p{'message'} . $trace->as_string; + + # skip calling of the Log::* subroutins + my $frame = 0; + $frame++ while caller($frame) && caller($frame) =~ /^Log::/; + $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/; + + $p{'message'} .= "\nStack trace:\n"; + while( my ($package, $filename, $line, $sub) = caller($frame++) ) { + $p{'message'} .= "\t$sub(...) called at $filename:$line\n"; + } + return $p{'message'}; + }; + + if ( $Config->Get('LogToFile') ) { + my ($filename, $logdir) = ( + $Config->Get('LogToFileNamed') || 'rt.log', + $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ), + ); + if ( $filename =~ m![/\\]! ) { # looks like an absolute path. + ($logdir) = $filename =~ m{^(.*[/\\])}; + } + else { + $filename = File::Spec->catfile( $logdir, $filename ); + } + + unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) { + # localizing here would be hard when we don't have a current user yet + die "Log file '$filename' couldn't be written or created.\n RT can't run."; + } + + require Log::Dispatch::File; + $RT::Logger->add( Log::Dispatch::File->new + ( name=>'file', + min_level=> $Config->Get('LogToFile'), + filename=> $filename, + mode=>'append', + callbacks => [ $simple_cb, $stack_cb ], + )); + } + if ( $Config->Get('LogToScreen') ) { + require Log::Dispatch::Screen; + $RT::Logger->add( Log::Dispatch::Screen->new + ( name => 'screen', + min_level => $Config->Get('LogToScreen'), + callbacks => [ $simple_cb, $stack_cb ], + stderr => 1, + )); + } + if ( $Config->Get('LogToSyslog') ) { + require Log::Dispatch::Syslog; + $RT::Logger->add(Log::Dispatch::Syslog->new + ( name => 'syslog', + ident => 'RT', + min_level => $Config->Get('LogToSyslog'), + callbacks => [ $syslog_cb, $stack_cb ], + stderr => 1, + $Config->Get('LogToSyslogConf'), + )); + } + } + InitSignalHandlers(%arg); +} + +{ # Work around bug in Log::Dispatch < 2.30, wherein the short forms + # of ->warn, ->err, and ->crit do not usefully propagate out, unlike + # ->warning, ->error, and ->critical + package Log::Dispatch; + no warnings 'redefine'; + sub warn { shift->warning(@_) } + sub err { shift->error(@_) } + sub crit { shift->critical(@_) } +} + +sub InitSignalHandlers { + + my %arg = @_; + return if $arg{'NoSignalHandlers'}; + +# Signal handlers +## This is the default handling of warnings and die'ings in the code +## (including other used modules - maybe except for errors catched by +## Mason). It will log all problems through the standard logging +## mechanism (see above). + + $SIG{__WARN__} = sub { + # The 'wide character' warnings has to be silenced for now, at least + # until HTML::Mason offers a sane way to process both raw output and + # unicode strings. + # use 'goto &foo' syntax to hide ANON sub from stack + if( index($_[0], 'Wide character in ') != 0 ) { + unshift @_, $RT::Logger, qw(level warning message); + goto &Log::Dispatch::log; + } + # Return value is used only by RT::Test to filter warnings from + # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever + # starts returning 'IGNORE', we'll need to switch to something more + # clever. I don't expect that to happen. + return 'IGNORE'; + }; + +#When we call die, trap it and log->crit with the value of the die. + + $SIG{__DIE__} = sub { + # if we are not in eval and perl is not parsing code + # then rollback transactions and log RT error + unless ($^S || !defined $^S ) { + $RT::Handle->Rollback(1) if $RT::Handle; + $RT::Logger->crit("$_[0]") if $RT::Logger; + } + die $_[0]; + }; +} + + +sub CheckPerlRequirements { + if ($^V < 5.008003) { + die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V; + } + + # use $error here so the following "die" can still affect the global $@ + my $error; + { + local $@; + eval { + my $x = ''; + my $y = \$x; + require Scalar::Util; + Scalar::Util::weaken($y); + }; + $error = $@; + } + + if ($error) { + die <<"EOF"; + +RT requires the Scalar::Util module be built with support for the 'weaken' +function. + +It is sometimes the case that operating system upgrades will replace +a working Scalar::Util with a non-working one. If your system was working +correctly up until now, this is likely the cause of the problem. + +Please reinstall Scalar::Util, being careful to let it build with your C +compiler. Usually this is as simple as running the following command as +root. + + perl -MCPAN -e'install Scalar::Util' + +EOF + + } +} + +=head2 InitClasses + +Load all modules that define base classes. + +=cut + +sub InitClasses { + shift if @_%2; # so we can call it as a function or method + my %args = (@_); + require RT::Tickets; + require RT::Transactions; + require RT::Attachments; + require RT::Users; + require RT::Principals; + require RT::CurrentUser; + require RT::Templates; + require RT::Queues; + require RT::ScripActions; + require RT::ScripConditions; + require RT::Scrips; + require RT::Groups; + require RT::GroupMembers; + require RT::CustomFields; + require RT::CustomFieldValues; + require RT::ObjectCustomFields; + require RT::ObjectCustomFieldValues; + require RT::Attributes; + require RT::Dashboard; + require RT::Approval; + require RT::Lifecycle; + require RT::Link; + require RT::Links; + require RT::Article; + require RT::Articles; + require RT::Class; + require RT::Classes; + require RT::ObjectClass; + require RT::ObjectClasses; + require RT::ObjectTopic; + require RT::ObjectTopics; + require RT::Topic; + require RT::Topics; + + # on a cold server (just after restart) people could have an object + # in the session, as we deserialize it so we never call constructor + # of the class, so the list of accessible fields is empty and we die + # with "Method xxx is not implemented in RT::SomeClass" + + # without this, we also can never call _ClassAccessible, because we + # won't have filled RT::Record::_TABLE_ATTR + $_->_BuildTableAttributes foreach qw( + RT::Ticket + RT::Transaction + RT::Attachment + RT::User + RT::Principal + RT::Template + RT::Queue + RT::ScripAction + RT::ScripCondition + RT::Scrip + RT::Group + RT::GroupMember + RT::CustomField + RT::CustomFieldValue + RT::ObjectCustomField + RT::ObjectCustomFieldValue + RT::Attribute + RT::ACE + RT::Link + RT::Article + RT::Class + RT::ObjectClass + RT::ObjectTopic + RT::Topic + ); + + if ( $args{'Heavy'} ) { + # load scrips' modules + my $scrips = RT::Scrips->new(RT->SystemUser); + $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' ); + while ( my $scrip = $scrips->Next ) { + local $@; + eval { $scrip->LoadModules } or + $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ". + "You should delete or repair this Scrip in the admin UI.\n$@\n"); + } + + foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) { + local $@; + eval "require $class; 1" or $RT::Logger->error( + "Class '$class' is listed in CustomFieldValuesSources option" + ." in the config, but we failed to load it:\n$@\n" + ); + } + + } +} + +=head2 InitSystemObjects + +Initializes system objects: C<$RT::System>, C<< RT->SystemUser >> +and C<< RT->Nobody >>. + +=cut + +sub InitSystemObjects { + + #RT's system user is a genuine database user. its id lives here + require RT::CurrentUser; + $SystemUser = RT::CurrentUser->new; + $SystemUser->LoadByName('RT_System'); + + #RT's "nobody user" is a genuine database user. its ID lives here. + $Nobody = RT::CurrentUser->new; + $Nobody->LoadByName('Nobody'); + + require RT::System; + $System = RT::System->new( $SystemUser ); +} + +=head1 CLASS METHODS + +=head2 Config + +Returns the current L, but note that +you must L first otherwise this method +returns undef. + +Method can be called as class method. + +=cut + +sub Config { return $Config || shift->LoadConfig(); } + +=head2 DatabaseHandle + +Returns the current L. + +See also L. + +=cut + +sub DatabaseHandle { return $Handle } + +=head2 Logger + +Returns the logger. See also L. + +=cut + +sub Logger { return $Logger } + +=head2 System + +Returns the current L. See also +L. + +=cut + +sub System { return $System } + +=head2 SystemUser + +Returns the system user's object, it's object of +L class that represents the system. See also +L. + +=cut + +sub SystemUser { return $SystemUser } + +=head2 Nobody + +Returns object of Nobody. It's object of L class +that represents a user who can own ticket and nothing else. See +also L. + +=cut + +sub Nobody { return $Nobody } + +sub PrivilegedUsers { + if (!$_Privileged) { + $_Privileged = RT::Group->new(RT->SystemUser); + $_Privileged->LoadSystemInternalGroup('Privileged'); + } + return $_Privileged; +} + +sub UnprivilegedUsers { + if (!$_Unprivileged) { + $_Unprivileged = RT::Group->new(RT->SystemUser); + $_Unprivileged->LoadSystemInternalGroup('Unprivileged'); + } + return $_Unprivileged; +} + + +=head2 Plugins + +Returns a listref of all Plugins currently configured for this RT instance. +You can define plugins by adding them to the @Plugins list in your RT_SiteConfig + +=cut + +our @PLUGINS = (); +sub Plugins { + my $self = shift; + unless (@PLUGINS) { + $self->InitPluginPaths; + @PLUGINS = $self->InitPlugins; + } + return \@PLUGINS; +} + +=head2 PluginDirs + +Takes an optional subdir (e.g. po, lib, etc.) and returns a list of +directories from plugins where that subdirectory exists. + +This code does not check plugin names, plugin validitity, or load +plugins (see L) in any way, and requires that RT's +configuration have been already loaded. + +=cut + +sub PluginDirs { + my $self = shift; + my $subdir = shift; + + require RT::Plugin; + + my @res; + foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { + my $path = RT::Plugin->new( name => $plugin )->Path( $subdir ); + next unless -d $path; + push @res, $path; + } + return @res; +} + +=head2 InitPluginPaths + +Push plugins' lib paths into @INC right after F. +In case F isn't in @INC, append them to @INC + +=cut + +sub InitPluginPaths { + my $self = shift || __PACKAGE__; + + my @lib_dirs = $self->PluginDirs('lib'); + + my @tmp_inc; + my $added; + for (@INC) { + my $realpath = Cwd::realpath($_); + next unless defined $realpath; + if ( $realpath eq $RT::LocalLibPath) { + push @tmp_inc, $_, @lib_dirs; + $added = 1; + } else { + push @tmp_inc, $_; + } + } + + # append @lib_dirs in case $RT::LocalLibPath isn't in @INC + push @tmp_inc, @lib_dirs unless $added; + + my %seen; + @INC = grep !$seen{$_}++, @tmp_inc; +} + +=head2 InitPlugins + +Initialize all Plugins found in the RT configuration file, setting up +their lib and L component roots. + +=cut + +sub InitPlugins { + my $self = shift; + my @plugins; + require RT::Plugin; + foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { + $plugin->require; + die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR); + push @plugins, RT::Plugin->new(name =>$plugin); + } + return @plugins; +} + + +sub InstallMode { + my $self = shift; + if (@_) { + my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + if ($_[0] and $integrity) { + # Trying to turn install mode on but we have a good DB! + require Carp; + $RT::Logger->error( + Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!") + ); + } + else { + $_INSTALL_MODE = shift; + if($_INSTALL_MODE) { + require RT::CurrentUser; + $SystemUser = RT::CurrentUser->new(); + } + } + } + return $_INSTALL_MODE; +} + +sub LoadGeneratedData { + my $class = shift; + my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; + + require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@"; + $class->CanonicalizeGeneratedPaths(); +} + +sub CanonicalizeGeneratedPaths { + my $class = shift; + unless ( File::Spec->file_name_is_absolute($EtcPath) ) { + + # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}. + # otherwise RT.pm will make the source dir(where we configure RT) be the + # BasePath instead of the one specified by --prefix + unless ( -d $BasePath + && File::Spec->file_name_is_absolute($BasePath) ) + { + my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; + + # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'} + # is not always absolute + $BasePath = File::Spec->rel2abs( + File::Spec->catdir( $pm_path, File::Spec->updir ) ); + } + + $BasePath = Cwd::realpath($BasePath); + + for my $path ( + qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath + LocalLibPath LexiconPath LocalLexiconPath PluginPath + LocalPluginPath MasonComponentRoot MasonLocalComponentRoot + MasonDataDir MasonSessionDir/ + ) + { + no strict 'refs'; + + # just change relative ones + $$path = File::Spec->catfile( $BasePath, $$path ) + unless File::Spec->file_name_is_absolute($$path); + } + } + +} + +=head2 AddJavaScript + +helper method to add js files to C config. +to add extra js files, you can add the following line +in the plugin's main file: + + RT->AddJavaScript( 'foo.js', 'bar.js' ); + +=cut + +sub AddJavaScript { + my $self = shift; + + my @old = RT->Config->Get('JSFiles'); + RT->Config->Set( 'JSFiles', @old, @_ ); + return RT->Config->Get('JSFiles'); +} + +=head2 AddStyleSheets + +helper method to add css files to C config + +to add extra css files, you can add the following line +in the plugin's main file: + + RT->AddStyleSheets( 'foo.css', 'bar.css' ); + +=cut + +sub AddStyleSheets { + my $self = shift; + my @old = RT->Config->Get('CSSFiles'); + RT->Config->Set( 'CSSFiles', @old, @_ ); + return RT->Config->Get('CSSFiles'); +} + +=head2 JavaScript + +helper method of RT->Config->Get('JSFiles') + +=cut + +sub JavaScript { + return RT->Config->Get('JSFiles'); +} + +=head2 StyleSheets + +helper method of RT->Config->Get('CSSFiles') + +=cut + +sub StyleSheets { + return RT->Config->Get('CSSFiles'); +} + +=head1 BUGS + +Please report them to rt-bugs@bestpractical.com, if you know what's +broken and have at least some idea of what needs to be fixed. + +If you're not sure what's going on, report them rt-devel@lists.bestpractical.com. + +=head1 SEE ALSO + +L +L + +=cut + +require RT::Base; +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/.Handle.pm.swp b/rt/lib/RT/.Handle.pm.swp new file mode 100644 index 000000000..5ae85734d Binary files /dev/null and b/rt/lib/RT/.Handle.pm.swp differ diff --git a/rt/lib/RT/.Ticket.pm.swp b/rt/lib/RT/.Ticket.pm.swp new file mode 100644 index 000000000..7088d1bcf Binary files /dev/null and b/rt/lib/RT/.Ticket.pm.swp differ diff --git a/rt/lib/RT/Action/CreateTickets.pm b/rt/lib/RT/Action/CreateTickets.pm index e3c7b53e0..542cbd27b 100644 --- a/rt/lib/RT/Action/CreateTickets.pm +++ b/rt/lib/RT/Action/CreateTickets.pm @@ -579,15 +579,11 @@ sub _ParseMultilineTemplate { my %args = (@_); my $template_id; - require Encode; - require utf8; my ( $queue, $requestor ); $RT::Logger->debug("Line: ==="); foreach my $line ( split( /\n/, $args{'Content'} ) ) { $line =~ s/\r$//; - $RT::Logger->debug( "Line: " . utf8::is_utf8($line) - ? Encode::encode_utf8($line) - : $line ); + $RT::Logger->debug( "Line: $line" ); if ( $line =~ /^===/ ) { if ( $template_id && !$queue && $args{'Queue'} ) { $self->{'templates'}->{$template_id} @@ -790,10 +786,10 @@ sub ParseLines { ); if ( $args{content} ) { - my $mimeobj = MIME::Entity->new(); - $mimeobj->build( - Type => $args{'contenttype'} || 'text/plain', - Data => $args{'content'} + my $mimeobj = MIME::Entity->build( + Type => $args{'contenttype'} || 'text/plain', + Charset => 'UTF-8', + Data => [ map {Encode::encode( "UTF-8", $_ )} @{$args{'content'}} ], ); $ticketargs{MIMEObj} = $mimeobj; $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond'; diff --git a/rt/lib/RT/Action/CreateTickets.pm.orig b/rt/lib/RT/Action/CreateTickets.pm.orig new file mode 100644 index 000000000..e3c7b53e0 --- /dev/null +++ b/rt/lib/RT/Action/CreateTickets.pm.orig @@ -0,0 +1,1292 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +package RT::Action::CreateTickets; +use base 'RT::Action'; + +use strict; +use warnings; + +use MIME::Entity; + +=head1 NAME + +RT::Action::CreateTickets - Create one or more tickets according to an externally supplied template + +=head1 SYNOPSIS + + ===Create-Ticket: codereview + Subject: Code review for {$Tickets{'TOP'}->Subject} + Depended-On-By: TOP + Content: Someone has created a ticket. you should review and approve it, + so they can finish their work + ENDOFCONTENT + +=head1 DESCRIPTION + +The CreateTickets ScripAction allows you to create automated workflows in RT, +creating new tickets in response to actions and conditions from other +tickets. + +=head2 Format + +CreateTickets uses the RT template configured in the scrip as a template +for an ordered set of tickets to create. The basic format is as follows: + + ===Create-Ticket: identifier + Param: Value + Param2: Value + Param3: Value + Content: Blah + blah + blah + ENDOFCONTENT + ===Create-Ticket: id2 + Param: Value + Content: Blah + ENDOFCONTENT + +As shown, you can put one or more C<===Create-Ticket:> sections in +a template. Each C<===Create-Ticket:> section is evaluated as its own +L object, which means that you can embed snippets +of Perl inside the L using C<{}> delimiters, but that +such sections absolutely can not span a C<===Create-Ticket:> boundary. + +Note that each C must come right after the C on the same +line. The C param can extend over multiple lines, but the text +of the first line must start right after C. Don't try to start +your C section with a newline. + +After each ticket is created, it's stuffed into a hash called C<%Tickets> +making it available during the creation of other tickets during the +same ScripAction. The hash key for each ticket is C, +where C<[identifier]> is the value you put after C<===Create-Ticket:>. The hash +is prepopulated with the ticket which triggered the ScripAction as +C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand +C. + +A simple example: + + ===Create-Ticket: codereview + Subject: Code review for {$Tickets{'TOP'}->Subject} + Depended-On-By: TOP + Content: Someone has created a ticket. you should review and approve it, + so they can finish their work + ENDOFCONTENT + +A convoluted example: + + ===Create-Ticket: approval + { # Find out who the administrators of the group called "HR" + # of which the creator of this ticket is a member + my $name = "HR"; + + my $groups = RT::Groups->new(RT->SystemUser); + $groups->LimitToUserDefinedGroups(); + $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name"); + $groups->WithMember($TransactionObj->CreatorObj->Id); + + my $groupid = $groups->First->Id; + + my $adminccs = RT::Users->new(RT->SystemUser); + $adminccs->WhoHaveRight( + Right => "AdminGroup", + Object =>$groups->First, + IncludeSystemRights => undef, + IncludeSuperusers => 0, + IncludeSubgroupMembers => 0, + ); + + our @admins; + while (my $admin = $adminccs->Next) { + push (@admins, $admin->EmailAddress); + } + } + Queue: ___Approvals + Type: approval + AdminCc: {join ("\nAdminCc: ",@admins) } + Depended-On-By: TOP + Refers-To: TOP + Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject} + Due: {time + 86400} + Content-Type: text/plain + Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject} + Blah + Blah + ENDOFCONTENT + ===Create-Ticket: two + Subject: Manager approval + Type: approval + Depended-On-By: TOP + Refers-To: {$Tickets{"create-approval"}->Id} + Queue: ___Approvals + Content-Type: text/plain + Content: Your approval is requred for this ticket, too. + ENDOFCONTENT + +As shown above, you can include a block with Perl code to set up some +values for the new tickets. If you want to access a variable in the +template section after the block, you must scope it with C rather +than C. Just as with other RT templates, you can also include +Perl code in the template sections using C<{}>. + +=head2 Acceptable Fields + +A complete list of acceptable fields: + + * Queue => Name or id# of a queue + Subject => A text string + ! Status => A valid status. Defaults to 'new' + Due => Dates can be specified in seconds since the epoch + to be handled literally or in a semi-free textual + format which RT will attempt to parse. + Starts => + Started => + Resolved => + Owner => Username or id of an RT user who can and should own + this ticket; forces the owner if necessary + + Requestor => Email address + + Cc => Email address + + AdminCc => Email address + + RequestorGroup => Group name + + CcGroup => Group name + + AdminCcGroup => Group name + TimeWorked => + TimeEstimated => + TimeLeft => + InitialPriority => + FinalPriority => + Type => + +! DependsOn => + +! DependedOnBy => + +! RefersTo => + +! ReferredToBy => + +! Members => + +! MemberOf => + Content => Content. Can extend to multiple lines. Everything + within a template after a Content: header is treated + as content until we hit a line containing only + ENDOFCONTENT + ContentType => the content-type of the Content field. Defaults to + 'text/plain' + UpdateType => 'correspond' or 'comment'; used in conjunction with + 'content' if this is an update. Defaults to + 'correspond' + + CustomField- => custom field value + CF-name => custom field value + CustomField-name => custom field value + +Fields marked with an C<*> are required. + +Fields marked with a C<+> may have multiple values, simply +by repeating the fieldname on a new line with an additional value. + +Fields marked with a C have processing postponed until after all +tickets in the same actions are created. Except for C, those +fields can also take a ticket name within the same action (i.e. +the identifiers after C<===Create-Ticket:>), instead of raw ticket ID +numbers. + +When parsed, field names are converted to lowercase and have hyphens stripped. +C, C, C, C and C will +all be treated as the same thing. + +=head1 METHODS + +=cut + +my %LINKTYPEMAP = ( + MemberOf => { + Type => 'MemberOf', + Mode => 'Target', + }, + Parents => { + Type => 'MemberOf', + Mode => 'Target', + }, + Members => { + Type => 'MemberOf', + Mode => 'Base', + }, + Children => { + Type => 'MemberOf', + Mode => 'Base', + }, + HasMember => { + Type => 'MemberOf', + Mode => 'Base', + }, + RefersTo => { + Type => 'RefersTo', + Mode => 'Target', + }, + ReferredToBy => { + Type => 'RefersTo', + Mode => 'Base', + }, + DependsOn => { + Type => 'DependsOn', + Mode => 'Target', + }, + DependedOnBy => { + Type => 'DependsOn', + Mode => 'Base', + }, + +); + + +#Do what we need to do and send it out. +sub Commit { + my $self = shift; + + # Create all the tickets we care about + return (1) unless $self->TicketObj->Type eq 'ticket'; + + $self->CreateByTemplate( $self->TicketObj ); + $self->UpdateByTemplate( $self->TicketObj ); + return (1); +} + + + +sub Prepare { + my $self = shift; + + unless ( $self->TemplateObj ) { + $RT::Logger->warning("No template object handed to $self"); + } + + unless ( $self->TransactionObj ) { + $RT::Logger->warning("No transaction object handed to $self"); + + } + + unless ( $self->TicketObj ) { + $RT::Logger->warning("No ticket object handed to $self"); + + } + + my $active = 0; + if ( $self->TemplateObj->Type eq 'Perl' ) { + $active = 1; + } else { + RT->Logger->info(sprintf( + "Template #%d is type %s. You most likely want to use a Perl template instead.", + $self->TemplateObj->id, $self->TemplateObj->Type + )); + } + + $self->Parse( + Content => $self->TemplateObj->Content, + _ActiveContent => $active, + ); + return 1; + +} + + + +sub CreateByTemplate { + my $self = shift; + my $top = shift; + + $RT::Logger->debug("In CreateByTemplate"); + + my @results; + + # XXX: cargo cult programming that works. i'll be back. + + local %T::Tickets = %T::Tickets; + local $T::TOP = $T::TOP; + local $T::ID = $T::ID; + $T::Tickets{'TOP'} = $T::TOP = $top if $top; + local $T::TransactionObj = $self->TransactionObj; + + my $ticketargs; + my ( @links, @postponed ); + foreach my $template_id ( @{ $self->{'create_tickets'} } ) { + $RT::Logger->debug("Workflow: processing $template_id of $T::TOP") + if $T::TOP; + + $T::ID = $template_id; + @T::AllID = @{ $self->{'create_tickets'} }; + + ( $T::Tickets{$template_id}, $ticketargs ) + = $self->ParseLines( $template_id, \@links, \@postponed ); + + # Now we have a %args to work with. + # Make sure we have at least the minimum set of + # reasonable data and do our thang + + my ( $id, $transid, $msg ) + = $T::Tickets{$template_id}->Create(%$ticketargs); + + foreach my $res ( split( '\n', $msg ) ) { + push @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': ' + . $res; + } + if ( !$id ) { + if ( $self->TicketObj ) { + $msg = "Couldn't create related ticket $template_id for " + . $self->TicketObj->Id . " " + . $msg; + } else { + $msg = "Couldn't create ticket $template_id " . $msg; + } + + $RT::Logger->error($msg); + next; + } + + $RT::Logger->debug("Assigned $template_id with $id"); + $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj ) + if $self->TicketObj + && $T::Tickets{$template_id}->can('SetOriginObj'); + + } + + $self->PostProcess( \@links, \@postponed ); + + return @results; +} + +sub UpdateByTemplate { + my $self = shift; + my $top = shift; + + # XXX: cargo cult programming that works. i'll be back. + + my @results; + local %T::Tickets = %T::Tickets; + local $T::ID = $T::ID; + + my $ticketargs; + my ( @links, @postponed ); + foreach my $template_id ( @{ $self->{'update_tickets'} } ) { + $RT::Logger->debug("Update Workflow: processing $template_id"); + + $T::ID = $template_id; + @T::AllID = @{ $self->{'update_tickets'} }; + + ( $T::Tickets{$template_id}, $ticketargs ) + = $self->ParseLines( $template_id, \@links, \@postponed ); + + # Now we have a %args to work with. + # Make sure we have at least the minimum set of + # reasonable data and do our thang + + my @attribs = qw( + Subject + FinalPriority + Priority + TimeEstimated + TimeWorked + TimeLeft + Status + Queue + Due + Starts + Started + Resolved + ); + + my $id = $template_id; + $id =~ s/update-(\d+).*/$1/; + my ($loaded, $msg) = $T::Tickets{$template_id}->LoadById($id); + + unless ( $loaded ) { + $RT::Logger->error("Couldn't update ticket $template_id: " . $msg); + push @results, $self->loc( "Couldn't load ticket '[_1]'", $id ); + next; + } + + my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} ); + + $template_id =~ m/^update-(.*)/; + my $base_id = "base-$1"; + my $base = $self->{'templates'}->{$base_id}; + if ($base) { + $base =~ s/\r//g; + $base =~ s/\n+$//; + $current =~ s/\n+$//; + + # If we have no base template, set what we can. + if ( $base ne $current ) { + push @results, + "Could not update ticket " + . $T::Tickets{$template_id}->Id + . ": Ticket has changed"; + next; + } + } + push @results, $T::Tickets{$template_id}->Update( + AttributesRef => \@attribs, + ARGSRef => $ticketargs + ); + + if ( $ticketargs->{'Owner'} ) { + ($id, $msg) = $T::Tickets{$template_id}->SetOwner($ticketargs->{'Owner'}, "Force"); + push @results, $msg unless $msg eq $self->loc("That user already owns that ticket"); + } + + push @results, + $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs ); + + push @results, + $self->UpdateCustomFields( $T::Tickets{$template_id}, $ticketargs ); + + next unless $ticketargs->{'MIMEObj'}; + if ( $ticketargs->{'UpdateType'} =~ /^(private|comment)$/i ) { + my ( $Transaction, $Description, $Object ) + = $T::Tickets{$template_id}->Comment( + BccMessageTo => $ticketargs->{'Bcc'}, + MIMEObj => $ticketargs->{'MIMEObj'}, + TimeTaken => $ticketargs->{'TimeWorked'} + ); + push( @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) + . ': ' + . $Description ); + } elsif ( $ticketargs->{'UpdateType'} =~ /^(public|response|correspond)$/i ) { + my ( $Transaction, $Description, $Object ) + = $T::Tickets{$template_id}->Correspond( + BccMessageTo => $ticketargs->{'Bcc'}, + MIMEObj => $ticketargs->{'MIMEObj'}, + TimeTaken => $ticketargs->{'TimeWorked'} + ); + push( @results, + $T::Tickets{$template_id} + ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) + . ': ' + . $Description ); + } else { + push( + @results, + $T::Tickets{$template_id}->loc( + "Update type was neither correspondence nor comment.") + . " " + . $T::Tickets{$template_id}->loc("Update not recorded.") + ); + } + } + + $self->PostProcess( \@links, \@postponed ); + + return @results; +} + +=head2 Parse + +Takes (in order) template content, a default queue, a default requestor, and +active (a boolean flag). + +Parses a template in the template content, defaulting queue and requestor if +unspecified in the template to the values provided as arguments. + +If the active flag is true, then we'll use L to parse the +templates, allowing you to embed active Perl in your templates. + +=cut + +sub Parse { + my $self = shift; + my %args = ( + Content => undef, + Queue => undef, + Requestor => undef, + _ActiveContent => undef, + @_ + ); + + if ( $args{'_ActiveContent'} ) { + $self->{'UsePerlTextTemplate'} = 1; + } else { + + $self->{'UsePerlTextTemplate'} = 0; + } + + if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) { + $self->_ParseMultilineTemplate(%args); + } elsif ( $args{'Content'} =~ /(?:\t|,)/i ) { + $self->_ParseXSVTemplate(%args); + } else { + RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}"); + } +} + +=head2 _ParseMultilineTemplate + +Parses mulitline templates. Things like: + + ===Create-Ticket: ... + +Takes the same arguments as L. + +=cut + +sub _ParseMultilineTemplate { + my $self = shift; + my %args = (@_); + + my $template_id; + require Encode; + require utf8; + my ( $queue, $requestor ); + $RT::Logger->debug("Line: ==="); + foreach my $line ( split( /\n/, $args{'Content'} ) ) { + $line =~ s/\r$//; + $RT::Logger->debug( "Line: " . utf8::is_utf8($line) + ? Encode::encode_utf8($line) + : $line ); + if ( $line =~ /^===/ ) { + if ( $template_id && !$queue && $args{'Queue'} ) { + $self->{'templates'}->{$template_id} + .= "Queue: $args{'Queue'}\n"; + } + if ( $template_id && !$requestor && $args{'Requestor'} ) { + $self->{'templates'}->{$template_id} + .= "Requestor: $args{'Requestor'}\n"; + } + $queue = 0; + $requestor = 0; + } + if ( $line =~ /^===Create-Ticket: (.*)$/ ) { + $template_id = "create-$1"; + $RT::Logger->debug("**** Create ticket: $template_id"); + push @{ $self->{'create_tickets'} }, $template_id; + } elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) { + $template_id = "update-$1"; + $RT::Logger->debug("**** Update ticket: $template_id"); + push @{ $self->{'update_tickets'} }, $template_id; + } elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) { + $template_id = "base-$1"; + $RT::Logger->debug("**** Base ticket: $template_id"); + push @{ $self->{'base_tickets'} }, $template_id; + } elsif ( $line =~ /^===#.*$/ ) { # a comment + next; + } else { + if ( $line =~ /^Queue:(.*)/i ) { + $queue = 1; + my $value = $1; + $value =~ s/^\s//; + $value =~ s/\s$//; + if ( !$value && $args{'Queue'} ) { + $value = $args{'Queue'}; + $line = "Queue: $value"; + } + } + if ( $line =~ /^Requestors?:(.*)/i ) { + $requestor = 1; + my $value = $1; + $value =~ s/^\s//; + $value =~ s/\s$//; + if ( !$value && $args{'Requestor'} ) { + $value = $args{'Requestor'}; + $line = "Requestor: $value"; + } + } + $self->{'templates'}->{$template_id} .= $line . "\n"; + } + } + if ( $template_id && !$queue && $args{'Queue'} ) { + $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n"; + } + } + +sub ParseLines { + my $self = shift; + my $template_id = shift; + my $links = shift; + my $postponed = shift; + + my $content = $self->{'templates'}->{$template_id}; + + if ( $self->{'UsePerlTextTemplate'} ) { + + $RT::Logger->debug( + "Workflow: evaluating\n$self->{templates}{$template_id}"); + + my $template = Text::Template->new( + TYPE => 'STRING', + SOURCE => $content + ); + + my $err; + $content = $template->fill_in( + PACKAGE => 'T', + BROKEN => sub { + $err = {@_}->{error}; + } + ); + + $RT::Logger->debug("Workflow: yielding $content"); + + if ($err) { + $RT::Logger->error( "Ticket creation failed: " . $err ); + while ( my ( $k, $v ) = each %T::X ) { + $RT::Logger->debug( + "Eliminating $template_id from ${k}'s parents."); + delete $v->{$template_id}; + } + next; + } + } + + my $TicketObj ||= RT::Ticket->new( $self->CurrentUser ); + + my %args; + my %original_tags; + my @lines = ( split( /\n/, $content ) ); + while ( defined( my $line = shift @lines ) ) { + if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) { + my $value = $2; + my $original_tag = $1; + my $tag = lc($original_tag); + $tag =~ s/-//g; + $tag =~ s/^(requestor|cc|admincc)s?$/$1/i; + + $original_tags{$tag} = $original_tag; + + if ( ref( $args{$tag} ) ) + { #If it's an array, we want to push the value + push @{ $args{$tag} }, $value; + } elsif ( defined( $args{$tag} ) ) + { #if we're about to get a second value, make it an array + $args{$tag} = [ $args{$tag}, $value ]; + } else { #if there's nothing there, just set the value + $args{$tag} = $value; + } + + if ( $tag =~ /^content$/i ) { #just build up the content + # convert it to an array + $args{$tag} = defined($value) ? [ $value . "\n" ] : []; + while ( defined( my $l = shift @lines ) ) { + last if ( $l =~ /^ENDOFCONTENT\s*$/ ); + push @{ $args{'content'} }, $l . "\n"; + } + } else { + # if it's not content, strip leading and trailing spaces + if ( $args{$tag} ) { + $args{$tag} =~ s/^\s+//g; + $args{$tag} =~ s/\s+$//g; + } + if ( + ($tag =~ /^(requestor|cc|admincc)(group)?$/i + or grep {lc $_ eq $tag} keys %LINKTYPEMAP) + and $args{$tag} =~ /,/ + ) { + $args{$tag} = [ split /,\s*/, $args{$tag} ]; + } + } + } + } + + foreach my $date (qw(due starts started resolved)) { + my $dateobj = RT::Date->new( $self->CurrentUser ); + next unless $args{$date}; + if ( $args{$date} =~ /^\d+$/ ) { + $dateobj->Set( Format => 'unix', Value => $args{$date} ); + } else { + eval { + $dateobj->Set( Format => 'iso', Value => $args{$date} ); + }; + if ($@ or $dateobj->Unix <= 0) { + $dateobj->Set( Format => 'unknown', Value => $args{$date} ); + } + } + $args{$date} = $dateobj->ISO; + } + + foreach my $role (qw(requestor cc admincc)) { + next unless my $value = $args{ $role . 'group' }; + + my $group = RT::Group->new( $self->CurrentUser ); + $group->LoadUserDefinedGroup( $value ); + unless ( $group->id ) { + $RT::Logger->error("Couldn't load group '$value'"); + next; + } + + $args{ $role } = $args{ $role } ? [$args{ $role }] : [] + unless ref $args{ $role }; + push @{ $args{ $role } }, $group->PrincipalObj->id; + } + + $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses + if $self->TicketObj; + + $args{'type'} ||= 'ticket'; + + my %ticketargs = ( + Queue => $args{'queue'}, + Subject => $args{'subject'}, + Status => $args{'status'} || 'new', + Due => $args{'due'}, + Starts => $args{'starts'}, + Started => $args{'started'}, + Resolved => $args{'resolved'}, + Owner => $args{'owner'}, + Requestor => $args{'requestor'}, + Cc => $args{'cc'}, + AdminCc => $args{'admincc'}, + TimeWorked => $args{'timeworked'}, + TimeEstimated => $args{'timeestimated'}, + TimeLeft => $args{'timeleft'}, + InitialPriority => $args{'initialpriority'} || 0, + FinalPriority => $args{'finalpriority'} || 0, + SquelchMailTo => $args{'squelchmailto'}, + Type => $args{'type'}, + $self->Rules + ); + + if ( $args{content} ) { + my $mimeobj = MIME::Entity->new(); + $mimeobj->build( + Type => $args{'contenttype'} || 'text/plain', + Data => $args{'content'} + ); + $ticketargs{MIMEObj} = $mimeobj; + $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond'; + } + + foreach my $tag ( keys(%args) ) { + # if the tag was added later, skip it + my $orig_tag = $original_tags{$tag} or next; + if ( $orig_tag =~ /^customfield-?(\d+)$/i ) { + $ticketargs{ "CustomField-" . $1 } = $args{$tag}; + } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) { + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} ); + $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id; + next unless $cf->id; + $ticketargs{ "CustomField-" . $cf->id } = $args{$tag}; + } elsif ($orig_tag) { + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} ); + $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id; + next unless $cf->id; + $ticketargs{ "CustomField-" . $cf->id } = $args{$tag}; + + } + } + + $self->GetDeferred( \%args, $template_id, $links, $postponed ); + + return $TicketObj, \%ticketargs; +} + + +=head2 _ParseXSVTemplate + +Parses a tab or comma delimited template. Should only ever be called by +L. + +=cut + +sub _ParseXSVTemplate { + my $self = shift; + my %args = (@_); + + use Regexp::Common qw(delimited); + my($first, $content) = split(/\r?\n/, $args{'Content'}, 2); + + my $delimiter; + if ( $first =~ /\t/ ) { + $delimiter = "\t"; + } else { + $delimiter = ','; + } + my @fields = split( /$delimiter/, $first ); + + my $delimiter_re = qr[$delimiter]; + my $justquoted = qr[$RE{quoted}]; + + # Used to generate automatic template ids + my $autoid = 1; + + LINE: + while ($content) { + $content =~ s/^(\s*\r?\n)+//; + + # Keep track of Queue and Requestor, so we can provide defaults + my $queue; + my $requestor; + + # The template for this line + my $template; + + # What column we're on + my $i = 0; + + # If the last iteration was the end of the line + my $EOL = 0; + + # The template id + my $template_id; + + COLUMN: + while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) { + $EOL = not $2; + + # Strip off quotes, if they exist + my $value = $1; + if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) { + substr( $value, 0, 1 ) = ""; + substr( $value, -1, 1 ) = ""; + } + + # What column is this? + my $field = $fields[$i++]; + next COLUMN unless $field =~ /\S/; + $field =~ s/^\s//; + $field =~ s/\s$//; + + if ( $field =~ /^id$/i ) { + # Special case if this is the ID column + if ( $value =~ /^\d+$/ ) { + $template_id = 'update-' . $value; + push @{ $self->{'update_tickets'} }, $template_id; + } elsif ( $value =~ /^#base-(\d+)$/ ) { + $template_id = 'base-' . $1; + push @{ $self->{'base_tickets'} }, $template_id; + } elsif ( $value =~ /\S/ ) { + $template_id = 'create-' . $value; + push @{ $self->{'create_tickets'} }, $template_id; + } + } else { + # Some translations + if ( $field =~ /^Body$/i + || $field =~ /^Data$/i + || $field =~ /^Message$/i ) + { + $field = 'Content'; + } elsif ( $field =~ /^Summary$/i ) { + $field = 'Subject'; + } elsif ( $field =~ /^Queue$/i ) { + # Note that we found a queue + $queue = 1; + $value ||= $args{'Queue'}; + } elsif ( $field =~ /^Requestors?$/i ) { + $field = 'Requestor'; # Remove plural + # Note that we found a requestor + $requestor = 1; + $value ||= $args{'Requestor'}; + } + + # Tack onto the end of the template + $template .= $field . ": "; + $template .= (defined $value ? $value : ""); + $template .= "\n"; + $template .= "ENDOFCONTENT\n" + if $field =~ /^Content$/i; + } + } + + # Ignore blank lines + next unless $template; + + # If we didn't find a queue of requestor, tack on the defaults + if ( !$queue && $args{'Queue'} ) { + $template .= "Queue: $args{'Queue'}\n"; + } + if ( !$requestor && $args{'Requestor'} ) { + $template .= "Requestor: $args{'Requestor'}\n"; + } + + # If we never found an ID, come up with one + unless ($template_id) { + $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"}; + $template_id = "create-auto-$autoid"; + # Also, it's a ticket to create + push @{ $self->{'create_tickets'} }, $template_id; + } + + # Save the template we generated + $self->{'templates'}->{$template_id} = $template; + + } +} + +sub GetDeferred { + my $self = shift; + my $args = shift; + my $id = shift; + my $links = shift; + my $postponed = shift; + + # Deferred processing + push @$links, + ( + $id, + { DependsOn => $args->{'dependson'}, + DependedOnBy => $args->{'dependedonby'}, + RefersTo => $args->{'refersto'}, + ReferredToBy => $args->{'referredtoby'}, + Children => $args->{'children'}, + Parents => $args->{'parents'}, + } + ); + + push @$postponed, ( + + # Status is postponed so we don't violate dependencies + $id, { Status => $args->{'status'}, } + ); +} + +sub GetUpdateTemplate { + my $self = shift; + my $t = shift; + + my $string; + $string .= "Queue: " . $t->QueueObj->Name . "\n"; + $string .= "Subject: " . $t->Subject . "\n"; + $string .= "Status: " . $t->Status . "\n"; + $string .= "UpdateType: correspond\n"; + $string .= "Content: \n"; + $string .= "ENDOFCONTENT\n"; + $string .= "Due: " . $t->DueObj->AsString . "\n"; + $string .= "Starts: " . $t->StartsObj->AsString . "\n"; + $string .= "Started: " . $t->StartedObj->AsString . "\n"; + $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n"; + $string .= "Owner: " . $t->OwnerObj->Name . "\n"; + $string .= "Requestor: " . $t->RequestorAddresses . "\n"; + $string .= "Cc: " . $t->CcAddresses . "\n"; + $string .= "AdminCc: " . $t->AdminCcAddresses . "\n"; + $string .= "TimeWorked: " . $t->TimeWorked . "\n"; + $string .= "TimeEstimated: " . $t->TimeEstimated . "\n"; + $string .= "TimeLeft: " . $t->TimeLeft . "\n"; + $string .= "InitialPriority: " . $t->Priority . "\n"; + $string .= "FinalPriority: " . $t->FinalPriority . "\n"; + + foreach my $type ( sort keys %LINKTYPEMAP ) { + + # don't display duplicates + if ( $type eq "HasMember" + || $type eq "Members" + || $type eq "MemberOf" ) + { + next; + } + $string .= "$type: "; + + my $mode = $LINKTYPEMAP{$type}->{Mode}; + my $method = $LINKTYPEMAP{$type}->{Type}; + + my $links = ''; + while ( my $link = $t->$method->Next ) { + $links .= ", " if $links; + + my $object = $mode . "Obj"; + my $member = $link->$object; + $links .= $member->Id if $member; + } + $string .= $links; + $string .= "\n"; + } + + return $string; +} + +sub GetBaseTemplate { + my $self = shift; + my $t = shift; + + my $string; + $string .= "Queue: " . $t->Queue . "\n"; + $string .= "Subject: " . $t->Subject . "\n"; + $string .= "Status: " . $t->Status . "\n"; + $string .= "Due: " . $t->DueObj->Unix . "\n"; + $string .= "Starts: " . $t->StartsObj->Unix . "\n"; + $string .= "Started: " . $t->StartedObj->Unix . "\n"; + $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n"; + $string .= "Owner: " . $t->Owner . "\n"; + $string .= "Requestor: " . $t->RequestorAddresses . "\n"; + $string .= "Cc: " . $t->CcAddresses . "\n"; + $string .= "AdminCc: " . $t->AdminCcAddresses . "\n"; + $string .= "TimeWorked: " . $t->TimeWorked . "\n"; + $string .= "TimeEstimated: " . $t->TimeEstimated . "\n"; + $string .= "TimeLeft: " . $t->TimeLeft . "\n"; + $string .= "InitialPriority: " . $t->Priority . "\n"; + $string .= "FinalPriority: " . $t->FinalPriority . "\n"; + + return $string; +} + +sub GetCreateTemplate { + my $self = shift; + + my $string; + + $string .= "Queue: General\n"; + $string .= "Subject: \n"; + $string .= "Status: new\n"; + $string .= "Content: \n"; + $string .= "ENDOFCONTENT\n"; + $string .= "Due: \n"; + $string .= "Starts: \n"; + $string .= "Started: \n"; + $string .= "Resolved: \n"; + $string .= "Owner: \n"; + $string .= "Requestor: \n"; + $string .= "Cc: \n"; + $string .= "AdminCc:\n"; + $string .= "TimeWorked: \n"; + $string .= "TimeEstimated: \n"; + $string .= "TimeLeft: \n"; + $string .= "InitialPriority: \n"; + $string .= "FinalPriority: \n"; + + foreach my $type ( keys %LINKTYPEMAP ) { + + # don't display duplicates + if ( $type eq "HasMember" + || $type eq 'Members' + || $type eq 'MemberOf' ) + { + next; + } + $string .= "$type: \n"; + } + return $string; +} + +sub UpdateWatchers { + my $self = shift; + my $ticket = shift; + my $args = shift; + + my @results; + + foreach my $type (qw(Requestor Cc AdminCc)) { + my $method = $type . 'Addresses'; + my $oldaddr = $ticket->$method; + + # Skip unless we have a defined field + next unless defined $args->{$type}; + my $newaddr = $args->{$type}; + + my @old = split( /,\s*/, $oldaddr ); + my @new; + for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) { + # Sometimes these are email addresses, sometimes they're + # users. Try to guess which is which, as we want to deal + # with email addresses if at all possible. + if (/^\S+@\S+$/) { + push @new, $_; + } else { + # It doesn't look like an email address. Try to load it. + my $user = RT::User->new($self->CurrentUser); + $user->Load($_); + if ($user->Id) { + push @new, $user->EmailAddress; + } else { + push @new, $_; + } + } + } + + my %oldhash = map { $_ => 1 } @old; + my %newhash = map { $_ => 1 } @new; + + my @add = grep( !defined $oldhash{$_}, @new ); + my @delete = grep( !defined $newhash{$_}, @old ); + + foreach (@add) { + my ( $val, $msg ) = $ticket->AddWatcher( + Type => $type, + Email => $_ + ); + + push @results, + $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg; + } + + foreach (@delete) { + my ( $val, $msg ) = $ticket->DeleteWatcher( + Type => $type, + Email => $_ + ); + push @results, + $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg; + } + } + return @results; +} + +sub UpdateCustomFields { + my $self = shift; + my $ticket = shift; + my $args = shift; + + my @results; + foreach my $arg (keys %{$args}) { + next unless $arg =~ /^CustomField-(\d+)$/; + my $cf = $1; + + my $CustomFieldObj = RT::CustomField->new($self->CurrentUser); + $CustomFieldObj->SetContextObject( $ticket ); + $CustomFieldObj->LoadById($cf); + + my @values; + if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext + @values = ($args->{$arg}); + } else { + @values = split /\n/, $args->{$arg}; + } + + if ( ($CustomFieldObj->Type eq 'Freeform' + && ! $CustomFieldObj->SingleValue) || + $CustomFieldObj->Type =~ /text/i) { + foreach my $val (@values) { + $val =~ s/\r//g; + } + } + + foreach my $value (@values) { + next unless length($value); + my ( $val, $msg ) = $ticket->AddCustomFieldValue( + Field => $cf, + Value => $value + ); + push ( @results, $msg ); + } + } + return @results; +} + +sub PostProcess { + my $self = shift; + my $links = shift; + my $postponed = shift; + + # postprocessing: add links + + while ( my $template_id = shift(@$links) ) { + my $ticket = $T::Tickets{$template_id}; + $RT::Logger->debug( "Handling links for " . $ticket->Id ); + my %args = %{ shift(@$links) }; + + foreach my $type ( keys %LINKTYPEMAP ) { + next unless ( defined $args{$type} ); + foreach my $link ( + ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) ) + { + next unless $link; + + if ( $link =~ /^TOP$/i ) { + $RT::Logger->debug( "Building $type link for $link: " + . $T::Tickets{TOP}->Id ); + $link = $T::Tickets{TOP}->Id; + + } elsif ( $link !~ m/^\d+$/ ) { + my $key = "create-$link"; + if ( !exists $T::Tickets{$key} ) { + $RT::Logger->debug( + "Skipping $type link for $key (non-existent)"); + next; + } + $RT::Logger->debug( "Building $type link for $link: " + . $T::Tickets{$key}->Id ); + $link = $T::Tickets{$key}->Id; + } else { + $RT::Logger->debug("Building $type link for $link"); + } + + my ( $wval, $wmsg ) = $ticket->AddLink( + Type => $LINKTYPEMAP{$type}->{'Type'}, + $LINKTYPEMAP{$type}->{'Mode'} => $link, + Silent => 1 + ); + + $RT::Logger->warning("AddLink thru $link failed: $wmsg") + unless $wval; + + # push @non_fatal_errors, $wmsg unless ($wval); + } + + } + } + + # postponed actions -- Status only, currently + while ( my $template_id = shift(@$postponed) ) { + my $ticket = $T::Tickets{$template_id}; + $RT::Logger->debug( "Handling postponed actions for " . $ticket->id ); + my %args = %{ shift(@$postponed) }; + $ticket->SetStatus( $args{Status} ) if defined $args{Status}; + } + +} + +sub Options { + my $self = shift; + my $queues = RT::Queues->new($self->CurrentUser); + $queues->UnLimit; + my @names; + while (my $queue = $queues->Next) { + push @names, $queue->Id, $queue->Name; + } + return ( + { + 'name' => 'Queue', + 'label' => 'In queue', + 'type' => 'select', + 'options' => \@names + } + ) +} + +RT::Base->_ImportOverlays(); + +1; + diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index 0f11cc141..a483fba9f 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -258,7 +258,7 @@ sub Bcc { sub AddressesFromHeader { my $self = shift; my $field = shift; - my $header = $self->TemplateObj->MIMEObj->head->get($field); + my $header = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field)); my @addresses = Email::Address->parse($header); return (@addresses); @@ -277,7 +277,7 @@ sub SendMessage { # ability to pass @_ to a 'post' routine. my ( $self, $MIMEObj ) = @_; - my $msgid = $MIMEObj->head->get('Message-ID'); + my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') ); chomp $msgid; $self->ScripActionObj->{_Message_ID}++; @@ -300,7 +300,7 @@ sub SendMessage { my $success = $msgid . " sent "; foreach (@EMAIL_RECIPIENT_HEADERS) { - my $recipients = $MIMEObj->head->get($_); + my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) ); $success .= " $_: " . $recipients if $recipients; } @@ -531,7 +531,7 @@ sub RecordOutgoingMailTransaction { $type = 'EmailRecord'; } - my $msgid = $MIMEObj->head->get('Message-ID'); + my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') ); chomp $msgid; my ( $id, $msg ) = $transaction->Create( @@ -649,7 +649,7 @@ sub DeferDigestRecipients { # Have to get the list of addresses directly from the MIME header # at this point. - $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); + $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) ); foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { next unless $rcpt; my $user_obj = RT::User->new(RT->SystemUser); @@ -746,7 +746,7 @@ sub RemoveInappropriateRecipients { # If there are no recipients, don't try to send the message. # If the transaction has content and has the header RT-Squelch-Replies-To - my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); + my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') ); if ( my $attachment = $self->TransactionObj->Attachments->First ) { if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { @@ -922,7 +922,8 @@ sub GetFriendlyName { =head2 SetHeader FIELD, VALUE -Set the FIELD of the current MIME object into VALUE. +Set the FIELD of the current MIME object into VALUE, which should be in +characters, not bytes. Returns the new header, in bytes. =cut @@ -935,7 +936,7 @@ sub SetHeader { chomp $field; my $head = $self->TemplateObj->MIMEObj->head; $head->fold_length( $field, 10000 ); - $head->replace( $field, $val ); + $head->replace( $field, Encode::encode( "UTF-8", $val ) ); return $head->get($field); } @@ -976,7 +977,7 @@ sub SetSubject { $subject =~ s/(\r\n|\n|\s)/ /g; - $self->SetHeader( 'Subject', Encode::encode_utf8( $subject ) ); + $self->SetHeader( 'Subject', $subject ); } @@ -992,11 +993,9 @@ sub SetSubjectToken { my $head = $self->TemplateObj->MIMEObj->head; $self->SetHeader( Subject => - Encode::encode_utf8( - RT::Interface::Email::AddSubjectTag( - Encode::decode_utf8( $head->get('Subject') ), - $self->TicketObj, - ), + RT::Interface::Email::AddSubjectTag( + Encode::decode( "UTF-8", $head->get('Subject') ), + $self->TicketObj, ), ); } @@ -1090,7 +1089,8 @@ sub PseudoReference { =head2 SetHeaderAsEncoding($field_name, $charset_encoding) -This routine converts the field into specified charset encoding. +This routine converts the field into specified charset encoding, then +applies the MIME-Header transfer encoding. =cut @@ -1101,12 +1101,12 @@ sub SetHeaderAsEncoding { my $head = $self->TemplateObj->MIMEObj->head; if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { - $head->replace( $field, RT->Config->Get('SMTPFrom') ); + $head->replace( $field, Encode::encode( "UTF-8", RT->Config->Get('SMTPFrom') ) ); return; } - my $value = $head->get( $field ); - $value = $self->MIMEEncodeString( $value, $enc ); + my $value = Encode::decode("UTF-8", $head->get( $field )); + $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes $head->replace( $field, $value ); } @@ -1116,7 +1116,8 @@ sub SetHeaderAsEncoding { Takes a perl string and optional encoding pass it over L. -Basicly encode a string using B encoding according to RFC2047. +Basicly encode a string using B encoding according to RFC2047, returning +bytes. =cut diff --git a/rt/lib/RT/Action/SendEmail.pm.orig b/rt/lib/RT/Action/SendEmail.pm.orig new file mode 100755 index 000000000..0f11cc141 --- /dev/null +++ b/rt/lib/RT/Action/SendEmail.pm.orig @@ -0,0 +1,1131 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +# Portions Copyright 2000 Tobias Brox + +package RT::Action::SendEmail; + +use strict; +use warnings; + +use base qw(RT::Action); + +use RT::EmailParser; +use RT::Interface::Email; +use Email::Address; +our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc); + + +=head1 NAME + +RT::Action::SendEmail - An Action which users can use to send mail +or can subclassed for more specialized mail sending behavior. +RT::Action::AutoReply is a good example subclass. + +=head1 SYNOPSIS + + use base 'RT::Action::SendEmail'; + +=head1 DESCRIPTION + +Basically, you create another module RT::Action::YourAction which ISA +RT::Action::SendEmail. + +=head1 METHODS + +=head2 CleanSlate + +Cleans class-wide options, like L. + +=cut + +sub CleanSlate { + my $self = shift; + $self->AttachTickets(undef); +} + +=head2 Commit + +Sends the prepared message and writes outgoing record into DB if the feature is +activated in the config. + +=cut + +sub Commit { + my $self = shift; + + return abs $self->SendMessage( $self->TemplateObj->MIMEObj ) + unless RT->Config->Get('RecordOutgoingEmail'); + + $self->DeferDigestRecipients(); + my $message = $self->TemplateObj->MIMEObj; + + my $orig_message; + $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt( + Attachment => $self->TransactionObj->Attachments->First, + Ticket => $self->TicketObj, + ); + + my ($ret) = $self->SendMessage($message); + return abs( $ret ) if $ret <= 0; + + if ($orig_message) { + $message->attach( + Type => 'application/x-rt-original-message', + Disposition => 'inline', + Data => $orig_message->as_string, + ); + } + $self->RecordOutgoingMailTransaction($message); + $self->RecordDeferredRecipients(); + return 1; +} + +=head2 Prepare + +Builds an outgoing email we're going to send using scrip's template. + +=cut + +sub Prepare { + my $self = shift; + + my ( $result, $message ) = $self->TemplateObj->Parse( + Argument => $self->Argument, + TicketObj => $self->TicketObj, + TransactionObj => $self->TransactionObj + ); + if ( !$result ) { + return (undef); + } + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + # Header + $self->SetRTSpecialHeaders(); + + my %seen; + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + @{ $self->{$type} } + = grep defined && length && !$seen{ lc $_ }++, + @{ $self->{$type} }; + } + + $self->RemoveInappropriateRecipients(); + + # Go add all the Tos, Ccs and Bccs that we need to to the message to + # make it happy, but only if we actually have values in those arrays. + +# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc + + for my $header (@EMAIL_RECIPIENT_HEADERS) { + + $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) ) + if (!$MIMEObj->head->get($header) + && $self->{$header} + && @{ $self->{$header} } ); + } + # PseudoTo (fake to headers) shouldn't get matched for message recipients. + # If we don't have any 'To' header (but do have other recipients), drop in + # the pseudo-to header. + $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) ) + if $self->{'PseudoTo'} + && @{ $self->{'PseudoTo'} } + && !$MIMEObj->head->get('To') + && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') ); + + # We should never have to set the MIME-Version header + $self->SetHeader( 'MIME-Version', '1.0' ); + + # fsck.com #5959: Since RT sends 8bit mail, we should say so. + $self->SetHeader( 'Content-Transfer-Encoding', '8bit' ); + + # For security reasons, we only send out textual mails. + foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) { + my $type = $part->mime_type || 'text/plain'; + $type = 'text/plain' unless RT::I18N::IsTextualContentType($type); + $part->head->mime_attr( "Content-Type" => $type ); + # utf-8 here is for _FindOrGuessCharset in I18N.pm + # it's not the final charset/encoding sent + $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); + } + + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, + RT->Config->Get('EmailOutputEncoding'), + 'mime_words_ok', ); + + # Build up a MIME::Entity that looks like the original message. + $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message') + && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) ); + + $self->AddTickets; + + my $attachment = $self->TransactionObj->Attachments->First; + if ($attachment + && !( + $attachment->GetHeader('X-RT-Encrypt') + || $self->TicketObj->QueueObj->Encrypt + ) + ) + { + $attachment->SetHeader( 'X-RT-Encrypt' => 1 ) + if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq + 'Success'; + } + + return $result; +} + +=head2 To + +Returns an array of L objects containing all the To: recipients for this notification + +=cut + +sub To { + my $self = shift; + return ( $self->AddressesFromHeader('To') ); +} + +=head2 Cc + +Returns an array of L objects containing all the Cc: recipients for this notification + +=cut + +sub Cc { + my $self = shift; + return ( $self->AddressesFromHeader('Cc') ); +} + +=head2 Bcc + +Returns an array of L objects containing all the Bcc: recipients for this notification + +=cut + +sub Bcc { + my $self = shift; + return ( $self->AddressesFromHeader('Bcc') ); + +} + +sub AddressesFromHeader { + my $self = shift; + my $field = shift; + my $header = $self->TemplateObj->MIMEObj->head->get($field); + my @addresses = Email::Address->parse($header); + + return (@addresses); +} + +=head2 SendMessage MIMEObj + +sends the message using RT's preferred API. +TODO: Break this out to a separate module + +=cut + +sub SendMessage { + + # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's + # ability to pass @_ to a 'post' routine. + my ( $self, $MIMEObj ) = @_; + + my $msgid = $MIMEObj->head->get('Message-ID'); + chomp $msgid; + + $self->ScripActionObj->{_Message_ID}++; + + $RT::Logger->info( $msgid . " #" + . $self->TicketObj->id . "/" + . $self->TransactionObj->id + . " - Scrip " + . ($self->ScripObj->id || '#rule'). " " + . ( $self->ScripObj->Description || '' ) ); + + my $status = RT::Interface::Email::SendEmail( + Entity => $MIMEObj, + Ticket => $self->TicketObj, + Transaction => $self->TransactionObj, + ); + + + return $status unless ($status > 0 || exists $self->{'Deferred'}); + + my $success = $msgid . " sent "; + foreach (@EMAIL_RECIPIENT_HEADERS) { + my $recipients = $MIMEObj->head->get($_); + $success .= " $_: " . $recipients if $recipients; + } + + if( exists $self->{'Deferred'} ) { + for (qw(daily weekly susp)) { + $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } ) + if exists $self->{'Deferred'}{ $_ }; + } + } + + $success =~ s/\n//g; + + $RT::Logger->info($success); + + return (1); +} + +=head2 AddAttachments + +Takes any attachments to this transaction and attaches them to the message +we're building. + +=cut + +sub AddAttachments { + my $self = shift; + + my $MIMEObj = $self->TemplateObj->MIMEObj; + + $MIMEObj->head->delete('RT-Attach-Message'); + + my $attachments = RT::Attachments->new( RT->SystemUser ); + $attachments->Limit( + FIELD => 'TransactionId', + VALUE => $self->TransactionObj->Id + ); + + # Don't attach anything blank + $attachments->LimitNotEmpty; + $attachments->OrderBy( FIELD => 'id' ); + + # We want to make sure that we don't include the attachment that's + # being used as the "Content" of this message" unless that attachment's + # content type is not like text/... + my $transaction_content_obj = $self->TransactionObj->ContentObj; + + if ( $transaction_content_obj + && $transaction_content_obj->ContentType =~ m{text/}i ) + { + # If this was part of a multipart/alternative, skip all of the kids + my $parent = $transaction_content_obj->ParentObj; + if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'parent', + OPERATOR => '!=', + VALUE => $parent->Id, + ); + } else { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'id', + OPERATOR => '!=', + VALUE => $transaction_content_obj->Id, + ); + } + } + + # attach any of this transaction's attachments + my $seen_attachment = 0; + while ( my $attach = $attachments->Next ) { + if ( !$seen_attachment ) { + $MIMEObj->make_multipart( 'mixed', Force => 1 ); + $seen_attachment = 1; + } + $self->AddAttachment($attach); + } +} + +=head2 AddAttachment $attachment + +Takes one attachment object of L class and attaches it to the message +we're building. + +=cut + +sub AddAttachment { + my $self = shift; + my $attach = shift; + my $MIMEObj = shift || $self->TemplateObj->MIMEObj; + + # $attach->TransactionObj may not always be $self->TransactionObj + return unless $attach->Id + and $attach->TransactionObj->CurrentUserCanSee; + + # ->attach expects just the disposition type; extract it if we have the header + # or default to "attachment" + my $disp = ($attach->GetHeader('Content-Disposition') || '') + =~ /^\s*(inline|attachment)/i ? $1 : "attachment"; + + $MIMEObj->attach( + Type => $attach->ContentType, + Charset => $attach->OriginalEncoding, + Data => $attach->OriginalContent, + Disposition => $disp, + Filename => $self->MIMEEncodeString( $attach->Filename ), + 'RT-Attachment:' => $self->TicketObj->Id . "/" + . $self->TransactionObj->Id . "/" + . $attach->id, + Encoding => '-SUGGEST', + ); +} + +=head2 AttachTickets [@IDs] + +Returns or set list of ticket's IDs that should be attached to an outgoing message. + +B this method works as a class method and setup things global, so you have to +clean list by passing undef as argument. + +=cut + +{ + my $list = []; + + sub AttachTickets { + my $self = shift; + $list = [ grep defined, @_ ] if @_; + return @$list; + } +} + +=head2 AddTickets + +Attaches tickets to the current message, list of tickets' ids get from +L method. + +=cut + +sub AddTickets { + my $self = shift; + $self->AddTicket($_) foreach $self->AttachTickets; + return; +} + +=head2 AddTicket $ID + +Attaches a ticket with ID to the message. + +Each ticket is attached as multipart entity and all its messages and attachments +are attached as sub entities in order of creation, but only if transaction type +is Create or Correspond. + +=cut + +sub AddTicket { + my $self = shift; + my $tid = shift; + + my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj ); + my $txn_alias = $attachs->TransactionAlias; + $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' ); + $attachs->Limit( + ALIAS => $txn_alias, + FIELD => 'Type', + VALUE => 'Correspond' + ); + $attachs->LimitByTicket($tid); + $attachs->LimitNotEmpty; + $attachs->OrderBy( FIELD => 'Created' ); + + my $ticket_mime = MIME::Entity->build( + Type => 'multipart/mixed', + Top => 0, + Description => "ticket #$tid", + ); + while ( my $attachment = $attachs->Next ) { + $self->AddAttachment( $attachment, $ticket_mime ); + } + if ( $ticket_mime->parts ) { + my $email_mime = $self->TemplateObj->MIMEObj; + $email_mime->make_multipart; + $email_mime->add_part($ticket_mime); + } + return; +} + +=head2 RecordOutgoingMailTransaction MIMEObj + +Record a transaction in RT with this outgoing message for future record-keeping purposes + +=cut + +sub RecordOutgoingMailTransaction { + my $self = shift; + my $MIMEObj = shift; + + my @parts = $MIMEObj->parts; + my @attachments; + my @keep; + foreach my $part (@parts) { + my $attach = $part->head->get('RT-Attachment'); + if ($attach) { + $RT::Logger->debug( + "We found an attachment. we want to not record it."); + push @attachments, $attach; + } else { + $RT::Logger->debug("We found a part. we want to record it."); + push @keep, $part; + } + } + $MIMEObj->parts( \@keep ); + foreach my $attachment (@attachments) { + $MIMEObj->head->add( 'RT-Attachment', $attachment ); + } + + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' ); + + my $transaction + = RT::Transaction->new( $self->TransactionObj->CurrentUser ); + +# XXX: TODO -> Record attachments as references to things in the attachments table, maybe. + + my $type; + if ( $self->TransactionObj->Type eq 'Comment' ) { + $type = 'CommentEmailRecord'; + } else { + $type = 'EmailRecord'; + } + + my $msgid = $MIMEObj->head->get('Message-ID'); + chomp $msgid; + + my ( $id, $msg ) = $transaction->Create( + Ticket => $self->TicketObj->Id, + Type => $type, + Data => $msgid, + MIMEObj => $MIMEObj, + ActivateScrips => 0 + ); + + if ($id) { + $self->{'OutgoingMailTransaction'} = $id; + } else { + $RT::Logger->warning( + "Could not record outgoing message transaction: $msg"); + } + return $id; +} + +=head2 SetRTSpecialHeaders + +This routine adds all the random headers that RT wants in a mail message +that don't matter much to anybody else. + +=cut + +sub SetRTSpecialHeaders { + my $self = shift; + + $self->SetSubject(); + $self->SetSubjectToken(); + $self->SetHeaderAsEncoding( 'Subject', + RT->Config->Get('EmailOutputEncoding') ) + if ( RT->Config->Get('EmailOutputEncoding') ); + $self->SetReturnAddress(); + $self->SetReferencesHeaders(); + + unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) { + + # Get Message-ID for this txn + my $msgid = ""; + if ( my $msg = $self->TransactionObj->Message->First ) { + $msgid = $msg->GetHeader("RT-Message-ID") + || $msg->GetHeader("Message-ID"); + } + + # If there is one, and we can parse it, then base our Message-ID on it + if ( $msgid + and $msgid + =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/ + "<$1." . $self->TicketObj->id + . "-" . $self->ScripObj->id + . "-" . $self->ScripActionObj->{_Message_ID} + . "@" . RT->Config->Get('Organization') . ">"/eg + and $2 == $self->TicketObj->id + ) + { + $self->SetHeader( "Message-ID" => $msgid ); + } else { + $self->SetHeader( + 'Message-ID' => RT::Interface::Email::GenMessageId( + Ticket => $self->TicketObj, + Scrip => $self->ScripObj, + ScripAction => $self->ScripActionObj + ), + ); + } + } + + if (my $precedence = RT->Config->Get('DefaultMailPrecedence') + and !$self->TemplateObj->MIMEObj->head->get("Precedence") + ) { + $self->SetHeader( 'Precedence', $precedence ); + } + + $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') ); + $self->SetHeader( 'RT-Ticket', + RT->Config->Get('rtname') . " #" . $self->TicketObj->id() ); + $self->SetHeader( 'Managed-by', + "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); + +# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be +# refactored into user's method. + if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress + and RT->Config->Get('UseOriginatorHeader') + ) { + $self->SetHeader( 'RT-Originator', $email ); + } + +} + + +sub DeferDigestRecipients { + my $self = shift; + $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id ); + + # The digest attribute will be an array of notifications that need to + # be sent for this transaction. The array will have the following + # format for its objects. + # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc} + # -> sent -> {true|false} + # The "sent" flag will be used by the cron job to indicate that it has + # run on this transaction. + # In a perfect world we might move this hash construction to the + # extension module itself. + my $digest_hash = {}; + + foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) { + # If we have a "PseudoTo", the "To" contains it, so we don't need to access it + next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) ); + $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) ); + + # Store the 'daily digest' folk in an array. + my ( @send_now, @daily_digest, @weekly_digest, @suspended ); + + # Have to get the list of addresses directly from the MIME header + # at this point. + $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); + foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { + next unless $rcpt; + my $user_obj = RT::User->new(RT->SystemUser); + $user_obj->LoadByEmail($rcpt); + if ( ! $user_obj->id ) { + # If there's an email address in here without an associated + # RT user, pass it on through. + $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail."); + push( @send_now, $rcpt ); + next; + } + + my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || ''; + $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt"); + + if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) } + elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) } + elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) } + else { push( @send_now, $rcpt ) } + } + + # Reset the relevant mail field. + $RT::Logger->debug( "Removing deferred recipients from $mailfield: line"); + if (@send_now) { + $self->SetHeader( $mailfield, join( ', ', @send_now ) ); + } else { # No recipients! Remove the header. + $self->TemplateObj->MIMEObj->head->delete($mailfield); + } + + # Push the deferred addresses into the appropriate field in + # our attribute hash, with the appropriate mail header. + $RT::Logger->debug( + "Setting deferred recipients for attribute creation"); + $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest); + $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest); + $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended); + } + + if ( scalar keys %$digest_hash ) { + + # Save the hash so that we can add it as an attribute to the + # outgoing email transaction. + $self->{'Deferred'} = $digest_hash; + } else { + $RT::Logger->debug( "No recipients found for deferred delivery on " + . "transaction #" + . $self->TransactionObj->id ); + } +} + + + +sub RecordDeferredRecipients { + my $self = shift; + return unless exists $self->{'Deferred'}; + + my $txn_id = $self->{'OutgoingMailTransaction'}; + return unless $txn_id; + + my $txn_obj = RT::Transaction->new( $self->CurrentUser ); + $txn_obj->Load( $txn_id ); + my( $ret, $msg ) = $txn_obj->AddAttribute( + Name => 'DeferredRecipients', + Content => $self->{'Deferred'} + ); + $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) + unless $ret; + + return ($ret,$msg); +} + +=head2 SquelchMailTo + +Returns list of the addresses to squelch on this transaction. + +=cut + +sub SquelchMailTo { + my $self = shift; + return map $_->Content, $self->TransactionObj->SquelchMailTo; +} + +=head2 RemoveInappropriateRecipients + +Remove addresses that are RT addresses or that are on this transaction's blacklist + +=cut + +sub RemoveInappropriateRecipients { + my $self = shift; + + my @blacklist = (); + + # If there are no recipients, don't try to send the message. + # If the transaction has content and has the header RT-Squelch-Replies-To + + my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); + if ( my $attachment = $self->TransactionObj->Attachments->First ) { + + if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { + + # What do we want to do with this? It's probably (?) a bounce + # caused by one of the watcher addresses being broken. + # Default ("true") is to redistribute, for historical reasons. + + if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) { + + # Don't send to any watchers. + @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS); + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message based on site configuration." + ); + } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq + 'privileged' ) + { + + # Only send to "privileged" watchers. + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + foreach my $addr ( @{ $self->{$type} } ) { + my $user = RT::User->new(RT->SystemUser); + $user->LoadByEmail($addr); + push @blacklist, $addr unless $user->id && $user->Privileged; + } + } + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message to unprivileged users based on site configuration." + ); + } + } + + if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) { + push @blacklist, split( /,/, $squelch ); + } + } + + # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted + push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo; + + # Cycle through the people we're sending to and pull out anyone on the + # system blacklist + + # Trim leading and trailing spaces. + @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } + Email::Address->parse( join ', ', grep defined, @blacklist ); + + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + my @addrs; + foreach my $addr ( @{ $self->{$type} } ) { + + # Weed out any RT addresses. We really don't want to talk to ourselves! + # If we get a reply back, that means it's not an RT address + if ( !RT::EmailParser->CullRTAddresses($addr) ) { + $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); + next; + } + if ( grep $addr eq $_, @blacklist ) { + $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping"); + next; + } + push @addrs, $addr; + } + foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) { + # never send email to itself + if ( !RT::EmailParser->CullRTAddresses($addr) ) { + $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); + next; + } + push @addrs, $addr; + } + @{ $self->{$type} } = @addrs; + } +} + +=head2 SetReturnAddress is_comment => BOOLEAN + +Calculate and set From and Reply-To headers based on the is_comment flag. + +=cut + +sub SetReturnAddress { + + my $self = shift; + my %args = ( + is_comment => 0, + friendly_name => undef, + @_ + ); + + # From and Reply-To + # $args{is_comment} should be set if the comment address is to be used. + my $replyto; + + if ( $args{'is_comment'} ) { + $replyto = $self->TicketObj->QueueObj->CommentAddress + || RT->Config->Get('CommentAddress'); + } else { + $replyto = $self->TicketObj->QueueObj->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); + } + + unless ( $self->TemplateObj->MIMEObj->head->get('From') ) { + $self->SetFrom( %args, From => $replyto ); + } + + unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) { + $self->SetHeader( 'Reply-To', "$replyto" ); + } + +} + +=head2 SetFrom ( From => emailaddress ) + +Set the From: address for outgoing email + +=cut + +sub SetFrom { + my $self = shift; + my %args = @_; + + my $from = $args{From}; + + if ( RT->Config->Get('UseFriendlyFromLine') ) { + my $friendly_name = $self->GetFriendlyName(%args); + $from = + sprintf( + RT->Config->Get('FriendlyFromLineFormat'), + $self->MIMEEncodeString( + $friendly_name, RT->Config->Get('EmailOutputEncoding') + ), + $args{From} + ); + } + + $self->SetHeader( 'From', $from ); + + #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine, + #and then Outlook prepends "rt@machine on behalf of" to the From: header + $self->SetHeader( 'Sender', $from ); +} + +=head2 GetFriendlyName + +Calculate the proper Friendly Name based on the creator of the transaction + +=cut + +sub GetFriendlyName { + my $self = shift; + my %args = ( + is_comment => 0, + friendly_name => '', + @_ + ); + my $friendly_name = $args{friendly_name}; + + unless ( $friendly_name ) { + $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName; + if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string + $friendly_name = $1; + } + } + + $friendly_name =~ s/"/\\"/g; + return $friendly_name; + +} + +=head2 SetHeader FIELD, VALUE + +Set the FIELD of the current MIME object into VALUE. + +=cut + +sub SetHeader { + my $self = shift; + my $field = shift; + my $val = shift; + + chomp $val; + chomp $field; + my $head = $self->TemplateObj->MIMEObj->head; + $head->fold_length( $field, 10000 ); + $head->replace( $field, $val ); + return $head->get($field); +} + +=head2 SetSubject + +This routine sets the subject. it does not add the rt tag. That gets done elsewhere +If subject is already defined via template, it uses that. otherwise, it tries to get +the transaction's subject. + +=cut + +sub SetSubject { + my $self = shift; + my $subject; + + if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { + return (); + } + + # don't use Transaction->Attachments because it caches + # and anything which later calls ->Attachments will be hurt + # by our RowsPerPage() call. caching is hard. + my $message = RT::Attachments->new( $self->CurrentUser ); + $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id); + $message->OrderBy( FIELD => 'id', ORDER => 'ASC' ); + $message->RowsPerPage(1); + + if ( $self->{'Subject'} ) { + $subject = $self->{'Subject'}; + } elsif ( my $first = $message->First ) { + my $tmp = $first->GetHeader('Subject'); + $subject = defined $tmp ? $tmp : $self->TicketObj->Subject; + } else { + $subject = $self->TicketObj->Subject; + } + $subject = '' unless defined $subject; + chomp $subject; + + $subject =~ s/(\r\n|\n|\s)/ /g; + + $self->SetHeader( 'Subject', Encode::encode_utf8( $subject ) ); + +} + +=head2 SetSubjectToken + +This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. + +=cut + +sub SetSubjectToken { + my $self = shift; + + my $head = $self->TemplateObj->MIMEObj->head; + $self->SetHeader( + Subject => + Encode::encode_utf8( + RT::Interface::Email::AddSubjectTag( + Encode::decode_utf8( $head->get('Subject') ), + $self->TicketObj, + ), + ), + ); +} + +=head2 SetReferencesHeaders + +Set References and In-Reply-To headers for this message. + +=cut + +sub SetReferencesHeaders { + my $self = shift; + + my $top = $self->TransactionObj->Message->First; + unless ( $top ) { + $self->SetHeader( References => $self->PseudoReference ); + return (undef); + } + + my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' ); + my @references = split( /\s+/m, $top->GetHeader('References') || '' ); + my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' ); + + # There are two main cases -- this transaction was created with + # the RT Web UI, and hence we want to *not* append its Message-ID + # to the References and In-Reply-To. OR it came from an outside + # source, and we should treat it as per the RFC + my $org = RT->Config->Get('Organization'); + if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) { + + # Make all references which are internal be to version which we + # have sent out + + for ( @references, @in_reply_to ) { + s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/ + "<$1." . $self->TicketObj->id . + "-" . $self->ScripObj->id . + "-" . $self->ScripActionObj->{_Message_ID} . + "@" . $org . ">"/eg + } + + # In reply to whatever the internal message was in reply to + $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) ); + + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; + + # References are unchanged from internal + } else { + + # In reply to that message + $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) ); + + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; + + # Push that message onto the end of the references + push @references, @msgid; + } + + # Push pseudo-ref to the front + my $pseudo_ref = $self->PseudoReference; + @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references ); + + # If there are more than 10 references headers, remove all but the + # first four and the last six (Gotta keep this from growing + # forever) + splice( @references, 4, -6 ) if ( $#references >= 10 ); + + # Add on the references + $self->SetHeader( 'References', join( " ", @references ) ); + $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 ); + +} + +=head2 PseudoReference + +Returns a fake Message-ID: header for the ticket to allow a base level of threading + +=cut + +sub PseudoReference { + + my $self = shift; + my $pseudo_ref + = 'TicketObj->id . '@' + . RT->Config->Get('Organization') . '>'; + return $pseudo_ref; +} + +=head2 SetHeaderAsEncoding($field_name, $charset_encoding) + +This routine converts the field into specified charset encoding. + +=cut + +sub SetHeaderAsEncoding { + my $self = shift; + my ( $field, $enc ) = ( shift, shift ); + + my $head = $self->TemplateObj->MIMEObj->head; + + if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { + $head->replace( $field, RT->Config->Get('SMTPFrom') ); + return; + } + + my $value = $head->get( $field ); + $value = $self->MIMEEncodeString( $value, $enc ); + $head->replace( $field, $value ); + +} + +=head2 MIMEEncodeString + +Takes a perl string and optional encoding pass it over +L. + +Basicly encode a string using B encoding according to RFC2047. + +=cut + +sub MIMEEncodeString { + my $self = shift; + return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] ); +} + +RT::Base->_ImportOverlays(); + +1; + diff --git a/rt/lib/RT/Attachment.pm b/rt/lib/RT/Attachment.pm index 07fdea3b2..af1f82c15 100755 --- a/rt/lib/RT/Attachment.pm +++ b/rt/lib/RT/Attachment.pm @@ -128,19 +128,17 @@ sub Create { $Attachment->make_singlepart; # Get the subject - my $Subject = $Attachment->head->get( 'subject', 0 ); + my $Subject = Encode::decode( 'UTF-8', $Attachment->head->get( 'subject' ) ); $Subject = '' unless defined $Subject; chomp $Subject; - utf8::decode( $Subject ) unless utf8::is_utf8( $Subject ); #Get the Message-ID - my $MessageId = $Attachment->head->get( 'Message-ID', 0 ); + my $MessageId = Encode::decode( "UTF-8", $Attachment->head->get( 'Message-ID' ) ); defined($MessageId) or $MessageId = ''; chomp ($MessageId); $MessageId =~ s/^<(.*?)>$/$1/o; #Get the filename - my $Filename = mime_recommended_filename($Attachment); # remove path part. @@ -148,8 +146,7 @@ sub Create { # MIME::Head doesn't support perl strings well and can return # octets which later will be double encoded in low-level code - my $head = $Attachment->head->as_string; - utf8::decode( $head ) unless utf8::is_utf8( $head ); + my $head = Encode::decode( 'UTF-8', $Attachment->head->as_string ); # If a message has no bodyhandle, that means that it has subparts (or appears to) # and we should act accordingly. @@ -289,7 +286,7 @@ before returning it. sub Content { my $self = shift; return $self->_DecodeLOB( - $self->ContentType, + $self->GetHeader('Content-Type'), # Includes charset, unlike ->ContentType $self->ContentEncoding, $self->_Value('Content', decode_utf8 => 0), ); @@ -320,7 +317,6 @@ sub OriginalContent { } return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); - my $enc = $self->OriginalEncoding; my $content; if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) { @@ -333,18 +329,20 @@ sub OriginalContent { return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); } - # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work. - local $@; - Encode::_utf8_off($content); + my $entity = MIME::Entity->new(); + $entity->head->add("Content-Type", $self->GetHeader("Content-Type")); + $entity->bodyhandle( MIME::Body::Scalar->new( $content ) ); + my $from = RT::I18N::_FindOrGuessCharset($entity); + $from = 'utf-8' if not $from or not Encode::find_encoding($from); - if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') { - # If we somehow fail to do the decode, at least push out the raw bits - eval { return( Encode::decode_utf8($content)) } || return ($content); - } + my $to = RT::I18N::_CanonicalizeCharset( + $self->OriginalEncoding || 'utf-8' + ); - eval { Encode::from_to($content, 'utf8' => $enc) } if $enc; + local $@; + eval { Encode::from_to($content, $from => $to) }; if ($@) { - $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@); + $RT::Logger->error("Could not convert attachment from $from to $to: ".$@); } return $content; } diff --git a/rt/lib/RT/Config.pm b/rt/lib/RT/Config.pm index 62aae1c35..b97802f7a 100644 --- a/rt/lib/RT/Config.pm +++ b/rt/lib/RT/Config.pm @@ -1024,7 +1024,6 @@ sub Get { my $res; if ( $user && $user->id && $META{$name}->{'Overridable'} ) { - $user = $user->UserObj if $user->isa('RT::CurrentUser'); my $prefs = $user->Preferences($RT::System); $res = $prefs->{$name} if $prefs; } diff --git a/rt/lib/RT/Config.pm.orig b/rt/lib/RT/Config.pm.orig new file mode 100644 index 000000000..62aae1c35 --- /dev/null +++ b/rt/lib/RT/Config.pm.orig @@ -0,0 +1,1382 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +package RT::Config; + +use strict; +use warnings; + + +use File::Spec (); + +=head1 NAME + + RT::Config - RT's config + +=head1 SYNOPSYS + + # get config object + use RT::Config; + my $config = RT::Config->new; + $config->LoadConfigs; + + # get or set option + my $rt_web_path = $config->Get('WebPath'); + $config->Set(EmailOutputEncoding => 'latin1'); + + # get config object from RT package + use RT; + RT->LoadConfig; + my $config = RT->Config; + +=head1 DESCRIPTION + +C class provide access to RT's and RT extensions' config files. + +RT uses two files for site configuring: + +First file is F - core config file. This file is shipped +with RT distribution and contains default values for all available options. +B + +Second file is F - site config file. You can use it +to customize your RT instance. In this file you can override any option +listed in core config file. + +RT extensions could also provide thier config files. Extensions should +use F<< _Config.pm >> and F<< _SiteConfig.pm >> names for +config files, where is extension name. + +B: All options from RT's config and extensions' configs are saved +in one place and thus extension could override RT's options, but it is not +recommended. + +=cut + +=head2 %META + +Hash of Config options that may be user overridable +or may require more logic than should live in RT_*Config.pm + +Keyed by config name, there are several properties that +can be set for each config optin: + + Section - What header this option should be grouped + under on the user Settings page + Overridable - Can users change this option + SortOrder - Within a Section, how should the options be sorted + for display to the user + Widget - Mason component path to widget that should be used + to display this config option + WidgetArguments - An argument hash passed to the WIdget + Description - Friendly description to show the user + Values - Arrayref of options (for select Widget) + ValuesLabel - Hashref, key is the Value from the Values + list, value is a user friendly description + of the value + Callback - subref that receives no arguments. It returns + a hashref of items that are added to the rest + of the WidgetArguments + PostLoadCheck - subref passed the RT::Config object and the current + setting of the config option. Can make further checks + (such as seeing if a library is installed) and then change + the setting of this or other options in the Config using + the RT::Config option. + Obfuscate - subref passed the RT::Config object, current setting of the config option + and a user object, can return obfuscated value. it's called in + RT->Config->GetObfuscated() + +=cut + +our %META = ( + # General user overridable options + DefaultQueue => { + Section => 'General', + Overridable => 1, + SortOrder => 1, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Default queue', #loc + Callback => sub { + my $ret = { Values => [], ValuesLabel => {}}; + my $q = RT::Queues->new($HTML::Mason::Commands::session{'CurrentUser'}); + $q->UnLimit; + while (my $queue = $q->Next) { + next unless $queue->CurrentUserHasRight("CreateTicket"); + push @{$ret->{Values}}, $queue->Id; + $ret->{ValuesLabel}{$queue->Id} = $queue->Name; + } + return $ret; + }, + } + }, + RememberDefaultQueue => { + Section => 'General', + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Remember default queue' # loc + } + }, + UsernameFormat => { + Section => 'General', + Overridable => 1, + SortOrder => 3, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Username format', # loc + Values => [qw(concise verbose)], + ValuesLabel => { + concise => 'Short usernames', # loc + verbose => 'Name and email address', # loc + }, + }, + }, + AutocompleteOwners => { + Section => 'General', + Overridable => 1, + SortOrder => 3.1, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Use autocomplete to find owners?', # loc + Hints => 'Replaces the owner dropdowns with textboxes' #loc + } + }, + WebDefaultStylesheet => { + Section => 'General', #loc + Overridable => 1, + SortOrder => 4, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Theme', #loc + # XXX: we need support for 'get values callback' + Values => [qw(web2 freeside2.1 freeside3 aileron ballard)], + }, + PostLoadCheck => sub { + my $self = shift; + my $value = $self->Get('WebDefaultStylesheet'); + + my @comp_roots = RT::Interface::Web->ComponentRoots; + for my $comp_root (@comp_roots) { + return if -d $comp_root.'/NoAuth/css/'.$value; + } + + $RT::Logger->warning( + "The default stylesheet ($value) does not exist in this instance of RT. " + . "Defaulting to freeside3." + ); + + #$self->Set('WebDefaultStylesheet', 'aileron'); + $self->Set('WebDefaultStylesheet', 'freeside3'); + }, + }, + UseSideBySideLayout => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 5, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Use a two column layout for create and update forms?' # loc + } + }, + MessageBoxRichText => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 5.1, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'WYSIWYG message composer' # loc + } + }, + MessageBoxRichTextHeight => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 6, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'WYSIWYG composer height', # loc + } + }, + MessageBoxWidth => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 7, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Message box width', #loc + }, + }, + MessageBoxHeight => { + Section => 'Ticket composition', + Overridable => 1, + SortOrder => 8, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Message box height', #loc + }, + }, + MessageBoxWrap => { + Section => 'Ticket composition', #loc + Overridable => 1, + SortOrder => 8.1, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Message box wrapping', #loc + Values => [qw(SOFT HARD)], + Hints => "When the WYSIWYG editor is not enabled, this setting determines whether automatic line wraps in the ticket message box are sent to RT or not.", # loc + }, + }, + DefaultTimeUnitsToHours => { + Section => 'Ticket composition', #loc + Overridable => 1, + SortOrder => 9, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Enter time in hours by default', #loc + Hints => 'Only for entry, not display', #loc + }, + }, + SearchResultsRefreshInterval => { + Section => 'General', #loc + Overridable => 1, + SortOrder => 9, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Search results refresh interval', #loc + Values => [qw(0 120 300 600 1200 3600 7200)], + ValuesLabel => { + 0 => "Don't refresh search results.", #loc + 120 => "Refresh search results every 2 minutes.", #loc + 300 => "Refresh search results every 5 minutes.", #loc + 600 => "Refresh search results every 10 minutes.", #loc + 1200 => "Refresh search results every 20 minutes.", #loc + 3600 => "Refresh search results every 60 minutes.", #loc + 7200 => "Refresh search results every 120 minutes.", #loc + }, + }, + }, + + # User overridable options for RT at a glance + HomePageRefreshInterval => { + Section => 'RT at a glance', #loc + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Home page refresh interval', #loc + Values => [qw(0 120 300 600 1200 3600 7200)], + ValuesLabel => { + 0 => "Don't refresh home page.", #loc + 120 => "Refresh home page every 2 minutes.", #loc + 300 => "Refresh home page every 5 minutes.", #loc + 600 => "Refresh home page every 10 minutes.", #loc + 1200 => "Refresh home page every 20 minutes.", #loc + 3600 => "Refresh home page every 60 minutes.", #loc + 7200 => "Refresh home page every 120 minutes.", #loc + }, + }, + }, + + # User overridable options for Ticket displays + MaxInlineBody => { + Section => 'Ticket display', #loc + Overridable => 1, + SortOrder => 1, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Maximum inline message length', #loc + Hints => + "Length in characters; Use '0' to show all messages inline, regardless of length" #loc + }, + }, + OldestTransactionsFirst => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Show oldest history first', #loc + }, + }, + DeferTransactionLoading => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 3, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Hide ticket history by default', #loc + }, + }, + ShowUnreadMessageNotifications => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 4, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Notify me of unread messages', #loc + }, + + }, + PlainTextPre => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 5, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'add 
 tag around plain text attachments', #loc
+            Hints       => "Use this to protect the format of plain text" #loc
+        },
+    },
+    PlainTextMono => {
+        Section         => 'Ticket display',
+        Overridable     => 1,
+        SortOrder       => 5,
+        Widget          => '/Widgets/Form/Boolean',
+        WidgetArguments => {
+            Description => 'display wrapped and formatted plain text attachments', #loc
+            Hints => 'Use css rules to display text monospaced and with formatting preserved, but wrap as needed.  This does not work well with IE6 and you should use the previous option', #loc
+        },
+    },
+    DisplayAfterQuickCreate => {
+        Section         => 'Ticket display',
+        Overridable     => 1,
+        SortOrder       => 6,
+        Widget          => '/Widgets/Form/Boolean',
+        WidgetArguments => {
+            Description => 'On Quick Create, redirect to ticket display', #loc
+            #Hints => '', #loc
+        },
+    },
+    MoreAboutRequestorTicketList => {
+        Section         => 'Ticket display',                       #loc
+        Overridable     => 1,
+        SortOrder       => 6,
+        Widget          => '/Widgets/Form/Select',
+        WidgetArguments => {
+            Description => q|What tickets to display in the 'More about requestor' box|,                #loc
+            Values      => [qw(Active Inactive All None)],
+            ValuesLabel => {
+                Active   => "Show the Requestor's 10 highest priority active tickets",                  #loc
+                Inactive => "Show the Requestor's 10 highest priority inactive tickets",      #loc
+                All      => "Show the Requestor's 10 highest priority tickets",      #loc
+                None     => "Show no tickets for the Requestor", #loc
+            },
+        },
+    },
+    SimplifiedRecipients => {
+        Section         => 'Ticket display',                       #loc
+        Overridable     => 1,
+        SortOrder       => 7,
+        Widget          => '/Widgets/Form/Boolean',
+        WidgetArguments => {
+            Description => q|Show simplified recipient list on ticket update|,                #loc
+        },
+    },
+    DisplayTicketAfterQuickCreate => {
+        Section         => 'Ticket display',
+        Overridable     => 1,
+        SortOrder       => 8,
+        Widget          => '/Widgets/Form/Boolean',
+        WidgetArguments => {
+            Description => q{Display ticket after "Quick Create"}, #loc
+        },
+    },
+
+    # User overridable locale options
+    DateTimeFormat => {
+        Section         => 'Locale',                       #loc
+        Overridable     => 1,
+        Widget          => '/Widgets/Form/Select',
+        WidgetArguments => {
+            Description => 'Date format',                            #loc
+            Callback => sub { my $ret = { Values => [], ValuesLabel => {}};
+                              my $date = RT::Date->new($HTML::Mason::Commands::session{'CurrentUser'});
+                              $date->SetToNow;
+                              foreach my $value ($date->Formatters) {
+                                 push @{$ret->{Values}}, $value;
+                                 $ret->{ValuesLabel}{$value} = $date->Get(
+                                     Format     => $value,
+                                     Timezone   => 'user',
+                                 );
+                              }
+                              return $ret;
+            },
+        },
+    },
+
+    RTAddressRegexp => {
+        Type    => 'SCALAR',
+        PostLoadCheck => sub {
+            my $self = shift;
+            my $value = $self->Get('RTAddressRegexp');
+            if (not $value) {
+                $RT::Logger->debug(
+                    'The RTAddressRegexp option is not set in the config.'
+                    .' Not setting this option results in additional SQL queries to'
+                    .' check whether each address belongs to RT or not.'
+                    .' It is especially important to set this option if RT recieves'
+                    .' emails on addresses that are not in the database or config.'
+                );
+            } elsif (ref $value and ref $value eq "Regexp") {
+                # Ensure that the regex is case-insensitive; while the
+                # local part of email addresses is _technically_
+                # case-sensitive, most MTAs don't treat it as such.
+                $RT::Logger->warning(
+                    'RTAddressRegexp is set to a case-sensitive regular expression.'
+                    .' This may lead to mail loops with MTAs which treat the'
+                    .' local part as case-insensitive -- which is most of them.'
+                ) if "$value" =~ /^\(\?[a-z]*-([a-z]*):/ and "$1" =~ /i/;
+            }
+        },
+    },
+    # User overridable mail options
+    EmailFrequency => {
+        Section         => 'Mail',                                     #loc
+        Overridable     => 1,
+        Default     => 'Individual messages',
+        Widget          => '/Widgets/Form/Select',
+        WidgetArguments => {
+            Description => 'Email delivery',    #loc
+            Values      => [
+            'Individual messages',    #loc
+            'Daily digest',           #loc
+            'Weekly digest',          #loc
+            'Suspended'               #loc
+            ]
+        }
+    },
+    NotifyActor => {
+        Section         => 'Mail',                                     #loc
+        Overridable     => 1,
+        SortOrder       => 2,
+        Widget          => '/Widgets/Form/Boolean',
+        WidgetArguments => {
+            Description => 'Outgoing mail', #loc
+            Hints => 'Should RT send you mail for ticket updates you make?', #loc
+        }
+    },
+
+    # this tends to break extensions that stash links in ticket update pages
+    Organization => {
+        Type            => 'SCALAR',
+        PostLoadCheck   => sub {
+            my ($self,$value) = @_;
+            $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace.  Please fix this.")
+                if $value =~ /\s/;;
+        },
+    },
+
+    # Internal config options
+    FullTextSearch => {
+        Type => 'HASH',
+        PostLoadCheck => sub {
+            my $self = shift;
+            my $v = $self->Get('FullTextSearch');
+            return unless $v->{Enable} and $v->{Indexed};
+            my $dbtype = $self->Get('DatabaseType');
+            if ($dbtype eq 'Oracle') {
+                if (not $v->{IndexName}) {
+                    $RT::Logger->error("No IndexName set for full-text index; disabling");
+                    $v->{Enable} = $v->{Indexed} = 0;
+                }
+            } elsif ($dbtype eq 'Pg') {
+                my $bad = 0;
+                if (not $v->{'Column'}) {
+                    $RT::Logger->error("No Column set for full-text index; disabling");
+                    $v->{Enable} = $v->{Indexed} = 0;
+                } elsif ($v->{'Column'} eq "Content"
+                             and (not $v->{'Table'} or $v->{'Table'} eq "Attachments")) {
+                    $RT::Logger->error("Column for full-text index is set to Content, not tsvector column; disabling");
+                    $v->{Enable} = $v->{Indexed} = 0;
+                }
+            } elsif ($dbtype eq 'mysql') {
+                if (not $v->{'Table'}) {
+                    $RT::Logger->error("No Table set for full-text index; disabling");
+                    $v->{Enable} = $v->{Indexed} = 0;
+                } elsif ($v->{'Table'} eq "Attachments") {
+                    $RT::Logger->error("Table for full-text index is set to Attachments, not SphinxSE table; disabling");
+                    $v->{Enable} = $v->{Indexed} = 0;
+                } elsif (not $v->{'MaxMatches'}) {
+                    $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000");
+                    $v->{MaxMatches} = 10_000;
+                }
+            } else {
+                $RT::Logger->error("Indexed full-text-search not supported for $dbtype");
+                $v->{Indexed} = 0;
+            }
+        },
+    },
+    DisableGraphViz => {
+        Type            => 'SCALAR',
+        PostLoadCheck   => sub {
+            my $self  = shift;
+            my $value = shift;
+            return if $value;
+            return if $INC{'GraphViz.pm'};
+            local $@;
+            return if eval {require GraphViz; 1};
+            $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
+            $self->Set( DisableGraphViz => 1 );
+        },
+    },
+    DisableGD => {
+        Type            => 'SCALAR',
+        PostLoadCheck   => sub {
+            my $self  = shift;
+            my $value = shift;
+            return if $value;
+            return if $INC{'GD.pm'};
+            local $@;
+            return if eval {require GD; 1};
+            $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
+            $self->Set( DisableGD => 1 );
+        },
+    },
+    MailPlugins  => { Type => 'ARRAY' },
+    Plugins      => {
+        Type => 'ARRAY',
+        PostLoadCheck => sub {
+            my $self = shift;
+            my $value = $self->Get('Plugins');
+            # XXX Remove in RT 4.2
+            return unless $value and grep {$_ eq "RT::FM"} @{$value};
+            warn 'RTFM has been integrated into core RT, and must be removed from your @Plugins';
+        },
+    },
+    GnuPG        => { Type => 'HASH' },
+    GnuPGOptions => { Type => 'HASH',
+        PostLoadCheck => sub {
+            my $self = shift;
+            my $gpg = $self->Get('GnuPG');
+            return unless $gpg->{'Enable'};
+            my $gpgopts = $self->Get('GnuPGOptions');
+            unless (-d $gpgopts->{homedir}  && -r _ ) { # no homedir, no gpg
+                $RT::Logger->debug(
+                    "RT's GnuPG libraries couldn't successfully read your".
+                    " configured GnuPG home directory (".$gpgopts->{homedir}
+                    ."). PGP support has been disabled");
+                $gpg->{'Enable'} = 0;
+                return;
+            }
+
+
+            require RT::Crypt::GnuPG;
+            unless (RT::Crypt::GnuPG->Probe()) {
+                $RT::Logger->debug(
+                    "RT's GnuPG libraries couldn't successfully execute gpg.".
+                    " PGP support has been disabled");
+                $gpg->{'Enable'} = 0;
+            }
+        }
+    },
+    ReferrerWhitelist => { Type => 'ARRAY' },
+    ResolveDefaultUpdateType => {
+        PostLoadCheck => sub {
+            my $self  = shift;
+            my $value = shift;
+            return unless $value;
+            $RT::Logger->info('The ResolveDefaultUpdateType config option has been deprecated.  '.
+                              'You can change the site default in your %Lifecycles config.');
+        }
+    },
+    WebPath => {
+        PostLoadCheck => sub {
+            my $self  = shift;
+            my $value = shift;
+
+            # "In most cases, you should leave $WebPath set to '' (an empty value)."
+            return unless $value;
+
+            # try to catch someone who assumes that you shouldn't leave this empty
+            if ($value eq '/') {
+                $RT::Logger->error("For the WebPath config option, use the empty string instead of /");
+                return;
+            }
+
+            # $WebPath requires a leading / but no trailing /, or it can be blank.
+            return if $value =~ m{^/.+[^/]$};
+
+            if ($value =~ m{/$}) {
+                $RT::Logger->error("The WebPath config option requires no trailing slash");
+            }
+
+            if ($value !~ m{^/}) {
+                $RT::Logger->error("The WebPath config option requires a leading slash");
+            }
+        },
+    },
+    WebDomain => {
+        PostLoadCheck => sub {
+            my $self  = shift;
+            my $value = shift;
+
+            if (!$value) {
+                $RT::Logger->error("You must set the WebDomain config option");
+                return;
+            }
+
+            if ($value =~ m{^(\w+://)}) {
+                $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)");
+                return;
+            }
+
+            if ($value =~ m{(/.*)}) {
+                $RT::Logger->error("The WebDomain config option must not contain a path ($1)");
+                return;
+            }
+
+            if ($value =~ m{:(\d*)}) {
+                $RT::Logger->error("The WebDomain config option must not contain a port ($1)");
+                return;
+            }
+        },
+    },
+    WebPort => {
+        PostLoadCheck => sub {
+            my $self  = shift;
+            my $value = shift;
+
+            if (!$value) {
+                $RT::Logger->error("You must set the WebPort config option");
+                return;
+            }
+
+            if ($value !~ m{^\d+$}) {
+                $RT::Logger->error("The WebPort config option must be an integer");
+            }
+        },
+    },
+    WebBaseURL => {
+        PostLoadCheck => sub {
+            my $self  = shift;
+            my $value = shift;
+
+            if (!$value) {
+                $RT::Logger->error("You must set the WebBaseURL config option");
+                return;
+            }
+
+            if ($value !~ m{^https?://}i) {
+                $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)");
+            }
+
+            if ($value =~ m{/$}) {
+                $RT::Logger->error("The WebBaseURL config option requires no trailing slash");
+            }
+
+            if ($value =~ m{^https?://.+?(/[^/].*)}i) {
+                $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)");
+            }
+        },
+    },
+    WebURL => {
+        PostLoadCheck => sub {
+            my $self  = shift;
+            my $value = shift;
+
+            if (!$value) {
+                $RT::Logger->error("You must set the WebURL config option");
+                return;
+            }
+
+            if ($value !~ m{^https?://}i) {
+                $RT::Logger->error("The WebURL config option must contain a scheme (http or https)");
+            }
+
+            if ($value !~ m{/$}) {
+                $RT::Logger->error("The WebURL config option requires a trailing slash");
+            }
+        },
+    },
+    EmailInputEncodings => {
+        Type => 'ARRAY',
+        PostLoadCheck => sub {
+            my $self  = shift;
+            my $value = $self->Get('EmailInputEncodings');
+            return unless $value && @$value;
+
+            my %seen;
+            foreach my $encoding ( grep defined && length, splice @$value ) {
+                next if $seen{ $encoding };
+                if ( $encoding eq '*' ) {
+                    unshift @$value, '*';
+                    next;
+                }
+
+                my $canonic = Encode::resolve_alias( $encoding );
+                unless ( $canonic ) {
+                    warn "Unknown encoding '$encoding' in \@EmailInputEncodings option";
+                }
+                elsif ( $seen{ $canonic }++ ) {
+                    next;
+                }
+                else {
+                    push @$value, $canonic;
+                }
+            }
+        },
+    },
+
+    ActiveStatus => {
+        Type => 'ARRAY',
+        PostLoadCheck => sub {
+            my $self  = shift;
+            return unless shift;
+            # XXX Remove in RT 4.2
+            warn < {
+        Type => 'ARRAY',
+        PostLoadCheck => sub {
+            my $self  = shift;
+            return unless shift;
+            # XXX Remove in RT 4.2
+            warn <_Init(@_);
+    return $self;
+}
+
+sub _Init {
+    return;
+}
+
+=head2 InitConfig
+
+Do nothin right now.
+
+=cut
+
+sub InitConfig {
+    my $self = shift;
+    my %args = ( File => '', @_ );
+    $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
+    return 1;
+}
+
+=head2 LoadConfigs
+
+Load all configs. First of all load RT's config then load
+extensions' config files in alphabetical order.
+Takes no arguments.
+
+=cut
+
+sub LoadConfigs {
+    my $self    = shift;
+
+    $self->InitConfig( File => 'RT_Config.pm' );
+    $self->LoadConfig( File => 'RT_Config.pm' );
+
+    my @configs = $self->Configs;
+    $self->InitConfig( File => $_ ) foreach @configs;
+    $self->LoadConfig( File => $_ ) foreach @configs;
+    return;
+}
+
+=head1 LoadConfig
+
+Takes param hash with C field.
+First, the site configuration file is loaded, in order to establish
+overall site settings like hostname and name of RT instance.
+Then, the core configuration file is loaded to set fallback values
+for all settings; it bases some values on settings from the site
+configuration file.
+
+B that core config file don't change options if site config
+has set them so to add value to some option instead of
+overriding you have to copy original value from core config file.
+
+=cut
+
+sub LoadConfig {
+    my $self = shift;
+    my %args = ( File => '', @_ );
+    $args{'File'} =~ s/(?_LoadConfig( %args, File => $site_config );
+    } else {
+        $self->_LoadConfig(%args);
+    }
+    $args{'File'} =~ s/Site(?=Config\.pm$)//;
+    $self->_LoadConfig(%args);
+    return 1;
+}
+
+sub _LoadConfig {
+    my $self = shift;
+    my %args = ( File => '', @_ );
+
+    my ($is_ext, $is_site);
+    if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
+        ($is_ext, $is_site) = ('', 1);
+    } else {
+        $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
+        $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
+    }
+
+    eval {
+        package RT;
+        local *Set = sub(\[$@%]@) {
+            my ( $opt_ref, @args ) = @_;
+            my ( $pack, $file, $line ) = caller;
+            return $self->SetFromConfig(
+                Option     => $opt_ref,
+                Value      => [@args],
+                Package    => $pack,
+                File       => $file,
+                Line       => $line,
+                SiteConfig => $is_site,
+                Extension  => $is_ext,
+            );
+        };
+        my @etc_dirs = ($RT::LocalEtcPath);
+        push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
+        push @etc_dirs, $RT::EtcPath, @INC;
+        local @INC = @etc_dirs;
+        require $args{'File'};
+    };
+    if ($@) {
+        return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/;
+        if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) {
+            die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
+        }
+
+        my $username = getpwuid($>);
+        my $group    = getgrgid($();
+
+        my ( $file_path, $fileuid, $filegid );
+        foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
+            my $tmp = File::Spec->catfile( $_, $args{File} );
+            ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
+            if ( defined $fileuid ) {
+                $file_path = $tmp;
+                last;
+            }
+        }
+        unless ($file_path) {
+            die
+                qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
+                . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
+        }
+
+        my $message = <Options( Overridable => undef ) ) {
+        $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
+    }
+}
+
+=head2 Configs
+
+Returns list of config files found in local etc, plugins' etc
+and main etc directories.
+
+=cut
+
+sub Configs {
+    my $self    = shift;
+
+    my @configs = ();
+    foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
+        my $mask = File::Spec->catfile( $path, "*_Config.pm" );
+        my @files = glob $mask;
+        @files = grep !/^RT_Config\.pm$/,
+            grep $_ && /^\w+_Config\.pm$/,
+            map { s/^.*[\\\/]//; $_ } @files;
+        push @configs, sort @files;
+    }
+
+    my %seen;
+    @configs = grep !$seen{$_}++, @configs;
+    return @configs;
+}
+
+=head2 Get
+
+Takes name of the option as argument and returns its current value.
+
+In the case of a user-overridable option, first checks the user's
+preferences before looking for site-wide configuration.
+
+Returns values from RT_SiteConfig, RT_Config and then the %META hash
+of configuration variables's "Default" for this config variable,
+in that order.
+
+Returns different things in scalar and array contexts. For scalar
+options it's not that important, however for arrays and hash it's.
+In scalar context returns references to arrays and hashes.
+
+Use C perl's op to force context, especially when you use
+C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
+as perl's '=>' op doesn't change context of the right hand argument to
+scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
+
+It's also important for options that have no default value(no default
+in F). If you don't force scalar context then you'll
+get empty list and all your named args will be messed up. For example
+C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
+will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
+unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
+will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
+
+=cut
+
+sub Get {
+    my ( $self, $name, $user ) = @_;
+
+    my $res;
+    if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
+        $user = $user->UserObj if $user->isa('RT::CurrentUser');
+        my $prefs = $user->Preferences($RT::System);
+        $res = $prefs->{$name} if $prefs;
+    }
+    $res = $OPTIONS{$name}           unless defined $res;
+    $res = $META{$name}->{'Default'} unless defined $res;
+    return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
+}
+
+=head2 GetObfuscated
+
+the same as Get, except it returns Obfuscated value via Obfuscate sub
+
+=cut
+
+sub GetObfuscated {
+    my $self = shift;
+    my ( $name, $user ) = @_;
+    my $obfuscate = $META{$name}->{Obfuscate};
+
+    # we use two Get here is to simplify the logic of the return value
+    # configs need obfuscation are supposed to be less, so won't be too heavy
+
+    return $self->Get(@_) unless $obfuscate;
+
+    my $res = $self->Get(@_);
+    $res = $obfuscate->( $self, $res, $user );
+    return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
+}
+
+=head2 Set
+
+Set option's value to new value. Takes name of the option and new value.
+Returns old value.
+
+The new value should be scalar, array or hash depending on type of the option.
+If the option is not defined in meta or the default RT config then it is of
+scalar type.
+
+=cut
+
+sub Set {
+    my ( $self, $name ) = ( shift, shift );
+
+    my $old = $OPTIONS{$name};
+    my $type = $META{$name}->{'Type'} || 'SCALAR';
+    if ( $type eq 'ARRAY' ) {
+        $OPTIONS{$name} = [@_];
+        { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
+    } elsif ( $type eq 'HASH' ) {
+        $OPTIONS{$name} = {@_};
+        { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
+    } else {
+        $OPTIONS{$name} = shift;
+        {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
+    }
+    $META{$name}->{'Type'} = $type;
+    return $self->_ReturnValue( $old, $type );
+}
+
+sub _ReturnValue {
+    my ( $self, $res, $type ) = @_;
+    return $res unless wantarray;
+
+    if ( $type eq 'ARRAY' ) {
+        return @{ $res || [] };
+    } elsif ( $type eq 'HASH' ) {
+        return %{ $res || {} };
+    }
+    return $res;
+}
+
+sub SetFromConfig {
+    my $self = shift;
+    my %args = (
+        Option     => undef,
+        Value      => [],
+        Package    => 'RT',
+        File       => '',
+        Line       => 0,
+        SiteConfig => 1,
+        Extension  => 0,
+        @_
+    );
+
+    unless ( $args{'File'} ) {
+        ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
+    }
+
+    my $opt = $args{'Option'};
+
+    my $type;
+    my $name = $self->__GetNameByRef($opt);
+    if ($name) {
+        $type = ref $opt;
+        $name =~ s/.*:://;
+    } else {
+        $name = $$opt;
+        $type = $META{$name}->{'Type'} || 'SCALAR';
+    }
+
+    # if option is already set we have to check where
+    # it comes from and may be ignore it
+    if ( exists $OPTIONS{$name} ) {
+        if ( $type eq 'HASH' ) {
+            $args{'Value'} = [
+                @{ $args{'Value'} },
+                @{ $args{'Value'} }%2? (undef) : (),
+                $self->Get( $name ),
+            ];
+        } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) {
+            # if it's site config of an extension then it can only
+            # override options that came from its main config
+            if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
+                my %source = %{ $META{$name}->{'Source'} };
+                warn
+                    "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
+                    ." This option earlier has been set in $source{'File'} line $source{'Line'}."
+                    ." To overide this option use ". ($source{'Extension'}||'RT')
+                    ." site config."
+                ;
+                return 1;
+            }
+        } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
+            # if it's core config then we can override any option that came from another
+            # core config, but not site config
+
+            my %source = %{ $META{$name}->{'Source'} };
+            if ( $source{'Extension'} ne $args{'Extension'} ) {
+                # as a site config is loaded earlier then its base config
+                # then we warn only on different extensions, for example
+                # RTIR's options is set in main site config
+                warn
+                    "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
+                    ." It may be ok, but we want you to be aware."
+                    ." This option has been set earlier in $source{'File'} line $source{'Line'}."
+                ;
+            }
+
+            return 1;
+        }
+    }
+
+    $META{$name}->{'Type'} = $type;
+    foreach (qw(Package File Line SiteConfig Extension)) {
+        $META{$name}->{'Source'}->{$_} = $args{$_};
+    }
+    $self->Set( $name, @{ $args{'Value'} } );
+
+    return 1;
+}
+
+    our %REF_SYMBOLS = (
+            SCALAR => '$',
+            ARRAY  => '@',
+            HASH   => '%',
+            CODE   => '&',
+        );
+
+{
+    my $last_pack = '';
+
+    sub __GetNameByRef {
+        my $self = shift;
+        my $ref  = shift;
+        my $pack = shift;
+        if ( !$pack && $last_pack ) {
+            my $tmp = $self->__GetNameByRef( $ref, $last_pack );
+            return $tmp if $tmp;
+        }
+        $pack ||= 'main::';
+        $pack .= '::' unless substr( $pack, -2 ) eq '::';
+
+        no strict 'refs';
+        my $name = undef;
+
+        # scan $pack's nametable(hash)
+        foreach my $k ( keys %{$pack} ) {
+
+            # The hash for main:: has a reference to itself
+            next if $k eq 'main::';
+
+            # if the entry has a trailing '::' then
+            # it is a link to another name space
+            if ( substr( $k, -2 ) eq '::') {
+                $name = $self->__GetNameByRef( $ref, $pack eq 'main::'? $k : $pack.$k );
+                return $name if $name;
+            }
+
+            # entry of the table with references to
+            # SCALAR, ARRAY... and other types with
+            # the same name
+            my $entry = ${$pack}{$k};
+            next unless $entry;
+
+            # Inlined constants are simplified in the symbol table --
+            # namely, when possible, you only get a reference back in
+            # $entry, rather than a full GLOB.  In 5.10, scalar
+            # constants began being inlined this way; starting in 5.20,
+            # list constants are also inlined.  Notably, ref(GLOB) is
+            # undef, but inlined constants are currently either REF,
+            # SCALAR, or ARRAY.
+            next if ref($entry);
+
+            my $ref_type = ref($ref);
+
+            # regex/arrayref/hashref/coderef are stored in SCALAR glob
+            $ref_type = 'SCALAR' if $ref_type eq 'REF';
+
+            my $entry_ref = *{$entry}{ $ref_type };
+            next if ref $entry_ref && ref $entry_ref ne ref $ref;
+            next unless $entry_ref;
+
+            # if references are equal then we've found
+            if ( $entry_ref == $ref ) {
+                $last_pack = $pack;
+                return ( $REF_SYMBOLS{ $ref_type } || '*' ) . $pack . $k;
+            }
+        }
+        return '';
+    }
+}
+
+=head2 Metadata
+
+
+=head2 Meta
+
+=cut
+
+sub Meta {
+    return $META{ $_[1] };
+}
+
+sub Sections {
+    my $self = shift;
+    my %seen;
+    my @sections = sort
+        grep !$seen{$_}++,
+        map $_->{'Section'} || 'General',
+        values %META;
+    return @sections;
+}
+
+sub Options {
+    my $self = shift;
+    my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
+    my @res  = keys %META;
+    
+    @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
+        @res 
+    ) if defined $args{'Section'};
+
+    if ( defined $args{'Overridable'} ) {
+        @res
+            = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
+            @res );
+    }
+
+    if ( $args{'Sorted'} ) {
+        @res = sort {
+            ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
+            || $a cmp $b 
+        } @res;
+    } else {
+        @res = sort { $a cmp $b } @res;
+    }
+    return @res;
+}
+
+=head2 AddOption( Name => '', Section => '', ... )
+
+=cut
+
+sub AddOption {
+    my $self = shift;
+    my %args = (
+        Name            => undef,
+        Section         => undef,
+        Overridable     => 0,
+        SortOrder       => undef,
+        Widget          => '/Widgets/Form/String',
+        WidgetArguments => {},
+        @_
+    );
+
+    unless ( $args{Name} ) {
+        $RT::Logger->error("Need Name to add a new config");
+        return;
+    }
+
+    unless ( $args{Section} ) {
+        $RT::Logger->error("Need Section to add a new config option");
+        return;
+    }
+
+    $META{ delete $args{Name} } = \%args;
+}
+
+=head2 DeleteOption( Name => '' )
+
+=cut
+
+sub DeleteOption {
+    my $self = shift;
+    my %args = (
+        Name            => undef,
+        @_
+        );
+    if ( $args{Name} ) {
+        delete $META{$args{Name}};
+    }
+    else {
+        $RT::Logger->error("Need Name to remove a config option");
+        return;
+    }
+}
+
+=head2 UpdateOption( Name => '' ), Section => '', ... )
+
+=cut
+
+sub UpdateOption {
+    my $self = shift;
+    my %args = (
+        Name            => undef,
+        Section         => undef,
+        Overridable     => undef,
+        SortOrder       => undef,
+        Widget          => undef,
+        WidgetArguments => undef,
+        @_
+    );
+
+    my $name = delete $args{Name};
+
+    unless ( $name ) {
+        $RT::Logger->error("Need Name to update a new config");
+        return;
+    }
+
+    unless ( exists $META{$name} ) {
+        $RT::Logger->error("Config $name doesn't exist");
+        return;
+    }
+
+    for my $type ( keys %args ) {
+        next unless defined $args{$type};
+        $META{$name}{$type} = $args{$type};
+    }
+    return 1;
+}
+
+RT::Base->_ImportOverlays();
+
+1;
diff --git a/rt/lib/RT/Crypt/GnuPG.pm b/rt/lib/RT/Crypt/GnuPG.pm
index d0587d4fe..03636c8c3 100644
--- a/rt/lib/RT/Crypt/GnuPG.pm
+++ b/rt/lib/RT/Crypt/GnuPG.pm
@@ -401,14 +401,15 @@ sub SignEncrypt {
 
     my $entity = $args{'Entity'};
     if ( $args{'Sign'} && !defined $args{'Signer'} ) {
+        my @addresses = Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( 'From' )));
         $args{'Signer'} = UseKeyForSigning()
-            || (Email::Address->parse( $entity->head->get( 'From' ) ))[0]->address;
+            || $addresses[0]->address;
     }
     if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
         my %seen;
         $args{'Recipients'} = [
             grep $_ && !$seen{ $_ }++, map $_->address,
-            map Email::Address->parse( $entity->head->get( $_ ) ),
+            map Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( $_ ) ) ),
             qw(To Cc Bcc)
         ];
     }
@@ -520,7 +521,7 @@ sub SignEncryptRFC3156 {
         $gnupg->options->push_recipients( $_ ) foreach 
             map UseKeyForEncryption($_) || $_,
             grep !$seen{ $_ }++, map $_->address,
-            map Email::Address->parse( $entity->head->get( $_ ) ),
+            map Email::Address->parse( Encode::decode( "UTF-8", $entity->head->get( $_ ) ) ),
             qw(To Cc Bcc);
 
         my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
diff --git a/rt/lib/RT/CurrentUser.pm b/rt/lib/RT/CurrentUser.pm
index c11d46031..6ffe14761 100755
--- a/rt/lib/RT/CurrentUser.pm
+++ b/rt/lib/RT/CurrentUser.pm
@@ -54,7 +54,7 @@
 
     use RT::CurrentUser;
 
-    # laod
+    # load
     my $current_user = RT::CurrentUser->new;
     $current_user->Load(...);
     # or
@@ -255,9 +255,6 @@ sub loc_fuzzy {
     my $self = shift;
     return '' if !defined $_[0] || $_[0] eq '';
 
-    # XXX: work around perl's deficiency when matching utf8 data
-    return $_[0] if Encode::is_utf8($_[0]);
-
     return $self->LanguageHandle->maketext_fuzzy( @_ );
 }
 
diff --git a/rt/lib/RT/CustomField.pm.orig b/rt/lib/RT/CustomField.pm.orig
new file mode 100644
index 000000000..e71bbf78a
--- /dev/null
+++ b/rt/lib/RT/CustomField.pm.orig
@@ -0,0 +1,2170 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+#                                          
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::CustomField;
+
+use strict;
+use warnings;
+
+use Scalar::Util 'blessed';
+
+use base 'RT::Record';
+
+sub Table {'CustomFields'}
+
+
+use RT::CustomFieldValues;
+use RT::ObjectCustomFields;
+use RT::ObjectCustomFieldValues;
+
+our %FieldTypes = (
+    Select => {
+        sort_order => 10,
+        selection_type => 1,
+
+        labels => [ 'Select multiple values',      # loc
+                    'Select one value',            # loc
+                    'Select up to [_1] values',    # loc
+                  ],
+
+        render_types => {
+            multiple => [
+
+                # Default is the first one
+                'Select box',              # loc
+                'List',                    # loc
+            ],
+            single => [ 'Select box',              # loc
+                        'Dropdown',                # loc
+                        'List',                    # loc
+                      ]
+        },
+
+    },
+    Freeform => {
+        sort_order => 20,
+        selection_type => 0,
+
+        labels => [ 'Enter multiple values',       # loc
+                    'Enter one value',             # loc
+                    'Enter up to [_1] values',     # loc
+                  ]
+                },
+    Text => {
+        sort_order => 30,
+        selection_type => 0,
+        labels         => [
+                    'Fill in multiple text areas',      # loc
+                    'Fill in one text area',            # loc
+                    'Fill in up to [_1] text areas',    # loc
+                  ]
+            },
+    Wikitext => {
+        sort_order => 40,
+        selection_type => 0,
+        labels         => [
+                    'Fill in multiple wikitext areas',      # loc
+                    'Fill in one wikitext area',            # loc
+                    'Fill in up to [_1] wikitext areas',    # loc
+                  ]
+                },
+
+    Image => {
+        sort_order => 50,
+        selection_type => 0,
+        labels         => [
+                    'Upload multiple images',               # loc
+                    'Upload one image',                     # loc
+                    'Upload up to [_1] images',             # loc
+                  ]
+             },
+    Binary => {
+        sort_order => 60,
+        selection_type => 0,
+        labels         => [
+                    'Upload multiple files',                # loc
+                    'Upload one file',                      # loc
+                    'Upload up to [_1] files',              # loc
+                  ]
+              },
+
+    Combobox => {
+        sort_order => 70,
+        selection_type => 1,
+        labels         => [
+                    'Combobox: Select or enter multiple values',      # loc
+                    'Combobox: Select or enter one value',            # loc
+                    'Combobox: Select or enter up to [_1] values',    # loc
+                  ]
+                },
+    Autocomplete => {
+        sort_order => 80,
+        selection_type => 1,
+        labels         => [
+                    'Enter multiple values with autocompletion',      # loc
+                    'Enter one value with autocompletion',            # loc
+                    'Enter up to [_1] values with autocompletion',    # loc
+                  ]
+    },
+
+    Date => {
+        sort_order => 90,
+        selection_type => 0,
+        labels         => [
+                    'Select multiple dates',                          # loc
+                    'Select date',                                    # loc
+                    'Select up to [_1] dates',                        # loc
+                  ]
+            },
+    DateTime => {
+        sort_order => 100,
+        selection_type => 0,
+        labels         => [
+                    'Select multiple datetimes',                      # loc
+                    'Select datetime',                                # loc
+                    'Select up to [_1] datetimes',                    # loc
+                  ]
+                },
+    TimeValue => {
+        sort_order => 105,
+        selection_type => 0,
+        labels         => [
+                     'Enter multiple time values (UNSUPPORTED)',
+                     'Enter a time value',
+                     'Enter [_1] time values (UNSUPPORTED)',
+                   ]
+                 },
+
+    IPAddress => {
+        sort_order => 110,
+        selection_type => 0,
+
+        labels => [ 'Enter multiple IP addresses',       # loc
+                    'Enter one IP address',             # loc
+                    'Enter up to [_1] IP addresses',     # loc
+                  ]
+                },
+    IPAddressRange => {
+        sort_order => 120,
+        selection_type => 0,
+
+        labels => [ 'Enter multiple IP address ranges',       # loc
+                    'Enter one IP address range',             # loc
+                    'Enter up to [_1] IP address ranges',     # loc
+                  ]
+                },
+);
+
+
+our %FRIENDLY_OBJECT_TYPES =  ();
+
+RT::CustomField->_ForObjectType( 'RT::Queue-RT::Ticket' => "Tickets", );    #loc
+RT::CustomField->_ForObjectType(
+    'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", );    #loc
+RT::CustomField->_ForObjectType( 'RT::User'  => "Users", );                           #loc
+RT::CustomField->_ForObjectType( 'RT::Queue'  => "Queues", );                         #loc
+RT::CustomField->_ForObjectType( 'RT::Group' => "Groups", );                          #loc
+
+our $RIGHTS = {
+    SeeCustomField            => 'View custom fields',                                    # loc_pair
+    AdminCustomField          => 'Create, modify and delete custom fields',               # loc_pair
+    AdminCustomFieldValues    => 'Create, modify and delete custom fields values',        # loc_pair
+    ModifyCustomField         => 'Add, modify and delete custom field values for objects' # loc_pair
+};
+
+our $RIGHT_CATEGORIES = {
+    SeeCustomField          => 'General',
+    AdminCustomField        => 'Admin',
+    AdminCustomFieldValues  => 'Admin',
+    ModifyCustomField       => 'Staff',
+};
+
+# Tell RT::ACE that this sort of object can get acls granted
+$RT::ACE::OBJECT_TYPES{'RT::CustomField'} = 1;
+
+__PACKAGE__->AddRights(%$RIGHTS);
+__PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES);
+
+=head2 AddRights C, C [, ...]
+
+Adds the given rights to the list of possible rights.  This method
+should be called during server startup, not at runtime.
+
+=cut
+
+sub AddRights {
+    my $self = shift;
+    my %new = @_;
+    $RIGHTS = { %$RIGHTS, %new };
+    %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES,
+                                      map { lc($_) => $_ } keys %new);
+}
+
+sub AvailableRights {
+    my $self = shift;
+    return $RIGHTS;
+}
+
+=head2 RightCategories
+
+Returns a hashref where the keys are rights for this type of object and the
+values are the category (General, Staff, Admin) the right falls into.
+
+=cut
+
+sub RightCategories {
+    return $RIGHT_CATEGORIES;
+}
+
+=head2 AddRightCategories C, C [, ...]
+
+Adds the given right and category pairs to the list of right categories.  This
+method should be called during server startup, not at runtime.
+
+=cut
+
+sub AddRightCategories {
+    my $self = shift if ref $_[0] or $_[0] eq __PACKAGE__;
+    my %new = @_;
+    $RIGHT_CATEGORIES = { %$RIGHT_CATEGORIES, %new };
+}
+
+=head1 NAME
+
+  RT::CustomField_Overlay - overlay for RT::CustomField
+
+=head1 DESCRIPTION
+
+=head1 'CORE' METHODS
+
+=head2 Create PARAMHASH
+
+Create takes a hash of values and creates a row in the database:
+
+  varchar(200) 'Name'.
+  varchar(200) 'Type'.
+  int(11) 'MaxValues'.
+  varchar(255) 'Pattern'.
+  smallint(6) 'Repeated'.
+  varchar(255) 'Description'.
+  int(11) 'SortOrder'.
+  varchar(255) 'LookupType'.
+  smallint(6) 'Disabled'.
+
+C is generally the result of either
+CCustomFieldLookupType> or CCustomFieldLookupType>.
+
+=cut
+
+sub Create {
+    my $self = shift;
+    my %args = (
+        Name        => '',
+        Type        => '',
+        MaxValues   => 0,
+        Pattern     => '',
+        Description => '',
+        Disabled    => 0,
+        LookupType  => '',
+        Repeated    => 0,
+        LinkValueTo => '',
+        IncludeContentForValue => '',
+        @_,
+    );
+
+    unless ( $self->CurrentUser->HasRight(Object => $RT::System, Right => 'AdminCustomField') ) {
+        return (0, $self->loc('Permission Denied'));
+    }
+
+    if ( $args{TypeComposite} ) {
+        @args{'Type', 'MaxValues'} = split(/-/, $args{TypeComposite}, 2);
+    }
+    elsif ( $args{Type} =~ s/(?:(Single)|Multiple)$// ) {
+        # old style Type string
+        $args{'MaxValues'} = $1 ? 1 : 0;
+    }
+    $args{'MaxValues'} = int $args{'MaxValues'};
+
+    if ( !exists $args{'Queue'}) {
+    # do nothing -- things below are strictly backward compat
+    }
+    elsif (  ! $args{'Queue'} ) {
+        unless ( $self->CurrentUser->HasRight( Object => $RT::System, Right => 'AssignCustomFields') ) {
+            return ( 0, $self->loc('Permission Denied') );
+        }
+        $args{'LookupType'} = 'RT::Queue-RT::Ticket';
+    }
+    else {
+        my $queue = RT::Queue->new($self->CurrentUser);
+        $queue->Load($args{'Queue'});
+        unless ($queue->Id) {
+            return (0, $self->loc("Queue not found"));
+        }
+        unless ( $queue->CurrentUserHasRight('AssignCustomFields') ) {
+            return ( 0, $self->loc('Permission Denied') );
+        }
+        $args{'LookupType'} = 'RT::Queue-RT::Ticket';
+        $args{'Queue'} = $queue->Id;
+    }
+
+    my ($ok, $msg) = $self->_IsValidRegex( $args{'Pattern'} );
+    return (0, $self->loc("Invalid pattern: [_1]", $msg)) unless $ok;
+
+    if ( $args{'MaxValues'} != 1 && $args{'Type'} =~ /(text|combobox)$/i ) {
+        $RT::Logger->debug("Support for 'multiple' Texts or Comboboxes is not implemented");
+        $args{'MaxValues'} = 1;
+    }
+
+    if ( $args{'RenderType'} ||= undef ) {
+        my $composite = join '-', @args{'Type', 'MaxValues'};
+        return (0, $self->loc("This custom field has no Render Types"))
+            unless $self->HasRenderTypes( $composite );
+
+        if ( $args{'RenderType'} eq $self->DefaultRenderType( $composite ) ) {
+            $args{'RenderType'} = undef;
+        } else {
+            return (0, $self->loc("Invalid Render Type") )
+                unless grep $_ eq  $args{'RenderType'}, $self->RenderTypes( $composite );
+        }
+    }
+
+    $args{'ValuesClass'} = undef if ($args{'ValuesClass'} || '') eq 'RT::CustomFieldValues';
+    if ( $args{'ValuesClass'} ||= undef ) {
+        return (0, $self->loc("This Custom Field can not have list of values"))
+            unless $self->IsSelectionType( $args{'Type'} );
+
+        unless ( $self->ValidateValuesClass( $args{'ValuesClass'} ) ) {
+            return (0, $self->loc("Invalid Custom Field values source"));
+        }
+    }
+
+    (my $rv, $msg) = $self->SUPER::Create(
+        Name        => $args{'Name'},
+        Type        => $args{'Type'},
+        RenderType  => $args{'RenderType'},
+        MaxValues   => $args{'MaxValues'},
+        Pattern     => $args{'Pattern'},
+        BasedOn     => $args{'BasedOn'},
+        ValuesClass => $args{'ValuesClass'},
+        Description => $args{'Description'},
+        Disabled    => $args{'Disabled'},
+        LookupType  => $args{'LookupType'},
+        Repeated    => $args{'Repeated'},
+    );
+
+    if ($rv) {
+        if ( exists $args{'LinkValueTo'}) {
+            $self->SetLinkValueTo($args{'LinkValueTo'});
+        }
+
+        if ( exists $args{'IncludeContentForValue'}) {
+            $self->SetIncludeContentForValue($args{'IncludeContentForValue'});
+        }
+
+        if ( exists $args{'UILocation'} ) {
+            $self->SetUILocation( $args{'UILocation'} );
+        }
+
+        if ( exists $args{'NoClone'} ) {
+            $self->SetNoClone( $args{'NoClone'} );
+        }
+
+        return ($rv, $msg) unless exists $args{'Queue'};
+
+        # Compat code -- create a new ObjectCustomField mapping
+        my $OCF = RT::ObjectCustomField->new( $self->CurrentUser );
+        $OCF->Create(
+            CustomField => $self->Id,
+            ObjectId => $args{'Queue'},
+        );
+    }
+
+    return ($rv, $msg);
+}
+
+=head2 Load ID/NAME
+
+Load a custom field.  If the value handed in is an integer, load by custom field ID. Otherwise, Load by name.
+
+=cut
+
+sub Load {
+    my $self = shift;
+    my $id = shift || '';
+
+    if ( $id =~ /^\d+$/ ) {
+        return $self->SUPER::Load( $id );
+    } else {
+        return $self->LoadByName( Name => $id );
+    }
+}
+
+
+
+=head2 LoadByName (Queue => QUEUEID, Name => NAME)
+
+Loads the Custom field named NAME.
+
+Will load a Disabled Custom Field even if there is a non-disabled Custom Field
+with the same Name.
+
+If a Queue parameter is specified, only look for ticket custom fields tied to that Queue.
+
+If the Queue parameter is '0', look for global ticket custom fields.
+
+If no queue parameter is specified, look for any and all custom fields with this name.
+
+BUG/TODO, this won't let you specify that you only want user or group CFs.
+
+=cut
+
+# Compatibility for API change after 3.0 beta 1
+*LoadNameAndQueue = \&LoadByName;
+# Change after 3.4 beta.
+*LoadByNameAndQueue = \&LoadByName;
+
+sub LoadByName {
+    my $self = shift;
+    my %args = (
+        Queue => undef,
+        Name  => undef,
+        @_,
+    );
+
+    unless ( defined $args{'Name'} && length $args{'Name'} ) {
+        $RT::Logger->error("Couldn't load Custom Field without Name");
+        return wantarray ? (0, $self->loc("No name provided")) : 0;
+    }
+
+    # if we're looking for a queue by name, make it a number
+    if ( defined $args{'Queue'} && ($args{'Queue'} =~ /\D/ || !$self->ContextObject) ) {
+        my $QueueObj = RT::Queue->new( $self->CurrentUser );
+        $QueueObj->Load( $args{'Queue'} );
+        $args{'Queue'} = $QueueObj->Id;
+        $self->SetContextObject( $QueueObj )
+            unless $self->ContextObject;
+    }
+
+    # XXX - really naive implementation.  Slow. - not really. still just one query
+
+    my $CFs = RT::CustomFields->new( $self->CurrentUser );
+    $CFs->SetContextObject( $self->ContextObject );
+    my $field = $args{'Name'} =~ /\D/? 'Name' : 'id';
+    $CFs->Limit( FIELD => $field, VALUE => $args{'Name'}, CASESENSITIVE => 0);
+    # Don't limit to queue if queue is 0.  Trying to do so breaks
+    # RT::Group type CFs.
+    if ( defined $args{'Queue'} ) {
+        $CFs->LimitToQueue( $args{'Queue'} );
+    }
+
+    # When loading by name, we _can_ load disabled fields, but prefer
+    # non-disabled fields.
+    $CFs->FindAllRows;
+    $CFs->OrderByCols(
+        { FIELD => "Disabled", ORDER => 'ASC' },
+    );
+
+    # We only want one entry.
+    $CFs->RowsPerPage(1);
+
+    # version before 3.8 just returns 0, so we need to test if wantarray to be
+    # backward compatible.
+    return wantarray ? (0, $self->loc("Not found")) : 0 unless my $first = $CFs->First;
+
+    return $self->LoadById( $first->id );
+}
+
+
+
+
+=head2 Custom field values
+
+=head3 Values FIELD
+
+Return a object (collection) of all acceptable values for this Custom Field.
+Class of the object can vary and depends on the return value
+of the C method.
+
+=cut
+
+*ValuesObj = \&Values;
+
+sub Values {
+    my $self = shift;
+
+    my $class = $self->ValuesClass;
+    if ( $class ne 'RT::CustomFieldValues') {
+        eval "require $class" or die "$@";
+    }
+    my $cf_values = $class->new( $self->CurrentUser );
+    # if the user has no rights, return an empty object
+    if ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) {
+        $cf_values->LimitToCustomField( $self->Id );
+    } else {
+        $cf_values->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' );
+    }
+    return ($cf_values);
+}
+
+
+=head3 AddValue HASH
+
+Create a new value for this CustomField.  Takes a paramhash containing the elements Name, Description and SortOrder
+
+=cut
+
+sub AddValue {
+    my $self = shift;
+    my %args = @_;
+
+    unless ($self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues')) {
+        return (0, $self->loc('Permission Denied'));
+    }
+
+    # allow zero value
+    if ( !defined $args{'Name'} || $args{'Name'} eq '' ) {
+        return (0, $self->loc("Can't add a custom field value without a name"));
+    }
+
+    my $newval = RT::CustomFieldValue->new( $self->CurrentUser );
+    return $newval->Create( %args, CustomField => $self->Id );
+}
+
+
+
+
+=head3 DeleteValue ID
+
+Deletes a value from this custom field by id.
+
+Does not remove this value for any article which has had it selected
+
+=cut
+
+sub DeleteValue {
+    my $self = shift;
+    my $id = shift;
+    unless ( $self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues') ) {
+        return (0, $self->loc('Permission Denied'));
+    }
+
+    my $val_to_del = RT::CustomFieldValue->new( $self->CurrentUser );
+    $val_to_del->Load( $id );
+    unless ( $val_to_del->Id ) {
+        return (0, $self->loc("Couldn't find that value"));
+    }
+    unless ( $val_to_del->CustomField == $self->Id ) {
+        return (0, $self->loc("That is not a value for this custom field"));
+    }
+
+    my $retval = $val_to_del->Delete;
+    unless ( $retval ) {
+        return (0, $self->loc("Custom field value could not be deleted"));
+    }
+    return ($retval, $self->loc("Custom field value deleted"));
+}
+
+
+=head2 ValidateQueue Queue
+
+Make sure that the name specified is valid
+
+=cut
+
+sub ValidateName {
+    my $self = shift;
+    my $value = shift;
+
+    return 0 unless length $value;
+
+    return $self->SUPER::ValidateName($value);
+}
+
+=head2 ValidateQueue Queue
+
+Make sure that the queue specified is a valid queue name
+
+=cut
+
+sub ValidateQueue {
+    my $self = shift;
+    my $id = shift;
+
+    return undef unless defined $id;
+    # 0 means "Global" null would _not_ be ok.
+    return 1 if $id eq '0';
+
+    my $q = RT::Queue->new( RT->SystemUser );
+    $q->Load( $id );
+    return undef unless $q->id;
+    return 1;
+}
+
+
+
+=head2 Types 
+
+Retuns an array of the types of CustomField that are supported
+
+=cut
+
+sub Types {
+    return (sort {(($FieldTypes{$a}{sort_order}||999) <=> ($FieldTypes{$b}{sort_order}||999)) or ($a cmp $b)} keys %FieldTypes);
+}
+
+
+=head2 IsSelectionType 
+
+Retuns a boolean value indicating whether the C method makes sense
+to this Custom Field.
+
+=cut
+
+sub IsSelectionType {
+    my $self = shift;
+    my $type = @_? shift : $self->Type;
+    return undef unless $type;
+    return $FieldTypes{$type}->{selection_type};
+}
+
+
+
+=head2 IsExternalValues
+
+=cut
+
+sub IsExternalValues {
+    my $self = shift;
+    return 0 unless $self->IsSelectionType( @_ );
+    return $self->ValuesClass eq 'RT::CustomFieldValues'? 0 : 1;
+}
+
+sub ValuesClass {
+    my $self = shift;
+    return $self->_Value( ValuesClass => @_ ) || 'RT::CustomFieldValues';
+}
+
+sub SetValuesClass {
+    my $self = shift;
+    my $class = shift || 'RT::CustomFieldValues';
+    
+    if ( $class eq 'RT::CustomFieldValues' ) {
+        return $self->_Set( Field => 'ValuesClass', Value => undef, @_ );
+    }
+
+    return (0, $self->loc("This Custom Field can not have list of values"))
+        unless $self->IsSelectionType;
+
+    unless ( $self->ValidateValuesClass( $class ) ) {
+        return (0, $self->loc("Invalid Custom Field values source"));
+    }
+    return $self->_Set( Field => 'ValuesClass', Value => $class, @_ );
+}
+
+sub ValidateValuesClass {
+    my $self = shift;
+    my $class = shift;
+
+    return 1 if !$class || $class eq 'RT::CustomFieldValues';
+    return 1 if grep $class eq $_, RT->Config->Get('CustomFieldValuesSources');
+    return undef;
+}
+
+
+=head2 FriendlyType [TYPE, MAX_VALUES]
+
+Returns a localized human-readable version of the custom field type.
+If a custom field type is specified as the parameter, the friendly type for that type will be returned
+
+=cut
+
+sub FriendlyType {
+    my $self = shift;
+
+    my $type = @_ ? shift : $self->Type;
+    my $max  = @_ ? shift : $self->MaxValues;
+    $max = 0 unless $max;
+
+    if (my $friendly_type = $FieldTypes{$type}->{labels}->[$max>2 ? 2 : $max]) {
+        return ( $self->loc( $friendly_type, $max ) );
+    }
+    else {
+        return ( $self->loc( $type ) );
+    }
+}
+
+sub FriendlyTypeComposite {
+    my $self = shift;
+    my $composite = shift || $self->TypeComposite;
+    return $self->FriendlyType(split(/-/, $composite, 2));
+}
+
+
+=head2 ValidateType TYPE
+
+Takes a single string. returns true if that string is a value
+type of custom field
+
+
+=cut
+
+sub ValidateType {
+    my $self = shift;
+    my $type = shift;
+
+    if ( $type =~ s/(?:Single|Multiple)$// ) {
+        $RT::Logger->warning( "Prefix 'Single' and 'Multiple' to Type deprecated, use MaxValues instead at (". join(":",caller).")");
+    }
+
+    if ( $FieldTypes{$type} ) {
+        return 1;
+    }
+    else {
+        return undef;
+    }
+}
+
+
+sub SetType {
+    my $self = shift;
+    my $type = shift;
+    if ($type =~ s/(?:(Single)|Multiple)$//) {
+        $RT::Logger->warning("'Single' and 'Multiple' on SetType deprecated, use SetMaxValues instead at (". join(":",caller).")");
+        $self->SetMaxValues($1 ? 1 : 0);
+    }
+    $self->_Set(Field => 'Type', Value =>$type);
+}
+
+=head2 SetPattern STRING
+
+Takes a single string representing a regular expression.  Performs basic
+validation on that regex, and sets the C field for the CF if it
+is valid.
+
+=cut
+
+sub SetPattern {
+    my $self = shift;
+    my $regex = shift;
+
+    my ($ok, $msg) = $self->_IsValidRegex($regex);
+    if ($ok) {
+        return $self->_Set(Field => 'Pattern', Value => $regex);
+    }
+    else {
+        return (0, $self->loc("Invalid pattern: [_1]", $msg));
+    }
+}
+
+=head2 _IsValidRegex(Str $regex) returns (Bool $success, Str $msg)
+
+Tests if the string contains an invalid regex.
+
+=cut
+
+sub _IsValidRegex {
+    my $self  = shift;
+    my $regex = shift or return (1, 'valid');
+
+    local $^W; local $@;
+    local $SIG{__DIE__} = sub { 1 };
+    local $SIG{__WARN__} = sub { 1 };
+
+    if (eval { qr/$regex/; 1 }) {
+        return (1, 'valid');
+    }
+
+    my $err = $@;
+    $err =~ s{[,;].*}{};    # strip debug info from error
+    chomp $err;
+    return (0, $err);
+}
+
+
+=head2 SingleValue
+
+Returns true if this CustomField only accepts a single value. 
+Returns false if it accepts multiple values
+
+=cut
+
+sub SingleValue {
+    my $self = shift;
+    if (($self->MaxValues||0) == 1) {
+        return 1;
+    } 
+    else {
+        return undef;
+    }
+}
+
+sub UnlimitedValues {
+    my $self = shift;
+    if (($self->MaxValues||0) == 0) {
+        return 1;
+    } 
+    else {
+        return undef;
+    }
+}
+
+
+=head2 CurrentUserHasRight RIGHT
+
+Helper function to call the custom field's queue's CurrentUserHasRight with the passed in args.
+
+=cut
+
+sub CurrentUserHasRight {
+    my $self  = shift;
+    my $right = shift;
+
+    return $self->CurrentUser->HasRight(
+        Object => $self,
+        Right  => $right,
+    );
+}
+
+=head2 ACLEquivalenceObjects
+
+Returns list of objects via which users can get rights on this custom field. For custom fields
+these objects can be set using L.
+
+=cut
+
+sub ACLEquivalenceObjects {
+    my $self = shift;
+
+    my $ctx = $self->ContextObject
+        or return;
+    return ($ctx, $ctx->ACLEquivalenceObjects);
+}
+
+=head2 ContextObject and SetContextObject
+
+Set or get a context for this object. It can be ticket, queue or another object
+this CF applies to. Used for ACL control, for example SeeCustomField can be granted on
+queue level to allow people to see all fields applied to the queue.
+
+=cut
+
+sub SetContextObject {
+    my $self = shift;
+    return $self->{'context_object'} = shift;
+}
+  
+sub ContextObject {
+    my $self = shift;
+    return $self->{'context_object'};
+}
+
+sub ValidContextType {
+    my $self = shift;
+    my $class = shift;
+
+    my %valid;
+    $valid{$_}++ for split '-', $self->LookupType;
+    delete $valid{'RT::Transaction'};
+
+    return $valid{$class};
+}
+
+=head2 LoadContextObject
+
+Takes an Id for a Context Object and loads the right kind of RT::Object
+for this particular Custom Field (based on the LookupType) and returns it.
+This is a good way to ensure you don't try to use a Queue as a Context
+Object on a User Custom Field.
+
+=cut
+
+sub LoadContextObject {
+    my $self = shift;
+    my $type = shift;
+    my $contextid = shift;
+
+    unless ( $self->ValidContextType($type) ) {
+        RT->Logger->debug("Invalid ContextType $type for Custom Field ".$self->Id);
+        return;
+    }
+
+    my $context_object = $type->new( $self->CurrentUser );
+    my ($id, $msg) = $context_object->LoadById( $contextid );
+    unless ( $id ) {
+        RT->Logger->debug("Invalid ContextObject id: $msg");
+        return;
+    }
+    return $context_object;
+}
+
+=head2 ValidateContextObject
+
+Ensure that a given ContextObject applies to this Custom Field.
+For custom fields that are assigned to Queues or to Classes, this checks that the Custom
+Field is actually applied to that objects.  For Global Custom Fields, it returns true
+as long as the Object is of the right type, because you may be using
+your permissions on a given Queue of Class to see a Global CF.
+For CFs that are only applied Globally, you don't need a ContextObject.
+
+=cut
+
+sub ValidateContextObject {
+    my $self = shift;
+    my $object = shift;
+
+    return 1 if $self->IsApplied(0);
+
+    # global only custom fields don't have objects
+    # that should be used as context objects.
+    return if $self->ApplyGlobally;
+
+    # Otherwise, make sure we weren't passed a user object that we're
+    # supposed to treat as a queue.
+    return unless $self->ValidContextType(ref $object);
+
+    # Check that it is applied correctly
+    my ($applied_to) = grep {ref($_) eq $self->RecordClassFromLookupType} ($object, $object->ACLEquivalenceObjects);
+    return unless $applied_to;
+    return $self->IsApplied($applied_to->id);
+}
+
+
+sub _Set {
+    my $self = shift;
+
+    unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
+        return ( 0, $self->loc('Permission Denied') );
+    }
+    return $self->SUPER::_Set( @_ );
+
+}
+
+
+
+=head2 _Value
+
+Takes the name of a table column.
+Returns its value as a string, if the user passes an ACL check
+
+=cut
+
+sub _Value {
+    my $self  = shift;
+    return undef unless $self->id;
+
+    # we need to do the rights check
+    unless ( $self->CurrentUserHasRight('SeeCustomField') ) {
+        $RT::Logger->debug(
+            "Permission denied. User #". $self->CurrentUser->id
+            ." has no SeeCustomField right on CF #". $self->id
+        );
+        return (undef);
+    }
+    return $self->__Value( @_ );
+}
+
+
+=head2 SetDisabled
+
+Takes a boolean.
+1 will cause this custom field to no longer be avaialble for objects.
+0 will re-enable this field.
+
+=cut
+
+
+=head2 SetTypeComposite
+
+Set this custom field's type and maximum values as a composite value
+
+=cut
+
+sub SetTypeComposite {
+    my $self = shift;
+    my $composite = shift;
+
+    my $old = $self->TypeComposite;
+
+    my ($type, $max_values) = split(/-/, $composite, 2);
+    if ( $type ne $self->Type ) {
+        my ($status, $msg) = $self->SetType( $type );
+        return ($status, $msg) unless $status;
+    }
+    if ( ($max_values || 0) != ($self->MaxValues || 0) ) {
+        my ($status, $msg) = $self->SetMaxValues( $max_values );
+        return ($status, $msg) unless $status;
+    }
+    my $render = $self->RenderType;
+    if ( $render and not grep { $_ eq $render } $self->RenderTypes ) {
+        # We switched types and our render type is no longer valid, so unset it
+        # and use the default
+        $self->SetRenderType( undef );
+    }
+    return 1, $self->loc(
+        "Type changed from '[_1]' to '[_2]'",
+        $self->FriendlyTypeComposite( $old ),
+        $self->FriendlyTypeComposite( $composite ),
+    );
+}
+
+=head2 TypeComposite
+
+Returns a composite value composed of this object's type and maximum values
+
+=cut
+
+
+sub TypeComposite {
+    my $self = shift;
+    return join '-', ($self->Type || ''), ($self->MaxValues || 0);
+}
+
+=head2 TypeComposites
+
+Returns an array of all possible composite values for custom fields.
+
+=cut
+
+sub TypeComposites {
+    my $self = shift;
+    return grep !/(?:[Tt]ext|Combobox|Date|DateTime|TimeValue)-0/, map { ("$_-1", "$_-0") } $self->Types;
+}
+
+=head2 RenderType
+
+Returns the type of form widget to render for this custom field.  Currently
+this only affects fields which return true for L. 
+
+=cut
+
+sub RenderType {
+    my $self = shift;
+    return '' unless $self->HasRenderTypes;
+
+    return $self->_Value( 'RenderType', @_ )
+        || $self->DefaultRenderType;
+}
+
+=head2 SetRenderType TYPE
+
+Sets this custom field's render type.
+
+=cut
+
+sub SetRenderType {
+    my $self = shift;
+    my $type = shift;
+    return (0, $self->loc("This custom field has no Render Types"))
+        unless $self->HasRenderTypes;
+
+    if ( !$type || $type eq $self->DefaultRenderType ) {
+        return $self->_Set( Field => 'RenderType', Value => undef, @_ );
+    }
+
+    if ( not grep { $_ eq $type } $self->RenderTypes ) {
+        return (0, $self->loc("Invalid Render Type for custom field of type [_1]",
+                                $self->FriendlyType));
+    }
+
+    return $self->_Set( Field => 'RenderType', Value => $type, @_ );
+}
+
+=head2 DefaultRenderType [TYPE COMPOSITE]
+
+Returns the default render type for this custom field's type or the TYPE
+COMPOSITE specified as an argument.
+
+=cut
+
+sub DefaultRenderType {
+    my $self = shift;
+    my $composite    = @_ ? shift : $self->TypeComposite;
+    my ($type, $max) = split /-/, $composite, 2;
+    return unless $type and $self->HasRenderTypes($composite);
+    return $FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }[0];
+}
+
+=head2 HasRenderTypes [TYPE_COMPOSITE]
+
+Returns a boolean value indicating whether the L and
+L methods make sense for this custom field.
+
+Currently true only for type C