From 1c538bfabc2cd31f27067505f0c3d1a46cba6ef0 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 9 Jul 2015 22:18:55 -0700 Subject: RT 4.2.11, ticket#13852 --- rt/lib/RT.pm | 208 +- rt/lib/RT/ACE.pm | 191 +- rt/lib/RT/ACL.pm | 119 +- rt/lib/RT/Action.pm | 20 - rt/lib/RT/Action/AutoOpen.pm | 3 +- rt/lib/RT/Action/AutoOpenInactive.pm | 105 + rt/lib/RT/Action/Autoreply.pm | 14 +- rt/lib/RT/Action/CreateTickets.pm | 113 +- rt/lib/RT/Action/CreateTickets.pm.orig | 9 +- rt/lib/RT/Action/EscalatePriority.pm | 165 +- rt/lib/RT/Action/LinearEscalate.pm | 15 +- rt/lib/RT/Action/Notify.pm | 54 +- rt/lib/RT/Action/NotifyGroup.pm | 16 +- rt/lib/RT/Action/NotifyGroupAsComment.pm | 8 +- rt/lib/RT/Action/NotifyOwnerOrAdminCc.pm | 76 + rt/lib/RT/Action/OpenOnStarted.pm | 87 + rt/lib/RT/Action/RecordComment.pm | 23 +- rt/lib/RT/Action/RecordCorrespondence.pm | 24 +- rt/lib/RT/Action/SendEmail.pm | 181 +- rt/lib/RT/Action/SendEmail.pm.orig | 42 +- rt/lib/RT/Action/SendForward.pm | 138 + rt/lib/RT/Action/SetStatus.pm | 2 +- rt/lib/RT/Approval/Rule/NewPending.pm | 2 +- rt/lib/RT/Approval/Rule/Passed.pm | 2 +- rt/lib/RT/Approval/Rule/Rejected.pm | 2 +- rt/lib/RT/Article.pm | 130 +- rt/lib/RT/Articles.pm | 39 +- rt/lib/RT/Attachment.pm | 406 ++- rt/lib/RT/Attachments.pm | 45 +- rt/lib/RT/Attribute.pm | 63 +- rt/lib/RT/Attributes.pm | 32 +- rt/lib/RT/Base.pm | 2 +- rt/lib/RT/CachedGroupMember.pm | 55 +- rt/lib/RT/CachedGroupMembers.pm | 30 +- rt/lib/RT/Class.pm | 217 +- rt/lib/RT/Classes.pm | 16 +- rt/lib/RT/Condition.pm | 26 +- rt/lib/RT/Condition/BeforeDue.pm | 23 +- rt/lib/RT/Condition/Overdue.pm | 10 +- rt/lib/RT/Condition/OwnerChange.pm | 16 +- rt/lib/RT/Condition/PriorityChange.pm | 6 +- rt/lib/RT/Condition/PriorityExceeds.pm | 6 +- rt/lib/RT/Condition/QueueChange.pm | 6 +- rt/lib/RT/Condition/StatusChange.pm | 4 +- rt/lib/RT/Config.pm | 605 ++-- rt/lib/RT/Crypt.pm | 843 +++++ rt/lib/RT/Crypt/GnuPG.pm | 1942 ++++------- rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm | 70 + rt/lib/RT/Crypt/Role.pm | 254 ++ rt/lib/RT/Crypt/SMIME.pm | 956 ++++++ rt/lib/RT/CurrentUser.pm | 45 +- rt/lib/RT/CustomField.pm | 780 +++-- rt/lib/RT/CustomFieldValue.pm | 61 +- rt/lib/RT/CustomFieldValues.pm | 61 +- rt/lib/RT/CustomFieldValues/External.pm | 12 +- rt/lib/RT/CustomFields.pm | 195 +- rt/lib/RT/Dashboard.pm | 43 +- rt/lib/RT/Dashboard/Mailer.pm | 68 +- rt/lib/RT/Dashboards.pm | 4 +- rt/lib/RT/Date.pm | 250 +- rt/lib/RT/DependencyWalker.pm | 305 ++ rt/lib/RT/DependencyWalker/FindDependencies.pm | 65 + rt/lib/RT/EmailParser.pm | 43 +- rt/lib/RT/Generated.pm.in | 4 + rt/lib/RT/Graph/Tickets.pm | 9 +- rt/lib/RT/Group.pm | 913 ++++-- rt/lib/RT/GroupMember.pm | 217 +- rt/lib/RT/GroupMembers.pm | 32 +- rt/lib/RT/Groups.pm | 95 +- rt/lib/RT/Handle.pm | 683 +++- rt/lib/RT/I18N.pm | 342 +- rt/lib/RT/I18N/cs.pm | 40 +- rt/lib/RT/I18N/fr.pm | 10 +- rt/lib/RT/I18N/ru.pm | 4 +- rt/lib/RT/Installer.pm | 10 +- rt/lib/RT/Interface/CLI.pm | 195 +- rt/lib/RT/Interface/Email.pm | 533 ++- rt/lib/RT/Interface/Email.pm.orig | 81 +- rt/lib/RT/Interface/Email/Auth/Crypt.pm | 294 ++ rt/lib/RT/Interface/Email/Auth/GnuPG.pm | 257 -- rt/lib/RT/Interface/REST.pm | 59 +- rt/lib/RT/Interface/Web.pm | 1358 ++++++-- rt/lib/RT/Interface/Web.pm.orig | 3454 -------------------- rt/lib/RT/Interface/Web/Handler.pm | 96 +- rt/lib/RT/Interface/Web/Menu.pm | 14 +- .../RT/Interface/Web/Middleware/StaticHeaders.pm | 80 + rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm | 7 +- rt/lib/RT/Interface/Web/Request.pm | 3 - rt/lib/RT/Interface/Web/Session.pm | 30 +- rt/lib/RT/Lifecycle.pm | 232 +- rt/lib/RT/Lifecycle/Ticket.pm | 125 + rt/lib/RT/Link.pm | 205 +- rt/lib/RT/Links.pm | 33 +- rt/lib/RT/Migrate.pm | 193 ++ rt/lib/RT/Migrate/Importer.pm | 468 +++ rt/lib/RT/Migrate/Importer/File.pm | 208 ++ rt/lib/RT/Migrate/Incremental.pm | 657 ++++ rt/lib/RT/Migrate/Serializer.pm | 492 +++ rt/lib/RT/Migrate/Serializer/File.pm | 171 + rt/lib/RT/Migrate/Serializer/IncrementalRecord.pm | 80 + rt/lib/RT/Migrate/Serializer/IncrementalRecords.pm | 69 + rt/lib/RT/ObjectClass.pm | 37 +- rt/lib/RT/ObjectClasses.pm | 12 +- rt/lib/RT/ObjectCustomField.pm | 269 +- rt/lib/RT/ObjectCustomFieldValue.pm | 49 +- rt/lib/RT/ObjectCustomFieldValues.pm | 30 +- rt/lib/RT/ObjectCustomFields.pm | 53 +- rt/lib/RT/ObjectScrip.pm | 277 ++ rt/lib/RT/ObjectScrips.pm | 92 + rt/lib/RT/ObjectTopic.pm | 44 +- rt/lib/RT/ObjectTopics.pm | 18 +- rt/lib/RT/PlackRunner.pm | 165 + rt/lib/RT/Plugin.pm | 10 +- rt/lib/RT/Pod/HTML.pm | 6 + rt/lib/RT/Principal.pm | 152 +- rt/lib/RT/Principals.pm | 15 +- rt/lib/RT/Queue.pm | 889 ++--- rt/lib/RT/Queues.pm | 22 +- rt/lib/RT/Record.pm | 994 ++++-- rt/lib/RT/Record/AddAndSort.pm | 621 ++++ rt/lib/RT/Record/Role.pm | 78 + rt/lib/RT/Record/Role/Lifecycle.pm | 219 ++ rt/lib/RT/Record/Role/Links.pm | 174 + rt/lib/RT/Record/Role/Rights.pm | 133 + rt/lib/RT/Record/Role/Roles.pm | 633 ++++ rt/lib/RT/Record/Role/Status.pm | 314 ++ rt/lib/RT/Reminders.pm | 23 +- rt/lib/RT/Report/Tickets.pm | 1107 ++++++- rt/lib/RT/Report/Tickets/Entry.pm | 83 +- rt/lib/RT/Rule.pm | 3 +- rt/lib/RT/Ruleset.pm | 1 - rt/lib/RT/SQL.pm | 81 +- rt/lib/RT/SavedSearches.pm | 13 +- rt/lib/RT/Scrip.pm | 543 +-- rt/lib/RT/ScripAction.pm | 246 +- rt/lib/RT/ScripActions.pm | 24 +- rt/lib/RT/ScripCondition.pm | 129 +- rt/lib/RT/ScripConditions.pm | 28 +- rt/lib/RT/Scrips.pm | 209 +- rt/lib/RT/Search/ActiveTicketsInQueue.pm | 5 +- rt/lib/RT/Search/Googleish.pm | 271 -- rt/lib/RT/Search/Simple.pm | 289 ++ rt/lib/RT/SearchBuilder.pm | 777 ++++- rt/lib/RT/SearchBuilder/AddAndSort.pm | 219 ++ rt/lib/RT/SearchBuilder/Role.pm | 77 + rt/lib/RT/SearchBuilder/Role/Roles.pm | 399 +++ rt/lib/RT/SharedSetting.pm | 30 +- rt/lib/RT/SharedSettings.pm | 4 +- rt/lib/RT/Shredder.pm | 88 +- rt/lib/RT/Shredder/ACE.pm | 101 - rt/lib/RT/Shredder/Attachment.pm | 136 - rt/lib/RT/Shredder/CachedGroupMember.pm | 143 - rt/lib/RT/Shredder/Constants.pm | 44 +- rt/lib/RT/Shredder/CustomField.pm | 126 - rt/lib/RT/Shredder/CustomFieldValue.pm | 94 - rt/lib/RT/Shredder/Dependencies.pm | 2 +- rt/lib/RT/Shredder/Dependency.pm | 13 +- rt/lib/RT/Shredder/Exceptions.pm | 18 +- rt/lib/RT/Shredder/Group.pm | 185 -- rt/lib/RT/Shredder/GroupMember.pm | 183 -- rt/lib/RT/Shredder/Link.pm | 140 - rt/lib/RT/Shredder/ObjectCustomFieldValue.pm | 116 - rt/lib/RT/Shredder/POD.pm | 6 + rt/lib/RT/Shredder/Plugin.pm | 16 +- rt/lib/RT/Shredder/Plugin/Attachments.pm | 2 +- rt/lib/RT/Shredder/Plugin/Base.pm | 9 +- rt/lib/RT/Shredder/Plugin/Summary.pm | 11 +- rt/lib/RT/Shredder/Plugin/Users.pm | 91 +- rt/lib/RT/Shredder/Principal.pm | 127 - rt/lib/RT/Shredder/Queue.pm | 107 - rt/lib/RT/Shredder/Record.pm | 121 +- rt/lib/RT/Shredder/Scrip.pm | 130 - rt/lib/RT/Shredder/ScripAction.pm | 100 - rt/lib/RT/Shredder/ScripCondition.pm | 101 - rt/lib/RT/Shredder/Template.pm | 120 - rt/lib/RT/Shredder/Ticket.pm | 126 - rt/lib/RT/Shredder/Transaction.pm | 115 - rt/lib/RT/Shredder/User.pm | 191 -- rt/lib/RT/Squish/CSS.pm | 23 +- rt/lib/RT/Squish/JS.pm | 14 +- rt/lib/RT/StyleGuide.pod | 347 +- rt/lib/RT/System.pm | 264 +- rt/lib/RT/Template.pm | 287 +- rt/lib/RT/Templates.pm | 16 +- rt/lib/RT/Test.pm | 548 ++-- rt/lib/RT/Test/Apache.pm | 30 +- rt/lib/RT/Test/GnuPG.pm | 15 +- rt/lib/RT/Test/SMIME.pm | 164 + rt/lib/RT/Test/Shredder.pm | 324 ++ rt/lib/RT/Test/Web.pm | 73 +- rt/lib/RT/Ticket.pm | 2281 +++++-------- rt/lib/RT/Tickets.pm | 1814 ++++------ rt/lib/RT/Tickets_SQL.pm | 512 --- rt/lib/RT/Topic.pm | 66 +- rt/lib/RT/Topics.pm | 12 - rt/lib/RT/Transaction.pm | 873 +++-- rt/lib/RT/Transactions.pm | 28 +- rt/lib/RT/URI.pm | 25 +- rt/lib/RT/URI/a.pm | 10 +- rt/lib/RT/URI/fsck_com_article.pm | 96 +- rt/lib/RT/URI/fsck_com_rt.pm | 18 +- rt/lib/RT/User.pm | 627 +++- rt/lib/RT/Users.pm | 144 +- rt/lib/RT/Util.pm | 10 +- 204 files changed, 24688 insertions(+), 17668 deletions(-) create mode 100644 rt/lib/RT/Action/AutoOpenInactive.pm create mode 100644 rt/lib/RT/Action/NotifyOwnerOrAdminCc.pm create mode 100644 rt/lib/RT/Action/OpenOnStarted.pm create mode 100644 rt/lib/RT/Action/SendForward.pm create mode 100644 rt/lib/RT/Crypt.pm create mode 100644 rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm create mode 100644 rt/lib/RT/Crypt/Role.pm create mode 100644 rt/lib/RT/Crypt/SMIME.pm create mode 100644 rt/lib/RT/DependencyWalker.pm create mode 100644 rt/lib/RT/DependencyWalker/FindDependencies.pm create mode 100644 rt/lib/RT/Interface/Email/Auth/Crypt.pm delete mode 100755 rt/lib/RT/Interface/Email/Auth/GnuPG.pm delete mode 100644 rt/lib/RT/Interface/Web.pm.orig create mode 100644 rt/lib/RT/Interface/Web/Middleware/StaticHeaders.pm create mode 100644 rt/lib/RT/Lifecycle/Ticket.pm create mode 100644 rt/lib/RT/Migrate.pm create mode 100644 rt/lib/RT/Migrate/Importer.pm create mode 100644 rt/lib/RT/Migrate/Importer/File.pm create mode 100644 rt/lib/RT/Migrate/Incremental.pm create mode 100644 rt/lib/RT/Migrate/Serializer.pm create mode 100644 rt/lib/RT/Migrate/Serializer/File.pm create mode 100644 rt/lib/RT/Migrate/Serializer/IncrementalRecord.pm create mode 100644 rt/lib/RT/Migrate/Serializer/IncrementalRecords.pm create mode 100644 rt/lib/RT/ObjectScrip.pm create mode 100644 rt/lib/RT/ObjectScrips.pm create mode 100644 rt/lib/RT/PlackRunner.pm create mode 100644 rt/lib/RT/Record/AddAndSort.pm create mode 100644 rt/lib/RT/Record/Role.pm create mode 100644 rt/lib/RT/Record/Role/Lifecycle.pm create mode 100644 rt/lib/RT/Record/Role/Links.pm create mode 100644 rt/lib/RT/Record/Role/Rights.pm create mode 100644 rt/lib/RT/Record/Role/Roles.pm create mode 100644 rt/lib/RT/Record/Role/Status.pm delete mode 100644 rt/lib/RT/Search/Googleish.pm create mode 100644 rt/lib/RT/Search/Simple.pm create mode 100644 rt/lib/RT/SearchBuilder/AddAndSort.pm create mode 100644 rt/lib/RT/SearchBuilder/Role.pm create mode 100644 rt/lib/RT/SearchBuilder/Role/Roles.pm delete mode 100644 rt/lib/RT/Shredder/ACE.pm delete mode 100644 rt/lib/RT/Shredder/Attachment.pm delete mode 100644 rt/lib/RT/Shredder/CachedGroupMember.pm delete mode 100644 rt/lib/RT/Shredder/CustomField.pm delete mode 100644 rt/lib/RT/Shredder/CustomFieldValue.pm delete mode 100644 rt/lib/RT/Shredder/Group.pm delete mode 100644 rt/lib/RT/Shredder/GroupMember.pm delete mode 100644 rt/lib/RT/Shredder/Link.pm delete mode 100644 rt/lib/RT/Shredder/ObjectCustomFieldValue.pm delete mode 100644 rt/lib/RT/Shredder/Principal.pm delete mode 100644 rt/lib/RT/Shredder/Queue.pm delete mode 100644 rt/lib/RT/Shredder/Scrip.pm delete mode 100644 rt/lib/RT/Shredder/ScripAction.pm delete mode 100644 rt/lib/RT/Shredder/ScripCondition.pm delete mode 100644 rt/lib/RT/Shredder/Template.pm delete mode 100644 rt/lib/RT/Shredder/Ticket.pm delete mode 100644 rt/lib/RT/Shredder/Transaction.pm delete mode 100644 rt/lib/RT/Shredder/User.pm create mode 100644 rt/lib/RT/Test/SMIME.pm create mode 100644 rt/lib/RT/Test/Shredder.pm delete mode 100644 rt/lib/RT/Tickets_SQL.pm (limited to 'rt/lib') diff --git a/rt/lib/RT.pm b/rt/lib/RT.pm index 8174505..7b58685 100644 --- a/rt/lib/RT.pm +++ b/rt/lib/RT.pm @@ -48,6 +48,7 @@ use strict; use warnings; +use 5.010; package RT; @@ -55,6 +56,8 @@ package RT; use Encode (); use File::Spec (); use Cwd (); +use Scalar::Util qw(blessed); +use UNIVERSAL::require; use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE); @@ -63,12 +66,15 @@ use vars qw($BasePath $BinPath $SbinPath $VarPath + $FontPath $LexiconPath + $StaticPath $PluginPath $LocalPath $LocalEtcPath $LocalLibPath $LocalLexiconPath + $LocalStaticPath $LocalPluginPath $MasonComponentRoot $MasonLocalComponentRoot @@ -159,17 +165,13 @@ sub LoadConfig { # If the user does that, do what they mean. $RT::WebPath = '' if ($RT::WebPath eq '/'); - # fix relative LogDir and GnuPG homedir + # Fix relative LogDir; It cannot be fixed in a PostLoadCheck, as + # they are run after logging is enabled. 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; } @@ -195,9 +197,10 @@ sub Init { InitClasses(%args); InitLogging(%args); InitPlugins(); + _BuildTableAttributes(); RT::I18N->Init; RT->Config->PostLoadCheck; - + RT::Lifecycle->FillCache; } =head2 ConnectToDatabase @@ -340,11 +343,11 @@ sub InitLogging { callbacks => [ $simple_cb, $stack_cb ], )); } - if ( $Config->Get('LogToScreen') ) { + if ( $Config->Get('LogToSTDERR') ) { require Log::Dispatch::Screen; $RT::Logger->add( Log::Dispatch::Screen->new ( name => 'screen', - min_level => $Config->Get('LogToScreen'), + min_level => $Config->Get('LogToSTDERR'), callbacks => [ $simple_cb, $stack_cb ], stderr => 1, )); @@ -364,16 +367,6 @@ sub InitLogging { 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 = @_; @@ -406,8 +399,9 @@ sub InitSignalHandlers { sub CheckPerlRequirements { - if ($^V < 5.008003) { - die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V; + eval {require 5.010_001}; + if ($@) { + die sprintf "RT requires Perl v5.10.1 or newer. Your current Perl is v%vd\n", $^V; } # use $error here so the following "die" can still affect the global $@ @@ -486,7 +480,32 @@ sub InitClasses { require RT::ObjectTopics; require RT::Topic; require RT::Topics; + require RT::Link; + require RT::Links; + + _BuildTableAttributes(); + + if ( $args{'Heavy'} ) { + # load scrips' modules + my $scrips = RT::Scrips->new(RT->SystemUser); + 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') ) { + $class->require or $RT::Logger->error( + "Class '$class' is listed in CustomFieldValuesSources option" + ." in the config, but we failed to load it:\n$@\n" + ); + } + + } +} + +sub _BuildTableAttributes { # 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 @@ -505,6 +524,7 @@ sub InitClasses { RT::ScripAction RT::ScripCondition RT::Scrip + RT::ObjectScrip RT::Group RT::GroupMember RT::CustomField @@ -513,34 +533,13 @@ sub InitClasses { RT::ObjectCustomFieldValue RT::Attribute RT::ACE - RT::Link RT::Article RT::Class + RT::Link 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 @@ -650,14 +649,17 @@ You can define plugins by adding them to the @Plugins list in your RT_SiteConfig =cut -our @PLUGINS = (); sub Plugins { + state @PLUGINS; + state $DID_INIT = 0; + my $self = shift; - unless (@PLUGINS) { + unless ($DID_INIT) { $self->InitPluginPaths; @PLUGINS = $self->InitPlugins; + $DID_INIT++; } - return \@PLUGINS; + return [@PLUGINS]; } =head2 PluginDirs @@ -789,9 +791,9 @@ sub CanonicalizeGeneratedPaths { $BasePath = Cwd::realpath($BasePath); for my $path ( - qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath - LocalLibPath LexiconPath LocalLexiconPath PluginPath - LocalPluginPath MasonComponentRoot MasonLocalComponentRoot + qw/EtcPath BinPath SbinPath VarPath LocalPath StaticPath LocalEtcPath + LocalLibPath LexiconPath LocalLexiconPath PluginPath FontPath + LocalPluginPath LocalStaticPath MasonComponentRoot MasonLocalComponentRoot MasonDataDir MasonSessionDir/ ) { @@ -807,12 +809,16 @@ sub CanonicalizeGeneratedPaths { =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: +Helper method to add JS files to the C<@JSFiles> config at runtime. + +To add files, you can add the following line to your extension's main C<.pm> +file: RT->AddJavaScript( 'foo.js', 'bar.js' ); +Files are expected to be in a static root in a F directory, such as +F in your extension or F for local overlays. + =cut sub AddJavaScript { @@ -825,13 +831,17 @@ sub AddJavaScript { =head2 AddStyleSheets -helper method to add css files to C config +Helper method to add CSS files to the C<@CSSFiles> config at runtime. -to add extra css files, you can add the following line -in the plugin's main file: +To add files, you can add the following line to your extension's main C<.pm> +file: RT->AddStyleSheets( 'foo.css', 'bar.css' ); +Files are expected to be in a static root in a F directory, such as +F in your extension or F for local +overlays. + =cut sub AddStyleSheets { @@ -861,6 +871,94 @@ sub StyleSheets { return RT->Config->Get('CSSFiles'); } +=head2 Deprecated + +Notes that a particular call path is deprecated, and will be removed in +a particular release. Puts a warning in the logs indicating such, along +with a stack trace. + +Optional arguments include: + +=over + +=item Remove + +The release which is slated to remove the method or component + +=item Instead + +A suggestion of what to use in place of the deprecated API + +=item Arguments + +Used if not the entire method is being removed, merely a manner of +calling it; names the arguments which are deprecated. + +=item Message + +Overrides the auto-built phrasing of C with a custom message. + +=item Object + +An L object to print the class and numeric id of. Useful if the +admin will need to hunt down a particular object to fix the deprecation +warning. + +=back + +=cut + +sub Deprecated { + my $class = shift; + my %args = ( + Arguments => undef, + Remove => undef, + Instead => undef, + Message => undef, + Stack => 1, + LogLevel => "warn", + @_, + ); + + my ($function) = (caller(1))[3]; + my $stack; + if ($function eq "HTML::Mason::Commands::__ANON__") { + eval { HTML::Mason::Exception->throw() }; + my $error = $@; + my $info = $error->analyze_error; + $function = "Mason component ".$info->{frames}[0]->filename; + $stack = join("\n", map { sprintf("\t[%s:%d]", $_->filename, $_->line) } @{$info->{frames}}); + } else { + $function = "function $function"; + $stack = Carp::longmess(); + } + $stack =~ s/^.*?\n//; # Strip off call to ->Deprecated + + my $msg; + if ($args{Message}) { + $msg = $args{Message}; + } elsif ($args{Arguments}) { + $msg = "Calling $function with $args{Arguments} is deprecated"; + } else { + $msg = "The $function is deprecated"; + } + $msg .= ", and will be removed in RT $args{Remove}" + if $args{Remove}; + $msg .= "."; + + $msg .= " You should use $args{Instead} instead." + if $args{Instead}; + + $msg .= sprintf " Object: %s #%d.", blessed($args{Object}), $args{Object}->id + if $args{Object}; + + $msg .= " Call stack:\n$stack" if $args{Stack}; + + my $loglevel = $args{LogLevel}; + RT->Logger->$loglevel($msg); +} + =head1 BUGS Please report them to rt-bugs@bestpractical.com, if you know what's diff --git a/rt/lib/RT/ACE.pm b/rt/lib/RT/ACE.pm index 83e19ce..c27a82b 100755 --- a/rt/lib/RT/ACE.pm +++ b/rt/lib/RT/ACE.pm @@ -71,15 +71,13 @@ sub Table {'ACL'} use strict; use warnings; -use RT::Principals; -use RT::Queues; -use RT::Groups; +require RT::Principals; +require RT::Queues; +require RT::Groups; -use vars qw ( - %LOWERCASERIGHTNAMES - %OBJECT_TYPES - %TICKET_METAPRINCIPALS -); +our %RIGHTS; + +my (@_ACL_CACHE_HANDLERS); @@ -90,37 +88,22 @@ use vars qw ( =cut - - - - - -%TICKET_METAPRINCIPALS = ( - Owner => 'The owner of a ticket', # loc_pair - Requestor => 'The requestor of a ticket', # loc_pair - Cc => 'The CC of a ticket', # loc_pair - AdminCc => 'The administrative CC of a ticket', # loc_pair -); - - - - =head2 LoadByValues PARAMHASH Load an ACE by specifying a paramhash with the following fields: PrincipalId => undef, PrincipalType => undef, - RightName => undef, + RightName => undef, And either: - Object => undef, + Object => undef, OR - ObjectType => undef, - ObjectId => undef + ObjectType => undef, + ObjectId => undef =cut @@ -137,7 +120,7 @@ sub LoadByValues { if ( $args{'RightName'} ) { my $canonic_name = $self->CanonicalizeRightName( $args{'RightName'} ); unless ( $canonic_name ) { - return ( 0, $self->loc("Invalid right. Couldn't canonicalize right '[_1]'", $args{'RightName'}) ); + return wantarray ? ( 0, $self->loc("Invalid right. Couldn't canonicalize right '[_1]'", $args{'RightName'}) ) : 0; } $args{'RightName'} = $canonic_name; } @@ -148,14 +131,14 @@ sub LoadByValues { $args{'PrincipalType'} ); unless ( $princ_obj->id ) { - return ( 0, + return wantarray ? ( 0, $self->loc( 'Principal [_1] not found.', $args{'PrincipalId'} ) - ); + ) : 0; } my ($object, $object_type, $object_id) = $self->_ParseObjectArg( %args ); unless( $object ) { - return ( 0, $self->loc("System error. Right not granted.") ); + return wantarray ? ( 0, $self->loc("System error. Right not granted.")) : 0; } $self->LoadByCols( PrincipalId => $princ_obj->Id, @@ -166,11 +149,11 @@ sub LoadByValues { #If we couldn't load it. unless ( $self->Id ) { - return ( 0, $self->loc("ACE not found") ); + return wantarray ? ( 0, $self->loc("ACE not found") ) : 0; } # if we could - return ( $self->Id, $self->loc("Right Loaded") ); + return wantarray ? ( $self->Id, $self->loc("Right Loaded") ) : $self->Id; } @@ -223,7 +206,7 @@ sub Create { } ($args{'Object'}, $args{'ObjectType'}, $args{'ObjectId'}) = $self->_ParseObjectArg( %args ); unless( $args{'Object'} ) { - return ( 0, $self->loc("System error. Right not granted.") ); + return ( 0, $self->loc("System error. Right not granted.") ); } # Validate the principal @@ -266,7 +249,7 @@ sub Create { #check if it's a valid RightName if ( $args{'Object'}->can('AvailableRights') ) { - my $available = $args{'Object'}->AvailableRights; + my $available = $args{'Object'}->AvailableRights($princ_obj); unless ( grep $_ eq $args{'RightName'}, map $self->CanonicalizeRightName( $_ ), keys %$available ) { $RT::Logger->warning( "Couldn't validate right name '$args{'RightName'}'" @@ -296,10 +279,12 @@ sub Create { ObjectId => $args{'Object'}->id, ); - #Clear the key cache. TODO someday we may want to just clear a little bit of the keycache space. - RT::Principal->InvalidateACLCache(); - if ( $id ) { + RT::ACE->InvalidateCaches( + Action => "Grant", + RightName => $self->RightName, + ACE => $self, + ); return ( $id, $self->loc('Right Granted') ); } else { @@ -344,12 +329,12 @@ sub _Delete { $RT::Handle->BeginTransaction() unless $InsideTransaction; + my $right = $self->RightName; + my ( $val, $msg ) = $self->SUPER::Delete(@_); if ($val) { - #Clear the key cache. TODO someday we may want to just clear a little bit of the keycache space. - # TODO what about the groups key cache? - RT::Principal->InvalidateACLCache(); + RT::ACE->InvalidateCaches( Action => "Revoke", RightName => $right ); $RT::Handle->Commit() unless $InsideTransaction; return ( $val, $self->loc('Right revoked') ); } @@ -396,7 +381,67 @@ sub _BootstrapCreate { } +=head2 InvalidateCaches + +Calls any registered ACL cache handlers (see L). + +Usually called from L and L. + +=cut + +sub InvalidateCaches { + my $class = shift; + + for my $handler (@_ACL_CACHE_HANDLERS) { + next unless ref($handler) eq "CODE"; + $handler->(@_); + } +} + +=head2 RegisterCacheHandler + +Class method. Takes a coderef and adds it to the ACL cache handlers. These +handlers are called by L, usually called itself from +L and L. + +The handlers are passed a hash which may contain any (or none) of these +optional keys: +=over + +=item Action + +A string indicating the action that (may have) invalidated the cache. Expected +values are currently: + +=over + +=item Grant + +=item Revoke + +=back + +However, other values may be passed in the future. + +=item RightName + +The (canonicalized) right being granted or revoked. + +=item ACE + +The L object just created. + +=back + +Your handler should be flexible enough to account for additional arguments +being passed in the future. + +=cut + +sub RegisterCacheHandler { + push @_ACL_CACHE_HANDLERS, $_[1]; +} sub RightName { my $self = shift; @@ -420,13 +465,17 @@ the correct case. If it's not found, will return undef. =cut sub CanonicalizeRightName { - my $self = shift; - return $LOWERCASERIGHTNAMES{ lc shift }; + my $self = shift; + my $name = shift; + for my $class (sort keys %RIGHTS) { + return $RIGHTS{$class}{ lc $name }{Name} + if $RIGHTS{$class}{ lc $name }; + } + return undef; } - =head2 Object If the object this ACE applies to is a queue, returns the queue object. @@ -445,7 +494,7 @@ sub Object { my $appliesto_obj; - if ($self->__Value('ObjectType') && $OBJECT_TYPES{$self->__Value('ObjectType')} ) { + if ($self->__Value('ObjectType') && $self->__Value('ObjectType')->DOES('RT::Record::Role::Rights') ) { $appliesto_obj = $self->__Value('ObjectType')->new($self->CurrentUser); unless (ref( $appliesto_obj) eq $self->__Value('ObjectType')) { return undef; @@ -563,21 +612,21 @@ sub _ParseObjectArg { @_ ); if( $args{'Object'} && ($args{'ObjectId'} || $args{'ObjectType'}) ) { - $RT::Logger->crit( "Method called with an ObjectType or an ObjectId and Object args" ); - return (); + $RT::Logger->crit( "Method called with an ObjectType or an ObjectId and Object args" ); + return (); } elsif( $args{'Object'} && ref($args{'Object'}) && !$args{'Object'}->can('id') ) { - $RT::Logger->crit( "Method called called Object that has no id method" ); - return (); + $RT::Logger->crit( "Method called called Object that has no id method" ); + return (); } elsif( $args{'Object'} ) { - my $obj = $args{'Object'}; - return ($obj, ref $obj, $obj->id); + my $obj = $args{'Object'}; + return ($obj, ref $obj, $obj->id); } elsif ( $args{'ObjectType'} ) { - my $obj = $args{'ObjectType'}->new( $self->CurrentUser ); - $obj->Load( $args{'ObjectId'} ); - return ($obj, ref $obj, $obj->id); + my $obj = $args{'ObjectType'}->new( $self->CurrentUser ); + $obj->Load( $args{'ObjectId'} ); + return ($obj, ref $obj, $obj->id); } else { - $RT::Logger->crit( "Method called with wrong args" ); - return (); + $RT::Logger->crit( "Method called with wrong args" ); + return (); } } @@ -722,29 +771,39 @@ sub _CoreAccessible { { id => - {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, PrincipalType => - {read => 1, write => 1, sql_type => 12, length => 25, is_blob => 0, is_numeric => 0, type => 'varchar(25)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 25, is_blob => 0, is_numeric => 0, type => 'varchar(25)', default => ''}, PrincipalId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, RightName => - {read => 1, write => 1, sql_type => 12, length => 25, is_blob => 0, is_numeric => 0, type => 'varchar(25)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 25, is_blob => 0, is_numeric => 0, type => 'varchar(25)', default => ''}, ObjectType => - {read => 1, write => 1, sql_type => 12, length => 25, is_blob => 0, is_numeric => 0, type => 'varchar(25)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 25, is_blob => 0, is_numeric => 0, type => 'varchar(25)', default => ''}, ObjectId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, Creator => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, Created => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, LastUpdatedBy => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, LastUpdated => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + + $deps->Add( out => $self->PrincipalObj->Object ); + $deps->Add( out => $self->Object ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ACL.pm b/rt/lib/RT/ACL.pm index 83423ad..89ca69f 100755 --- a/rt/lib/RT/ACL.pm +++ b/rt/lib/RT/ACL.pm @@ -65,10 +65,10 @@ my $ACL = RT::ACL->new($CurrentUser); package RT::ACL; -use RT::ACE; - use base 'RT::SearchBuilder'; +use RT::ACE; + sub Table { 'ACL'} use strict; @@ -122,40 +122,6 @@ sub LimitToObject { -=head2 LimitNotObject $object - -Limit the ACL to rights NOT on the object $object. $object needs to be -an RT::Record class. - -=cut - -sub LimitNotObject { - my $self = shift; - my $obj = shift; - unless ( defined($obj) - && ref($obj) - && UNIVERSAL::can( $obj, 'id' ) - && $obj->id ) - { - return undef; - } - $self->Limit( FIELD => 'ObjectType', - OPERATOR => '!=', - VALUE => ref($obj), - ENTRYAGGREGATOR => 'OR', - SUBCLAUSE => $obj->id - ); - $self->Limit( FIELD => 'ObjectId', - OPERATOR => '!=', - VALUE => $obj->id, - ENTRYAGGREGATOR => 'OR', - QUOTEVALUE => 0, - SUBCLAUSE => $obj->id - ); -} - - - =head2 LimitToPrincipal { Type => undef, Id => undef, IncludeGroupMembership => undef } Limit the ACL to the principal with PrincipalId Id and PrincipalType Type @@ -239,86 +205,9 @@ sub AddRecord { return $self->SUPER::AddRecord( $record ); } +# The singular of ACL is ACE. +sub _SingularClass { "RT::ACE" } - - -#wrap around _DoSearch so that we can build the hash of returned -#values -sub _DoSearch { - my $self = shift; - # $RT::Logger->debug("Now in ".$self."->_DoSearch"); - my $return = $self->SUPER::_DoSearch(@_); - # $RT::Logger->debug("In $self ->_DoSearch. return from SUPER::_DoSearch was $return"); - if ( $self->{'must_redo_search'} ) { - $RT::Logger->crit( -"_DoSearch is not so successful as it still needs redo search, won't call _BuildHash" - ); - } - else { - $self->_BuildHash(); - } - return ($return); -} - - -#Build a hash of this ACL's entries. -sub _BuildHash { - my $self = shift; - - while (my $entry = $self->Next) { - my $hashkey = join '-', map $entry->__Value( $_ ), - qw(ObjectType ObjectId RightName PrincipalId PrincipalType); - - $self->{'as_hash'}->{"$hashkey"} =1; - - } -} - - - -=head2 HasEntry - -=cut - -sub HasEntry { - - my $self = shift; - my %args = ( RightScope => undef, - RightAppliesTo => undef, - RightName => undef, - PrincipalId => undef, - PrincipalType => undef, - @_ ); - - #if we haven't done the search yet, do it now. - $self->_DoSearch(); - - if ($self->{'as_hash'}->{ $args{'RightScope'} . "-" . - $args{'RightAppliesTo'} . "-" . - $args{'RightName'} . "-" . - $args{'PrincipalId'} . "-" . - $args{'PrincipalType'} - } == 1) { - return(1); - } - else { - return(undef); - } -} - -# }}} - - -=head2 NewItem - -Returns an empty new RT::ACE item - -=cut - -sub NewItem { - my $self = shift; - return(RT::ACE->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Action.pm b/rt/lib/RT/Action.pm index 853949d..1740b1d 100755 --- a/rt/lib/RT/Action.pm +++ b/rt/lib/RT/Action.pm @@ -172,13 +172,6 @@ sub Prepare { } -#If this rule applies to this transaction, return true. - -sub IsApplicable { - my $self = shift; - return(undef); -} - sub Options { my $self = shift; return(); @@ -190,19 +183,6 @@ sub Rules { return(split "\n", $self->ScripObj->ActionRules); } -sub DESTROY { - my $self = shift; - - # We need to clean up all the references that might maybe get - # oddly circular - $self->{'ScripActionObj'} = undef; - $self->{'ScripObj'} = undef; - $self->{'TemplateObj'} =undef - $self->{'TicketObj'} = undef; - $self->{'TransactionObj'} = undef; -} - - RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Action/AutoOpen.pm b/rt/lib/RT/Action/AutoOpen.pm index 06721b7..156c1ee 100644 --- a/rt/lib/RT/Action/AutoOpen.pm +++ b/rt/lib/RT/Action/AutoOpen.pm @@ -46,7 +46,6 @@ # # END BPS TAGGED BLOCK }}} -# This Action will open the BASE if a dependent is resolved. package RT::Action::AutoOpen; use strict; @@ -87,7 +86,7 @@ sub Prepare { # no change if the ticket is in initial status and the message is a mail # from a requestor - return 1 if $ticket->QueueObj->Lifecycle->IsInitial($ticket->Status) + return 1 if $ticket->LifecycleObj->IsInitial($ticket->Status) && $self->TransactionObj->IsInbound; if ( my $msg = $self->TransactionObj->Message->First ) { diff --git a/rt/lib/RT/Action/AutoOpenInactive.pm b/rt/lib/RT/Action/AutoOpenInactive.pm new file mode 100644 index 0000000..a8a3739 --- /dev/null +++ b/rt/lib/RT/Action/AutoOpenInactive.pm @@ -0,0 +1,105 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 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::AutoOpenInactive; + +use strict; +use warnings; +use base qw(RT::Action); + +=head1 DESCRIPTION + +This action automatically moves an inactive ticket to an active status. + +Status is not changed if there is no active statuses in the lifecycle. + +Status is not changed if message's head has field C with +C substring. + +Status is set to the first possible active status. If the ticket's status is +C then RT finds all possible transitions from C status and +selects first one that results in the ticket having an active status. + +=cut + +sub Prepare { + my $self = shift; + + my $ticket = $self->TicketObj; + return 0 if $ticket->LifecycleObj->IsActive( $ticket->Status ); + + if ( my $msg = $self->TransactionObj->Message->First ) { + return 0 + if ( $msg->GetHeader('RT-Control') || '' ) =~ + /\bno-autoopen\b/i; + } + + my $next = $ticket->FirstActiveStatus; + return 0 unless defined $next; + + $self->{'set_status_to'} = $next; + + return 1; +} + +sub Commit { + my $self = shift; + + return 1 unless my $new_status = $self->{'set_status_to'}; + + my ($val, $msg) = $self->TicketObj->SetStatus( $new_status ); + unless ( $val ) { + $RT::Logger->error( "Couldn't auto-open-inactive ticket: ". $msg ); + return 0; + } + return 1; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Action/Autoreply.pm b/rt/lib/RT/Action/Autoreply.pm index 2b04222..9bf6ab6 100755 --- a/rt/lib/RT/Action/Autoreply.pm +++ b/rt/lib/RT/Action/Autoreply.pm @@ -93,18 +93,18 @@ Set this message's return address to the apropriate queue address sub SetReturnAddress { my $self = shift; - + my $friendly_name; - if (RT->Config->Get('UseFriendlyFromLine')) { - $friendly_name = $self->TicketObj->QueueObj->Description || - $self->TicketObj->QueueObj->Name; - } + if (RT->Config->Get('UseFriendlyFromLine')) { + $friendly_name = $self->TicketObj->QueueObj->Description || + $self->TicketObj->QueueObj->Name; + } $self->SUPER::SetReturnAddress( @_, friendly_name => $friendly_name ); - + } - + =head2 SetRTSpecialHeaders diff --git a/rt/lib/RT/Action/CreateTickets.pm b/rt/lib/RT/Action/CreateTickets.pm index 46791de..03bc212 100644 --- a/rt/lib/RT/Action/CreateTickets.pm +++ b/rt/lib/RT/Action/CreateTickets.pm @@ -53,6 +53,7 @@ use strict; use warnings; use MIME::Entity; +use RT::Link; =head1 NAME @@ -128,18 +129,18 @@ A convoluted example: my $groups = RT::Groups->new(RT->SystemUser); $groups->LimitToUserDefinedGroups(); - $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name"); + $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => $name, CASESENSITIVE => 0); $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, + Right => "AdminGroup", + Object =>$groups->First, + IncludeSystemRights => undef, + IncludeSuperusers => 0, + IncludeSubgroupMembers => 0, ); our @admins; @@ -241,47 +242,6 @@ all be treated as the same thing. =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; @@ -388,10 +348,6 @@ sub CreateByTemplate { } $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 ); @@ -669,11 +625,6 @@ sub ParseLines { 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; } } @@ -718,7 +669,7 @@ sub ParseLines { } if ( ($tag =~ /^(requestor|cc|admincc)(group)?$/i - or grep {lc $_ eq $tag} keys %LINKTYPEMAP) + or grep {lc $_ eq $tag} keys %RT::Link::TYPEMAP) and $args{$tag} =~ /,/ ) { $args{$tag} = [ split /,\s*/, $args{$tag} ]; @@ -736,7 +687,7 @@ sub ParseLines { eval { $dateobj->Set( Format => 'iso', Value => $args{$date} ); }; - if ($@ or $dateobj->Unix <= 0) { + if ($@ or not $dateobj->IsSet) { $dateobj->Set( Format => 'unknown', Value => $args{$date} ); } } @@ -802,14 +753,22 @@ sub ParseLines { $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; + $cf->LoadByName( + Name => $1, + LookupType => RT::Ticket->CustomFieldLookupType, + ObjectId => $ticketargs{Queue}, + IncludeGlobal => 1, + ); 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; + $cf->LoadByName( + Name => $orig_tag, + LookupType => RT::Ticket->CustomFieldLookupType, + ObjectId => $ticketargs{Queue}, + IncludeGlobal => 1, + ); next unless $cf->id; $ticketargs{ "CustomField-" . $cf->id } = $args{$tag}; @@ -1012,19 +971,11 @@ sub GetUpdateTemplate { $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; - } + foreach my $type ( RT::Link->DisplayTypes ) { $string .= "$type: "; - my $mode = $LINKTYPEMAP{$type}->{Mode}; - my $method = $LINKTYPEMAP{$type}->{Type}; + my $mode = $RT::Link::TYPEMAP{$type}->{Mode}; + my $method = $RT::Link::TYPEMAP{$type}->{Type}; my $links = ''; while ( my $link = $t->$method->Next ) { @@ -1090,15 +1041,7 @@ sub GetCreateTemplate { $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; - } + foreach my $type ( RT::Link->DisplayTypes ) { $string .= "$type: \n"; } return $string; @@ -1220,7 +1163,7 @@ sub PostProcess { $RT::Logger->debug( "Handling links for " . $ticket->Id ); my %args = %{ shift(@$links) }; - foreach my $type ( keys %LINKTYPEMAP ) { + foreach my $type ( keys %RT::Link::TYPEMAP ) { next unless ( defined $args{$type} ); foreach my $link ( ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) ) @@ -1247,8 +1190,8 @@ sub PostProcess { } my ( $wval, $wmsg ) = $ticket->AddLink( - Type => $LINKTYPEMAP{$type}->{'Type'}, - $LINKTYPEMAP{$type}->{'Mode'} => $link, + Type => $RT::Link::TYPEMAP{$type}->{'Type'}, + $RT::Link::TYPEMAP{$type}->{'Mode'} => $link, Silent => 1 ); diff --git a/rt/lib/RT/Action/CreateTickets.pm.orig b/rt/lib/RT/Action/CreateTickets.pm.orig index 542cbd2..46791de 100644 --- a/rt/lib/RT/Action/CreateTickets.pm.orig +++ b/rt/lib/RT/Action/CreateTickets.pm.orig @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -960,6 +960,13 @@ sub GetDeferred { my $links = shift; my $postponed = shift; + # Unify the aliases for child/parent + $args->{$_} = [$args->{$_}] + for grep {$args->{$_} and not ref $args->{$_}} qw/members hasmember memberof/; + push @{$args->{'children'}}, @{delete $args->{'members'}} if $args->{'members'}; + push @{$args->{'children'}}, @{delete $args->{'hasmember'}} if $args->{'hasmember'}; + push @{$args->{'parents'}}, @{delete $args->{'memberof'}} if $args->{'memberof'}; + # Deferred processing push @$links, ( diff --git a/rt/lib/RT/Action/EscalatePriority.pm b/rt/lib/RT/Action/EscalatePriority.pm index 04aa7ed..8632d9d 100644 --- a/rt/lib/RT/Action/EscalatePriority.pm +++ b/rt/lib/RT/Action/EscalatePriority.pm @@ -71,6 +71,30 @@ Alternately, if you don't set a due date, the Priority will be incremented by 1 until it reaches the Final Priority. If a ticket without a due date has a Priority greater than Final Priority, it will be decremented by 1. +=head2 CONFIGURATION + +EsclatePriority's behavior can be controlled by two options: + +=over 4 + +=item RecordTransaction + +If true (the default), the action casuses a transaction on the ticket +when it is escalated. If false, the action updates the priority without +running scrips or recording a transaction. + +=item UpdateLastUpdated + +If true (the default), the action updates the LastUpdated field when the +ticket is escalated. You cannot set C to false unless +C is also false. + +=back + +To use these with C, specify them with C<--action-arg>: + + --action-arg "RecordTransaction: 0, UpdateLastUpdated: 0" + =cut @@ -88,67 +112,67 @@ sub Describe { my $self = shift; return (ref $self . " will move a ticket's priority toward its final priority."); } - + sub Prepare { my $self = shift; - + if ($self->TicketObj->Priority() == $self->TicketObj->FinalPriority()) { - # no update necessary. - return 0; + # no update necessary. + return 0; } - + #compute the number of days until the ticket is due my $due = $self->TicketObj->DueObj(); - + # If we don't have a due date, adjust the priority by one # until we hit the final priority - if ($due->Unix() < 1) { - if ( $self->TicketObj->Priority > $self->TicketObj->FinalPriority ){ - $self->{'prio'} = ($self->TicketObj->Priority - 1); - return 1; - } - elsif ( $self->TicketObj->Priority < $self->TicketObj->FinalPriority ){ - $self->{'prio'} = ($self->TicketObj->Priority + 1); - return 1; - } - # otherwise the priority is at the final priority. we don't need to - # Continue - else { - return 0; - } + if (not $due->IsSet) { + if ( $self->TicketObj->Priority > $self->TicketObj->FinalPriority ){ + $self->{'prio'} = ($self->TicketObj->Priority - 1); + return 1; + } + elsif ( $self->TicketObj->Priority < $self->TicketObj->FinalPriority ){ + $self->{'prio'} = ($self->TicketObj->Priority + 1); + return 1; + } + # otherwise the priority is at the final priority. we don't need to + # Continue + else { + return 0; + } } # we've got a due date. now there are other things we should do - else { + else { my $arg = $self->Argument || ''; my $now = time(); if ( $arg =~ /CurrentTime:\s*(\d+)/i ) { $now = $1; } - my $diff_in_seconds = $due->Diff($now); - my $diff_in_days = int( $diff_in_seconds / 86400); - - #if we haven't hit the due date yet - if ($diff_in_days > 0 ) { - - # compute the difference between the current priority and the - # final priority - - my $prio_delta = - $self->TicketObj->FinalPriority() - $self->TicketObj->Priority; - - my $inc_priority_by = int( $prio_delta / $diff_in_days ); - - #set the ticket's priority to that amount - $self->{'prio'} = $self->TicketObj->Priority + $inc_priority_by; - - } - #if $days is less than 1, set priority to final_priority - else { - $self->{'prio'} = $self->TicketObj->FinalPriority(); - } + my $diff_in_seconds = $due->Diff($now); + my $diff_in_days = int( $diff_in_seconds / 86400); + + #if we haven't hit the due date yet + if ($diff_in_days > 0 ) { + + # compute the difference between the current priority and the + # final priority + + my $prio_delta = + $self->TicketObj->FinalPriority() - $self->TicketObj->Priority; + + my $inc_priority_by = int( $prio_delta / $diff_in_days ); + + #set the ticket's priority to that amount + $self->{'prio'} = $self->TicketObj->Priority + $inc_priority_by; + + } + #if $days is less than 1, set priority to final_priority + else { + $self->{'prio'} = $self->TicketObj->FinalPriority(); + } } return 1; @@ -156,11 +180,58 @@ sub Prepare { sub Commit { my $self = shift; - my ($val, $msg) = $self->TicketObj->SetPriority($self->{'prio'}); + my $new_value = $self->{'prio'}; + return 1 unless defined $new_value; + + my $ticket = $self->TicketObj; + return 1 if $ticket->Priority == $new_value; - unless ($val) { - $RT::Logger->debug($self . " $msg"); - } + # Overide defaults from argument + my($record, $update) = (1, 1); + { + my $arg = $self->Argument || ''; + if ( $arg =~ /RecordTransaction:\s*(\d+)/i ) { + $record = $1; + $RT::Logger->debug("Overrode RecordTransaction: $record"); + } + if ( $arg =~ /UpdateLastUpdated:\s*(\d+)/i ) { + $update = $1; + $RT::Logger->debug("Overrode UpdateLastUpdated: $update"); + } + # If creating a transaction, we have to update lastupdated + $update = 1 if $record; + } + + $RT::Logger->debug( + 'Escalating priority of ticket #'. $ticket->Id + .' from '. $ticket->Priority .' to '. $new_value + .' and'. ($record? '': ' do not') .' record a transaction' + .' and'. ($update? '': ' do not') .' touch last updated field' + ); + + my ($val, $msg); + unless ( $record ) { + unless ( $update ) { + ( $val, $msg ) = $ticket->__Set( + Field => 'Priority', + Value => $new_value, + ); + } else { + ( $val, $msg ) = $ticket->_Set( + Field => 'Priority', + Value => $new_value, + RecordTransaction => 0, + ); + } + } else { + ($val, $msg) = $ticket->SetPriority($new_value); + } + + unless ($val) { + $RT::Logger->error( "Couldn't set new priority value: $msg"); + return (0, $msg); + } + return 1; } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Action/LinearEscalate.pm b/rt/lib/RT/Action/LinearEscalate.pm index cc88b1d..9607033 100755 --- a/rt/lib/RT/Action/LinearEscalate.pm +++ b/rt/lib/RT/Action/LinearEscalate.pm @@ -98,7 +98,7 @@ the Due date. Tickets without due date B. =head1 CONFIGURATION Initial and Final priorities are controlled by queue's options -and can be defined using the web UI via Configuration tab. This +and can be defined using the web UI via Admin tab. This action should handle correctly situations when initial priority is greater than final. @@ -140,8 +140,6 @@ use strict; use warnings; use base qw(RT::Action); -our $VERSION = '0.06'; - #Do what we need to do and send it out. #What does this type of Action does @@ -157,8 +155,7 @@ sub Prepare { my $ticket = $self->TicketObj; - my $due = $ticket->DueObj->Unix; - unless ( $due > 0 ) { + unless ( $ticket->DueObj->IsSet ) { $RT::Logger->debug('Due is not set. Not escalating.'); return 1; } @@ -183,9 +180,8 @@ sub Prepare { # now we know we have a due date. for every day that passes, # increment priority according to the formula - my $starts = $ticket->StartsObj->Unix; - $starts = $ticket->CreatedObj->Unix unless $starts > 0; - my $now = time; + my $starts = $ticket->StartsObj->IsSet ? $ticket->StartsObj->Unix : $ticket->CreatedObj->Unix; + my $now = time; # do nothing if we didn't reach starts or created date if ( $starts > $now ) { @@ -193,12 +189,13 @@ sub Prepare { return 1; } + my $due = $ticket->DueObj->Unix; $due = $starts + 1 if $due <= $starts; # +1 to avoid div by zero my $percent_complete = ($now-$starts)/($due - $starts); my $new_priority = int($percent_complete * $priority_range) + ($ticket->InitialPriority || 0); - $new_priority = $ticket->FinalPriority if $new_priority > $ticket->FinalPriority; + $new_priority = $ticket->FinalPriority if $new_priority > $ticket->FinalPriority; $self->{'new_priority'} = $new_priority; return 1; diff --git a/rt/lib/RT/Action/Notify.pm b/rt/lib/RT/Action/Notify.pm index 0b75b20..633206e 100755 --- a/rt/lib/RT/Action/Notify.pm +++ b/rt/lib/RT/Action/Notify.pm @@ -71,8 +71,8 @@ sub Prepare { =head2 SetRecipients -Sets the recipients of this meesage to Owner, Requestor, AdminCc, Cc or All. -Explicitly B notify the creator of the transaction by default +Sets the recipients of this message to Owner, Requestor, AdminCc, Cc or All. +Explicitly B notify the creator of the transaction by default. =cut @@ -107,6 +107,7 @@ sub SetRecipients { if ( $arg =~ /\bOwner\b/ && $ticket->OwnerObj->id != RT->Nobody->id && $ticket->OwnerObj->EmailAddress + && not $ticket->OwnerObj->Disabled ) { # If we're not sending to Ccs or requestors, # then the Owner can be the To. @@ -131,24 +132,9 @@ sub SetRecipients { } } - my $creatorObj = $self->TransactionObj->CreatorObj; - my $creator = $creatorObj->EmailAddress() || ''; - - #Strip the sender out of the To, Cc and AdminCc and set the - # recipients fields used to build the message by the superclass. - # unless a flag is set - my $TransactionCurrentUser = RT::CurrentUser->new; - $TransactionCurrentUser->LoadByName($creatorObj->Name); - if (RT->Config->Get('NotifyActor',$TransactionCurrentUser)) { - @{ $self->{'To'} } = @To; - @{ $self->{'Cc'} } = @Cc; - @{ $self->{'Bcc'} } = @Bcc; - } - else { - @{ $self->{'To'} } = grep ( lc $_ ne lc $creator, @To ); - @{ $self->{'Cc'} } = grep ( lc $_ ne lc $creator, @Cc ); - @{ $self->{'Bcc'} } = grep ( lc $_ ne lc $creator, @Bcc ); - } + @{ $self->{'To'} } = @To; + @{ $self->{'Cc'} } = @Cc; + @{ $self->{'Bcc'} } = @Bcc; @{ $self->{'PseudoTo'} } = @PseudoTo; if ( $arg =~ /\bOtherRecipients\b/ ) { @@ -161,6 +147,34 @@ sub SetRecipients { } } +=head2 RemoveInappropriateRecipients + +Remove transaction creator as appropriate for the NotifyActor setting. + +To send email to the selected receipients regardless of RT's NotifyActor +configuration, include AlwaysNotifyActor in the list of arguments. + +=cut + +sub RemoveInappropriateRecipients { + my $self = shift; + + my $creatorObj = $self->TransactionObj->CreatorObj; + my $creator = $creatorObj->EmailAddress() || ''; + my $TransactionCurrentUser = RT::CurrentUser->new; + $TransactionCurrentUser->LoadByName($creatorObj->Name); + + $self->RecipientFilter( + Callback => sub { + return unless lc $_[0] eq lc $creator; + return "not sending to $creator, creator of the transaction, due to NotifyActor setting"; + }, + ) unless RT->Config->Get('NotifyActor',$TransactionCurrentUser) + || $self->Argument =~ /\bAlwaysNotifyActor\b/; + + $self->SUPER::RemoveInappropriateRecipients(); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Action/NotifyGroup.pm b/rt/lib/RT/Action/NotifyGroup.pm index 847d60b..5646d7e 100644 --- a/rt/lib/RT/Action/NotifyGroup.pm +++ b/rt/lib/RT/Action/NotifyGroup.pm @@ -73,6 +73,10 @@ require RT::Group; =head2 SetRecipients Sets the recipients of this message to Groups and/or Users. +Respects RT's NotifyActor configuration. + +To send email to the selected receipients regardless of RT's NotifyActor +configuration, include AlwaysNotifyActor in the list of arguments. =cut @@ -84,16 +88,6 @@ sub SetRecipients { $self->_HandleArgument( $_ ); } - my $creatorObj = $self->TransactionObj->CreatorObj; - my $creator = $creatorObj->EmailAddress(); - - my $TransactionCurrentUser = RT::CurrentUser->new; - $TransactionCurrentUser->LoadByName($creatorObj->Name); - - unless (RT->Config->Get('NotifyActor',$TransactionCurrentUser)) { - @{ $self->{'To'} } = grep ( !/^\Q$creator\E$/, @{ $self->{'To'} } ); - } - $self->{'seen_ueas'} = {}; return 1; @@ -103,6 +97,8 @@ sub _HandleArgument { my $self = shift; my $instance = shift; + return if ( $instance eq 'AlwaysNotifyActor' ); + if ( $instance !~ /\D/ ) { my $obj = RT::Principal->new( $self->CurrentUser ); $obj->Load( $instance ); diff --git a/rt/lib/RT/Action/NotifyGroupAsComment.pm b/rt/lib/RT/Action/NotifyGroupAsComment.pm index a1c0d08..dd69fa3 100644 --- a/rt/lib/RT/Action/NotifyGroupAsComment.pm +++ b/rt/lib/RT/Action/NotifyGroupAsComment.pm @@ -62,14 +62,12 @@ package RT::Action::NotifyGroupAsComment; use strict; use warnings; -use RT::Action::NotifyGroup; - use base qw(RT::Action::NotifyGroup); sub SetReturnAddress { - my $self = shift; - $self->{'comment'} = 1; - return $self->SUPER::SetReturnAddress( @_, is_comment => 1 ); + my $self = shift; + $self->{'comment'} = 1; + return $self->SUPER::SetReturnAddress( @_, is_comment => 1 ); } =head1 AUTHOR diff --git a/rt/lib/RT/Action/NotifyOwnerOrAdminCc.pm b/rt/lib/RT/Action/NotifyOwnerOrAdminCc.pm new file mode 100644 index 0000000..2d6e423 --- /dev/null +++ b/rt/lib/RT/Action/NotifyOwnerOrAdminCc.pm @@ -0,0 +1,76 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 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::NotifyOwnerOrAdminCc; + +use strict; +use warnings; + +use base qw(RT::Action::Notify); + +use Email::Address; + +=head1 Notify Owner or AdminCc + +If the owner of this ticket is Nobody, notify the AdminCcs. Otherwise, only notify the Owner. + +=cut + +sub Argument { + my $self = shift; + my $ticket = $self->TicketObj; + if ($ticket->Owner == RT->Nobody->id) { + return 'AdminCc'; + } else { + return 'Owner'; + } +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Action/OpenOnStarted.pm b/rt/lib/RT/Action/OpenOnStarted.pm new file mode 100644 index 0000000..0995e94 --- /dev/null +++ b/rt/lib/RT/Action/OpenOnStarted.pm @@ -0,0 +1,87 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 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 }}} + +=head1 NAME + + RT::Action::OpenOnStarted + +=head1 DESCRIPTION + +OpenOnStarted is a ScripAction which sets a ticket status to open when the +ticket is given a Started value. Before this commit, this functionality used to +happen in RT::Ticket::SetStarted which made the functionality the policy for +setting started. Moving the functionality to a scrip allows for it to be +disabled if it is not desired. + +=cut + +package RT::Action::OpenOnStarted; +use base 'RT::Action'; +use strict; +use warnings; + +sub Prepare { + my $self = shift; + return 0 unless $self->TransactionObj->Type eq "Set"; + return 0 unless $self->TransactionObj->Field eq "Started"; + return 1; +} + +sub Commit { + my $self = shift; + my $ticket = $self->TicketObj; + + my $next = $ticket->FirstActiveStatus; + $ticket->SetStatus( $next ) if defined $next; + + return 1; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Action/RecordComment.pm b/rt/lib/RT/Action/RecordComment.pm index d9ee7f1..575c92e 100644 --- a/rt/lib/RT/Action/RecordComment.pm +++ b/rt/lib/RT/Action/RecordComment.pm @@ -59,11 +59,12 @@ been started, to make a comment on the ticket. =head1 SYNOPSIS -my $action_obj = RT::Action::RecordComment->new('TicketObj' => $ticket_obj, - 'TemplateObj' => $template_obj, - ); -my $result = $action_obj->Prepare(); -$action_obj->Commit() if $result; + my $action_obj = RT::Action::RecordComment->new( + 'TicketObj' => $ticket_obj, + 'TemplateObj' => $template_obj, + ); + my $result = $action_obj->Prepare(); + $action_obj->Commit() if $result; =head1 METHODS @@ -79,8 +80,8 @@ will give us a loop. sub Prepare { my $self = shift; if (defined $self->{'TransactionObj'} && - $self->{'TransactionObj'}->Type =~ /^(Comment|Correspond)$/) { - return undef; + $self->{'TransactionObj'}->Type =~ /^(Comment|Correspond)$/) { + return undef; } return 1; } @@ -103,14 +104,14 @@ sub CreateTransaction { my $self = shift; my ($result, $msg) = $self->{'TemplateObj'}->Parse( - TicketObj => $self->{'TicketObj'}); + TicketObj => $self->{'TicketObj'}); return undef unless $result; - + my ($trans, $desc, $transaction) = $self->{'TicketObj'}->Comment( - MIMEObj => $self->TemplateObj->MIMEObj); + MIMEObj => $self->TemplateObj->MIMEObj); $self->{'TransactionObj'} = $transaction; } - + RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Action/RecordCorrespondence.pm b/rt/lib/RT/Action/RecordCorrespondence.pm index 4dd8eba..e407b9f 100644 --- a/rt/lib/RT/Action/RecordCorrespondence.pm +++ b/rt/lib/RT/Action/RecordCorrespondence.pm @@ -59,12 +59,12 @@ been started, to create a correspondence on the ticket. =head1 SYNOPSIS -my $action_obj = RT::Action::RecordCorrespondence->new( - 'TicketObj' => $ticket_obj, - 'TemplateObj' => $template_obj, - ); -my $result = $action_obj->Prepare(); -$action_obj->Commit() if $result; + my $action_obj = RT::Action::RecordCorrespondence->new( + 'TicketObj' => $ticket_obj, + 'TemplateObj' => $template_obj, + ); + my $result = $action_obj->Prepare(); + $action_obj->Commit() if $result; =head1 METHODS @@ -80,8 +80,8 @@ will give us a loop. sub Prepare { my $self = shift; if (defined $self->{'TransactionObj'} && - $self->{'TransactionObj'}->Type =~ /^(Comment|Correspond)$/) { - return undef; + $self->{'TransactionObj'}->Type =~ /^(Comment|Correspond)$/) { + return undef; } return 1; } @@ -104,14 +104,14 @@ sub CreateTransaction { my $self = shift; my ($result, $msg) = $self->{'TemplateObj'}->Parse( - TicketObj => $self->{'TicketObj'}); + TicketObj => $self->{'TicketObj'}); return undef unless $result; - + my ($trans, $desc, $transaction) = $self->{'TicketObj'}->Correspond( - MIMEObj => $self->TemplateObj->MIMEObj); + MIMEObj => $self->TemplateObj->MIMEObj); $self->{'TransactionObj'} = $transaction; } - + RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index af3a6bf..80b0054 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -135,13 +135,15 @@ Builds an outgoing email we're going to send using scrip's template. sub Prepare { my $self = shift; - my ( $result, $message ) = $self->TemplateObj->Parse( - Argument => $self->Argument, - TicketObj => $self->TicketObj, - TransactionObj => $self->TransactionObj - ); - if ( !$result ) { - return (undef); + unless ( $self->TemplateObj->MIMEObj ) { + my ( $result, $message ) = $self->TemplateObj->Parse( + Argument => $self->Argument, + TicketObj => $self->TicketObj, + TransactionObj => $self->TransactionObj + ); + if ( !$result ) { + return (undef); + } } my $MIMEObj = $self->TemplateObj->MIMEObj; @@ -179,12 +181,6 @@ sub Prepare { && !$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'; @@ -195,9 +191,12 @@ sub Prepare { $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); } - RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, - RT->Config->Get('EmailOutputEncoding'), - 'mime_words_ok', ); + RT::I18N::SetMIMEEntityToEncoding( + Entity => $MIMEObj, + Encoding => RT->Config->Get('EmailOutputEncoding'), + PreserveWords => 1, + IsOut => 1, + ); # Build up a MIME::Entity that looks like the original message. $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message') @@ -218,7 +217,7 @@ sub Prepare { 'Success'; } - return $result; + return 1; } =head2 To @@ -407,6 +406,7 @@ sub AddAttachment { Data => $attach->OriginalContent, Disposition => $disp, Filename => $self->MIMEEncodeString( $attach->Filename ), + Id => $attach->GetHeader('Content-ID'), 'RT-Attachment:' => $self->TicketObj->Id . "/" . $self->TransactionObj->Id . "/" . $attach->id, @@ -462,11 +462,11 @@ sub AddTicket { 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' + ALIAS => $txn_alias, + FIELD => 'Type', + OPERATOR => 'IN', + VALUE => [qw(Create Correspond)], ); $attachs->LimitByTicket($tid); $attachs->LimitNotEmpty; @@ -601,16 +601,10 @@ sub SetRTSpecialHeaders { } } - 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', + $self->SetHeader( 'X-RT-Ticket', RT->Config->Get('rtname') . " #" . $self->TicketObj->id() ); - $self->SetHeader( 'Managed-by', + $self->SetHeader( 'X-Managed-by', "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be @@ -619,7 +613,7 @@ sub SetRTSpecialHeaders { and ! defined $self->TemplateObj->MIMEObj->head->get("RT-Originator") and RT->Config->Get('UseOriginatorHeader') ) { - $self->SetHeader( 'RT-Originator', $email ); + $self->SetHeader( 'X-RT-Originator', $email ); } } @@ -739,15 +733,29 @@ Remove addresses that are RT addresses or that are on this transaction's blackli =cut +my %squelch_reasons = ( + 'not privileged' + => "because autogenerated messages are configured to only be sent to privileged users (RedistributeAutoGeneratedMessages)", + 'squelch:attachment' + => "by RT-Squelch-Replies-To header in the incoming message", + 'squelch:transaction' + => "by notification checkboxes for this transaction", + 'squelch:ticket' + => "by notification checkboxes on this ticket's People page", +); + + sub RemoveInappropriateRecipients { my $self = shift; - my @blacklist = (); + 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 = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') ); + chomp $msgid; + if ( my $attachment = $self->TransactionObj->Attachments->First ) { if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { @@ -756,7 +764,9 @@ sub RemoveInappropriateRecipients { # caused by one of the watcher addresses being broken. # Default ("true") is to redistribute, for historical reasons. - if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) { + my $redistribute = RT->Config->Get('RedistributeAutoGeneratedMessages'); + + if ( !$redistribute ) { # Don't send to any watchers. @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS); @@ -764,16 +774,15 @@ sub RemoveInappropriateRecipients { . " The incoming message was autogenerated. " . "Not redistributing this message based on site configuration." ); - } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq - 'privileged' ) - { + } elsif ( $redistribute 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; + $blacklist{ $addr } ||= 'not privileged' + unless $user->id && $user->Privileged; } } $RT::Logger->info( $msgid @@ -784,48 +793,88 @@ sub RemoveInappropriateRecipients { } if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) { - push @blacklist, split( /,/, $squelch ); + $blacklist{ $_->address } ||= 'squelch:attachment' + foreach Email::Address->parse( $squelch ); } } - # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted - push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo; + # Let's grab the SquelchMailTo attributes and push those entries + # into the blacklisted + $blacklist{ $_->Content } ||= 'squelch:transaction' + foreach $self->TransactionObj->SquelchMailTo; + $blacklist{ $_->Content } ||= 'squelch:ticket' + foreach $self->TicketObj->SquelchMailTo; + + # canonicalize emails + foreach my $address ( keys %blacklist ) { + my $reason = delete $blacklist{ $address }; + $blacklist{ lc $_ } = $reason + foreach map RT::User->CanonicalizeEmailAddress( $_->address ), + Email::Address->parse( $address ); + } - # Cycle through the people we're sending to and pull out anyone on the - # system blacklist + $self->RecipientFilter( + Callback => sub { + return unless RT::EmailParser->IsRTAddress( $_[0] ); + return "$_[0] appears to point to this RT instance. Skipping"; + }, + All => 1, + ); - # Trim leading and trailing spaces. - @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } - Email::Address->parse( join ', ', grep defined, @blacklist ); + $self->RecipientFilter( + Callback => sub { + return unless $blacklist{ lc $_[0] }; + return "$_[0] is blacklisted $squelch_reasons{ $blacklist{ lc $_[0] } }. Skipping"; + }, + ); - foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + + # Cycle through the people we're sending to and pull out anyone that meets any of the callbacks + for 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; + ADDRESS: + for my $addr ( @{ $self->{$type} } ) { + for my $filter ( map {$_->{Callback}} @{$self->{RecipientFilter}} ) { + my $skip = $filter->($addr); + next unless $skip; + $RT::Logger->info( "$msgid $skip" ); + next ADDRESS; } 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; + + NOSQUELCH_ADDRESS: + for my $addr ( @{ $self->{NoSquelch}{$type} } ) { + for my $filter ( map {$_->{Callback}} grep {$_->{All}} @{$self->{RecipientFilter}} ) { + my $skip = $filter->($addr); + next unless $skip; + $RT::Logger->info( "$msgid $skip" ); + next NOSQUELCH_ADDRESS; } push @addrs, $addr; } + @{ $self->{$type} } = @addrs; } } +=head2 RecipientFilter Callback => SUB, [All => 1] + +Registers a filter to be applied to addresses by +L. The C will be called with +one address at a time, and should return false if the address should +receive mail, or a message explaining why it should not be. Passing a +true value for C will cause the filter to also be applied to +NoSquelch (one-time Cc and Bcc) recipients as well. + +=cut + +sub RecipientFilter { + my $self = shift; + push @{ $self->{RecipientFilter}}, {@_}; +} + =head2 SetReturnAddress is_comment => BOOLEAN Calculate and set From and Reply-To headers based on the is_comment flag. @@ -1079,13 +1128,8 @@ Returns a fake Message-ID: header for the ticket to allow a base level of thread =cut sub PseudoReference { - my $self = shift; - my $pseudo_ref - = 'TicketObj->id . '@' - . RT->Config->Get('Organization') . '>'; - return $pseudo_ref; + return RT::Interface::Email::PseudoReference( $self->TicketObj ); } =head2 SetHeaderAsEncoding($field_name, $charset_encoding) @@ -1101,11 +1145,6 @@ sub SetHeaderAsEncoding { my $head = $self->TemplateObj->MIMEObj->head; - if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { - $head->replace( $field, Encode::encode( "UTF-8", RT->Config->Get('SMTPFrom') ) ); - return; - } - my $value = Encode::decode("UTF-8", $head->get( $field )); $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes $head->replace( $field, $value ); diff --git a/rt/lib/RT/Action/SendEmail.pm.orig b/rt/lib/RT/Action/SendEmail.pm.orig index 0f11cc1..af3a6bf 100755 --- a/rt/lib/RT/Action/SendEmail.pm.orig +++ b/rt/lib/RT/Action/SendEmail.pm.orig @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -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( @@ -616,6 +616,7 @@ sub SetRTSpecialHeaders { # 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 ! defined $self->TemplateObj->MIMEObj->head->get("RT-Originator") and RT->Config->Get('UseOriginatorHeader') ) { $self->SetHeader( 'RT-Originator', $email ); @@ -649,7 +650,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 +747,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 +923,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 +937,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 +978,7 @@ sub SetSubject { $subject =~ s/(\r\n|\n|\s)/ /g; - $self->SetHeader( 'Subject', Encode::encode_utf8( $subject ) ); + $self->SetHeader( 'Subject', $subject ); } @@ -992,11 +994,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 +1090,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 +1102,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 +1117,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/SendForward.pm b/rt/lib/RT/Action/SendForward.pm new file mode 100644 index 0000000..5fad224 --- /dev/null +++ b/rt/lib/RT/Action/SendForward.pm @@ -0,0 +1,138 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 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::SendForward; + +use strict; +use warnings; + +use base qw(RT::Action::SendEmail); + +use Email::Address; + +=head2 Prepare + +=cut + +sub Prepare { + my $self = shift; + + my $txn = $self->TransactionObj; + + if ( $txn->Type eq 'Forward Transaction' ) { + my $forwarded_txn = RT::Transaction->new( $self->CurrentUser ); + $forwarded_txn->Load( $txn->Field ); + $self->{ForwardedTransactionObj} = $forwarded_txn; + } + + my ( $result, $message ) = $self->TemplateObj->Parse( + Argument => $self->Argument, + Ticket => $self->TicketObj, + Transaction => $self->ForwardedTransactionObj, + ForwardTransaction => $self->TransactionObj, + ); + + if ( !$result ) { + return (undef); + } + + my $mime = $self->TemplateObj->MIMEObj; + $mime->make_multipart unless $mime->is_multipart; + + my $entity; + if ( $txn->Type eq 'Forward Transaction' ) { + $entity = $self->ForwardedTransactionObj->ContentAsMIME; + } + else { + my $txns = $self->TicketObj->Transactions; + $txns->Limit( + FIELD => 'Type', + OPERATOR => 'IN', + VALUE => [qw(Create Correspond)], + ); + + $entity = MIME::Entity->build( + Type => 'multipart/mixed', + Description => 'forwarded ticket', + ); + $entity->add_part($_) foreach + map $_->ContentAsMIME, + @{ $txns->ItemsArrayRef }; + } + + $mime->add_part($entity); + + my $txn_attachment = $self->TransactionObj->Attachments->First; + for my $header (qw/From To Cc Bcc/) { + if ( $txn_attachment->GetHeader( $header ) ) { + $mime->head->replace( $header => Encode::encode( "UTF-8", $txn_attachment->GetHeader($header) ) ); + } + } + + if ( RT->Config->Get('ForwardFromUser') ) { + $mime->head->replace( 'X-RT-Sign' => 0 ); + } + + $self->SUPER::Prepare(); +} + +sub SetSubjectToken { + my $self = shift; + return if RT->Config->Get('ForwardFromUser'); + $self->SUPER::SetSubjectToken(@_); +} + +sub ForwardedTransactionObj { + my $self = shift; + return $self->{'ForwardedTransactionObj'}; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Action/SetStatus.pm b/rt/lib/RT/Action/SetStatus.pm index 2f932ec..d763b9b 100644 --- a/rt/lib/RT/Action/SetStatus.pm +++ b/rt/lib/RT/Action/SetStatus.pm @@ -101,7 +101,7 @@ sub Prepare { my $self = shift; my $ticket = $self->TicketObj; - my $lifecycle = $ticket->QueueObj->Lifecycle; + my $lifecycle = $ticket->LifecycleObj; my $status = $ticket->Status; my $argument = $self->Argument; diff --git a/rt/lib/RT/Approval/Rule/NewPending.pm b/rt/lib/RT/Approval/Rule/NewPending.pm index a501b11..4195565 100644 --- a/rt/lib/RT/Approval/Rule/NewPending.pm +++ b/rt/lib/RT/Approval/Rule/NewPending.pm @@ -75,7 +75,7 @@ sub Commit { # first txn entry of the approval ticket local $self->{TransactionObj} = $to; - $self->RunScripAction('Notify Owner', 'New Pending Approval', @_); + $self->RunScripAction('Notify Owner and AdminCcs', 'New Pending Approval', @_); return; diff --git a/rt/lib/RT/Approval/Rule/Passed.pm b/rt/lib/RT/Approval/Rule/Passed.pm index 22413d0..53d09a1 100644 --- a/rt/lib/RT/Approval/Rule/Passed.pm +++ b/rt/lib/RT/Approval/Rule/Passed.pm @@ -96,7 +96,7 @@ sub Commit { $top->Correspond( MIMEObj => $template->MIMEObj ); if ($passed) { - my $new_status = $top->QueueObj->Lifecycle->DefaultStatus('approved') || 'open'; + my $new_status = $top->LifecycleObj->DefaultStatus('approved') || 'open'; if ( $new_status ne $top->Status ) { $top->SetStatus( $new_status ); } diff --git a/rt/lib/RT/Approval/Rule/Rejected.pm b/rt/lib/RT/Approval/Rule/Rejected.pm index d049ef8..91078d3 100644 --- a/rt/lib/RT/Approval/Rule/Rejected.pm +++ b/rt/lib/RT/Approval/Rule/Rejected.pm @@ -75,7 +75,7 @@ sub Commit { # XXX: from custom prepare code $rejected->Correspond( MIMEObj => $template->MIMEObj ); $rejected->SetStatus( - Status => $rejected->QueueObj->Lifecycle->DefaultStatus('denied') || 'rejected', + Status => $rejected->LifecycleObj->DefaultStatus('denied') || 'rejected', Force => 1, ); } diff --git a/rt/lib/RT/Article.pm b/rt/lib/RT/Article.pm index 8f955da..b53c3cc 100644 --- a/rt/lib/RT/Article.pm +++ b/rt/lib/RT/Article.pm @@ -50,9 +50,11 @@ use strict; use warnings; package RT::Article; - use base 'RT::Record'; +use Role::Basic 'with'; +with "RT::Record::Role::Links" => { -excludes => ["AddLink", "_AddLinksOnCreate"] }; + use RT::Articles; use RT::ObjectTopics; use RT::Classes; @@ -67,8 +69,7 @@ sub Table {'Articles'} # This object takes custom fields use RT::CustomField; -RT::CustomField->_ForObjectType( CustomFieldLookupType() => 'Articles' ) - ; #loc +RT::CustomField->RegisterLookupType( CustomFieldLookupType() => 'Articles' ); #loc # {{{ Create @@ -352,27 +353,11 @@ sub Children { =head2 AddLink -Takes a paramhash of Type and one of Base or Target. Adds that link to this tick -et. - -=cut - -sub DeleteLink { - my $self = shift; - my %args = ( - Target => '', - Base => '', - Type => '', - Silent => undef, - @_ - ); +Takes a paramhash of Type and one of Base or Target. Adds that link to this article. - unless ( $self->CurrentUserHasRight('ModifyArticle') ) { - return ( 0, $self->loc("Permission Denied") ); - } +Prevents the use of plain numbers to avoid confusing behaviour. - $self->_DeleteLink(%args); -} +=cut sub AddLink { my $self = shift; @@ -397,15 +382,6 @@ sub AddLink { return ( 0, $self->loc("Cannot add link to plain number") ); } - # Check that we're actually getting a valid URI - my $uri_obj = RT::URI->new( $self->CurrentUser ); - unless ( $uri_obj->FromURI( $args{'Target'}||$args{'Base'} )) { - my $msg = $self->loc( "Couldn't resolve '[_1]' into a Link.", $args{'Target'} || $args{'Base'} ); - $RT::Logger->warning( $msg ); - return( 0, $msg ); - } - - $self->_AddLink(%args); } @@ -522,26 +498,6 @@ sub DeleteTopic { } } -=head2 CurrentUserHasRight - -Returns true if the current user has the right for this article, for the whole system or for this article's class - -=cut - -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - - return ( - $self->CurrentUser->HasRight( - Right => $right, - Object => $self, - EquivObjects => [ $RT::System, $RT::System, $self->ClassObj ] - ) - ); - -} - =head2 CurrentUserCanSee Returns true if the current user can see the article, using ShowArticle @@ -610,6 +566,14 @@ sub CustomFieldLookupType { "RT::Class-RT::Article"; } + +sub ACLEquivalenceObjects { + my $self = shift; + return $self->ClassObj; +} + +sub ModifyLinkRight { "ModifyArticle" } + =head2 LoadByInclude Field Value Takes the name of a form field from "Include Article" @@ -646,11 +610,11 @@ sub LoadByInclude { } unless ($ok) { # load failed, don't check Class - return ($ok, $msg); + return wantarray ? ($ok, $msg) : $ok; } unless ($Queue) { # we haven't requested extra sanity checking - return ($ok, $msg); + return wantarray ? ($ok, $msg) : $ok; } # ensure that this article is available for the Queue we're @@ -658,10 +622,10 @@ sub LoadByInclude { my $class = $self->ClassObj; unless ($class->IsApplied(0) || $class->IsApplied($Queue)) { $self->LoadById(0); - return (0, $self->loc("The Class of the Article identified by [_1] is not applied to the current Queue",$Value)); + return wantarray ? (0, $self->loc("The Class of the Article identified by [_1] is not applied to the current Queue",$Value)) : 0; } - return ($ok, $msg); + return wantarray ? ($ok, $msg) : $ok; } @@ -755,10 +719,10 @@ Returns the Class Object which has the id returned by Class =cut sub ClassObj { - my $self = shift; - my $Class = RT::Class->new($self->CurrentUser); - $Class->Load($self->Class()); - return($Class); + my $self = shift; + my $Class = RT::Class->new($self->CurrentUser); + $Class->Load($self->Class()); + return($Class); } =head2 Parent @@ -838,31 +802,57 @@ sub _CoreAccessible { { id => - {read => 1, type => 'int(11)', default => ''}, + {read => 1, type => 'int(11)', default => ''}, Name => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, type => 'varchar(255)', default => ''}, Summary => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, type => 'varchar(255)', default => ''}, SortOrder => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, Class => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, Parent => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, URI => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, type => 'varchar(255)', default => ''}, Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, type => 'int(11)', default => '0'}, Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, + {read => 1, auto => 1, type => 'datetime', default => ''}, LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, type => 'int(11)', default => '0'}, LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, + {read => 1, auto => 1, type => 'datetime', default => ''}, } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + + # Links + my $links = RT::Links->new( $self->CurrentUser ); + $links->Limit( + SUBCLAUSE => "either", + FIELD => $_, + VALUE => $self->URI, + ENTRYAGGREGATOR => 'OR' + ) for qw/Base Target/; + $deps->Add( in => $links ); + + $deps->Add( out => $self->ClassObj ); + $deps->Add( in => $self->Topics ); +} + +sub PostInflate { + my $self = shift; + + $self->__Set( Field => 'URI', Value => $self->URI ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Articles.pm b/rt/lib/RT/Articles.pm index 6800232..4b85eba 100644 --- a/rt/lib/RT/Articles.pm +++ b/rt/lib/RT/Articles.pm @@ -300,7 +300,8 @@ sub LimitCustomField { $self->Limit( ALIAS => $fields, FIELD => 'Name', VALUE => $args{'FIELD'}, - ENTRYAGGREGATOR => 'OR'); + ENTRYAGGREGATOR => 'OR', + CASESENSITIVE => 0); $self->Limit( ALIAS => $fields, FIELD => 'LookupType', @@ -388,15 +389,15 @@ sub LimitCustomField { sub LimitTopics { my $self = shift; my @topics = @_; + return unless @topics; my $topics = $self->NewAlias('ObjectTopics'); $self->Limit( - ALIAS => $topics, - FIELD => 'Topic', - VALUE => $_, - ENTRYAGGREGATOR => 'OR' - ) - for @topics; + ALIAS => $topics, + FIELD => 'Topic', + OPERATOR => 'IN', + VALUE => [ @topics ], + ); $self->Limit( ALIAS => $topics, @@ -580,16 +581,10 @@ sub Search { } - require Time::ParseDate; foreach my $date (qw(Created< Created> LastUpdated< LastUpdated>)) { next unless ( $args{$date} ); - my ($seconds, $error) = Time::ParseDate::parsedate( $args{$date}, FUZZY => 1, PREFER_PAST => 1 ); - unless ( defined $seconds ) { - $RT::Logger->warning( - "Couldn't parse date '$args{$date}' by Time::ParseDate" ); - } my $date_obj = RT::Date->new( $self->CurrentUser ); - $date_obj->Set( Format => 'unix', Value => $seconds ); + $date_obj->Set( Format => 'unknown', Value => $args{$date} ); $dates->{$date} = $date_obj; if ( $date =~ /^(.*?)<$/i ) { @@ -897,22 +892,6 @@ sub Search { return 1; } - -=head2 NewItem - -Returns an empty new RT::Article item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Article->new($self->CurrentUser)); -} - - - RT::Base->_ImportOverlays(); 1; - -1; diff --git a/rt/lib/RT/Attachment.pm b/rt/lib/RT/Attachment.pm index 78c1f67..154d161 100755 --- a/rt/lib/RT/Attachment.pm +++ b/rt/lib/RT/Attachment.pm @@ -80,6 +80,7 @@ use MIME::Base64; use MIME::QuotedPrint; use MIME::Body; use RT::Util 'mime_recommended_filename'; +use URI; sub _OverlayAccessible { { @@ -127,13 +128,15 @@ sub Create { # If we possibly can, collapse it to a singlepart $Attachment->make_singlepart; + my $head = $Attachment->head; + # Get the subject - my $Subject = Encode::decode( 'UTF-8', $Attachment->head->get( 'subject' ) ); + my $Subject = Encode::decode( 'UTF-8', $head->get( 'subject' ) ); $Subject = '' unless defined $Subject; chomp $Subject; #Get the Message-ID - my $MessageId = Encode::decode( "UTF-8", $Attachment->head->get( 'Message-ID' ) ); + my $MessageId = Encode::decode( "UTF-8", $head->get( 'Message-ID' ) ); defined($MessageId) or $MessageId = ''; chomp ($MessageId); $MessageId =~ s/^<(.*?)>$/$1/o; @@ -144,9 +147,18 @@ sub Create { # remove path part. $Filename =~ s!.*/!! if $Filename; + my $content; + unless ( $head->get('Content-Length') ) { + my $length = 0; + $length = length $Attachment->bodyhandle->as_string + if defined $Attachment->bodyhandle; + $head->replace( 'Content-Length' => Encode::encode( "UTF-8", $length ) ); + } + $head = $head->as_string; + # MIME::Head doesn't support perl strings well and can return # octets which later will be double encoded in low-level code - my $head = Encode::decode( 'UTF-8', $Attachment->head->as_string ); + $head = Encode::decode( 'UTF-8', $head ); # If a message has no bodyhandle, that means that it has subparts (or appears to) # and we should act accordingly. @@ -162,6 +174,12 @@ sub Create { unless ($id) { $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr); + my $txn = RT::Transaction->new($self->CurrentUser); + $txn->Load($args{'TransactionId'}); + if ( $txn->id ) { + $txn->Object->_NewTransaction( Type => 'AttachmentError', ActivateScrips => 0, Data => $Filename ); + } + return ($id); } foreach my $part ( $Attachment->parts ) { @@ -173,6 +191,7 @@ sub Create { ); unless ($id) { $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); + return ($id); } } return ($id); @@ -181,47 +200,39 @@ sub Create { #If it's not multipart else { - my ($ContentEncoding, $Body, $ContentType, $Filename) = $self->_EncodeLOB( - $Attachment->bodyhandle->as_string, - $Attachment->mime_type, - $Filename - ); + my ( $encoding, $type, $note_args ); + ( $encoding, $content, $type, $Filename, $note_args ) = + $self->_EncodeLOB( $Attachment->bodyhandle->as_string, $Attachment->mime_type, $Filename, ); my $id = $self->SUPER::Create( TransactionId => $args{'TransactionId'}, - ContentType => $ContentType, - ContentEncoding => $ContentEncoding, + ContentType => $type, + ContentEncoding => $encoding, Parent => $args{'Parent'}, Headers => $head, Subject => $Subject, - Content => $Body, + Content => $content, Filename => $Filename, MessageId => $MessageId, ); - unless ($id) { + if ($id) { + if ($note_args) { + $self->TransactionObj->Object->_NewTransaction( %$note_args ); + } + } + else { $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); + my $txn = RT::Transaction->new($self->CurrentUser); + $txn->Load($args{'TransactionId'}); + if ( $txn->id ) { + $txn->Object->_NewTransaction( Type => 'AttachmentError', ActivateScrips => 0, Data => $Filename ); + } } return $id; } } -=head2 Import - -Create an attachment exactly as specified in the named parameters. - -=cut - -sub Import { - my $self = shift; - my %args = ( ContentEncoding => 'none', @_ ); - - ( $args{'ContentEncoding'}, $args{'Content'} ) = - $self->_EncodeLOB( $args{'Content'}, $args{'MimeType'} ); - - return ( $self->SUPER::Create(%args) ); -} - =head2 TransactionObj Returns the transaction object asscoiated with this attachment. @@ -260,6 +271,35 @@ sub ParentObj { return $parent; } +=head2 Closest + +Takes a MIME type as a string or regex. Returns an L object +for the nearest containing part with a matching L. Strings must +match exactly and all matches are done case insensitively. Strings ending in a +C must only match the first part of the MIME type. For example: + + # Find the nearest multipart/* container + my $container = $attachment->Closest("multipart/"); + +Returns undef if no such object is found. + +=cut + +sub Closest { + my $self = shift; + my $type = shift; + my $part = $self->ParentObj or return undef; + + $type = qr/^\Q$type\E$/ + unless ref $type eq "REGEX"; + + while (lc($part->ContentType) !~ $type) { + $part = $part->ParentObj or last; + } + + return ($part and $part->id) ? $part : undef; +} + =head2 Children Returns an L object which is preloaded with @@ -276,6 +316,30 @@ sub Children { return($kids); } +=head2 Siblings + +Returns an L object containing all the attachments sharing +the same immediate parent as the current object, excluding the current +attachment itself. + +If the current attachment is a top-level part (i.e. Parent == 0) then a +guaranteed empty L object is returned. + +=cut + +sub Siblings { + my $self = shift; + my $siblings = RT::Attachments->new( $self->CurrentUser ); + if ($self->Parent) { + $siblings->ChildrenOf( $self->Parent ); + $siblings->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->Id ); + } else { + # Ensure emptiness + $siblings->Limit( SUBCLAUSE => 'empty', FIELD => 'id', VALUE => 0 ); + } + return $siblings; +} + =head2 Content Returns the attachment's content. if it's base64 encoded, decode it @@ -318,16 +382,11 @@ sub OriginalContent { return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); - my $content; - if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) { - $content = $self->_Value('Content', decode_utf8 => 0); - } elsif ( $self->ContentEncoding eq 'base64' ) { - $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0)); - } elsif ( $self->ContentEncoding eq 'quoted-printable' ) { - $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0)); - } else { - return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); - } + my $content = $self->_DecodeLOB( + "application/octet-stream", # Force _DecodeLOB to not decode to characters + $self->ContentEncoding, + $self->_Value('Content', decode_utf8 => 0), + ); my $entity = MIME::Entity->new(); $entity->head->add("Content-Type", $self->GetHeader("Content-Type")); @@ -379,59 +438,32 @@ sub ContentLength { return $len; } -=head2 Quote - -=cut - -sub Quote { - my $self=shift; - my %args=(Reply=>undef, # Prefilled reply (i.e. from the KB/FAQ system) - @_); - - my ($quoted_content, $body, $headers); - my $max=0; +=head2 FriendlyContentLength - # TODO: Handle Multipart/Mixed (eventually fix the link in the - # ShowHistory web template?) - if (RT::I18N::IsTextualContentType($self->ContentType)) { - $body=$self->Content; +Returns L in bytes, kilobytes, or megabytes as most +appropriate. The size is suffixed with C, C, or C and the returned +string is localized. - # Do we need any preformatting (wrapping, that is) of the message? +Returns the empty string if the L is 0 or undefined. - # Remove quoted signature. - $body =~ s/\n-- \n(.*)$//s; - - # What's the longest line like? - foreach (split (/\n/,$body)) { - $max=length if ( length > $max); - } - - if ($max>76) { - require Text::Wrapper; - my $wrapper = Text::Wrapper->new - ( - columns => 70, - body_start => ($max > 70*3 ? ' ' : ''), - par_start => '' - ); - $body=$wrapper->wrap($body); - } - - $body =~ s/^/> /gm; +=cut - $body = '[' . $self->TransactionObj->CreatorObj->Name() . ' - ' . $self->TransactionObj->CreatedAsString() - . "]:\n\n" - . $body . "\n\n"; +sub FriendlyContentLength { + my $self = shift; + my $size = $self->ContentLength; + return '' unless $size; - } else { - $body = "[Non-text message not quoted]\n\n"; + my $res = ''; + if ( $size > 1024*1024 ) { + $res = $self->loc( "[_1]MiB", int( $size / 1024 / 102.4 ) / 10 ); } - - $max=60 if $max<60; - $max=70 if $max>78; - $max+=2; - - return (\$body, $max); + elsif ( $size > 1024 ) { + $res = $self->loc( "[_1]KiB", int( $size / 102.4 ) / 10 ); + } + else { + $res = $self->loc( "[_1]B", $size ); + } + return $res; } =head2 ContentAsMIME [Children => 1] @@ -443,6 +475,44 @@ recursively added to the entity. =cut +sub _EncodeHeaderToMIME { + my ( $self, $header_name, $header_val ) = @_; + if ($header_name =~ /^Content-/i) { + my $params = MIME::Field::ParamVal->parse_params($header_val); + $header_val = delete $params->{'_'}; + foreach my $key ( sort keys %$params ) { + my $value = $params->{$key}; + if ( $value =~ /[^\x00-\x7f]/ ) { # check for non-ASCII + $value = q{UTF-8''} . URI->new( + Encode::encode('UTF-8', $value) + ); + $value =~ s/(["\\])/\\$1/g; + $header_val .= qq{; ${key}*="$value"}; + } + else { + $header_val .= qq{; $key="$value"}; + } + } + } + elsif ( $header_name =~ /^(?:Resent-)?(?:To|From|B?Cc|Sender|Reply-To)$/i ) { + my @addresses = RT::EmailParser->ParseEmailAddress( $header_val ); + foreach my $address ( @addresses ) { + foreach my $field (qw(phrase comment)) { + my $v = $address->$field() or next; + $v = RT::Interface::Email::EncodeToMIME( String => $v ); + $address->$field($v); + } + } + $header_val = join ', ', map $_->format, @addresses; + } + else { + $header_val = RT::Interface::Email::EncodeToMIME( + String => $header_val + ); + } + return $header_val; +} + sub ContentAsMIME { my $self = shift; my %opts = ( @@ -453,24 +523,27 @@ sub ContentAsMIME { my $entity = MIME::Entity->new(); foreach my $header ($self->SplitHeaders) { my ($h_key, $h_val) = split /:/, $header, 2; - $entity->head->add( $h_key, RT::Interface::Email::EncodeToMIME( String => $h_val ) ); + $entity->head->add( + $h_key, $self->_EncodeHeaderToMIME($h_key, $h_val) + ); } - - # since we want to return original content, let's use original encoding - $entity->head->mime_attr( - "Content-Type.charset" => $self->OriginalEncoding ) - if $self->OriginalEncoding; - $entity->bodyhandle( - MIME::Body::Scalar->new( $self->OriginalContent ) - ); - - if ($opts{'Children'} and not $self->IsMessageContentType) { - my $children = $self->Children; - while (my $child = $children->Next) { - $entity->make_multipart unless $entity->is_multipart; - $entity->add_part( $child->ContentAsMIME(%opts) ); + if ($entity->is_multipart) { + if ($opts{'Children'} and not $self->IsMessageContentType) { + my $children = $self->Children; + while (my $child = $children->Next) { + $entity->add_part( $child->ContentAsMIME(%opts) ); + } } + } else { + # since we want to return original content, let's use original encoding + $entity->head->mime_attr( + "Content-Type.charset" => $self->OriginalEncoding ) + if $self->OriginalEncoding; + + $entity->bodyhandle( + MIME::Body::Scalar->new( $self->OriginalContent ) + ); } return $entity; @@ -503,7 +576,7 @@ sub Addresses { my $self = shift; my %data = (); - my $current_user_address = lc $self->CurrentUser->EmailAddress; + my $current_user_address = lc($self->CurrentUser->EmailAddress || ''); foreach my $hdr (@ADDRESS_HEADERS) { my @Addresses; my $line = $self->GetHeader($hdr); @@ -531,9 +604,9 @@ sub NiceHeaders { my $hdrs = ""; my @hdrs = $self->_SplitHeaders; while (my $str = shift @hdrs) { - next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Bcc|Date|Subject):/i; - $hdrs .= $str . "\n"; - $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/); + next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Bcc|Date|Subject):/i; + $hdrs .= $str . "\n"; + $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/); } return $hdrs; } @@ -710,20 +783,16 @@ sub Encrypt { return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; return (0, $self->loc('Permission Denied')) unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); - return (0, $self->loc('GnuPG integration is disabled')) - unless RT->Config->Get('GnuPG')->{'Enable'}; + return (0, $self->loc('Cryptography is disabled')) + unless RT->Config->Get('Crypt')->{'Enable'}; return (0, $self->loc('Attachments encryption is disabled')) - unless RT->Config->Get('GnuPG')->{'AllowEncryptDataInDB'}; - - require RT::Crypt::GnuPG; + unless RT->Config->Get('Crypt')->{'AllowEncryptDataInDB'}; my $type = $self->ContentType; - if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { + if ( $type =~ /^x-application-rt\/[^-]+-encrypted/i ) { return (1, $self->loc('Already encrypted')); } elsif ( $type =~ /^multipart\//i ) { return (1, $self->loc('No need to encrypt')); - } else { - $type = qq{x-application-rt\/gpg-encrypted; original-type="$type"}; } my $queue = $txn->TicketObj->QueueObj; @@ -734,9 +803,9 @@ sub Encrypt { RT->Config->Get('CorrespondAddress'), RT->Config->Get('CommentAddress'), ) { - my %res = RT::Crypt::GnuPG::GetKeysInfo( $address, 'private' ); + my %res = RT::Crypt->GetKeysInfo( Key => $address, Type => 'private' ); next if $res{'exit_code'} || !$res{'info'}; - %res = RT::Crypt::GnuPG::GetKeysForEncryption( $address ); + %res = RT::Crypt->GetKeysForEncryption( $address ); next if $res{'exit_code'} || !$res{'info'}; $encrypt_for = $address; } @@ -744,24 +813,26 @@ sub Encrypt { return (0, $self->loc('No key suitable for encryption')); } - $self->__Set( Field => 'ContentType', Value => $type ); - $self->SetHeader( 'Content-Type' => $type ); - my $content = $self->Content; - my %res = RT::Crypt::GnuPG::SignEncryptContent( + my %res = RT::Crypt->SignEncryptContent( Content => \$content, Sign => 0, Encrypt => 1, Recipients => [ $encrypt_for ], ); if ( $res{'exit_code'} ) { - return (0, $self->loc('GnuPG error. Contact with administrator')); + return (0, $self->loc('Encryption error; contact the administrator')); } my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); unless ( $status ) { return ($status, $self->loc("Couldn't replace content with encrypted data: [_1]", $msg)); } + + $type = qq{x-application-rt\/$res{'Protocol'}-encrypted; original-type="$type"}; + $self->__Set( Field => 'ContentType', Value => $type ); + $self->SetHeader( 'Content-Type' => $type ); + return (1, $self->loc('Successfuly encrypted data')); } @@ -772,31 +843,45 @@ sub Decrypt { return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; return (0, $self->loc('Permission Denied')) unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); - return (0, $self->loc('GnuPG integration is disabled')) - unless RT->Config->Get('GnuPG')->{'Enable'}; - - require RT::Crypt::GnuPG; + return (0, $self->loc('Cryptography is disabled')) + unless RT->Config->Get('Crypt')->{'Enable'}; my $type = $self->ContentType; - if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { + my $protocol; + if ( $type =~ /^x-application-rt\/([^-]+)-encrypted/i ) { + $protocol = $1; + $protocol =~ s/gpg/gnupg/; # backwards compatibility ($type) = ($type =~ /original-type="(.*)"/i); $type ||= 'application/octet-stream'; } else { return (1, $self->loc('Is not encrypted')); } - $self->__Set( Field => 'ContentType', Value => $type ); - $self->SetHeader( 'Content-Type' => $type ); + + my $queue = $txn->TicketObj->QueueObj; + my @addresses = + $queue->CorrespondAddress, + $queue->CommentAddress, + RT->Config->Get('CorrespondAddress'), + RT->Config->Get('CommentAddress') + ; my $content = $self->Content; - my %res = RT::Crypt::GnuPG::DecryptContent( Content => \$content, ); + my %res = RT::Crypt->DecryptContent( + Protocol => $protocol, + Content => \$content, + Recipients => \@addresses, + ); if ( $res{'exit_code'} ) { - return (0, $self->loc('GnuPG error. Contact with administrator')); + return (0, $self->loc('Decryption error; contact the administrator')); } my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); unless ( $status ) { return ($status, $self->loc("Couldn't replace content with decrypted data: [_1]", $msg)); } + $self->__Set( Field => 'ContentType', Value => $type ); + $self->SetHeader( 'Content-Type' => $type ); + return (1, $self->loc('Successfuly decrypted data')); } @@ -1025,33 +1110,74 @@ sub _CoreAccessible { { id => - {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, TransactionId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, Parent => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, MessageId => - {read => 1, write => 1, sql_type => 12, length => 160, is_blob => 0, is_numeric => 0, type => 'varchar(160)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 160, is_blob => 0, is_numeric => 0, type => 'varchar(160)', default => ''}, Subject => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, Filename => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, ContentType => - {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''}, ContentEncoding => - {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''}, Content => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longblob', default => ''}, + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longblob', default => ''}, Headers => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''}, + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''}, Creator => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, Created => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + $deps->Add( out => $self->TransactionObj ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + + # Nested attachments + my $objs = RT::Attachments->new( $self->CurrentUser ); + $objs->Limit( + FIELD => 'Parent', + OPERATOR => '=', + VALUE => $self->Id + ); + $objs->Limit( + FIELD => 'id', + OPERATOR => '!=', + VALUE => $self->Id + ); + push( @$list, $objs ); + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + return $self->SUPER::__DependsOn( %args ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Attachments.pm b/rt/lib/RT/Attachments.pm index b771243..13cf5cf 100755 --- a/rt/lib/RT/Attachments.pm +++ b/rt/lib/RT/Attachments.pm @@ -71,11 +71,10 @@ package RT::Attachments; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::Attachment; -use base 'RT::SearchBuilder'; - sub Table { 'Attachments'} @@ -112,14 +111,12 @@ sub TransactionAlias { return $self->{'_sql_transaction_alias'} if $self->{'_sql_transaction_alias'}; - my $res = $self->NewAlias('Transactions'); - $self->Limit( - ENTRYAGGREGATOR => 'AND', - FIELD => 'TransactionId', - VALUE => $res . '.id', - QUOTEVALUE => 0, + return $self->{'_sql_transaction_alias'} = $self->Join( + ALIAS1 => 'main', + FIELD1 => 'TransactionId', + TABLE2 => 'Transactions', + FIELD2 => 'id', ); - return $self->{'_sql_transaction_alias'} = $res; } =head2 ContentType (VALUE => 'text/plain', ENTRYAGGREGATOR => 'OR', OPERATOR => '=' ) @@ -133,9 +130,9 @@ sub ContentType { my $self = shift; my %args = ( VALUE => 'text/plain', - OPERATOR => '=', - ENTRYAGGREGATOR => 'OR', - @_ + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + @_ ); return $self->Limit ( %args, FIELD => 'ContentType' ); @@ -203,13 +200,11 @@ sub LimitByTicket { VALUE => 'RT::Ticket', ); - my $tickets = $self->NewAlias('Tickets'); - $self->Limit( - ENTRYAGGREGATOR => 'AND', - ALIAS => $tickets, - FIELD => 'id', - VALUE => $transactions . '.ObjectId', - QUOTEVALUE => 0, + my $tickets = $self->Join( + ALIAS1 => $transactions, + FIELD1 => 'ObjectId', + TABLE2 => 'Tickets', + FIELD2 => 'id', ); $self->Limit( ENTRYAGGREGATOR => 'AND', @@ -228,18 +223,6 @@ sub AddRecord { return $self->SUPER::AddRecord( $record ); } - -=head2 NewItem - -Returns an empty new RT::Attachment item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Attachment->new($self->CurrentUser)); -} - RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Attribute.pm b/rt/lib/RT/Attribute.pm index 24c89dd..8ee95d2 100644 --- a/rt/lib/RT/Attribute.pm +++ b/rt/lib/RT/Attribute.pm @@ -145,11 +145,11 @@ sub Create { Content => '', ContentType => '', Object => undef, - @_); + @_); if ($args{Object} and UNIVERSAL::can($args{Object}, 'Id')) { - $args{ObjectType} = $args{Object}->isa("RT::CurrentUser") ? "RT::User" : ref($args{Object}); - $args{ObjectId} = $args{Object}->Id; + $args{ObjectType} = $args{Object}->isa("RT::CurrentUser") ? "RT::User" : ref($args{Object}); + $args{ObjectId} = $args{Object}->Id; } else { return(0, $self->loc("Required parameter '[_1]' not specified", 'Object')); @@ -181,7 +181,6 @@ sub Create { $args{'ContentType'} = 'storable'; } - $self->SUPER::Create( Name => $args{'Name'}, Content => $args{'Content'}, @@ -210,11 +209,11 @@ sub LoadByNameAndObject { ); return ( - $self->LoadByCols( - Name => $args{'Name'}, - ObjectType => ref($args{'Object'}), - ObjectId => $args{'Object'}->Id, - ) + $self->LoadByCols( + Name => $args{'Name'}, + ObjectType => ref($args{'Object'}), + ObjectId => $args{'Object'}->Id, + ) ); } @@ -285,7 +284,9 @@ sub SetContent { return(0, "Content couldn't be frozen"); } } - return $self->_Set( Field => 'Content', Value => $content ); + my ($ok, $msg) = $self->_Set( Field => 'Content', Value => $content ); + return ($ok, $self->loc("Attribute updated")) if $ok; + return ($ok, $msg); } =head2 SubValue KEY @@ -375,6 +376,7 @@ sub Delete { unless ($self->CurrentUserHasRight('delete')) { return (0,$self->loc('Permission Denied')); } + return($self->SUPER::Delete(@_)); } @@ -599,31 +601,50 @@ sub _CoreAccessible { { id => - {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, Name => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, Description => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, Content => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'blob', default => ''}, + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'blob', default => ''}, ContentType => - {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, ObjectType => - {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, ObjectId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, Creator => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, Created => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, LastUpdatedBy => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, LastUpdated => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + $deps->Add( out => $self->Object ); +} + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + if ($data->{Object} and ref $data->{Object}) { + my $on_uid = ${ $data->{Object} }; + return if $importer->ShouldSkipTransaction($on_uid); + } + return $class->SUPER::PreInflate( $importer, $uid, $data ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Attributes.pm b/rt/lib/RT/Attributes.pm index 7da2932..f5e84a4 100644 --- a/rt/lib/RT/Attributes.pm +++ b/rt/lib/RT/Attributes.pm @@ -68,11 +68,10 @@ package RT::Attributes; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::Attribute; -use base 'RT::SearchBuilder'; - sub Table { 'Attributes'} @@ -140,23 +139,6 @@ sub Named { return (@attributes); } -=head2 WithId ID - -Returns the RT::Attribute objects with the id ID - -XXX TODO XXX THIS NEEDS A BETTER ACL CHECK - -=cut - -sub WithId { - my $self = shift; - my $id = shift; - - my $attr = RT::Attribute->new($self->CurrentUser); - $attr->LoadByCols( id => $id ); - return($attr); -} - =head2 DeleteEntry { Name => Content => , id => } Deletes attributes with @@ -218,18 +200,6 @@ sub LimitToObject { } - - -=head2 NewItem - -Returns an empty new RT::Attribute item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Attribute->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Base.pm b/rt/lib/RT/Base.pm index 838bad0..9254c8f 100644 --- a/rt/lib/RT/Base.pm +++ b/rt/lib/RT/Base.pm @@ -122,7 +122,7 @@ to this object's CurrentUser->LanguageHandle for localization. you call it like this: - $self->loc("I have [quant,_1,concrete mixer].", 6); + $self->loc("I have [quant,_1,concrete mixer,concrete mixers].", 6); In english, this would return: I have 6 concrete mixers. diff --git a/rt/lib/RT/CachedGroupMember.pm b/rt/lib/RT/CachedGroupMember.pm index 5213bd1..f5d62c2 100644 --- a/rt/lib/RT/CachedGroupMember.pm +++ b/rt/lib/RT/CachedGroupMember.pm @@ -418,21 +418,64 @@ sub _CoreAccessible { { id => - {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, GroupId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, MemberId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, Via => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, ImmediateParentId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, Disabled => - {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, + {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, } }; +sub Serialize { + die "CachedGroupMembers should never be serialized"; +} + +sub __DependsOn +{ + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# deep memebership + my $objs = RT::CachedGroupMembers->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Via', VALUE => $self->Id ); + $objs->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->Id ); + push( @$list, $objs ); + +# principal lost group membership and lost some rights which he could delegate to +# some body + +# XXX: Here is problem cause HasMemberRecursively would return true allways +# cause we didn't delete anything yet. :( + # if pricipal is not member anymore(could be via other groups) then proceed + if( $self->GroupObj->Object->HasMemberRecursively( $self->MemberObj ) ) { + my $acl = RT::ACL->new( $self->CurrentUser ); + $acl->LimitToPrincipal( Id => $self->GroupId ); + } + + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + + return $self->SUPER::__DependsOn( %args ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/CachedGroupMembers.pm b/rt/lib/RT/CachedGroupMembers.pm index 14d6589..e6bda97 100644 --- a/rt/lib/RT/CachedGroupMembers.pm +++ b/rt/lib/RT/CachedGroupMembers.pm @@ -69,11 +69,10 @@ package RT::CachedGroupMembers; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::CachedGroupMember; -use base 'RT::SearchBuilder'; - sub Table { 'CachedGroupMembers'} # {{{ LimitToUsers @@ -89,9 +88,10 @@ groups from users for display purposes sub LimitToUsers { my $self = shift; - my $principals = $self->NewAlias('Principals'); - $self->Join( ALIAS1 => 'main', FIELD1 => 'MemberId', - ALIAS2 => $principals, FIELD2 =>'id'); + my $principals = $self->Join( + ALIAS1 => 'main', FIELD1 => 'MemberId', + TABLE2 => 'Principals', FIELD2 =>'id' + ); $self->Limit( ALIAS => $principals, FIELD => 'PrincipalType', @@ -114,9 +114,11 @@ groups from users for display purposes sub LimitToGroups { my $self = shift; - my $principals = $self->NewAlias('Principals'); - $self->Join( ALIAS1 => 'main', FIELD1 => 'MemberId', - ALIAS2 => $principals, FIELD2 =>'id'); + my $principals = $self->Join( + ALIAS1 => 'main', FIELD1 => 'MemberId', + TABLE2 => 'Principals', FIELD2 =>'id' + ); + $self->Limit( ALIAS => $principals, FIELD => 'PrincipalType', @@ -166,23 +168,13 @@ sub LimitToGroupsWithMember { VALUE => $member || '0', FIELD => 'MemberId', ENTRYAGGREGATOR => 'OR', - QUOTEVALUE => 0 + QUOTEVALUE => 0 )); } # }}} -=head2 NewItem - -Returns an empty new RT::CachedGroupMember item - -=cut - -sub NewItem { - my $self = shift; - return(RT::CachedGroupMember->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Class.pm b/rt/lib/RT/Class.pm index d60c6b7..4f746be 100644 --- a/rt/lib/RT/Class.pm +++ b/rt/lib/RT/Class.pm @@ -60,6 +60,9 @@ use RT::Articles; use RT::ObjectClass; use RT::ObjectClasses; +use Role::Basic 'with'; +with "RT::Record::Role::Rights"; + sub Table {'Classes'} =head2 Load IDENTIFIER @@ -81,94 +84,19 @@ sub Load { } } -# {{{ This object provides ACLs - -use vars qw/$RIGHTS/; -$RIGHTS = { - SeeClass => 'See that this class exists', #loc_pair - CreateArticle => 'Create articles in this class', #loc_pair - ShowArticle => 'See articles in this class', #loc_pair - ShowArticleHistory => 'See changes to articles in this class', #loc_pair - ModifyArticle => 'Modify or delete articles in this class', #loc_pair - ModifyArticleTopics => 'Modify topics for articles in this class', #loc_pair - AdminClass => 'Modify metadata and custom fields for this class', #loc_pair - AdminTopics => 'Modify topic hierarchy associated with this class', #loc_pair - ShowACL => 'Display Access Control List', #loc_pair - ModifyACL => 'Create, modify and delete Access Control List entries', #loc_pair - DeleteArticle => 'Delete articles in this class', #loc_pair -}; - -our $RIGHT_CATEGORIES = { - SeeClass => 'Staff', - CreateArticle => 'Staff', - ShowArticle => 'General', - ShowArticleHistory => 'Staff', - ModifyArticle => 'Staff', - ModifyArticleTopics => 'Staff', - AdminClass => 'Admin', - AdminTopics => 'Admin', - ShowACL => 'Admin', - ModifyACL => 'Admin', - DeleteArticle => 'Staff', -}; - -# TODO: This should be refactored out into an RT::ACLedObject or something -# stuff the rights into a hash of rights that can exist. - -# Tell RT::ACE that this sort of object can get acls granted -$RT::ACE::OBJECT_TYPES{'RT::Class'} = 1; - -# TODO this is ripe for a refacor, since this is stolen from Queue -__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); -} - -=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 }; -} - -=head2 AvailableRights - -Returns a hash of available rights for this object. The keys are the right names and the values are a description of what t -he rights do - -=cut - -sub AvailableRights { - my $self = shift; - return ($RIGHTS); -} - -sub RightCategories { - return $RIGHT_CATEGORIES; -} - - -# }}} - +__PACKAGE__->AddRight( Staff => SeeClass => 'See that this class exists'); # loc +__PACKAGE__->AddRight( Staff => CreateArticle => 'Create articles in this class'); # loc +__PACKAGE__->AddRight( General => ShowArticle => 'See articles in this class'); # loc +__PACKAGE__->AddRight( Staff => ShowArticleHistory => 'See changes to articles in this class'); # loc +__PACKAGE__->AddRight( General => SeeCustomField => 'View custom field values' ); # loc +__PACKAGE__->AddRight( Staff => ModifyArticle => 'Modify or delete articles in this class'); # loc +__PACKAGE__->AddRight( Staff => ModifyArticleTopics => 'Modify topics for articles in this class'); # loc +__PACKAGE__->AddRight( Staff => ModifyCustomField => 'Modify custom field values' ); # loc +__PACKAGE__->AddRight( Admin => AdminClass => 'Modify metadata and custom fields for this class'); # loc +__PACKAGE__->AddRight( Admin => AdminTopics => 'Modify topic hierarchy associated with this class'); # loc +__PACKAGE__->AddRight( Admin => ShowACL => 'Display Access Control List'); # loc +__PACKAGE__->AddRight( Admin => ModifyACL => 'Create, modify and delete Access Control List entries'); # loc +__PACKAGE__->AddRight( Staff => DeleteArticle => 'Delete articles in this class'); # loc # {{{ Create @@ -255,20 +183,6 @@ sub _Value { # }}} -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - - return ( - $self->CurrentUser->HasRight( - Right => $right, - Object => ( $self->Id ? $self : $RT::System ), - EquivObjects => [ $RT::System, $RT::System ] - ) - ); - -} - sub ArticleCustomFields { my $self = shift; @@ -450,7 +364,33 @@ sub RemoveFromObject { return ( $oid, $msg ); } +sub SubjectOverride { + my $self = shift; + my $override = $self->FirstAttribute('SubjectOverride'); + return $override ? $override->Content : 0; +} +sub SetSubjectOverride { + my $self = shift; + my $override = shift; + + if ( $override == $self->SubjectOverride ) { + return (0, "SubjectOverride is already set to that"); + } + + my $cf = RT::CustomField->new($self->CurrentUser); + $cf->Load($override); + + if ( $override ) { + my ($ok, $msg) = $self->SetAttribute( Name => 'SubjectOverride', Content => $override ); + return ($ok, $ok ? $self->loc('Added Subject Override: [_1]', $cf->Name) : + $self->loc('Unable to add Subject Override: [_1] [_2]', $cf->Name, $msg)); + } else { + my ($ok, $msg) = $self->DeleteAttribute('SubjectOverride'); + return ($ok, $ok ? $self->loc('Removed Subject Override') : + $self->loc('Unable to add Subject Override: [_1] [_2]', $cf->Name, $msg)); + } +} =head2 id @@ -592,29 +532,82 @@ sub _CoreAccessible { { id => - {read => 1, type => 'int(11)', default => ''}, + {read => 1, type => 'int(11)', default => ''}, Name => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, type => 'varchar(255)', default => ''}, Description => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, type => 'varchar(255)', default => ''}, SortOrder => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, Disabled => - {read => 1, write => 1, type => 'int(2)', default => '0'}, + {read => 1, write => 1, type => 'int(2)', default => '0'}, HotList => - {read => 1, write => 1, type => 'int(2)', default => '0'}, + {read => 1, write => 1, type => 'int(2)', default => '0'}, Creator => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, type => 'int(11)', default => '0'}, Created => - {read => 1, auto => 1, type => 'datetime', default => ''}, + {read => 1, auto => 1, type => 'datetime', default => ''}, LastUpdatedBy => - {read => 1, auto => 1, type => 'int(11)', default => '0'}, + {read => 1, auto => 1, type => 'int(11)', default => '0'}, LastUpdated => - {read => 1, auto => 1, type => 'datetime', default => ''}, + {read => 1, auto => 1, type => 'datetime', default => ''}, } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + + my $articles = RT::Articles->new( $self->CurrentUser ); + $articles->Limit( FIELD => "Class", VALUE => $self->Id ); + $deps->Add( in => $articles ); + + my $topics = RT::Topics->new( $self->CurrentUser ); + $topics->LimitToObject( $self ); + $deps->Add( in => $topics ); + + my $objectclasses = RT::ObjectClasses->new( $self->CurrentUser ); + $objectclasses->LimitToClass( $self->Id ); + $deps->Add( in => $objectclasses ); + + # Custom Fields on things _in_ this class (CFs on the class itself + # have already been dealt with) + my $ocfs = RT::ObjectCustomFields->new( $self->CurrentUser ); + $ocfs->Limit( FIELD => 'ObjectId', + OPERATOR => '=', + VALUE => $self->id, + ENTRYAGGREGATOR => 'OR' ); + $ocfs->Limit( FIELD => 'ObjectId', + OPERATOR => '=', + VALUE => 0, + ENTRYAGGREGATOR => 'OR' ); + my $cfs = $ocfs->Join( + ALIAS1 => 'main', + FIELD1 => 'CustomField', + TABLE2 => 'CustomFields', + FIELD2 => 'id', + ); + $ocfs->Limit( ALIAS => $cfs, + FIELD => 'LookupType', + OPERATOR => 'STARTSWITH', + VALUE => 'RT::Class-' ); + $deps->Add( in => $ocfs ); +} + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + $class->SUPER::PreInflate( $importer, $uid, $data ); + + return if $importer->MergeBy( "Name", $class, $uid, $data ); + + return 1; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Classes.pm b/rt/lib/RT/Classes.pm index 0175b2f..bf55d52 100644 --- a/rt/lib/RT/Classes.pm +++ b/rt/lib/RT/Classes.pm @@ -79,21 +79,7 @@ sub AddRecord { return $self->SUPER::AddRecord( $record ); } -sub ColumnMapClassName { - return 'RT__Class'; -} - -=head2 NewItem - -Returns an empty new RT::Class item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Class->new($self->CurrentUser)); -} - +sub _SingularClass { "RT::Class" } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Condition.pm b/rt/lib/RT/Condition.pm index 2aa6545..bd495db 100755 --- a/rt/lib/RT/Condition.pm +++ b/rt/lib/RT/Condition.pm @@ -54,14 +54,14 @@ use RT::Condition; my $foo = RT::Condition->new( - TransactionObj => $tr, - TicketObj => $ti, - ScripObj => $scr, - Argument => $arg, - Type => $type); + TransactionObj => $tr, + TicketObj => $ti, + ScripObj => $scr, + Argument => $arg, + Type => $type); if ($foo->IsApplicable) { - # do something + # do something } @@ -95,14 +95,14 @@ sub new { sub _Init { my $self = shift; my %args = ( TransactionObj => undef, - TicketObj => undef, - ScripObj => undef, - TemplateObj => undef, - Argument => undef, - ApplicableTransTypes => undef, + TicketObj => undef, + ScripObj => undef, + TemplateObj => undef, + Argument => undef, + ApplicableTransTypes => undef, CurrentUser => undef, - @_ ); - + @_ ); + $self->{'Argument'} = $args{'Argument'}; $self->{'ScripObj'} = $args{'ScripObj'}; $self->{'TicketObj'} = $args{'TicketObj'}; diff --git a/rt/lib/RT/Condition/BeforeDue.pm b/rt/lib/RT/Condition/BeforeDue.pm index 9ff641b..6e1b602 100644 --- a/rt/lib/RT/Condition/BeforeDue.pm +++ b/rt/lib/RT/Condition/BeforeDue.pm @@ -46,6 +46,23 @@ # # END BPS TAGGED BLOCK }}} +=head1 NAME + +RT::Condition::BeforeDue + +=head1 DESCRIPTION + +Returns true if the ticket we're operating on is within the +amount of time defined by the passed in argument. + +The passed in value is a date in the format "1d2h3m4s" +for 1 day and 2 hours and 3 minutes and 4 seconds. Single +units can also be passed such as 1d for just one day. + + +=cut + + package RT::Condition::BeforeDue; use base 'RT::Condition'; @@ -61,15 +78,15 @@ sub IsApplicable { # and 3 minutes and 4 seconds. my %e; foreach (qw(d h m s)) { - my @vals = $self->Argument =~ m/(\d+)$_/; - $e{$_} = pop @vals || 0; + my @vals = $self->Argument =~ m/(\d+)$_/i; + $e{$_} = pop @vals || 0; } my $elapse = $e{'d'} * 24*60*60 + $e{'h'} * 60*60 + $e{'m'} * 60 + $e{'s'}; my $cur = RT::Date->new( RT->SystemUser ); $cur->SetToNow(); my $due = $self->TicketObj->DueObj; - return (undef) if $due->Unix <= 0; + return (undef) unless $due->IsSet; my $diff = $due->Diff($cur); if ( $diff >= 0 and $diff <= $elapse ) { diff --git a/rt/lib/RT/Condition/Overdue.pm b/rt/lib/RT/Condition/Overdue.pm index 240d7fe..f9c0c49 100644 --- a/rt/lib/RT/Condition/Overdue.pm +++ b/rt/lib/RT/Condition/Overdue.pm @@ -70,12 +70,12 @@ If the due date is before "now" return true sub IsApplicable { my $self = shift; - if ($self->TicketObj->DueObj->Unix > 0 and - $self->TicketObj->DueObj->Unix < time()) { - return(1); - } + if ($self->TicketObj->DueObj->IsSet and + $self->TicketObj->DueObj->Unix < time()) { + return(1); + } else { - return(undef); + return(undef); } } diff --git a/rt/lib/RT/Condition/OwnerChange.pm b/rt/lib/RT/Condition/OwnerChange.pm index 867e632..7368971 100644 --- a/rt/lib/RT/Condition/OwnerChange.pm +++ b/rt/lib/RT/Condition/OwnerChange.pm @@ -62,12 +62,16 @@ If we're changing the owner return true, otherwise return false sub IsApplicable { my $self = shift; - if ( ( $self->TransactionObj->Field || '' ) eq 'Owner' ) { - return(1); - } - else { - return(undef); - } + return unless ( $self->TransactionObj->Field || '' ) eq 'Owner'; + + # For tickets, there is both a Set txn (for the column) and a + # SetWatcher txn (for the group); we fire on the former for + # historical consistency. Non-ticket objects will not have a + # denormalized Owner column, and thus need fire on the SetWatcher. + return if $self->TransactionObj->Type eq "SetWatcher" + and $self->TransactionObj->ObjectType eq "RT::Ticket"; + + return(1); } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Condition/PriorityChange.pm b/rt/lib/RT/Condition/PriorityChange.pm index 06b5b06..8992e7b 100644 --- a/rt/lib/RT/Condition/PriorityChange.pm +++ b/rt/lib/RT/Condition/PriorityChange.pm @@ -62,10 +62,10 @@ the Priority Obj sub IsApplicable { my $self = shift; if ($self->TransactionObj->Field eq 'Priority') { - return(1); - } + return(1); + } else { - return(undef); + return(undef); } } diff --git a/rt/lib/RT/Condition/PriorityExceeds.pm b/rt/lib/RT/Condition/PriorityExceeds.pm index 16f250e..808595b 100644 --- a/rt/lib/RT/Condition/PriorityExceeds.pm +++ b/rt/lib/RT/Condition/PriorityExceeds.pm @@ -60,10 +60,10 @@ If the priority exceeds the argument value sub IsApplicable { my $self = shift; if ($self->TicketObj->Priority > $self->Argument) { - return(1); - } + return(1); + } else { - return(undef); + return(undef); } } diff --git a/rt/lib/RT/Condition/QueueChange.pm b/rt/lib/RT/Condition/QueueChange.pm index 0de9d71..d4be965 100644 --- a/rt/lib/RT/Condition/QueueChange.pm +++ b/rt/lib/RT/Condition/QueueChange.pm @@ -60,10 +60,10 @@ If the queue has changed. sub IsApplicable { my $self = shift; if ($self->TransactionObj->Field eq 'Queue') { - return(1); - } + return(1); + } else { - return(undef); + return(undef); } } diff --git a/rt/lib/RT/Condition/StatusChange.pm b/rt/lib/RT/Condition/StatusChange.pm index 668c5bc..f665e45 100644 --- a/rt/lib/RT/Condition/StatusChange.pm +++ b/rt/lib/RT/Condition/StatusChange.pm @@ -114,11 +114,11 @@ sub IsApplicable { } else { $RT::Logger->error("Argument '$argument' is incorrect.") - unless RT::Lifecycle->Load('')->IsValid( $argument ); + unless RT::Lifecycle->Load(Type => 'ticket')->IsValid( $argument ); return 0; } - my $lifecycle = $self->TicketObj->QueueObj->Lifecycle; + my $lifecycle = $self->TicketObj->LifecycleObj; if ( $new_must_be ) { return 0 unless grep lc($new) eq lc($_), map {m/^(initial|active|inactive)$/i? $lifecycle->Valid(lc $_): $_ } diff --git a/rt/lib/RT/Config.pm b/rt/lib/RT/Config.pm index 8d30739..08844f5 100644 --- a/rt/lib/RT/Config.pm +++ b/rt/lib/RT/Config.pm @@ -51,8 +51,10 @@ package RT::Config; use strict; use warnings; - +use 5.010; use File::Spec (); +use Symbol::Global::Name; +use List::MoreUtils 'uniq'; =head1 NAME @@ -107,7 +109,7 @@ 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 + under on the user Preferences page Overridable - Can users change this option SortOrder - Within a Section, how should the options be sorted for display to the user @@ -122,6 +124,11 @@ can be set for each config optin: Callback - subref that receives no arguments. It returns a hashref of items that are added to the rest of the WidgetArguments + PostSet - subref passed the RT::Config object and the current and + previous setting of the config option. This is called well + before much of RT's subsystems are initialized, so what you + can do here is pretty limited. It's mostly useful for + effecting the value of other config options early. 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 @@ -133,7 +140,8 @@ can be set for each config optin: =cut -our %META = ( +our %META; +%META = ( # General user overridable options DefaultQueue => { Section => 'General', @@ -171,8 +179,9 @@ our %META = ( Widget => '/Widgets/Form/Select', WidgetArguments => { Description => 'Username format', # loc - Values => [qw(concise verbose)], + Values => [qw(role concise verbose)], ValuesLabel => { + role => 'Privileged: usernames; Unprivileged: names and email addresses', # loc concise => 'Short usernames', # loc verbose => 'Name and email address', # loc }, @@ -195,27 +204,54 @@ our %META = ( Widget => '/Widgets/Form/Select', WidgetArguments => { Description => 'Theme', #loc - # XXX: we need support for 'get values callback' - Values => [qw(web2 freeside2.1 freeside3 aileron ballard)], + Callback => sub { + state @stylesheets; + unless (@stylesheets) { + for my $static_path ( RT::Interface::Web->StaticRoots ) { + my $css_path = + File::Spec->catdir( $static_path, 'css' ); + next unless -d $css_path; + if ( opendir my $dh, $css_path ) { + push @stylesheets, grep { + $_ ne 'base' && -e File::Spec->catfile( $css_path, $_, 'main.css' ) + } readdir $dh; + } + else { + RT->Logger->error("Can't read $css_path: $!"); + } + } + @stylesheets = sort { lc $a cmp lc $b } uniq @stylesheets; + } + return { Values => \@stylesheets }; + }, }, 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; + my @roots = RT::Interface::Web->StaticRoots; + for my $root (@roots) { + return if -d "$root/css/$value"; } $RT::Logger->warning( "The default stylesheet ($value) does not exist in this instance of RT. " - . "Defaulting to freeside3." + . "Defaulting to freeside4." ); - #$self->Set('WebDefaultStylesheet', 'aileron'); - $self->Set('WebDefaultStylesheet', 'freeside3'); + $self->Set('WebDefaultStylesheet', 'freeside4'); }, }, + TimeInICal => { + Section => 'General', + Overridable => 1, + SortOrder => 5, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Include time in iCal feed events?', # loc + Hints => 'Formats iCal feed events with date and time' #loc + } + }, UseSideBySideLayout => { Section => 'Ticket composition', Overridable => 1, @@ -261,17 +297,6 @@ our %META = ( 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, @@ -324,6 +349,16 @@ our %META = ( }, # User overridable options for Ticket displays + PreferRichText => { + Section => 'Ticket display', # loc + Overridable => 1, + SortOrder => 0.9, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Display messages in rich text if available', # loc + Hints => 'Rich text (HTML) shows formatting such as colored text, bold, italics, and more', # loc + }, + }, MaxInlineBody => { Section => 'Ticket display', #loc Overridable => 1, @@ -344,13 +379,19 @@ our %META = ( Description => 'Show oldest history first', #loc }, }, - DeferTransactionLoading => { + ShowHistory => { Section => 'Ticket display', Overridable => 1, SortOrder => 3, - Widget => '/Widgets/Form/Boolean', + Widget => '/Widgets/Form/Select', WidgetArguments => { - Description => 'Hide ticket history by default', #loc + Description => 'Show history', #loc + Values => [qw(delay click always)], + ValuesLabel => { + delay => "after the rest of the page loads", #loc + click => "after clicking a link", #loc + always => "immediately", #loc + }, }, }, ShowUnreadMessageNotifications => { @@ -364,13 +405,20 @@ our %META = ( }, 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
+        PostSet => sub {
+            my $self  = shift;
+            my $value = shift;
+            $self->SetFromConfig(
+                Option => \'PlainTextMono',
+                Value  => [$value],
+                %{$self->Meta('PlainTextPre')->{'Source'}}
+            );
+        },
+        PostLoadCheck => sub {
+            my $self = shift;
+            # XXX: deprecated, remove in 4.4
+            $RT::Logger->info("You set \$PlainTextPre in your config, which has been removed in favor of \$PlainTextMono.  Please update your config.")
+                if $self->Meta('PlainTextPre')->{'Source'}{'Package'};
         },
     },
     PlainTextMono => {
@@ -379,18 +427,8 @@ our %META = (
         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
+            Description => 'Display plain-text attachments in fixed-width font', #loc
+            Hints => 'Display all plain-text attachments in a monospace font with formatting preserved, but wrapping as needed.', #loc
         },
     },
     MoreAboutRequestorTicketList => {
@@ -399,7 +437,7 @@ our %META = (
         SortOrder       => 6,
         Widget          => '/Widgets/Form/Select',
         WidgetArguments => {
-            Description => q|What tickets to display in the 'More about requestor' box|,                #loc
+            Description => '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
@@ -415,7 +453,7 @@ our %META = (
         SortOrder       => 7,
         Widget          => '/Widgets/Form/Boolean',
         WidgetArguments => {
-            Description => q|Show simplified recipient list on ticket update|,                #loc
+            Description => "Show simplified recipient list on ticket update",                #loc
         },
     },
     DisplayTicketAfterQuickCreate => {
@@ -424,9 +462,18 @@ our %META = (
         SortOrder       => 8,
         Widget          => '/Widgets/Form/Boolean',
         WidgetArguments => {
-            Description => q{Display ticket after "Quick Create"}, #loc
+            Description => 'Display ticket after "Quick Create"', #loc
         },
     },
+    QuoteFolding => {
+        Section => 'Ticket display',
+        Overridable => 1,
+        SortOrder => 9,
+        Widget => '/Widgets/Form/Boolean',
+        WidgetArguments => {
+            Description => 'Enable quote folding?' # loc
+        }
+    },
 
     # User overridable locale options
     DateTimeFormat => {
@@ -513,6 +560,10 @@ our %META = (
     },
 
     # Internal config options
+    DatabaseExtraDSN => {
+        Type => 'HASH',
+    },
+
     FullTextSearch => {
         Type => 'HASH',
         PostLoadCheck => sub {
@@ -540,11 +591,26 @@ our %META = (
                     $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");
+                    $RT::Logger->error("Table for full-text index is set to Attachments, not FTS 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 {
+                    my (undef, $create) = eval { $RT::Handle->dbh->selectrow_array("SHOW CREATE TABLE " . $v->{Table}); };
+                    my ($engine) = ($create||'') =~ /engine=(\S+)/i;
+                    if (not $create) {
+                        $RT::Logger->error("External table ".$v->{Table}." does not exist");
+                        $v->{Enable} = $v->{Indexed} = 0;
+                    } elsif (lc $engine eq "sphinx") {
+                        # External Sphinx indexer
+                        $v->{Sphinx} = 1;
+                        unless ($v->{'MaxMatches'}) {
+                            $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000");
+                            $v->{MaxMatches} = 10_000;
+                        }
+                    } else {
+                        # Internal, one-column table
+                        $v->{Column} = 'Content';
+                        $v->{Engine} = $engine;
+                    }
                 }
             } else {
                 $RT::Logger->error("Indexed full-text-search not supported for $dbtype");
@@ -558,9 +624,7 @@ our %META = (
             my $self  = shift;
             my $value = shift;
             return if $value;
-            return if $INC{'GraphViz.pm'};
-            local $@;
-            return if eval {require GraphViz; 1};
+            return if GraphViz->require;
             $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
             $self->Set( DisableGraphViz => 1 );
         },
@@ -571,60 +635,168 @@ our %META = (
             my $self  = shift;
             my $value = shift;
             return if $value;
-            return if $INC{'GD.pm'};
-            local $@;
-            return if eval {require GD; 1};
+            return if GD->require;
             $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
             $self->Set( DisableGD => 1 );
         },
     },
-    MailPlugins  => { Type => 'ARRAY' },
-    Plugins      => {
+    MailCommand => {
+        Type    => 'SCALAR',
+        PostLoadCheck => sub {
+            my $self = shift;
+            my $value = $self->Get('MailCommand');
+            return if ref($value) eq "CODE"
+                or $value =~/^(sendmail|sendmailpipe|qmail|testfile|mbox)$/;
+            $RT::Logger->error("Unknown value for \$MailCommand: $value; defaulting to sendmailpipe");
+            $self->Set( MailCommand => 'sendmailpipe' );
+        },
+    },
+    HTMLFormatter => {
+        Type => 'SCALAR',
+        PostLoadCheck => sub { RT::Interface::Email->_HTMLFormatter },
+    },
+    MailPlugins  => {
         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';
+
+            # Make sure Crypt is post-loaded first
+            $META{Crypt}{'PostLoadCheck'}->( $self, $self->Get( 'Crypt' ) );
+
+            my @plugins = $self->Get('MailPlugins');
+            if ( grep $_ eq 'Auth::GnuPG' || $_ eq 'Auth::SMIME', @plugins ) {
+                $RT::Logger->warning(
+                    'Auth::GnuPG and Auth::SMIME (from an extension) have been'
+                    .' replaced with Auth::Crypt.  @MailPlugins has been adjusted,'
+                    .' but should be updated to replace both with Auth::Crypt to'
+                    .' silence this warning.'
+                );
+                my %seen;
+                @plugins =
+                    grep !$seen{$_}++,
+                    grep {
+                        $_ eq 'Auth::GnuPG' || $_ eq 'Auth::SMIME'
+                        ? 'Auth::Crypt' : $_
+                    } @plugins;
+                $self->Set( MailPlugins => @plugins );
+            }
+
+            if ( not @{$self->Get('Crypt')->{Incoming}} and grep $_ eq 'Auth::Crypt', @plugins ) {
+                $RT::Logger->warning("Auth::Crypt enabled in MailPlugins, but no available incoming encryption formats");
+            }
         },
     },
-    GnuPG        => { Type => 'HASH' },
-    GnuPGOptions => { Type => 'HASH',
+    Crypt        => {
+        Type => 'HASH',
+        PostLoadCheck => sub {
+            my $self = shift;
+            require RT::Crypt;
+
+            for my $proto (RT::Crypt->EnabledProtocols) {
+                my $opt = $self->Get($proto);
+                if (not RT::Crypt->LoadImplementation($proto)) {
+                    $RT::Logger->error("You enabled $proto, but we couldn't load module RT::Crypt::$proto");
+                    $opt->{'Enable'} = 0;
+                } elsif (not RT::Crypt->LoadImplementation($proto)->Probe) {
+                    $opt->{'Enable'} = 0;
+                } elsif ($META{$proto}{'PostLoadCheck'}) {
+                    $META{$proto}{'PostLoadCheck'}->( $self, $self->Get( $proto ) );
+                }
+
+            }
+
+            my $opt = $self->Get('Crypt');
+            my @enabled = RT::Crypt->EnabledProtocols;
+            my %enabled;
+            $enabled{$_} = 1 for @enabled;
+            $opt->{'Enable'} = scalar @enabled;
+            $opt->{'Incoming'} = [ $opt->{'Incoming'} ]
+                if $opt->{'Incoming'} and not ref $opt->{'Incoming'};
+            if ( $opt->{'Incoming'} && @{ $opt->{'Incoming'} } ) {
+                $RT::Logger->warning("$_ explicitly set as incoming Crypt plugin, but not marked Enabled; removing")
+                    for grep {not $enabled{$_}} @{$opt->{'Incoming'}};
+                $opt->{'Incoming'} = [ grep {$enabled{$_}} @{$opt->{'Incoming'}} ];
+            } else {
+                $opt->{'Incoming'} = \@enabled;
+            }
+            if ( $opt->{'Outgoing'} ) {
+                if (not $enabled{$opt->{'Outgoing'}}) {
+                    $RT::Logger->warning($opt->{'Outgoing'}.
+                                             " explicitly set as outgoing Crypt plugin, but not marked Enabled; "
+                                             . (@enabled ? "using $enabled[0]" : "removing"));
+                }
+                $opt->{'Outgoing'} = $enabled[0] unless $enabled{$opt->{'Outgoing'}};
+            } else {
+                $opt->{'Outgoing'} = $enabled[0];
+            }
+        },
+    },
+    SMIME        => {
+        Type => 'HASH',
+        PostLoadCheck => sub {
+            my $self = shift;
+            my $opt = $self->Get('SMIME');
+            return unless $opt->{'Enable'};
+
+            if (exists $opt->{Keyring}) {
+                unless ( File::Spec->file_name_is_absolute( $opt->{Keyring} ) ) {
+                    $opt->{Keyring} = File::Spec->catfile( $RT::BasePath, $opt->{Keyring} );
+                }
+                unless (-d $opt->{Keyring} and -r _) {
+                    $RT::Logger->info(
+                        "RT's SMIME libraries couldn't successfully read your".
+                        " configured SMIME keyring directory (".$opt->{Keyring}
+                        .").");
+                    delete $opt->{Keyring};
+                }
+            }
+
+            if (defined $opt->{CAPath}) {
+                if (-d $opt->{CAPath} and -r _) {
+                    # directory, all set
+                } elsif (-f $opt->{CAPath} and -r _) {
+                    # file, all set
+                } else {
+                    $RT::Logger->warn(
+                        "RT's SMIME libraries could not read your configured CAPath (".$opt->{CAPath}.")"
+                    );
+                    delete $opt->{CAPath};
+                }
+            }
+        },
+    },
+    GnuPG        => {
+        Type => 'HASH',
         PostLoadCheck => sub {
             my $self = shift;
             my $gpg = $self->Get('GnuPG');
             return unless $gpg->{'Enable'};
+
             my $gpgopts = $self->Get('GnuPGOptions');
+            unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
+                $gpgopts->{homedir} = File::Spec->catfile( $RT::BasePath, $gpgopts->{homedir} );
+            }
             unless (-d $gpgopts->{homedir}  && -r _ ) { # no homedir, no gpg
-                $RT::Logger->debug(
+                $RT::Logger->info(
                     "RT's GnuPG libraries couldn't successfully read your".
                     " configured GnuPG home directory (".$gpgopts->{homedir}
-                    ."). PGP support has been disabled");
+                    ."). GnuPG 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;
+            if ( grep exists $gpg->{$_}, qw(RejectOnMissingPrivateKey RejectOnBadData AllowEncryptDataInDB) ) {
+                $RT::Logger->warning(
+                    "The RejectOnMissingPrivateKey, RejectOnBadData and AllowEncryptDataInDB"
+                    ." GnuPG options are now properties of the generic Crypt configuration. You"
+                    ." should set them there instead."
+                );
+                delete $gpg->{$_} for qw(RejectOnMissingPrivateKey RejectOnBadData AllowEncryptDataInDB);
             }
         }
     },
+    GnuPGOptions => { Type => 'HASH' },
     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;
@@ -762,35 +934,88 @@ our %META = (
             }
         },
     },
+    LogToScreen => {
+        Deprecated => {
+            Instead => 'LogToSTDERR',
+            Remove  => '4.4',
+        },
+    },
+    UserAutocompleteFields => {
+        Deprecated => {
+            Instead => 'UserSearchFields',
+            Remove  => '4.4',
+        },
+    },
+    CustomFieldGroupings => {
+        Type            => 'HASH',
+        PostLoadCheck   => sub {
+            my $config = shift;
+            # use scalar context intentionally to avoid not a hash error
+            my $groups = $config->Get('CustomFieldGroupings') || {};
 
-    ActiveStatus => {
-        Type => 'ARRAY',
-        PostLoadCheck => sub {
-            my $self  = shift;
-            return unless shift;
-            # XXX Remove in RT 4.2
-            warn <Logger->error("Config option \%CustomFieldGroupings is a @{[ref $groups]} not a HASH; ignoring");
+                $groups = {};
+            }
+
+            for my $class (keys %$groups) {
+                my @h;
+                if (ref($groups->{$class}) eq 'HASH') {
+                    push @h, $_, $groups->{$class}->{$_}
+                        for sort {lc($a) cmp lc($b)} keys %{ $groups->{$class} };
+                } elsif (ref($groups->{$class}) eq 'ARRAY') {
+                    @h = @{ $groups->{$class} };
+                } else {
+                    RT->Logger->error("Config option \%CustomFieldGroupings{$class} is not a HASH or ARRAY; ignoring");
+                    delete $groups->{$class};
+                    next;
+                }
+
+                $groups->{$class} = [];
+                while (@h) {
+                    my $group = shift @h;
+                    my $ref   = shift @h;
+                    if (ref($ref) eq 'ARRAY') {
+                        push @{$groups->{$class}}, $group => $ref;
+                    } else {
+                        RT->Logger->error("Config option \%CustomFieldGroupings{$class}{$group} is not an ARRAY; ignoring");
+                    }
+                }
+            }
+            $config->Set( CustomFieldGroupings => %$groups );
         },
     },
-    InactiveStatus => {
-        Type => 'ARRAY',
-        PostLoadCheck => sub {
-            my $self  = shift;
-            return unless shift;
-            # XXX Remove in RT 4.2
-            warn < {
+        Type    => 'ARRAY',
+    },
+    WebExternalAuth           => { Deprecated => { Instead => 'WebRemoteUserAuth',             Remove => '4.4' }},
+    WebExternalAuthContinuous => { Deprecated => { Instead => 'WebRemoteUserContinuous',       Remove => '4.4' }},
+    WebFallbackToInternalAuth => { Deprecated => { Instead => 'WebFallbackToRTLogin',          Remove => '4.4' }},
+    WebExternalGecos          => { Deprecated => { Instead => 'WebRemoteUserGecos',            Remove => '4.4' }},
+    WebExternalAuto           => { Deprecated => { Instead => 'WebRemoteUserAutocreate',       Remove => '4.4' }},
+    AutoCreate                => { Deprecated => { Instead => 'UserAutocreateDefaultsOnLogin', Remove => '4.4' }},
+    LogoImageHeight => {
+        Deprecated => {
+            LogLevel => "info",
+            Message => "The LogoImageHeight configuration option did not affect display, and has been removed; please remove it from your RT_SiteConfig.pm",
+        },
+    },
+    LogoImageWidth => {
+        Deprecated => {
+            LogLevel => "info",
+            Message => "The LogoImageWidth configuration option did not affect display, and has been removed; please remove it from your RT_SiteConfig.pm",
+        },
+    },
+    DatabaseRequireSSL => {
+        Deprecated => {
+            Remove => '4.4',
+            LogLevel => "info",
+            Message => "The DatabaseRequireSSL configuration option did not enable SSL connections to the database, and has been removed; please remove it from your RT_SiteConfig.pm.  Use DatabaseExtraDSN to accomplish the same purpose.",
         },
     },
 );
 my %OPTIONS = ();
+my @LOADED_CONFIGS = ();
 
 =head1 METHODS
 
@@ -812,19 +1037,6 @@ 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
@@ -836,11 +1048,9 @@ Takes no arguments.
 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;
 }
@@ -868,9 +1078,13 @@ sub LoadConfig {
         and my $site_config = $ENV{RT_SITE_CONFIG} )
     {
         $self->_LoadConfig( %args, File => $site_config );
+        # to allow load siteconfig again and again in case it's updated
+        delete $INC{ $site_config };
     } else {
         $self->_LoadConfig(%args);
+        delete $INC{$args{'File'}};
     }
+
     $args{'File'} =~ s/Site(?=Config\.pm$)//;
     $self->_LoadConfig(%args);
     return 1;
@@ -903,6 +1117,20 @@ sub _LoadConfig {
                 Extension  => $is_ext,
             );
         };
+        local *Plugin = sub {
+            my (@new_plugins) = @_;
+            @new_plugins = map {s/-/::/g if not /:/; $_} @new_plugins;
+            my ( $pack, $file, $line ) = caller;
+            return $self->SetFromConfig(
+                Option     => \@RT::Plugins,
+                Value      => [@RT::Plugins, @new_plugins],
+                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;
@@ -953,6 +1181,14 @@ EOF
         my $errormessage = sprintf( $message,
             $file_path, $fileusername, $filegroup, $filegroup );
         die "$errormessage\n$@";
+    } else {
+        # Loaded successfully
+        push @LOADED_CONFIGS, {
+            as          => $args{'File'},
+            filename    => $INC{ $args{'File'} },
+            extension   => $is_ext,
+            site        => $is_site,
+        };
     }
     return 1;
 }
@@ -989,6 +1225,40 @@ sub Configs {
     return @configs;
 }
 
+=head2 LoadedConfigs
+
+Returns a list of hashrefs, one for each config file loaded.  The keys of the
+hashes are:
+
+=over 4
+
+=item as
+
+Name this config file was loaded as (relative filename usually).
+
+=item filename
+
+The full path and filename.
+
+=item extension
+
+The "extension" part of the filename.  For example, the file C
+will have an C value of C.
+
+=item site
+
+True if the file is considered a site-level override.  For example, C
+will be false for C and true for C.
+
+=back
+
+=cut
+
+sub LoadedConfigs {
+    # Copy to avoid the caller changing our internal data
+    return map { \%$_ } @LOADED_CONFIGS
+}
+
 =head2 Get
 
 Takes name of the option as argument and returns its current value.
@@ -1080,6 +1350,24 @@ sub Set {
         {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
     }
     $META{$name}->{'Type'} = $type;
+    $META{$name}->{'PostSet'}->($self, $OPTIONS{$name}, $old)
+        if $META{$name}->{'PostSet'};
+    if ($META{$name}->{'Deprecated'}) {
+        my %deprecated = %{$META{$name}->{'Deprecated'}};
+        my $new_var = $deprecated{Instead} || '';
+        $self->SetFromConfig(
+            Option => \$new_var,
+            Value  => [$OPTIONS{$name}],
+            %{$self->Meta($name)->{'Source'}}
+        ) if $new_var;
+        $META{$name}->{'PostLoadCheck'} ||= sub {
+            RT->Deprecated(
+                Message => "Configuration option $name is deprecated",
+                Stack   => 0,
+                %deprecated,
+            );
+        };
+    }
     return $self->_ReturnValue( $old, $type );
 }
 
@@ -1115,7 +1403,7 @@ sub SetFromConfig {
     my $opt = $args{'Option'};
 
     my $type;
-    my $name = $self->__GetNameByRef($opt);
+    my $name = Symbol::Global::Name->find($opt);
     if ($name) {
         $type = ref $opt;
         $name =~ s/.*:://;
@@ -1175,77 +1463,6 @@ sub SetFromConfig {
     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
 
 
@@ -1270,7 +1487,7 @@ sub Sections {
 sub Options {
     my $self = shift;
     my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
-    my @res  = keys %META;
+    my @res  = sort keys %META;
     
     @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
         @res 
diff --git a/rt/lib/RT/Crypt.pm b/rt/lib/RT/Crypt.pm
new file mode 100644
index 0000000..cad86d2
--- /dev/null
+++ b/rt/lib/RT/Crypt.pm
@@ -0,0 +1,843 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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::Crypt;
+use 5.010;
+
+=head1 NAME
+
+RT::Crypt - encrypt/decrypt and sign/verify subsystem for RT
+
+=head1 DESCRIPTION
+
+This module provides support for encryption and signing of outgoing
+messages, as well as the decryption and verification of incoming emails
+using various encryption standards. Currently, L
+and L protocols are supported.
+
+=head1 CONFIGURATION
+
+You can control the configuration of this subsystem from RT's configuration file.
+Some options are available via the web interface, but to enable this functionality,
+you MUST start in the configuration file.
+
+For each protocol there is a hash with the same name in the configuration file.
+This hash controls RT-specific options regarding the protocol. It allows you to
+enable/disable each facility or change the format of messages; for example, GnuPG
+uses the following config:
+
+    Set( %GnuPG,
+        Enable => 1,
+        ... other options ...
+    );
+
+C is the only key that is generic for all protocols. A protocol may have
+additional options to fine-tune behaviour.
+
+However, note that you B add the
+L email filter to enable
+the handling of incoming encrypted/signed messages.  It should be added
+in addition to the standard
+L plugin.
+
+=head2 %Crypt
+
+This config option hash chooses which protocols are decrypted and
+verified in incoming messages, which protocol is used for outgoing
+emails, and RT's behaviour on errors during decrypting and verification.
+
+RT will provide sane defaults for all of these options.  By default, all
+enabled encryption protocols are decrypted on incoming mail; if you wish
+to limit this to a subset, you may, via:
+
+    Set( %Crypt,
+        ...
+        Incoming => ['SMIME'],
+        ...
+    );
+
+RT can currently only use one protocol to encrypt and sign outgoing
+email; this defaults to the first enabled protocol.  You many specify it
+explicitly via:
+
+    Set( %Crypt,
+        ...
+        Outgoing => 'GnuPG',
+        ...
+    );
+
+You can allow users to encrypt data in the database by setting the
+C key to a true value; by default, this is
+disabled.  Be aware that users must have rights to see and modify
+tickets to use this feature.
+
+=head2 Per-queue options
+
+Using the web interface, it is possible to enable signing and/or
+encrypting by default. As an administrative user of RT, navigate to the
+'Admin' and 'Queues' menus, and select a queue.  If at least one
+encryption protocol is enabled, information concerning available keys
+will be displayed, as well as options to enable signing and encryption.
+
+=head2 Handling incoming messages
+
+To enable handling of encrypted and signed message in the RT you must
+enable the L mail plugin:
+
+    Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filter...);
+
+=head2 Error handling
+
+There are several global templates created in the database by
+default. RT uses these templates to send error messages to users or RT's
+owner. These templates have an 'Error:' or 'Error to RT owner:' prefix
+in the name. You can adjust the text of the messages using the web
+interface.
+
+Note that while C<$TicketObj>, C<$TransactionObj> and other variables
+usually available in RT's templates are not available in these
+templates, but each is passed alternate data structures can be used to
+build better messages; see the default templates and descriptions below.
+
+You can disable any particular notification by simply deleting the
+content of a template.  Deleting the templates entirely is not
+suggested, as RT will log error messages when attempting to send mail
+usign them.
+
+=head3 Problems with public keys
+
+The 'Error: public key' template is used to inform the user that RT had
+problems with their public key, and thus will not be able to send
+encrypted content. There are several reasons why RT might fail to use a
+key; by default, the actual reason is not sent to the user, but sent to
+the RT owner using the 'Error to RT owner: public key' template.
+
+Possible reasons include "Not Found", "Ambiguous specification", "Wrong
+key usage", "Key revoked", "Key expired", "No CRL known", "CRL too old",
+"Policy mismatch", "Not a secret key", "Key not trusted" or "No specific
+reason given".
+
+In the 'Error: public key' template there are a few additional variables
+available:
+
+=over 4
+
+=item $Message - user friendly error message
+
+=item $Reason - short reason as listed above
+
+=item $Recipient - recipient's identification
+
+=item $AddressObj - L object containing recipient's email address
+
+=back
+
+As a message may have several invalid recipients, to avoid sending many
+emails to the RT owner, the system sends one message to the owner,
+grouped by recipient. In the 'Error to RT owner: public key' template a
+C<@BadRecipients> array is available where each element is a hash
+reference that describes one recipient using the same fields as
+described above:
+
+    @BadRecipients = (
+        { Message => '...', Reason => '...', Recipient => '...', ...},
+        { Message => '...', Reason => '...', Recipient => '...', ...},
+        ...
+    )
+
+=head3 Private key doesn't exist
+
+The 'Error: no private key' template is used to inform the user that
+they sent an encrypted email to RT, but RT does not have the private key
+to decrypt it.
+
+In this template L object C<$Message> is available, which
+is the originally received message.
+
+=head3 Invalid data
+
+The 'Error: bad encrypted data' template is used to inform the user that
+a message they sent had invalid data, and could not be handled.  There
+are several possible reasons for this error, but most of them are data
+corruption or absence of expected information.
+
+In this template, the C<@Messages> array is available, and will contain
+a list of error messages.
+
+=head1 METHODS
+
+=head2 Protocols
+
+Returns the complete set of encryption protocols that RT implements; not
+all may be supported by this installation.
+
+=cut
+
+our @PROTOCOLS = ('GnuPG', 'SMIME');
+our %PROTOCOLS = map { lc $_ => $_ } @PROTOCOLS;
+
+sub Protocols {
+    return @PROTOCOLS;
+}
+
+=head2 EnabledProtocols
+
+Returns the set of enabled and available encryption protocols.
+
+=cut
+
+sub EnabledProtocols {
+    my $self = shift;
+    return grep RT->Config->Get($_)->{'Enable'}, $self->Protocols;
+}
+
+=head2 UseForOutgoing
+
+Returns the configured outgoing encryption protocol; see
+L.
+
+=cut
+
+sub UseForOutgoing {
+    return RT->Config->Get('Crypt')->{'Outgoing'};
+}
+
+=head2 EnabledOnIncoming
+
+Returns the list of encryption protocols that should be used for
+decryption and verification of incoming email; see L.
+This list is irrelevant unless L is
+enabled in L.
+
+=cut
+
+sub EnabledOnIncoming {
+    return @{ scalar RT->Config->Get('Crypt')->{'Incoming'} };
+}
+
+=head2 LoadImplementation CLASS
+
+Given the name of an encryption implementation (e.g. "GnuPG"), loads the
+L class associated with it; return the classname on success,
+and undef on failure.
+
+=cut
+
+sub LoadImplementation {
+    state %cache;
+    my $proto = $PROTOCOLS{ lc $_[1] } or die "Unknown protocol '$_[1]'";
+    my $class = 'RT::Crypt::'. $proto;
+    return $cache{ $class } if exists $cache{ $class };
+
+    if ($class->require) {
+        return $cache{ $class } = $class;
+    } else {
+        RT->Logger->warn( "Could not load $class: $@" );
+        return $cache{ $class } = undef;
+    }
+}
+
+=head2 SimpleImplementationCall Protocol => NAME, [...]
+
+Examines the caller of this method, and dispatches to the method of the
+same name on the correct L class based on the provided
+C.
+
+=cut
+
+sub SimpleImplementationCall {
+    my $self = shift;
+    my %args = (@_);
+    my $protocol = delete $args{'Protocol'} || $self->UseForOutgoing;
+
+    my $method = (caller(1))[3];
+    $method =~ s/.*:://;
+
+    my %res = $self->LoadImplementation( $protocol )->$method( %args );
+    $res{'Protocol'} = $protocol if keys %res;
+    return %res;
+}
+
+=head2 FindProtectedParts Entity => MIME::Entity
+
+Looks for encrypted or signed parts of the given C, using all
+L encryption protocols.  For each node in the MIME
+hierarchy, L for that L
+is called on each L protocol.  Any multipart nodes
+not claimed by those protocols are recursed into.
+
+Finally, L is called on the top-most
+entity for each L protocol.
+
+Returns a list of hash references; each hash reference is guaranteed to
+contain a C key describing the protocol of the found part, and
+a C which is either C or C.  The remaining keys
+are protocol-dependent; the hashref will be provided to
+L.
+
+=cut
+
+sub FindProtectedParts {
+    my $self = shift;
+    my %args = (
+        Entity => undef,
+        Skip => {},
+        Scattered => 1,
+        @_
+    );
+
+    my $entity = $args{'Entity'};
+    return () if $args{'Skip'}{ $entity };
+
+    $args{'TopEntity'} ||= $entity;
+
+    my @protocols = $self->EnabledOnIncoming;
+
+    foreach my $protocol ( @protocols ) {
+        my $class = $self->LoadImplementation( $protocol );
+        my %info = $class->CheckIfProtected(
+            TopEntity => $args{'TopEntity'},
+            Entity    => $entity,
+        );
+        next unless keys %info;
+
+        $args{'Skip'}{ $entity } = 1;
+        $info{'Protocol'} = $protocol;
+        return \%info;
+    }
+
+    if ( $entity->effective_type =~ /^multipart\/(?:signed|encrypted)/ ) {
+        # if no module claimed that it supports these types then
+        # we don't dive in and check sub-parts
+        $args{'Skip'}{ $entity } = 1;
+        return ();
+    }
+
+    my @res;
+
+    # not protected itself, look inside
+    push @res, $self->FindProtectedParts(
+        %args, Entity => $_, Scattered => 0,
+    ) foreach grep !$args{'Skip'}{$_}, $entity->parts;
+
+    if ( $args{'Scattered'} ) {
+        my %parent;
+        my $filter; $filter = sub {
+            $parent{$_[0]} = $_[1];
+            unless ( $_[0]->is_multipart ) {
+                return () if $args{'Skip'}{$_[0]};
+                return $_[0];
+            }
+            return map $filter->($_, $_[0]), grep !$args{'Skip'}{$_}, $_[0]->parts;
+        };
+        my @parts = $filter->($entity);
+        return @res unless @parts;
+
+        foreach my $protocol ( @protocols ) {
+            my $class = $self->LoadImplementation( $protocol );
+            my @list = $class->FindScatteredParts(
+                Entity  => $args{'TopEntity'},
+                Parts   => \@parts,
+                Parents => \%parent,
+                Skip    => $args{'Skip'}
+            );
+            next unless @list;
+
+            $_->{'Protocol'} = $protocol foreach @list;
+            push @res, @list;
+            @parts = grep !$args{'Skip'}{$_}, @parts;
+        }
+    }
+
+    return @res;
+}
+
+=head2 SignEncrypt Entity => ENTITY, [Sign => 1], [Encrypt => 1],
+[Recipients => ARRAYREF], [Signer => NAME], [Protocol => NAME],
+[Passphrase => VALUE]
+
+Takes a L object, and signs and/or encrypts it using the
+given C.  If not set, C for encryption will be set
+by examining the C, C, and C headers of the MIME entity.
+If not set, C defaults to the C of the MIME entity.
+
+C, if not provided, will be retrieved using
+L.
+
+Returns a hash with at least the following keys:
+
+=over
+
+=item exit_code
+
+True if there was an error encrypting or signing.
+
+=item message
+
+An un-localized error message desribing the problem.
+
+=back
+
+=cut
+
+sub SignEncrypt {
+    my $self = shift;
+    my %args = (@_);
+
+    my $entity = $args{'Entity'};
+    if ( $args{'Sign'} && !defined $args{'Signer'} ) {
+        $args{'Signer'} =
+            $self->UseKeyForSigning
+            || do {
+                my ($addr) = map {Email::Address->parse( Encode::decode( "UTF-8", $_ ) )}
+                    $entity->head->get( 'From' );
+                $addr ? $addr->address : undef
+            };
+    }
+    if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
+        my %seen;
+        $args{'Recipients'} = [
+            grep $_ && !$seen{ $_ }++, map $_->address,
+            map Email::Address->parse( Encode::decode("UTF-8", $_ ) ),
+            map $entity->head->get( $_ ),
+            qw(To Cc Bcc)
+        ];
+    }
+    return $self->SimpleImplementationCall( %args );
+}
+
+=head2 SignEncryptContent Content => STRINGREF, [Sign => 1], [Encrypt => 1],
+[Recipients => ARRAYREF], [Signer => NAME], [Protocol => NAME],
+[Passphrase => VALUE]
+
+Signs and/or encrypts a string, which is passed by reference.
+C defaults to C, and C
+defaults to the global L.  All other
+arguments and return values are identical to L.
+
+=cut
+
+sub SignEncryptContent {
+    my $self = shift;
+    my %args = (@_);
+
+    if ( $args{'Sign'} && !defined $args{'Signer'} ) {
+        $args{'Signer'} = $self->UseKeyForSigning;
+    }
+    if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
+        $args{'Recipients'} = [ RT->Config->Get('CorrespondAddress') ];
+    }
+
+    return $self->SimpleImplementationCall( %args );
+}
+
+=head2 DrySign Signer => KEY
+
+Signs a small message with the key, to make sure the key exists and we
+have a useable passphrase. The Signer argument MUST be a key identifier
+of the signer: either email address, key id or finger print.
+
+Returns a true value if all went well.
+
+=cut
+
+sub DrySign {
+    my $self = shift;
+
+    my $mime = MIME::Entity->build(
+        Type    => "text/plain",
+        From    => 'nobody@localhost',
+        To      => 'nobody@localhost',
+        Subject => "dry sign",
+        Data    => ['t'],
+    );
+
+    my %res = $self->SignEncrypt(
+        @_,
+        Sign    => 1,
+        Encrypt => 0,
+        Entity  => $mime,
+    );
+
+    return $res{exit_code} == 0;
+}
+
+=head2 VerifyDecrypt Entity => ENTITY [, Passphrase => undef ]
+
+Locates all protected parts of the L object C, as
+found by L, and calls
+L from the appropriate L
+class on each.
+
+C, if not provided, will be retrieved using
+L.
+
+Returns a list of the hash references returned from
+L.
+
+=cut
+
+sub VerifyDecrypt {
+    my $self = shift;
+    my %args = (
+        Entity    => undef,
+        Recursive => 1,
+        @_
+    );
+
+    my @res;
+
+    my @protected = $self->FindProtectedParts( Entity => $args{'Entity'} );
+    foreach my $protected ( @protected ) {
+        my %res = $self->SimpleImplementationCall(
+            %args, Protocol => $protected->{'Protocol'}, Info => $protected
+        );
+
+        # Let the header be modified so continuations are handled
+        my $modify = $res{status_on}->head->modify;
+        $res{status_on}->head->modify(1);
+        $res{status_on}->head->add(
+            "X-RT-" . $protected->{'Protocol'} . "-Status" => $res{'status'}
+        );
+        $res{status_on}->head->modify($modify);
+
+        push @res, \%res;
+    }
+
+    push @res, $self->VerifyDecrypt( %args )
+        if $args{Recursive} and @res and not grep {$_->{'exit_code'}} @res;
+
+    return @res;
+}
+
+=head2 DecryptContent Protocol => NAME, Content => STRINGREF, [Passphrase => undef]
+
+Decrypts the content in the string reference in-place.  All other
+arguments and return values are identical to L.
+
+=cut
+
+sub DecryptContent {
+    return shift->SimpleImplementationCall( @_ );
+}
+
+=head2 ParseStatus Protocol => NAME, Status => STRING
+
+Takes a C describing the status of verification/decryption,
+usually as stored in a MIME header.  Parses it and returns array of hash
+references, one for each operation.  Each hashref contains at least
+three keys:
+
+=over
+
+=item Operation
+
+The classification of the process whose status is being reported upon.
+Valid values include C, C, C, C,
+C, C and C.
+
+=item Status
+
+Whether the operation was successful; contains C on success.
+Other possible values include C, C, or C.
+
+=item Message
+
+An un-localized user friendly message.
+
+=back
+
+=cut
+
+sub ParseStatus {
+    my $self = shift;
+    my %args = (
+        Protocol => undef,
+        Status   => '',
+        @_
+    );
+    return $self->LoadImplementation( $args{'Protocol'} )->ParseStatus( $args{'Status'} );
+}
+
+=head2 UseKeyForSigning [KEY]
+
+Returns or sets the identifier of the key that should be used for
+signing.  Returns the current value when called without arguments; sets
+the new value when called with one argument and unsets if it's undef.
+
+This cache is cleared at the end of every request.
+
+=cut
+
+sub UseKeyForSigning {
+    my $self = shift;
+    state $key;
+    if ( @_ ) {
+        $key = $_[0];
+    }
+    return $key;
+}
+
+=head2 UseKeyForEncryption [KEY [, VALUE]]
+
+Gets or sets keys to use for encryption.  When passed no arguments,
+clears the cache.  When passed just a key, returns the encryption key
+previously stored for that key.  When passed two (or more) keys, stores
+them associatively.
+
+This cache is reset at the end of every request.
+
+=cut
+
+sub UseKeyForEncryption {
+    my $self = shift;
+    state %key;
+    unless ( @_ ) {
+        %key = ();
+    } elsif ( @_ > 1 ) {
+        %key = (%key, @_);
+        $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
+    } else {
+        return $key{ $_[0] };
+    }
+    return ();
+}
+
+=head2 GetKeysForEncryption Recipient => EMAIL, Protocol => NAME
+
+Returns the list of keys which are suitable for encrypting mail to the
+given C.  Generally this is equivalent to L
+with a C of , but encryption protocols may further limit
+which keys can be used for encryption, as opposed to signing.
+
+=cut
+
+sub CheckRecipients {
+    my $self = shift;
+    my @recipients = (@_);
+
+    my ($status, @issues) = (1, ());
+
+    my $trust = sub { 1 };
+    if ( $self->UseForOutgoing eq 'SMIME' ) {
+        $trust = sub { $_[0]->{'TrustLevel'} > 0 or RT->Config->Get('SMIME')->{AcceptUntrustedCAs} };
+    } elsif ( $self->UseForOutgoing eq 'GnuPG' ) {
+        $trust = sub { $_[0]->{'TrustLevel'} > 0 };
+    }
+
+    my %seen;
+    foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
+        my %res = $self->GetKeysForEncryption( Recipient => $address );
+        if ( $res{'info'} && @{ $res{'info'} } == 1 and $trust->($res{'info'}[0]) ) {
+            # One key, which is trusted, or we can sign with an
+            # untrusted key (aka SMIME with AcceptUntrustedCAs)
+            next;
+        }
+        my $user = RT::User->new( RT->SystemUser );
+        $user->LoadByEmail( $address );
+        # it's possible that we have no User record with the email
+        $user = undef unless $user->id;
+
+        if ( my $fpr = RT::Crypt->UseKeyForEncryption( $address ) ) {
+            if ( $res{'info'} && @{ $res{'info'} } ) {
+                next if
+                    grep lc $_->{'Fingerprint'} eq lc $fpr,
+                    grep $trust->($_),
+                    @{ $res{'info'} };
+            }
+
+            $status = 0;
+            my %issue = (
+                EmailAddress => $address,
+                $user? (User => $user) : (),
+                Keys => undef,
+            );
+            $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
+            push @issues, \%issue;
+            next;
+        }
+
+        my $prefered_key;
+        $prefered_key = $user->PreferredKey if $user;
+        #XXX: prefered key is not yet implemented...
+
+        # classify errors
+        $status = 0;
+        my %issue = (
+            EmailAddress => $address,
+            $user? (User => $user) : (),
+            Keys => undef,
+        );
+
+        unless ( $res{'info'} && @{ $res{'info'} } ) {
+            # no key
+            $issue{'Message'} = "There is no key suitable for encryption."; #loc
+        }
+        elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
+            # trust is not set
+            $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
+        }
+        else {
+            # multiple keys
+            $issue{'Message'} = "There are several keys suitable for encryption."; #loc
+        }
+        push @issues, \%issue;
+    }
+    return ($status, @issues);
+}
+
+sub GetKeysForEncryption {
+    my $self = shift;
+    my %args = @_%2? (Recipient => @_) : (Protocol => undef, Recipient => undef, @_ );
+    return $self->SimpleImplementationCall( %args );
+}
+
+=head2 GetKeysForSigning Signer => EMAIL, Protocol => NAME
+
+Returns the list of keys which are suitable for signing mail from the
+given C.  Generally this is equivalent to L
+with a C of , but encryption protocols may further limit
+which keys can be used for signing, as opposed to encryption.
+
+=cut
+
+sub GetKeysForSigning {
+    my $self = shift;
+    my %args = @_%2? (Signer => @_) : (Protocol => undef, Signer => undef, @_);
+    return $self->SimpleImplementationCall( %args );
+}
+
+=head2 GetPublicKeyInfo Protocol => NAME, KEY => EMAIL
+
+As per L, but the C is forced to C.
+
+=cut
+
+sub GetPublicKeyInfo {
+    return (shift)->GetKeyInfo( @_, Type => 'public' );
+}
+
+=head2 GetPrivateKeyInfo Protocol => NAME, KEY => EMAIL
+
+As per L, but the C is forced to C.
+
+=cut
+
+sub GetPrivateKeyInfo {
+    return (shift)->GetKeyInfo( @_, Type => 'private' );
+}
+
+=head2 GetKeyInfo Protocol => NAME, Type => ('public'|'private'), KEY => EMAIL
+
+As per L, but only the first matching key is returned in
+the C value of the result.
+
+=cut
+
+sub GetKeyInfo {
+    my $self = shift;
+    my %res = $self->GetKeysInfo( @_ );
+    $res{'info'} = $res{'info'}->[0];
+    return %res;
+}
+
+=head2 GetKeysInfo Protocol => NAME, Type => ('public'|'private'), Key => EMAIL
+
+Looks up information about the public or private keys (as determined by
+C) for the email address C.  As each protocol has its own key
+store, C is also required.  If no C is provided and a
+true value for C is given, returns all keys.
+
+The return value is a hash containing C and C in the
+case of failure, or C, which is an array reference of key
+information.  Each key is represented as a hash reference; the keys are
+protocol-dependent, but will at least contain:
+
+=over
+
+=item Protocol
+
+The name of the protocol of this key
+
+=item Created
+
+An L of the date the key was created; undef if unset.
+
+=item Expire
+
+An L of the date the key expires; undef if the key does not expire.
+
+=item Fingerprint
+
+A fingerprint unique to this key
+
+=item Formatted
+
+A formatted string representation of the key
+
+=item User
+
+An array reference of associated user data, each of which is a hashref
+containing at least a C value, which is a C<< Alice Example
+ >> style email address.  Each may also contain
+C and C keys, which are L objects.
+
+=back
+
+=cut
+
+sub GetKeysInfo {
+    my $self = shift;
+    my %args = @_%2 ? (Key => @_) : ( Protocol => undef, Key => undef, @_ );
+    return $self->SimpleImplementationCall( %args );
+}
+
+1;
diff --git a/rt/lib/RT/Crypt/GnuPG.pm b/rt/lib/RT/Crypt/GnuPG.pm
index 9d97445..ddb91e4 100644
--- a/rt/lib/RT/Crypt/GnuPG.pm
+++ b/rt/lib/RT/Crypt/GnuPG.pm
@@ -48,34 +48,39 @@
 
 use strict;
 use warnings;
+use 5.010;
 
 package RT::Crypt::GnuPG;
 
+use Role::Basic 'with';
+with 'RT::Crypt::Role';
+
 use IO::Handle;
+use File::Which qw();
+use RT::Crypt::GnuPG::CRLFHandle;
 use GnuPG::Interface;
 use RT::EmailParser ();
 use RT::Util 'safe_run_child', 'mime_recommended_filename';
 
 =head1 NAME
 
-RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG)
+RT::Crypt::GnuPG - GNU Privacy Guard encryption/decryption/verification/signing
 
 =head1 DESCRIPTION
 
-This module provides support for encryption and signing of outgoing messages, 
-as well as the decryption and verification of incoming email.
+This module provides support for encryption and signing of outgoing
+messages using GnuPG, as well as the decryption and verification of
+incoming email.
 
 =head1 CONFIGURATION
 
-You can control the configuration of this subsystem from RT's configuration file.
-Some options are available via the web interface, but to enable this functionality, you
-MUST start in the configuration file.
-
-There are two hashes, GnuPG and GnuPGOptions in the configuration file. The 
-first one controls RT specific options. It enables you to enable/disable facility 
-or change the format of messages. The second one is a hash with options for the 
-'gnupg' utility. You can use it to define a keyserver, enable auto-retrieval keys 
-and set almost any option 'gnupg' supports on your system.
+There are two reveant configuration options, both of which are hashes:
+C and C. The first one controls RT specific
+options; it enables you to enable/disable the GPG protocol or change the
+format of messages. The second one is a hash with options which are
+passed to the C utility. You can use it to define a keyserver,
+enable auto-retrieval of keys, or set almost any option which C
+supports on your system.
 
 =head2 %GnuPG
 
@@ -88,13 +93,13 @@ Set to true value to enable this subsystem:
         ... other options ...
     );
 
-However, note that you B add the 'Auth::GnuPG' email filter to enable
+However, note that you B add the 'Auth::Crypt' email filter to enable
 the handling of incoming encrypted/signed messages.
 
 =head3 Format of outgoing messages
 
-Format of outgoing messages can be controlled using the 'OutgoingMessagesFormat'
-option in the RT config:
+The format of outgoing messages can be controlled using the
+C option in the RT config:
 
     Set( %GnuPG,
         ... other options ...
@@ -110,50 +115,49 @@ or
         ... other options ...
     );
 
-This framework implements two formats of signing and encrypting of email messages:
+The two formats for GPG mail are as follows:
 
 =over
 
 =item RFC
 
-This format is also known as GPG/MIME and described in RFC3156 and RFC1847.
-Technique described in these RFCs is well supported by many mail user
-agents (MUA), but some MUAs support only inline signatures and encryption,
-so it's possible to use inline format (see below).
+This format, the default, is also known as GPG/MIME, and is described in
+RFC3156 and RFC1847.  The technique described in these RFCs is well
+supported by many mail user agents (MUA); however, some older MUAs only
+support inline signatures and encryption.
 
 =item Inline
 
-This format doesn't take advantage of MIME, but some mail clients do
-not support GPG/MIME.
-
-We sign text parts using clear signatures. For each attachments another
-attachment with a signature is added with '.sig' extension.
+This format doesn't take advantage of MIME, but some mail clients do not
+support GPG/MIME.  In general, this format is discouraged because modern
+mail clients typically do not support it well.
 
-Encryption of text parts is implemented using inline format, other parts
-are replaced with attachments with the filename extension '.pgp'.
-
-This format is discouraged because modern mail clients typically don't support
-it well.
+Text parts are signed using clear-text signatures. For each attachment,
+the signature is attached separately as a file with a '.sig' extension
+added to the filename.  Encryption of text parts is implemented using
+inline format, while other parts are replaced with attachments with the
+filename extension '.pgp'.
 
 =back
 
-=head3 Encrypting data in the database
+=head3 Passphrases
 
-You can allow users to encrypt data in the database using
-option C. By default it's disabled.
-Users must have rights to see and modify tickets to use
-this feature.
+Passphrases for keys may be set by passing C.  It may be set
+to a scalar (to use for all keys), an anonymous function, or a hash (to
+look up by address).  If the hash is used, the '' key is used as a
+default.
 
 =head2 %GnuPGOptions
 
-Use this hash to set options of the 'gnupg' program. You can define almost any
-option you want which  gnupg supports, but never try to set options which
-change output format or gnupg's commands, such as --sign (command),
---list-options (option) and other.
+Use this hash to set additional options of the 'gnupg' program.  The
+only options which are diallowed are options which alter the output
+format or attempt to run commands; thiss includes C<--sign>,
+C<--list-options>, etc.
 
-Some GnuPG options take arguments while others take none. (Such as  --use-agent).
-For options without specific value use C as hash value.
-To disable these option just comment them out or delete them from the hash
+Some GnuPG options take arguments, while others take none. (Such as
+C<--use-agent>).  For options without specific value use C as
+hash value.  To disable these options, you may comment them out or
+delete them from the hash:
 
     Set(%GnuPGOptions,
         'option-with-value' => 'value',
@@ -161,62 +165,69 @@ To disable these option just comment them out or delete them from the hash
         # 'commented-option' => 'value or undef',
     );
 
-B that options may contain '-' character and such options B be
-quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'.
+B that options may contain the '-' character and such options
+B be quoted, otherwise you will see the quite cryptic error C.
+
+Common options include:
 
 =over
 
 =item --homedir
 
-The GnuPG home directory, by default it is set to F.
+The GnuPG home directory where the keyrings are stored; by default it is
+set to F.
 
-You can manage this data with the 'gpg' commandline utility 
-using the GNUPGHOME environment variable or --homedir option. 
-Other utilities may be used as well.
+You can manage this data with the 'gpg' commandline utility using the
+GNUPGHOME environment variable or C<--homedir> option.  Other utilities may
+be used as well.
 
-In a standard installation, access to this directory should be granted to
-the web server user which is running RT's web interface, but if you're running
-cronjobs or other utilities that access RT directly via API and may generate
-encrypted/signed notifications then the users you execute these scripts under
-must have access too. 
+In a standard installation, access to this directory should be granted
+to the web server user which is running RT's web interface; however, if
+you are running cronjobs or other utilities that access RT directly via
+API, and may generate encrypted/signed notifications, then the users you
+execute these scripts under must have access too.
 
-However, granting access to the dir to many users makes your setup less secure,
-some features, such as auto-import of keys, may not be available if you do not.
-To enable this features and suppress warnings about permissions on
-the dir use --no-permission-warning.
+Be aware that granting access to the directory to many users makes the
+keys less secure -- and some features, such as auto-import of keys, may
+not be available if directory permissions are too permissive.  To enable
+these features and suppress warnings about permissions on the directory,
+add the C<--no-permission-warning> option to C.
 
 =item --digest-algo
 
-This option is required in advance when RFC format for outgoing messages is
-used. We can not get default algorithm from gpg program so RT uses 'SHA1' by
-default. You may want to override it. You can use MD5, SHA1, RIPEMD160,
-SHA256 or other, however use `gpg --version` command to get information about
-supported algorithms by your gpg. These algorithms are listed as hash-functions.
+This option is required when the C format for outgoing messages is
+used.  RT defaults to 'SHA1' by default, but you may wish to override
+it.  C will list the algorithms supported by your
+C installation under 'hash functions'; these generally include
+MD5, SHA1, RIPEMD160, and SHA256.
 
 =item --use-agent
 
-This option lets you use GPG Agent to cache the passphrase of RT's key. See
+This option lets you use GPG Agent to cache the passphrase of secret
+keys. See
 L
 for information about GPG Agent.
 
 =item --passphrase
 
-This option lets you set the passphrase of RT's key directly. This option is
-special in that it isn't passed directly to GPG, but is put into a file that
-GPG then reads (which is more secure). The downside is that anyone who has read
-access to your RT_SiteConfig.pm file can see the passphrase, thus we recommend
-the --use-agent option instead.
+This option lets you set the passphrase of RT's key directly. This
+option is special in that it is not passed directly to GPG; rather, it
+is put into a file that GPG then reads (which is more secure). The
+downside is that anyone who has read access to your RT_SiteConfig.pm
+file can see the passphrase -- thus we recommend the --use-agent option
+whenever possible.
 
 =item other
 
-Read `man gpg` to get list of all options this program support.
+Read C to get list of all options this program supports.
 
 =back
 
 =head2 Per-queue options
 
 Using the web interface it's possible to enable signing and/or encrypting by
-default. As an administrative user of RT, open 'Configuration' then 'Queues',
+default. As an administrative user of RT, open 'Admin' then 'Queues',
 and select a queue. On the page you can see information about the queue's keys 
 at the bottom and two checkboxes to choose default actions.
 
@@ -227,99 +238,35 @@ option is disabled.
 =head2 Handling incoming messages
 
 To enable handling of encrypted and signed message in the RT you should add
-'Auth::GnuPG' mail plugin.
-
-    Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
+'Auth::Crypt' mail plugin.
 
-See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`.
+    Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filter...);
 
-=head2 Errors handling
+See also `perldoc lib/RT/Interface/Email/Auth/Crypt.pm`.
 
-There are several global templates created in the database by default. RT
-uses these templates to send error messages to users or RT's owner. These 
-templates have 'Error:' or 'Error to RT owner:' prefix in the name. You can 
-adjust the text of the messages using the web interface.
-
-Note that C<$TicketObj>, C<$TransactionObj> and other variable usually available
-in RT's templates are not available in these templates, but each template
-used for errors reporting has set of available data structures you can use to
-build better messages. See default templates and descriptions below.
-
-As well, you can disable particular notification by deleting content of
-a template. You can delete a template too, but in this case you'll see
-error messages in the logs when RT can not load template you've deleted.
-
-=head3 Problems with public keys
-
-Template 'Error: public key' is used to inform the user that RT has problems with
-his public key and won't be able to send him encrypted content. There are several 
-reasons why RT can't use a key. However, the actual reason is not sent to the user, 
-but sent to RT owner using 'Error to RT owner: public key'.
-
-The possible reasons: "Not Found", "Ambiguous specification", "Wrong
-key usage", "Key revoked", "Key expired", "No CRL known", "CRL too
-old", "Policy mismatch", "Not a secret key", "Key not trusted" or
-"No specific reason given".
+=head2 Encrypting to untrusted keys
 
 Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
 unless 'always trust' mode is enabled.
 
-In the 'Error: public key' template there are a few additional variables available:
-
-=over 4
-
-=item $Message - user friendly error message
-
-=item $Reason - short reason as listed above
-
-=item $Recipient - recipient's identification
-
-=item $AddressObj - L object containing recipient's email address
-
-=back
-
-A message can have several invalid recipients, to avoid sending many emails
-to the RT owner the system sends one message to the owner, grouped by
-recipient. In the 'Error to RT owner: public key' template a C<@BadRecipients>
-array is available where each element is a hash reference that describes one
-recipient using the same fields as described above. So it's something like:
-
-    @BadRecipients = (
-        { Message => '...', Reason => '...', Recipient => '...', ...},
-        { Message => '...', Reason => '...', Recipient => '...', ...},
-        ...
-    )
-
-=head3 Private key doesn't exist
-
-Template 'Error: no private key' is used to inform the user that
-he sent an encrypted email, but we have no private key to decrypt
-it.
-
-In this template C<$Message> object of L class
-available. It's the message RT received.
+=head1 FOR DEVELOPERS
 
-=head3 Invalid data
+=head2 Documentation and references
 
-Template 'Error: bad GnuPG data' used to inform the user that a
-message he sent has invalid data and can not be handled.
+=over
 
-There are several reasons for this error, but most of them are data
-corruption or absence of expected information.
+=item RFC1847
 
-In this template C<@Messages> array is available and contains list
-of error messages.
+Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
+Describes generic MIME security framework, "mulitpart/signed" and
+"multipart/encrypted" MIME types.
 
-=head1 FOR DEVELOPERS
 
-=head2 Documentation and references
+=item RFC3156
 
-* RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
-Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted"
-MIME types.
+MIME Security with Pretty Good Privacy (PGP), updates RFC2015.
 
-* RFC3156 - MIME Security with Pretty Good Privacy (PGP),
-updates RFC2015.
+=back
 
 =cut
 
@@ -364,65 +311,133 @@ our $RE_FILE_EXTENSIONS = qr/pgp|asc/i;
 #            ...
 #        );
 
-=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ]
-
-Signs and/or encrypts an email message with GnuPG utility.
-
-=over
+sub CallGnuPG {
+    my $self = shift;
+    my %args = (
+        Options     => undef,
+        Signer      => undef,
+        Recipients  => [],
+        Passphrase  => undef,
+
+        Command     => undef,
+        CommandArgs => [],
+
+        Content     => undef,
+        Handles     => {},
+        Direct      => undef,
+        Output      => undef,
+        @_
+    );
 
-=item Signing
+    my %handle = %{$args{Handles}};
+    my ($handles, $handle_list) = _make_gpg_handles( %handle );
+    $handles->options( $_ )->{'direct'} = 1
+        for @{$args{Direct} || [keys %handle] };
+    %handle = %$handle_list;
 
-During signing you can pass C argument to set key we sign with this option
-overrides gnupg's C option. If C argument is not provided
-then address of a message sender is used.
+    my $content = $args{Content};
+    my $command = $args{Command};
 
-As well you can pass C, but if value is undefined then L
-called to get it.
+    my %GnuPGOptions = RT->Config->Get('GnuPGOptions');
+    my %opt = (
+        'digest-algo' => 'SHA1',
+        %GnuPGOptions,
+        %{ $args{Options} || {} },
+    );
+    my $gnupg = GnuPG::Interface->new;
+    $gnupg->call( $self->GnuPGPath );
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+    );
+    $gnupg->options->armor( 1 );
+    $gnupg->options->meta_interactive( 0 );
+    $gnupg->options->default_key( $args{Signer} )
+        if defined $args{Signer};
 
-=item Encrypting
+    my %seen;
+    $gnupg->options->push_recipients( $_ ) for
+        map { RT::Crypt->UseKeyForEncryption($_) || $_ }
+        grep { !$seen{ $_ }++ }
+            @{ $args{Recipients} || [] };
 
-During encryption you can pass a C array, otherwise C, C and
-C fields of the message are used to fetch the list.
+    $args{Passphrase} = $GnuPGOptions{passphrase}
+        unless defined $args{'Passphrase'};
+    $args{Passphrase} = $self->GetPassphrase( Address => $args{Signer} )
+        unless defined $args{'Passphrase'};
+    $gnupg->passphrase( $args{'Passphrase'} )
+        if defined $args{Passphrase};
 
-=back
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $pid = safe_run_child {
+            if ($command =~ /^--/) {
+                $gnupg->wrap_call(
+                    handles      => $handles,
+                    commands     => [$command],
+                    command_args => $args{CommandArgs},
+                );
+            } else {
+                $gnupg->$command(
+                    handles      => $handles,
+                    command_args => $args{CommandArgs},
+                );
+            }
+        };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            if (Scalar::Util::blessed($content) and $content->can("print")) {
+                $content->print( $handle{'stdin'} );
+            } elsif (ref($content) eq "SCALAR") {
+                $handle{'stdin'}->print( ${ $content } );
+            } elsif (defined $content) {
+                $handle{'stdin'}->print( $content );
+            }
+            close $handle{'stdin'} or die "Can't close gnupg input handle: $!";
+            $args{Callback}->(%handle) if $args{Callback};
+        }
+        waitpid $pid, 0;
+    };
+    my $err = $@;
+    if ($args{Output}) {
+        push @{$args{Output}}, readline $handle{stdout};
+        if (not close $handle{stdout}) {
+            $err ||= "Can't close gnupg output handle: $!";
+        }
+    }
 
-Returns a hash with the following keys:
+    my %res;
+    $res{'exit_code'} = $?;
 
-* exit_code
-* error
-* logger
-* status
-* message
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/ = undef; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        if (not close $handle{$_}) {
+            $err ||= "Can't close gnupg $_ handle: $!";
+        }
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $err || $res{'exit_code'} ) {
+        $res{'message'} = $err? $err : "gpg exited with error code ". ($res{'exit_code'} >> 8);
+    }
 
-=cut
+    return %res;
+}
 
 sub SignEncrypt {
-    my %args = (@_);
+    my $self = shift;
 
-    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()
-            || $addresses[0]->address;
-    }
-    if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
-        my %seen;
-        $args{'Recipients'} = [
-            grep $_ && !$seen{ $_ }++, map $_->address,
-            map Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( $_ ) ) ),
-            qw(To Cc Bcc)
-        ];
-    }
-    
     my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
     if ( $format eq 'inline' ) {
-        return SignEncryptInline( %args );
+        return $self->SignEncryptInline( @_ );
     } else {
-        return SignEncryptRFC3156( %args );
+        return $self->SignEncryptRFC3156( @_ );
     }
 }
 
 sub SignEncryptRFC3156 {
+    my $self = shift;
     my %args = (
         Entity => undef,
 
@@ -436,28 +451,7 @@ sub SignEncryptRFC3156 {
         @_
     );
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnuPGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined $args{'Passphrase'};
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $opt{'default_key'} = $args{'Signer'}
-        if $args{'Sign'} && $args{'Signer'};
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        armor => 1,
-        meta_interactive => 0,
-    );
-
     my $entity = $args{'Entity'};
-
-    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
-        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
-    }
-
     my %res;
     if ( $args{'Sign'} && !$args{'Encrypt'} ) {
         # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1)
@@ -469,46 +463,28 @@ sub SignEncryptRFC3156 {
                 );
             }
         }
-
-        my ($handles, $handle_list) = _make_gpg_handles(stdin =>IO::Handle::CRLF->new );
-        my %handle = %$handle_list;
-
-        $gnupg->passphrase( $args{'Passphrase'} );
-
-        eval {
-            local $SIG{'CHLD'} = 'DEFAULT';
-            my $pid = safe_run_child { $gnupg->detach_sign( handles => $handles ) };
-            $entity->make_multipart( 'mixed', Force => 1 );
-            {
-                local $SIG{'PIPE'} = 'IGNORE';
-                $entity->parts(0)->print( $handle{'stdin'} );
-                close $handle{'stdin'};
-            }
-            waitpid $pid, 0;
-        };
-        my $err = $@;
-        my @signature = readline $handle{'stdout'};
-        close $handle{'stdout'};
-
-        $res{'exit_code'} = $?;
-        foreach ( qw(stderr logger status) ) {
-            $res{$_} = do { local $/; readline $handle{$_} };
-            delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-            close $handle{$_};
-        }
-        $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-        $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-        $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-        if ( $err || $res{'exit_code'} ) {
-            $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
-            return %res;
-        }
+        $entity->make_multipart( 'mixed', Force => 1 );
+
+        my @signature;
+        # We use RT::Crypt::GnuPG::CRLFHandle to canonicalize the
+        # MIME::Entity output to use \r\n instead of \n for its newlines
+        %res = $self->CallGnuPG(
+            Signer     => $args{'Signer'},
+            Command    => "detach_sign",
+            Handles    => { stdin => RT::Crypt::GnuPG::CRLFHandle->new },
+            Direct     => [],
+            Passphrase => $args{'Passphrase'},
+            Content    => $entity->parts(0),
+            Output     => \@signature,
+        );
+        return %res if $res{message};
 
         # setup RFC1847(Ch.2.1) requirements
         my $protocol = 'application/pgp-signature';
+        my $algo = RT->Config->Get('GnuPGOptions')->{'digest-algo'} || 'SHA1';
         $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
         $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
-        $entity->head->mime_attr( 'Content-Type.micalg'   => 'pgp-'. lc $opt{'digest-algo'} );
+        $entity->head->mime_attr( 'Content-Type.micalg'   => 'pgp-'. lc $algo );
         $entity->attach(
             Type        => $protocol,
             Disposition => 'inline',
@@ -517,48 +493,24 @@ sub SignEncryptRFC3156 {
         );
     }
     if ( $args{'Encrypt'} ) {
-        my %seen;
-        $gnupg->options->push_recipients( $_ ) foreach 
-            map UseKeyForEncryption($_) || $_,
-            grep !$seen{ $_ }++, map $_->address,
-            map Email::Address->parse( Encode::decode( "UTF-8", $entity->head->get( $_ ) ) ),
+        my @recipients = map $_->address,
+            map Email::Address->parse( Encode::decode( "UTF-8", $_ ) ),
+            map $entity->head->get( $_ ),
             qw(To Cc Bcc);
 
         my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
         binmode $tmp_fh, ':raw';
 
-        my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
-        my %handle = %$handle_list;
-        $handles->options( 'stdout'  )->{'direct'} = 1;
-        $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
-
-        eval {
-            local $SIG{'CHLD'} = 'DEFAULT';
-            my $pid = safe_run_child { $args{'Sign'}
-                ? $gnupg->sign_and_encrypt( handles => $handles )
-                : $gnupg->encrypt( handles => $handles ) };
-            $entity->make_multipart( 'mixed', Force => 1 );
-            {
-                local $SIG{'PIPE'} = 'IGNORE';
-                $entity->parts(0)->print( $handle{'stdin'} );
-                close $handle{'stdin'};
-            }
-            waitpid $pid, 0;
-        };
-
-        $res{'exit_code'} = $?;
-        foreach ( qw(stderr logger status) ) {
-            $res{$_} = do { local $/; readline $handle{$_} };
-            delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-            close $handle{$_};
-        }
-        $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-        $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-        $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-        if ( $@ || $? ) {
-            $res{'message'} = $@? $@: "gpg exited with error code ". ($? >> 8);
-            return %res;
-        }
+        $entity->make_multipart( 'mixed', Force => 1 );
+        %res = $self->CallGnuPG(
+            Signer     => $args{'Signer'},
+            Recipients => \@recipients,
+            Command    => ( $args{'Sign'} ? "sign_and_encrypt" : "encrypt" ),
+            Handles    => { stdout => $tmp_fh },
+            Passphrase => $args{'Passphrase'},
+            Content    => $entity->parts(0),
+        );
+        return %res if $res{message};
 
         my $protocol = 'application/pgp-encrypted';
         $entity->parts([]);
@@ -583,6 +535,7 @@ sub SignEncryptRFC3156 {
 }
 
 sub SignEncryptInline {
+    my $self = shift;
     my %args = ( @_ );
 
     my $entity = $args{'Entity'};
@@ -591,19 +544,20 @@ sub SignEncryptInline {
     $entity->make_singlepart;
     if ( $entity->is_multipart ) {
         foreach ( $entity->parts ) {
-            %res = SignEncryptInline( @_, Entity => $_ );
+            %res = $self->SignEncryptInline( @_, Entity => $_ );
             return %res if $res{'exit_code'};
         }
         return %res;
     }
 
-    return _SignEncryptTextInline( @_ )
+    return $self->_SignEncryptTextInline( @_ )
         if $entity->effective_type =~ /^text\//i;
 
-    return _SignEncryptAttachmentInline( @_ );
+    return $self->_SignEncryptAttachmentInline( @_ );
 }
 
 sub _SignEncryptTextInline {
+    my $self = shift;
     my %args = (
         Entity => undef,
 
@@ -618,72 +572,23 @@ sub _SignEncryptTextInline {
     );
     return unless $args{'Sign'} || $args{'Encrypt'};
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnupGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined($args{'Passphrase'});
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $opt{'default_key'} = $args{'Signer'}
-        if $args{'Sign'} && $args{'Signer'};
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        armor => 1,
-        meta_interactive => 0,
-    );
-
-    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
-        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
-    }
-
-    if ( $args{'Encrypt'} ) {
-        $gnupg->options->push_recipients( $_ ) foreach 
-            map UseKeyForEncryption($_) || $_,
-            @{ $args{'Recipients'} || [] };
-    }
-
-    my %res;
-
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw';
 
-    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
-    my %handle = %$handle_list;
-
-    $handles->options( 'stdout'  )->{'direct'} = 1;
-    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
-
     my $entity = $args{'Entity'};
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $method = $args{'Sign'} && $args{'Encrypt'}
-            ? 'sign_and_encrypt'
-            : ($args{'Sign'}? 'clearsign': 'encrypt');
-        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
-        {
-            local $SIG{'PIPE'} = 'IGNORE';
-            $entity->bodyhandle->print( $handle{'stdin'} );
-            close $handle{'stdin'};
-        }
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    my $err = $@;
-
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-    if ( $err || $res{'exit_code'} ) {
-        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
-        return %res;
-    }
+    my %res = $self->CallGnuPG(
+        Signer     => $args{'Signer'},
+        Recipients => $args{'Recipients'},
+        Command    => ( $args{'Sign'} && $args{'Encrypt'}
+                      ? 'sign_and_encrypt'
+                      : ( $args{'Sign'}
+                        ? 'clearsign'
+                        : 'encrypt' ) ),
+        Handles    => { stdout => $tmp_fh },
+        Passphrase => $args{'Passphrase'},
+        Content    => $entity->bodyhandle,
+    );
+    return %res if $res{message};
 
     $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) );
     $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
@@ -692,6 +597,7 @@ sub _SignEncryptTextInline {
 }
 
 sub _SignEncryptAttachmentInline {
+    my $self = shift;
     my %args = (
         Entity => undef,
 
@@ -706,71 +612,25 @@ sub _SignEncryptAttachmentInline {
     );
     return unless $args{'Sign'} || $args{'Encrypt'};
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnupGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined($args{'Passphrase'});
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $opt{'default_key'} = $args{'Signer'}
-        if $args{'Sign'} && $args{'Signer'};
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        armor => 1,
-        meta_interactive => 0,
-    );
-
-    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
-        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
-    }
 
     my $entity = $args{'Entity'};
-    if ( $args{'Encrypt'} ) {
-        $gnupg->options->push_recipients( $_ ) foreach
-            map UseKeyForEncryption($_) || $_,
-            @{ $args{'Recipients'} || [] };
-    }
-
-    my %res;
 
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw';
 
-    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
-    my %handle = %$handle_list;
-    $handles->options( 'stdout'  )->{'direct'} = 1;
-    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
-
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $method = $args{'Sign'} && $args{'Encrypt'}
-            ? 'sign_and_encrypt'
-            : ($args{'Sign'}? 'detach_sign': 'encrypt');
-        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
-        {
-            local $SIG{'PIPE'} = 'IGNORE';
-            $entity->bodyhandle->print( $handle{'stdin'} );
-            close $handle{'stdin'};
-        }
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    my $err = $@;
-
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-    if ( $err || $res{'exit_code'} ) {
-        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
-        return %res;
-    }
+    my %res = $self->CallGnuPG(
+        Signer     => $args{'Signer'},
+        Recipients => $args{'Recipients'},
+        Command    => ( $args{'Sign'} && $args{'Encrypt'}
+                      ? 'sign_and_encrypt'
+                      : ( $args{'Sign'}
+                        ? 'detach_sign'
+                        : 'encrypt' ) ),
+        Handles    => { stdout => $tmp_fh },
+        Passphrase => $args{'Passphrase'},
+        Content    => $entity->bodyhandle,
+    );
+    return %res if $res{message};
 
     my $filename = mime_recommended_filename( $entity ) || 'no_name';
     if ( $args{'Sign'} && !$args{'Encrypt'} ) {
@@ -794,6 +654,7 @@ sub _SignEncryptAttachmentInline {
 }
 
 sub SignEncryptContent {
+    my $self = shift;
     my %args = (
         Content => undef,
 
@@ -808,70 +669,22 @@ sub SignEncryptContent {
     );
     return unless $args{'Sign'} || $args{'Encrypt'};
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnupGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined($args{'Passphrase'});
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $opt{'default_key'} = $args{'Signer'}
-        if $args{'Sign'} && $args{'Signer'};
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        armor => 1,
-        meta_interactive => 0,
-    );
-
-    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
-        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
-    }
-
-    if ( $args{'Encrypt'} ) {
-        $gnupg->options->push_recipients( $_ ) foreach 
-            map UseKeyForEncryption($_) || $_,
-            @{ $args{'Recipients'} || [] };
-    }
-
-    my %res;
-
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw';
 
-    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
-    my %handle = %$handle_list;
-    $handles->options( 'stdout'  )->{'direct'} = 1;
-    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
-
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $method = $args{'Sign'} && $args{'Encrypt'}
-            ? 'sign_and_encrypt'
-            : ($args{'Sign'}? 'clearsign': 'encrypt');
-        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
-        {
-            local $SIG{'PIPE'} = 'IGNORE';
-            $handle{'stdin'}->print( ${ $args{'Content'} } );
-            close $handle{'stdin'};
-        }
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    my $err = $@;
-
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-    if ( $err || $res{'exit_code'} ) {
-        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
-        return %res;
-    }
+    my %res = $self->CallGnuPG(
+        Signer     => $args{'Signer'},
+        Recipients => $args{'Recipients'},
+        Command    => ( $args{'Sign'} && $args{'Encrypt'}
+                      ? 'sign_and_encrypt'
+                      : ( $args{'Sign'}
+                        ? 'clearsign'
+                        : 'encrypt' ) ),
+        Handles    => { stdout => $tmp_fh },
+        Passphrase => $args{'Passphrase'},
+        Content    => $args{'Content'},
+    );
+    return %res if $res{message};
 
     ${ $args{'Content'} } = '';
     seek $tmp_fh, 0, 0;
@@ -888,257 +701,276 @@ sub SignEncryptContent {
     return %res;
 }
 
-sub FindProtectedParts {
-    my %args = ( Entity => undef, CheckBody => 1, @_ );
-    my $entity = $args{'Entity'};
+sub CheckIfProtected {
+    my $self = shift;
+    my %args = ( Entity => undef, @_ );
 
-    # inline PGP block, only in singlepart
-    unless ( $entity->is_multipart ) {
-        my $file = ($entity->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
+    my $entity = $args{'Entity'};
 
-        my $io = $entity->open('r');
-        unless ( $io ) {
-            $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
-            return ();
-        }
+    # we check inline PGP block later in another sub
+    return () unless $entity->is_multipart;
 
-        # Deal with "partitioned" PGP mail, which (contrary to common
-        # sense) unnecessarily applies a base64 transfer encoding to PGP
-        # mail (whose content is already base64-encoded).
-        if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
-            my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
-            if ($decoder) {
-                local $@;
-                eval {
-                    my $buf = '';
-                    open my $fh, '>', \$buf
-                        or die "Couldn't open scalar for writing: $!";
-                    binmode $fh, ":raw";
-                    $decoder->decode($io, $fh);
-                    close $fh or die "Couldn't close scalar: $!";
-
-                    open $fh, '<', \$buf
-                        or die "Couldn't re-open scalar for reading: $!";
-                    binmode $fh, ":raw";
-                    $io = $fh;
-                    1;
-                } or do {
-                    $RT::Logger->error("Couldn't decode body: $@");
-                }
-            }
-        }
+    # RFC3156, multipart/{signed,encrypted}
+    my $type = $entity->effective_type;
+    return () unless $type =~ /^multipart\/(?:encrypted|signed)$/;
 
-        while ( defined($_ = $io->getline) ) {
-            next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
-            my $type = $1? 'signed': 'encrypted';
-            $RT::Logger->debug("Found $type inline part");
-            return {
-                Type    => $type,
-                Format  => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
-                Data    => $entity,
-            };
-        }
-        $io->close;
+    unless ( $entity->parts == 2 ) {
+        $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
         return ();
     }
 
-    # RFC3156, multipart/{signed,encrypted}
-    if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
-        unless ( $entity->parts == 2 ) {
-            $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
-            return ();
-        }
-
-        my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
-        unless ( $protocol ) {
-            $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
-            return ();
-        }
+    my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
+    unless ( $protocol ) {
+        # if protocol is not set then we can check second part for PGP message
+        $RT::Logger->error( "Entity is '$type', but has no protocol defined. Checking for PGP part" );
+        my $protected = $self->_CheckIfProtectedInline( $entity->parts(1), 1 );
+        return () unless $protected;
 
-        if ( $type eq 'multipart/encrypted' ) {
-            unless ( $protocol eq 'application/pgp-encrypted' ) {
-                $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
-                return ();
-            }
-            $RT::Logger->debug("Found encrypted according to RFC3156 part");
-            return {
-                Type    => 'encrypted',
-                Format  => 'RFC3156',
-                Top   => $entity,
-                Data  => $entity->parts(1),
-                Info    => $entity->parts(0),
-            };
-        } else {
-            unless ( $protocol eq 'application/pgp-signature' ) {
-                $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
-                return ();
-            }
-            $RT::Logger->debug("Found signed according to RFC3156 part");
-            return {
+        if ( $protected eq 'signature' ) {
+            $RT::Logger->debug("Found part signed according to RFC3156");
+            return (
                 Type      => 'signed',
                 Format    => 'RFC3156',
-                Top     => $entity,
-                Data    => $entity->parts(0),
+                Top       => $entity,
+                Data      => $entity->parts(0),
                 Signature => $entity->parts(1),
-            };
+            );
+        } else {
+            $RT::Logger->debug("Found part encrypted according to RFC3156");
+            return (
+                Type   => 'encrypted',
+                Format => 'RFC3156',
+                Top    => $entity,
+                Data   => $entity->parts(1),
+                Info   => $entity->parts(0),
+            );
+        }
+    }
+    elsif ( $type eq 'multipart/encrypted' ) {
+        unless ( $protocol eq 'application/pgp-encrypted' ) {
+            $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
+            return ();
+        }
+        $RT::Logger->debug("Found part encrypted according to RFC3156");
+        return (
+            Type   => 'encrypted',
+            Format => 'RFC3156',
+            Top    => $entity,
+            Data   => $entity->parts(1),
+            Info   => $entity->parts(0),
+        );
+    } else {
+        unless ( $protocol eq 'application/pgp-signature' ) {
+            $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
+            return ();
         }
+        $RT::Logger->debug("Found part signed according to RFC3156");
+        return (
+            Type      => 'signed',
+            Format    => 'RFC3156',
+            Top       => $entity,
+            Data      => $entity->parts(0),
+            Signature => $entity->parts(1),
+        );
     }
+    return ();
+}
+
+
+sub FindScatteredParts {
+    my $self = shift;
+    my %args = ( Parts => [], Skip => {}, @_ );
+
+    my @res;
+
+    my @parts = @{ $args{'Parts'} };
 
     # attachments signed with signature in another part
-    my @file_indices;
-    foreach my $i ( 0 .. $entity->parts - 1 ) {
-        my $part = $entity->parts($i);
+    {
+        my @file_indices;
+        for (my $i = 0; $i < @parts; $i++ ) {
+            my $part = $parts[ $i ];
+
+            # we can not associate a signature within an attachment
+            # without file names
+            my $fname = $part->head->recommended_filename;
+            next unless $fname;
 
-        # we can not associate a signature within an attachment
-        # without file names
-        my $fname = $part->head->recommended_filename;
-        next unless $fname;
+            my $type = $part->effective_type;
 
-        if ( $part->effective_type eq 'application/pgp-signature' ) {
-            push @file_indices, $i;
+            if ( $type eq 'application/pgp-signature' ) {
+                push @file_indices, $i;
+            }
+            elsif ( $type eq 'application/octet-stream' && $fname =~ /\.sig$/i ) {
+                push @file_indices, $i;
+            }
         }
-        elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
-            push @file_indices, $i;
+
+        foreach my $i ( @file_indices ) {
+            my $sig_part = $parts[ $i ];
+            my $sig_name = $sig_part->head->recommended_filename;
+            my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
+
+            my ($data_part_idx) =
+                grep $file_name eq ($parts[$_]->head->recommended_filename||''),
+                grep $sig_part  ne  $parts[$_],
+                    0 .. @parts - 1;
+            unless ( defined $data_part_idx ) {
+                $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
+                next;
+            }
+
+            my $data_part_in = $parts[ $data_part_idx ];
+
+            $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
+
+            $args{'Skip'}{$data_part_in} = 1;
+            $args{'Skip'}{$sig_part} = 1;
+            push @res, {
+                Type      => 'signed',
+                Format    => 'Attachment',
+                Top       => $args{'Parents'}{$sig_part},
+                Data      => $data_part_in,
+                Signature => $sig_part,
+            };
         }
     }
 
-    my (@res, %skip);
-    foreach my $i ( @file_indices ) {
-        my $sig_part = $entity->parts($i);
-        $skip{"$sig_part"}++;
-        my $sig_name = $sig_part->head->recommended_filename;
-        my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
-
-        my ($data_part_idx) =
-            grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
-            grep $sig_part  ne  $entity->parts($_),
-                0 .. $entity->parts - 1;
-        unless ( defined $data_part_idx ) {
-            $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
-            next;
-        }
-        my $data_part_in = $entity->parts($data_part_idx);
+    # attachments with inline encryption
+    foreach my $part ( @parts ) {
+        next if $args{'Skip'}{$part};
+
+        my $fname = $part->head->recommended_filename || '';
+        next unless $fname =~ /\.${RE_FILE_EXTENSIONS}$/;
+
+        $RT::Logger->debug("Found encrypted attachment '$fname'");
 
-        $skip{"$data_part_in"}++;
-        $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
+        $args{'Skip'}{$part} = 1;
         push @res, {
-            Type      => 'signed',
-            Format    => 'Attachment',
-            Top       => $entity,
-            Data      => $data_part_in,
-            Signature => $sig_part,
+            Type    => 'encrypted',
+            Format  => 'Attachment',
+            Data    => $part,
         };
     }
 
-    # attachments with inline encryption
-    my @encrypted_indices =
-        grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.${RE_FILE_EXTENSIONS}$/}
-            0 .. $entity->parts - 1;
-
-    foreach my $i ( @encrypted_indices ) {
-        my $part = $entity->parts($i);
-        $skip{"$part"}++;
-        $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'");
+    # inline PGP block
+    foreach my $part ( @parts ) {
+        next if $args{'Skip'}{$part};
+
+        my $type = $self->_CheckIfProtectedInline( $part );
+        next unless $type;
+
+        my $file = ($part->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
+
+        $args{'Skip'}{$part} = 1;
         push @res, {
-            Type      => 'encrypted',
-            Format    => 'Attachment',
-            Top     => $entity,
-            Data    => $part,
+            Type      => $type,
+            Format    => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
+            Data      => $part,
         };
     }
 
-    push @res, FindProtectedParts( Entity => $_ )
-        foreach grep !$skip{"$_"}, $entity->parts;
-
     return @res;
 }
 
-=head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ]
+sub _CheckIfProtectedInline {
+    my $self = shift;
+    my $entity = shift;
+    my $check_for_signature = shift || 0;
 
-=cut
+    my $io = $entity->open('r');
+    unless ( $io ) {
+        $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
+        return '';
+    }
+
+    # Deal with "partitioned" PGP mail, which (contrary to common
+    # sense) unnecessarily applies a base64 transfer encoding to PGP
+    # mail (whose content is already base64-encoded).
+    if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
+        my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
+        if ($decoder) {
+            local $@;
+            eval {
+                my $buf = '';
+                open my $fh, '>', \$buf
+                    or die "Couldn't open scalar for writing: $!";
+                binmode $fh, ":raw";
+                $decoder->decode($io, $fh);
+                close $fh or die "Couldn't close scalar: $!";
+
+                open $fh, '<', \$buf
+                    or die "Couldn't re-open scalar for reading: $!";
+                binmode $fh, ":raw";
+                $io = $fh;
+                1;
+            } or do {
+                $RT::Logger->error("Couldn't decode body: $@");
+            }
+        }
+    }
+
+    while ( defined($_ = $io->getline) ) {
+        if ( /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
+            return $1? 'signed': 'encrypted';
+        }
+        elsif ( $check_for_signature && !/^-----BEGIN PGP SIGNATURE-----/ ) {
+            return 'signature';
+        }
+    }
+    $io->close;
+    return '';
+}
 
 sub VerifyDecrypt {
+    my $self = shift;
     my %args = (
-        Entity    => undef,
-        Detach    => 1,
-        SetStatus => 1,
-        AddStatus => 0,
+        Info      => undef,
         @_
     );
-    my @protected = FindProtectedParts( Entity => $args{'Entity'} );
-    my @res;
-    # XXX: detaching may brake nested signatures
-    foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) {
-        my $status_on;
+
+    my %res;
+
+    my $item = $args{'Info'};
+    my $status_on;
+    if ( $item->{'Type'} eq 'signed' ) {
         if ( $item->{'Format'} eq 'RFC3156' ) {
-            push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) };
-            if ( $args{'Detach'} ) {
-                $item->{'Top'}->parts( [ $item->{'Data'} ] );
-                $item->{'Top'}->make_singlepart;
-            }
+            %res = $self->VerifyRFC3156( %$item );
             $status_on = $item->{'Top'};
         } elsif ( $item->{'Format'} eq 'Inline' ) {
-            push @res, { VerifyInline( %$item ) };
+            %res = $self->VerifyInline( %$item );
             $status_on = $item->{'Data'};
         } elsif ( $item->{'Format'} eq 'Attachment' ) {
-            push @res, { VerifyAttachment( %$item ) };
-            if ( $args{'Detach'} ) {
-                $item->{'Top'}->parts( [
-                    grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts
-                ] );
-                $item->{'Top'}->make_singlepart;
-            }
+            %res = $self->VerifyAttachment( %$item );
             $status_on = $item->{'Data'};
+        } else {
+            die "Unknown format '".$item->{'Format'} . "' of GnuPG signed part";
         }
-        if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
-            my $method = $args{'AddStatus'} ? 'add' : 'set';
-            # Let the header be modified so continuations are handled
-            my $modify = $status_on->head->modify;
-            $status_on->head->modify(1);
-            $status_on->head->$method(
-                'X-RT-GnuPG-Status' => $res[-1]->{'status'}
-            );
-            $status_on->head->modify($modify);
-        }
-    }
-    foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
-        my $status_on;
+    } elsif ( $item->{'Type'} eq 'encrypted' ) {
         if ( $item->{'Format'} eq 'RFC3156' ) {
-            push @res, { DecryptRFC3156( %$item ) };
+            %res = $self->DecryptRFC3156( %$item );
             $status_on = $item->{'Top'};
         } elsif ( $item->{'Format'} eq 'Inline' ) {
-            push @res, { DecryptInline( %$item ) };
+            %res = $self->DecryptInline( %$item );
             $status_on = $item->{'Data'};
         } elsif ( $item->{'Format'} eq 'Attachment' ) {
-            push @res, { DecryptAttachment( %$item ) };
+            %res = $self->DecryptAttachment( %$item );
             $status_on = $item->{'Data'};
+        } else {
+            die "Unknown format '".$item->{'Format'} . "' of GnuPG encrypted part";
         }
-        if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
-            my $method = $args{'AddStatus'} ? 'add' : 'set';
-            # Let the header be modified so continuations are handled
-            my $modify = $status_on->head->modify;
-            $status_on->head->modify(1);
-            $status_on->head->$method(
-                'X-RT-GnuPG-Status' => $res[-1]->{'status'}
-            );
-            $status_on->head->modify($modify);
-        }
+    } else {
+        die "Unknown type '".$item->{'Type'} . "' of protected item";
     }
-    return @res;
+
+    return (%res, status_on => $status_on);
 }
 
-sub VerifyInline { return DecryptInline( @_ ) }
+sub VerifyInline { return (shift)->DecryptInline( @_ ) }
 
 sub VerifyAttachment {
-    my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
-
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-    $opt{'digest-algo'} ||= 'SHA1';
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
-    );
+    my $self = shift;
+    my %args = ( Data => undef, Signature => undef, @_ );
 
     foreach ( $args{'Data'}, $args{'Signature'} ) {
         next unless $_->bodyhandle->is_encoded;
@@ -1152,85 +984,45 @@ sub VerifyAttachment {
     $args{'Data'}->bodyhandle->print( $tmp_fh );
     $tmp_fh->flush;
 
-    my ($handles, $handle_list) = _make_gpg_handles();
-    my %handle = %$handle_list;
+    my %res = $self->CallGnuPG(
+        Command     => "verify",
+        CommandArgs => [ '-', $tmp_fn ],
+        Passphrase  => $args{'Passphrase'},
+        Content     => $args{'Signature'}->bodyhandle,
+    );
+
+    $args{'Top'}->parts( [
+        grep "$_" ne $args{'Signature'}, $args{'Top'}->parts
+    ] );
+    $args{'Top'}->make_singlepart;
 
-    my %res;
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $pid = safe_run_child { $gnupg->verify(
-            handles => $handles, command_args => [ '-', $tmp_fn ]
-        ) };
-        {
-            local $SIG{'PIPE'} = 'IGNORE';
-            $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
-            close $handle{'stdin'};
-        }
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-    if ( $@ || $? ) {
-        $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
-    }
     return %res;
 }
 
 sub VerifyRFC3156 {
-    my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
-
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-    $opt{'digest-algo'} ||= 'SHA1';
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
-    );
+    my $self = shift;
+    my %args = ( Data => undef, Signature => undef, @_ );
 
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw:eol(CRLF?)';
     $args{'Data'}->print( $tmp_fh );
     $tmp_fh->flush;
 
-    my ($handles, $handle_list) = _make_gpg_handles();
-    my %handle = %$handle_list;
+    my %res = $self->CallGnuPG(
+        Command     => "verify",
+        CommandArgs => [ '-', $tmp_fn ],
+        Passphrase  => $args{'Passphrase'},
+        Content     => $args{'Signature'}->bodyhandle,
+    );
+
+    $args{'Top'}->parts( [ $args{'Data'} ] );
+    $args{'Top'}->make_singlepart;
 
-    my %res;
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $pid = safe_run_child { $gnupg->verify(
-            handles => $handles, command_args => [ '-', $tmp_fn ]
-        ) };
-        {
-            local $SIG{'PIPE'} = 'IGNORE';
-            $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
-            close $handle{'stdin'};
-        }
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-    if ( $@ || $? ) {
-        $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
-    }
     return %res;
 }
 
 sub DecryptRFC3156 {
+    my $self = shift;
     my %args = (
         Data => undef,
         Info => undef,
@@ -1239,105 +1031,52 @@ sub DecryptRFC3156 {
         @_
     );
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnupGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined($args{'Passphrase'});
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
-    );
-
     if ( $args{'Data'}->bodyhandle->is_encoded ) {
         require RT::EmailParser;
-        RT::EmailParser->_DecodeBody($args{'Data'});
-    }
-
-    $args{'Passphrase'} = GetPassphrase()
-        unless defined $args{'Passphrase'};
-
-    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
-    binmode $tmp_fh, ':raw';
-
-    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
-    my %handle = %$handle_list;
-    $handles->options( 'stdout' )->{'direct'} = 1;
-
-    my %res;
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        $gnupg->passphrase( $args{'Passphrase'} );
-        my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
-        {
-            local $SIG{'PIPE'} = 'IGNORE';
-            $args{'Data'}->bodyhandle->print( $handle{'stdin'} );
-            close $handle{'stdin'}
-        }
-
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
+        RT::EmailParser->_DecodeBody($args{'Data'});
     }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my %res = $self->CallGnuPG(
+        Command     => "decrypt",
+        Handles     => { stdout => $tmp_fh },
+        Passphrase  => $args{'Passphrase'},
+        Content     => $args{'Data'}->bodyhandle,
+    );
 
     # if the decryption is fine but the signature is bad, then without this
     # status check we lose the decrypted text
     # XXX: add argument to the function to control this check
-    if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
-        if ( $@ || $? ) {
-            $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
-            return %res;
-        }
-    }
+    delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
+
+    return %res if $res{message};
 
     seek $tmp_fh, 0, 0;
     my $parser = RT::EmailParser->new();
     my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
     $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
-    $args{'Top'}->parts( [] );
-    $args{'Top'}->add_part( $decrypted );
+
+    $args{'Top'}->parts( [$decrypted] );
     $args{'Top'}->make_singlepart;
+
     return %res;
 }
 
 sub DecryptInline {
+    my $self = shift;
     my %args = (
         Data => undef,
         Passphrase => undef,
         @_
     );
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnuPGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined($args{'Passphrase'});
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
-    );
-
     if ( $args{'Data'}->bodyhandle->is_encoded ) {
         require RT::EmailParser;
         RT::EmailParser->_DecodeBody($args{'Data'});
     }
 
-    $args{'Passphrase'} = GetPassphrase()
-        unless defined $args{'Passphrase'};
-
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw';
 
@@ -1361,9 +1100,8 @@ sub DecryptInline {
             seek $block_fh, 0, 0;
 
             my ($res_fh, $res_fn);
-            ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
+            ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
                 %args,
-                GnuPG => $gnupg,
                 BlockHandle => $block_fh,
             );
             return %res unless $res_fh;
@@ -1398,9 +1136,8 @@ sub DecryptInline {
         seek $block_fh, 0, 0;
 
         my ($res_fh, $res_fn);
-        ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
+        ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
             %args,
-            GnuPG => $gnupg,
             BlockHandle => $block_fh,
         );
         return %res unless $res_fh;
@@ -1419,92 +1156,53 @@ sub DecryptInline {
 }
 
 sub _DecryptInlineBlock {
+    my $self = shift;
     my %args = (
-        GnuPG => undef,
         BlockHandle => undef,
         Passphrase => undef,
         @_
     );
-    my $gnupg = $args{'GnuPG'};
 
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw';
 
-    my ($handles, $handle_list) = _make_gpg_handles(
-            stdin => $args{'BlockHandle'}, 
-            stdout => $tmp_fh);
-    my %handle = %$handle_list;
-    $handles->options( 'stdout' )->{'direct'} = 1;
-    $handles->options( 'stdin' )->{'direct'} = 1;
-
-    my %res;
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        $gnupg->passphrase( $args{'Passphrase'} );
-        my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    my %res = $self->CallGnuPG(
+        Command     => "decrypt",
+        Handles     => { stdout => $tmp_fh, stdin => $args{'BlockHandle'} },
+        Passphrase  => $args{'Passphrase'},
+    );
 
     # if the decryption is fine but the signature is bad, then without this
     # status check we lose the decrypted text
     # XXX: add argument to the function to control this check
-    if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
-        if ( $@ || $? ) {
-            $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
-            return (undef, undef, %res);
-        }
-    }
+    delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
+
+    return (undef, undef, %res) if $res{message};
 
     seek $tmp_fh, 0, 0;
     return ($tmp_fh, $tmp_fn, %res);
 }
 
 sub DecryptAttachment {
+    my $self = shift;
     my %args = (
-        Top  => undef,
         Data => undef,
         Passphrase => undef,
         @_
     );
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnuPGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined($args{'Passphrase'});
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
-    );
-
     if ( $args{'Data'}->bodyhandle->is_encoded ) {
         require RT::EmailParser;
         RT::EmailParser->_DecodeBody($args{'Data'});
     }
 
-    $args{'Passphrase'} = GetPassphrase()
-        unless defined $args{'Passphrase'};
-
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw';
     $args{'Data'}->bodyhandle->print( $tmp_fh );
     seek $tmp_fh, 0, 0;
 
-    my ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
+    my ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
         %args,
-        GnuPG => $gnupg,
         BlockHandle => $tmp_fh,
     );
     return %res unless $res_fh;
@@ -1528,68 +1226,29 @@ sub DecryptAttachment {
 }
 
 sub DecryptContent {
+    my $self = shift;
     my %args = (
         Content => undef,
         Passphrase => undef,
         @_
     );
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-
-    # handling passphrase in GnupGOptions
-    $args{'Passphrase'} = delete $opt{'passphrase'}
-        if !defined($args{'Passphrase'});
-
-    $opt{'digest-algo'} ||= 'SHA1';
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
-    );
-
-    $args{'Passphrase'} = GetPassphrase()
-        unless defined $args{'Passphrase'};
-
     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
     binmode $tmp_fh, ':raw';
 
-    my ($handles, $handle_list) = _make_gpg_handles(
-            stdout => $tmp_fh);
-    my %handle = %$handle_list;
-    $handles->options( 'stdout' )->{'direct'} = 1;
-
-    my %res;
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        $gnupg->passphrase( $args{'Passphrase'} );
-        my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
-        {
-            local $SIG{'PIPE'} = 'IGNORE';
-            print { $handle{'stdin'} } ${ $args{'Content'} };
-            close $handle{'stdin'};
-        }
-
-        waitpid $pid, 0;
-    };
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    my %res = $self->CallGnuPG(
+        Command     => "decrypt",
+        Handles     => { stdout => $tmp_fh },
+        Passphrase  => $args{'Passphrase'},
+        Content     => $args{'Content'},
+    );
 
     # if the decryption is fine but the signature is bad, then without this
     # status check we lose the decrypted text
     # XXX: add argument to the function to control this check
-    if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
-        if ( $@ || $? ) {
-            $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
-            return %res;
-        }
-    }
+    delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
+
+    return %res if $res{'message'};
 
     ${ $args{'Content'} } = '';
     seek $tmp_fh, 0, 0;
@@ -1606,48 +1265,6 @@ sub DecryptContent {
     return %res;
 }
 
-=head2 GetPassphrase [ Address => undef ]
-
-Returns passphrase, called whenever it's required with Address as a named argument.
-
-=cut
-
-sub GetPassphrase {
-    my %args = ( Address => undef, @_ );
-    return 'test';
-}
-
-=head2 ParseStatus
-
-Takes a string containing output of gnupg status stream. Parses it and returns
-array of hashes. Each element of array is a hash ref and represents line or
-group of lines in the status message.
-
-All hashes have Operation, Status and Message elements.
-
-=over
-
-=item Operation
-
-Classification of operations gnupg performs. Now we have support
-for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data
-values.
-
-=item Status
-
-Informs about success. Value is 'DONE' on success, other values means that
-an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other.
-
-=item Message
-
-User friendly message.
-
-=back
-
-This parser is based on information from GnuPG distribution.
-
-=cut
-
 my %REASON_CODE_TO_TEXT = (
     NODATA => {
         1 => "No armored data",
@@ -1723,6 +1340,7 @@ my %ignore_keyword = map { $_ => 1 } qw(
 );
 
 sub ParseStatus {
+    my $self = shift;
     my $status = shift;
     return () unless $status;
 
@@ -1966,52 +1584,10 @@ sub _PrepareGnuPGOptions {
     return %res;
 }
 
-{ my %key;
-# no args -> clear
-# one arg -> return preferred key
-# many -> set
-sub UseKeyForEncryption {
-    unless ( @_ ) {
-        %key = ();
-    } elsif ( @_ > 1 ) {
-        %key = (%key, @_);
-        $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
-    } else {
-        return $key{ $_[0] };
-    }
-    return ();
-} }
-
-=head2 UseKeyForSigning
-
-Returns or sets identifier of the key that should be used for signing.
-
-Returns the current value when called without arguments.
-
-Sets new value when called with one argument and unsets if it's undef.
-
-=cut
-
-{ my $key;
-sub UseKeyForSigning {
-    if ( @_ ) {
-        $key = $_[0];
-    }
-    return $key;
-} }
-
-=head2 GetKeysForEncryption
-
-Takes identifier and returns keys suitable for encryption.
-
-B that keys for which trust level is not set are
-also listed.
-
-=cut
-
 sub GetKeysForEncryption {
-    my $key_id = shift;
-    my %res = GetKeysInfo( $key_id, 'public', @_ );
+    my $self = shift;
+    my %args = (Recipient => undef, @_);
+    my %res = $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
     return %res if $res{'exit_code'};
     return %res unless $res{'info'};
 
@@ -2020,7 +1596,7 @@ sub GetKeysForEncryption {
         next if $key->{'Capabilities'} =~ /D/;
         # skip keys not suitable for encryption
         next unless $key->{'Capabilities'} =~ /e/i;
-        # skip disabled, expired, revoke and keys with no trust,
+        # skip disabled, expired, revoked and keys with no trust,
         # but leave keys with unknown trust level
         next if $key->{'TrustLevel'} < 0;
 
@@ -2031,151 +1607,61 @@ sub GetKeysForEncryption {
 }
 
 sub GetKeysForSigning {
-    my $key_id = shift;
-    return GetKeysInfo( $key_id, 'private', @_ );
-}
-
-sub CheckRecipients {
-    my @recipients = (@_);
-
-    my ($status, @issues) = (1, ());
-
-    my %seen;
-    foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
-        my %res = GetKeysForEncryption( $address );
-        if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
-            # good, one suitable and trusted key 
-            next;
-        }
-        my $user = RT::User->new( RT->SystemUser );
-        $user->LoadByEmail( $address );
-        # it's possible that we have no User record with the email
-        $user = undef unless $user->id;
-
-        if ( my $fpr = UseKeyForEncryption( $address ) ) {
-            if ( $res{'info'} && @{ $res{'info'} } ) {
-                next if
-                    grep lc $_->{'Fingerprint'} eq lc $fpr,
-                    grep $_->{'TrustLevel'} > 0,
-                    @{ $res{'info'} };
-            }
-
-            $status = 0;
-            my %issue = (
-                EmailAddress => $address,
-                $user? (User => $user) : (),
-                Keys => undef,
-            );
-            $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
-            push @issues, \%issue;
-            next;
-        }
-
-        my $prefered_key;
-        $prefered_key = $user->PreferredKey if $user;
-        #XXX: prefered key is not yet implemented...
-
-        # classify errors
-        $status = 0;
-        my %issue = (
-            EmailAddress => $address,
-            $user? (User => $user) : (),
-            Keys => undef,
-        );
-
-        unless ( $res{'info'} && @{ $res{'info'} } ) {
-            # no key
-            $issue{'Message'} = "There is no key suitable for encryption."; #loc
-        }
-        elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
-            # trust is not set
-            $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
-        }
-        else {
-            # multiple keys
-            $issue{'Message'} = "There are several keys suitable for encryption."; #loc
-        }
-        push @issues, \%issue;
-    }
-    return ($status, @issues);
-}
-
-sub GetPublicKeyInfo {
-    return GetKeyInfo( shift, 'public', @_ );
-}
-
-sub GetPrivateKeyInfo {
-    return GetKeyInfo( shift, 'private', @_ );
-}
-
-sub GetKeyInfo {
-    my %res = GetKeysInfo(@_);
-    $res{'info'} = $res{'info'}->[0];
-    return %res;
+    my $self = shift;
+    my %args = (Signer => undef, @_);
+    return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
 }
 
 sub GetKeysInfo {
-    my $email = shift;
-    my $type = shift || 'public';
-    my $force = shift;
+    my $self = shift;
+    my %args = (
+        Key   => undef,
+        Type  => 'public',
+        Force => 0,
+        @_
+    );
 
+    my $email = $args{'Key'};
+    my $type = $args{'Type'};
     unless ( $email ) {
-        return (exit_code => 0) unless $force;
-    }
-
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-    $opt{'digest-algo'} ||= 'SHA1';
-    $opt{'with-colons'} = undef; # parseable format
-    $opt{'fingerprint'} = undef; # show fingerprint
-    $opt{'fixed-list-mode'} = undef; # don't merge uid with keys
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        armor => 1,
-        meta_interactive => 0,
+        return (exit_code => 0) unless $args{'Force'};
+    }
+
+    my @info;
+    my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
+    my %res = $self->CallGnuPG(
+        Options     => {
+            'with-colons'     => undef, # parseable format
+            'fingerprint'     => undef, # show fingerprint
+            'fixed-list-mode' => undef, # don't merge uid with keys
+        },
+        Command     => $method,
+        ( $email ? (CommandArgs => ['--', $email]) : () ),
+        Output      => \@info,
     );
 
-    my %res;
-
-    my ($handles, $handle_list) = _make_gpg_handles();
-    my %handle = %$handle_list;
+    # Asking for a non-existent key is not an error
+    if ($res{message} and $res{logger} =~ /(secret key not available|public key not found)/) {
+        delete $res{exit_code};
+        delete $res{message};
+    }
 
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
-        my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email
-                                                        ? (command_args => [ "--", $email])
-                                                        : () ) };
-        close $handle{'stdin'};
-        waitpid $pid, 0;
-    };
+    return %res if $res{'message'};
 
-    my @info = readline $handle{'stdout'};
-    close $handle{'stdout'};
+    @info = $self->ParseKeysInfo( @info );
+    $res{'info'} = \@info;
 
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    if ( $res{'logger'} && $? ) {
-        $RT::Logger->error( $res{'logger'} );
-        $RT::Logger->error( 'The above error may result from an unconfigured RT/GPG installation. See perldoc etc/RT_Config.pm for information about configuring or disabling GPG support for RT' );
-    }
-    if ( $@ || $? ) {
-        $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
-        return %res;
+    for my $key (@{$res{info}}) {
+        $key->{Formatted} =
+            join("; ", map {$_->{String}} @{$key->{User}})
+                . " (".substr($key->{Fingerprint}, -8) . ")";
     }
 
-    @info = ParseKeysInfo( @info );
-    $res{'info'} = \@info;
     return %res;
 }
 
 sub ParseKeysInfo {
+    my $self = shift;
     my @lines = @_;
 
     my %gpg_opt = RT->Config->Get('GnuPGOptions');
@@ -2209,7 +1695,7 @@ sub ParseKeysInfo {
 
             @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = 
                 _ConvertTrustChar( $info{'OwnerTrustChar'} );
-            $info{ $_ } = _ParseDate( $info{ $_ } )
+            $info{ $_ } = $self->ParseDate( $info{ $_ } )
                 foreach qw(Created Expire);
             push @res, \%info;
         }
@@ -2222,7 +1708,7 @@ sub ParseKeysInfo {
             ) } = split /:/, $line, 12;
             @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = 
                 _ConvertTrustChar( $info{'OwnerTrustChar'} );
-            $info{ $_ } = _ParseDate( $info{ $_ } )
+            $info{ $_ } = $self->ParseDate( $info{ $_ } )
                 foreach qw(Created Expire);
             push @res, \%info;
         }
@@ -2230,7 +1716,7 @@ sub ParseKeysInfo {
             my %info;
             @info{ qw(Trust Created Expire String) }
                 = (split /:/, $line)[0,4,5,8];
-            $info{ $_ } = _ParseDate( $info{ $_ } )
+            $info{ $_ } = $self->ParseDate( $info{ $_ } )
                 foreach qw(Created Expire);
             push @{ $res[-1]{'User'} ||= [] }, \%info;
         }
@@ -2308,173 +1794,97 @@ sub ParseKeysInfo {
     }
 }
 
-sub _ParseDate {
-    my $value = shift;
-    # never
-    return $value unless $value;
-
-    require RT::Date;
-    my $obj = RT::Date->new( RT->SystemUser );
-    # unix time
-    if ( $value =~ /^\d+$/ ) {
-        $obj->Set( Value => $value );
-    } else {
-        $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
-    }
-    return $obj;
-}
-
 sub DeleteKey {
+    my $self = shift;
     my $key = shift;
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
-    );
-
-    my ($handles, $handle_list) = _make_gpg_handles();
-    my %handle = %$handle_list;
-
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $pid = safe_run_child { $gnupg->wrap_call(
-            handles => $handles,
-            commands => ['--delete-secret-and-public-key'],
-            command_args => ["--", $key],
-        ) };
-        close $handle{'stdin'};
-        while ( my $str = readline $handle{'status'} ) {
-            if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
-                print { $handle{'command'} } "y\n";
+    return $self->CallGnuPG(
+        Command     => "--delete-secret-and-public-key",
+        CommandArgs => ["--", $key],
+        Callback    => sub {
+            my %handle = @_;
+            while ( my $str = readline $handle{'status'} ) {
+                if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
+                    print { $handle{'command'} } "y\n";
+                }
             }
-        }
-        waitpid $pid, 0;
-    };
-    my $err = $@;
-    close $handle{'stdout'};
-
-    my %res;
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-    if ( $err || $res{'exit_code'} ) {
-        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
-    }
-    return %res;
+        },
+    );
 }
 
 sub ImportKey {
+    my $self = shift;
     my $key = shift;
 
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
-    $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        meta_interactive => 0,
+    return $self->CallGnuPG(
+        Command     => "import_keys",
+        Content     => $key,
     );
-
-    my ($handles, $handle_list) = _make_gpg_handles();
-    my %handle = %$handle_list;
-
-    eval {
-        local $SIG{'CHLD'} = 'DEFAULT';
-        my $pid = safe_run_child { $gnupg->wrap_call(
-            handles => $handles,
-            commands => ['--import'],
-        ) };
-        print { $handle{'stdin'} } $key;
-        close $handle{'stdin'};
-        waitpid $pid, 0;
-    };
-    my $err = $@;
-    close $handle{'stdout'};
-
-    my %res;
-    $res{'exit_code'} = $?;
-    foreach ( qw(stderr logger status) ) {
-        $res{$_} = do { local $/; readline $handle{$_} };
-        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
-        close $handle{$_};
-    }
-    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
-    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
-    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
-    if ( $err || $res{'exit_code'} ) {
-        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
-    }
-    return %res;
 }
 
-=head2 KEY
-
-Signs a small message with the key, to make sure the key exists and 
-we have a useable passphrase. The first argument MUST be a key identifier
-of the signer: either email address, key id or finger print.
-
-Returns a true value if all went well.
-
-=cut
-
-sub DrySign {
-    my $from = shift;
-
-    my $mime = MIME::Entity->build(
-        Type    => "text/plain",
-        From    => 'nobody@localhost',
-        To      => 'nobody@localhost',
-        Subject => "dry sign",
-        Data    => ['t'],
-    );
-
-    my %res = SignEncrypt(
-        Sign    => 1,
-        Encrypt => 0,
-        Entity  => $mime,
-        Signer  => $from,
-    );
-
-    return $res{exit_code} == 0;
+sub GnuPGPath {
+    state $cache = RT->Config->Get('GnuPG')->{'GnuPG'};
+    $cache = $_[1] if @_ > 1;
+    return $cache;
 }
 
-1;
-
-=head2 Probe
-
-This routine returns true if RT's GnuPG support is configured and working 
-properly (and false otherwise).
-
-
-=cut
+sub Probe {
+    my $self = shift;
+    my $gnupg = GnuPG::Interface->new;
+
+    my $bin = $self->GnuPGPath();
+    unless ($bin) {
+        $RT::Logger->warning(
+            "No gpg path set; GnuPG support has been disabled.  ".
+            "Check the 'GnuPG' configuration in %GnuPG");
+        return 0;
+    }
 
+    if ($bin =~ m{^/}) {
+        unless (-f $bin and -x _) {
+            $RT::Logger->warning(
+                "Invalid gpg path $bin; GnuPG support has been disabled.  ".
+                "Check the 'GnuPG' configuration in %GnuPG");
+            return 0;
+        }
+    } else {
+        local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'
+            unless defined $ENV{PATH};
+        my $path = File::Which::which( $bin );
+        unless ($path) {
+            $RT::Logger->warning(
+                "Can't find gpg binary '$bin' in PATH ($ENV{PATH}); GnuPG support has been disabled.  ".
+                "You may need to specify a full path to gpg via the 'GnuPG' configuration in %GnuPG");
+            return 0;
+        }
+        $self->GnuPGPath( $bin = $path );
+    }
 
-sub Probe {
-    my $gnupg = GnuPG::Interface->new();
-    my %opt = RT->Config->Get('GnuPGOptions');
+    $gnupg->call( $bin );
     $gnupg->options->hash_init(
-        _PrepareGnuPGOptions( %opt ),
-        armor => 1,
-        meta_interactive => 0,
+        _PrepareGnuPGOptions( RT->Config->Get('GnuPGOptions') )
     );
+    $gnupg->options->meta_interactive( 0 );
 
     my ($handles, $handle_list) = _make_gpg_handles();
     my %handle = %$handle_list;
 
-    local $@;
+    local $@ = undef;
     eval {
         local $SIG{'CHLD'} = 'DEFAULT';
-        my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) };
-        close $handle{'stdin'};
+        my $pid = safe_run_child {
+            $gnupg->wrap_call(
+                commands => ['--version' ],
+                handles  => $handles
+            )
+        };
+        close $handle{'stdin'} or die "Can't close gnupg input handle: $!";
         waitpid $pid, 0;
     };
     if ( $@ ) {
+        $RT::Logger->warning(
+            "RT's GnuPG libraries couldn't successfully execute gpg.".
+                " GnuPG support has been disabled");
         $RT::Logger->debug(
             "Probe for GPG failed."
             ." Couldn't run `gpg --version`: ". $@
@@ -2487,15 +1897,18 @@ sub Probe {
 # but there is no way to get actuall error
     if ( $? && ($? >> 8) != 2 ) {
         my $msg = "Probe for GPG failed."
-            ." Process exitted with code ". ($? >> 8)
+            ." Process exited with code ". ($? >> 8)
             . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
             . ".";
         foreach ( qw(stderr logger status) ) {
-            my $tmp = do { local $/; readline $handle{$_} };
+            my $tmp = do { local $/ = undef; readline $handle{$_} };
             next unless $tmp && $tmp =~ /\S/s;
-            close $handle{$_};
+            close $handle{$_} or $tmp .= "\nFailed to close: $!";
             $msg .= "\n$_:\n$tmp\n";
         }
+        $RT::Logger->warning(
+            "RT's GnuPG libraries couldn't successfully execute gpg.".
+                " GnuPG support has been disabled");
         $RT::Logger->debug( $msg );
         return 0;
     }
@@ -2515,15 +1928,4 @@ sub _make_gpg_handles {
 
 RT::Base->_ImportOverlays();
 
-# helper package to avoid using temp file
-package IO::Handle::CRLF;
-
-use base qw(IO::Handle);
-
-sub print {
-    my ($self, @args) = (@_);
-    s/\r*\n/\x0D\x0A/g foreach @args;
-    return $self->SUPER::print( @args );
-}
-
 1;
diff --git a/rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm b/rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm
new file mode 100644
index 0000000..74a4009
--- /dev/null
+++ b/rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm
@@ -0,0 +1,70 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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::Crypt::GnuPG::CRLFHandle;
+use strict;
+use warnings;
+
+use base qw(IO::Handle);
+
+# https://metacpan.org/module/MIME::Tools#Fuzzing-of-CRLF-and-newline-when-encoding-composing
+# means that the output of $entity->print contains lines terminated by
+# "\n"; however, signatures are generated off of the "correct" form of
+# the MIME entity, which uses "\r\n" as the newline separator.  This
+# class, used only when generating signatures, transparently munges "\n"
+# newlines into "\r\n" newlines such that the generated signature is
+# correct for the "\r\n"-newline version of the MIME entity which will
+# eventually be sent over the wire.
+
+sub print {
+    my ($self, @args) = (@_);
+    s/\r*\n/\x0D\x0A/g foreach @args;
+    return $self->SUPER::print( @args );
+}
+
+1;
diff --git a/rt/lib/RT/Crypt/Role.pm b/rt/lib/RT/Crypt/Role.pm
new file mode 100644
index 0000000..b1e368d
--- /dev/null
+++ b/rt/lib/RT/Crypt/Role.pm
@@ -0,0 +1,254 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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::Crypt::Role;
+use Role::Basic;
+
+=head1 NAME
+
+RT::Crypt::Role - Common requirements for encryption implementations
+
+=head1 METHODS
+
+=head2 Probe
+
+This routine is called only if the protocol is enabled, and should
+return true if all binaries required by the protocol are installed.  It
+should produce any warnings necessary to describe any issues it
+encounters.
+
+=cut
+
+requires 'Probe';
+
+=head2 GetPassphrase Address => ADDRESS
+
+Returns the passphrase for the given address.  It looks at the relevant
+configuration option for the encryption protocol
+(e.g. L for GnuPG), and examines the Passphrase key.
+It it does not exist, returns the empty string.  If it is a scalar, it
+returns that value.  If it is an anonymous subroutine, it calls it.  If
+it is a hash, it looks up the address (using '' as a fallback key).
+
+=cut
+
+sub GetPassphrase {
+    my $self = shift;
+    my %args = ( Address => undef, @_ );
+
+    my $class = ref($self) || $self;
+    $class =~ s/^RT::Crypt:://;
+
+    my $config = RT->Config->Get($class)->{Passphrase};
+
+    return '' unless defined $config;
+
+    if (not ref $config) {
+        return $config;
+    } elsif (ref $config eq "HASH") {
+        return $config->{$args{Address}}
+            || $config->{''};
+    } elsif (ref $config eq "CODE") {
+        return $config->( @_ );
+    } else {
+        warn "Unknown Passphrase type for $class: ".ref($config);
+    }
+}
+
+=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ]
+
+Signs and/or encrypts a MIME entity.  All arguments and return values
+are identical to L, with the omission of
+C.
+
+=cut
+
+requires 'SignEncrypt';
+
+=head2 SignEncryptContent Content => STRINGREF, [ Encrypt => 1, Sign => 1, ... ]
+
+Signs and/or encrypts a string, which is passed by reference.  All
+arguments and return values are identical to
+L, with the omission of C.
+
+=cut
+
+requires 'SignEncryptContent';
+
+=head2 VerifyDecrypt Info => HASHREF, [ Passphrase => undef ]
+
+The C key is a hashref as returned from L or
+L.  This method should alter the mime objects
+in-place as necessary during signing and decryption.
+
+Returns a hash with at least the following keys:
+
+=over
+
+=item exit_code
+
+True if there was an error encrypting or signing.
+
+=item message
+
+An un-localized error message desribing the problem.
+
+=back
+
+=cut
+
+requires 'VerifyDecrypt';
+
+=head2 DecryptContent Content => STRINGREF, [ Passphrase => undef ]
+
+Decrypts the content in the string reference in-place.  All arguments
+and return values are identical to L, with the
+omission of C.
+
+=cut
+
+requires 'DecryptContent';
+
+=head2 ParseStatus STRING
+
+Takes a string describing the status of verification/decryption, usually
+as stored in a MIME header.  Parses and returns it as described in
+L.
+
+=cut
+
+requires 'ParseStatus';
+
+=head2 FindScatteredParts Parts => ARRAYREF, Parents => HASHREF, Skip => HASHREF
+
+Passed the list of unclaimed L objects in C, this
+method should examine them as a whole to determine if there are any that
+could not be claimed by the single-entity-at-a-time L
+method.  This is generally only necessary in the case of signatures
+manually attached in parallel, and the like.
+
+If found, the relevant entities should be inserted into C with a
+true value, to signify to other encryption protols that they have been
+claimed.  The method should return a list of hash references, each
+containing a C key which is either C or C.  The
+remaining keys are protocol-dependent; the hashref will be provided to
+L.
+
+=cut
+
+requires 'FindScatteredParts';
+
+=head2 CheckIfProtected Entity => MIME::Entity
+
+Examines the provided L, and returns an empty list if it
+is not signed or encrypted using the protocol.  If it is, returns a hash
+reference containing a C which is either C or
+C.  The remaining keys are protocol-dependent; the hashref will
+be provided to L.
+
+=cut
+
+requires 'CheckIfProtected';
+
+=head2 GetKeysInfo Type => ('public'|'private'), Key => EMAIL
+
+Returns a list of keys matching the email C, as described in
+L.
+
+=cut
+
+requires 'GetKeysInfo';
+
+=head2 GetKeysForEncryption Recipient => EMAIL
+
+Returns a list of keys suitable for encryption, as described in
+L.
+
+=cut
+
+requires 'GetKeysForEncryption';
+
+=head2 GetKeysForSigning Signer => EMAIL
+
+Returns a list of keys suitable for encryption, as described in
+L.
+
+=cut
+
+requires 'GetKeysForSigning';
+
+=head2 ParseDate STRING
+
+Takes a string, and parses and returns a L; if the string is
+purely numeric, assumes is a epoch timestamp.
+
+=cut
+
+sub ParseDate {
+    my $self = shift;
+    my $value = shift;
+
+    # never
+    return $value unless $value;
+
+    require RT::Date;
+    my $obj = RT::Date->new( RT->SystemUser );
+    # unix time
+    if ( $value =~ /^\d+$/ ) {
+        $obj->Set( Value => $value );
+    } else {
+        $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
+    }
+    return $obj;
+}
+
+
+1;
diff --git a/rt/lib/RT/Crypt/SMIME.pm b/rt/lib/RT/Crypt/SMIME.pm
new file mode 100644
index 0000000..a676d8b
--- /dev/null
+++ b/rt/lib/RT/Crypt/SMIME.pm
@@ -0,0 +1,956 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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;
+use 5.010;
+
+package RT::Crypt::SMIME;
+
+use Role::Basic 'with';
+with 'RT::Crypt::Role';
+
+use RT::Crypt;
+use File::Which qw();
+use IPC::Run3 0.036 'run3';
+use RT::Util 'safe_run_child';
+use Crypt::X509;
+use String::ShellQuote 'shell_quote';
+
+=head1 NAME
+
+RT::Crypt::SMIME - encrypt/decrypt and sign/verify email messages with the SMIME
+
+=head1 CONFIGURATION
+
+You should start from reading L.
+
+=head2 %SMIME
+
+    Set( %SMIME,
+        Enable => 1,
+        OpenSSL => '/usr/bin/openssl',
+        Keyring => '/opt/rt4/var/data/smime',
+        CAPath  => '/opt/rt4/var/data/smime/signing-ca.pem',
+        Passphrase => {
+            'queue.address@example.com' => 'passphrase',
+            '' => 'fallback',
+        },
+    );
+
+=head3 OpenSSL
+
+Path to openssl executable.
+
+=head3 Keyring
+
+Path to directory with keys and certificates for queues. Key and
+certificates should be stored in a PEM file named, e.g.,
+F.  See L.
+
+=head3 CAPath
+
+C should be set to either a PEM-formatted certificate of a
+single signing certificate authority, or a directory of such (including
+hash symlinks as created by the openssl tool C).  Only SMIME
+certificates signed by these certificate authorities will be treated as
+valid signatures.  If left unset (and C is unset, as
+it is by default), no signatures will be marked as valid!
+
+=head3 AcceptUntrustedCAs
+
+Allows arbitrary SMIME certificates, no matter their signing entities.
+Such mails will be marked as untrusted, but signed; C will be
+used to mark which mails are signed by trusted certificate authorities.
+This configuration is generally insecure, as it allows the possibility
+of accepting forged mail signed by an untrusted certificate authority.
+
+Setting this option also allows encryption to users with certificates
+created by untrusted CAs.
+
+=head3 Passphrase
+
+C may be set to a scalar (to use for all keys), an anonymous
+function, or a hash (to look up by address).  If the hash is used, the
+'' key is used as a default.
+
+=head2 Keyring configuration
+
+RT looks for keys in the directory configured in the L option
+of the L.  While public certificates are also stored
+on users, private SSL keys are only loaded from disk.  Keys and
+certificates should be concatenated, in in PEM format, in files named
+C, for example.
+
+These files need be readable by the web server user which is running
+RT's web interface; however, if you are running cronjobs or other
+utilities that access RT directly via API, and may generate
+encrypted/signed notifications, then the users you execute these scripts
+under must have access too.
+
+The keyring on disk will be checked before the user with the email
+address is examined.  If the file exists, it will be used in preference
+to the certificate on the user.
+
+=cut
+
+sub OpenSSLPath {
+    state $cache = RT->Config->Get('SMIME')->{'OpenSSL'};
+    $cache = $_[1] if @_ > 1;
+    return $cache;
+}
+
+sub Probe {
+    my $self = shift;
+    my $bin = $self->OpenSSLPath();
+    unless ($bin) {
+        $RT::Logger->warning(
+            "No openssl path set; SMIME support has been disabled.  ".
+            "Check the 'OpenSSL' configuration in %OpenSSL");
+        return 0;
+    }
+
+    if ($bin =~ m{^/}) {
+        unless (-f $bin and -x _) {
+            $RT::Logger->warning(
+                "Invalid openssl path $bin; SMIME support has been disabled.  ".
+                "Check the 'OpenSSL' configuration in %OpenSSL");
+            return 0;
+        }
+    } else {
+        local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'
+            unless defined $ENV{PATH};
+        my $path = File::Which::which( $bin );
+        unless ($path) {
+            $RT::Logger->warning(
+                "Can't find openssl binary '$bin' in PATH ($ENV{PATH}); SMIME support has been disabled.  ".
+                "You may need to specify a full path to opensssl via the 'OpenSSL' configuration in %OpenSSL");
+            return 0;
+        }
+        $self->OpenSSLPath( $bin = $path );
+    }
+
+    {
+        my ($buf, $err) = ('', '');
+
+        local $SIG{'CHLD'} = 'DEFAULT';
+        safe_run_child { run3( [$bin, "list-standard-commands"],
+            \undef,
+            \$buf, \$err
+        ) };
+
+        if ($? or $err) {
+            $RT::Logger->warning(
+                "RT's SMIME libraries couldn't successfully execute openssl.".
+                    " SMIME support has been disabled") ;
+            return;
+        } elsif ($buf !~ /\bsmime\b/) {
+            $RT::Logger->warning(
+                "openssl does not include smime support.".
+                    " SMIME support has been disabled");
+            return;
+        } else {
+            return 1;
+        }
+    }
+}
+
+sub SignEncrypt {
+    my $self = shift;
+    my %args = (
+        Entity => undef,
+
+        Sign => 1,
+        Signer => undef,
+        Passphrase => undef,
+
+        Encrypt => 1,
+        Recipients => undef,
+
+        @_
+    );
+
+    my $entity = $args{'Entity'};
+
+    if ( $args{'Encrypt'} ) {
+        my %seen;
+        $args{'Recipients'} = [
+            grep !$seen{$_}++, map $_->address, map Email::Address->parse(Encode::decode("UTF-8",$_)),
+            grep defined && length, map $entity->head->get($_), qw(To Cc Bcc)
+        ];
+    }
+
+    $entity->make_multipart('mixed', Force => 1);
+    my ($buf, %res) = $self->_SignEncrypt(
+        %args,
+        Content => \$entity->parts(0)->stringify,
+    );
+    unless ( $buf ) {
+        $entity->make_singlepart;
+        return %res;
+    }
+
+    my $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
+    my $parser = MIME::Parser->new();
+    $parser->output_dir($tmpdir);
+    my $newmime = $parser->parse_data($$buf);
+
+    # Work around https://rt.cpan.org/Public/Bug/Display.html?id=87835
+    for my $part (grep {$_->is_multipart and $_->preamble and @{$_->preamble}} $newmime->parts_DFS) {
+        $part->preamble->[-1] .= "\n"
+            if $part->preamble->[-1] =~ /\r$/;
+    }
+
+    $entity->parts([$newmime]);
+    $entity->make_singlepart;
+
+    return %res;
+}
+
+sub SignEncryptContent {
+    my $self = shift;
+    my %args = (
+        Content => undef,
+        @_
+    );
+
+    my ($buf, %res) = $self->_SignEncrypt(%args);
+    ${ $args{'Content'} } = $$buf if $buf;
+    return %res;
+}
+
+sub _SignEncrypt {
+    my $self = shift;
+    my %args = (
+        Content => undef,
+
+        Sign => 1,
+        Signer => undef,
+        Passphrase => undef,
+
+        Encrypt => 1,
+        Recipients => [],
+
+        @_
+    );
+
+    my %res = (exit_code => 0, status => '');
+
+    my @keys;
+    if ( $args{'Encrypt'} ) {
+        my @addresses = @{ $args{'Recipients'} };
+
+        foreach my $address ( @addresses ) {
+            $RT::Logger->debug( "Considering encrypting message to " . $address );
+
+            my %key_info = $self->GetKeysInfo( Key => $address );
+            unless ( defined $key_info{'info'} ) {
+                $res{'exit_code'} = 1;
+                my $reason = 'Key not found';
+                $res{'status'} .= $self->FormatStatus({
+                    Operation => "RecipientsCheck", Status => "ERROR",
+                    Message => "Recipient '$address' is unusable, the reason is '$reason'",
+                    Recipient => $address,
+                    Reason => $reason,
+                });
+                next;
+            }
+
+            if ( not $key_info{'info'}[0]{'Expire'} ) {
+                # we continue here as it's most probably a problem with the key,
+                # so later during encryption we'll get verbose errors
+                $RT::Logger->error(
+                    "Trying to send an encrypted message to ". $address
+                    .", but we couldn't get expiration date of the key."
+                );
+            }
+            elsif ( $key_info{'info'}[0]{'Expire'}->Diff( time ) < 0 ) {
+                $res{'exit_code'} = 1;
+                my $reason = 'Key expired';
+                $res{'status'} .= $self->FormatStatus({
+                    Operation => "RecipientsCheck", Status => "ERROR",
+                    Message => "Recipient '$address' is unusable, the reason is '$reason'",
+                    Recipient => $address,
+                    Reason => $reason,
+                });
+                next;
+            }
+            push @keys, $key_info{'info'}[0]{'Content'};
+        }
+    }
+    return (undef, %res) if $res{'exit_code'};
+
+    my $opts = RT->Config->Get('SMIME');
+
+    my @commands;
+    if ( $args{'Sign'} ) {
+        my $file = $self->CheckKeyring( Key => $args{'Signer'} );
+        unless ($file) {
+            $res{'status'} .= $self->FormatStatus({
+                Operation => "KeyCheck", Status => "MISSING",
+                Message   => "Secret key for $args{Signer} is not available",
+                Key       => $args{Signer},
+                KeyType   => "secret",
+            });
+            $res{exit_code} = 1;
+            return (undef, %res);
+        }
+        $args{'Passphrase'} = $self->GetPassphrase( Address => $args{'Signer'} )
+            unless defined $args{'Passphrase'};
+
+        push @commands, [
+            $self->OpenSSLPath, qw(smime -sign),
+            -signer => $file,
+            -inkey  => $file,
+            (defined $args{'Passphrase'} && length $args{'Passphrase'})
+                ? (qw(-passin env:SMIME_PASS))
+                : (),
+        ];
+    }
+    if ( $args{'Encrypt'} ) {
+        foreach my $key ( @keys ) {
+            my $key_file = File::Temp->new;
+            print $key_file $key;
+            close $key_file;
+            $key = $key_file;
+        }
+        push @commands, [
+            $self->OpenSSLPath, qw(smime -encrypt -des3),
+            map { $_->filename } @keys
+        ];
+    }
+
+    my $buf = ${ $args{'Content'} };
+    for my $command (@commands) {
+        my ($out, $err) = ('', '');
+        {
+            local $ENV{'SMIME_PASS'} = $args{'Passphrase'};
+            local $SIG{'CHLD'} = 'DEFAULT';
+            safe_run_child { run3(
+                $command,
+                \$buf,
+                \$out, \$err
+            ) };
+        }
+
+        $RT::Logger->debug( "openssl stderr: " . $err ) if length $err;
+
+        # copy output from the first command to the second command
+        # similar to the pipe we used to use to pipe signing -> encryption
+        # Using the pipe forced us to invoke the shell, this avoids any use of shell.
+        $buf = $out;
+    }
+
+    if ($buf) {
+        $res{'status'} .= $self->FormatStatus({
+            Operation => "Sign", Status => "DONE",
+            Message => "Signed message",
+        }) if $args{'Sign'};
+        $res{'status'} .= $self->FormatStatus({
+            Operation => "Encrypt", Status => "DONE",
+            Message => "Data has been encrypted",
+        }) if $args{'Encrypt'};
+    }
+
+    return (\$buf, %res);
+}
+
+sub VerifyDecrypt {
+    my $self = shift;
+    my %args = ( Info => undef, @_ );
+
+    my %res;
+    my $item = $args{'Info'};
+    if ( $item->{'Type'} eq 'signed' ) {
+        %res = $self->Verify( %$item );
+    } elsif ( $item->{'Type'} eq 'encrypted' ) {
+        %res = $self->Decrypt( %args, %$item );
+    } else {
+        die "Unknown type '". $item->{'Type'} ."' of protected item";
+    }
+
+    return (%res, status_on => $item->{'Data'});
+}
+
+sub Verify {
+    my $self = shift;
+    my %args = (Data => undef, @_ );
+
+    my $msg = $args{'Data'}->as_string;
+
+    my %res;
+    my $buf;
+    my $keyfh = File::Temp->new;
+    {
+        local $SIG{CHLD} = 'DEFAULT';
+        my $cmd = [
+            $self->OpenSSLPath, qw(smime -verify -noverify),
+            '-signer', $keyfh->filename,
+        ];
+        safe_run_child { run3( $cmd, \$msg, \$buf, \$res{'stderr'} ) };
+        $res{'exit_code'} = $?;
+    }
+    if ( $res{'exit_code'} ) {
+        if ($res{stderr} =~ /(signature|digest) failure/) {
+            $res{'message'} = "Validation failed";
+            $res{'status'} = $self->FormatStatus({
+                Operation => "Verify", Status => "BAD",
+                Message => "The signature did not verify",
+            });
+        } else {
+            $res{'message'} = "openssl exited with error code ". ($? >> 8)
+                ." and error: $res{stderr}";
+            $res{'status'} = $self->FormatStatus({
+                Operation => "Verify", Status => "ERROR",
+                Message => "There was an error verifying: $res{stderr}",
+            });
+            $RT::Logger->error($res{'message'});
+        }
+        return %res;
+    }
+
+    my $signer;
+    if ( my $key = do { $keyfh->seek(0, 0); local $/; readline $keyfh } ) {{
+        my %info = $self->GetCertificateInfo( Certificate => $key );
+
+        $signer = $info{info}[0];
+        last unless $signer and $signer->{User}[0]{String};
+
+        unless ( $info{info}[0]{TrustLevel} > 0 or RT->Config->Get('SMIME')->{AcceptUntrustedCAs}) {
+            # We don't trust it; give it the finger
+            $res{exit_code} = 1;
+            $res{'message'} = "Validation failed";
+            $res{'status'} = $self->FormatStatus({
+                Operation => "Verify", Status => "BAD",
+                Message => "The signing CA was not trusted",
+                UserString => $signer->{User}[0]{String},
+                Trust => "NONE",
+            });
+            return %res;
+        }
+
+        my $user = RT::User->new( $RT::SystemUser );
+        $user->LoadOrCreateByEmail( $signer->{User}[0]{String} );
+        my $current_key = $user->SMIMECertificate;
+        last if $current_key && $current_key eq $key;
+
+        # Never over-write existing keys with untrusted ones.
+        last if $current_key and not $info{info}[0]{TrustLevel} > 0;
+
+        my ($status, $msg) = $user->SetSMIMECertificate( $key );
+        $RT::Logger->error("Couldn't set SMIME certificate for user #". $user->id .": $msg")
+            unless $status;
+    }}
+
+    my $res_entity = _extract_msg_from_buf( \$buf );
+    unless ( $res_entity ) {
+        $res{'exit_code'} = 1;
+        $res{'message'} = "verified message, but couldn't parse result";
+        $res{'status'} = $self->FormatStatus({
+            Operation => "Verify", Status => "DONE",
+            Message => "The signature is good, unknown signer",
+            Trust => "UNKNOWN",
+        });
+        return %res;
+    }
+
+    $res_entity->make_multipart( 'mixed', Force => 1 );
+
+    $args{'Data'}->make_multipart( 'mixed', Force => 1 );
+    $args{'Data'}->parts([ $res_entity->parts ]);
+    $args{'Data'}->make_singlepart;
+
+    $res{'status'} = $self->FormatStatus({
+        Operation => "Verify", Status => "DONE",
+        Message => "The signature is good, signed by ".$signer->{User}[0]{String}.", trust is ".$signer->{TrustTerse},
+        UserString => $signer->{User}[0]{String},
+        Trust => uc($signer->{TrustTerse}),
+    });
+
+    return %res;
+}
+
+sub Decrypt {
+    my $self = shift;
+    my %args = (Data => undef, Queue => undef, @_ );
+
+    my $msg = $args{'Data'}->as_string;
+
+    push @{ $args{'Recipients'} ||= [] },
+        $args{'Queue'}->CorrespondAddress, RT->Config->Get('CorrespondAddress'),
+        $args{'Queue'}->CommentAddress, RT->Config->Get('CommentAddress')
+    ;
+
+    my ($buf, %res) = $self->_Decrypt( %args, Content => \$args{'Data'}->as_string );
+    return %res unless $buf;
+
+    my $res_entity = _extract_msg_from_buf( $buf );
+    $res_entity->make_multipart( 'mixed', Force => 1 );
+
+    # Work around https://rt.cpan.org/Public/Bug/Display.html?id=87835
+    for my $part (grep {$_->is_multipart and $_->preamble and @{$_->preamble}} $res_entity->parts_DFS) {
+        $part->preamble->[-1] .= "\n"
+            if $part->preamble->[-1] =~ /\r$/;
+    }
+
+    $args{'Data'}->make_multipart( 'mixed', Force => 1 );
+    $args{'Data'}->parts([ $res_entity->parts ]);
+    $args{'Data'}->make_singlepart;
+
+    return %res;
+}
+
+sub DecryptContent {
+    my $self = shift;
+    my %args = (
+        Content => undef,
+        @_
+    );
+
+    my ($buf, %res) = $self->_Decrypt( %args );
+    ${ $args{'Content'} } = $$buf if $buf;
+    return %res;
+}
+
+sub _Decrypt {
+    my $self = shift;
+    my %args = (Content => undef, @_ );
+
+    my %seen;
+    my @addresses =
+        grep !$seen{lc $_}++, map $_->address, map Email::Address->parse($_),
+        grep length && defined, @{$args{'Recipients'}};
+
+    my ($buf, $encrypted_to, %res);
+
+    foreach my $address ( @addresses ) {
+        my $file = $self->CheckKeyring( Key => $address );
+        unless ( $file ) {
+            my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
+            $RT::Logger->debug("No key found for $address in $keyring directory");
+            next;
+        }
+
+        local $ENV{SMIME_PASS} = $self->GetPassphrase( Address => $address );
+        local $SIG{CHLD} = 'DEFAULT';
+        my $cmd = [
+            $self->OpenSSLPath,
+            qw(smime -decrypt),
+            -recip => $file,
+            (defined $ENV{'SMIME_PASS'} && length $ENV{'SMIME_PASS'})
+                ? (qw(-passin env:SMIME_PASS))
+                : (),
+        ];
+        safe_run_child { run3( $cmd, $args{'Content'}, \$buf, \$res{'stderr'} ) };
+        unless ( $? ) {
+            $encrypted_to = $address;
+            $RT::Logger->debug("Message encrypted for $encrypted_to");
+            last;
+        }
+
+        if ( index($res{'stderr'}, 'no recipient matches key') >= 0 ) {
+            $RT::Logger->debug("Although we have a key for $address, it is not the one that encrypted this message");
+            next;
+        }
+
+        $res{'exit_code'} = $?;
+        $res{'message'} = "openssl exited with error code ". ($? >> 8)
+            ." and error: $res{stderr}";
+        $RT::Logger->error( $res{'message'} );
+        $res{'status'} = $self->FormatStatus({
+            Operation => 'Decrypt', Status => 'ERROR',
+            Message => 'Decryption failed',
+            EncryptedTo => $address,
+        });
+        return (undef, %res);
+    }
+    unless ( $encrypted_to ) {
+        $RT::Logger->error("Couldn't find SMIME key for addresses: ". join ', ', @addresses);
+        $res{'exit_code'} = 1;
+        $res{'status'} = $self->FormatStatus({
+            Operation => 'KeyCheck',
+            Status    => 'MISSING',
+            Message   => "Secret key is not available",
+            KeyType   => 'secret',
+        });
+        return (undef, %res);
+    }
+
+    $res{'status'} = $self->FormatStatus({
+        Operation => 'Decrypt', Status => 'DONE',
+        Message => 'Decryption process succeeded',
+        EncryptedTo => $encrypted_to,
+    });
+
+    return (\$buf, %res);
+}
+
+sub FormatStatus {
+    my $self = shift;
+    my @status = @_;
+
+    my $res = '';
+    foreach ( @status ) {
+        while ( my ($k, $v) = each %$_ ) {
+            $res .= "[SMIME:]". $k .": ". $v ."\n";
+        }
+        $res .= "[SMIME:]\n";
+    }
+
+    return $res;
+}
+
+sub ParseStatus {
+    my $self = shift;
+    my $status = shift;
+    return () unless $status;
+
+    my @status = split /\s*(?:\[SMIME:\]\s*){2}/, $status;
+    foreach my $block ( grep length, @status ) {
+        chomp $block;
+        $block = { map { s/^\s+//; s/\s+$//; $_ } map split(/:/, $_, 2), split /\s*\[SMIME:\]/, $block };
+    }
+    foreach my $block ( grep $_->{'EncryptedTo'}, @status ) {
+        $block->{'EncryptedTo'} = [{
+            EmailAddress => $block->{'EncryptedTo'},  
+        }];
+    }
+
+    return @status;
+}
+
+sub _extract_msg_from_buf {
+    my $buf = shift;
+    my $rtparser = RT::EmailParser->new();
+    my $parser   = MIME::Parser->new();
+    $rtparser->_SetupMIMEParser($parser);
+    $parser->decode_bodies(0);
+    $parser->output_to_core(1);
+    unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) {
+        $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages");
+
+        # Try again, this time without extracting nested messages
+        $parser->extract_nested_messages(0);
+        unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) {
+            $RT::Logger->crit("couldn't parse MIME stream");
+            return (undef);
+        }
+    }
+    return $rtparser->Entity;
+}
+
+sub FindScatteredParts { return () }
+
+sub CheckIfProtected {
+    my $self = shift;
+    my %args = ( Entity => undef, @_ );
+
+    my $entity = $args{'Entity'};
+
+    my $type = $entity->effective_type;
+    if ( $type =~ m{^application/(?:x-)?pkcs7-mime$} || $type eq 'application/octet-stream' ) {
+        # RFC3851 ch.3.9 variant 1 and 3
+
+        my $security_type;
+
+        my $smime_type = $entity->head->mime_attr('Content-Type.smime-type');
+        if ( $smime_type ) { # it's optional according to RFC3851
+            if ( $smime_type eq 'enveloped-data' ) {
+                $security_type = 'encrypted';
+            }
+            elsif ( $smime_type eq 'signed-data' ) {
+                $security_type = 'signed';
+            }
+            elsif ( $smime_type eq 'certs-only' ) {
+                $security_type = 'certificate management';
+            }
+            elsif ( $smime_type eq 'compressed-data' ) {
+                $security_type = 'compressed';
+            }
+            else {
+                $security_type = $smime_type;
+            }
+        }
+
+        unless ( $security_type ) {
+            my $fname = $entity->head->recommended_filename || '';
+            if ( $fname =~ /\.p7([czsm])$/ ) {
+                my $type_char = $1;
+                if ( $type_char eq 'm' ) {
+                    # RFC3851, ch3.4.2
+                    # it can be both encrypted and signed
+                    $security_type = 'encrypted';
+                }
+                elsif ( $type_char eq 's' ) {
+                    # RFC3851, ch3.4.3, multipart/signed, XXX we should never be here
+                    # unless message is changed by some gateway
+                    $security_type = 'signed';
+                }
+                elsif ( $type_char eq 'c' ) {
+                    # RFC3851, ch3.7
+                    $security_type = 'certificate management';
+                }
+                elsif ( $type_char eq 'z' ) {
+                    # RFC3851, ch3.5
+                    $security_type = 'compressed';
+                }
+            }
+        }
+        return () unless $security_type;
+
+        my %res = (
+            Type   => $security_type,
+            Format => 'RFC3851',
+            Data   => $entity,
+        );
+
+        if ( $security_type eq 'encrypted' ) {
+            my $top = $args{'TopEntity'}->head;
+            $res{'Recipients'} = [map {Encode::decode("UTF-8", $_)}
+                                      grep defined && length, map $top->get($_), 'To', 'Cc'];
+        }
+
+        return %res;
+    }
+    elsif ( $type eq 'multipart/signed' ) {
+        # RFC3156, multipart/signed
+        # RFC3851, ch.3.9 variant 2
+
+        unless ( $entity->parts == 2 ) {
+            $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
+            return ();
+        }
+
+        my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
+        unless ( $protocol ) {
+            $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
+            return ();
+        }
+
+        unless ( $protocol =~ m{^application/(x-)?pkcs7-signature$} ) {
+            $RT::Logger->info( "Skipping protocol '$protocol', only 'application/x-pkcs7-signature' is supported" );
+            return ();
+        }
+        $RT::Logger->debug("Found part signed according to RFC3156");
+        return (
+            Type      => 'signed',
+            Format    => 'RFC3156',
+            Data      => $entity,
+        );
+    }
+    return ();
+}
+
+sub GetKeysForEncryption {
+    my $self = shift;
+    my %args = (Recipient => undef, @_);
+    return $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
+}
+
+sub GetKeysForSigning {
+    my $self = shift;
+    my %args = (Signer => undef, @_);
+    return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
+}
+
+sub GetKeysInfo {
+    my $self = shift;
+    my %args = (
+        Key   => undef,
+        Type  => 'public',
+        Force => 0,
+        @_
+    );
+
+    my $email = $args{'Key'};
+    unless ( $email ) {
+        return (exit_code => 0); # unless $args{'Force'};
+    }
+
+    my $key = $self->GetKeyContent( %args );
+    return (exit_code => 0) unless $key;
+
+    return $self->GetCertificateInfo( Certificate => $key );
+}
+
+sub GetKeyContent {
+    my $self = shift;
+    my %args = ( Key => undef, @_ );
+
+    my $key;
+    if ( my $file = $self->CheckKeyring( %args ) ) {
+        open my $fh, '<:raw', $file
+            or die "Couldn't open file '$file': $!";
+        $key = do { local $/; readline $fh };
+        close $fh;
+    }
+    else {
+        my $user = RT::User->new( RT->SystemUser );
+        $user->LoadByEmail( $args{'Key'} );
+        $key = $user->SMIMECertificate if $user->id;
+    }
+    return $key;
+}
+
+sub CheckKeyring {
+    my $self = shift;
+    my %args = (
+        Key => undef,
+        @_,
+    );
+    my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
+    return undef unless $keyring;
+
+    my $file = File::Spec->catfile( $keyring, $args{'Key'} .'.pem' );
+    return undef unless -f $file;
+
+    return $file;
+}
+
+sub GetCertificateInfo {
+    my $self = shift;
+    my %args = (
+        Certificate => undef,
+        @_,
+    );
+
+    if ($args{Certificate} =~ /^-----BEGIN \s+ CERTIFICATE----- \s* $
+                                (.*?)
+                               ^-----END \s+ CERTIFICATE----- \s* $/smx) {
+        $args{Certificate} = MIME::Base64::decode_base64($1);
+    }
+
+    my $cert = Crypt::X509->new( cert => $args{Certificate} );
+    return ( exit_code => 1, stderr => $cert->error ) if $cert->error;
+
+    my %USER_MAP = (
+        Country          => 'country',
+        StateOrProvince  => 'state',
+        Organization     => 'org',
+        OrganizationUnit => 'ou',
+        Name             => 'cn',
+        EmailAddress     => 'email',
+    );
+    my $canonicalize = sub {
+        my $type = shift;
+        my %data;
+        for (keys %USER_MAP) {
+            my $method = $type . "_" . $USER_MAP{$_};
+            $data{$_} = $cert->$method if $cert->can($method);
+        }
+        $data{String} = Email::Address->new( @data{'Name', 'EmailAddress'} )->format
+            if $data{EmailAddress};
+        return \%data;
+    };
+
+    my $PEM = "-----BEGIN CERTIFICATE-----\n"
+        . MIME::Base64::encode_base64( $args{Certificate} )
+        . "-----END CERTIFICATE-----\n";
+
+    my %res = (
+        exit_code => 0,
+        info => [ {
+            Content         => $PEM,
+            Fingerprint     => Digest::SHA::sha1_hex($args{Certificate}),
+            'Serial Number' => $cert->serial,
+            Created         => $self->ParseDate( $cert->not_before ),
+            Expire          => $self->ParseDate( $cert->not_after ),
+            Version         => sprintf("%d (0x%x)",hex($cert->version || 0)+1, hex($cert->version || 0)),
+            Issuer          => [ $canonicalize->( 'issuer' ) ],
+            User            => [ $canonicalize->( 'subject' ) ],
+        } ],
+        stderr => ''
+    );
+
+    # Check the validity
+    my $ca = RT->Config->Get('SMIME')->{'CAPath'};
+    if ($ca) {
+        my @ca_verify;
+        if (-d $ca) {
+            @ca_verify = ('-CApath', $ca);
+        } elsif (-f $ca) {
+            @ca_verify = ('-CAfile', $ca);
+        }
+
+        local $SIG{CHLD} = 'DEFAULT';
+        my $cmd = [
+            $self->OpenSSLPath,
+            'verify', @ca_verify,
+        ];
+        my $buf = '';
+        safe_run_child { run3( $cmd, \$PEM, \$buf, \$res{stderr} ) };
+
+        if ($buf =~ /^stdin: OK$/) {
+            $res{info}[0]{Trust} = "Signed by trusted CA $res{info}[0]{Issuer}[0]{String}";
+            $res{info}[0]{TrustTerse} = "full";
+            $res{info}[0]{TrustLevel} = 2;
+        } elsif ($? == 0 or ($? >> 8) == 2) {
+            $res{info}[0]{Trust} = "UNTRUSTED signing CA $res{info}[0]{Issuer}[0]{String}";
+            $res{info}[0]{TrustTerse} = "none";
+            $res{info}[0]{TrustLevel} = -1;
+        } else {
+            $res{exit_code} = $?;
+            $res{message} = "openssl exited with error code ". ($? >> 8)
+                ." and stout: $buf";
+            $res{info}[0]{Trust} = "unknown (openssl failed)";
+            $res{info}[0]{TrustTerse} = "unknown";
+            $res{info}[0]{TrustLevel} = 0;
+        }
+    } else {
+        $res{info}[0]{Trust} = "unknown (no CAPath set)";
+        $res{info}[0]{TrustTerse} = "unknown";
+        $res{info}[0]{TrustLevel} = 0;
+    }
+
+    $res{info}[0]{Formatted} = $res{info}[0]{User}[0]{String}
+        . " (issued by $res{info}[0]{Issuer}[0]{String})";
+
+    return %res;
+}
+
+1;
diff --git a/rt/lib/RT/CurrentUser.pm b/rt/lib/RT/CurrentUser.pm
index 99a0641..a4b5dc0 100755
--- a/rt/lib/RT/CurrentUser.pm
+++ b/rt/lib/RT/CurrentUser.pm
@@ -88,14 +88,13 @@ passed to Load method.
 
 package RT::CurrentUser;
 
-use RT::I18N;
-
 use strict;
 use warnings;
 
-
 use base qw/RT::User/;
 
+use RT::I18N;
+
 #The basic idea here is that $self->CurrentUser is always supposed
 # to be a CurrentUser object. but that's hard to do when we're trying to load
 # the CurrentUser object
@@ -268,44 +267,8 @@ sub CurrentUser {
     return shift;
 }
 
-=head2 Authenticate
-
-Takes $password, $created and $nonce, and returns a boolean value
-representing whether the authentication succeeded.
-
-If both $nonce and $created are specified, validate $password against:
-
-    encode_base64(sha1(
-        $nonce .
-        $created .
-        sha1_hex( "$username:$realm:$server_pass" )
-    ))
-
-where $server_pass is the md5_hex(password) digest stored in the
-database, $created is in ISO time format, and $nonce is a random
-string no longer than 32 bytes.
-
-=cut
-
-sub Authenticate { 
-    my ($self, $password, $created, $nonce, $realm) = @_;
-
-    require Digest::MD5;
-    require Digest::SHA1;
-    require MIME::Base64;
-
-    my $username = $self->UserObj->Name or return;
-    my $server_pass = $self->UserObj->__Value('Password') or return;
-    my $auth_digest = MIME::Base64::encode_base64(Digest::SHA1::sha1(
-        $nonce .
-        $created .
-        Digest::MD5::md5_hex("$username:$realm:$server_pass")
-    ));
-
-    chomp($password);
-    chomp($auth_digest);
-
-    return ($password eq $auth_digest);
+sub CustomFieldLookupType {
+    return "RT::User";
 }
 
 RT::Base->_ImportOverlays();
diff --git a/rt/lib/RT/CustomField.pm b/rt/lib/RT/CustomField.pm
index de912ed..6b9d57b 100644
--- a/rt/lib/RT/CustomField.pm
+++ b/rt/lib/RT/CustomField.pm
@@ -50,14 +50,18 @@ package RT::CustomField;
 
 use strict;
 use warnings;
+use 5.010;
 
 use Scalar::Util 'blessed';
 
 use base 'RT::Record';
 
-sub Table {'CustomFields'}
+use Role::Basic 'with';
+with "RT::Record::Role::Rights";
 
+sub Table {'CustomFields'}
 
+use Scalar::Util qw(blessed);
 use RT::CustomFieldValues;
 use RT::ObjectCustomFields;
 use RT::ObjectCustomFieldValues;
@@ -67,9 +71,9 @@ our %FieldTypes = (
         sort_order => 10,
         selection_type => 1,
 
-        labels => [ 'Select multiple values',      # loc
-                    'Select one value',            # loc
-                    'Select up to [_1] values',    # loc
+        labels => [ 'Select multiple values',               # loc
+                    'Select one value',                     # loc
+                    'Select up to [quant,_1,value,values]', # loc
                   ],
 
         render_types => {
@@ -90,27 +94,27 @@ our %FieldTypes = (
         sort_order => 20,
         selection_type => 0,
 
-        labels => [ 'Enter multiple values',       # loc
-                    'Enter one value',             # loc
-                    'Enter up to [_1] values',     # loc
+        labels => [ 'Enter multiple values',               # loc
+                    'Enter one value',                     # loc
+                    'Enter up to [quant,_1,value,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
+                    'Fill in multiple text areas',                   # loc
+                    'Fill in one text area',                         # loc
+                    'Fill in up to [quant,_1,text area,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
+                    'Fill in multiple wikitext areas',                       # loc
+                    'Fill in one wikitext area',                             # loc
+                    'Fill in up to [quant,_1,wikitext area,wikitext areas]', # loc
                   ]
                 },
 
@@ -120,16 +124,16 @@ our %FieldTypes = (
         labels         => [
                     'Upload multiple images',               # loc
                     'Upload one image',                     # loc
-                    'Upload up to [_1] images',             # loc
+                    'Upload up to [quant,_1,image,images]', # loc
                   ]
              },
     Binary => {
         sort_order => 60,
         selection_type => 0,
         labels         => [
-                    'Upload multiple files',                # loc
-                    'Upload one file',                      # loc
-                    'Upload up to [_1] files',              # loc
+                    'Upload multiple files',              # loc
+                    'Upload one file',                    # loc
+                    'Upload up to [quant,_1,file,files]', # loc
                   ]
               },
 
@@ -137,18 +141,18 @@ our %FieldTypes = (
         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
+                    'Combobox: Select or enter multiple values',               # loc
+                    'Combobox: Select or enter one value',                     # loc
+                    'Combobox: Select or enter up to [quant,_1,value,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
+                    'Enter multiple values with autocompletion',               # loc
+                    'Enter one value with autocompletion',                     # loc
+                    'Enter up to [quant,_1,value,values] with autocompletion', # loc
                   ]
     },
 
@@ -156,18 +160,18 @@ our %FieldTypes = (
         sort_order => 90,
         selection_type => 0,
         labels         => [
-                    'Select multiple dates',                          # loc
-                    'Select date',                                    # loc
-                    'Select up to [_1] dates',                        # loc
+                    'Select multiple dates',              # loc
+                    'Select date',                        # loc
+                    'Select up to [quant,_1,date,dates]', # loc
                   ]
             },
     DateTime => {
         sort_order => 100,
         selection_type => 0,
         labels         => [
-                    'Select multiple datetimes',                      # loc
-                    'Select datetime',                                # loc
-                    'Select up to [_1] datetimes',                    # loc
+                    'Select multiple datetimes',                  # loc
+                    'Select datetime',                            # loc
+                    'Select up to [quant,_1,datetime,datetimes]', # loc
                   ]
                 },
     TimeValue => {
@@ -184,95 +188,41 @@ our %FieldTypes = (
         sort_order => 110,
         selection_type => 0,
 
-        labels => [ 'Enter multiple IP addresses',       # loc
-                    'Enter one IP address',             # loc
-                    'Enter up to [_1] IP addresses',     # loc
+        labels => [ 'Enter multiple IP addresses',                    # loc
+                    'Enter one IP address',                           # loc
+                    'Enter up to [quant,_1,IP address,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
+        labels => [ 'Enter multiple IP address ranges',                          # loc
+                    'Enter one IP address range',                                # loc
+                    'Enter up to [quant,_1,IP address range,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.
+my %BUILTIN_GROUPINGS;
+my %FRIENDLY_LOOKUP_TYPES = ();
 
-=cut
-
-sub RightCategories {
-    return $RIGHT_CATEGORIES;
-}
+__PACKAGE__->RegisterLookupType( 'RT::Queue-RT::Ticket' => "Tickets", );    #loc
+__PACKAGE__->RegisterLookupType( 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", ); #loc
+__PACKAGE__->RegisterLookupType( 'RT::User'  => "Users", );                           #loc
+__PACKAGE__->RegisterLookupType( 'RT::Queue'  => "Queues", );                         #loc
+__PACKAGE__->RegisterLookupType( 'RT::Group' => "Groups", );                          #loc
 
-=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
+__PACKAGE__->RegisterBuiltInGroupings(
+    'RT::Ticket'    => [ qw(Basics Dates Links People) ],
+    'RT::User'      => [ 'Identity', 'Access control', 'Location', 'Phones' ],
+);
 
-sub AddRightCategories {
-    my $self = shift if ref $_[0] or $_[0] eq __PACKAGE__;
-    my %new = @_;
-    $RIGHT_CATEGORIES = { %$RIGHT_CATEGORIES, %new };
-}
+__PACKAGE__->AddRight( General => SeeCustomField         => 'View custom fields'); # loc
+__PACKAGE__->AddRight( Admin   => AdminCustomField       => 'Create, modify and delete custom fields'); # loc
+__PACKAGE__->AddRight( Admin   => AdminCustomFieldValues => 'Create, modify and delete custom fields values'); # loc
+__PACKAGE__->AddRight( Staff   => ModifyCustomField      => 'Add, modify and delete custom field values for objects'); # loc
 
 =head1 NAME
 
@@ -290,7 +240,6 @@ Create takes a hash of values and creates a row in the database:
   varchar(200) 'Type'.
   int(11) 'MaxValues'.
   varchar(255) 'Pattern'.
-  smallint(6) 'Repeated'.
   varchar(255) 'Description'.
   int(11) 'SortOrder'.
   varchar(255) 'LookupType'.
@@ -311,7 +260,6 @@ sub Create {
         Description => '',
         Disabled    => 0,
         LookupType  => '',
-        Repeated    => 0,
         LinkValueTo => '',
         IncludeContentForValue => '',
         @_,
@@ -383,6 +331,8 @@ sub Create {
         }
     }
 
+    $args{'Disabled'} ||= 0;
+
     (my $rv, $msg) = $self->SUPER::Create(
         Name        => $args{'Name'},
         Type        => $args{'Type'},
@@ -394,7 +344,6 @@ sub Create {
         Description => $args{'Description'},
         Disabled    => $args{'Disabled'},
         LookupType  => $args{'LookupType'},
-        Repeated    => $args{'Repeated'},
     );
 
     if ($rv) {
@@ -446,20 +395,58 @@ sub Load {
 
 
 
-=head2 LoadByName (Queue => QUEUEID, Name => NAME)
+=head2 LoadByName Name => C, [...]
+
+Loads the Custom field named NAME.  As other optional parameters, takes:
+
+=over
+
+=item LookupType => C
+
+The type of Custom Field to look for; while this parameter is not
+required, it is highly suggested, or you may not find the Custom Field
+you are expecting.  It should be passed a C such as
+L or
+L.
+
+=item ObjectType => C
+
+The class of object that the custom field is applied to.  This can be
+intuited from the provided C.
 
-Loads the Custom field named NAME.
+=item ObjectId => C
 
-Will load a Disabled Custom Field even if there is a non-disabled Custom Field
-with the same Name.
+limits the custom field search to one applied to the relevant id.  For
+example, if a C of C<< RT::Ticket->CustomFieldLookupType >>
+is used, this is which Queue the CF must be applied to.  Pass 0 to only
+search custom fields that are applied globally.
 
-If a Queue parameter is specified, only look for ticket custom fields tied to that Queue.
+=item IncludeDisabled => C
 
-If the Queue parameter is '0', look for global ticket custom fields.
+Whether it should return Disabled custom fields if they match; defaults
+to on, though non-Disabled custom fields are returned preferentially.
 
-If no queue parameter is specified, look for any and all custom fields with this name.
+=item IncludeGlobal => C
 
-BUG/TODO, this won't let you specify that you only want user or group CFs.
+Whether to also search global custom fields, even if a value is provided
+for C; defaults to off.  Non-global custom fields are returned
+preferentially.
+
+=back
+
+For backwards compatibility, a value passed for C is equivalent
+to specifying a C of L,
+and a C of the value passed as C.
+
+If multiple custom fields match the above constraints, the first
+according to C will be returned; ties are broken by C,
+lowest-first.
+
+=head2 LoadNameAndQueue
+
+=head2 LoadByNameAndQueue
+
+Deprecated alternate names for L.
 
 =cut
 
@@ -471,8 +458,17 @@ BUG/TODO, this won't let you specify that you only want user or group CFs.
 sub LoadByName {
     my $self = shift;
     my %args = (
+        Name       => undef,
+        LookupType => undef,
+        ObjectType => undef,
+        ObjectId   => undef,
+
+        IncludeDisabled => 1,
+        IncludeGlobal   => 0,
+
+        # Back-compat
         Queue => undef,
-        Name  => undef,
+
         @_,
     );
 
@@ -481,34 +477,117 @@ sub LoadByName {
         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;
+    if ( defined $args{'Queue'} ) {
+        # Set a LookupType for backcompat, otherwise we'll calculate
+        # one of RT::Queue from your ContextObj.  Older code was relying
+        # on us defaulting to RT::Queue-RT::Ticket in old LimitToQueue call.
+        $args{LookupType} ||= 'RT::Queue-RT::Ticket';
+        $args{ObjectId}   //= delete $args{Queue};
+    }
+
+    # Default the ObjectType to the top category of the LookupType; it's
+    # what the CFs are assigned on.
+    $args{ObjectType} ||= $1 if $args{LookupType} and $args{LookupType} =~ /^([^-]+)/;
+
+    # Resolve the ObjectId/ObjectType; this is necessary to properly
+    # limit ObjectId, and also possibly useful to set a ContextObj if we
+    # are currently lacking one.  It is not strictly necessary if we
+    # have a context object and were passed a numeric ObjectId, but it
+    # cannot hurt to verify its sanity.  Skip if we have a false
+    # ObjectId, which means "global", or if we lack an ObjectType
+    if ($args{ObjectId} and $args{ObjectType}) {
+        my ($obj, $ok, $msg);
+        eval {
+            $obj = $args{ObjectType}->new( $self->CurrentUser );
+            ($ok, $msg) = $obj->Load( $args{ObjectId} );
+        };
+
+        if ($ok) {
+            $args{ObjectId} = $obj->id;
+            $self->SetContextObject( $obj )
+                unless $self->ContextObject;
+        } else {
+            $RT::Logger->warning("Failed to load $args{ObjectType} '$args{ObjectId}'");
+            if ($args{IncludeGlobal}) {
+                # Fall back to acting like we were only asked about the
+                # global case
+                $args{ObjectId} = 0;
+            } else {
+                # If they didn't also want global results, there's no
+                # point in searching; abort
+                return wantarray ? (0, $self->loc("Not found")) : 0;
+            }
+        }
+    } elsif (not $args{ObjectType} and $args{ObjectId}) {
+        # If we skipped out on the above due to lack of ObjectType, make
+        # sure we clear out ObjectId of anything lingering
+        $RT::Logger->warning("No LookupType or ObjectType passed; ignoring ObjectId");
+        delete $args{ObjectId};
     }
 
-    # 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' },
+    # The context object may be a ticket, for example, as context for a
+    # queue CF.  The valid lookup types are thus the entire set of
+    # ACLEquivalenceObjects for the context object.
+    $args{LookupType} ||= [
+        map {$_->CustomFieldLookupType}
+            ($self->ContextObject, $self->ContextObject->ACLEquivalenceObjects) ]
+        if $self->ContextObject;
+
+    # Apply LookupType limits
+    $args{LookupType} = [ $args{LookupType} ]
+        if $args{LookupType} and not ref($args{LookupType});
+    $CFs->Limit( FIELD => "LookupType", OPERATOR => "IN", VALUE => $args{LookupType} )
+        if $args{LookupType};
+
+    # Default to by SortOrder and id; this mirrors the standard ordering
+    # of RT::CustomFields (minus the Name, which is guaranteed to be
+    # fixed)
+    my @order = (
+        { FIELD => 'SortOrder',
+          ORDER => 'ASC' },
+        { FIELD => 'id',
+          ORDER => 'ASC' },
     );
 
+    if (defined $args{ObjectId}) {
+        # The join to OCFs is distinct -- either we have a global
+        # application or an objectid match, but never both.  Even if
+        # this were not the case, we care only for the first row.
+        my $ocfs = $CFs->_OCFAlias( Distinct => 1);
+        if ($args{IncludeGlobal}) {
+            $CFs->Limit(
+                ALIAS    => $ocfs,
+                FIELD    => 'ObjectId',
+                OPERATOR => 'IN',
+                VALUE    => [ $args{ObjectId}, 0 ],
+            );
+            # Find the queue-specific first
+            unshift @order, { ALIAS => $ocfs, FIELD => "ObjectId", ORDER => "DESC" };
+        } else {
+            $CFs->Limit(
+                ALIAS => $ocfs,
+                FIELD => 'ObjectId',
+                VALUE => $args{ObjectId},
+            );
+        }
+    }
+
+    if ($args{IncludeDisabled}) {
+        # Load disabled fields, but return them only as a last resort.
+        # This goes at the front of @order, as we prefer the
+        # non-disabled global CF to the disabled Queue-specific CF.
+        $CFs->FindAllRows;
+        unshift @order, { FIELD => "Disabled", ORDER => 'ASC' };
+    }
+
+    # Apply the above orderings
+    $CFs->OrderByCols( @order );
+
     # We only want one entry.
     $CFs->RowsPerPage(1);
 
@@ -539,9 +618,10 @@ sub Values {
 
     my $class = $self->ValuesClass;
     if ( $class ne 'RT::CustomFieldValues') {
-        eval "require $class" or die "$@";
+        $class->require or die "Can't load $class: $@";
     }
     my $cf_values = $class->new( $self->CurrentUser );
+    $cf_values->SetCustomFieldObject( $self );
     # if the user has no rights, return an empty object
     if ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) {
         $cf_values->LimitToCustomField( $self->Id );
@@ -758,7 +838,11 @@ sub ValidateType {
     my $type = shift;
 
     if ( $type =~ s/(?:Single|Multiple)$// ) {
-        $RT::Logger->warning( "Prefix 'Single' and 'Multiple' to Type deprecated, use MaxValues instead at (". join(":",caller).")");
+        RT->Deprecated(
+            Arguments => "suffix 'Single' or 'Multiple'",
+            Instead   => "MaxValues",
+            Remove    => "4.4",
+        );
     }
 
     if ( $FieldTypes{$type} ) {
@@ -774,7 +858,11 @@ 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).")");
+        RT->Deprecated(
+            Arguments => "suffix 'Single' or 'Multiple'",
+            Instead   => "MaxValues",
+            Remove    => "4.4",
+        );
         $self->SetMaxValues($1 ? 1 : 0);
     }
     $self->_Set(Field => 'Type', Value =>$type);
@@ -854,22 +942,6 @@ sub UnlimitedValues {
 }
 
 
-=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
@@ -887,9 +959,10 @@ sub 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.
+Set or get a context for this object. It can be ticket, queue or another
+object this CF added to. Used for ACL control, for example
+SeeCustomField can be granted on queue level to allow people to see all
+fields added to the queue.
 
 =cut
 
@@ -944,12 +1017,13 @@ sub LoadContextObject {
 
 =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.
+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 added to that object.  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 added globally, you
+don't need a ContextObject.
 
 =cut
 
@@ -957,23 +1031,22 @@ sub ValidateContextObject {
     my $self = shift;
     my $object = shift;
 
-    return 1 if $self->IsApplied(0);
+    return 1 if $self->IsGlobal;
 
     # global only custom fields don't have objects
     # that should be used as context objects.
-    return if $self->ApplyGlobally;
+    return if $self->IsOnlyGlobal;
 
     # 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);
+    # Check that it is added correctly
+    my ($added_to) = grep {ref($_) eq $self->RecordClassFromLookupType} ($object, $object->ACLEquivalenceObjects);
+    return unless $added_to;
+    return $self->IsAdded($added_to->id);
 }
 
-
 sub _Set {
     my $self = shift;
 
@@ -1172,9 +1245,7 @@ sub SetLookupType {
     my $lookup = shift;
     if ( $lookup ne $self->LookupType ) {
         # Okay... We need to invalidate our existing relationships
-        my $ObjectCustomFields = RT::ObjectCustomFields->new($self->CurrentUser);
-        $ObjectCustomFields->LimitToCustomField($self->Id);
-        $_->Delete foreach @{$ObjectCustomFields->ItemsArrayRef};
+        RT::ObjectCustomField->new($self->CurrentUser)->DeleteAll( CustomField => $self );
     }
     return $self->_Set(Field => 'LookupType', Value =>$lookup);
 }
@@ -1188,15 +1259,9 @@ Returns an array of LookupTypes available
 
 sub LookupTypes {
     my $self = shift;
-    return sort keys %FRIENDLY_OBJECT_TYPES;
+    return sort keys %FRIENDLY_LOOKUP_TYPES;
 }
 
-my @FriendlyObjectTypes = (
-    "[_1] objects",            # loc
-    "[_1]'s [_2] objects",        # loc
-    "[_1]'s [_2]'s [_3] objects",   # loc
-);
-
 =head2 FriendlyLookupType
 
 Returns a localized description of the type of this custom field
@@ -1206,15 +1271,21 @@ Returns a localized description of the type of this custom field
 sub FriendlyLookupType {
     my $self = shift;
     my $lookup = shift || $self->LookupType;
-   
-    return ($self->loc( $FRIENDLY_OBJECT_TYPES{$lookup} ))
-                     if (defined  $FRIENDLY_OBJECT_TYPES{$lookup} );
+
+    return ($self->loc( $FRIENDLY_LOOKUP_TYPES{$lookup} ))
+        if defined $FRIENDLY_LOOKUP_TYPES{$lookup};
 
     my @types = map { s/^RT::// ? $self->loc($_) : $_ }
       grep { defined and length }
       split( /-/, $lookup )
       or return;
-    return ( $self->loc( $FriendlyObjectTypes[$#types], @types ) );
+
+    state $LocStrings = [
+        "[_1] objects",            # loc
+        "[_1]'s [_2] objects",        # loc
+        "[_1]'s [_2]'s [_3] objects",   # loc
+    ];
+    return ( $self->loc( $LocStrings->[$#types], @types ) );
 }
 
 =head1 RecordClassFromLookupType
@@ -1293,112 +1364,181 @@ sub CollectionClassFromLookupType {
     return $collection_class;
 }
 
-=head1 ApplyGlobally
+=head2 Groupings
 
-Certain custom fields (users, groups) should only be applied globally
-but rather than regexing in code for LookupType =~ RT::Queue, we'll codify
-the rules here.
+Returns a (sorted and lowercased) list of the groupings in which this custom
+field appears.
+
+If called on a loaded object, the returned list is limited to groupings which
+apply to the record class this CF applies to (L).
+
+If passed a loaded object or a class name, the returned list is limited to
+groupings which apply to the class of the object or the specified class.
+
+If called on an unloaded object, all potential groupings are returned.
 
 =cut
 
-sub ApplyGlobally {
+sub Groupings {
     my $self = shift;
+    my $record_class = $self->_GroupingClass(shift);
 
-    return ($self->LookupType =~ /^RT::(?:Group|User)/io);
+    my $config = RT->Config->Get('CustomFieldGroupings');
+       $config = {} unless ref($config) eq 'HASH';
 
-}
+    my @groups;
+    if ( $record_class ) {
+        push @groups, sort {lc($a) cmp lc($b)} keys %{ $BUILTIN_GROUPINGS{$record_class} || {} };
+        if ( ref($config->{$record_class} ||= []) eq "ARRAY") {
+            my @order = @{ $config->{$record_class} };
+            while (@order) {
+                push @groups, shift(@order);
+                shift(@order);
+            }
+        } else {
+            @groups = sort {lc($a) cmp lc($b)} keys %{ $config->{$record_class} };
+        }
+    } else {
+        my %all = (%$config, %BUILTIN_GROUPINGS);
+        @groups = sort {lc($a) cmp lc($b)} map {$self->Groupings($_)} grep {$_} keys(%all);
+    }
 
-=head1 AppliedTo
+    my %seen;
+    return
+        grep defined && length && !$seen{lc $_}++,
+        @groups;
+}
 
-Returns collection with objects this custom field is applied to.
-Class of the collection depends on L.
-See all L .
+=head2 CustomGroupings
 
-Doesn't takes into account if object is applied globally.
+Identical to L but filters out built-in groupings from the the
+returned list.
 
 =cut
 
-sub AppliedTo {
+sub CustomGroupings {
     my $self = shift;
+    my $record_class = $self->_GroupingClass(shift);
+    return grep !$BUILTIN_GROUPINGS{$record_class}{$_}, $self->Groupings( $record_class );
+}
 
-    my ($res, $ocfs_alias) = $self->_AppliedTo;
-    return $res unless $res;
+sub _GroupingClass {
+    my $self    = shift;
+    my $record  = shift;
 
-    $res->Limit(
-        ALIAS     => $ocfs_alias,
-        FIELD     => 'id',
-        OPERATOR  => 'IS NOT',
-        VALUE     => 'NULL',
-    );
+    my $record_class = ref($record) || $record || '';
+    $record_class = $self->RecordClassFromLookupType
+        if !$record_class and blessed($self) and $self->id;
 
-    return $res;
+    return $record_class;
 }
 
-=head1 NotAppliedTo
+=head2 RegisterBuiltInGroupings
 
-Returns collection with objects this custom field is not applied to.
-Class of the collection depends on L.
-See all L .
+Registers groupings to be considered a fundamental part of RT, either via use
+in core RT or via an extension.  These groupings must be rendered explicitly in
+Mason by specific calls to F and
+F.  They will not show up automatically on normal
+display pages like configured custom groupings.
+
+Takes a set of key-value pairs of class names (valid L subclasses)
+and array refs of grouping names to consider built-in.
 
-Doesn't takes into account if object is applied globally.
+If a class already contains built-in groupings (such as L and
+L), new groupings are appended.
 
 =cut
 
-sub NotAppliedTo {
+sub RegisterBuiltInGroupings {
     my $self = shift;
+    my %new  = @_;
 
-    my ($res, $ocfs_alias) = $self->_AppliedTo;
-    return $res unless $res;
+    while (my ($k,$v) = each %new) {
+        $v = [$v] unless ref($v) eq 'ARRAY';
+        $BUILTIN_GROUPINGS{$k} = {
+            %{$BUILTIN_GROUPINGS{$k} || {}},
+            map { $_ => 1 } @$v
+        };
+    }
+    $BUILTIN_GROUPINGS{''} = { map { %$_ } values %BUILTIN_GROUPINGS  };
+}
 
-    $res->Limit(
-        ALIAS     => $ocfs_alias,
-        FIELD     => 'id',
-        OPERATOR  => 'IS',
-        VALUE     => 'NULL',
-    );
+=head1 IsOnlyGlobal
 
-    return $res;
-}
+Certain custom fields (users, groups) should only be added globally;
+codify that set here for reference.
+
+=cut
 
-sub _AppliedTo {
+sub IsOnlyGlobal {
     my $self = shift;
 
-    my ($class) = $self->CollectionClassFromLookupType;
-    return undef unless $class;
+    return ($self->LookupType =~ /^RT::(?:Group|User)/io);
+
+}
+sub ApplyGlobally {
+    RT->Deprecated(
+        Instead   => "IsOnlyGlobal",
+        Remove    => "4.4",
+    );
+    return shift->IsOnlyGlobal(@_);
+}
+
+=head1 AddedTo
 
-    my $res = $class->new( $self->CurrentUser );
+Returns collection with objects this custom field is added to.
+Class of the collection depends on L.
+See all L .
 
-    # If CF is a Group CF, only display user-defined groups
-    if ( $class eq 'RT::Groups' ) {
-        $res->LimitToUserDefinedGroups;
-    }
+Doesn't takes into account if object is added globally.
 
-    $res->OrderBy( FIELD => 'Name' );
-    my $ocfs_alias = $res->Join(
-        TYPE   => 'LEFT',
-        ALIAS1 => 'main',
-        FIELD1 => 'id',
-        TABLE2 => 'ObjectCustomFields',
-        FIELD2 => 'ObjectId',
-    );
-    $res->Limit(
-        LEFTJOIN => $ocfs_alias,
-        ALIAS    => $ocfs_alias,
-        FIELD    => 'CustomField',
-        VALUE    => $self->id,
+=cut
+
+sub AddedTo {
+    my $self = shift;
+    return RT::ObjectCustomField->new( $self->CurrentUser )
+        ->AddedTo( CustomField => $self );
+}
+sub AppliedTo {
+    RT->Deprecated(
+        Instead   => "AddedTo",
+        Remove    => "4.4",
     );
-    return ($res, $ocfs_alias);
+    shift->AddedTo(@_);
+};
+
+=head1 NotAddedTo
+
+Returns collection with objects this custom field is not added to.
+Class of the collection depends on L.
+See all L .
+
+Doesn't take into account if the object is added globally.
+
+=cut
+
+sub NotAddedTo {
+    my $self = shift;
+    return RT::ObjectCustomField->new( $self->CurrentUser )
+        ->NotAddedTo( CustomField => $self );
 }
+sub NotAppliedTo {
+    RT->Deprecated(
+        Instead   => "NotAddedTo",
+        Remove    => "4.4",
+    );
+    shift->NotAddedTo(@_)
+};
 
-=head2 IsApplied
+=head2 IsAdded
 
 Takes object id and returns corresponding L
-record if this custom field is applied to the object. Use 0 to check
-if custom field is applied globally.
+record if this custom field is added to the object. Use 0 to check
+if custom field is added globally.
 
 =cut
 
-sub IsApplied {
+sub IsAdded {
     my $self = shift;
     my $id = shift;
     my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
@@ -1406,6 +1546,29 @@ sub IsApplied {
     return undef unless $ocf->id;
     return $ocf;
 }
+sub IsApplied {
+    RT->Deprecated(
+        Instead   => "IsAdded",
+        Remove    => "4.4",
+    );
+    shift->IsAdded(@_);
+};
+
+sub IsGlobal { return shift->IsAdded(0) }
+
+=head2 IsAddedToAny
+
+Returns true if custom field is applied to any object.
+
+=cut
+
+sub IsAddedToAny {
+    my $self = shift;
+    my $id = shift;
+    my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
+    $ocf->LoadByCols( CustomField => $self->id );
+    return $ocf->id ? 1 : 0;
+}
 
 =head2 AddToObject OBJECT
 
@@ -1415,7 +1578,6 @@ Takes an object
 
 =cut
 
-
 sub AddToObject {
     my $self  = shift;
     my $object = shift;
@@ -1429,26 +1591,9 @@ sub AddToObject {
         return ( 0, $self->loc('Permission Denied') );
     }
 
-    if ( $self->IsApplied( $id ) ) {
-        return ( 0, $self->loc("Custom field is already applied to the object") );
-    }
-
-    if ( $id ) {
-        # applying locally
-        return (0, $self->loc("Couldn't apply custom field to an object as it's global already") )
-            if $self->IsApplied( 0 );
-    }
-    else {
-        my $applied = RT::ObjectCustomFields->new( $self->CurrentUser );
-        $applied->LimitToCustomField( $self->id );
-        while ( my $record = $applied->Next ) {
-            $record->Delete;
-        }
-    }
-
     my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
-    my ( $oid, $msg ) = $ocf->Create(
-        ObjectId => $id, CustomField => $self->id,
+    my ( $oid, $msg ) = $ocf->Add(
+        CustomField => $self->id, ObjectId => $id,
     );
     return ( $oid, $msg );
 }
@@ -1475,9 +1620,9 @@ sub RemoveFromObject {
         return ( 0, $self->loc('Permission Denied') );
     }
 
-    my $ocf = $self->IsApplied( $id );
+    my $ocf = $self->IsAdded( $id );
     unless ( $ocf ) {
-        return ( 0, $self->loc("This custom field does not apply to that object") );
+        return ( 0, $self->loc("This custom field cannot be added to that object") );
     }
 
     # XXX: Delete doesn't return anything
@@ -1749,9 +1894,10 @@ sub ValuesForObject {
 }
 
 
-=head2 _ForObjectType PATH FRIENDLYNAME
+=head2 RegisterLookupType LOOKUPTYPE FRIENDLYNAME
 
-Tell RT that a certain object accepts custom fields
+Tell RT that a certain object accepts custom fields via a lookup type and
+provide a friendly name for such CFs.
 
 Examples:
 
@@ -1765,13 +1911,21 @@ This is a class method.
 
 =cut
 
-sub _ForObjectType {
+sub RegisterLookupType {
     my $self = shift;
     my $path = shift;
     my $friendly_name = shift;
 
-    $FRIENDLY_OBJECT_TYPES{$path} = $friendly_name;
+    $FRIENDLY_LOOKUP_TYPES{$path} = $friendly_name;
+}
 
+sub _ForObjectType {
+    RT->Deprecated(
+        Instead => 'RegisterLookupType',
+        Remove  => '4.4',
+    );
+    my $self = shift;
+    $self->RegisterLookupType(@_);
 }
 
 
@@ -1831,18 +1985,20 @@ sub _URLTemplate {
         unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
             return ( 0, $self->loc('Permission Denied') );
         }
-        $self->SetAttribute( Name => $template_name, Content => $value );
+        if (length $value and defined $value) {
+            $self->SetAttribute( Name => $template_name, Content => $value );
+        } else {
+            $self->DeleteAttribute( $template_name );
+        }
         return ( 1, $self->loc('Updated') );
     } else {
         unless ( $self->id && $self->CurrentUserHasRight('SeeCustomField') ) {
             return (undef);
         }
 
-        my @attr = $self->Attributes->Named($template_name);
-        my $attr = shift @attr;
-
-        if ($attr) { return $attr->Content }
-
+        my ($attr) = $self->Attributes->Named($template_name);
+        return undef unless $attr;
+        return $attr->Content;
     }
 }
 
@@ -1857,7 +2013,7 @@ sub SetBasedOn {
     $cf->SetContextObject( $self->ContextObject );
     $cf->Load( ref $value ? $value->id : $value );
 
-    return (0, "Permission denied")
+    return (0, "Permission Denied")
         unless $cf->id && $cf->CurrentUserHasRight('SeeCustomField');
 
     # XXX: Remove this restriction once we support lists and cascaded selects
@@ -2011,24 +2167,6 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 =cut
 
 
-=head2 Repeated
-
-Returns the current value of Repeated. 
-(In the database, Repeated is stored as smallint(6).)
-
-
-
-=head2 SetRepeated VALUE
-
-
-Set Repeated to VALUE. 
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Repeated will be stored as a smallint(6).)
-
-
-=cut
-
-
 =head2 BasedOn
 
 Returns the current value of BasedOn. 
@@ -2171,8 +2309,6 @@ sub _CoreAccessible {
         {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
         Pattern => 
         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
-        Repeated => 
-        {read => 1, write => 1, sql_type => 5, length => 6,  is_blob => 0,  is_numeric => 1,  type => 'smallint(6)', default => '0'},
         ValuesClass => 
         {read => 1, write => 1, sql_type => 12, length => 64,  is_blob => 0,  is_numeric => 0,  type => 'varchar(64)', default => ''},
         BasedOn => 
@@ -2197,6 +2333,48 @@ sub _CoreAccessible {
  }
 };
 
+sub FindDependencies {
+    my $self = shift;
+    my ($walker, $deps) = @_;
+
+    $self->SUPER::FindDependencies($walker, $deps);
+
+    $deps->Add( out => $self->BasedOnObj )
+        if $self->BasedOnObj->id;
+
+    my $applied = RT::ObjectCustomFields->new( $self->CurrentUser );
+    $applied->LimitToCustomField( $self->id );
+    $deps->Add( in => $applied );
+
+    $deps->Add( in => $self->Values ) if $self->ValuesClass eq "RT::CustomFieldValues";
+}
+
+sub __DependsOn {
+    my $self = shift;
+    my %args = (
+        Shredder => undef,
+        Dependencies => undef,
+        @_,
+    );
+    my $deps = $args{'Dependencies'};
+    my $list = [];
+
+# Custom field values
+    push( @$list, $self->Values );
+
+# Ticket custom field values
+    my $objs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
+    $objs->LimitToCustomField( $self->Id );
+    push( @$list, $objs );
+
+    $deps->_PushDependencies(
+        BaseObject => $self,
+        Flags => RT::Shredder::Constants::DEPENDS_ON,
+        TargetObjects => $list,
+        Shredder => $args{'Shredder'}
+    );
+    return $self->SUPER::__DependsOn( %args );
+}
 
 RT::Base->_ImportOverlays();
 
diff --git a/rt/lib/RT/CustomFieldValue.pm b/rt/lib/RT/CustomFieldValue.pm
index e6b8a09..ecffa27 100644
--- a/rt/lib/RT/CustomFieldValue.pm
+++ b/rt/lib/RT/CustomFieldValue.pm
@@ -54,8 +54,8 @@ package RT::CustomFieldValue;
 no warnings qw/redefine/;
 
 
-use RT::CustomField;
 use base 'RT::Record';
+use RT::CustomField;
 
 sub Table {'CustomFieldValues'}
 
@@ -100,37 +100,6 @@ sub ValidateName {
     return defined $_[1] && length $_[1];
 };
 
-=head2 DeleteCategory
-
-Deletes the category associated with this value
-Returns -1 if there is no Category
-
-=cut
-
-sub DeleteCategory {
-    my $self = shift;
-    my $attr = $self->FirstAttribute('Category') or return (-1,'No Category Set');
-    return $attr->Delete;
-}
-
-=head2 Delete
-
-Make sure we delete our Category when we're deleted
-
-=cut
-
-sub Delete {
-    my $self = shift;
-
-    my ($result, $msg) = $self->DeleteCategory;
-
-    unless ($result) {
-        return ($result, $msg);
-    }
-
-    return $self->SUPER::Delete(@_);
-}
-
 sub _Set { 
     my $self = shift; 
 
@@ -175,18 +144,37 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 (In the database, CustomField will be stored as a int(11).)
 
 
+=head2 SetCustomFieldObj
+
+Store the CustomField object which loaded this CustomFieldValue.
+Passed down from the CustomFieldValues collection in AddRecord.
+
+This object will be transparently returned from CustomFieldObj rather
+than loading from the database.
+
 =cut
 
+sub SetCustomFieldObj {
+    my $self = shift;
+    return $self->{'custom_field'} = shift;
+}
 
 =head2 CustomFieldObj
 
-Returns the CustomField Object which has the id returned by CustomField
+If a CustomField object was stored using SetCustomFieldObj and it is
+the same CustomField stored in the CustomField column, then the stored
+CustomField object (likely passed down from CustomField->Values) will be returned.
 
+Otherwise returns the CustomField Object which has the id returned by CustomField
 
 =cut
 
 sub CustomFieldObj {
     my $self = shift;
+
+    return $self->{custom_field} if $self->{custom_field}
+        and $self->{custom_field}->id == $self->__Value('CustomField');
+
     my $CustomField =  RT::CustomField->new($self->CurrentUser);
     $CustomField->Load($self->__Value('CustomField'));
     return($CustomField);
@@ -329,7 +317,14 @@ sub _CoreAccessible {
 };
 
 
+sub FindDependencies {
+    my $self = shift;
+    my ($walker, $deps) = @_;
+
+    $self->SUPER::FindDependencies($walker, $deps);
 
+    $deps->Add( out => $self->CustomFieldObj );
+}
 
 RT::Base->_ImportOverlays();
 
diff --git a/rt/lib/RT/CustomFieldValues.pm b/rt/lib/RT/CustomFieldValues.pm
index 193cd66..7188689 100644
--- a/rt/lib/RT/CustomFieldValues.pm
+++ b/rt/lib/RT/CustomFieldValues.pm
@@ -51,12 +51,10 @@ package RT::CustomFieldValues;
 use strict;
 use warnings;
 
-
+use base 'RT::SearchBuilder';
 
 use RT::CustomFieldValue;
 
-use base 'RT::SearchBuilder';
-
 sub Table { 'CustomFieldValues'}
 
 sub _Init {
@@ -64,15 +62,15 @@ sub _Init {
 
   # By default, order by SortOrder
   $self->OrderByCols(
-	 { ALIAS => 'main',
-	   FIELD => 'SortOrder',
-	   ORDER => 'ASC' },
-	 { ALIAS => 'main',
-	   FIELD => 'Name',
-	   ORDER => 'ASC' },
-	 { ALIAS => 'main',
-	   FIELD => 'id',
-	   ORDER => 'ASC' },
+         { ALIAS => 'main',
+           FIELD => 'SortOrder',
+           ORDER => 'ASC' },
+         { ALIAS => 'main',
+           FIELD => 'Name',
+           ORDER => 'ASC' },
+         { ALIAS => 'main',
+           FIELD => 'id',
+           ORDER => 'ASC' },
      );
 
     return ( $self->SUPER::_Init(@_) );
@@ -95,19 +93,50 @@ sub LimitToCustomField {
     );
 }
 
+=head2 SetCustomFieldObject
+
+Store the CustomField object which loaded this CustomFieldValues collection.
+Consumers of CustomFieldValues collection (such as External Custom Fields)
+can now work out how they were loaded (off a Queue or Ticket or something else)
+by inspecting the CustomField.
 
+=cut
 
+sub SetCustomFieldObject {
+    my $self = shift;
+    return $self->{'custom_field'} = shift;
+}
 
-=head2 NewItem
+=head2 CustomFieldObject
 
-Returns an empty new RT::CustomFieldValue item
+Returns the CustomField object used to load this CustomFieldValues collection.
+Relies on $CustomField->Values having been called, is not set on manual loads.
 
 =cut
 
-sub NewItem {
+sub CustomFieldObject {
     my $self = shift;
-    return(RT::CustomFieldValue->new($self->CurrentUser));
+    return $self->{'custom_field'};
 }
+
+=head2 AddRecord
+
+Propagates the CustomField object from the Collection
+down to individual CustomFieldValue objects.
+
+=cut
+
+sub AddRecord {
+    my $self = shift;
+    my $CFV = shift;
+
+    $CFV->SetCustomFieldObj($self->CustomFieldObject);
+
+    push @{$self->{'items'}}, $CFV;
+    $self->{'rows'}++;
+}
+
+
 RT::Base->_ImportOverlays();
 
 1;
diff --git a/rt/lib/RT/CustomFieldValues/External.pm b/rt/lib/RT/CustomFieldValues/External.pm
index a0eabd5..66e798a 100644
--- a/rt/lib/RT/CustomFieldValues/External.pm
+++ b/rt/lib/RT/CustomFieldValues/External.pm
@@ -77,8 +77,10 @@ the identifier by which the user will see the dropdown.
 =head2 ExternalValues
 
 This method should return an array reference of hash references.  The
-hash references should contain keys for C, C, and
-C.
+hash references must contain a key for C and can optionally contain
+keys for C, C, and C. If supplying a
+category, you must also set the category the custom field is based on in
+the custom field configuration page.
 
 =head1 SEE ALSO
 
@@ -179,6 +181,7 @@ sub _DoSearch {
             customfield => $self->{'__external_cf'},
             sortorder => 0,
             description => '',
+            category => undef,
             creator => RT->SystemUser->id,
             created => undef,
             lastupdatedby => RT->SystemUser->id,
@@ -193,6 +196,7 @@ sub _DoSearch {
         $value->LoadFromHash( { %defaults, %$_ } );
         next if $check && !$check->( $self, $value );
         $self->AddRecord( $value );
+        last if $self->RowsPerPage and ++$i >= $self->RowsPerPage;
     }
     $self->{'must_redo_search'} = 0;
     return $self->_RecordCount;
@@ -214,6 +218,10 @@ sub LimitToCustomField {
     return $self->SUPER::LimitToCustomField( @_ );
 }
 
+sub _SingularClass {
+    "RT::CustomFieldValue"
+}
+
 RT::Base->_ImportOverlays();
 
 1;
diff --git a/rt/lib/RT/CustomFields.pm b/rt/lib/RT/CustomFields.pm
index ba3b01c..90bfa47 100644
--- a/rt/lib/RT/CustomFields.pm
+++ b/rt/lib/RT/CustomFields.pm
@@ -68,10 +68,10 @@ package RT::CustomFields;
 use strict;
 use warnings;
 
-use RT::CustomField;
-
 use base 'RT::SearchBuilder';
 
+use RT::CustomField;
+
 sub Table { 'CustomFields'}
 
 sub _Init {
@@ -79,21 +79,81 @@ sub _Init {
 
   # By default, order by SortOrder
   $self->OrderByCols(
-	 { ALIAS => 'main',
-	   FIELD => 'SortOrder',
-	   ORDER => 'ASC' },
-	 { ALIAS => 'main',
-	   FIELD => 'Name',
-	   ORDER => 'ASC' },
-	 { ALIAS => 'main',
-	   FIELD => 'id',
-	   ORDER => 'ASC' },
+         { ALIAS => 'main',
+           FIELD => 'SortOrder',
+           ORDER => 'ASC' },
+         { ALIAS => 'main',
+           FIELD => 'Name',
+           ORDER => 'ASC' },
+         { ALIAS => 'main',
+           FIELD => 'id',
+           ORDER => 'ASC' },
      );
     $self->{'with_disabled_column'} = 1;
 
     return ( $self->SUPER::_Init(@_) );
 }
 
+=head2 LimitToGrouping
+
+Limits this collection object to custom fields which appear under a
+specified grouping by calling L for each CF name as appropriate.
+
+Requires an L object or class name as the first argument and
+accepts a grouping name as the second.  If the grouping name is false
+(usually via the empty string), limits to custom fields which appear in no
+grouping.
+
+I While the record object or class name is used to find the
+available groupings, no automatic limit is placed on the lookup type of
+the custom fields.  It's highly suggested you limit the collection by
+queue or another lookup type first.  This is already done for you if
+you're creating the collection via the L method on an
+L object.
+
+=cut
+
+sub LimitToGrouping {
+    my $self = shift;
+    my $obj = shift;
+    my $grouping = shift;
+
+    my $grouping_class = $self->NewItem->_GroupingClass($obj);
+
+    my $config = RT->Config->Get('CustomFieldGroupings');
+       $config = {} unless ref($config) eq 'HASH';
+       $config = $config->{$grouping_class} || [];
+    my %h = ref $config eq "ARRAY" ? @{$config} : %{$config};
+
+    if ( $grouping ) {
+        my $list = $h{$grouping};
+        unless ( $list and ref($list) eq 'ARRAY' and @$list ) {
+            return $self->Limit( FIELD => 'id', VALUE => 0, ENTRYAGGREGATOR => 'AND' );
+        }
+        $self->Limit(
+            FIELD         => 'Name',
+            FUNCTION      => 'LOWER(?)',
+            OPERATOR      => 'IN',
+            VALUE         => [map {lc $_} @{$list}],
+            CASESENSITIVE => 1,
+        );
+    } else {
+        my @list = map {@$_} grep defined && ref($_) eq 'ARRAY',
+            values %h;
+
+        return unless @list;
+
+        $self->Limit(
+            FIELD         => 'Name',
+            FUNCTION      => 'LOWER(?)',
+            OPERATOR      => 'NOT IN',
+            VALUE         => [ map {lc $_} @list ],
+            CASESENSITIVE => 1,
+        );
+    }
+    return;
+}
+
 
 =head2 LimitToLookupType
 
@@ -160,7 +220,7 @@ sub LimitToObjectId {
 =head2 LimitToGlobalOrObjectId
 
 Takes list of object IDs and limits collection to custom
-fields that are applied to these objects or globally.
+fields that are added to these objects or globally.
 
 =cut
 
@@ -177,29 +237,7 @@ sub LimitToGlobalOrObjectId {
     $self->LimitToObjectId(0) unless $global_only;
 }
 
-sub _LimitToOCFs {
-    my $self = shift;
-    my @ids = @_;
-
-    my $ocfs_alias = $self->_OCFAlias( New => 1, Left => 1 );
-    if ( @ids ) {
-        # XXX: we need different EA in join clause, but DBIx::SB
-        # doesn't support them, use IN (X) instead
-        my $dbh = $self->_Handle->dbh;
-        $self->Limit(
-            LEFTJOIN   => $ocfs_alias,
-            ALIAS      => $ocfs_alias,
-            FIELD      => 'ObjectId',
-            OPERATOR   => 'IN',
-            QUOTEVALUE => 0,
-            VALUE      => "(". join( ',', map $dbh->quote($_), @ids ) .")",
-        );
-    }
-
-    return $ocfs_alias;
-}
-
-=head2 LimitToNotApplied
+=head2 LimitToNotAdded
 
 Takes either list of object ids or nothing. Limits collection
 to custom fields to listed objects or any corespondingly. Use
@@ -207,48 +245,31 @@ zero to mean global.
 
 =cut
 
-sub LimitToNotApplied {
+sub LimitToNotAdded {
     my $self = shift;
-    my @ids = @_;
-
-    my $ocfs_alias = $self->_LimitToOCFs(@ids);
-
-    $self->Limit(
-        ENTRYAGGREGATOR => 'AND',
-        ALIAS    => $ocfs_alias,
-        FIELD    => 'id',
-        OPERATOR => 'IS',
-        VALUE    => 'NULL',
-    );
+    return RT::ObjectCustomFields->new( $self->CurrentUser )
+        ->LimitTargetToNotAdded( $self => @_ );
 }
 
-=head2 LimitToApplied
+=head2 LimitToAdded
 
 Limits collection to custom fields to listed objects or any corespondingly. Use
 zero to mean global.
 
 =cut
 
-sub LimitToApplied {
+sub LimitToAdded {
     my $self = shift;
-    my @ids = @_;
-
-    my $ocfs_alias = $self->_LimitToOCFs(@ids);
-
-    $self->Limit(
-        ENTRYAGGREGATOR => 'AND',
-        ALIAS    => $ocfs_alias,
-        FIELD    => 'id',
-        OPERATOR => 'IS NOT',
-        VALUE    => 'NULL',
-    );
+    return RT::ObjectCustomFields->new( $self->CurrentUser )
+        ->LimitTargetToAdded( $self => @_ );
 }
 
 =head2 LimitToGlobalOrQueue QUEUEID
 
-DEPRECATED since CFs are applicable not only to tickets these days.
+Limits the set of custom fields found to global custom fields or those
+tied to the queue C, similar to L.
 
-Limits the set of custom fields found to global custom fields or those tied to the queue with ID QUEUEID
+Note that this will cause the collection to only return ticket CFs.
 
 =cut
 
@@ -262,34 +283,33 @@ sub LimitToGlobalOrQueue {
 
 =head2 LimitToQueue QUEUEID
 
-DEPRECATED since CFs are applicable not only to tickets these days.
+Takes a numeric C, and limits the Custom Field collection to
+those only applied directly to it; this limit is OR'd with other
+L and L limits.
 
-Takes a queue id (numerical) as its only argument. Makes sure that
-Scopes it pulls out apply to this queue (or another that you've selected with
-another call to this method
+Note that this will cause the collection to only return ticket CFs.
 
 =cut
 
 sub LimitToQueue  {
    my $self = shift;
-  my $queue = shift;
-
-  $self->Limit (ALIAS => $self->_OCFAlias,
-                ENTRYAGGREGATOR => 'OR',
-		FIELD => 'ObjectId',
-		VALUE => "$queue")
-      if defined $queue;
-  $self->LimitToLookupType( 'RT::Queue-RT::Ticket' );
+   my $queue = shift;
+
+   $self->Limit (ALIAS => $self->_OCFAlias,
+                 ENTRYAGGREGATOR => 'OR',
+                 FIELD => 'ObjectId',
+                 VALUE => "$queue")
+       if defined $queue;
+   $self->LimitToLookupType( 'RT::Queue-RT::Ticket' );
 }
 
 
 =head2 LimitToGlobal
 
-DEPRECATED since CFs are applicable not only to tickets these days.
+Limits the Custom Field collection to global ticket CFs; this limit is
+OR'd with L limits.
 
-Makes sure that Scopes it pulls out apply to all queues
-(or another that you've selected with
-another call to this method or LimitToQueue)
+Note that this will cause the collection to only return ticket CFs.
 
 =cut
 
@@ -298,8 +318,8 @@ sub LimitToGlobal  {
 
   $self->Limit (ALIAS => $self->_OCFAlias,
                 ENTRYAGGREGATOR => 'OR',
-		FIELD => 'ObjectId',
-		VALUE => 0);
+                FIELD => 'ObjectId',
+                VALUE => 0);
   $self->LimitToLookupType( 'RT::Queue-RT::Ticket' );
 }
 
@@ -351,19 +371,8 @@ sub SetContextObject {
 
 sub _OCFAlias {
     my $self = shift;
-    my %args = ( New => 0, Left => 0, @_ );
-
-    return $self->{'_sql_ocfalias'} if $self->{'_sql_ocfalias'} && !$args{'New'};
-
-    my $alias = $self->Join(
-        $args{'Left'} ? (TYPE => 'LEFT') : (),
-        ALIAS1 => 'main',
-        FIELD1 => 'id',
-        TABLE2 => 'ObjectCustomFields',
-        FIELD2 => 'CustomField'
-    );
-    return $alias if $args{'New'};
-    return $self->{'_sql_ocfalias'} = $alias;
+    return RT::ObjectCustomFields->new( $self->CurrentUser )
+        ->JoinTargetToThis( $self => @_ );
 }
 
 
diff --git a/rt/lib/RT/Dashboard.pm b/rt/lib/RT/Dashboard.pm
index d84f56b..6d9eeb6 100644
--- a/rt/lib/RT/Dashboard.pm
+++ b/rt/lib/RT/Dashboard.pm
@@ -67,41 +67,26 @@
 
 package RT::Dashboard;
 
-use RT::SavedSearch;
-
 use strict;
 use warnings;
 
 use base qw/RT::SharedSetting/;
 
+use RT::SavedSearch;
+
 use RT::System;
-RT::System::AddRights(
-    SubscribeDashboard => 'Subscribe to dashboards', #loc_pair
-
-    SeeDashboard       => 'View system dashboards', #loc_pair
-    CreateDashboard    => 'Create system dashboards', #loc_pair
-    ModifyDashboard    => 'Modify system dashboards', #loc_pair
-    DeleteDashboard    => 'Delete system dashboards', #loc_pair
-
-    SeeOwnDashboard    => 'View personal dashboards', #loc_pair
-    CreateOwnDashboard => 'Create personal dashboards', #loc_pair
-    ModifyOwnDashboard => 'Modify personal dashboards', #loc_pair
-    DeleteOwnDashboard => 'Delete personal dashboards', #loc_pair
-);
-
-RT::System::AddRightCategories(
-    SubscribeDashboard => 'Staff',
-
-    SeeDashboard       => 'General',
-    CreateDashboard    => 'Admin',
-    ModifyDashboard    => 'Admin',
-    DeleteDashboard    => 'Admin',
-
-    SeeOwnDashboard    => 'Staff',
-    CreateOwnDashboard => 'Staff',
-    ModifyOwnDashboard => 'Staff',
-    DeleteOwnDashboard => 'Staff',
-);
+'RT::System'->AddRight( Staff   => SubscribeDashboard => 'Subscribe to dashboards'); # loc
+
+'RT::System'->AddRight( General => SeeDashboard       => 'View system dashboards'); # loc
+'RT::System'->AddRight( Admin   => CreateDashboard    => 'Create system dashboards'); # loc
+'RT::System'->AddRight( Admin   => ModifyDashboard    => 'Modify system dashboards'); # loc
+'RT::System'->AddRight( Admin   => DeleteDashboard    => 'Delete system dashboards'); # loc
+
+'RT::System'->AddRight( Staff   => SeeOwnDashboard    => 'View personal dashboards'); # loc
+'RT::System'->AddRight( Staff   => CreateOwnDashboard => 'Create personal dashboards'); # loc
+'RT::System'->AddRight( Staff   => ModifyOwnDashboard => 'Modify personal dashboards'); # loc
+'RT::System'->AddRight( Staff   => DeleteOwnDashboard => 'Delete personal dashboards'); # loc
+
 
 =head2 ObjectName
 
diff --git a/rt/lib/RT/Dashboard/Mailer.pm b/rt/lib/RT/Dashboard/Mailer.pm
index 8582acd..f0f14a0 100644
--- a/rt/lib/RT/Dashboard/Mailer.pm
+++ b/rt/lib/RT/Dashboard/Mailer.pm
@@ -60,6 +60,7 @@ use RT::Interface::Web::Handler;
 use RT::Interface::Web;
 use File::Temp 'tempdir';
 use HTML::Scrubber;
+use URI::QueryParam;
 
 sub MailDashboards {
     my $self = shift;
@@ -349,6 +350,7 @@ sub EmailDashboard {
     $RT::Logger->debug('Mailing dashboard "'.$dashboard->Name.'" to user '.$currentuser->Name." <$email>");
 
     my $ok = RT::Interface::Email::SendEmail(
+        %{ RT->Config->Get('Crypt')->{'Dashboards'} || {} },
         Entity => $entity,
     );
 
@@ -379,8 +381,10 @@ sub BuildEmail {
             # already attached this object
             return "cid:$cid_of{$uri}" if $cid_of{$uri};
 
-            $cid_of{$uri} = time() . $$ . int(rand(1e6));
             my ($data, $filename, $mimetype, $encoding) = GetResource($uri);
+            return $uri unless defined $data;
+
+            $cid_of{$uri} = time() . $$ . int(rand(1e6));
 
             # Encode textual data in UTF-8, and downgrade (treat
             # codepoints as codepoints, and ensure the UTF-8 flag is
@@ -409,7 +413,7 @@ sub BuildEmail {
         inline_css => sub {
             my $uri = shift;
             my ($content) = GetResource($uri);
-            return $content;
+            return defined $content ? $content : "";
         },
         inline_imports => 1,
     );
@@ -457,7 +461,7 @@ sub BuildEmail {
                 autohandler_name => '', # disable forced login and more
                 data_dir => $data_dir,
             );
-            $mason->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
+            $mason->set_escape( h => \&RT::Interface::Web::EscapeHTML );
             $mason->set_escape( u => \&RT::Interface::Web::EscapeURI  );
             $mason->set_escape( j => \&RT::Interface::Web::EscapeJS   );
         }
@@ -530,7 +534,13 @@ sub BuildEmail {
 
 sub GetResource {
     my $uri = URI->new(shift);
-    my ($content, $filename, $mimetype, $encoding);
+    my ($content, $content_type, $filename, $mimetype, $encoding);
+
+    # Avoid trying to inline any remote URIs.  We absolutified all URIs
+    # using WebURL in SendDashboard() above, so choose the simpler match on
+    # that rather than testing a bunch of URI accessors.
+    my $WebURL = RT->Config->Get("WebURL");
+    return unless $uri =~ /^\Q$WebURL/;
 
     $RT::Logger->debug("Getting resource $uri");
 
@@ -543,43 +553,35 @@ sub GetResource {
     $path = "/$path"
         unless $path =~ m{^/};
 
-    $HTML::Mason::Commands::r->path_info($path);
-
-    # grab the query arguments
-    my %args;
-    for (split /&/, ($uri->query||'')) {
-        my ($k, $v) = /^(.*?)=(.*)$/
-            or die "Unable to parse query parameter '$_'";
-
-        for ($k, $v) { s/%(..)/chr hex $1/ge }
-
-        # Decode from bytes to characters
-        $_ = Encode::decode( "UTF-8", $_ ) for $k, $v;
-
-        # no value yet, simple key=value
-        if (!exists $args{$k}) {
-            $args{$k} = $v;
-        }
-        # already have key=value, need to upgrade it to key=[value1, value2]
-        elsif (!ref($args{$k})) {
-            $args{$k} = [$args{$k}, $v];
-        }
-        # already key=[value1, value2], just add the new value
-        else {
-            push @{ $args{$k} }, $v;
-        }
+    # Try the static handler first for non-Mason CSS, JS, etc.
+    my $res = RT::Interface::Web::Handler->GetStatic($path);
+    if ($res->is_success) {
+        RT->Logger->debug("Fetched '$path' from the static handler");
+        $content      = $res->decoded_content;
+        $content_type = $res->headers->content_type;
+    } else {
+        # Try it through Mason instead...
+        $HTML::Mason::Commands::r->path_info($path);
+
+        # grab the query arguments
+        my %args = map { $_ => [ map {Encode::decode("UTF-8",$_)}
+                                     $uri->query_param($_) ] } $uri->query_param;
+        # Convert empty and single element arrayrefs to a non-ref scalar
+        @$_ < 2 and $_ = $_->[0]
+            for values %args;
+
+        $RT::Logger->debug("Running component '$path'");
+        $content = RunComponent($path, %args);
+
+        $content_type = $HTML::Mason::Commands::r->content_type;
     }
 
-    $RT::Logger->debug("Running component '$path'");
-    $content = RunComponent($path, %args);
-
     # guess at the filename from the component name
     $filename = $1 if $path =~ m{^.*/(.*?)$};
 
     # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
     ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
 
-    my $content_type = $HTML::Mason::Commands::r->content_type;
     if ($content_type) {
         $mimetype = $content_type;
 
diff --git a/rt/lib/RT/Dashboards.pm b/rt/lib/RT/Dashboards.pm
index 8aad02d..e4137a0 100644
--- a/rt/lib/RT/Dashboards.pm
+++ b/rt/lib/RT/Dashboards.pm
@@ -67,12 +67,12 @@
 
 package RT::Dashboards;
 
-use RT::Dashboard;
-
 use strict;
 use warnings;
 use base 'RT::SharedSettings';
 
+use RT::Dashboard;
+
 sub RecordClass {
     return 'RT::Dashboard';
 }
diff --git a/rt/lib/RT/Date.pm b/rt/lib/RT/Date.pm
index 4405b07..c572b75 100644
--- a/rt/lib/RT/Date.pm
+++ b/rt/lib/RT/Date.pm
@@ -56,7 +56,7 @@
 
 =head1 DESCRIPTION
 
-RT Date is a simple Date Object designed to be speedy and easy for RT to use
+RT Date is a simple Date Object designed to be speedy and easy for RT to use.
 
 The fact that it assumes that a time of 0 means "never" is probably a bug.
 
@@ -166,10 +166,21 @@ sub Set {
 
     return $self->Unix(0) unless $args{'Value'} && $args{'Value'} =~ /\S/;
 
-    if ( $args{'Format'} =~ /^unix$/i ) {
+    my $format = lc $args{'Format'};
+
+    if ( $format eq 'unix' ) {
         return $self->Unix( $args{'Value'} );
     }
-    elsif ( $args{'Format'} =~ /^(sql|datemanip|iso)$/i ) {
+    elsif (
+        ($format eq 'sql' || $format eq 'iso')
+        && $args{'Value'} =~ /^(\d{4})-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/
+    ) {
+        local $@;
+        my $u = eval { Time::Local::timegm($6, $5, $4, $3, $2-1, $1) } || 0;
+        $RT::Logger->warning("Invalid date $args{'Value'}: $@") if $@ && !$u;
+        return $self->Unix( $u > 0 ? $u : 0 );
+    }
+    elsif ( $format =~ /^(sql|datemanip|iso)$/ ) {
         $args{'Value'} =~ s!/!-!g;
 
         if (   ( $args{'Value'} =~ /^(\d{4})?(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ )
@@ -201,7 +212,7 @@ sub Set {
             return $self->Unix(0);
         }
     }
-    elsif ( $args{'Format'} =~ /^unknown$/i ) {
+    elsif ( $format eq 'unknown' ) {
         require Time::ParseDate;
         # the module supports only legacy timezones like PDT or EST...
         # so we parse date as GMT and later apply offset, this only
@@ -230,7 +241,7 @@ sub Set {
             "RT::Date used Time::ParseDate to make '$args{'Value'}' $date\n"
         );
 
-        return $self->Set( Format => 'unix', Value => $date);
+        return $self->Unix($date || 0);
     }
     else {
         $RT::Logger->error(
@@ -365,56 +376,105 @@ sub DiffAsString {
 Takes a number of seconds. Returns a localized string describing
 that duration.
 
+Takes optional named arguments:
+
+=over 4
+
+=item * Show
+
+How many elements to show, how precise it should be. Default is 1,
+most vague variant.
+
+=item * Short
+
+Turn on short notation with one character units, for example
+"3M 2d 1m 10s".
+
+=back
+
 =cut
 
 sub DurationAsString {
     my $self     = shift;
     my $duration = int shift;
+    my %args = ( Show => 1, Short => 0, @_ );
 
-    my ( $negative, $s, $time_unit );
+    unless ( $duration ) {
+        return $args{Short}? $self->loc("0s") : $self->loc("0 seconds");
+    }
+
+    my $negative;
     $negative = 1 if $duration < 0;
     $duration = abs $duration;
 
-    if ( $duration < $MINUTE ) {
-        $s         = $duration;
-        $time_unit = $self->loc("sec");
-    }
-    elsif ( $duration < ( 2 * $HOUR ) ) {
-        $s         = int( $duration / $MINUTE + 0.5 );
-        $time_unit = $self->loc("min");
-    }
-    elsif ( $duration < ( 2 * $DAY ) ) {
-        $s         = int( $duration / $HOUR + 0.5 );
-        $time_unit = $self->loc("hours");
-    }
-    elsif ( $duration < ( 2 * $WEEK ) ) {
-        $s         = int( $duration / $DAY + 0.5 );
-        $time_unit = $self->loc("days");
-    }
-    elsif ( $duration < ( 2 * $MONTH ) ) {
-        $s         = int( $duration / $WEEK + 0.5 );
-        $time_unit = $self->loc("weeks");
-    }
-    elsif ( $duration < $YEAR ) {
-        $s         = int( $duration / $MONTH + 0.5 );
-        $time_unit = $self->loc("months");
-    }
-    else {
-        $s         = int( $duration / $YEAR + 0.5 );
-        $time_unit = $self->loc("years");
+    my @res;
+
+    my $coef = 2;
+    my $i = 0;
+    while ( $duration > 0 && ++$i <= $args{'Show'} ) {
+
+        my ($locstr, $unit);
+        if ( $duration < $MINUTE ) {
+            $locstr = $args{Short}
+                    ? '[_1]s'                      # loc
+                    : '[quant,_1,second,seconds]'; # loc
+            $unit = 1;
+        }
+        elsif ( $duration < ( $coef * $HOUR ) ) {
+            $locstr = $args{Short}
+                    ? '[_1]m'                      # loc
+                    : '[quant,_1,minute,minutes]'; # loc
+            $unit = $MINUTE;
+        }
+        elsif ( $duration < ( $coef * $DAY ) ) {
+            $locstr = $args{Short}
+                    ? '[_1]h'                      # loc
+                    : '[quant,_1,hour,hours]';     # loc
+            $unit = $HOUR;
+        }
+        elsif ( $duration < ( $coef * $WEEK ) ) {
+            $locstr = $args{Short}
+                    ? '[_1]d'                      # loc
+                    : '[quant,_1,day,days]';       # loc
+            $unit = $DAY;
+        }
+        elsif ( $duration < ( $coef * $MONTH ) ) {
+            $locstr = $args{Short}
+                    ? '[_1]W'                      # loc
+                    : '[quant,_1,week,weeks]';     # loc
+            $unit = $WEEK;
+        }
+        elsif ( $duration < $YEAR ) {
+            $locstr = $args{Short}
+                    ? '[_1]M'                      # loc
+                    : '[quant,_1,month,months]';   # loc
+            $unit = $MONTH;
+        }
+        else {
+            $locstr = $args{Short}
+                    ? '[_1]Y'                      # loc
+                    : '[quant,_1,year,years]';     # loc
+            $unit = $YEAR;
+        }
+        my $value = int( $duration / $unit  + ($i < $args{'Show'}? 0 : 0.5) );
+        $duration -= int( $value * $unit );
+
+        push @res, $self->loc($locstr, $value);
+
+        $coef = 1;
     }
 
     if ( $negative ) {
-        return $self->loc( "[_1] [_2] ago", $s, $time_unit );
+        return $self->loc( "[_1] ago", join ' ', @res );
     }
     else {
-        return $self->loc( "[_1] [_2]", $s, $time_unit );
+        return join ' ', @res;
     }
 }
 
 =head2 AgeAsString
 
-Takes nothing. Returns a string that's the differnce between the
+Takes nothing. Returns a string that's the difference between the
 time in the object and now.
 
 =cut
@@ -425,10 +485,10 @@ sub AgeAsString { return $_[0]->DiffAsString }
 
 =head2 AsString
 
-Returns the object's time as a localized string with curent user's prefered
+Returns the object's time as a localized string with curent user's preferred
 format and timezone.
 
-If the current user didn't choose prefered format then system wide setting is
+If the current user didn't choose preferred format then system wide setting is
 used or L if the latter is not specified. See config option
 C.
 
@@ -438,7 +498,7 @@ sub AsString {
     my $self = shift;
     my %args = (@_);
 
-    return $self->loc("Not set") unless $self->Unix > 0;
+    return $self->loc("Not set") unless $self->IsSet;
 
     my $format = RT->Config->Get( 'DateTimeFormat', $self->CurrentUser ) || 'DefaultFormat';
     $format = { Format => $format } unless ref $format;
@@ -555,13 +615,21 @@ Returns the number of seconds since the epoch
 
 sub Unix {
     my $self = shift; 
-    $self->{'time'} = int(shift || 0) if @_;
+
+    if (@_) {
+        my $time = int(shift || 0);
+        if ($time < 0) {
+            RT->Logger->notice("Passed a unix time less than 0, forcing to 0: [$time]");
+            $time = 0;
+        }
+        $self->{'time'} = int $time;
+    }
     return $self->{'time'};
 }
 
 =head2 DateTime
 
-Alias for L method. Arguments C and