diff options
| author | Ivan Kohler <ivan@freeside.biz> | 2015-07-09 22:18:55 -0700 |
|---|---|---|
| committer | Ivan Kohler <ivan@freeside.biz> | 2015-07-09 22:18:55 -0700 |
| commit | 1c538bfabc2cd31f27067505f0c3d1a46cba6ef0 (patch) | |
| tree | 96922ad4459eda1e649327fd391d60c58d454c53 /rt/lib | |
| parent | 4f5619288413a185e9933088d9dd8c5afbc55dfa (diff) | |
RT 4.2.11, ticket#13852
Diffstat (limited to 'rt/lib')
196 files changed, 23860 insertions, 16840 deletions
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<JSFiles> 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<js/> directory, such as +F<static/js/> in your extension or F<local/static/js/> for local overlays. + =cut sub AddJavaScript { @@ -825,13 +831,17 @@ sub AddJavaScript { =head2 AddStyleSheets -helper method to add css files to C<CSSFiles> 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<css/> directory, such as +F<static/css/> in your extension or F<local/static/css/> 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<Calling function ____ is +deprecated> with a custom message. + +=item Object + +An L<RT::Record> 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</RegisterCacheHandler>). + +Usually called from L</Create> and L</Delete>. + +=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</InvalidateCaches>, usually called itself from +L</Create> and L</Delete>. + +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<RT::ACE> 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 +# <sales@bestpractical.com> +# +# (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<RT-Control> with +C<no-autoopen> substring. + +Status is set to the first possible active status. If the ticket's status is +C<Resolved> then RT finds all possible transitions from C<Resolved> 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 # <sales@bestpractical.com> # # (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<UpdateLastUpdated> to false unless +C<RecordTransaction> is also false. + +=back + +To use these with C<rt-crontool>, 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<are not updated>. =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<does not> notify the creator of the transaction by default +Sets the recipients of this message to Owner, Requestor, AdminCc, Cc or All. +Explicitly B<does not> 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/Shredder/CustomFieldValue.pm b/rt/lib/RT/Action/NotifyOwnerOrAdminCc.pm index 95f136b..2d6e423 100644 --- a/rt/lib/RT/Shredder/CustomFieldValue.pm +++ b/rt/lib/RT/Action/NotifyOwnerOrAdminCc.pm @@ -46,49 +46,31 @@ # # END BPS TAGGED BLOCK }}} -use RT::CustomFieldValue (); -package RT::CustomFieldValue; +package RT::Action::NotifyOwnerOrAdminCc; use strict; use warnings; -use warnings FATAL => 'redefine'; -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; +use base qw(RT::Action::Notify); -# No dependencies that should be deleted with record -# I should decide is TicketCustomFieldValue depends by this or not. -# Today I think no. What would be tomorrow I don't know. +use Email::Address; -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; +=head1 Notify Owner or AdminCc + +If the owner of this ticket is Nobody, notify the AdminCcs. Otherwise, only notify the Owner. + +=cut - my $obj = $self->CustomFieldObj; - if( $obj && defined $obj->id ) { - push( @$list, $obj ); +sub Argument { + my $self = shift; + my $ticket = $self->TicketObj; + if ($ticket->Owner == RT->Nobody->id) { + return 'AdminCc'; } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related CustomField #". $self->id ." object"; + return 'Owner'; } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->__Relates( %args ); } +RT::Base->_ImportOverlays(); + 1; diff --git a/rt/lib/RT/Shredder/ACE.pm b/rt/lib/RT/Action/OpenOnStarted.pm index 57346c0..0995e94 100644 --- a/rt/lib/RT/Shredder/ACE.pm +++ b/rt/lib/RT/Action/OpenOnStarted.pm @@ -46,56 +46,42 @@ # # END BPS TAGGED BLOCK }}} -use RT::ACE (); -package RT::ACE; +=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; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Exceptions; -use RT::Shredder::Constants; -use RT::Shredder::Dependencies; -sub __DependsOn -{ +sub Prepare { my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; + 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; - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__DependsOn( %args ); + return 1; } -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; +RT::Base->_ImportOverlays(); - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} 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<RemoveInappropriateRecipients>. The C<Callback> 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<All> 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 - = '<RT-Ticket-' - . $self->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 # <sales@bestpractical.com> # # (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<RT::Interface::Email/EncodeToMIME>. -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/Shredder/CustomField.pm b/rt/lib/RT/Action/SendForward.pm index a3d542a..5fad224 100644 --- a/rt/lib/RT/Shredder/CustomField.pm +++ b/rt/lib/RT/Action/SendForward.pm @@ -46,81 +46,93 @@ # # END BPS TAGGED BLOCK }}} -use RT::CustomField (); -package RT::CustomField; +# +package RT::Action::SendForward; use strict; use warnings; -use warnings FATAL => 'redefine'; -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; +use base qw(RT::Action::SendEmail); + +use Email::Address; -#TODO: Queues if we wish export tool +=head2 Prepare -sub __DependsOn -{ +=cut + +sub Prepare { 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 => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} + + 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)], ); - return $self->SUPER::__DependsOn( %args ); -} -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - - my $obj = $self->Object; - -# Queue -# Skip if it's global CF - if( $self->Queue ) { - if( $self->QueueObj && $self->QueueObj->Id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related queue #". $self->Queue ." object"; + $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) ) ); } } - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); + if ( RT->Config->Get('ForwardFromUser') ) { + $mime->head->replace( 'X-RT-Sign' => 0 ); + } + + $self->SUPER::Prepare(); } -1; +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<RT::Attachment> object +for the nearest containing part with a matching L</ContentType>. 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<RT::Attachments> object which is preloaded with @@ -276,6 +316,30 @@ sub Children { return($kids); } +=head2 Siblings + +Returns an L<RT::Attachments> 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<RT::Attachments> 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</ContentLength> in bytes, kilobytes, or megabytes as most +appropriate. The size is suffixed with C<MiB>, C<KiB>, or C<B> and the returned +string is localized. - # Do we need any preformatting (wrapping, that is) of the message? +Returns the empty string if the L</ContentLength> 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<RIGHT>, C<DESCRIPTION> [, ...] - -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<RIGHT>, C<CATEGORY> [, ...] - -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 <pre> 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 <<EOT; -The ActiveStatus configuration has been replaced by the new Lifecycles -functionality. You should set the 'active' property of the 'default' -lifecycle and add transition rules; see RT_Config.pm for documentation. -EOT + unless (ref($groups) eq 'HASH') { + RT->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 <<EOT; -The InactiveStatus configuration has been replaced by the new Lifecycles -functionality. You should set the 'inactive' property of the 'default' -lifecycle and add transition rules; see RT_Config.pm for documentation. -EOT + ChartColors => { + 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<RTIR_Config.pm> +will have an C<extension> value of C<RTIR>. + +=item site + +True if the file is considered a site-level override. For example, C<site> +will be false for C<RT_Config.pm> and true for C<RT_SiteConfig.pm>. + +=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 +# <sales@bestpractical.com> +# +# (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<GnuPG|RT::Crypt::GnuPG> +and L<SMIME|RT::Crypt::SMIME> 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<Enable> 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<must> add the +L<Auth::Crypt|RT::Interface::Email::Auth::Crypt> email filter to enable +the handling of incoming encrypted/signed messages. It should be added +in addition to the standard +L<Auth::MailFrom|RT::Interface::Email::Auth::Crypt> 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<AllowEncryptDataInDB> 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<RT::Interface::Email::Auth::Crypt> 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<Email::Address> 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<MIME::Entity> 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<RT_Config/Crypt>. + +=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<RT_Config/Crypt>. +This list is irrelevant unless L<RT::Interface::Email::Auth::Crypt> is +enabled in L<RT_Config/@MailPlugins>. + +=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<RT::Crypt> 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<RT::Crypt::Role> class based on the provided +C<Protocol>. + +=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<Entity>, using all +L</EnabledOnIncoming> encryption protocols. For each node in the MIME +hierarchy, L<RT::Crypt::Role/CheckIfProtected> for that L<MIME::Entity> +is called on each L</EnabledOnIncoming> protocol. Any multipart nodes +not claimed by those protocols are recursed into. + +Finally, L<RT::Crypt::Role/FindScatteredParts> is called on the top-most +entity for each L</EnabledOnIncoming> protocol. + +Returns a list of hash references; each hash reference is guaranteed to +contain a C<Protocol> key describing the protocol of the found part, and +a C<Type> which is either C<encrypted> or C<signed>. The remaining keys +are protocol-dependent; the hashref will be provided to +L</VerifyDecrypt>. + +=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<MIME::Entity> object, and signs and/or encrypts it using the +given C<Protocol>. If not set, C<Recipients> for encryption will be set +by examining the C<To>, C<Cc>, and C<Bcc> headers of the MIME entity. +If not set, C<Signer> defaults to the C<From> of the MIME entity. + +C<Passphrase>, if not provided, will be retrieved using +L<RT::Crypt::Role/GetPassphrase>. + +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<Recipients> defaults to C</UseKeyForSigning>, and C<Recipients> +defaults to the global L<RT::Config/CorrespondAddress>. All other +arguments and return values are identical to L</SignEncrypt>. + +=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<MIME::Entity> object C<ENTITY>, as +found by L</FindProtectedParts>, and calls +L<RT::Crypt::Role/VerifyDecrypt> from the appropriate L<RT::Crypt::Role> +class on each. + +C<Passphrase>, if not provided, will be retrieved using +L<RT::Crypt::Role/GetPassphrase>. + +Returns a list of the hash references returned from +L<RT::Crypt::Role/VerifyDecrypt>. + +=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</VerifyDecrypt>. + +=cut + +sub DecryptContent { + return shift->SimpleImplementationCall( @_ ); +} + +=head2 ParseStatus Protocol => NAME, Status => STRING + +Takes a C<String> 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<Sign>, C<Encrypt>, C<Decrypt>, C<Verify>, +C<PassphraseCheck>, C<RecipientsCheck> and C<Data>. + +=item Status + +Whether the operation was successful; contains C<DONE> on success. +Other possible values include C<ERROR>, C<BAD>, or C<MISSING>. + +=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<Recipient>. Generally this is equivalent to L</GetKeysInfo> +with a C<Type> of <private>, 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<Signer>. Generally this is equivalent to L</GetKeysInfo> +with a C<Type> of <private>, 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</GetKeyInfo>, but the C<Type> is forced to C<public>. + +=cut + +sub GetPublicKeyInfo { + return (shift)->GetKeyInfo( @_, Type => 'public' ); +} + +=head2 GetPrivateKeyInfo Protocol => NAME, KEY => EMAIL + +As per L</GetKeyInfo>, but the C<Type> is forced to C<private>. + +=cut + +sub GetPrivateKeyInfo { + return (shift)->GetKeyInfo( @_, Type => 'private' ); +} + +=head2 GetKeyInfo Protocol => NAME, Type => ('public'|'private'), KEY => EMAIL + +As per L</GetKeysInfo>, but only the first matching key is returned in +the C<info> 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<Type>) for the email address C<Key>. As each protocol has its own key +store, C<Protocol> is also required. If no C<Key> is provided and a +true value for C<Force> is given, returns all keys. + +The return value is a hash containing C<exit_code> and C<message> in the +case of failure, or C<info>, 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<RT::Date> of the date the key was created; undef if unset. + +=item Expire + +An L<RT::Date> 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<String> value, which is a C<< Alice Example +<alice@example.com> >> style email address. Each may also contain +C<Created> and C<Expire> keys, which are L<RT::Date> 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<GnuPG> and C<GnuPGOptions>. 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<gnupg> utility. You can use it to define a keyserver, +enable auto-retrieval of keys, or set almost any option which C<gnupg> +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<must> add the 'Auth::GnuPG' email filter to enable +However, note that you B<must> 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<OutgoingMessagesFormat> 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<AllowEncryptDataInDB>. 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<Passphrase>. 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<undef> 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<undef> 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<NOTE> that options may contain '-' character and such options B<MUST> be -quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'. +B<NOTE> that options may contain the '-' character and such options +B<MUST> be quoted, otherwise you will see the quite cryptic error C<gpg: +Invalid option "--0">. + +Common options include: =over =item --homedir -The GnuPG home directory, by default it is set to F</opt/rt4/var/data/gpg>. +The GnuPG home directory where the keyrings are stored; by default it is +set to F</opt/rt4/var/data/gpg>. -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<GnuPGOptions>. =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<RFC> format for outgoing messages is +used. RT defaults to 'SHA1' by default, but you may wish to override +it. C<gnupng --version> will list the algorithms supported by your +C<gnupg> 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<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html> 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<man gpg> 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...); - -See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`. - -=head2 Errors 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 '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. +'Auth::Crypt' mail plugin. -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. + Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filter...); -=head3 Problems with public keys +See also `perldoc lib/RT/Interface/Email/Auth/Crypt.pm`. -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<Email::Address> 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<MIME::Entity> 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<Signer> argument to set key we sign with this option -overrides gnupg's C<default-key> option. If C<Signer> 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<Passphrase>, but if value is undefined then L</GetPassphrase> -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<Recipients> array, otherwise C<To>, C<Cc> and -C<Bcc> 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; - if ( $part->effective_type eq 'application/pgp-signature' ) { - push @file_indices, $i; + my $type = $part->effective_type; + + 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}$/; - $skip{"$data_part_in"}++; - $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'"); + $RT::Logger->debug("Found encrypted attachment '$fname'"); + + $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::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{'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<Note> 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; + # 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}; + } - my ($handles, $handle_list) = _make_gpg_handles(); - my %handle = %$handle_list; + return %res if $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; - }; - - 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 +# <sales@bestpractical.com> +# +# (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 +# <sales@bestpractical.com> +# +# (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<RT_Config/GnuPG> 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<RT::Crypt/SignEncrypt>, with the omission of +C<Protocol>. + +=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<RT::Crypt/SignEncryptContent>, with the omission of C<Protocol>. + +=cut + +requires 'SignEncryptContent'; + +=head2 VerifyDecrypt Info => HASHREF, [ Passphrase => undef ] + +The C<Info> key is a hashref as returned from L</FindScatteredParts> or +L</CheckIfProtected>. 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<RT::Crypt/DecryptContent>, with the +omission of C<Protocol>. + +=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<RT::Crypt/ParseStatus>. + +=cut + +requires 'ParseStatus'; + +=head2 FindScatteredParts Parts => ARRAYREF, Parents => HASHREF, Skip => HASHREF + +Passed the list of unclaimed L<MIME::Entity> objects in C<Parts>, 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</CheckIfProtected> +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<Skip> 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<Type> key which is either C<signed> or C<encrypted>. The +remaining keys are protocol-dependent; the hashref will be provided to +L</VerifyDecrypt>. + +=cut + +requires 'FindScatteredParts'; + +=head2 CheckIfProtected Entity => MIME::Entity + +Examines the provided L<MIME::Entity>, 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<Type> which is either C<encrypted> or +C<signed>. The remaining keys are protocol-dependent; the hashref will +be provided to L</VerifyDecrypt>. + +=cut + +requires 'CheckIfProtected'; + +=head2 GetKeysInfo Type => ('public'|'private'), Key => EMAIL + +Returns a list of keys matching the email C<Key>, as described in +L<RT::Crypt/GetKeysInfo>. + +=cut + +requires 'GetKeysInfo'; + +=head2 GetKeysForEncryption Recipient => EMAIL + +Returns a list of keys suitable for encryption, as described in +L<RT::Crypt/GetKeysForEncryption>. + +=cut + +requires 'GetKeysForEncryption'; + +=head2 GetKeysForSigning Signer => EMAIL + +Returns a list of keys suitable for encryption, as described in +L<RT::Crypt/GetKeysForSigning>. + +=cut + +requires 'GetKeysForSigning'; + +=head2 ParseDate STRING + +Takes a string, and parses and returns a L<RT::Date>; 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 +# <sales@bestpractical.com> +# +# (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<RT::Crypt>. + +=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<email.address@example.com.pem>. See L</Keyring configuration>. + +=head3 CAPath + +C<CAPath> 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<c_rehash>). Only SMIME +certificates signed by these certificate authorities will be treated as +valid signatures. If left unset (and C<AcceptUntrustedCAs> 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<CAPath> 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<Passphrase> 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</Keyring> option +of the L<RT_Config/%SMIME>. 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<email.address@example.com.pem>, 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<RIGHT>, C<DESCRIPTION> [, ...] - -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<RIGHT>, C<CATEGORY> [, ...] - -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<NAME>, [...] + +Loads the Custom field named NAME. As other optional parameters, takes: + +=over + +=item LookupType => C<LOOKUPTYPE> + +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<LookupType> such as +L<RT::Ticket/CustomFieldLookupType> or +L<RT::User/CustomFieldLookupType>. + +=item ObjectType => C<CLASS> + +The class of object that the custom field is applied to. This can be +intuited from the provided C<LookupType>. -Loads the Custom field named NAME. +=item ObjectId => C<ID> -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<LookupType> 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<BOOLEAN> -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<BOOLEAN> -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<ObjectId>; defaults to off. Non-global custom fields are returned +preferentially. + +=back + +For backwards compatibility, a value passed for C<Queue> is equivalent +to specifying a C<LookupType> of L<RT::Ticket/CustomFieldLookupType>, +and a C<ObjectId> of the value passed as C<Queue>. + +If multiple custom fields match the above constraints, the first +according to C<SortOrder> will be returned; ties are broken by C<id>, +lowest-first. + +=head2 LoadNameAndQueue + +=head2 LoadByNameAndQueue + +Deprecated alternate names for L</LoadByName>. =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</RecordClassFromLookupType>). + +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</LookupType>. -See all L</NotAppliedTo> . +=head2 CustomGroupings -Doesn't takes into account if object is applied globally. +Identical to L</Groupings> 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</LookupType>. -See all L</AppliedTo> . +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</Elements/ShowCustomFields> and +F</Elements/EditCustomFields>. 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<RT::Record> 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<RT::Ticket> and +L<RT::User>), 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</LookupType>. +See all L</NotAddedTo> . - # 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</LookupType>. +See all L</AddedTo> . + +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<RT::ObjectCustomField> -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<name>, C<description>, and -C<sortorder>. +hash references must contain a key for C<name> and can optionally contain +keys for C<description>, C<sortorder>, and C<category>. 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</Limit> for each CF name as appropriate. + +Requires an L<RT::Record> 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<Caveat:> 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</CustomFields> method on an +L<RT::Record> 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<QUEUEID>, similar to L</LimitToGlobalOrObjectId>. -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<QUEUEID>, and limits the Custom Field collection to +those only applied directly to it; this limit is OR'd with other +L</LimitToQueue> and L</LimitToGlobal> 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</LimitToQueue> 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</DefaultFormat> if the latter is not specified. See config option C<DateTimeFormat>. @@ -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</Get> method. Arguments C<Date> and <Time> +Alias for L</Get> method. Arguments C<Date> and C<Time> are fixed to true values, other arguments could be used as described in L</Get>. @@ -601,7 +669,7 @@ sub Time { =head2 Get -Returnsa a formatted and localized string that represets time of +Returns a formatted and localized string that represents the time of the current object. @@ -639,7 +707,7 @@ Each method takes several arguments: Formatters may also add own arguments to the list, for example in RFC2822 format day of time in output is optional so it -understand boolean argument C<DayOfTime>. +understands boolean argument C<DayOfTime>. =head3 Formatters @@ -687,7 +755,7 @@ sub DefaultFormat $self->Localtime($args{'Timezone'}); $wday = $self->GetWeekday($wday); $mon = $self->GetMonth($mon); - ($mday, $hour, $min, $sec) = map { sprintf "%02d", $_ } ($mday, $hour, $min, $sec); + $_ = sprintf "%02d", $_ foreach $mday, $hour, $min, $sec; if( $args{'Date'} && !$args{'Time'} ) { return $self->loc('[_1] [_2] [_3] [_4]', @@ -734,8 +802,8 @@ sub LocaleObj { Returns date and time as string, with user localization. Supports arguments: C<DateFormat> and C<TimeFormat> which may contains date and -time format as specified in L<DateTime::Locale> (default to full_date_format and -medium_time_format), C<AbbrDay> and C<AbbrMonth> which may be set to 0 if +time format as specified in L<DateTime::Locale> (default to C<date_format_full> and +C<time_format_medium>), C<AbbrDay> and C<AbbrMonth> which may be set to 0 if you want full Day/Month names instead of abbreviated ones. =cut @@ -796,11 +864,11 @@ sub LocalizedDateTime =head3 ISO Returns the object's date in ISO format C<YYYY-MM-DD mm:hh:ss>. -ISO format is locale independant, but adding timezone offset info +ISO format is locale-independent, but adding timezone offset info is not implemented yet. Supports arguments: C<Timezone>, C<Date>, C<Time> and C<Seconds>. -See </Output formatters> for description of arguments. +See L</Output formatters> for description of arguments. =cut @@ -822,7 +890,7 @@ sub ISO { my $res = ''; $res .= sprintf("%04d-%02d-%02d", $year, $mon, $mday) if $args{'Date'}; $res .= sprintf(' %02d:%02d', $hour, $min) if $args{'Time'}; - $res .= sprintf(':%02d', $sec, $min) if $args{'Time'} && $args{'Seconds'}; + $res .= sprintf(':%02d', $sec) if $args{'Time'} && $args{'Seconds'}; $res =~ s/^\s+//; return $res; @@ -833,12 +901,12 @@ sub ISO { Returns the object's date and time in W3C date time format (L<http://www.w3.org/TR/NOTE-datetime>). -Format is locale independand and is close enought to ISO, but +Format is locale-independent and is close enough to ISO, but note that date part is B<not optional> and output string has timezone offset mark in C<[+-]hh:mm> format. Supports arguments: C<Timezone>, C<Time> and C<Seconds>. -See </Output formatters> for description of arguments. +See L</Output formatters> for description of arguments. =cut @@ -862,7 +930,7 @@ sub W3CDTF { $res .= sprintf("%04d-%02d-%02d", $year, $mon, $mday); if ( $args{'Time'} ) { $res .= sprintf('T%02d:%02d', $hour, $min); - $res .= sprintf(':%02d', $sec, $min) if $args{'Seconds'}; + $res .= sprintf(':%02d', $sec) if $args{'Seconds'}; if ( $offset ) { $res .= sprintf "%s%02d:%02d", $self->_SplitOffset( $offset ); } else { @@ -878,11 +946,11 @@ sub W3CDTF { Returns the object's date and time in RFC2822 format, for example C<Sun, 06 Nov 1994 08:49:37 +0000>. -Format is locale independand as required by RFC. Time +Format is locale-independent as required by RFC. Time part always has timezone offset in digits with sign prefix. Supports arguments: C<Timezone>, C<Date>, C<Time>, C<DayOfWeek> -and C<Seconds>. See </Output formatters> for description of +and C<Seconds>. See L</Output formatters> for description of arguments. =cut @@ -920,8 +988,8 @@ Returns the object's date and time in RFC2616 (HTTP/1.1) format, for example C<Sun, 06 Nov 1994 08:49:37 GMT>. While the RFC describes version 1.1 of HTTP, but the same form date can be used in version 1.0. -Format is fixed length, locale independand and always represented in GMT -what makes it quite useless for users, but any date in HTTP transfers +Format is fixed-length, locale-independent and always represented in GMT +which makes it quite useless for users, but any date in HTTP transfers must be presented using this format. HTTP-date = rfc1123 | ... @@ -936,7 +1004,7 @@ must be presented using this format. Supports arguments: C<Date> and C<Time>, but you should use them only for some personal reasons, RFC2616 doesn't define any optional parts. -See </Output formatters> for description of arguments. +See L</Output formatters> for description of arguments. =cut @@ -955,10 +1023,12 @@ sub RFC2616 { =head4 iCal -Returns the object's date and time in iCalendar format, +Returns the object's date and time in iCalendar format. +If only date requested then user's timezone is used, otherwise +it's UTC. Supports arguments: C<Date> and C<Time>. -See </Output formatters> for description of arguments. +See L</Output formatters> for description of arguments. =cut @@ -1009,11 +1079,19 @@ argument unix C<$time>, default value is the current unix time. Returns object's date and time in the format provided by perl's builtin functions C<localtime> and C<gmtime> with two exceptions: -1) "Year" is a four-digit year, rather than "years since 1900" +=over + +=item 1) + +"Year" is a four-digit year, rather than "years since 1900" + +=item 2) -2) The last element of the array returned is C<offset>, which +The last element of the array returned is C<offset>, which represents timezone offset against C<UTC> in seconds. +=back + =cut sub Localtime @@ -1035,7 +1113,7 @@ sub Localtime POSIX::tzset(); @local = localtime($unix); } - POSIX::tzset(); # return back previouse value + POSIX::tzset(); # return back previous value } $local[5] += 1900; # change year to 4+ digits format my $offset = Time::Local::timegm_nocheck(@local) - $unix; @@ -1047,16 +1125,16 @@ sub Localtime Takes argument C<$context>, which determines whether we should treat C<@time> as "user local", "system" or "UTC" time. -C<@time> is array returned by L<Localtime> functions. Only first +C<@time> is array returned by L</Localtime> functions. Only first six elements are mandatory - $sec, $min, $hour, $mday, $mon and $year. You may pass $wday, $yday and $isdst, these are ignored. If you pass C<$offset> as ninth argument, it's used instead of C<$context>. It's done such way as code -C<$self->Timelocal('utc', $self->Localtime('server'))> doesn't -makes much sense and most probably would produce unexpected -result, so the method ignore 'utc' context and uses offset -returned by L<Localtime> method. +C<< $self->Timelocal('utc', $self->Localtime('server')) >> doesn't +make much sense and most probably would produce unexpected +results, so the method ignores 'utc' context and uses the offset +returned by the L</Localtime> method. =cut @@ -1087,40 +1165,36 @@ sub Timelocal { =head3 Timezone $context -Returns the timezone name. - -Takes one argument, C<$context> argument which could be C<user>, C<server> or C<utc>. +Returns the timezone name for the specified context. C<$context> +should be one of these values: =over -=item user +=item C<user> -Default value is C<user> that mean it returns current user's Timezone value. +The current user's Timezone value will be returned. -=item server +=item C<server> -If context is C<server> it returns value of the C<Timezone> RT config option. - -=item utc - -If both server's and user's timezone names are undefined returns 'UTC'. +The value of the C<Timezone> RT config option will be returned. =back +For any other value of C<$context>, or if the specified context has no +defined timezone, C<UTC> is returned. + =cut sub Timezone { my $self = shift; if (@_ == 0) { - Carp::carp "RT::Date->Timezone is a setter only"; + Carp::carp 'RT::Date->Timezone requires a context argument'; return undef; } my $context = lc(shift); - $context = 'utc' unless $context =~ /^(?:utc|server|user)$/i; - my $tz; if( $context eq 'user' ) { $tz = $self->CurrentUser->UserObj->Timezone; @@ -1134,6 +1208,20 @@ sub Timezone { return $tz; } +=head3 IsSet + +Returns true if this Date is set in the database, otherwise returns a false value. + +This avoids needing to compare to 1970-01-01 in any of your code. + +=cut + +sub IsSet { + my $self = shift; + return $self->Unix ? 1 : 0; + +} + RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/DependencyWalker.pm b/rt/lib/RT/DependencyWalker.pm new file mode 100644 index 0000000..4d1e354 --- /dev/null +++ b/rt/lib/RT/DependencyWalker.pm @@ -0,0 +1,305 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::DependencyWalker; + +use strict; +use warnings; + +use RT::DependencyWalker::FindDependencies; +use Carp; + +sub new { + my $class = shift; + my $self = bless {}, $class; + $self->Init(@_); + return $self; +} + +sub Init { + my $self = shift; + my %args = ( + First => "top", + GC => 0, + Page => 100, + Progress => undef, + MessageHandler => \&Carp::carp, + @_ + ); + + $self->{first} = $args{First}; + $self->{GC} = $args{GC}; + $self->{Page} = $args{Page}; + $self->{progress} = $args{Progress}; + $self->{msg} = $args{MessageHandler}, + $self->{stack} = []; +} + +sub PushObj { + my $self = shift; + push @{$self->{stack}}, { object => $_ } + for @_; +} + +sub Walk { + my $self = shift; + + $self->PushObj( @_ ); + + # Ensure that RT::Ticket's ->Load doesn't follow a merged ticket to + # the ticket it was merged into. + no warnings 'redefine'; + local *RT::Ticket::Load = sub { + my $self = shift; + my $id = shift; + $self->LoadById( $id ); + return $self->Id; + }; + + # When we walk ticket links, find deleted tickets as well + local *RT::Links::IsValidLink = sub { + my $self = shift; + my $link = shift; + return unless $link && ref $link && $link->Target && $link->Base; + return 1; + }; + + $self->{visited} = {}; + $self->{seen} = {}; + $self->{gc_count} = 0; + + my $stack = $self->{stack}; + while (@{$stack}) { + my %frame = %{ shift @{$stack} }; + $self->{top} = []; + $self->{replace} = []; + $self->{bottom} = []; + my $ref = $frame{object}; + if ($ref->isa("RT::Record")) { + $self->Process(%frame); + } else { + unless ($ref->{unrolled}) { + $ref->FindAllRows; + $ref->RowsPerPage( $self->{Page} ); + $ref->FirstPage; + $ref->{unrolled}++; + } + my $last; + while (my $obj = $ref->DBIx::SearchBuilder::Next) { + $last = $obj->Id; + $self->Process(%frame, object => $obj ); + } + if (defined $last) { + $self->NextPage($ref => $last); + push @{$self->{replace}}, \%frame; + } + } + unshift @{$stack}, @{$self->{replace}}; + unshift @{$stack}, @{$self->{top}}; + push @{$stack}, @{$self->{bottom}}; + + if ($self->{GC} > 0 and $self->{gc_count} > $self->{GC}) { + $self->{gc_count} = 0; + require Time::HiRes; + my $start_time = Time::HiRes::time(); + $self->{msg}->("Starting GC pass..."); + my $start_size = @{$self->{stack}}; + @{ $self->{stack} } = grep { + $_->{object}->isa("RT::Record") + ? not exists $self->{visited}{$_->{uid} ||= $_->{object}->UID} + : ( $_->{has_results} ||= do { + $_->{object}->FindAllRows; + $_->{object}->RowsPerPage(1); + $_->{object}->Count; + } ) + } @{ $self->{stack} }; + my $end_time = Time::HiRes::time(); + my $end_size = @{$self->{stack}}; + my $size = $start_size - $end_size; + my $time = $end_time - $start_time; + $self->{msg}->( + sprintf( + "GC -- %d removed, %.2f seconds, %d/s", + $size, $time, int($size/$time) + ) + ); + } + } + $self->{progress}->(undef, 'force') if $self->{progress}; +} + +sub NextPage { + my $self = shift; + my $collection = shift; + + $collection->NextPage; +} + +sub Process { + my $self = shift; + my %args = ( + object => undef, + direction => undef, + from => undef, + @_ + ); + + my $obj = $args{object}; + return if $obj->isa("RT::System"); + + my $uid = $obj->UID; + unless ($uid) { + warn "$args{direction} from $args{from} to $obj is an invalid reference"; + return; + } + $self->{progress}->($obj) if $self->{progress}; + if (exists $self->{visited}{$uid}) { + # Already visited -- no-op + $self->Again(%args); + } elsif (exists $obj->{satisfied}) { + # All dependencies visited -- time to visit + $self->Visit(%args); + $self->{visited}{$uid}++; + } elsif (exists $self->{seen}{$uid}) { + # All of the dependencies are on the stack already. We may not + # have gotten to them, but we will eventually. This _may_ be a + # cycle, but true cycle detection is too memory-intensive, as it + # requires keeping track of the history of how each dep got + # added to the stack, all of the way back. + $self->ForcedVisit(%args); + $self->{visited}{$uid}++; + } else { + # Nothing known about this previously; add its deps to the + # stack, then objects it refers to. + return if defined $args{from} + and not $self->Observe(%args); + my $deps = RT::DependencyWalker::FindDependencies->new; + $obj->FindDependencies($self, $deps); + # Shove it back for later + push @{$self->{replace}}, \%args; + if ($self->{first} eq "top") { + # Top-first; that is, visit things we point to first, + # then deal with us, then deal with things that point to + # us. For serialization. + $self->PrependDeps( out => $deps, $uid ); + $self->AppendDeps( in => $deps, $uid ); + } else { + # Bottom-first; that is, deal with things that point to + # us first, then deal with us, then deal with things we + # point to. For removal. + $self->PrependDeps( in => $deps, $uid ); + $self->AppendDeps( out => $deps, $uid ); + } + $obj->{satisfied}++; + $self->{seen}{$uid}++; + $self->{gc_count}++ if $self->{GC} > 0; + } +} + +sub Observe { 1 } + +sub Again {} + +sub Visit {} + +sub ForcedVisit { + my $self = shift; + $self->Visit( @_ ); +} + +sub AppendDeps { + my $self = shift; + my ($dir, $deps, $from) = @_; + for my $obj (@{$deps->{$dir}}) { + if (not defined $obj) { + warn "$dir from $from contained an invalid reference"; + next; + } elsif ($obj->isa("RT::Record")) { + warn "$dir from $from to $obj is an invalid reference" unless $obj->UID; + next if $self->{GC} < 0 and exists $self->{seen}{$obj->UID}; + } else { + $obj->FindAllRows; + if ($self->{GC} < 0) { + $obj->RowsPerPage(1); + next unless $obj->Count; + } + } + push @{$self->{bottom}}, { + object => $obj, + direction => $dir, + from => $from, + }; + } +} + +sub PrependDeps { + my $self = shift; + my ($dir, $deps, $from) = @_; + for my $obj (@{$deps->{$dir}}) { + if (not defined $obj) { + warn "$dir from $from contained an invalid reference"; + next; + } elsif ($obj->isa("RT::Record")) { + warn "$dir from $from to $obj is an invalid reference" unless $obj->UID; + next if $self->{GC} < 0 and exists $self->{visited}{$obj->UID}; + } else { + $obj->FindAllRows; + if ($self->{GC} < 0) { + $obj->RowsPerPage(1); + next unless $obj->Count; + } + } + unshift @{$self->{top}}, { + object => $obj, + direction => $dir, + from => $from, + }; + } +} + +1; diff --git a/rt/lib/RT/DependencyWalker/FindDependencies.pm b/rt/lib/RT/DependencyWalker/FindDependencies.pm new file mode 100644 index 0000000..50de016 --- /dev/null +++ b/rt/lib/RT/DependencyWalker/FindDependencies.pm @@ -0,0 +1,65 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::DependencyWalker::FindDependencies; + +use strict; +use warnings; + +sub new { + my $class = shift; + return bless {out => [], in => []}, $class; +} + +sub Add { + my $self = shift; + my ($dir, $obj) = @_; + push @{$self->{$dir}}, $obj; +} + +1; diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm index 695b744..2954505 100644 --- a/rt/lib/RT/EmailParser.pm +++ b/rt/lib/RT/EmailParser.pm @@ -122,10 +122,8 @@ sub SmartParseMIMEEntityFromScalar { close($fh); if ( -f $temp_file ) { - # We have to trust the temp file's name -- untaint it - $temp_file =~ /(.*)/; - my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} ); - unlink($1); + my $entity = $self->ParseMIMEEntityFromFile( $temp_file, $args{'Decode'}, $args{'Exact'} ); + unlink($temp_file); return $entity; } } @@ -528,30 +526,45 @@ we can use that removes the bandaid =cut +use Email::Address::List; + sub ParseEmailAddress { my $self = shift; my $address_string = shift; - $address_string =~ s/^\s+|\s+$//g; + my @list = Email::Address::List->parse( + $address_string, + skip_comments => 1, + skip_groups => 1, + ); + my $logger = sub { RT->Logger->error( + "Unable to parse an email address from $address_string: ". shift + ) }; my @addresses; - # if it looks like a username / local only email - if ($address_string !~ /@/ && $address_string =~ /^\w+$/) { - my $user = RT::User->new( RT->SystemUser ); - my ($id, $msg) = $user->Load($address_string); - if ($id) { - push @addresses, Email::Address->new($user->Name,$user->EmailAddress); + foreach my $e ( @list ) { + if ($e->{'type'} eq 'mailbox') { + if ($e->{'not_ascii'}) { + $logger->($e->{'value'} ." contains not ASCII values"); + next; + } + push @addresses, $e->{'value'} + } elsif ( $e->{'value'} =~ /^\s*(\w+)\s*$/ ) { + my $user = RT::User->new( RT->SystemUser ); + $user->Load( $1 ); + if ($user->id) { + push @addresses, Email::Address->new($user->Name, $user->EmailAddress); + } else { + $logger->($e->{'value'} ." is not a valid email address and is not user name"); + } } else { - $RT::Logger->error("Unable to parse an email address from $address_string: $msg"); + $logger->($e->{'value'} ." is not a valid email address"); } - } else { - @addresses = Email::Address->parse($address_string); } $self->CleanupAddresses(@addresses); return @addresses; - } =head2 CleanupAddresses ARRAY diff --git a/rt/lib/RT/Generated.pm.in b/rt/lib/RT/Generated.pm.in index 4e23043..9dcb80b 100644 --- a/rt/lib/RT/Generated.pm.in +++ b/rt/lib/RT/Generated.pm.in @@ -51,6 +51,7 @@ use warnings; use strict; our $VERSION = '@RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.@RT_VERSION_PATCH@'; +our ($MAJOR_VERSION, $MINOR_VERSION, $REVISION) = $VERSION =~ /^(\d)\.(\d)\.(\d+)/; @DATABASE_ENV_PREF@ @@ -59,12 +60,15 @@ $EtcPath = '@RT_ETC_PATH@'; $BinPath = '@RT_BIN_PATH@'; $SbinPath = '@RT_SBIN_PATH@'; $VarPath = '@RT_VAR_PATH@'; +$FontPath = '@RT_FONT_PATH@'; $LexiconPath = '@RT_LEXICON_PATH@'; +$StaticPath = '@RT_STATIC_PATH@'; $PluginPath = '@RT_PLUGIN_PATH@'; $LocalPath = '@RT_LOCAL_PATH@'; $LocalEtcPath = '@LOCAL_ETC_PATH@'; $LocalLibPath = '@LOCAL_LIB_PATH@'; $LocalLexiconPath = '@LOCAL_LEXICON_PATH@'; +$LocalStaticPath = '@LOCAL_STATIC_PATH@'; $LocalPluginPath = '@LOCAL_PLUGIN_PATH@'; # $MasonComponentRoot is where your rt instance keeps its mason html files $MasonComponentRoot = '@MASON_HTML_PATH@'; diff --git a/rt/lib/RT/Graph/Tickets.pm b/rt/lib/RT/Graph/Tickets.pm index 52c4b72..6fc5310 100644 --- a/rt/lib/RT/Graph/Tickets.pm +++ b/rt/lib/RT/Graph/Tickets.pm @@ -299,9 +299,12 @@ sub TicketLinks { } $args{'Seen'} ||= {}; - return $args{'Graph'} if $args{'Seen'}{ $args{'Ticket'}->id }++; - - $self->AddTicket( %args ); + if ( $args{'Seen'}{ $args{'Ticket'}->id } && $args{'Seen'}{ $args{'Ticket'}->id } <= $args{'CurrentDepth'} ) { + return $args{'Graph'}; + } elsif ( ! defined $args{'Seen'}{ $args{'Ticket'}->id } ) { + $self->AddTicket( %args ); + } + $args{'Seen'}{ $args{'Ticket'}->id } = $args{'CurrentDepth'}; return $args{'Graph'} if $args{'MaxDepth'} && $args{'CurrentDepth'} >= $args{'MaxDepth'}; diff --git a/rt/lib/RT/Group.pm b/rt/lib/RT/Group.pm index 80e4ca5..b79f474 100755 --- a/rt/lib/RT/Group.pm +++ b/rt/lib/RT/Group.pm @@ -62,12 +62,6 @@ my $group = RT::Group->new($CurrentUser); An RT group object. -=head1 METHODS - - - - - =cut @@ -79,6 +73,9 @@ use warnings; use base 'RT::Record'; +use Role::Basic 'with'; +with "RT::Record::Role::Rights"; + sub Table {'Groups'} @@ -88,97 +85,18 @@ use RT::GroupMembers; use RT::Principals; use RT::ACL; -use vars qw/$RIGHTS $RIGHT_CATEGORIES/; - -$RIGHTS = { - AdminGroup => 'Modify group metadata or delete group', # loc_pair - AdminGroupMembership => 'Modify group membership roster', # loc_pair - ModifyOwnMembership => 'Join or leave group', # loc_pair - EditSavedSearches => 'Create, modify and delete saved searches', # loc_pair - ShowSavedSearches => 'View saved searches', # loc_pair - SeeGroup => 'View group', # loc_pair - SeeGroupDashboard => 'View group dashboards', # loc_pair - CreateGroupDashboard => 'Create group dashboards', # loc_pair - ModifyGroupDashboard => 'Modify group dashboards', # loc_pair - DeleteGroupDashboard => 'Delete group dashboards', # loc_pair -}; - -$RIGHT_CATEGORIES = { - AdminGroup => 'Admin', - AdminGroupMembership => 'Admin', - ModifyOwnMembership => 'Staff', - EditSavedSearches => 'Admin', - ShowSavedSearches => 'Staff', - SeeGroup => 'Staff', - SeeGroupDashboard => 'Staff', - CreateGroupDashboard => 'Admin', - ModifyGroupDashboard => 'Admin', - DeleteGroupDashboard => 'Admin', -}; - -# Tell RT::ACE that this sort of object can get acls granted -$RT::ACE::OBJECT_TYPES{'RT::Group'} = 1; - - -# - -# TODO: This should be refactored out into an RT::ACLedObject or something -# stuff the rights into a hash of rights that can exist. - -__PACKAGE__->AddRights(%$RIGHTS); -__PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES); - -=head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...] - -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 AvailableRights - -Returns a hash of available rights for this object. The keys are the right names and the values are a description of what the rights do - -=cut - -sub AvailableRights { - my $self = shift; - return($RIGHTS); -} - -=head2 RightCategories - -Returns a hashref where the keys are rights for this type of object and the -values are the category (General, Staff, Admin) the right falls into. - -=cut - -sub RightCategories { - return $RIGHT_CATEGORIES; -} - -=head2 AddRightCategories C<RIGHT>, C<CATEGORY> [, ...] - -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 }; -} - +__PACKAGE__->AddRight( Admin => AdminGroup => 'Modify group metadata or delete group'); # loc +__PACKAGE__->AddRight( Admin => AdminGroupMembership => 'Modify group membership roster'); # loc +__PACKAGE__->AddRight( Staff => ModifyOwnMembership => 'Join or leave group'); # loc +__PACKAGE__->AddRight( Admin => EditSavedSearches => 'Create, modify and delete saved searches'); # loc +__PACKAGE__->AddRight( Staff => ShowSavedSearches => 'View saved searches'); # loc +__PACKAGE__->AddRight( Staff => SeeGroup => 'View group'); # loc +__PACKAGE__->AddRight( Staff => SeeGroupDashboard => 'View group dashboards'); # loc +__PACKAGE__->AddRight( Admin => CreateGroupDashboard => 'Create group dashboards'); # loc +__PACKAGE__->AddRight( Admin => ModifyGroupDashboard => 'Modify group dashboards'); # loc +__PACKAGE__->AddRight( Admin => DeleteGroupDashboard => 'Delete group dashboards'); # loc +=head1 METHODS =head2 SelfDescription @@ -187,32 +105,37 @@ Returns a user-readable description of what this group is for and what it's name =cut sub SelfDescription { - my $self = shift; - if ($self->Domain eq 'ACLEquivalence') { - my $user = RT::Principal->new($self->CurrentUser); - $user->Load($self->Instance); - return $self->loc("user [_1]",$user->Object->Name); - } - elsif ($self->Domain eq 'UserDefined') { - return $self->loc("group '[_1]'",$self->Name); - } - elsif ($self->Domain eq 'RT::System-Role') { - return $self->loc("system [_1]",$self->Type); - } - elsif ($self->Domain eq 'RT::Queue-Role') { - my $queue = RT::Queue->new($self->CurrentUser); - $queue->Load($self->Instance); - return $self->loc("queue [_1] [_2]",$queue->Name, $self->Type); - } - elsif ($self->Domain eq 'RT::Ticket-Role') { - return $self->loc("ticket #[_1] [_2]",$self->Instance, $self->Type); - } - elsif ($self->Domain eq 'SystemInternal') { - return $self->loc("system group '[_1]'",$self->Type); - } - else { - return $self->loc("undescribed group [_1]",$self->Id); - } + my $self = shift; + if ($self->Domain eq 'ACLEquivalence') { + my $user = RT::Principal->new($self->CurrentUser); + $user->Load($self->Instance); + return $self->loc("user [_1]",$user->Object->Name); + } + elsif ($self->Domain eq 'UserDefined') { + return $self->loc("group '[_1]'",$self->Name); + } + elsif ($self->Domain eq 'RT::System-Role') { + return $self->loc("system [_1]",$self->Name); + } + elsif ($self->Domain eq 'RT::Queue-Role') { + my $queue = RT::Queue->new($self->CurrentUser); + $queue->Load($self->Instance); + return $self->loc("queue [_1] [_2]",$queue->Name, $self->Name); + } + elsif ($self->Domain eq 'RT::Ticket-Role') { + return $self->loc("ticket #[_1] [_2]",$self->Instance, $self->Name); + } + elsif ($self->RoleClass) { + my $class = lc $self->RoleClass; + $class =~ s/^RT:://i; + return $self->loc("[_1] #[_2] [_3]", $self->loc($class), $self->Instance, $self->Name); + } + elsif ($self->Domain eq 'SystemInternal') { + return $self->loc("system group '[_1]'",$self->Name); + } + else { + return $self->loc("undescribed group [_1]",$self->Id); + } } @@ -285,7 +208,7 @@ sub LoadACLEquivalenceGroup { return $self->LoadByCols( Domain => 'ACLEquivalence', - Type => 'UserEquiv', + Name => 'UserEquiv', Instance => $principal, ); } @@ -307,79 +230,120 @@ sub LoadSystemInternalGroup { return $self->LoadByCols( Domain => 'SystemInternal', - Type => $identifier, + Name => $identifier, ); } +=head2 LoadRoleGroup +Takes a paramhash of Object and Name and attempts to load the suitable role +group for said object. -=head2 LoadTicketRoleGroup { Ticket => TICKET_ID, Type => TYPE } +=cut -Loads a ticket group from the database. +sub LoadRoleGroup { + my $self = shift; + my %args = ( + Object => undef, + Name => undef, + @_ + ); -Takes a param hash with 2 parameters: + my $object = delete $args{Object}; - Ticket is the TicketId we're curious about - Type is the type of Group we're trying to load: - Requestor, Cc, AdminCc, Owner + return wantarray ? (0, $self->loc("Object passed is not loaded")) : 0 + unless $object->id; + + # Translate Object to Domain + Instance + $args{Domain} = ref($object) . "-Role"; + $args{Instance} = $object->id; + + return $self->LoadByCols(%args); +} + + +=head2 LoadTicketRoleGroup { Ticket => TICKET_ID, Name => TYPE } + +Deprecated in favor of L</LoadRoleGroup> or L<RT::Record/RoleGroup>. =cut sub LoadTicketRoleGroup { - my $self = shift; - my %args = (Ticket => '0', - Type => undef, - @_); - $self->LoadByCols( Domain => 'RT::Ticket-Role', - Instance =>$args{'Ticket'}, - Type => $args{'Type'} - ); + my $self = shift; + my %args = ( + Ticket => '0', + Name => undef, + @_, + ); + RT->Deprecated( + Instead => "RT::Group->LoadRoleGroup or RT::Ticket->RoleGroup", + Remove => "4.4", + ); + $args{'Name'} = $args{'Type'} if exists $args{'Type'}; + $self->LoadByCols( + Domain => 'RT::Ticket-Role', + Instance => $args{'Ticket'}, + Name => $args{'Name'}, + ); } =head2 LoadQueueRoleGroup { Queue => Queue_ID, Type => TYPE } -Loads a Queue group from the database. - -Takes a param hash with 2 parameters: - - Queue is the QueueId we're curious about - Type is the type of Group we're trying to load: - Requestor, Cc, AdminCc, Owner +Deprecated in favor of L</LoadRoleGroup> or L<RT::Record/RoleGroup>. =cut sub LoadQueueRoleGroup { - my $self = shift; - my %args = (Queue => undef, - Type => undef, - @_); - $self->LoadByCols( Domain => 'RT::Queue-Role', - Instance =>$args{'Queue'}, - Type => $args{'Type'} - ); + my $self = shift; + my %args = ( + Queue => undef, + Name => undef, + @_, + ); + RT->Deprecated( + Instead => "RT::Group->LoadRoleGroup or RT::Queue->RoleGroup", + Remove => "4.4", + ); + $args{'Name'} = $args{'Type'} if exists $args{'Type'}; + $self->LoadByCols( + Domain => 'RT::Queue-Role', + Instance => $args{'Queue'}, + Name => $args{'Name'}, + ); } -=head2 LoadSystemRoleGroup Type - -Loads a System group from the database. - -Takes a single param: Type +=head2 LoadSystemRoleGroup Name - Type is the type of Group we're trying to load: - Requestor, Cc, AdminCc, Owner +Deprecated in favor of L</LoadRoleGroup> or L<RT::Record/RoleGroup>. =cut sub LoadSystemRoleGroup { - my $self = shift; + my $self = shift; my $type = shift; - $self->LoadByCols( Domain => 'RT::System-Role', - Type => $type - ); + RT->Deprecated( + Instead => "RT::Group->LoadRoleGroup or RT::System->RoleGroup", + Remove => "4.4", + ); + $self->LoadByCols( + Domain => 'RT::System-Role', + Instance => RT::System->Id, + Name => $type + ); +} + +sub LoadByCols { + my $self = shift; + my %args = ( @_ ); + if ( exists $args{'Type'} ) { + RT->Deprecated( Instead => 'Name', Arguments => 'Type', Remove => '4.4' ); + $args{'Name'} = $args{'Type'}; + } + return $self->SUPER::LoadByCols( %args ); } @@ -413,12 +377,17 @@ sub _Create { Name => undef, Description => undef, Domain => undef, - Type => undef, Instance => '0', InsideTransaction => undef, _RecordTransaction => 1, @_ ); + if ( $args{'Type'} ) { + RT->Deprecated( Instead => 'Name', Arguments => 'Type', Remove => '4.4' ); + $args{'Name'} = $args{'Type'}; + } else { + $args{'Type'} = $args{'Name'}; + } # Enforce uniqueness on user defined group names if ($args{'Domain'} and $args{'Domain'} eq 'UserDefined') { @@ -496,7 +465,7 @@ sub CreateUserDefinedGroup { return ( 0, $self->loc('Permission Denied') ); } - return($self->_Create( Domain => 'UserDefined', Type => '', Instance => '', @_)); + return($self->_Create( Domain => 'UserDefined', Instance => '', @_)); } =head2 ValidateName VALUE @@ -550,8 +519,7 @@ sub _CreateACLEquivalenceGroup { my $princ = shift; my $id = $self->_Create( Domain => 'ACLEquivalence', - Type => 'UserEquiv', - Name => 'User '. $princ->Object->Id, + Name => 'UserEquiv', Description => 'ACL equiv. for user '.$princ->Object->Id, Instance => $princ->Id, InsideTransaction => 1, @@ -579,38 +547,195 @@ sub _CreateACLEquivalenceGroup { -=head2 CreateRoleGroup { Domain => DOMAIN, Type => TYPE, Instance => ID } +=head2 CreateRoleGroup -A helper subroutine which creates a ticket group. (What RT 2.0 called Ticket watchers) -Type is one of ( "Requestor" || "Cc" || "AdminCc" || "Owner") -Domain is one of (RT::Ticket-Role || RT::Queue-Role || RT::System-Role) -Instance is the id of the ticket or queue in question +A convenience method for creating a role group on an object. -This routine expects to be called from {Ticket||Queue}->CreateTicketGroups _inside of a transaction_ +This method expects to be called from B<inside of a database transaction>! If +you're calling it outside of one, you B<MUST> pass a false value for +InsideTransaction. -Returns a tuple of (Id, Message). If id is 0, the create failed +Takes a paramhash of: + +=over 4 + +=item Name + +Required. RT's core role types are C<Requestor>, C<Cc>, C<AdminCc>, and +C<Owner>. Extensions may add their own. + +=item Object + +Optional. The object on which this role applies, used to set Domain and +Instance automatically. + +=item Domain + +Optional. The class on which this role applies, with C<-Role> appended. RT's +supported core role group domains are C<RT::Ticket-Role>, C<RT::Queue-Role>, +and C<RT::System-Role>. + +Not required if you pass an Object. + +=item Instance + +Optional. The numeric ID of the object (of the class encoded in Domain) on +which this role applies. If Domain is C<RT::System-Role>, Instance should be C<1>. + +Not required if you pass an Object. + +=item InsideTransaction + +Optional. Defaults to true in expectation of usual call sites. If you call +this method while not inside a transaction, you C<MUST> pass a false value for +this parameter. + +=back + +You must pass either an Object or both Domain and Instance. + +Returns a tuple of (id, Message). If id is false, the create failed and +Message should contain an error string. =cut sub CreateRoleGroup { my $self = shift; my %args = ( Instance => undef, - Type => undef, + Name => undef, Domain => undef, + Object => undef, + InsideTransaction => 1, @_ ); - unless (RT::Queue->IsRoleGroupType($args{Type})) { - return ( 0, $self->loc("Invalid Group Type") ); + # Translate Object to Domain + Instance + my $object = delete $args{Object}; + if ( $object ) { + $args{Domain} = ref($object) . "-Role"; + $args{Instance} = $object->id; + } + + unless ($args{Instance}) { + return ( 0, $self->loc("An Instance must be provided") ); + } + + unless ($self->ValidateRoleGroup(%args)) { + return ( 0, $self->loc("Invalid Group Name and Domain") ); + } + + if ( exists $args{'Type'} ) { + RT->Deprecated( Instead => 'Name', Arguments => 'Type', Remove => '4.4' ); + $args{'Name'} = $args{'Type'}; + } + + my %create = map { $_ => $args{$_} } qw(Domain Instance Name); + + my $duplicate = RT::Group->new( RT->SystemUser ); + $duplicate->LoadByCols( %create ); + if ($duplicate->id) { + return ( 0, $self->loc("Role group exists already") ); + } + + my ($id, $msg) = $self->_Create( + InsideTransaction => $args{InsideTransaction}, + %create, + ); + + if ($self->SingleMemberRoleGroup) { + $self->_AddMember( + PrincipalId => RT->Nobody->Id, + InsideTransaction => $args{InsideTransaction}, + RecordTransaction => 0, + Object => $object, + ); } + return ($id, $msg); +} - return ( $self->_Create( Domain => $args{'Domain'}, - Instance => $args{'Instance'}, - Type => $args{'Type'}, - InsideTransaction => 1 ) ); +sub RoleClass { + my $self = shift; + my $domain = shift || $self->Domain; + return unless $domain =~ /^(.+)-Role$/; + return unless $1->DOES("RT::Record::Role::Roles"); + return $1; } +=head2 ValidateRoleGroup +Takes a param hash containing Domain and Type which are expected to be values +passed into L</CreateRoleGroup>. Returns true if the specified Type is a +registered role on the specified Domain. Otherwise returns false. + +=cut + +sub ValidateRoleGroup { + my $self = shift; + my %args = (@_); + return 0 unless $args{Domain} and ($args{Type} or $args{'Name'}); + + my $class = $self->RoleClass($args{Domain}); + return 0 unless $class; + + return $class->HasRole($args{Type}||$args{'Name'}); +} + +=head2 SingleMemberRoleGroup + +=cut + +sub SingleMemberRoleGroup { + my $self = shift; + my $class = $self->RoleClass; + return unless $class; + return $class->Role($self->Name)->{Single}; +} + +sub SingleMemberRoleGroupColumn { + my $self = shift; + my ($class) = $self->Domain =~ /^(.+)-Role$/; + return unless $class; + + my $role = $class->Role($self->Name); + return unless $role->{Class} eq $class; + return $role->{Column}; +} + +sub RoleGroupObject { + my $self = shift; + my ($class) = $self->Domain =~ /^(.+)-Role$/; + return unless $class; + my $obj = $class->new( $self->CurrentUser ); + $obj->Load( $self->Instance ); + return $obj; +} + +sub Type { + my $self = shift; + RT->Deprecated( Instead => 'Name', Remove => '4.4' ); + return $self->_Value('Type', @_); +} + +sub SetType { + my $self = shift; + RT->Deprecated( Instead => 'Name', Remove => '4.4' ); + return $self->SetName(@_); +} + +sub SetName { + my $self = shift; + my $value = shift; + + my ($status, $msg) = $self->_Set( Field => 'Name', Value => $value ); + return ($status, $msg) unless $status; + + { + my ($status, $msg) = $self->__Set( Field => 'Type', Value => $value ); + RT->Logger->error("Couldn't set Type: $msg") unless $status; + } + + return ($status, $msg); +} =head2 Delete @@ -880,8 +1005,8 @@ sub AddMember { # to modify group membership or the user is the principal in question # and the user has the right to modify his own membership unless ( ($new_member == $self->CurrentUser->PrincipalId && - $self->CurrentUserHasRight('ModifyOwnMembership') ) || - $self->CurrentUserHasRight('AdminGroupMembership') ) { + $self->CurrentUserHasRight('ModifyOwnMembership') ) || + $self->CurrentUserHasRight('AdminGroupMembership') ) { #User has no permission to be doing this return ( 0, $self->loc("Permission Denied") ); } @@ -893,7 +1018,7 @@ sub AddMember { # this should _ONLY_ ever be called from Ticket/Queue AddWatcher # when we want to deal with groups according to queue rights # In the dim future, this will all get factored out and life -# will get better +# will get better # takes a paramhash of { PrincipalId => undef, InsideTransaction } @@ -901,7 +1026,13 @@ sub _AddMember { my $self = shift; my %args = ( PrincipalId => undef, InsideTransaction => undef, + RecordTransaction => 1, @_); + + # RecordSetTransaction is used by _DeleteMember to get one txn but not the other + $args{RecordSetTransaction} = $args{RecordTransaction} + unless exists $args{RecordSetTransaction}; + my $new_member = $args{'PrincipalId'}; unless ($self->Id) { @@ -935,6 +1066,9 @@ sub _AddMember { return ( 0, $self->loc("Groups can't be members of their members")); } + my @purge; + push @purge, @{$self->MembersObj->ItemsArrayRef} + if $self->SingleMemberRoleGroup; my $member_object = RT::GroupMember->new( $self->CurrentUser ); my $id = $member_object->Create( @@ -942,12 +1076,62 @@ sub _AddMember { Group => $self->PrincipalObj, InsideTransaction => $args{'InsideTransaction'} ); - if ($id) { - return ( 1, $self->loc("Member added: [_1]", $new_member_obj->Object->Name) ); + + return(0, $self->loc("Couldn't add member to group")) + unless $id; + + # Purge all previous members (we're a single member role group) + my $old_member_id; + for my $member (@purge) { + my $old_member = $member->MemberId; + my ($ok, $msg) = $member->Delete(); + return(0, $self->loc("Couldn't remove previous member: [_1]", $msg)) + unless $ok; + + # We remove all members in this loop, but there should only ever be one + # member. Keep track of the last one successfully removed for the + # SetWatcher transaction below. + $old_member_id = $old_member; } - else { - return(0, $self->loc("Couldn't add member to group")); + + # Update the column + if (my $col = $self->SingleMemberRoleGroupColumn) { + my $obj = $args{Object} || $self->RoleGroupObject; + my ($ok, $msg) = $obj->_Set( + Field => $col, + Value => $new_member_obj->Id, + CheckACL => 0, # don't check acl + RecordTransaction => $args{'RecordSetTransaction'}, + ); + return (0, $self->loc("Could not update column [_1]: [_2]", $col, $msg)) + unless $ok; } + + # Record an Add/SetWatcher txn on the object if we're a role group + if ($args{RecordTransaction} and $self->RoleClass) { + my $obj = $args{Object} || $self->RoleGroupObject; + + if ($self->SingleMemberRoleGroup) { + $obj->_NewTransaction( + Type => 'SetWatcher', + OldValue => $old_member_id, + NewValue => $new_member_obj->Id, + Field => $self->Name, + ); + } else { + $obj->_NewTransaction( + Type => 'AddWatcher', # use "watcher" for history's sake + NewValue => $new_member_obj->Id, + Field => $self->Name, + ); + } + } + + return (1, $self->loc("[_1] set to [_2]", + $self->loc($self->Name), $new_member_obj->Object->Name) ) + if $self->SingleMemberRoleGroup; + + return ( 1, $self->loc("Member added: [_1]", $new_member_obj->Object->Name) ); } @@ -1043,6 +1227,8 @@ removes that GroupMember from this group. Returns a two value array. the first value is true on successful addition or 0 on failure. The second value is a textual status msg. +Optionally takes a hash of key value flags, such as RecordTransaction. + =cut sub DeleteMember { @@ -1055,23 +1241,28 @@ sub DeleteMember { # and the user has the right to modify his own membership unless ( (($member_id == $self->CurrentUser->PrincipalId) && - $self->CurrentUserHasRight('ModifyOwnMembership') ) || - $self->CurrentUserHasRight('AdminGroupMembership') ) { + $self->CurrentUserHasRight('ModifyOwnMembership') ) || + $self->CurrentUserHasRight('AdminGroupMembership') ) { #User has no permission to be doing this return ( 0, $self->loc("Permission Denied") ); } - $self->_DeleteMember($member_id); + $self->_DeleteMember($member_id, @_); } # A helper subroutine for DeleteMember that bypasses the ACL checks # this should _ONLY_ ever be called from Ticket/Queue DeleteWatcher # when we want to deal with groups according to queue rights # In the dim future, this will all get factored out and life -# will get better +# will get better sub _DeleteMember { my $self = shift; my $member_id = shift; + my %args = ( + RecordTransaction => 1, + @_, + ); + my $member_obj = RT::GroupMember->new( $self->CurrentUser ); @@ -1085,16 +1276,43 @@ sub _DeleteMember { return ( 0,$self->loc( "Group has no such member" )); } + my $old_member = $member_obj->MemberId; + #Now that we've checked ACLs and sanity, delete the groupmember my $val = $member_obj->Delete(); - if ($val) { - return ( $val, $self->loc("Member deleted") ); - } - else { + unless ($val) { $RT::Logger->debug("Failed to delete group ".$self->Id." member ". $member_id); return ( 0, $self->loc("Member not deleted" )); } + + if ($self->RoleClass) { + my %txn = ( + OldValue => $old_member, + Field => $self->Name, + ); + + if ($self->SingleMemberRoleGroup) { + # _AddMember creates the Set-Owner txn (for example) but we handle + # the SetWatcher-Owner txn below. + $self->_AddMember( + PrincipalId => RT->Nobody->Id, + RecordTransaction => 0, + RecordSetTransaction => $args{RecordTransaction}, + ); + $txn{Type} = "SetWatcher"; + $txn{NewValue} = RT->Nobody->id; + } else { + $txn{Type} = "DelWatcher"; + } + + if ($args{RecordTransaction}) { + my $obj = $args{Object} || $self->RoleGroupObject; + $obj->_NewTransaction(%txn); + } + } + + return ( $val, $self->loc("Member deleted") ); } @@ -1104,20 +1322,20 @@ sub _Set { my %args = ( Field => undef, Value => undef, - TransactionType => 'Set', - RecordTransaction => 1, + TransactionType => 'Set', + RecordTransaction => 1, @_ ); unless ( $self->CurrentUserHasRight('AdminGroup') ) { - return ( 0, $self->loc('Permission Denied') ); - } + return ( 0, $self->loc('Permission Denied') ); + } my $Old = $self->SUPER::_Value("$args{'Field'}"); - + my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'}, - Value => $args{'Value'} ); - + Value => $args{'Value'} ); + #If we can't actually set the field to the value, don't record # a transaction. instead, get out of here. if ( $ret == 0 ) { return ( 0, $msg ); } @@ -1138,40 +1356,6 @@ sub _Set { } } - - - - -=head2 CurrentUserHasRight RIGHTNAME - -Returns true if the current user has the specified right for this group. - - - TODO: we don't deal with membership visibility yet - -=cut - - -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - - - - if ($self->Id && - $self->CurrentUser->HasRight( Object => $self, - Right => $right )) { - return(1); - } - elsif ( $self->CurrentUser->HasRight(Object => $RT::System, Right => $right )) { - return (1); - } else { - return(undef); - } - -} - - =head2 CurrentUserCanSee Always returns 1; unfortunately, for historical reasons, users have @@ -1198,17 +1382,9 @@ The response is cached. PrincipalObj should never ever change. sub PrincipalObj { my $self = shift; - unless ( defined $self->{'PrincipalObj'} && - defined $self->{'PrincipalObj'}->ObjectId && - ($self->{'PrincipalObj'}->ObjectId == $self->Id) && - (defined $self->{'PrincipalObj'}->PrincipalType && - $self->{'PrincipalObj'}->PrincipalType eq 'Group')) { - - $self->{'PrincipalObj'} = RT::Principal->new($self->CurrentUser); - $self->{'PrincipalObj'}->LoadByCols('ObjectId' => $self->Id, - 'PrincipalType' => 'Group') ; - } - return($self->{'PrincipalObj'}); + my $res = RT::Principal->new( $self->CurrentUser ); + $res->Load( $self->id ); + return $res; } @@ -1223,11 +1399,29 @@ sub PrincipalId { return $self->Id; } +sub InstanceObj { + my $self = shift; + + my $class; + if ( $self->Domain eq 'ACLEquivalence' ) { + $class = "RT::User"; + } elsif ($self->Domain eq 'RT::Queue-Role') { + $class = "RT::Queue"; + } elsif ($self->Domain eq 'RT::Ticket-Role') { + $class = "RT::Ticket"; + } + + return unless $class; + + my $obj = $class->new( $self->CurrentUser ); + $obj->Load( $self->Instance ); + return $obj; +} sub BasicColumns { ( - [ Name => 'Name' ], - [ Description => 'Description' ], + [ Name => 'Name' ], + [ Description => 'Description' ], ); } @@ -1314,7 +1508,7 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure. Returns the current value of Type. (In the database, Type is stored as varchar(64).) - +Deprecated, use Name instead, will be removed in 4.4. =head2 SetType VALUE @@ -1323,6 +1517,7 @@ Set Type to VALUE. Returns (1, 'Status message') on success and (0, 'Error Message') on failure. (In the database, Type will be stored as a varchar(64).) +Deprecated, use SetName instead, will be removed in 4.4. =cut @@ -1386,29 +1581,223 @@ 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 => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', 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 => ''}, Domain => - {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 => ''}, Type => - {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 => ''}, Instance => - {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); + + my $instance = $self->InstanceObj; + $deps->Add( out => $instance ) if $instance; + + # Group members records, unless we're a system group + if ($self->Domain ne "SystemInternal") { + my $objs = RT::GroupMembers->new( $self->CurrentUser ); + $objs->LimitToMembersOfGroup( $self->PrincipalId ); + $deps->Add( in => $objs ); + } + + # Group member records group belongs to + my $objs = RT::GroupMembers->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'MemberId', VALUE => $self->PrincipalId ); + $deps->Add( in => $objs ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# User is inconsistent without own Equivalence group + if( $self->Domain eq 'ACLEquivalence' ) { + # delete user entry after ACL equiv group + # in other case we will get deep recursion + my $objs = RT::User->new($self->CurrentUser); + $objs->Load( $self->Instance ); + $deps->_PushDependency( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::WIPE_AFTER, + TargetObject => $objs, + Shredder => $args{'Shredder'} + ); + } + +# Principal + $deps->_PushDependency( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::WIPE_AFTER, + TargetObject => $self->PrincipalObj, + Shredder => $args{'Shredder'} + ); + +# Group members records + my $objs = RT::GroupMembers->new( $self->CurrentUser ); + $objs->LimitToMembersOfGroup( $self->PrincipalId ); + push( @$list, $objs ); + +# Group member records group belongs to + $objs = RT::GroupMembers->new( $self->CurrentUser ); + $objs->Limit( + VALUE => $self->PrincipalId, + FIELD => 'MemberId', + ENTRYAGGREGATOR => 'OR', + QUOTEVALUE => 0 + ); + push( @$list, $objs ); + +# Cached group members records + push( @$list, $self->DeepMembersObj ); + +# Cached group member records group belongs to + $objs = RT::GroupMembers->new( $self->CurrentUser ); + $objs->Limit( + VALUE => $self->PrincipalId, + FIELD => 'MemberId', + ENTRYAGGREGATOR => 'OR', + QUOTEVALUE => 0 + ); + push( @$list, $objs ); + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + return $self->SUPER::__DependsOn( %args ); +} + +sub BeforeWipeout { + my $self = shift; + if( $self->Domain eq 'SystemInternal' ) { + RT::Shredder::Exception::Info->throw('SystemObject'); + } + return $self->SUPER::BeforeWipeout( @_ ); +} + +sub Serialize { + my $self = shift; + my %args = (@_); + my %store = $self->SUPER::Serialize(@_); + + my $instance = $self->InstanceObj; + $store{Instance} = \($instance->UID) if $instance; + + $store{Disabled} = $self->PrincipalObj->Disabled; + $store{Principal} = $self->PrincipalObj->UID; + $store{PrincipalId} = $self->PrincipalObj->Id; + return %store; +} + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + my $principal_uid = delete $data->{Principal}; + my $principal_id = delete $data->{PrincipalId}; + my $disabled = delete $data->{Disabled}; + + # Inflate refs into their IDs + $class->SUPER::PreInflate( $importer, $uid, $data ); + + # Factored out code, in case we find an existing version of this group + my $obj = RT::Group->new( RT->SystemUser ); + my $duplicated = sub { + $importer->SkipTransactions( $uid ); + $importer->Resolve( + $principal_uid, + ref($obj->PrincipalObj), + $obj->PrincipalObj->Id + ); + $importer->Resolve( $uid => ref($obj), $obj->Id ); + return; + }; + + # Go looking for the pre-existing version of the it + if ($data->{Domain} eq "ACLEquivalence") { + $obj->LoadACLEquivalenceGroup( $data->{Instance} ); + return $duplicated->() if $obj->Id; + + # Update the name and description for the new ID + $data->{Name} = 'User '. $data->{Instance}; + $data->{Description} = 'ACL equiv. for user '.$data->{Instance}; + } elsif ($data->{Domain} eq "UserDefined") { + $data->{Name} = $importer->Qualify($data->{Name}); + $obj->LoadUserDefinedGroup( $data->{Name} ); + if ($obj->Id) { + $importer->MergeValues($obj, $data); + return $duplicated->(); + } + } elsif ($data->{Domain} =~ /^(SystemInternal|RT::System-Role)$/) { + $obj->LoadByCols( Domain => $data->{Domain}, Name => $data->{Name} ); + return $duplicated->() if $obj->Id; + } elsif ($data->{Domain} eq "RT::Queue-Role") { + my $queue = RT::Queue->new( RT->SystemUser ); + $queue->Load( $data->{Instance} ); + $obj->LoadRoleGroup( Object => $queue, Name => $data->{Name} ); + return $duplicated->() if $obj->Id; + } + + my $principal = RT::Principal->new( RT->SystemUser ); + my ($id) = $principal->Create( + PrincipalType => 'Group', + Disabled => $disabled, + ObjectId => 0, + ); + + # Now we have a principal id, set the id for the group record + $data->{id} = $id; + + $importer->Resolve( $principal_uid => ref($principal), $id ); + + $importer->Postpone( + for => $uid, + uid => $principal_uid, + column => "ObjectId", + ); + + return 1; +} + +sub PostInflate { + my $self = shift; + + my $cgm = RT::CachedGroupMember->new($self->CurrentUser); + $cgm->Create( + Group => $self->PrincipalObj, + Member => $self->PrincipalObj, + ImmediateParent => $self->PrincipalObj + ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/GroupMember.pm b/rt/lib/RT/GroupMember.pm index 9ac7576..6fc6002 100755 --- a/rt/lib/RT/GroupMember.pm +++ b/rt/lib/RT/GroupMember.pm @@ -95,6 +95,58 @@ Both Group and Member are expected to be RT::Principal objects =cut +sub _InsertCGM { + my $self = shift; + + my $cached_member = RT::CachedGroupMember->new( $self->CurrentUser ); + my $cached_id = $cached_member->Create( + Member => $self->MemberObj, + Group => $self->GroupObj, + ImmediateParent => $self->GroupObj, + Via => '0' + ); + + + #When adding a member to a group, we need to go back + #and popuplate the CachedGroupMembers of all the groups that group is part of . + + my $cgm = RT::CachedGroupMembers->new( $self->CurrentUser ); + + # find things which have the current group as a member. + # $group is an RT::Principal for the group. + $cgm->LimitToGroupsWithMember( $self->GroupId ); + $cgm->Limit( + SUBCLAUSE => 'filter', # dont't mess up with prev condition + FIELD => 'MemberId', + OPERATOR => '!=', + VALUE => 'main.GroupId', + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'AND', + ); + + while ( my $parent_member = $cgm->Next ) { + my $parent_id = $parent_member->MemberId; + my $via = $parent_member->Id; + my $group_id = $parent_member->GroupId; + + my $other_cached_member = + RT::CachedGroupMember->new( $self->CurrentUser ); + my $other_cached_id = $other_cached_member->Create( + Member => $self->MemberObj, + Group => $parent_member->GroupObj, + ImmediateParent => $parent_member->MemberObj, + Via => $parent_member->Id + ); + unless ($other_cached_id) { + $RT::Logger->err( "Couldn't add " . $self->MemberId + . " as a submember of a supergroup" ); + return; + } + } + + return $cached_id; +} + sub Create { my $self = shift; my %args = ( @@ -161,52 +213,9 @@ sub Create { return (undef); } - my $cached_member = RT::CachedGroupMember->new( $self->CurrentUser ); - my $cached_id = $cached_member->Create( - Member => $args{'Member'}, - Group => $args{'Group'}, - ImmediateParent => $args{'Group'}, - Via => '0' - ); - - - #When adding a member to a group, we need to go back - #and popuplate the CachedGroupMembers of all the groups that group is part of . - - my $cgm = RT::CachedGroupMembers->new( $self->CurrentUser ); - - # find things which have the current group as a member. - # $group is an RT::Principal for the group. - $cgm->LimitToGroupsWithMember( $args{'Group'}->Id ); - $cgm->Limit( - SUBCLAUSE => 'filter', # dont't mess up with prev condition - FIELD => 'MemberId', - OPERATOR => '!=', - VALUE => 'main.GroupId', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'AND', - ); - - while ( my $parent_member = $cgm->Next ) { - my $parent_id = $parent_member->MemberId; - my $via = $parent_member->Id; - my $group_id = $parent_member->GroupId; - - my $other_cached_member = - RT::CachedGroupMember->new( $self->CurrentUser ); - my $other_cached_id = $other_cached_member->Create( - Member => $args{'Member'}, - Group => $parent_member->GroupObj, - ImmediateParent => $parent_member->MemberObj, - Via => $parent_member->Id - ); - unless ($other_cached_id) { - $RT::Logger->err( "Couldn't add " . $args{'Member'} - . " as a submember of a supergroup" ); - $RT::Handle->Rollback() unless ($args{'InsideTransaction'}); - return (undef); - } - } + my $clone = RT::GroupMember->new( $self->CurrentUser ); + $clone->Load( $id ); + my $cached_id = $clone->_InsertCGM; unless ($cached_id) { $RT::Handle->Rollback() unless ($args{'InsideTransaction'}); @@ -470,23 +479,125 @@ 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 => '0'}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, MemberId => - {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->GroupObj->Object ); + $deps->Add( out => $self->MemberObj->Object ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + + my $objs = RT::CachedGroupMembers->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'MemberId', VALUE => $self->MemberId ); + $objs->Limit( FIELD => 'ImmediateParentId', VALUE => $self->GroupId ); + push( @$list, $objs ); + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + + my $group = $self->GroupObj->Object; + # XXX: If we delete member of the ticket owner role group then we should also + # fix ticket object, but only if we don't plan to delete group itself! + unless( ($group->Name || '') eq 'Owner' && + ($group->Domain || '') eq 'RT::Ticket-Role' ) { + return $self->SUPER::__DependsOn( %args ); + } + + # we don't delete group, so we have to fix Ticket and Group + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::VARIABLE, + TargetObjects => $group, + Shredder => $args{'Shredder'} + ); + $args{'Shredder'}->PutResolver( + BaseClass => ref $self, + TargetClass => ref $group, + Code => sub { + my %args = (@_); + my $group = $args{'TargetObject'}; + return if $args{'Shredder'}->GetState( Object => $group ) + & (RT::Shredder::Constants::WIPED|RT::Shredder::Constants::IN_WIPING); + return unless ($group->Name || '') eq 'Owner'; + return unless ($group->Domain || '') eq 'RT::Ticket-Role'; + + return if $group->MembersObj->Count > 1; + + my $group_member = $args{'BaseObject'}; + + if( $group_member->MemberObj->id == RT->Nobody->id ) { + RT::Shredder::Exception->throw( "Couldn't delete Nobody from owners role group" ); + } + + my( $status, $msg ) = $group->AddMember( RT->Nobody->id ); + + RT::Shredder::Exception->throw( $msg ) unless $status; + + return; + }, + ); + + return $self->SUPER::__DependsOn( %args ); +} + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + $class->SUPER::PreInflate( $importer, $uid, $data ); + + my $obj = RT::GroupMember->new( RT->SystemUser ); + $obj->LoadByCols( + GroupId => $data->{GroupId}, + MemberId => $data->{MemberId}, + ); + if ($obj->id) { + $importer->Resolve( $uid => ref($obj) => $obj->Id ); + return; + } + + return 1; +} + +sub PostInflate { + my $self = shift; + + $self->_InsertCGM; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/GroupMembers.pm b/rt/lib/RT/GroupMembers.pm index a5e8840..bf03706 100755 --- a/rt/lib/RT/GroupMembers.pm +++ b/rt/lib/RT/GroupMembers.pm @@ -69,10 +69,10 @@ package RT::GroupMembers; use strict; use warnings; -use RT::GroupMember; - use base 'RT::SearchBuilder'; +use RT::GroupMember; + sub Table { 'GroupMembers'} @@ -88,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', @@ -113,9 +114,10 @@ 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', @@ -142,23 +144,11 @@ sub LimitToMembersOfGroup { VALUE => $group, FIELD => 'GroupId', ENTRYAGGREGATOR => 'OR', - QUOTEVALUE => 0 + QUOTEVALUE => 0 )); } - - -=head2 NewItem - -Returns an empty new RT::GroupMember item - -=cut - -sub NewItem { - my $self = shift; - return(RT::GroupMember->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Groups.pm b/rt/lib/RT/Groups.pm index 576c99d..3099f1b 100755 --- a/rt/lib/RT/Groups.pm +++ b/rt/lib/RT/Groups.pm @@ -74,14 +74,11 @@ package RT::Groups; use strict; use warnings; - - -use RT::Group; - use base 'RT::SearchBuilder'; sub Table { 'Groups'} +use RT::Group; use RT::Users; # XXX: below some code is marked as subject to generalize in Groups, Users classes. @@ -98,8 +95,8 @@ sub _Init { my @result = $self->SUPER::_Init(@_); $self->OrderBy( ALIAS => 'main', - FIELD => 'Name', - ORDER => 'ASC'); + FIELD => 'Name', + ORDER => 'ASC'); # XXX: this code should be generalized $self->{'princalias'} = $self->Join( @@ -144,7 +141,7 @@ Return only SystemInternal Groups, such as "privileged" "unprivileged" and "ever sub LimitToSystemInternalGroups { my $self = shift; - $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'SystemInternal'); + $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'SystemInternal', CASESENSITIVE => 0 ); # All system internal groups have the same instance. No reason to limit down further #$self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => '0'); } @@ -161,16 +158,34 @@ Return only UserDefined Groups sub LimitToUserDefinedGroups { my $self = shift; - $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'UserDefined'); + $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'UserDefined', CASESENSITIVE => 0 ); # All user-defined groups have the same instance. No reason to limit down further #$self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => ''); } +=head2 LimitToRolesForObject OBJECT +Limits the set of groups to role groups specifically for the object in question +based on the object's class and ID. If the object has no ID, the roles are not +limited by group C<Instance>. That is, calling this method on an unloaded +object will find all role groups for that class of object. +Replaces L</LimitToRolesForQueue>, L</LimitToRolesForTicket>, and +L</LimitToRolesForSystem>. + +=cut + +sub LimitToRolesForObject { + my $self = shift; + my $object = shift; + $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => ref($object) . "-Role", CASESENSITIVE => 0 ); + $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => $object->id); +} =head2 LimitToRolesForQueue QUEUE_ID +B<DEPRECATED>. Use L</LimitToRolesForObject> instead. + Limits the set of groups found to role groups for queue QUEUE_ID =cut @@ -178,7 +193,11 @@ Limits the set of groups found to role groups for queue QUEUE_ID sub LimitToRolesForQueue { my $self = shift; my $queue = shift; - $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::Queue-Role'); + RT->Deprecated( + Instead => "LimitToRolesForObject", + Remove => "4.4", + ); + $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::Queue-Role', CASESENSITIVE => 0 ); $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => $queue); } @@ -186,6 +205,8 @@ sub LimitToRolesForQueue { =head2 LimitToRolesForTicket Ticket_ID +B<DEPRECATED>. Use L</LimitToRolesForObject> instead. + Limits the set of groups found to role groups for Ticket Ticket_ID =cut @@ -193,21 +214,32 @@ Limits the set of groups found to role groups for Ticket Ticket_ID sub LimitToRolesForTicket { my $self = shift; my $Ticket = shift; - $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::Ticket-Role'); - $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => '$Ticket'); + RT->Deprecated( + Instead => "LimitToRolesForObject", + Remove => "4.4", + ); + $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::Ticket-Role', CASESENSITIVE => 0 ); + $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => $Ticket); } =head2 LimitToRolesForSystem System_ID +B<DEPRECATED>. Use L</LimitToRolesForObject> instead. + Limits the set of groups found to role groups for System System_ID =cut sub LimitToRolesForSystem { my $self = shift; - $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::System-Role'); + RT->Deprecated( + Instead => "LimitToRolesForObject", + Remove => "4.4", + ); + $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::System-Role', CASESENSITIVE => 0 ); + $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => RT::System->Id ); } @@ -223,15 +255,15 @@ sub WithMember { my %args = ( PrincipalId => undef, Recursively => undef, @_); - my $members; - - if ($args{'Recursively'}) { - $members = $self->NewAlias('CachedGroupMembers'); - } else { - $members = $self->NewAlias('GroupMembers'); - } - $self->Join(ALIAS1 => 'main', FIELD1 => 'id', - ALIAS2 => $members, FIELD2 => 'GroupId'); + my $members = $self->Join( + ALIAS1 => 'main', FIELD1 => 'id', + $args{'Recursively'} + ? (TABLE2 => 'CachedGroupMembers') + # (GroupId, MemberId) is unique in GM table + : (TABLE2 => 'GroupMembers', DISTINCT => 1) + , + FIELD2 => 'GroupId', + ); $self->Limit(ALIAS => $members, FIELD => 'MemberId', OPERATOR => '=', VALUE => $args{'PrincipalId'}); $self->Limit(ALIAS => $members, FIELD => 'Disabled', VALUE => 0) @@ -263,6 +295,7 @@ sub WithoutMember { FIELD1 => 'id', TABLE2 => $members, FIELD2 => 'GroupId', + DISTINCT => $members eq 'GroupMembers', ); $self->Limit( LEFTJOIN => $members_alias, @@ -452,28 +485,16 @@ sub AddRecord { sub _DoSearch { my $self = shift; - + #unless we really want to find disabled rows, make sure we're only finding enabled ones. unless($self->{'find_disabled_rows'}) { - $self->LimitToEnabled(); + $self->LimitToEnabled(); } - - return($self->SUPER::_DoSearch(@_)); - -} + return($self->SUPER::_DoSearch(@_)); - -=head2 NewItem - -Returns an empty new RT::Group item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Group->new($self->CurrentUser)); } + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Handle.pm b/rt/lib/RT/Handle.pm index 794d8b0..735be55 100644 --- a/rt/lib/RT/Handle.pm +++ b/rt/lib/RT/Handle.pm @@ -60,9 +60,9 @@ RT::Handle - RT's database handle C<RT::Handle> is RT specific wrapper over one of L<DBIx::SearchBuilder::Handle> classes. As RT works with different types of DBs we subclass repsective handler -from L<DBIx::SerachBuilder>. Type of the DB is defined by C<DatabasseType> RT's -config option. You B<must> load this module only when the configs have been -loaded. +from L<DBIx::SearchBuilder>. Type of the DB is defined by L<RT's DatabaseType +config option|RT_Config/DatabaseType>. You B<must> load this module only when +the configs have been loaded. =cut @@ -83,14 +83,22 @@ L<DBIx::SearchBuilder::Handle>, using the C<DatabaseType> configuration. =cut sub FinalizeDatabaseType { - eval { - use base "DBIx::SearchBuilder::Handle::". RT->Config->Get('DatabaseType'); - }; + my $db_type = RT->Config->Get('DatabaseType'); + my $package = "DBIx::SearchBuilder::Handle::$db_type"; - if ($@) { - die "Unable to load DBIx::SearchBuilder database handle for '". RT->Config->Get('DatabaseType') ."'.\n". + $package->require or + die "Unable to load DBIx::SearchBuilder database handle for '$db_type'.\n". "Perhaps you've picked an invalid database type or spelled it incorrectly.\n". $@; + + @RT::Handle::ISA = ($package); + + # We use COLLATE NOCASE to enforce case insensitivity on the normally + # case-sensitive SQLite, LOWER() approach works, but lucks performance + # due to absence of functional indexes + if ($db_type eq 'SQLite') { + no strict 'refs'; no warnings 'redefine'; + *DBIx::SearchBuilder::Handle::SQLite::CaseSensitive = sub {0}; } } @@ -125,7 +133,7 @@ sub Connect { } - if ( $db_type eq 'Pg' ) { + elsif ( $db_type eq 'Pg' ) { my $version = $self->DatabaseVersion; ($version) = $version =~ /^(\d+\.\d+)/; $self->dbh->{pg_server_prepare} = 0 if $version > 9.1; #and we're using a deb-7 version DBD::Pg? @@ -162,12 +170,18 @@ sub BuildDSN { Database => $db_name, Port => $db_port, Driver => $db_type, - RequireSSL => RT->Config->Get('DatabaseRequireSSL'), ); if ( $db_type eq 'Oracle' && $db_host ) { $args{'SID'} = delete $args{'Database'}; } $self->SUPER::BuildDSN( %args ); + + if (RT->Config->Get('DatabaseExtraDSN')) { + my %extra = RT->Config->Get('DatabaseExtraDSN'); + $self->{'dsn'} .= ";$_=$extra{$_}" + for sort keys %extra; + } + return $self->{'dsn'}; } =head2 DSN @@ -225,7 +239,6 @@ sub SystemDSN { sub CheckIntegrity { my $self = shift; - $self = new $self unless ref $self; unless ($RT::Handle and $RT::Handle->dbh) { local $@; @@ -238,13 +251,13 @@ sub CheckIntegrity { my $test_user = RT::CurrentUser->new; $test_user->Load('RT_System'); unless ( $test_user->id ) { - return (0, 'no system user', "Couldn't find RT_System user in the DB '". $self->DSN ."'"); + return (0, 'no system user', "Couldn't find RT_System user in the DB '". $RT::Handle->DSN ."'"); } $test_user = RT::CurrentUser->new; $test_user->Load('Nobody'); unless ( $test_user->id ) { - return (0, 'no nobody user', "Couldn't find Nobody user in the DB '". $self->DSN ."'"); + return (0, 'no nobody user', "Couldn't find Nobody user in the DB '". $RT::Handle->DSN ."'"); } return 1; @@ -279,22 +292,37 @@ sub CheckCompatibility { } if ( $state eq 'post' ) { - my $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Tickets")->[1]; - unless ( $create_table =~ /(?:ENGINE|TYPE)\s*=\s*InnoDB/i ) { + my $show_table = sub { $dbh->selectrow_arrayref("SHOW CREATE TABLE $_[0]")->[1] }; + unless ( $show_table->("Tickets") =~ /(?:ENGINE|TYPE)\s*=\s*InnoDB/i ) { return (0, "RT requires that all its tables be of InnoDB type. Upgrade RT tables."); } - $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Attachments")->[1]; - unless ( $create_table =~ /\bContent\b[^,]*BLOB/i ) { + unless ( $show_table->("Attachments") =~ /\bContent\b[^,]*BLOB/i ) { return (0, "RT since version 3.8 has new schema for MySQL versions after 4.1.0\n" ."Follow instructions in the UPGRADING.mysql file."); } } - my $max_packet = ($dbh->selectrow_array("show variables like 'max_allowed_packet'"))[1]; - if ($state =~ /^(create|post)$/ and $max_packet <= (1024 * 1024)) { - my $max_packet = sprintf("%.1fM", $max_packet/1024/1024); - warn "max_allowed_packet is set to $max_packet, which limits the maximum attachment or email size that RT can process. Consider adjusting MySQL's max_allowed_packet setting.\n"; + if ($state =~ /^(create|post)$/) { + my $show_var = sub { $dbh->selectrow_arrayref("SHOW VARIABLES LIKE ?",{},$_[0])->[1] }; + + my $max_packet = $show_var->("max_allowed_packet"); + if ($max_packet <= (5 * 1024 * 1024)) { + $max_packet = sprintf("%.1fM", $max_packet/1024/1024); + warn "max_allowed_packet is set to $max_packet, which limits the maximum attachment or email size that RT can process. Consider adjusting MySQL's max_allowed_packet setting.\n"; + } + + my $full_version = $show_var->("version"); + if ($full_version =~ /^5\.(\d+)\.(\d+)$/ and (($1 == 6 and $2 >= 20) or $1 > 6)) { + my $redo_log_size = $show_var->("innodb_log_file_size"); + $redo_log_size *= $show_var->("innodb_log_files_in_group") + if $full_version =~ /^5\.(\d+)\.(\d+)$/ and (($1 == 6 and $2 >= 22) or $1 > 6); + + if ($redo_log_size / 10 < 5 * 1024 * 1024) { + $redo_log_size = sprintf("%.1fM",$redo_log_size/1024/1024); + warn "innodb_log_file_size is set to $redo_log_size; attachments can only be 10% of this value on MySQL 5.6. Consider adjusting MySQL's innodb_log_file_size setting.\n"; + } + } } } return (1) @@ -363,7 +391,7 @@ sub CreateDatabase { $status = $dbh->do("CREATE DATABASE $db_name WITH ENCODING='UNICODE' TEMPLATE template0"); } elsif ( $db_type eq 'mysql' ) { - $status = $dbh->do("CREATE DATABASE $db_name DEFAULT CHARACTER SET utf8"); + $status = $dbh->do("CREATE DATABASE `$db_name` DEFAULT CHARACTER SET utf8"); } else { $status = $dbh->do("CREATE DATABASE $db_name"); @@ -404,6 +432,9 @@ sub DropDatabase { $path = "$RT::VarPath/$path" unless substr($path, 0, 1) eq '/'; unlink $path or return (0, "Couldn't remove '$path': $!"); return (1); + } elsif ( $db_type eq 'mysql' ) { + $dbh->do("DROP DATABASE `$db_name`") + or return (0, $DBI::errstr); } else { $dbh->do("DROP DATABASE ". $db_name) or return (0, $DBI::errstr); @@ -531,6 +562,42 @@ sub InsertSchema { return (1); } +sub InsertIndexes { + my $self = shift; + my $dbh = shift; + my $base_path = shift || $RT::EtcPath; + + my $db_type = RT->Config->Get('DatabaseType'); + + $dbh = $self->dbh if !$dbh && ref $self; + return (0, "No DBI handle provided") unless $dbh; + + return (0, "'$base_path' doesn't exist") unless -e $base_path; + + my $path; + if ( -d $base_path ) { + $path = File::Spec->catfile( $base_path, "indexes"); + return (0, "Couldn't find indexes file") + unless -e $path; + } else { + $path = $base_path; + } + + if ( $db_type eq 'Oracle' ) { + my $db_user = RT->Config->Get('DatabaseUser'); + my $status = $dbh->do( "ALTER SESSION SET CURRENT_SCHEMA=$db_user" ); + unless ( $status ) { + return $status, "Couldn't set current schema to $db_user." + ."\nError: ". $dbh->errstr; + } + } + + local $@; + eval { require $path; 1 } + or return (0, "Couldn't execute '$path': " . $@); + return (1); +} + =head1 GetVersionFile Takes base name of the file as argument, scans for <base name>-<version> named @@ -686,10 +753,9 @@ sub InsertInitialData { $group = RT::Group->new( RT->SystemUser ); my ( $val, $msg ) = $group->_Create( - Type => $name, Domain => 'SystemInternal', Description => 'Pseudogroup for internal use', # loc - Name => '', + Name => $name, Instance => '', ); return ($val, $msg) unless $val; @@ -729,20 +795,18 @@ sub InsertInitialData { # system role groups foreach my $name (qw(Owner Requestor Cc AdminCc)) { - my $group = RT::Group->new( RT->SystemUser ); - $group->LoadSystemRoleGroup( $name ); + my $group = RT->System->RoleGroup( $name ); if ( $group->id ) { push @warns, "System role '$name' already exists."; next; } $group = RT::Group->new( RT->SystemUser ); - my ( $val, $msg ) = $group->_Create( - Type => $name, - Domain => 'RT::System-Role', - Description => 'SystemRolegroup for internal use', # loc - Name => '', - Instance => '', + my ( $val, $msg ) = $group->CreateRoleGroup( + Name => $name, + Object => RT->System, + Description => 'SystemRolegroup for internal use', # loc + InsideTransaction => 0, ); return ($val, $msg) unless $val; } @@ -790,8 +854,9 @@ sub InsertData { if ( @Groups ) { $RT::Logger->debug("Creating groups..."); foreach my $item (@Groups) { + my $attributes = delete $item->{ Attributes }; my $new_entry = RT::Group->new( RT->SystemUser ); - $item->{Domain} ||= 'UserDefined'; + $item->{'Domain'} ||= 'UserDefined'; my $member_of = delete $item->{'MemberOf'}; my $members = delete $item->{'Members'}; my ( $return, $msg ) = $new_entry->_Create(%$item); @@ -800,6 +865,8 @@ sub InsertData { next; } else { $RT::Logger->debug($return ."."); + $_->{Object} = $new_entry for @{$attributes || []}; + push @Attributes, @{$attributes || []}; } if ( $member_of ) { $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY'; @@ -844,15 +911,50 @@ sub InsertData { if ( @Users ) { $RT::Logger->debug("Creating users..."); foreach my $item (@Users) { + my $member_of = delete $item->{'MemberOf'}; if ( $item->{'Name'} eq 'root' && $root_password ) { $item->{'Password'} = $root_password; } + my $attributes = delete $item->{ Attributes }; my $new_entry = RT::User->new( RT->SystemUser ); my ( $return, $msg ) = $new_entry->Create(%$item); unless ( $return ) { $RT::Logger->error( $msg ); } else { $RT::Logger->debug( $return ."." ); + $_->{Object} = $new_entry for @{$attributes || []}; + push @Attributes, @{$attributes || []}; + } + if ( $member_of ) { + $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY'; + foreach( @$member_of ) { + my $parent = RT::Group->new($RT::SystemUser); + if ( ref $_ eq 'HASH' ) { + $parent->LoadByCols( %$_ ); + } + elsif ( !ref $_ ) { + $parent->LoadUserDefinedGroup( $_ ); + } + else { + $RT::Logger->error( + "(Error: wrong format of MemberOf field." + ." Should be name of user defined group or" + ." hash reference with 'column => value' pairs." + ." Use array reference to add to multiple groups)" + ); + next; + } + unless ( $parent->Id ) { + $RT::Logger->error("(Error: couldn't load group to add member)"); + next; + } + my ( $return, $msg ) = $parent->AddMember( $new_entry->Id ); + unless ( $return ) { + $RT::Logger->error( $msg ); + } else { + $RT::Logger->debug( $return ."." ); + } + } } } $RT::Logger->debug("done."); @@ -887,12 +989,15 @@ sub InsertData { if ( @Queues ) { $RT::Logger->debug("Creating queues..."); for my $item (@Queues) { + my $attributes = delete $item->{ Attributes }; my $new_entry = RT::Queue->new(RT->SystemUser); my ( $return, $msg ) = $new_entry->Create(%$item); unless ( $return ) { $RT::Logger->error( $msg ); } else { $RT::Logger->debug( $return ."." ); + $_->{Object} = $new_entry for @{$attributes || []}; + push @Attributes, @{$attributes || []}; } } $RT::Logger->debug("done."); @@ -900,23 +1005,29 @@ sub InsertData { if ( @CustomFields ) { $RT::Logger->debug("Creating custom fields..."); for my $item ( @CustomFields ) { + my $attributes = delete $item->{ Attributes }; my $new_entry = RT::CustomField->new( RT->SystemUser ); my $values = delete $item->{'Values'}; - my @queues; - # if ref then it's list of queues, so we do things ourself - if ( exists $item->{'Queue'} && ref $item->{'Queue'} ) { + # Back-compat for the old "Queue" argument + if ( exists $item->{'Queue'} ) { $item->{'LookupType'} ||= 'RT::Queue-RT::Ticket'; - @queues = @{ delete $item->{'Queue'} }; + $RT::Logger->warn("Queue provided for non-ticket custom field") + unless $item->{'LookupType'} =~ /^RT::Queue-/; + $item->{'ApplyTo'} = delete $item->{'Queue'}; } + my $apply_to = delete $item->{'ApplyTo'}; + if ( $item->{'BasedOn'} ) { if ( $item->{'BasedOn'} =~ /^\d+$/) { # Already have an ID -- should be fine } elsif ( $item->{'LookupType'} ) { my $basedon = RT::CustomField->new($RT::SystemUser); - my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'}, - LookupType => $item->{'LookupType'} ); + my ($ok, $msg ) = $basedon->LoadByCols( + Name => $item->{'BasedOn'}, + LookupType => $item->{'LookupType'}, + Disabled => 0 ); if ($ok) { $item->{'BasedOn'} = $basedon->Id; } else { @@ -937,30 +1048,42 @@ sub InsertData { } foreach my $value ( @{$values} ) { - my ( $return, $msg ) = $new_entry->AddValue(%$value); + ( $return, $msg ) = $new_entry->AddValue(%$value); $RT::Logger->error( $msg ) unless $return; } - # apply by default - if ( !@queues && !exists $item->{'Queue'} && $item->{LookupType} ) { - my $ocf = RT::ObjectCustomField->new(RT->SystemUser); - $ocf->Create( CustomField => $new_entry->Id ); - } - - for my $q (@queues) { - my $q_obj = RT::Queue->new(RT->SystemUser); - $q_obj->Load($q); - unless ( $q_obj->Id ) { - $RT::Logger->error("Could not find queue ". $q ); - next; + my $class = $new_entry->RecordClassFromLookupType; + if ($class) { + if ($new_entry->IsOnlyGlobal and $apply_to) { + $RT::Logger->warn("ApplyTo provided for global custom field ".$new_entry->Name ); + undef $apply_to; + } + if ( !$apply_to ) { + # Apply to all by default + my $ocf = RT::ObjectCustomField->new(RT->SystemUser); + ( $return, $msg) = $ocf->Create( CustomField => $new_entry->Id ); + $RT::Logger->error( $msg ) unless $return and $ocf->Id; + } else { + $apply_to = [ $apply_to ] unless ref $apply_to; + for my $name ( @{ $apply_to } ) { + my $obj = $class->new(RT->SystemUser); + $obj->Load($name); + if ( $obj->Id ) { + my $ocf = RT::ObjectCustomField->new(RT->SystemUser); + ( $return, $msg ) = $ocf->Create( + CustomField => $new_entry->Id, + ObjectId => $obj->Id, + ); + $RT::Logger->error( $msg ) unless $return and $ocf->Id; + } else { + $RT::Logger->error("Could not find $class $name to apply ".$new_entry->Name." to" ); + } + } } - my $OCF = RT::ObjectCustomField->new(RT->SystemUser); - ( $return, $msg ) = $OCF->Create( - CustomField => $new_entry->Id, - ObjectId => $q_obj->Id, - ); - $RT::Logger->error( $msg ) unless $return and $OCF->Id; } + + $_->{Object} = $new_entry for @{$attributes || []}; + push @Attributes, @{$attributes || []}; } $RT::Logger->debug("done."); @@ -975,17 +1098,32 @@ sub InsertData { if ( $item->{'CF'} ) { $object = RT::CustomField->new( RT->SystemUser ); my @columns = ( Name => $item->{'CF'} ); + push @columns, LookupType => $item->{'LookupType'} if $item->{'LookupType'}; + push @columns, ObjectId => $item->{'ObjectId'} if $item->{'ObjectId'}; push @columns, Queue => $item->{'Queue'} if $item->{'Queue'} and not ref $item->{'Queue'}; - $object->LoadByName( @columns ); + my ($ok, $msg) = $object->LoadByName( @columns ); + unless ( $ok ) { + RT->Logger->error("Unable to load CF ".$item->{CF}.": $msg"); + next; + } } elsif ( $item->{'Queue'} ) { $object = RT::Queue->new(RT->SystemUser); - $object->Load( $item->{'Queue'} ); + my ($ok, $msg) = $object->Load( $item->{'Queue'} ); + unless ( $ok ) { + RT->Logger->error("Unable to load queue ".$item->{Queue}.": $msg"); + next; + } + } elsif ( $item->{ObjectType} and $item->{ObjectId}) { + $object = $item->{ObjectType}->new(RT->SystemUser); + my ($ok, $msg) = $object->Load( $item->{ObjectId} ); + unless ( $ok ) { + RT->Logger->error("Unable to load ".$item->{ObjectType}." ".$item->{ObjectId}.": $msg"); + next; + } } else { $object = $RT::System; } - $RT::Logger->error("Couldn't load object") and next unless $object and $object->Id; - # Group rights or user rights? if ( $item->{'GroupDomain'} ) { $princ = RT::Group->new(RT->SystemUser); @@ -994,12 +1132,11 @@ sub InsertData { } elsif ( $item->{'GroupDomain'} eq 'SystemInternal' ) { $princ->LoadSystemInternalGroup( $item->{'GroupType'} ); } elsif ( $item->{'GroupDomain'} eq 'RT::System-Role' ) { - $princ->LoadSystemRoleGroup( $item->{'GroupType'} ); + $princ->LoadRoleGroup( Object => RT->System, Name => $item->{'GroupType'} ); } elsif ( $item->{'GroupDomain'} eq 'RT::Queue-Role' && $item->{'Queue'} ) { - $princ->LoadQueueRoleGroup( Type => $item->{'GroupType'}, - Queue => $object->id); + $princ->LoadRoleGroup( Object => $object, Name => $item->{'GroupType'} ); } else { $princ->Load( $item->{'GroupId'} ); } @@ -1017,15 +1154,18 @@ sub InsertData { } # Grant it - my ( $return, $msg ) = $princ->PrincipalObj->GrantRight( - Right => $item->{'Right'}, - Object => $object - ); - unless ( $return ) { - $RT::Logger->error( $msg ); - } - else { - $RT::Logger->debug( $return ."." ); + my @rights = ref($item->{'Right'}) eq 'ARRAY' ? @{$item->{'Right'}} : $item->{'Right'}; + foreach my $right ( @rights ) { + my ( $return, $msg ) = $princ->PrincipalObj->GrantRight( + Right => $right, + Object => $object + ); + unless ( $return ) { + $RT::Logger->error( $msg ); + } + else { + $RT::Logger->debug( $return ."." ); + } } } $RT::Logger->debug("done."); @@ -1089,14 +1229,21 @@ sub InsertData { my @queues = ref $item->{'Queue'} eq 'ARRAY'? @{ $item->{'Queue'} }: $item->{'Queue'} || 0; push @queues, 0 unless @queues; # add global queue at least + my ( $return, $msg ) = $new_entry->Create( %$item, Queue => shift @queues ); + unless ( $return ) { + $RT::Logger->error( $msg ); + next; + } + else { + $RT::Logger->debug( $return ."." ); + } foreach my $q ( @queues ) { - my ( $return, $msg ) = $new_entry->Create( %$item, Queue => $q ); - unless ( $return ) { - $RT::Logger->error( $msg ); - } - else { - $RT::Logger->debug( $return ."." ); - } + my ($return, $msg) = $new_entry->AddToObject( + ObjectId => $q, + Stage => $item->{'Stage'}, + ); + $RT::Logger->error( "Couldn't apply scrip to $q: $msg" ) + unless $return; } } $RT::Logger->debug("done."); @@ -1106,7 +1253,12 @@ sub InsertData { my $sys = RT::System->new(RT->SystemUser); for my $item (@Attributes) { - my $obj = delete $item->{Object}; # XXX: make this something loadable + my $obj = delete $item->{Object}; + + if ( ref $obj eq 'CODE' ) { + $obj = $obj->(); + } + $obj ||= $sys; my ( $return, $msg ) = $obj->AddAttribute (%$item); unless ( $return ) { @@ -1232,6 +1384,366 @@ sub FillIn { return $sql; } +sub Indexes { + my $self = shift; + + my %res; + + my $db_type = RT->Config->Get('DatabaseType'); + my $dbh = $self->dbh; + + my $list; + if ( $db_type eq 'mysql' ) { + $list = $dbh->selectall_arrayref( + 'select distinct table_name, index_name from information_schema.statistics where table_schema = ?', + undef, scalar RT->Config->Get('DatabaseName') + ); + } + elsif ( $db_type eq 'Pg' ) { + $list = $dbh->selectall_arrayref( + 'select tablename, indexname from pg_indexes', + undef, + ); + } + elsif ( $db_type eq 'SQLite' ) { + $list = $dbh->selectall_arrayref( + 'select tbl_name, name from sqlite_master where type = ?', + undef, 'index' + ); + } + elsif ( $db_type eq 'Oracle' ) { + $list = $dbh->selectall_arrayref( + 'select table_name, index_name from all_indexes where index_name NOT LIKE ? AND lower(Owner) = ?', + undef, 'SYS_%$$', lc RT->Config->Get('DatabaseUser'), + ); + } + else { + die "Not implemented"; + } + push @{ $res{ lc $_->[0] } ||= [] }, lc $_->[1] foreach @$list; + return %res; +} + +sub IndexesThatBeginWith { + my $self = shift; + my %args = (Table => undef, Columns => [], @_); + + my %indexes = $self->Indexes; + + my @check = @{ $args{'Columns'} }; + + my @list; + foreach my $index ( @{ $indexes{ lc $args{'Table'} } || [] } ) { + my %info = $self->IndexInfo( Table => $args{'Table'}, Name => $index ); + next if @{ $info{'Columns'} } < @check; + my $check = join ',', @check; + next if join( ',', @{ $info{'Columns'} } ) !~ /^\Q$check\E(?:,|$)/i; + + push @list, \%info; + } + return sort { @{ $a->{'Columns'} } <=> @{ $b->{'Columns'} } } @list; +} + +sub IndexInfo { + my $self = shift; + my %args = (Table => undef, Name => undef, @_); + + my $db_type = RT->Config->Get('DatabaseType'); + my $dbh = $self->dbh; + + my %res = ( + Table => lc $args{'Table'}, + Name => lc $args{'Name'}, + ); + if ( $db_type eq 'mysql' ) { + my $list = $dbh->selectall_arrayref( + 'select NON_UNIQUE, COLUMN_NAME, SUB_PART + from information_schema.statistics + where table_schema = ? AND LOWER(table_name) = ? AND index_name = ? + ORDER BY SEQ_IN_INDEX', + undef, scalar RT->Config->Get('DatabaseName'), lc $args{'Table'}, $args{'Name'}, + ); + return () unless $list && @$list; + $res{'Unique'} = $list->[0][0]? 0 : 1; + $res{'Functional'} = 0; + $res{'Columns'} = [ map $_->[1], @$list ]; + } + elsif ( $db_type eq 'Pg' ) { + my $index = $dbh->selectrow_hashref( + 'select ix.*, pg_get_expr(ix.indexprs, ix.indrelid) as functions + from + pg_class t, pg_class i, pg_index ix + where + t.relname ilike ? + and t.relkind = ? + and i.relname ilike ? + and ix.indrelid = t.oid + and ix.indexrelid = i.oid + ', + undef, $args{'Table'}, 'r', $args{'Name'}, + ); + return () unless $index && keys %$index; + $res{'Unique'} = $index->{'indisunique'}; + $res{'Functional'} = (grep $_ == 0, split ' ', $index->{'indkey'})? 1 : 0; + $res{'Columns'} = [ map int($_), split ' ', $index->{'indkey'} ]; + my $columns = $dbh->selectall_hashref( + 'select a.attnum, a.attname + from pg_attribute a where a.attrelid = ?', + 'attnum', undef, $index->{'indrelid'} + ); + if ($index->{'functions'}) { + # XXX: this is good enough for us + $index->{'functions'} = [ split /,\s+/, $index->{'functions'} ]; + } + foreach my $e ( @{ $res{'Columns'} } ) { + if (exists $columns->{$e} ) { + $e = $columns->{$e}{'attname'}; + } + elsif ( !$e ) { + $e = shift @{ $index->{'functions'} }; + } + } + + foreach my $column ( @{$res{'Columns'}} ) { + next unless $column =~ s/^lower\( \s* \(? (\w+) \)? (?:::text)? \s* \)$/$1/ix; + $res{'CaseInsensitive'}{ lc $1 } = 1; + } + } + elsif ( $db_type eq 'SQLite' ) { + my $list = $dbh->selectall_arrayref("pragma index_info('$args{'Name'}')"); + return () unless $list && @$list; + + $res{'Functional'} = 0; + $res{'Columns'} = [ map $_->[2], @$list ]; + + $list = $dbh->selectall_arrayref("pragma index_list('$args{'Table'}')"); + $res{'Unique'} = (grep lc $_->[1] eq lc $args{'Name'}, @$list)[0][2]? 1 : 0; + } + elsif ( $db_type eq 'Oracle' ) { + my $index = $dbh->selectrow_arrayref( + 'select uniqueness, funcidx_status from all_indexes + where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(Owner) = ?', + undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'), + ); + return () unless $index && @$index; + $res{'Unique'} = $index->[0] eq 'UNIQUE'? 1 : 0; + $res{'Functional'} = $index->[1] ? 1 : 0; + + my %columns = map @$_, @{ $dbh->selectall_arrayref( + 'select column_position, column_name from all_ind_columns + where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?', + undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'), + ) }; + $columns{ $_->[0] } = $_->[1] foreach @{ $dbh->selectall_arrayref( + 'select column_position, column_expression from all_ind_expressions + where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?', + undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'), + ) }; + $res{'Columns'} = [ map $columns{$_}, sort { $a <=> $b } keys %columns ]; + + foreach my $column ( @{$res{'Columns'}} ) { + next unless $column =~ s/^lower\( \s* " (\w+) " \s* \)$/$1/ix; + $res{'CaseInsensitive'}{ lc $1 } = 1; + } + } + else { + die "Not implemented"; + } + $_ = lc $_ foreach @{ $res{'Columns'} }; + return %res; +} + +sub DropIndex { + my $self = shift; + my %args = (Table => undef, Name => undef, @_); + + my $db_type = RT->Config->Get('DatabaseType'); + my $dbh = $self->dbh; + local $dbh->{'PrintError'} = 0; + local $dbh->{'RaiseError'} = 0; + + my $res; + if ( $db_type eq 'mysql' ) { + $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} ); + $res = $dbh->do( + 'drop index '. $dbh->quote_identifier($args{'Name'}) ." on $args{'Table'}", + ); + } + elsif ( $db_type eq 'Pg' ) { + $res = $dbh->do("drop index $args{'Name'} CASCADE"); + } + elsif ( $db_type eq 'SQLite' ) { + $res = $dbh->do("drop index $args{'Name'}"); + } + elsif ( $db_type eq 'Oracle' ) { + my $user = RT->Config->Get('DatabaseUser'); + # Check if it has constraints associated with it + my ($constraint) = $dbh->selectrow_arrayref( + 'SELECT constraint_name, table_name FROM all_constraints WHERE LOWER(owner) = ? AND LOWER(index_name) = ?', + undef, lc $user, lc $args{'Name'} + ); + if ($constraint) { + my ($constraint_name, $table) = @{$constraint}; + $res = $dbh->do("ALTER TABLE $user.$table DROP CONSTRAINT $constraint_name"); + } else { + $res = $dbh->do("DROP INDEX $user.$args{'Name'}"); + } + } + else { + die "Not implemented"; + } + my $desc = $self->IndexDescription( %args ); + return ($res, $res? "Dropped $desc" : "Couldn't drop $desc: ". $dbh->errstr); +} + +sub _CanonicTableNameMysql { + my $self = shift; + my $table = shift; + return $table unless $table; + # table name can be case sensitivity in DDL + # use LOWER to workaround mysql "bug" + return ($self->dbh->selectrow_array( + 'SELECT table_name + FROM information_schema.tables + WHERE table_schema = ? AND LOWER(table_name) = ?', + undef, scalar RT->Config->Get('DatabaseName'), lc $table + ))[0] || $table; +} + +sub DropIndexIfExists { + my $self = shift; + my %args = (Table => undef, Name => undef, @_); + + my %indexes = $self->Indexes; + return (1, ucfirst($self->IndexDescription( %args )) ." doesn't exists") + unless grep $_ eq lc $args{'Name'}, + @{ $indexes{ lc $args{'Table'} } || []}; + return $self->DropIndex(%args); +} + +sub CreateIndex { + my $self = shift; + my %args = ( Table => undef, Name => undef, Columns => [], CaseInsensitive => {}, @_ ); + + $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} ) + if RT->Config->Get('DatabaseType') eq 'mysql'; + + my $name = $args{'Name'}; + unless ( $name ) { + my %indexes = $self->Indexes; + %indexes = map { $_ => 1 } @{ $indexes{ lc $args{'Table'} } || [] }; + my $i = 1; + $i++ while $indexes{ lc($args{'Table'}).$i }; + $name = lc($args{'Table'}).$i; + } + + my @columns = @{ $args{'Columns'} }; + if ( $self->CaseSensitive ) { + foreach my $column ( @columns ) { + next unless $args{'CaseInsensitive'}{ lc $column }; + $column = "LOWER($column)"; + } + } + + my $sql = "CREATE" + . ($args{'Unique'}? ' UNIQUE' : '') + ." INDEX $name ON $args{'Table'}" + ."(". join( ', ', @columns ) .")" + ; + + my $res = $self->dbh->do( $sql ); + unless ( $res ) { + return ( + undef, "Failed to create ". $self->IndexDescription( %args ) + ." (sql: $sql): ". $self->dbh->errstr + ); + } + return ($name, "Created ". $self->IndexDescription( %args ) ); +} + +sub IndexDescription { + my $self = shift; + my %args = (@_); + + my $desc = + ($args{'Unique'}? 'unique ' : '') + .'index' + . ($args{'Name'}? " $args{'Name'}" : '') + . ( @{$args{'Columns'}||[]}? + " (" + . join(', ', @{$args{'Columns'}}) + . (@{$args{'Optional'}||[]}? '['. join(', ', '', @{$args{'Optional'}}).']' : '' ) + .")" + : '' + ) + . ($args{'Table'}? " on $args{'Table'}" : '') + ; + return $desc; +} + +sub MakeSureIndexExists { + my $self = shift; + my %args = ( Table => undef, Columns => [], Optional => [], @_ ); + + my @list = $self->IndexesThatBeginWith( + Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}], + ); + if (@list) { + RT->Logger->debug( ucfirst $self->IndexDescription( + Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}], + ). ' exists.' ); + return; + } + + @list = $self->IndexesThatBeginWith( + Table => $args{'Table'}, Columns => $args{'Columns'}, + ); + if ( !@list ) { + my ($status, $msg) = $self->CreateIndex( + Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}], + ); + my $method = $status ? 'debug' : 'warning'; + RT->Logger->$method($msg); + } + else { + RT->Logger->info( + ucfirst $self->IndexDescription( + %{$list[0]} + ) + .' exists, you may consider replacing it with ' + . $self->IndexDescription( + Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}], + ) + ); + } +} + +sub DropIndexesThatArePrefix { + my $self = shift; + my %args = ( Table => undef, Columns => [], @_ ); + + my @list = $self->IndexesThatBeginWith( + Table => $args{'Table'}, Columns => [$args{'Columns'}[0]], + ); + + my $checking = join ',', map lc $_, @{ $args{'Columns'} }, ''; + foreach my $i ( splice @list ) { + my $columns = join ',', @{ $i->{'Columns'} }, ''; + next unless $checking =~ /^\Q$columns/i; + + push @list, $i; + } + pop @list; + + foreach my $i ( @list ) { + my ($status, $msg) = $self->DropIndex( + Table => $i->{'Table'}, Name => $i->{'Name'}, + ); + my $method = $status ? 'debug' : 'warning'; + RT->Logger->$method($msg); + } +} + # log a mason stack trace instead of a Carp::longmess because it's less painful # and uses mason component paths properly sub _LogSQLStatement { @@ -1244,6 +1756,13 @@ sub _LogSQLStatement { push @{$self->{'StatementLog'}} , ([Time::HiRes::time(), $statement, [@bind], $duration, HTML::Mason::Exception->new->as_string]); } +# helper in a few cases where we do SQL by hand +sub __MakeClauseCaseInsensitive { + my $self = shift; + return join ' ', @_ unless $self->CaseSensitive; + my ($field, $op, $value) = $self->_MakeClauseCaseInsensitive(@_); + return "$field $op $value"; +} sub _TableNames { my $self = shift; diff --git a/rt/lib/RT/I18N.pm b/rt/lib/RT/I18N.pm index de93512..bad4eb4 100644 --- a/rt/lib/RT/I18N.pm +++ b/rt/lib/RT/I18N.pm @@ -101,12 +101,6 @@ sub Init { # Load language-specific functions foreach my $file ( File::Glob::bsd_glob(substr(__FILE__, 0, -3) . "/*.pm") ) { - unless ( $file =~ /^([-\w\s\.\/\\~:]+)$/ ) { - warn("$file is tainted. not loading"); - next; - } - $file = $1; - my ($lang) = ($file =~ /([^\\\/]+?)\.pm$/); next unless grep $_ eq '*' || $_ eq $lang, @lang; require $file; @@ -191,22 +185,71 @@ sub IsTextualContentType { } -=head2 SetMIMEEntityToEncoding $entity, $encoding +=head2 SetMIMEEntityToEncoding Entity => ENTITY, Encoding => ENCODING, PreserveWords => BOOL, IsOut => BOOL An utility function which will try to convert entity body into specified charset encoding (encoded as octets, *not* unicode-strings). It will iterate all the entities in $entity, and try to convert each one into specified charset if whose Content-Type is 'text/plain'. +If PreserveWords is true, values in mime head will be decoded.(default is false) + +Incoming and outgoing mails are handled differently, if IsOut is true(default +is false), it'll be treated as outgoing mail, otherwise incomding mail: + +incoming mail: +1) find encoding +2) if found then try to convert to utf-8 in croak mode, return if success +3) guess encoding +4) if guessed differently then try to convert to utf-8 in croak mode, return + if success +5) mark part as application/octet-stream instead of falling back to any + encoding + +outgoing mail: +1) find encoding +2) if didn't find then do nothing, send as is, let MUA deal with it +3) if found then try to convert it to outgoing encoding in croak mode, return + if success +4) do nothing otherwise, keep original encoding + This function doesn't return anything meaningful. =cut sub SetMIMEEntityToEncoding { - my ( $entity, $enc, $preserve_words ) = ( shift, shift, shift ); + my ( $entity, $enc, $preserve_words, $is_out ); + + if ( @_ <= 3 ) { + ( $entity, $enc, $preserve_words ) = @_; + } + else { + my %args = ( + Entity => undef, + Encoding => undef, + PreserveWords => undef, + IsOut => undef, + @_, + ); + + $entity = $args{Entity}; + $enc = $args{Encoding}; + $preserve_words = $args{PreserveWords}; + $is_out = $args{IsOut}; + } + + unless ( $entity && $enc ) { + RT->Logger->error("Missing Entity or Encoding arguments"); + return; + } # do the same for parts first of all - SetMIMEEntityToEncoding( $_, $enc, $preserve_words ) foreach $entity->parts; + SetMIMEEntityToEncoding( + Entity => $_, + Encoding => $enc, + PreserveWords => $preserve_words, + IsOut => $is_out, + ) foreach $entity->parts; my $head = $entity->head; @@ -224,14 +267,16 @@ sub SetMIMEEntityToEncoding { } SetMIMEHeadToEncoding( - $head, - _FindOrGuessCharset($entity, 1) => $enc, - $preserve_words + Head => $head, + From => _FindOrGuessCharset( $entity, 1 ), + To => $enc, + PreserveWords => $preserve_words, + IsOut => $is_out, ); # If this is a textual entity, we'd need to preserve its original encoding $head->replace( "X-RT-Original-Encoding" => Encode::encode( "UTF-8", $charset ) ) - if $head->mime_attr('content-type.charset') or IsTextualContentType($head->mime_type); + if $head->mime_attr('content-type.charset') or IsTextualContentType($head->mime_type); return unless IsTextualContentType($head->mime_type); @@ -245,9 +290,24 @@ sub SetMIMEEntityToEncoding { . $head->mime_type . " - " . ( Encode::decode("UTF-8",$head->get('subject')) || 'Subjectless message' ) ); - { - no warnings 'utf8'; - $string = Encode::encode( $enc, Encode::decode( $charset, $string) ); + my $orig_string = $string; + ( my $success, $string ) = EncodeFromToWithCroak( $orig_string, $charset => $enc ); + if ( !$success ) { + return if $is_out; + my $error = $string; + + my $guess = _GuessCharset($orig_string); + if ( $guess && $guess ne $charset ) { + $RT::Logger->error( "Encoding error: " . $error . " falling back to Guess($guess) => $enc" ); + ( $success, $string ) = EncodeFromToWithCroak( $orig_string, $guess, $enc ); + $error = $string unless $success; + } + + if ( !$success ) { + $RT::Logger->error( "Encoding error: " . $error . " falling back to application/octet-stream" ); + $head->mime_attr( "content-type" => 'application/octet-stream' ); + return; + } } my $new_body = MIME::Body::InCore->new($string); @@ -277,15 +337,72 @@ sub DecodeMIMEWordsToEncoding { my $str = shift; my $to_charset = _CanonicalizeCharset(shift); my $field = shift || ''; + $RT::Logger->warning( + "DecodeMIMEWordsToEncoding was called without field name." + ."It's known to cause troubles with decoding fields properly." + ) unless $field; + + # XXX TODO: RT doesn't currently do the right thing with mime-encoded headers + # We _should_ be preserving them encoded until after parsing is completed and + # THEN undo the mime-encoding. + # + # This routine should be translating the existing mimeencoding to utf8 but leaving + # things encoded. + # + # It's legal for headers to contain mime-encoded commas and semicolons which + # should not be treated as address separators. (Encoding == quoting here) + # + # until this is fixed, we must escape any string containing a comma or semicolon + # this is only a bandaid + + # Some _other_ MUAs encode quotes _already_, and double quotes + # confuse us a lot, so only quote it if it isn't quoted + # already. # handle filename*=ISO-8859-1''%74%E9%73%74%2E%74%78%74, parameter value # continuations, and similar syntax from RFC 2231 - if ($field =~ /^Content-(Type|Disposition)/i) { + if ($field =~ /^Content-/i) { # This concatenates continued parameters and normalizes encoded params # to QB encoded-words which we handle below - $str = MIME::Field::ParamVal->parse($str)->stringify; + my $params = MIME::Field::ParamVal->parse_params($str); + foreach my $v ( values %$params ) { + $v = _DecodeMIMEWordsToEncoding( $v, $to_charset ); + # de-quote in case those were hidden inside encoded part + $v =~ s/\\(.)/$1/g if $v =~ s/^"(.*)"$/$1/; + } + $str = bless({}, 'MIME::Field::ParamVal')->set($params)->stringify; + } + elsif ( $field =~ /^(?:Resent-)?(?:To|From|B?Cc|Sender|Reply-To)$/i ) { + my @addresses = RT::EmailParser->ParseEmailAddress( $str ); + foreach my $address ( @addresses ) { + foreach my $field (qw(phrase comment)) { + my $v = $address->$field() or next; + $v = _DecodeMIMEWordsToEncoding( $v, $to_charset ); + if ( $field eq 'phrase' ) { + # de-quote in case quoted value were hidden inside encoded part + $v =~ s/\\(.)/$1/g if $v =~ s/^"(.*)"$/$1/; + } + $address->$field($v); + } + } + $str = join ', ', map $_->format, @addresses; + } + else { + $str = _DecodeMIMEWordsToEncoding( $str, $to_charset ); } + + # We might have \n without trailing whitespace, which will result in + # invalid headers. + $str =~ s/\n//g; + + return ($str) +} + +sub _DecodeMIMEWordsToEncoding { + my $str = shift; + my $to_charset = shift; + # Pre-parse by removing all whitespace between encoded words my $encoded_word = qr/ =\? # =? @@ -312,80 +429,51 @@ sub DecodeMIMEWordsToEncoding { $encoded_word ([^=]*) # trailing /xgcs; + return $str unless @list; + + # add everything that hasn't matched to the end of the latest + # string in array this happen when we have 'key="=?encoded?="; key="plain"' + $list[-1] .= substr($str, pos $str); + + $str = ''; + while (@list) { + my ($prefix, $charset, $encoding, $enc_str, $trailing) = + splice @list, 0, 5; + $charset = _CanonicalizeCharset($charset); + $encoding = lc $encoding; + + $trailing =~ s/\s?\t?$//; # Observed from Outlook Express + + if ( $encoding eq 'q' ) { + use MIME::QuotedPrint; + $enc_str =~ tr/_/ /; # Observed from Outlook Express + $enc_str = decode_qp($enc_str); + } elsif ( $encoding eq 'b' ) { + use MIME::Base64; + $enc_str = decode_base64($enc_str); + } else { + $RT::Logger->warning("Incorrect encoding '$encoding' in '$str', " + ."only Q(uoted-printable) and B(ase64) are supported"); + } - if ( @list ) { - # add everything that hasn't matched to the end of the latest - # string in array this happen when we have 'key="=?encoded?="; key="plain"' - $list[-1] .= substr($str, pos $str); - - $str = ""; - while (@list) { - my ($prefix, $charset, $encoding, $enc_str, $trailing) = - splice @list, 0, 5; - $charset = _CanonicalizeCharset($charset); - $encoding = lc $encoding; - - $trailing =~ s/\s?\t?$//; # Observed from Outlook Express - - if ( $encoding eq 'q' ) { - use MIME::QuotedPrint; - $enc_str =~ tr/_/ /; # Observed from Outlook Express - $enc_str = decode_qp($enc_str); - } elsif ( $encoding eq 'b' ) { - use MIME::Base64; - $enc_str = decode_base64($enc_str); + # now we have got a decoded subject, try to convert into the encoding + if ( $charset ne $to_charset || $charset =~ /^utf-?8(?:-strict)?$/i ) { + if ( Encode::find_encoding($charset) ) { + Encode::from_to( $enc_str, $charset, $to_charset ); } else { - $RT::Logger->warning("Incorrect encoding '$encoding' in '$str', " - ."only Q(uoted-printable) and B(ase64) are supported"); - } - - # now we have got a decoded subject, try to convert into the encoding - if ( $charset ne $to_charset || $charset =~ /^utf-?8(?:-strict)?$/i ) { - if ( Encode::find_encoding($charset) ) { - Encode::from_to( $enc_str, $charset, $to_charset ); - } else { - $RT::Logger->warning("Charset '$charset' is not supported"); - $enc_str =~ s/[^[:print:]]/\357\277\275/g; - Encode::from_to( $enc_str, 'UTF-8', $to_charset ) - unless $to_charset eq 'utf-8'; - } + $RT::Logger->warning("Charset '$charset' is not supported"); + $enc_str =~ s/[^[:print:]]/\357\277\275/g; + Encode::from_to( $enc_str, 'UTF-8', $to_charset ) + unless $to_charset eq 'utf-8'; } - - # XXX TODO: RT doesn't currently do the right thing with mime-encoded headers - # We _should_ be preserving them encoded until after parsing is completed and - # THEN undo the mime-encoding. - # - # This routine should be translating the existing mimeencoding to utf8 but leaving - # things encoded. - # - # It's legal for headers to contain mime-encoded commas and semicolons which - # should not be treated as address separators. (Encoding == quoting here) - # - # until this is fixed, we must escape any string containing a comma or semicolon - # this is only a bandaid - - # Some _other_ MUAs encode quotes _already_, and double quotes - # confuse us a lot, so only quote it if it isn't quoted - # already. - $enc_str = qq{"$enc_str"} - if $enc_str =~ /[,;]/ - and $enc_str !~ /^".*"$/ - and $prefix !~ /"$/ and $trailing !~ /^"/ - and (!$field || $field =~ /^(?:To$|From$|B?Cc$|Content-)/i); - - $str .= $prefix . $enc_str . $trailing; } + $str .= $prefix . $enc_str . $trailing; } - # We might have \n without trailing whitespace, which will result in - # invalid headers. - $str =~ s/\n//g; - return ($str) } - =head2 _FindOrGuessCharset MIME::Entity, $head_only When handed a MIME::Entity will first attempt to read what charset the message is encoded in. Failing that, will use Encode::Guess to try to figure it out @@ -422,8 +510,8 @@ use Encode::Guess to try to figure it out the string's encoding. =cut -use constant HAS_ENCODE_GUESS => do { local $@; eval { require Encode::Guess; 1 } }; -use constant HAS_ENCODE_DETECT => do { local $@; eval { require Encode::Detect::Detector; 1 } }; +use constant HAS_ENCODE_GUESS => Encode::Guess->require; +use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require; sub _GuessCharset { my $fallback = _CanonicalizeCharset('iso-8859-1'); @@ -451,7 +539,7 @@ sub _GuessCharset { } } else { - $RT::Logger->error( + $RT::Logger->error( "You requested to guess encoding, but we couldn't" ." load Encode::Detect::Detector module" ); @@ -519,8 +607,12 @@ sub _CanonicalizeCharset { elsif ( $charset eq 'euc-cn' ) { # gbk is superset of gb2312/euc-cn so it's safe return 'gbk'; - # XXX TODO: gb18030 is an even larger, more permissive superset of gbk, - # but needs Encode::HanExtra installed + } + elsif ( $charset =~ /^(?:(?:big5(-1984|-2003|ext|plus))|cccii|unisys|euc-tw|gb18030|(?:cns11643-\d+))$/ ) { + unless ( Encode::HanExtra->require ) { + RT->Logger->error("Please install Encode::HanExtra to handle $charset"); + } + return $charset; } else { return $charset; @@ -528,7 +620,7 @@ sub _CanonicalizeCharset { } -=head2 SetMIMEHeadToEncoding HEAD OLD_CHARSET NEW_CHARSET +=head2 SetMIMEHeadToEncoding MIMEHead => HEAD, From => OLD_ENCODING, To => NEW_Encoding, PreserveWords => BOOL, IsOut => BOOL Converts a MIME Head from one encoding to another. This totally violates the RFC. We should never need this. But, Surprise!, MUAs are badly broken and do this kind of stuff @@ -538,7 +630,33 @@ all the time =cut sub SetMIMEHeadToEncoding { - my ( $head, $charset, $enc, $preserve_words ) = ( shift, shift, shift, shift ); + my ( $head, $charset, $enc, $preserve_words, $is_out ); + + if ( @_ <= 4 ) { + ( $head, $charset, $enc, $preserve_words ) = @_; + } + else { + my %args = ( + Head => undef, + From => undef, + To => undef, + PreserveWords => undef, + IsOut => undef, + @_, + ); + + $head = $args{Head}; + $charset = $args{From}; + $enc = $args{To}; + $preserve_words = $args{PreserveWords}; + $is_out = $args{IsOut}; + } + + unless ( $head && $charset && $enc ) { + RT->Logger->error( + "Missing Head or From or To arguments"); + return; + } $charset = _CanonicalizeCharset($charset); $enc = _CanonicalizeCharset($enc); @@ -552,9 +670,31 @@ sub SetMIMEHeadToEncoding { $head->delete($tag); foreach my $value (@values) { if ( $charset ne $enc || $enc =~ /^utf-?8(?:-strict)?$/i ) { - no warnings 'utf8'; - $value = Encode::encode( $enc, Encode::decode( $charset, $value) ); + my $orig_value = $value; + ( my $success, $value ) = EncodeFromToWithCroak( $orig_value, $charset => $enc ); + if ( !$success ) { + my $error = $value; + if ($is_out) { + $value = $orig_value; + $head->add( $tag, $value ); + next; + } + + my $guess = _GuessCharset($orig_value); + if ( $guess && $guess ne $charset ) { + $RT::Logger->error( "Encoding error: " . $error . " falling back to Guess($guess) => $enc" ); + ( $success, $value ) = EncodeFromToWithCroak( $orig_value, $guess, $enc ); + $error = $value unless $success; + } + + if ( !$success ) { + $RT::Logger->error( "Encoding error: " . $error . " forcing conversion to $charset => $enc" ); + $value = $orig_value; + Encode::from_to( $value, $charset => $enc ); + } + } } + $value = DecodeMIMEWordsToEncoding( $value, $enc, $tag ) unless $preserve_words; @@ -569,6 +709,26 @@ sub SetMIMEHeadToEncoding { } +=head2 EncodeFromToWithCroak $string, $from, $to + +Try to encode string from encoding $from to encoding $to in croak mode + +return (1, $encoded_string) if success, otherwise (0, $error) + +=cut + +sub EncodeFromToWithCroak { + my $string = shift; + my $from = shift; + my $to = shift; + + eval { + no warnings 'utf8'; + $string = Encode::encode( $to, Encode::decode( $from, $string ), Encode::FB_CROAK ); + }; + return $@ ? ( 0, $@ ) : ( 1, $string ); +} + RT::Base->_ImportOverlays(); 1; # End of module. diff --git a/rt/lib/RT/I18N/cs.pm b/rt/lib/RT/I18N/cs.pm index 9b1573d..59057d3 100644 --- a/rt/lib/RT/I18N/cs.pm +++ b/rt/lib/RT/I18N/cs.pm @@ -81,43 +81,21 @@ sub quant { # Normal case: # Note that the formatting of $num is preserved. - #return( $handle->numf($num) . ' ' . $handle->numerate($num, @forms) ); - return( $handle->numerate($num, @forms) ); - # Most human languages put the number phrase before the qualified phrase. + return( $handle->numf($num) . ' ' . $handle->numerate($num, @forms) ); } sub numerate { - # return this lexical item in a form appropriate to this number - my($handle, $num, @forms) = @_; - my $s = ($num == 1); - - return '' unless @forms; - return - $s ? $forms[0] : - ( $num > 1 && $num < 5 ) ? $forms[1] : - $forms[2]; -} - -#-------------------------------------------------------------------------- + # return this lexical item in a form appropriate to this number + my($handle, $num, @forms) = @_; -sub numf { - my($handle, $num) = @_[0,1]; - if($num < 10_000_000_000 and $num > -10_000_000_000 and $num == int($num)) { - $num += 0; # Just use normal integer stringification. - # Specifically, don't let %G turn ten million into 1E+007 - } else { - $num = CORE::sprintf("%G", $num); - # "CORE::" is there to avoid confusion with the above sub sprintf. - } - while( $num =~ s/^([-+]?\d+)(\d{3})/$1,$2/s ) {1} # right from perlfaq5 - # The initial \d+ gobbles as many digits as it can, and then we - # backtrack so it un-eats the rightmost three, and then we - # insert the comma there. + return '' unless @forms; - $num =~ tr<.,><,.> if ref($handle) and $handle->{'numf_comma'}; - # This is just a lame hack instead of using Number::Format - return $num; + my $fallback = (grep defined, @forms)[0]; + return $forms[0] // $fallback if $num == 1; + return $forms[1] // $fallback + if $num > 1 and $num < 5; + return $forms[2] // $fallback; } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/I18N/fr.pm b/rt/lib/RT/I18N/fr.pm index 2253768..cd1273d 100644 --- a/rt/lib/RT/I18N/fr.pm +++ b/rt/lib/RT/I18N/fr.pm @@ -56,11 +56,11 @@ use strict; use warnings; sub numf { - my ($handle, $num) = @_[0,1]; - my $fr_num = $handle->SUPER::numf($num); - # French prefer to print 1000 as 1(nbsp)000 rather than 1,000 - $fr_num =~ tr<.,><,\x{A0}>; - return $fr_num; + my ($handle, $num) = @_[0,1]; + my $fr_num = $handle->SUPER::numf($num); + # French prefer to print 1000 as 1(nbsp)000 rather than 1,000 + $fr_num =~ tr<.,><,\x{A0}>; + return $fr_num; } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/I18N/ru.pm b/rt/lib/RT/I18N/ru.pm index 783a0b1..c77e864 100755 --- a/rt/lib/RT/I18N/ru.pm +++ b/rt/lib/RT/I18N/ru.pm @@ -61,7 +61,7 @@ sub quant { return $num unless @forms; return $forms[3] if !$num && $forms[3]; - return $num .' '. $handle->numerate($num, @forms); + return $handle->numf($num) .' '. $handle->numerate($num, @forms); } sub numerate { @@ -75,7 +75,7 @@ sub numerate { } else { $form = 2; } - return $forms[$form]; + return $forms[$form] || (grep defined, @forms)[0]; } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Installer.pm b/rt/lib/RT/Installer.pm index 7c3e079..ccf4896 100644 --- a/rt/lib/RT/Installer.pm +++ b/rt/lib/RT/Installer.pm @@ -131,12 +131,6 @@ my %Meta = ( Hints => 'The password RT should use to connect to the database.', }, }, - DatabaseRequireSSL => { - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Use SSL?', # loc - }, - }, rtname => { Widget => '/Widgets/Form/String', WidgetArguments => { @@ -288,7 +282,9 @@ sub SaveConfig { # remove obsolete settings we'll add later $content =~ s/^\s* Set \s* \( \s* \$$_ .*$//xm; - $content .= "Set( \$$_, '$RT::Installer->{InstallConfig}{$_}' );\n"; + my $value = $RT::Installer->{InstallConfig}{$_}; + $value =~ s/(['\\])/\\$1/g; + $content .= "Set( \$$_, '$value' );\n"; } $content .= "1;\n"; print $fh $content; diff --git a/rt/lib/RT/Interface/CLI.pm b/rt/lib/RT/Interface/CLI.pm index 5faa8ca..f992f16 100644 --- a/rt/lib/RT/Interface/CLI.pm +++ b/rt/lib/RT/Interface/CLI.pm @@ -49,10 +49,11 @@ package RT::Interface::CLI; use strict; use warnings; -use RT; + +use RT::Base; use base 'Exporter'; -our @EXPORT_OK = qw(CleanEnv GetCurrentUser GetMessageContent debug loc); +our @EXPORT_OK = qw(CleanEnv GetCurrentUser debug loc Init); =head1 NAME @@ -60,27 +61,18 @@ our @EXPORT_OK = qw(CleanEnv GetCurrentUser GetMessageContent debug loc); =head1 SYNOPSIS - use lib "/path/to/rt/libraries/"; - - use RT::Interface::CLI qw(CleanEnv - GetCurrentUser GetMessageContent loc); - - #Clean out all the nasties from the environment - CleanEnv(); + use lib "/opt/rt4/local/lib", "/opt/rt4/lib"; - #let's talk to RT' - use RT; + use RT::Interface::CLI qw(GetCurrentUser Init loc); - #Load RT's config file - RT::LoadConfig(); + # Process command-line arguments, load the configuration, and connect + # to the database + Init(); - # Connect to the database. set up loggign - RT::Init(); - - #Get the current user all loaded + # Get the current user all loaded my $CurrentUser = GetCurrentUser(); - print loc('Hello!'); # Synonym of $CuurentUser->loc('Hello!'); + print loc('Hello!'); # Synonym of $CurrentUser->loc('Hello!'); =head1 DESCRIPTION @@ -98,11 +90,13 @@ Removes some of the nastiest nasties from the user's environment. =cut sub CleanEnv { + RT->Deprecated( Remove => "4.4" ); + $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; $ENV{'ENV'} = '' if defined $ENV{'ENV'}; - $ENV{'IFS'} = '' if defined $ENV{'IFS'}; + $ENV{'IFS'} = '' if defined $ENV{'IFS'}; } @@ -121,28 +115,26 @@ loaded with that user. if the current user isn't found, returns a copy of RT::N =cut sub GetCurrentUser { - + require RT::CurrentUser; - + #Instantiate a user object - - my $Gecos= ($^O eq 'MSWin32') ? Win32::LoginName() : (getpwuid($<))[0]; + + my $Gecos= (getpwuid($<))[0]; #If the current user is 0, then RT will assume that the User object #is that of the currentuser. $CurrentUser = RT::CurrentUser->new(); $CurrentUser->LoadByGecos($Gecos); - + unless ($CurrentUser->Id) { - $RT::Logger->debug("No user with a unix login of '$Gecos' was found. "); + $RT::Logger->error("No user with a GECOS (unix login) of '$Gecos' was found."); } return($CurrentUser); } - - =head2 loc Synonym of $CurrentUser->loc(). @@ -156,82 +148,9 @@ sub loc { } - - -=head2 GetMessageContent - -Takes two arguments a source file and a boolean "edit". If the source file -is undef or "", assumes an empty file. Returns an edited file as an -array of lines. - -=cut - -sub GetMessageContent { - my %args = ( Source => undef, - Content => undef, - Edit => undef, - CurrentUser => undef, - @_); - my $source = $args{'Source'}; - - my $edit = $args{'Edit'}; - - my $currentuser = $args{'CurrentUser'}; - my @lines; - - use File::Temp qw/ tempfile/; - - #Load the sourcefile, if it's been handed to us - if ($source) { - open( SOURCE, '<', $source ) or die $!; - @lines = (<SOURCE>) or die $!; - close (SOURCE) or die $!; - } - elsif ($args{'Content'}) { - @lines = split('\n',$args{'Content'}); - } - #get us a tempfile. - my ($fh, $filename) = tempfile(); - - #write to a tmpfile - for (@lines) { - print $fh $_; - } - close ($fh) or die $!; - - #Edit the file if we need to - if ($edit) { - - unless ($ENV{'EDITOR'}) { - $RT::Logger->crit('No $EDITOR variable defined'); - return undef; - } - system ($ENV{'EDITOR'}, $filename); - } - - open( READ, '<', $filename ) or die $!; - my @newlines = (<READ>); - close (READ) or die $!; - - unlink ($filename) unless (debug()); - return(\@newlines); - -} - - - sub debug { - my $val = shift; - my ($debug); - if ($val) { - $RT::Logger->debug($val); - if ($debug) { - print STDERR "$val\n"; - } - } - if ($debug) { - return(1); - } + RT->Deprecated( Remove => "4.4", Instead => '$RT::Logger->debug' ); + $RT::Logger->debug(@_); } sub ShowHelp { @@ -249,6 +168,78 @@ sub ShowHelp { ); } +=head2 Init + +A shim for L<Getopt::Long/GetOptions> which automatically adds a +C<--help> option if it is not supplied. It then calls L<RT/LoadConfig> +and L<RT/Init>. + +It sets the C<LogToSTDERR> setting to C<warning>, to ensure that the +user sees all relevant warnings. It also adds C<--quiet> and +C<--verbose> options, which adjust the C<LogToSTDERR> value to C<error> +or C<debug>, respectively. + +=cut + +sub Init { + require Getopt::Long; + require Pod::Usage; + + my %exists; + my @args; + my $hash; + if (ref $_[0]) { + $hash = shift(@_); + for (@_) { + m/^([a-zA-Z0-9-]+)/; + $exists{$1}++; + push @args, $_ => \($hash->{$1}); + } + } else { + $hash = {}; + @args = @_; + while (@_) { + my $key = shift(@_); + $exists{$key}++; + shift(@_); + } + } + + push @args, "help|h!" => \($hash->{help}) + unless $exists{help}; + + push @args, "verbose|v!" => \($hash->{verbose}) + unless $exists{verbose}; + + push @args, "quiet|q!" => \($hash->{quiet}) + unless $exists{quiet}; + + my $ok = Getopt::Long::GetOptions( @args ); + Pod::Usage::pod2usage(1) if not $ok and not defined wantarray; + + return unless $ok; + + Pod::Usage::pod2usage({ verbose => 2}) + if not $exists{help} and $hash->{help}; + + require RT; + RT::LoadConfig(); + + if (not $exists{quiet} and $hash->{quiet}) { + RT->Config->Set(LogToSTDERR => "error"); + } elsif (not $exists{verbose} and $hash->{verbose}) { + RT->Config->Set(LogToSTDERR => "debug"); + } else { + RT->Config->Set(LogToSTDERR => "warning"); + } + + RT::Init(); + + $| = 1; + + return $ok; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm index f860461..87e24e7 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -50,27 +50,25 @@ package RT::Interface::Email; use strict; use warnings; +use 5.010; use Email::Address; use MIME::Entity; use RT::EmailParser; use File::Temp; -use UNIVERSAL::require; use Mail::Mailer (); use Text::ParseWords qw/shellwords/; +use RT::Util 'safe_run_child'; +use File::Spec; BEGIN { use base 'Exporter'; use vars qw ( @EXPORT_OK); - # set the version for version checking - our $VERSION = 2.0; - # your exported package globals go here, # as well as any optionally exported functions @EXPORT_OK = qw( &CreateUser - &GetMessageContent &CheckForLoops &CheckForSuspiciousSender &CheckForAutoGenerated @@ -165,17 +163,16 @@ sub CheckForSuspiciousSender { =head2 CheckForAutoGenerated HEAD -Takes a HEAD object of L<MIME::Head> class and returns true if message -is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated' -fields of the head in tests. +Takes a HEAD object of L<MIME::Head> class and returns true if message is +autogenerated. Checks C<Precedence>, C<Auto-Submitted>, and +C<X-FC-Machinegenerated> fields of the head in tests. =cut sub CheckForAutoGenerated { my $head = shift; - my $Precedence = $head->get("Precedence") || ""; - if ( $Precedence =~ /^(bulk|junk)/i ) { + if (grep { /^(bulk|junk)/i } $head->get_all("Precedence")) { return (1); } @@ -331,7 +328,7 @@ sub WillSignEncrypt { my $attachment = delete $args{Attachment}; my $ticket = delete $args{Ticket}; - if ( not RT->Config->Get('GnuPG')->{'Enable'} ) { + if ( not RT->Config->Get('Crypt')->{'Enable'} ) { $args{Sign} = $args{Encrypt} = 0; return wantarray ? %args : 0; } @@ -367,13 +364,6 @@ sub SendEmail { my $TicketObj = $args{'Ticket'}; my $TransactionObj = $args{'Transaction'}; - foreach my $arg( qw(Entity Bounce) ) { - next unless defined $args{ lc $arg }; - - $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead"); - $args{ $arg } = delete $args{ lc $arg }; - } - unless ( $args{'Entity'} ) { $RT::Logger->crit( "Could not send mail without 'Entity' object" ); return 0; @@ -396,13 +386,35 @@ sub SendEmail { return -1; } + if (my $precedence = RT->Config->Get('DefaultMailPrecedence') + and !$args{'Entity'}->head->get("Precedence") + ) { + $args{'Entity'}->head->replace( 'Precedence', Encode::encode("UTF-8",$precedence) ); + } + if ( $TransactionObj && !$TicketObj && $TransactionObj->ObjectType eq 'RT::Ticket' ) { $TicketObj = $TransactionObj->Object; } - if ( RT->Config->Get('GnuPG')->{'Enable'} ) { + my $head = $args{'Entity'}->head; + unless ( $head->get('Date') ) { + require RT::Date; + my $date = RT::Date->new( RT->SystemUser ); + $date->SetToNow; + $head->replace( 'Date', Encode::encode("UTF-8",$date->RFC2822( Timezone => 'server' ) ) ); + } + unless ( $head->get('MIME-Version') ) { + # We should never have to set the MIME-Version header + $head->replace( 'MIME-Version', '1.0' ); + } + unless ( $head->get('Content-Transfer-Encoding') ) { + # fsck.com #5959: Since RT sends 8bit mail, we should say so. + $head->replace( 'Content-Transfer-Encoding', '8bit' ); + } + + if ( RT->Config->Get('Crypt')->{'Enable'} ) { %args = WillSignEncrypt( %args, Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef, @@ -412,26 +424,15 @@ sub SendEmail { return $res unless $res > 0; } - unless ( $args{'Entity'}->head->get('Date') ) { - require RT::Date; - my $date = RT::Date->new( RT->SystemUser ); - $date->SetToNow; - $args{'Entity'}->head->set( 'Date', Encode::encode( "UTF-8", $date->RFC2822( Timezone => 'server' ) ) ); - } - my $mail_command = RT->Config->Get('MailCommand'); - if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) { - $Mail::Mailer::testfile::config{outfile} = File::Temp->new; - $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}"); - } - # if it is a sub routine, we just return it; return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' ); if ( $mail_command eq 'sendmailpipe' ) { my $path = RT->Config->Get('SendmailPath'); my @args = shellwords(RT->Config->Get('SendmailArguments')); + push @args, "-t" unless grep {$_ eq "-t"} @args; # SetOutgoingMailFrom and bounces conflict, since they both want -f if ( $args{'Bounce'} ) { @@ -441,14 +442,15 @@ sub SendEmail { my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {}; if ($TicketObj) { - my $QueueName = $TicketObj->QueueObj->Name; - my $QueueAddressOverride = $Overrides->{$QueueName}; + my $Queue = $TicketObj->QueueObj; + my $QueueAddressOverride = $Overrides->{$Queue->id} + || $Overrides->{$Queue->Name}; if ($QueueAddressOverride) { $OutgoingMailAddress = $QueueAddressOverride; } else { - $OutgoingMailAddress ||= $TicketObj->QueueObj->CorrespondAddress - || RT->Config->Get('CorrespondAddress'); + $OutgoingMailAddress ||= $Queue->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); } } elsif ($Overrides->{'Default'}) { @@ -502,62 +504,42 @@ sub SendEmail { } return 0; } - } - elsif ( $mail_command eq 'smtp' ) { - require Net::SMTP; - my $smtp = do { local $@; eval { Net::SMTP->new( - Host => RT->Config->Get('SMTPServer'), - Debug => RT->Config->Get('SMTPDebug'), - ) } }; - unless ( $smtp ) { - $RT::Logger->crit( "Could not connect to SMTP server."); - if ($TicketObj) { - _RecordSendEmailFailure( $TicketObj ); - } - return 0; + } elsif ( $mail_command eq 'mbox' ) { + my $now = RT::Date->new(RT->SystemUser); + $now->SetToNow; + + state $logfile; + unless ($logfile) { + my $when = $now->ISO( Timezone => "server" ); + $when =~ s/\s+/-/g; + $logfile = "$RT::VarPath/$when.mbox"; + $RT::Logger->info("Storing outgoing emails in $logfile"); } - # duplicate head as we want drop Bcc field - my $head = $args{'Entity'}->head->dup; - my @recipients = map $_->address, map - Email::Address->parse(Encode::decode("UTF-8", $head->get($_))), - qw(To Cc Bcc); - $head->delete('Bcc'); - - my $sender = RT->Config->Get('SMTPFrom') - || Encode::decode( "UTF-8", $args{'Entity'}->head->get('From') ); - chomp $sender; - - my $status = $smtp->mail( $sender ) - && $smtp->recipient( @recipients ); - - if ( $status ) { - $smtp->data; - my $fh = $smtp->tied_fh; - $head->print( $fh ); - print $fh "\n"; - $args{'Entity'}->print_body( $fh ); - $smtp->dataend; - } - $smtp->quit; - - unless ( $status ) { - $RT::Logger->crit( "$msgid: Could not send mail via SMTP." ); - if ( $TicketObj ) { - _RecordSendEmailFailure( $TicketObj ); - } + my $fh; + unless (open($fh, ">>", $logfile)) { + $RT::Logger->crit( "Can't open mbox file $logfile: $!" ); return 0; } - } - else { + my $content = $args{Entity}->stringify; + $content =~ s/^(>*From )/>$1/mg; + print $fh "From $ENV{USER}\@localhost ".localtime."\n"; + print $fh $content, "\n"; + close $fh; + } else { local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'}); my @mailer_args = ($mail_command); if ( $mail_command eq 'sendmail' ) { $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath'); - push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments')); - } - else { + push @mailer_args, grep {$_ ne "-t"} + split(/\s+/, RT->Config->Get('SendmailArguments')); + } elsif ( $mail_command eq 'testfile' ) { + unless ($Mail::Mailer::testfile::config{outfile}) { + $Mail::Mailer::testfile::config{outfile} = File::Temp->new; + $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}"); + } + } else { push @mailer_args, RT->Config->Get('MailParams'); } @@ -630,10 +612,10 @@ sub SendEmailUsingTemplate { return -1; } - $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ $_ } ) ) + $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ $_ } ) ) foreach grep defined $args{$_}, qw(To Cc Bcc From); - $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) ) + $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) ) foreach keys %{ $args{ExtraHeaders} }; SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} ); @@ -641,195 +623,58 @@ sub SendEmailUsingTemplate { return SendEmail( Entity => $mail ); } -=head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => '' - -Forwards transaction with all attachments as 'message/rfc822'. - -=cut - -sub ForwardTransaction { - my $txn = shift; - my %args = ( To => '', Cc => '', Bcc => '', @_ ); - - my $entity = $txn->ContentAsMIME; - - my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn ); - if ($ret) { - my $ticket = $txn->TicketObj; - my ( $ret, $msg ) = $ticket->_NewTransaction( - Type => 'Forward Transaction', - Field => $txn->id, - Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc}, - ); - unless ($ret) { - $RT::Logger->error("Failed to create transaction: $msg"); - } - } - return ( $ret, $msg ); -} - -=head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => '' - -Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'. - -=cut - -sub ForwardTicket { - my $ticket = shift; - my %args = ( To => '', Cc => '', Bcc => '', @_ ); - - my $txns = $ticket->Transactions; - $txns->Limit( - FIELD => 'Type', - VALUE => $_, - ) for qw(Create Correspond); - - my $entity = MIME::Entity->build( - Type => 'multipart/mixed', - Description => 'forwarded ticket', - ); - $entity->add_part( $_ ) foreach - map $_->ContentAsMIME, - @{ $txns->ItemsArrayRef }; - - my ( $ret, $msg ) = SendForward( - %args, - Entity => $entity, - Ticket => $ticket, - Template => 'Forward Ticket', - ); - - if ($ret) { - my ( $ret, $msg ) = $ticket->_NewTransaction( - Type => 'Forward Ticket', - Field => $ticket->id, - Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc}, - ); - unless ($ret) { - $RT::Logger->error("Failed to create transaction: $msg"); - } - } - - return ( $ret, $msg ); - -} - -=head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => '' +=head2 GetForwardFrom Ticket => undef, Transaction => undef -Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template. +Resolve the From field to use in forward mail =cut -sub SendForward { - my (%args) = ( - Entity => undef, - Ticket => undef, - Transaction => undef, - Template => 'Forward', - To => '', Cc => '', Bcc => '', - @_ - ); - - my $txn = $args{'Transaction'}; - my $ticket = $args{'Ticket'}; - $ticket ||= $txn->Object if $txn; - - my $entity = $args{'Entity'}; - unless ( $entity ) { - require Carp; - $RT::Logger->error(Carp::longmess("No entity provided")); - return (0, $ticket->loc("Couldn't send email")); - } - - my ($template, $msg) = PrepareEmailUsingTemplate( - Template => $args{'Template'}, - Arguments => { - Ticket => $ticket, - Transaction => $txn, - }, - ); - - my $mail; - if ( $template ) { - $mail = $template->MIMEObj; - } else { - $RT::Logger->warning($msg); - } - unless ( $mail ) { - $RT::Logger->warning("Couldn't generate email using template '$args{Template}'"); +sub GetForwardFrom { + my %args = ( Ticket => undef, Transaction => undef, @_ ); + my $txn = $args{Transaction}; + my $ticket = $args{Ticket} || $txn->Object; - my $description; - unless ( $args{'Transaction'} ) { - $description = 'This is forward of ticket #'. $ticket->id; - } else { - $description = 'This is forward of transaction #' - . $txn->id ." of a ticket #". $txn->ObjectId; - } - $mail = MIME::Entity->build( - Type => 'text/plain', - Charset => "UTF-8", - Data => Encode::encode( "UTF-8", $description ), - ); + if ( RT->Config->Get('ForwardFromUser') ) { + return ( $txn || $ticket )->CurrentUser->EmailAddress; } - - $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) ) - foreach grep defined $args{$_}, qw(To Cc Bcc); - - $mail->make_multipart unless $mail->is_multipart; - $mail->add_part( $entity ); - - my $from; - unless (defined $mail->head->get('Subject')) { - my $subject = ''; - $subject = $txn->Subject if $txn; - $subject ||= $ticket->Subject if $ticket; - - unless ( RT->Config->Get('ForwardFromUser') ) { - # XXX: what if want to forward txn of other object than ticket? - $subject = AddSubjectTag( $subject, $ticket ); - } - - $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) ); + else { + return $ticket->QueueObj->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); } - - $mail->head->set( - From => EncodeToMIME( - String => GetForwardFrom( Transaction => $txn, Ticket => $ticket ) - ) - ); - - my $status = RT->Config->Get('ForwardFromUser') - # never sign if we forward from User - ? SendEmail( %args, Entity => $mail, Sign => 0 ) - : SendEmail( %args, Entity => $mail ); - return (0, $ticket->loc("Couldn't send email")) unless $status; - return (1, $ticket->loc("Sent email successfully")); } -=head2 GetForwardFrom Ticket => undef, Transaction => undef +=head2 GetForwardAttachments Ticket => undef, Transaction => undef -Resolve the From field to use in forward mail +Resolve the Attachments to forward =cut -sub GetForwardFrom { +sub GetForwardAttachments { my %args = ( Ticket => undef, Transaction => undef, @_ ); my $txn = $args{Transaction}; my $ticket = $args{Ticket} || $txn->Object; - if ( RT->Config->Get('ForwardFromUser') ) { - return ( $txn || $ticket )->CurrentUser->EmailAddress; + my $attachments = RT::Attachments->new( $ticket->CurrentUser ); + if ($txn) { + $attachments->Limit( FIELD => 'TransactionId', VALUE => $txn->id ); } else { - return $ticket->QueueObj->CorrespondAddress - || RT->Config->Get('CorrespondAddress'); + $attachments->LimitByTicket( $ticket->id ); + $attachments->Limit( + ALIAS => $attachments->TransactionAlias, + FIELD => 'Type', + OPERATOR => 'IN', + VALUE => [ qw(Create Correspond) ], + ); } + return $attachments; } + =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0 -Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well -handle errors with users' keys. +Signs and encrypts message using L<RT::Crypt>, but as well handle errors +with users' keys. If a recipient has no key or has other problems with it, then the unction sends a error to him using 'Error: public key' template. @@ -857,11 +702,12 @@ sub SignEncrypt { $RT::Logger->debug("$msgid Signing message") if $args{'Sign'}; $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'}; - require RT::Crypt::GnuPG; - my %res = RT::Crypt::GnuPG::SignEncrypt( %args ); + my %res = RT::Crypt->SignEncrypt( %args ); return 1 unless $res{'exit_code'}; - my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + my @status = RT::Crypt->ParseStatus( + Protocol => $res{'Protocol'}, Status => $res{'status'}, + ); my @bad_recipients; foreach my $line ( @status ) { @@ -925,7 +771,7 @@ sub SignEncrypt { } # redo without broken recipients - %res = RT::Crypt::GnuPG::SignEncrypt( %args ); + %res = RT::Crypt->SignEncrypt( %args ); return 0 if $res{'exit_code'}; return 1; @@ -1203,7 +1049,7 @@ sub DeleteRecipientsFromHead { my %skip = map { lc $_ => 1 } @_; foreach my $field ( qw(To Cc Bcc) ) { - $head->set( $field => Encode::encode( "UTF-8", + $head->replace( $field => Encode::encode( "UTF-8", join ', ', map $_->format, grep !$skip{ lc $_->address }, Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) ) ); @@ -1254,17 +1100,35 @@ sub SetInReplyTo { } push @references, @id, @rtid; if ( $args{'Ticket'} ) { - my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>'; + my $pseudo_ref = PseudoReference( $args{'Ticket'} ); push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references; } - @references = splice @references, 4, -6 + splice @references, 4, -6 if @references > 10; my $mail = $args{'Message'}; - $mail->head->set( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; - $mail->head->set( 'References' => Encode::encode( "UTF-8", join ' ', @references) ); + $mail->head->replace( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; + $mail->head->replace( 'References' => Encode::encode( "UTF-8", join ' ', @references) ); } +sub PseudoReference { + my $ticket = shift; + return '<RT-Ticket-'. $ticket->id .'@'. RT->Config->Get('Organization') .'>'; +} + +=head2 ExtractTicketId + +Passed a MIME::Entity. Returns a ticket id or undef to signal 'new ticket'. + +This is a great entry point if you need to customize how ticket ids are +handled for your site. RT-Extension-RepliesToResolved demonstrates one +possible use for this extension. + +If the Subject of this ticket is modified, it will be reloaded by the +mail gateway code before Ticket creation. + +=cut + sub ExtractTicketId { my $entity = shift; @@ -1273,19 +1137,29 @@ sub ExtractTicketId { return ParseTicketId( $subject ); } +=head2 ParseTicketId + +Takes a string and searches for [subjecttag #id] + +Returns the id if a match is found. Otherwise returns undef. + +=cut + sub ParseTicketId { my $Subject = shift; my $rtname = RT->Config->Get('rtname'); my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i; + # We use @captures and pull out the last capture value to guard against + # someone using (...) instead of (?:...) in $EmailSubjectTagRegex. my $id; - if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) { - $id = $1; + if ( my @captures = $Subject =~ /\[$test_name\s+\#(\d+)\s*\]/i ) { + $id = $captures[-1]; } else { foreach my $tag ( RT->System->SubjectTag ) { - next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i; - $id = $1; + next unless my @captures = $Subject =~ /\[\Q$tag\E\s+\#(\d+)\s*\]/i; + $id = $captures[-1]; last; } } @@ -1434,6 +1308,10 @@ sub Gateway { push @mail_plugins, "Auth::MailFrom" unless @mail_plugins; @mail_plugins = _LoadPlugins( @mail_plugins ); + #Set up a queue object + my $SystemQueueObj = RT::Queue->new( RT->SystemUser ); + $SystemQueueObj->Load( $args{'queue'} ); + my %skip_plugin; foreach my $class( grep !ref, @mail_plugins ) { # check if we should apply filter before decoding @@ -1445,6 +1323,8 @@ sub Gateway { next unless $check_cb->( Message => $Message, RawMessageRef => \$args{'message'}, + Queue => $SystemQueueObj, + Actions => \@actions, ); $skip_plugin{ $class }++; @@ -1456,6 +1336,8 @@ sub Gateway { my ($status, $msg) = $Code->( Message => $Message, RawMessageRef => \$args{'message'}, + Queue => $SystemQueueObj, + Actions => \@actions, ); next if $status > 0; @@ -1514,10 +1396,6 @@ sub Gateway { $Right = 'CreateTicket'; } - #Set up a queue object - my $SystemQueueObj = RT::Queue->new( RT->SystemUser ); - $SystemQueueObj->Load( $args{'queue'} ); - # We can safely have no queue of we have a known-good ticket unless ( $SystemTicket->id || $SystemQueueObj->id ) { return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef ); @@ -1572,6 +1450,8 @@ sub Gateway { return ( 0, $result, undef ); } + $head->replace('X-RT-Interface' => 'Email'); + # if plugin's updated SystemTicket then update arguments $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id; @@ -1591,8 +1471,6 @@ sub Gateway { ); } - $head->replace('X-RT-Interface' => 'Email'); - my ( $id, $Transaction, $ErrStr ) = $Ticket->Create( Queue => $SystemQueueObj->Id, Subject => $NewSubject, @@ -1932,9 +1810,10 @@ sub IsCorrectAction { sub _RecordSendEmailFailure { my $ticket = shift; if ($ticket) { - $ticket->_RecordNote( - NoteType => 'SystemError', - Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.", + $ticket->_NewTransaction( + Type => "SystemError", + Data => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.", #loc + ActivateScrips => 0, ); return 1; } @@ -1944,6 +1823,118 @@ sub _RecordSendEmailFailure { } } +=head2 ConvertHTMLToText HTML + +Takes HTML characters and converts it to plain text characters. +Appropriate for generating a plain text part from an HTML part of an +email. Returns undef if conversion fails. + +=cut + +sub ConvertHTMLToText { + return _HTMLFormatter()->(@_); +} + +sub _HTMLFormatter { + state $formatter; + return $formatter if defined $formatter; + + my $wanted = RT->Config->Get("HTMLFormatter"); + + my @order; + if ($wanted) { + @order = ($wanted, "core"); + } else { + @order = ("w3m", "elinks", "links", "html2text", "lynx", "core"); + } + # Always fall back to core, even if it is not listed + for my $prog (@order) { + if ($prog eq "core") { + RT->Logger->debug("Using internal Perl HTML -> text conversion"); + require HTML::FormatText::WithLinks::AndTables; + $formatter = \&_HTMLFormatText; + } else { + unless (HTML::FormatExternal->require) { + RT->Logger->warn("HTML::FormatExternal is not installed; falling back to internal perl formatter") + if $wanted; + next; + } + + my $path = $prog =~ s{(.*/)}{} ? $1 : undef; + my $package = "HTML::FormatText::" . ucfirst($prog); + unless ($package->require) { + RT->Logger->warn("$prog is not a valid formatter provided by HTML::FormatExternal") + if $wanted; + next; + } + + if ($path) { + local $ENV{PATH} = $path; + local $ENV{HOME} = File::Spec->tmpdir(); + if (not defined $package->program_version) { + RT->Logger->warn("Could not find or run external '$prog' HTML formatter in $path$prog") + if $wanted; + next; + } + } else { + local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin' + unless defined $ENV{PATH}; + local $ENV{HOME} = File::Spec->tmpdir(); + if (not defined $package->program_version) { + RT->Logger->warn("Could not find or run external '$prog' HTML formatter in \$PATH ($ENV{PATH}) -- you may need to install it or provide the full path") + if $wanted; + next; + } + } + + RT->Logger->debug("Using $prog for HTML -> text conversion"); + $formatter = sub { + my $html = shift; + my $text = RT::Util::safe_run_child { + local $ENV{PATH} = $path || $ENV{PATH} + || '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'; + local $ENV{HOME} = File::Spec->tmpdir(); + $package->format_string( + Encode::encode( "UTF-8", $html ), + input_charset => "UTF-8", + output_charset => "UTF-8", + leftmargin => 0, rightmargin => 78 + ); + }; + $text = Encode::decode( "UTF-8", $text ); + return $text; + }; + } + RT->Config->Set( HTMLFormatter => $prog ); + last; + } + return $formatter; +} + +sub _HTMLFormatText { + my $html = shift; + + my $text; + eval { + $text = HTML::FormatText::WithLinks::AndTables->convert( + $html => { + leftmargin => 0, + rightmargin => 78, + no_rowspacing => 1, + before_link => '', + after_link => ' (%l)', + footnote => '', + skip_linked_urls => 1, + with_emphasis => 0, + } + ); + $text //= ''; + }; + $RT::Logger->error("Failed to downgrade HTML to plain text: $@") if $@; + return $text; +} + + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Interface/Email.pm.orig b/rt/lib/RT/Interface/Email.pm.orig index 74120ba..f860461 100755 --- a/rt/lib/RT/Interface/Email.pm.orig +++ b/rt/lib/RT/Interface/Email.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 # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -114,7 +114,7 @@ sub CheckForLoops { my $head = shift; # If this instance of RT sent it our, we don't want to take it in - my $RTLoop = $head->get("X-RT-Loop-Prevention") || ""; + my $RTLoop = Encode::decode( "UTF-8", $head->get("X-RT-Loop-Prevention") || "" ); chomp ($RTLoop); # remove that newline if ( $RTLoop eq RT->Config->Get('rtname') ) { return 1; @@ -253,22 +253,27 @@ sub MailError { # the colons are necessary to make ->build include non-standard headers my %entity_args = ( Type => "multipart/mixed", - From => $args{'From'}, - Bcc => $args{'Bcc'}, - To => $args{'To'}, - Subject => $args{'Subject'}, - 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'), + From => Encode::encode( "UTF-8", $args{'From'} ), + Bcc => Encode::encode( "UTF-8", $args{'Bcc'} ), + To => Encode::encode( "UTF-8", $args{'To'} ), + Subject => EncodeToMIME( String => $args{'Subject'} ), + 'X-RT-Loop-Prevention:' => Encode::encode( "UTF-8", RT->Config->Get('rtname') ), ); # only set precedence if the sysadmin wants us to if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) { - $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence'); + $entity_args{'Precedence:'} = + Encode::encode( "UTF-8", RT->Config->Get('DefaultErrorMailPrecedence') ); } my $entity = MIME::Entity->build(%entity_args); SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} ); - $entity->attach( Data => $args{'Explanation'} . "\n" ); + $entity->attach( + Type => "text/plain", + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $args{'Explanation'} . "\n" ), + ); if ( $args{'MIMEObj'} ) { $args{'MIMEObj'}->sync_headers; @@ -276,7 +281,7 @@ sub MailError { } if ( $args{'Attach'} ) { - $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' ); + $entity->attach( Data => Encode::encode( "UTF-8", $args{'Attach'} ), Type => 'message/rfc822' ); } @@ -374,7 +379,7 @@ sub SendEmail { return 0; } - my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); chomp $msgid; # If we don't have any recipients to send to, don't send a message; @@ -411,7 +416,7 @@ sub SendEmail { require RT::Date; my $date = RT::Date->new( RT->SystemUser ); $date->SetToNow; - $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) ); + $args{'Entity'}->head->set( 'Date', Encode::encode( "UTF-8", $date->RFC2822( Timezone => 'server' ) ) ); } my $mail_command = RT->Config->Get('MailCommand'); @@ -514,12 +519,13 @@ sub SendEmail { # duplicate head as we want drop Bcc field my $head = $args{'Entity'}->head->dup; - my @recipients = map $_->address, map - Email::Address->parse($head->get($_)), qw(To Cc Bcc); + my @recipients = map $_->address, map + Email::Address->parse(Encode::decode("UTF-8", $head->get($_))), + qw(To Cc Bcc); $head->delete('Bcc'); my $sender = RT->Config->Get('SMTPFrom') - || $args{'Entity'}->head->get('From'); + || Encode::decode( "UTF-8", $args{'Entity'}->head->get('From') ); chomp $sender; my $status = $smtp->mail( $sender ) @@ -624,10 +630,10 @@ sub SendEmailUsingTemplate { return -1; } - $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) ) + $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ $_ } ) ) foreach grep defined $args{$_}, qw(To Cc Bcc From); - $mail->head->set( $_ => $args{ExtraHeaders}{$_} ) + $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) ) foreach keys %{ $args{ExtraHeaders} }; SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} ); @@ -760,8 +766,9 @@ sub SendForward { . $txn->id ." of a ticket #". $txn->ObjectId; } $mail = MIME::Entity->build( - Type => 'text/plain', - Data => $description, + Type => 'text/plain', + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $description ), ); } @@ -844,7 +851,7 @@ sub SignEncrypt { ); return 1 unless $args{'Sign'} || $args{'Encrypt'}; - my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); chomp $msgid; $RT::Logger->debug("$msgid Signing message") if $args{'Sign'}; @@ -980,9 +987,6 @@ sub EncodeToMIME { $value =~ s/\s+$//; - # we need perl string to split thing char by char - Encode::_utf8_on($value) unless Encode::is_utf8($value); - my ( $tmp, @chunks ) = ( '', () ); while ( length $value ) { my $char = substr( $value, 0, 1, '' ); @@ -1087,7 +1091,8 @@ sub ParseCcAddressesFromHead { && !IgnoreCcAddress( $_ ) } map lc $user->CanonicalizeEmailAddress( $_->address ), - map RT::EmailParser->CleanupAddresses( Email::Address->parse( $args{'Head'}->get( $_ ) ) ), + map RT::EmailParser->CleanupAddresses( Email::Address->parse( + Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ), qw(To Cc); } @@ -1125,7 +1130,7 @@ sub ParseSenderAddressFromHead { #Figure out who's sending this message. foreach my $header ( @sender_headers ) { - my $addr_line = $head->get($header) || next; + my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next; my ($addr, $name) = ParseAddressFromHeader( $addr_line ); # only return if the address is not empty return ($addr, $name, @errors) if $addr; @@ -1153,7 +1158,7 @@ sub ParseErrorsToAddressFromHead { foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) { # If there's a header of that name - my $headerobj = $head->get($header); + my $headerobj = Encode::decode( "UTF-8", $head->get($header) ); if ($headerobj) { my ( $addr, $name ) = ParseAddressFromHeader($headerobj); @@ -1198,9 +1203,9 @@ sub DeleteRecipientsFromHead { my %skip = map { lc $_ => 1 } @_; foreach my $field ( qw(To Cc Bcc) ) { - $head->set( $field => + $head->set( $field => Encode::encode( "UTF-8", join ', ', map $_->format, grep !$skip{ lc $_->address }, - Email::Address->parse( $head->get( $field ) ) + Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) ) ); } } @@ -1233,7 +1238,7 @@ sub SetInReplyTo { my $get_header = sub { my @res; if ( $args{'InReplyTo'}->isa('MIME::Entity') ) { - @res = $args{'InReplyTo'}->head->get( shift ); + @res = map {Encode::decode("UTF-8", $_)} $args{'InReplyTo'}->head->get( shift ); } else { @res = $args{'InReplyTo'}->GetHeader( shift ) || ''; } @@ -1256,14 +1261,14 @@ sub SetInReplyTo { if @references > 10; my $mail = $args{'Message'}; - $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; - $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) ); + $mail->head->set( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; + $mail->head->set( 'References' => Encode::encode( "UTF-8", join ' ', @references) ); } sub ExtractTicketId { my $entity = shift; - my $subject = $entity->head->get('Subject') || ''; + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') || '' ); chomp $subject; return ParseTicketId( $subject ); } @@ -1468,14 +1473,14 @@ sub Gateway { my $head = $Message->head; my $ErrorsTo = ParseErrorsToAddressFromHead( $head ); my $Sender = (ParseSenderAddressFromHead( $head ))[0]; - my $From = $head->get("From"); + my $From = Encode::decode( "UTF-8", $head->get("From") ); chomp $From if defined $From; - my $MessageId = $head->get('Message-ID') + my $MessageId = Encode::decode( "UTF-8", $head->get('Message-ID') ) || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>'; #Pull apart the subject line - my $Subject = $head->get('Subject') || ''; + my $Subject = Encode::decode( "UTF-8", $head->get('Subject') || ''); chomp $Subject; # Lets check for mail loops of various sorts. @@ -1498,7 +1503,7 @@ sub Gateway { $args{'ticket'} ||= ExtractTicketId( $Message ); # ExtractTicketId may have been overridden, and edited the Subject - my $NewSubject = $Message->head->get('Subject'); + my $NewSubject = Encode::decode( "UTF-8", $Message->head->get('Subject') ); chomp $NewSubject; $SystemTicket = RT::Ticket->new( RT->SystemUser ); @@ -1746,7 +1751,7 @@ sub _RunUnsafeAction { @_ ); - my $From = $args{Message}->head->get("From"); + my $From = Encode::decode( "UTF-8", $args{Message}->head->get("From") ); if ( $args{'Action'} =~ /^take$/i ) { my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id ); @@ -1902,7 +1907,7 @@ sub _HandleMachineGeneratedMail { # to the scrip. We might want to notify nobody. Or just # the RT Owner. Or maybe all Privileged watchers. my ( $Sender, $junk ) = ParseSenderAddressFromHead($head); - $head->replace( 'RT-Squelch-Replies-To', $Sender ); + $head->replace( 'RT-Squelch-Replies-To', Encode::encode("UTF-8", $Sender ) ); $head->replace( 'RT-DetectedAutoGenerated', 'true' ); } return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop ); diff --git a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm b/rt/lib/RT/Interface/Email/Auth/Crypt.pm index ec409a4..8f8e636 100755..100644 --- a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm +++ b/rt/lib/RT/Interface/Email/Auth/Crypt.pm @@ -46,12 +46,30 @@ # # END BPS TAGGED BLOCK }}} -package RT::Interface::Email::Auth::GnuPG; +package RT::Interface::Email::Auth::Crypt; use strict; use warnings; -=head2 GetCurrentUser +=head1 NAME + +RT::Interface::Email::Auth::Crypt - decrypting and verifying protected emails + +=head2 DESCRIPTION + +This mail plugin decrypts and verifies incoming emails. Supported +encryption protocols are GnuPG and SMIME. + +This code is independant from code that encrypts/sign outgoing emails, so +it's possible to decrypt data without bringing in encryption. To enable +it put the module in the mail plugins list: + + Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filters...); + +C<Auth::Crypt> will not function without C<Auth::MailFrom> listed before +it. + +=head3 GnuPG To use the gnupg-secured mail gateway, you need to do the following: @@ -59,48 +77,85 @@ Set up a GnuPG key directory with a pubring containing only the keys you care about and specify the following in your SiteConfig.pm Set(%GnuPGOptions, homedir => '/opt/rt4/var/data/GnuPG'); - Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...); + +Read also: L<RT::Crypt> and L<RT::Crypt::GnuPG>. + +=head3 SMIME + +To use the SMIME-secured mail gateway, you need to do the following: + +Set up a SMIME key directory with files containing keys for queues' +addresses and specify the following in your SiteConfig.pm + + 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', + }, + ); + +Read also: L<RT::Crypt> and L<RT::Crypt::SMIME>. =cut sub ApplyBeforeDecode { return 1 } -use RT::Crypt::GnuPG; +use RT::Crypt; use RT::EmailParser (); sub GetCurrentUser { my %args = ( Message => undef, RawMessageRef => undef, + Queue => undef, + Actions => undef, @_ ); - foreach my $p ( $args{'Message'}->parts_DFS ) { - $p->head->delete($_) for qw( - X-RT-GnuPG-Status X-RT-Incoming-Encryption + # we clean all possible headers + my @headers = + qw( + X-RT-Incoming-Encryption X-RT-Incoming-Signature X-RT-Privacy X-RT-Sign X-RT-Encrypt - ); + ), + map "X-RT-$_-Status", RT::Crypt->Protocols; + foreach my $p ( $args{'Message'}->parts_DFS ) { + $p->head->delete($_) for @headers; } - my $msg = $args{'Message'}->dup; - - my ($status, @res) = VerifyDecrypt( - Entity => $args{'Message'}, AddStatus => 1, + my (@res) = RT::Crypt->VerifyDecrypt( + %args, + Entity => $args{'Message'}, ); - if ( $status && !@res ) { - $args{'Message'}->head->replace( - 'X-RT-Incoming-Encryption' => 'Not encrypted' - ); - + if ( !@res ) { + if (RT->Config->Get('Crypt')->{'RejectOnUnencrypted'}) { + EmailErrorToSender( + %args, + Template => 'Error: unencrypted message', + Arguments => { Message => $args{'Message'} }, + ); + return (-1, 'rejected because the message is unencrypted with RejectOnUnencrypted enabled'); + } + else { + $args{'Message'}->head->replace( + 'X-RT-Incoming-Encryption' => 'Not encrypted' + ); + } return 1; } - # FIXME: Check if the message is encrypted to the address of - # _this_ queue. send rejecting mail otherwise. - - unless ( $status ) { - $RT::Logger->error("Had a problem during decrypting and verifying"); + if ( grep {$_->{'exit_code'}} @res ) { + my @fail = grep {$_->{status}{Status} ne "DONE"} + map { my %ret = %{$_}; map {+{%ret, status => $_}} RT::Crypt->ParseStatus( Protocol => $_->{Protocol}, Status => $_->{status})} + @res; + for my $fail ( @fail ) { + $RT::Logger->warning("Failure during ".$fail->{Protocol}." ". lc($fail->{status}{Operation}) . ": ". $fail->{status}{Message}); + } my $reject = HandleErrors( Message => $args{'Message'}, Result => \@res ); return (0, 'rejected because of problems during decrypting and verifying') if $reject; @@ -113,14 +168,19 @@ sub GetCurrentUser { Data => ${ $args{'RawMessageRef'} }, ); - $args{'Message'}->head->replace( 'X-RT-Privacy' => 'PGP' ); - + my @found; + my @check_protocols = RT::Crypt->EnabledOnIncoming; foreach my $part ( $args{'Message'}->parts_DFS ) { my $decrypted; - my $status = Encode::decode( "UTF-8", $part->head->get( 'X-RT-GnuPG-Status' ) ); - if ( $status ) { - for ( RT::Crypt::GnuPG::ParseStatus( $status ) ) { + foreach my $protocol ( @check_protocols ) { + my @status = grep defined && length, + map Encode::decode( "UTF-8", $_), $part->head->get( "X-RT-$protocol-Status" ); + next unless @status; + + push @found, $protocol; + + for ( map RT::Crypt->ParseStatus( Protocol => $protocol, Status => "$_" ), @status ) { if ( $_->{Operation} eq 'Decrypt' && $_->{Status} eq 'DONE' ) { $decrypted = 1; } @@ -133,11 +193,15 @@ sub GetCurrentUser { } $part->head->replace( - 'X-RT-Incoming-Encryption' => + 'X-RT-Incoming-Encryption' => $decrypted ? 'Success' : 'Not encrypted' ); } + my %seen; + $args{'Message'}->head->replace( 'X-RT-Privacy' => Encode::encode( "UTF-8", $_ ) ) + foreach grep !$seen{$_}++, @found; + return 1; } @@ -152,17 +216,17 @@ sub HandleErrors { my %sent_once = (); foreach my $run ( @{ $args{'Result'} } ) { - my @status = RT::Crypt::GnuPG::ParseStatus( $run->{'status'} ); + my @status = RT::Crypt->ParseStatus( Protocol => $run->{'Protocol'}, Status => $run->{'status'} ); unless ( $sent_once{'NoPrivateKey'} ) { unless ( CheckNoPrivateKey( Message => $args{'Message'}, Status => \@status ) ) { $sent_once{'NoPrivateKey'}++; - $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnMissingPrivateKey'}; + $reject = 1 if RT->Config->Get('Crypt')->{'RejectOnMissingPrivateKey'}; } } unless ( $sent_once{'BadData'} ) { unless ( CheckBadData( Message => $args{'Message'}, Status => \@status ) ) { $sent_once{'BadData'}++; - $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnBadData'}; + $reject = 1 if RT->Config->Get('Crypt')->{'RejectOnBadData'}; } } } @@ -184,20 +248,11 @@ sub CheckNoPrivateKey { $RT::Logger->error("Couldn't decrypt a message: have no private key"); - my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0]; - my ($status) = RT::Interface::Email::SendEmailUsingTemplate( - To => $address, + return EmailErrorToSender( + %args, Template => 'Error: no private key', - Arguments => { - Message => $args{'Message'}, - TicketObj => $args{'Ticket'}, - }, - InReplyTo => $args{'Message'}, + Arguments => { Message => $args{'Message'} }, ); - unless ( $status ) { - $RT::Logger->error("Couldn't send 'Error: no private key'"); - } - return 0; } sub CheckBadData { @@ -208,50 +263,32 @@ sub CheckBadData { @{ $args{'Status'} }; return 1 unless @bad_data_messages; - $RT::Logger->error("Couldn't process a message: ". join ', ', @bad_data_messages ); + return EmailErrorToSender( + %args, + Template => 'Error: bad encrypted data', + Arguments => { Messages => [ @bad_data_messages ] }, + ); +} + +sub EmailErrorToSender { + my %args = (@_); + + $args{'Arguments'} ||= {}; + $args{'Arguments'}{'TicketObj'} ||= $args{'Ticket'}; my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0]; my ($status) = RT::Interface::Email::SendEmailUsingTemplate( To => $address, - Template => 'Error: bad GnuPG data', - Arguments => { - Messages => [ @bad_data_messages ], - TicketObj => $args{'Ticket'}, - }, + Template => $args{'Template'}, + Arguments => $args{'Arguments'}, InReplyTo => $args{'Message'}, ); unless ( $status ) { - $RT::Logger->error("Couldn't send 'Error: bad GnuPG data'"); + $RT::Logger->error("Couldn't send '$args{'Template'}''"); } return 0; } -sub VerifyDecrypt { - my %args = ( - Entity => undef, - @_ - ); - - my @res = RT::Crypt::GnuPG::VerifyDecrypt( %args ); - unless ( @res ) { - $RT::Logger->debug("No more encrypted/signed parts"); - return 1; - } - - $RT::Logger->debug('Found GnuPG protected parts'); - - # return on any error - if ( grep $_->{'exit_code'}, @res ) { - $RT::Logger->debug("Error during verify/decrypt operation"); - return (0, @res); - } - - # nesting - my ($status, @nested) = VerifyDecrypt( %args ); - return $status, @res, @nested; -} - RT::Base->_ImportOverlays(); 1; - diff --git a/rt/lib/RT/Interface/REST.pm b/rt/lib/RT/Interface/REST.pm index edfc5d3..b6f9fd3 100644 --- a/rt/lib/RT/Interface/REST.pm +++ b/rt/lib/RT/Interface/REST.pm @@ -283,17 +283,52 @@ sub vpush { # "Normalise" a hash key that's known to be multi-valued. sub vsplit { - my ($val) = @_; + my ($val, $strip) = @_; my @words; - - foreach my $line (map {split /\n/} (ref $val eq 'ARRAY') ? @$val : ($val||'')) - { - # XXX: This should become a real parser, ? la Text::ParseWords. - $line =~ s/^\s+//; - $line =~ s/\s+$//; - push @words, split /\s*,\s*/, $line; + my @values = map {split /\n/} (ref $val eq 'ARRAY' ? @$val : $val); + + foreach my $line (@values) { + while ($line =~ /\S/) { + $line =~ s/^ + \s* # Trim leading whitespace + (?: + (") # Quoted string + ((?>[^\\"]*(?:\\.[^\\"]*)*))" + | + (') # Single-quoted string + ((?>[^\\']*(?:\\.[^\\']*)*))' + | + q\{(.*?)\} # A perl-ish q{} string; this does + # no paren balancing, however, and + # only exists for back-compat + | + (.*?) # Anything else, until the next comma + ) + \s* # Trim trailing whitespace + (?: + \Z # Finish at end-of-line + | + , # Or a comma + ) + //xs or last; # There should be no way this match + # fails, but add a failsafe to + # prevent infinite-looping if it + # somehow does. + my ($quote, $quoted) = ($1 ? ($1, $2) : $3 ? ($3, $4) : ('', $5 || $6)); + # Only unquote the quote character, or the backslash -- and + # only if we were originally quoted.. + if ($5) { + $quoted =~ s/([\\'])/\\$1/g; + $quote = "'"; + } + if ($strip) { + $quoted =~ s/\\([\\$quote])/$1/g if $quote; + push @words, $quoted; + } else { + push @words, "$quote$quoted$quote"; + } + } } - return \@words; } @@ -324,11 +359,17 @@ sub process_attachments { } my $info = $cgi->uploadInfo($fh); + # If Content-ID exists for attachment then we need multipart/related + # to be able to refer to this Content-Id in core of mime message + if($info->{'Content-ID'}) { + $entity->head->set('Content-Type', 'multipart/related'); + } my $new_entity = $entity->attach( Path => $tmp_fn, Type => $info->{'Content-Type'} || guess_media_type($tmp_fn), Filename => $file, Disposition => $info->{'Content-Disposition'} || "attachment", + 'Content-ID' => $info->{'Content-ID'}, ); $new_entity->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh; $i++; diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm index 4cf3a07..dad6a8e 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -70,6 +70,7 @@ use RT::Interface::Web::Session; use Digest::MD5 (); use List::MoreUtils qw(); use JSON qw(); +use Plack::Util; =head2 SquishedCSS $style @@ -99,6 +100,37 @@ sub SquishedJS { return $js; } +=head2 JSFiles + +=cut + +sub JSFiles { + return qw{ + jquery-1.9.1.min.js + jquery_noconflict.js + jquery-ui-1.10.0.custom.min.js + jquery-ui-timepicker-addon.js + jquery-ui-patch-datepicker.js + jquery.modal.min.js + jquery.modal-defaults.js + jquery.cookie.js + titlebox-state.js + i18n.js + util.js + autocomplete.js + jquery.event.hover-1.0.js + superfish.js + supersubs.js + jquery.supposition.js + history-folding.js + cascaded.js + forms.js + event-registration.js + late.js + /static/RichText/ckeditor.js + }, RT->Config->Get('JSFiles'); +} + =head2 ClearSquished Removes the cached CSS and JS entries, forcing them to be regenerated @@ -111,13 +143,13 @@ sub ClearSquished { %SQUISHED_CSS = (); } -=head2 EscapeUTF8 SCALARREF +=head2 EscapeHTML SCALARREF does a css-busting but minimalist escaping of whatever html you're passing in. =cut -sub EscapeUTF8 { +sub EscapeHTML { my $ref = shift; return unless defined $$ref; @@ -130,7 +162,15 @@ sub EscapeUTF8 { $$ref =~ s/'/'/g; } - +# Back-compat +# XXX: Remove in 4.4 +sub EscapeUTF8 { + RT->Deprecated( + Instead => "EscapeHTML", + Remove => "4.4", + ); + EscapeHTML(@_); +} =head2 EscapeURI SCALARREF @@ -148,13 +188,15 @@ sub EscapeURI { =head2 EncodeJSON SCALAR -Encodes the SCALAR to JSON and returns a JSON string. SCALAR may be a simple -value or a reference. +Encodes the SCALAR to JSON and returns a JSON Unicode (B<not> UTF-8) string. +SCALAR may be a simple value or a reference. =cut sub EncodeJSON { - JSON::to_json(shift, { utf8 => 1, allow_nonref => 1 }); + my $s = JSON::to_json(shift, { allow_nonref => 1 }); + $s =~ s{/}{\\/}g; + return $s; } sub _encode_surrogates { @@ -190,36 +232,29 @@ sub WebCanonicalizeInfo { -=head2 WebExternalAutoInfo($user); +=head2 WebRemoteUserAutocreateInfo($user); -Returns a hash of user attributes, used when WebExternalAuto is set. +Returns a hash of user attributes, used when WebRemoteUserAutocreate is set. =cut -sub WebExternalAutoInfo { +sub WebRemoteUserAutocreateInfo { my $user = shift; my %user_info; # default to making Privileged users, even if they specify # some other default Attributes - if ( !$RT::AutoCreate - || ( ref($RT::AutoCreate) && not exists $RT::AutoCreate->{Privileged} ) ) + if ( !$RT::UserAutocreateDefaultsOnLogin + || ( ref($RT::UserAutocreateDefaultsOnLogin) && not exists $RT::UserAutocreateDefaultsOnLogin->{Privileged} ) ) { $user_info{'Privileged'} = 1; } - if ( $^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/ ) { - - # Populate fields with information from Unix /etc/passwd - - my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ]; - $user_info{'Comments'} = $comments if defined $comments; - $user_info{'RealName'} = $realname if defined $realname; - } elsif ( $^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1' ) { - - # Populate fields with information from NT domain controller - } + # Populate fields with information from Unix /etc/passwd + my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ]; + $user_info{'Comments'} = $comments if defined $comments; + $user_info{'RealName'} = $realname if defined $realname; # and return the wad of stuff return {%user_info}; @@ -278,7 +313,7 @@ sub HandleRequest { MaybeShowNoAuthPage($ARGS); - AttemptExternalAuth($ARGS) if RT->Config->Get('WebExternalAuthContinuous') or not _UserLoggedIn(); + AttemptExternalAuth($ARGS) if RT->Config->Get('WebRemoteUserContinuous') or not _UserLoggedIn(); _ForceLogout() unless _UserLoggedIn(); @@ -300,7 +335,7 @@ sub HandleRequest { # REST urls get a special 401 response if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) { - $HTML::Mason::Commands::r->content_type("text/plain"); + $HTML::Mason::Commands::r->content_type("text/plain; charset=utf-8"); $m->error_format("text"); $m->out("RT/$RT::VERSION 401 Credentials required\n"); $m->out("\n$msg\n") if $msg; @@ -441,6 +476,18 @@ params. =cut sub TangentForLogin { + my $login = TangentForLoginURL(@_); + Redirect( RT->Config->Get('WebBaseURL') . $login ); +} + +=head2 TangentForLoginURL [HASH] + +Returns a URL suitable for tangenting for login. Optionally takes a hash which +is dumped into query params. + +=cut + +sub TangentForLoginURL { my $ARGS = shift; my $hash = SetNextPage($ARGS); my %query = (@_, next => $hash); @@ -448,9 +495,9 @@ sub TangentForLogin { $query{mobile} = 1 if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)}; - my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?'; + my $login = RT->Config->Get('WebPath') . '/NoAuth/Login.html?'; $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query); - Redirect($login); + return $login; } =head2 TangentForLoginWithError ERROR @@ -645,24 +692,24 @@ sub ShowRequestedPage { sub AttemptExternalAuth { my $ARGS = shift; - return unless ( RT->Config->Get('WebExternalAuth') ); + return unless ( RT->Config->Get('WebRemoteUserAuth') ); my $user = $ARGS->{user}; my $m = $HTML::Mason::Commands::m; - # If RT is configured for external auth, let's go through and get REMOTE_USER + my $logged_in_external_user = _UserLoggedIn() && $HTML::Mason::Commands::session{'WebExternallyAuthed'}; - # do we actually have a REMOTE_USER equivlent? - if ( RT::Interface::Web::WebCanonicalizeInfo() ) { - my $orig_user = $user; + # If RT is configured for external auth, let's go through and get REMOTE_USER + # Do we actually have a REMOTE_USER or equivalent? We only check auth if + # 1) we have no logged in user, or 2) we have a user who is externally + # authed. If we have a logged in user who is internally authed, don't + # check remote user otherwise we may log them out. + if (RT::Interface::Web::WebCanonicalizeInfo() + and (not _UserLoggedIn() or $logged_in_external_user) ) + { $user = RT::Interface::Web::WebCanonicalizeInfo(); - my $load_method = RT->Config->Get('WebExternalGecos') ? 'LoadByGecos' : 'Load'; - - if ( $^O eq 'MSWin32' and RT->Config->Get('WebExternalGecos') ) { - my $NodeName = Win32::NodeName(); - $user =~ s/^\Q$NodeName\E\\//i; - } + my $load_method = RT->Config->Get('WebRemoteUserGecos') ? 'LoadByGecos' : 'Load'; my $next = RemoveNextPage($ARGS->{'next'}); $next = $next->{'url'} if ref $next; @@ -670,12 +717,12 @@ sub AttemptExternalAuth { $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new(); $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user); - if ( RT->Config->Get('WebExternalAuto') and not _UserLoggedIn() ) { + if ( RT->Config->Get('WebRemoteUserAutocreate') and not _UserLoggedIn() ) { # Create users on-the-fly my $UserObj = RT::User->new(RT->SystemUser); my ( $val, $msg ) = $UserObj->Create( - %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} }, + %{ ref RT->Config->Get('UserAutocreateDefaultsOnLogin') ? RT->Config->Get('UserAutocreateDefaultsOnLogin') : {} }, Name => $user, Gecos => $user, ); @@ -683,10 +730,10 @@ sub AttemptExternalAuth { if ($val) { # now get user specific information, to better create our user. - my $new_user_info = RT::Interface::Web::WebExternalAutoInfo($user); + my $new_user_info = RT::Interface::Web::WebRemoteUserAutocreateInfo($user); # set the attributes that have been defined. - foreach my $attribute ( $UserObj->WritableAttributes ) { + foreach my $attribute ( $UserObj->WritableAttributes, qw(Privileged Disabled) ) { $m->callback( Attribute => $attribute, User => $user, @@ -699,19 +746,13 @@ sub AttemptExternalAuth { } $HTML::Mason::Commands::session{'CurrentUser'}->Load($user); } else { - - # we failed to successfully create the user. abort abort abort. - delete $HTML::Mason::Commands::session{'CurrentUser'}; - - if (RT->Config->Get('WebFallbackToInternalAuth')) { - TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg); - } else { - $m->abort(); - } + RT->Logger->error("Couldn't auto-create user '$user' when attempting WebRemoteUser: $msg"); + AbortExternalAuth( Error => "UserAutocreateDefaultsOnLogin" ); } } if ( _UserLoggedIn() ) { + $HTML::Mason::Commands::session{'WebExternallyAuthed'} = 1; $m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' ); # It is possible that we did a redirect to the login page, # if the external auth allows lack of auth through with no @@ -723,28 +764,45 @@ sub AttemptExternalAuth { # straight-up external auth would always redirect to / # when you first hit it. } else { - delete $HTML::Mason::Commands::session{'CurrentUser'}; - $user = $orig_user; - - unless ( RT->Config->Get('WebFallbackToInternalAuth') ) { - TangentForLoginWithError($ARGS, 'You are not an authorized user'); - } - } - } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) { - unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) { - # XXX unreachable due to prior defaulting in HandleRequest (check c34d108) - TangentForLoginWithError($ARGS, 'You are not an authorized user'); + # Couldn't auth with the REMOTE_USER provided because an RT + # user doesn't exist and we're configured not to create one. + RT->Logger->error("Couldn't find internal user for '$user' when attempting WebRemoteUser and RT is not configured for auto-creation. Refer to `perldoc $RT::BasePath/docs/authentication.pod` if you want to allow auto-creation."); + AbortExternalAuth( + Error => "NoInternalUser", + User => $user, + ); } - } else { - - # WebExternalAuth is set, but we don't have a REMOTE_USER. abort - # XXX: we must return AUTH_REQUIRED status or we fallback to - # internal auth here too. - delete $HTML::Mason::Commands::session{'CurrentUser'} - if defined $HTML::Mason::Commands::session{'CurrentUser'}; + } + elsif ($logged_in_external_user) { + # The logged in external user was deauthed by the auth system and we + # should kick them out. + AbortExternalAuth( Error => "Deauthorized" ); + } + elsif (not RT->Config->Get('WebFallbackToRTLogin')) { + # Abort if we don't want to fallback internally + AbortExternalAuth( Error => "NoRemoteUser" ); } } +sub AbortExternalAuth { + my %args = @_; + my $error = $args{Error} ? "/Errors/WebRemoteUser/$args{Error}" : undef; + my $m = $HTML::Mason::Commands::m; + my $r = $HTML::Mason::Commands::r; + + _ForceLogout(); + + # Clear the decks, not that we should have partial content. + $m->clear_buffer; + + $r->status(403); + $m->comp($error, %args) + if $error and $m->comp_exists($error); + + # Return a 403 Forbidden or we may fallback to a login page with no form + $m->abort(403); +} + sub AttemptPasswordAuthentication { my $ARGS = shift; return unless defined $ARGS->{user} && defined $ARGS->{pass}; @@ -770,7 +828,7 @@ sub AttemptPasswordAuthentication { InstantiateNewSession(); $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj; - $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' ); + $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler', RedirectTo => \$next ); # Really the only time we don't want to redirect here is if we were # passed user and pass as query params in the URL. @@ -838,6 +896,30 @@ sub SendSessionCookie { $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string; } +=head2 GetWebURLFromRequest + +People may use different web urls instead of C<$WebURL> in config. +Return the web url current user is using. + +=cut + +sub GetWebURLFromRequest { + + my $uri = URI->new( RT->Config->Get('WebURL') ); + + if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) { + $uri->scheme('https'); + } + else { + $uri->scheme('http'); + } + + # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST + $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} ); + $uri->port( $ENV{'SERVER_PORT'} ); + return "$uri"; # stringify to be consistent with WebURL in config +} + =head2 Redirect URL This routine ells the current user's browser to redirect to URL. @@ -868,15 +950,10 @@ sub Redirect { && $uri->host eq $server_uri->host && $uri->port eq $server_uri->port ) { - if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) { - $uri->scheme('https'); - } else { - $uri->scheme('http'); - } - - # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST - $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'}); - $uri->port( $ENV{'SERVER_PORT'} ); + my $env_uri = URI->new(GetWebURLFromRequest()); + $uri->scheme($env_uri->scheme); + $uri->host($env_uri->host); + $uri->port($env_uri->port); } # not sure why, but on some systems without this call mason doesn't @@ -890,13 +967,13 @@ sub Redirect { $HTML::Mason::Commands::m->abort; } -=head2 CacheControlExpiresHeaders +=head2 GetStaticHeaders -set both Cache-Control and Expires http headers +return an arrayref of Headers (currently, Cache-Control and Expires). =cut -sub CacheControlExpiresHeaders { +sub GetStaticHeaders { my %args = @_; my $Visibility = 'private'; @@ -913,13 +990,28 @@ sub CacheControlExpiresHeaders { ? sprintf "max-age=%d, %s", $args{Time}, $Visibility : 'no-cache' ; - $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = $CacheControl; my $expires = RT::Date->new(RT->SystemUser); $expires->SetToNow; $expires->AddSeconds( $args{Time} ) if $args{Time}; - $HTML::Mason::Commands::r->headers_out->{'Expires'} = $expires->RFC2616; + return [ + Expires => $expires->RFC2616, + 'Cache-Control' => $CacheControl, + ]; +} + +=head2 CacheControlExpiresHeaders + +set both Cache-Control and Expires http headers + +=cut + +sub CacheControlExpiresHeaders { + Plack::Util::header_iter( GetStaticHeaders(@_), sub { + my ( $key, $val ) = @_; + $HTML::Mason::Commands::r->headers_out->{$key} = $val; + } ); } =head2 StaticFileHeaders @@ -932,20 +1024,12 @@ This routine could really use _accurate_ heuristics. (XXX TODO) =cut sub StaticFileHeaders { - my $date = RT::Date->new(RT->SystemUser); - # remove any cookie headers -- if it is cached publicly, it # shouldn't include anyone's cookie! delete $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'}; # Expire things in a month. CacheControlExpiresHeaders( Time => 'forever' ); - - # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since' - # request, but we don't handle it and generate full reply again - # Last modified at server start time - # $date->Set( Value => $^T ); - # $HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = $date->RFC2616; } =head2 ComponentPathIsSafe PATH @@ -1109,7 +1193,7 @@ sub StripContent { # Check for plaintext sig return '' if not $html and $content =~ /^(--)?\Q$sig\E$/; - # Check for html-formatted sig; we don't use EscapeUTF8 here + # Check for html-formatted sig; we don't use EscapeHTML here # because we want to precisely match the escapting that FCKEditor # uses. $sig =~ s/&/&/g; @@ -1270,6 +1354,16 @@ sub ComponentRoots { return @roots; } +sub StaticRoots { + my $self = shift; + my @static = ( + $RT::LocalStaticPath, + (map { $_->StaticDir } @{RT->Plugins}), + $RT::StaticPath, + ); + return grep { $_ and -d $_ } @static; +} + our %is_whitelisted_component = ( # The RSS feed embeds an auth token in the path, but query # information for the search. Because it's a straight-up read, in @@ -1284,6 +1378,7 @@ our %is_whitelisted_component = ( '/Search/Simple.html' => 1, '/m/tickets/search' => 1, '/Search/Chart.html' => 1, + '/User/Search.html' => 1, # This page takes Attachment and Transaction argument to figure # out what to show, but it's read only and will deny information if you @@ -1466,7 +1561,7 @@ sub ExpandCSRFToken { if ($data->{attach}) { my $filename = $data->{attach}{filename}; my $mime = $data->{attach}{mime}; - $HTML::Mason::Commands::session{'Attachments'}{$filename} + $HTML::Mason::Commands::session{'Attachments'}{$ARGS->{'Token'}||''}{$filename} = $mime; } @@ -1550,10 +1645,178 @@ sub PotentialPageAction { return ""; } +=head2 RewriteInlineImages PARAMHASH + +Turns C<< <img src="cid:..."> >> elements in HTML into working images pointing +back to RT's stored copy. + +Takes the following parameters: + +=over 4 + +=item Content + +Scalar ref of the HTML content to rewrite. Modified in place to support the +most common use-case. + +=item Attachment + +The L<RT::Attachment> object from which the Content originates. + +=item Related (optional) + +Array ref of related L<RT::Attachment> objects to use for C<Content-ID> matching. + +Defaults to the result of the C<Siblings> method on the passed Attachment. + +=item AttachmentPath (optional) + +The base path to use when rewriting C<src> attributes. + +Defaults to C< $WebPath/Ticket/Attachment > + +=back + +In scalar context, returns the number of elements rewritten. + +In list content, returns the attachments IDs referred to by the rewritten <img> +elements, in the order found. There may be duplicates. + +=cut + +sub RewriteInlineImages { + my %args = ( + Content => undef, + Attachment => undef, + Related => undef, + AttachmentPath => RT->Config->Get('WebPath')."/Ticket/Attachment", + @_ + ); + + return unless defined $args{Content} + and ref $args{Content} eq 'SCALAR' + and defined $args{Attachment}; + + my $related_part = $args{Attachment}->Closest("multipart/related") + or return; + + $args{Related} ||= $related_part->Children->ItemsArrayRef; + return unless @{$args{Related}}; + + my $content = $args{'Content'}; + my @rewritten; + + require HTML::RewriteAttributes::Resources; + $$content = HTML::RewriteAttributes::Resources->rewrite($$content, sub { + my $cid = shift; + my %meta = @_; + return $cid unless lc $meta{tag} eq 'img' + and lc $meta{attr} eq 'src' + and $cid =~ s/^cid://i; + + for my $attach (@{$args{Related}}) { + if (($attach->GetHeader('Content-ID') || '') =~ /^(<)?\Q$cid\E(?(1)>)$/) { + push @rewritten, $attach->Id; + return "$args{AttachmentPath}/" . $attach->TransactionId . '/' . $attach->Id; + } + } + + # No attachments means this is a bogus CID. Just pass it through. + RT->Logger->debug(qq[Found bogus inline image src="cid:$cid"]); + return "cid:$cid"; + }); + return @rewritten; +} + +=head2 GetCustomFieldInputName(CustomField => $cf_object, Object => $object, Grouping => $grouping_name) + +Returns the standard custom field input name; this is complementary to +L</_ParseObjectCustomFieldArgs>. Takes the following arguments: + +=over + +=item CustomField => I<L<RT::CustomField> object> + +Required. + +=item Object => I<object> + +The object that the custom field is applied to; optional. If omitted, +defaults to a new object of the appropriate class for the custom field. + +=item Grouping => I<CF grouping> + +The grouping that the custom field is being rendered in. Groupings +allow a custom field to appear in more than one location per form. + +=back + +=cut + +sub GetCustomFieldInputName { + my %args = ( + CustomField => undef, + Object => undef, + Grouping => undef, + @_, + ); + + my $name = GetCustomFieldInputNamePrefix(%args); + + if ( $args{CustomField}->Type eq 'Select' ) { + if ( $args{CustomField}->RenderType eq 'List' and $args{CustomField}->SingleValue ) { + $name .= 'Value'; + } + else { + $name .= 'Values'; + } + } + elsif ( $args{CustomField}->Type =~ /^(?:Binary|Image)$/ ) { + $name .= 'Upload'; + } + elsif ( $args{CustomField}->Type =~ /^(?:Date|DateTime|Text|Wikitext)$/ ) { + $name .= 'Values'; + } + else { + if ( $args{CustomField}->SingleValue ) { + $name .= 'Value'; + } + else { + $name .= 'Values'; + } + } + + return $name; +} + +=head2 GetCustomFieldInputNamePrefix(CustomField => $cf_object, Object => $object, Grouping => $grouping_name) + +Returns the standard custom field input name prefix(without "Value" or alike suffix) + +=cut + +sub GetCustomFieldInputNamePrefix { + my %args = ( + CustomField => undef, + Object => undef, + Grouping => undef, + @_, + ); + + my $prefix = join '-', 'Object', ref( $args{Object} ) || $args{CustomField}->ObjectTypeFromLookupType, + ( $args{Object} && $args{Object}->id ? $args{Object}->id : '' ), + 'CustomField' . ( $args{Grouping} ? ":$args{Grouping}" : '' ), + $args{CustomField}->id, ''; + + return $prefix; +} + package HTML::Mason::Commands; use vars qw/$r $m %session/; +use Scalar::Util qw(blessed); + sub Menu { return $HTML::Mason::Commands::m->notes('menu'); } @@ -1566,7 +1829,96 @@ sub PageWidgets { return $HTML::Mason::Commands::m->notes('page-widgets'); } +sub RenderMenu { + my %args = (toplevel => 1, parent_id => '', depth => 0, @_); + return unless $args{'menu'}; + + my ($menu, $depth, $toplevel, $id, $parent_id) + = @args{qw(menu depth toplevel id parent_id)}; + + my $interp = $m->interp; + my $web_path = RT->Config->Get('WebPath'); + + my $res = ''; + $res .= ' ' x $depth; + $res .= '<ul'; + $res .= ' id="'. $interp->apply_escapes($id, 'h') .'"' + if $id; + $res .= ' class="toplevel"' if $toplevel; + $res .= ">\n"; + + for my $child ($menu->children) { + $res .= ' 'x ($depth+1); + + my $item_id = lc(($parent_id? "$parent_id-" : "") .$child->key); + $item_id =~ s/\s/-/g; + my $eitem_id = $interp->apply_escapes($item_id, 'h'); + $res .= qq{<li id="li-$eitem_id"}; + + my @classes; + push @classes, 'has-children' if $child->has_children; + push @classes, 'active' if $child->active; + $res .= ' class="'. join( ' ', @classes ) .'"' + if @classes; + + $res .= '>'; + + if ( my $tmp = $child->raw_html ) { + $res .= $tmp; + } else { + $res .= qq{<a id="$eitem_id" class="menu-item}; + if ( $tmp = $child->class ) { + $res .= ' '. $interp->apply_escapes($tmp, 'h'); + } + $res .= '"'; + + my $path = $child->path; + my $url = (not $path or $path =~ m{^\w+:/}) ? $path : $web_path . $path; + $url ||= "#"; + $res .= ' href="'. $interp->apply_escapes($url, 'h') .'"'; + + if ( $tmp = $child->target ) { + $res .= ' target="'. $interp->apply_escapes($tmp, 'h') .'"' + } + + if ($child->attributes) { + for my $key (keys %{$child->attributes}) { + my ($name, $value) = map { $interp->apply_escapes($_, 'h') } + $key, $child->attributes->{$key}; + $res .= " $name=\"$value\""; + } + } + $res .= '>'; + + if ( $child->escape_title ) { + $res .= $interp->apply_escapes($child->title, 'h'); + } else { + $res .= $child->title; + } + $res .= '</a>'; + } + + if ( $child->has_children ) { + $res .= "\n"; + $res .= RenderMenu( + menu => $child, + toplevel => 0, + parent_id => $item_id, + depth => $depth+1, + return => 1, + ); + $res .= "\n"; + $res .= ' ' x ($depth+1); + } + $res .= "</li>\n"; + } + $res .= ' ' x $depth; + $res .= '</ul>'; + return $res if $args{'return'}; + $m->print($res); + return ''; +} =head2 loc ARRAY @@ -1725,9 +2077,10 @@ sub CreateTicket { my (@Actions); - my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); + my $current_user = $session{'CurrentUser'}; + my $Ticket = RT::Ticket->new( $current_user ); - my $Queue = RT::Queue->new( $session{'CurrentUser'} ); + my $Queue = RT::Queue->new( $current_user ); unless ( $Queue->Load( $ARGS{'Queue'} ) ) { Abort('Queue not found'); } @@ -1738,12 +2091,12 @@ sub CreateTicket { my $due; if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) { - $due = RT::Date->new( $session{'CurrentUser'} ); + $due = RT::Date->new( $current_user ); $due->Set( Format => 'unknown', Value => $ARGS{'Due'} ); } my $starts; if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) { - $starts = RT::Date->new( $session{'CurrentUser'} ); + $starts = RT::Date->new( $current_user ); $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} ); } @@ -1751,34 +2104,44 @@ sub CreateTicket { Content => $ARGS{Content}, ContentType => $ARGS{ContentType}, StripSignature => 1, - CurrentUser => $session{'CurrentUser'}, + CurrentUser => $current_user, ); + my $date_now = RT::Date->new( $current_user ); + $date_now->SetToNow; my $MIMEObj = MakeMIMEEntity( Subject => $ARGS{'Subject'}, - From => $ARGS{'From'}, + From => $ARGS{'From'} || $current_user->EmailAddress, + To => $ARGS{'To'} || $Queue->CorrespondAddress + || RT->Config->Get('CorrespondAddress'), Cc => $ARGS{'Cc'}, + Date => $date_now->RFC2822(Timezone => 'user'), Body => $sigless, Type => $ARGS{'ContentType'}, Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', ); - if ( $ARGS{'Attachments'} ) { - my $rv = $MIMEObj->make_multipart; - $RT::Logger->error("Couldn't make multipart message") - if !$rv || $rv !~ /^(?:DONE|ALREADY)$/; + my @attachments; + if ( my $tmp = $session{'Attachments'}{ $ARGS{'Token'} || '' } ) { + push @attachments, grep $_, map $tmp->{$_}, sort keys %$tmp; - foreach ( map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} } ) { - unless ($_) { - $RT::Logger->error("Couldn't add empty attachemnt"); - next; - } - $MIMEObj->add_part($_); - } + delete $session{'Attachments'}{ $ARGS{'Token'} || '' } + unless $ARGS{'KeepAttachments'}; + $session{'Attachments'} = $session{'Attachments'} + if @attachments; + } + if ( $ARGS{'Attachments'} ) { + push @attachments, grep $_, map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} }; + } + if ( @attachments ) { + $MIMEObj->make_multipart; + $MIMEObj->add_part( $_ ) foreach @attachments; } for my $argument (qw(Encrypt Sign)) { - $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ); + if ( defined $ARGS{ $argument } ) { + $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ); + } } my %create_args = ( @@ -1799,16 +2162,25 @@ sub CreateTicket { Status => $ARGS{'Status'}, Due => $due ? $due->ISO : undef, Starts => $starts ? $starts->ISO : undef, - MIMEObj => $MIMEObj + MIMEObj => $MIMEObj, + SquelchMailTo => $ARGS{'SquelchMailTo'}, + TransSquelchMailTo => $ARGS{'TransSquelchMailTo'}, ); - my @txn_squelch; - foreach my $type (qw(Requestor Cc AdminCc)) { - push @txn_squelch, map $_->address, Email::Address->parse( $create_args{$type} ) - if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] }; + if ($ARGS{'DryRun'}) { + $create_args{DryRun} = 1; + $create_args{Owner} ||= $RT::Nobody->Id; + $create_args{Requestor} ||= $session{CurrentUser}->EmailAddress; + $create_args{Subject} ||= ''; + $create_args{Status} ||= $Queue->Lifecycle->DefaultOnCreate, + } else { + my @txn_squelch; + foreach my $type (qw(Requestor Cc AdminCc)) { + push @txn_squelch, map $_->address, Email::Address->parse( $create_args{$type} ) + if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] }; + } + push @{$create_args{TransSquelchMailTo}}, @txn_squelch; } - $create_args{TransSquelchMailTo} = \@txn_squelch - if @txn_squelch; if ( $ARGS{'AttachTickets'} ) { require RT::Action::SendEmail; @@ -1818,69 +2190,16 @@ sub CreateTicket { : ( $ARGS{'AttachTickets'} ) ); } - foreach my $arg ( keys %ARGS ) { - next if $arg =~ /-(?:Magic|Category)$/; - - if ( $arg =~ /^Object-RT::Transaction--CustomField-/ ) { - $create_args{$arg} = $ARGS{$arg}; - } - - # Object-RT::Ticket--CustomField-3-Values - elsif ( $arg =~ /^Object-RT::Ticket--CustomField-(\d+)/ ) { - my $cfid = $1; - - my $cf = RT::CustomField->new( $session{'CurrentUser'} ); - $cf->SetContextObject( $Queue ); - $cf->Load($cfid); - unless ( $cf->id ) { - $RT::Logger->error( "Couldn't load custom field #" . $cfid ); - next; - } - - if ( $arg =~ /-Upload$/ ) { - $create_args{"CustomField-$cfid"} = _UploadedFile($arg); - next; - } - - my $type = $cf->Type; - - my @values = (); - if ( ref $ARGS{$arg} eq 'ARRAY' ) { - @values = @{ $ARGS{$arg} }; - } elsif ( $type =~ /text/i ) { - @values = ( $ARGS{$arg} ); - } else { - no warnings 'uninitialized'; - @values = split /\r*\n/, $ARGS{$arg}; - } - @values = grep length, map { - s/\r+\n/\n/g; - s/^\s+//; - s/\s+$//; - $_; - } - grep defined, @values; - - $create_args{"CustomField-$cfid"} = \@values; - } - } - - # turn new link lists into arrays, and pass in the proper arguments - my %map = ( - 'new-DependsOn' => 'DependsOn', - 'DependsOn-new' => 'DependedOnBy', - 'new-MemberOf' => 'Parents', - 'MemberOf-new' => 'Children', - 'new-RefersTo' => 'RefersTo', - 'RefersTo-new' => 'ReferredToBy', + my %cfs = ProcessObjectCustomFieldUpdatesForCreate( + ARGSRef => \%ARGS, + ContextObject => $Queue, ); - foreach my $key ( keys %map ) { - next unless $ARGS{$key}; - $create_args{ $map{$key} } = [ grep $_, split ' ', $ARGS{$key} ]; - } + my %links = ProcessLinksForCreate( ARGSRef => \%ARGS ); + + my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args, %links, %cfs); + return $Trans if $ARGS{DryRun}; - my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args); unless ($id) { Abort($ErrMsg); } @@ -1948,10 +2267,18 @@ sub ProcessUpdateMessage { @_ ); - if ( $args{ARGSRef}->{'UpdateAttachments'} - && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } ) - { - delete $args{ARGSRef}->{'UpdateAttachments'}; + my @attachments; + if ( my $tmp = $session{'Attachments'}{ $args{'ARGSRef'}{'Token'} || '' } ) { + push @attachments, grep $_, map $tmp->{$_}, sort keys %$tmp; + + delete $session{'Attachments'}{ $args{'ARGSRef'}{'Token'} || '' } + unless $args{'KeepAttachments'}; + $session{'Attachments'} = $session{'Attachments'} + if @attachments; + } + if ( $args{ARGSRef}{'UpdateAttachments'} ) { + push @attachments, grep $_, map $args{ARGSRef}->{UpdateAttachments}{$_}, + sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} }; } # Strip the signature @@ -1973,7 +2300,7 @@ sub ProcessUpdateMessage { # If, after stripping the signature, we have no message, create a # Touch transaction if necessary - if ( not $args{ARGSRef}->{'UpdateAttachments'} + if ( not @attachments and not length $args{ARGSRef}->{'UpdateContent'} ) { #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) { @@ -1993,7 +2320,7 @@ sub ProcessUpdateMessage { return; } - if ( $args{ARGSRef}->{'UpdateSubject'} eq ($args{'TicketObj'}->Subject || '') ) { + if ( ($args{ARGSRef}->{'UpdateSubject'}||'') eq ($args{'TicketObj'}->Subject || '') ) { $args{ARGSRef}->{'UpdateSubject'} = undef; } @@ -2017,14 +2344,14 @@ sub ProcessUpdateMessage { if ( my $msg = $old_txn->Message->First ) { RT::Interface::Email::SetInReplyTo( Message => $Message, - InReplyTo => $msg + InReplyTo => $msg, + Ticket => $args{'TicketObj'}, ); } - if ( $args{ARGSRef}->{'UpdateAttachments'} ) { + if ( @attachments ) { $Message->make_multipart; - $Message->add_part($_) foreach map $args{ARGSRef}->{UpdateAttachments}{$_}, - sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} }; + $Message->add_part( $_ ) foreach @attachments; } if ( $args{ARGSRef}->{'AttachTickets'} ) { @@ -2036,8 +2363,8 @@ sub ProcessUpdateMessage { } my %message_args = ( - Sign => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ), - Encrypt => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ), + Sign => $args{ARGSRef}->{'Sign'}, + Encrypt => $args{ARGSRef}->{'Encrypt'}, MIMEObj => $Message, TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}, CustomFields => \%txn_customfields, @@ -2052,11 +2379,11 @@ sub ProcessUpdateMessage { if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) { my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args); push( @results, $Description ); - $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object; + $Object->UpdateCustomFields( %{ $args{ARGSRef} } ) if $Object; } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) { my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args); push( @results, $Description ); - $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object; + $Object->UpdateCustomFields( %{ $args{ARGSRef} } ) if $Object; } else { push( @results, loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") ); @@ -2115,36 +2442,39 @@ sub _ProcessUpdateMessageRecipients { sub ProcessAttachments { my %args = ( ARGSRef => {}, + Token => '', @_ ); - my $ARGSRef = $args{ARGSRef} || {}; + my $token = $args{'ARGSRef'}{'Token'} + ||= $args{'Token'} ||= Digest::MD5::md5_hex( rand(1024) ); + + my $update_session = 0; + # deal with deleting uploaded attachments - foreach my $key ( keys %$ARGSRef ) { - if ( $key =~ m/^DeleteAttach-(.+)$/ ) { - delete $session{'Attachments'}{$1}; - } - $session{'Attachments'} = { %{ $session{'Attachments'} || {} } }; + if ( my $del = $args{'ARGSRef'}{'DeleteAttach'} ) { + delete $session{'Attachments'}{ $token }{ $_ } + foreach ref $del? @$del : ($del); + + $update_session = 1; } # store the uploaded attachment in session - if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} ) - { # attachment? - my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' ); + my $new = $args{'ARGSRef'}{'Attach'}; + if ( defined $new && length $new ) { + my $attachment = MakeMIMEEntity( + AttachmentFieldName => 'Attach' + ); # This needs to be decoded because the value is a reference; # hence it was not decoded along with all of the standard # arguments in DecodeARGS - my $file_path = Encode::decode("UTF-8", "$ARGSRef->{'Attach'}"); - $session{'Attachments'} = - { %{ $session{'Attachments'} || {} }, $file_path => $attachment, }; - } + my $file_path = Encode::decode( "UTF-8", "$new"); + $session{'Attachments'}{ $token }{ $file_path } = $attachment; - # delete temporary storage entry to make WebUI clean - unless ( keys %{ $session{'Attachments'} } and $ARGSRef->{'UpdateAttach'} ) - { - delete $session{'Attachments'}; + $update_session = 1; } + $session{'Attachments'} = $session{'Attachments'} if $update_session; } @@ -2176,7 +2506,7 @@ sub MakeMIMEEntity { "Message-Id" => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId ), "X-RT-Interface" => $args{Interface}, map { $_ => Encode::encode( "UTF-8", $args{ $_} ) } - grep defined $args{$_}, qw(Subject From Cc) + grep defined $args{$_}, qw(Subject From Cc To Date) ); if ( defined $args{'Body'} && length $args{'Body'} ) { @@ -2213,7 +2543,7 @@ sub MakeMIMEEntity { Data => \@content, # Bytes, as read directly from the file, above ); if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) { - $Message->head->set( 'Subject' => Encode::encode( "UTF-8", $filename ) ); + $Message->head->replace( 'Subject' => Encode::encode( "UTF-8", $filename ) ); } # Attachment parts really shouldn't get a Message-ID or "interface" @@ -2277,7 +2607,7 @@ sub ProcessACLChanges { my $obj; if ( $object_type eq 'RT::System' ) { $obj = $RT::System; - } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) { + } elsif ( $object_type->DOES('RT::Record::Role::Rights') ) { $obj = $object_type->new( $session{'CurrentUser'} ); $obj->Load($object_id); unless ( $obj->id ) { @@ -2377,7 +2707,7 @@ sub ProcessACLs { my $obj; if ( $object_type eq 'RT::System' ) { $obj = $RT::System; - } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) { + } elsif ( $object_type->DOES('RT::Record::Role::Rights') ) { $obj = $object_type->new( $session{'CurrentUser'} ); $obj->Load($object_id); unless ( $obj->id ) { @@ -2627,38 +2957,69 @@ sub ProcessTicketReminders { if ( $args->{'update-reminders'} ) { while ( my $reminder = $reminder_collection->Next ) { - my $resolve_status = $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve; - if ( $reminder->Status ne $resolve_status && $args->{ 'Complete-Reminder-' . $reminder->id } ) { - my ($status, $msg) = $Ticket->Reminders->Resolve($reminder); - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); - + my $resolve_status = $reminder->LifecycleObj->ReminderStatusOnResolve; + my ( $status, $msg, $old_subject, @subresults ); + if ( $reminder->Status ne $resolve_status + && $args->{ 'Complete-Reminder-' . $reminder->id } ) + { + ( $status, $msg ) = $Ticket->Reminders->Resolve($reminder); + push @subresults, $msg; } - elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) { - my ($status, $msg) = $Ticket->Reminders->Open($reminder); - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + elsif ( $reminder->Status eq $resolve_status + && !$args->{ 'Complete-Reminder-' . $reminder->id } ) + { + ( $status, $msg ) = $Ticket->Reminders->Open($reminder); + push @subresults, $msg; } - if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) { - my ($status, $msg) = $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ; - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + if ( + exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) + && ( $reminder->Subject ne + $args->{ 'Reminder-Subject-' . $reminder->id } ) + ) + { + $old_subject = $reminder->Subject; + ( $status, $msg ) = + $reminder->SetSubject( + $args->{ 'Reminder-Subject-' . $reminder->id } ); + push @subresults, $msg; } - if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) { - my ($status, $msg) = $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ; - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + if ( + exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) + && ( $reminder->Owner != + $args->{ 'Reminder-Owner-' . $reminder->id } ) + ) + { + ( $status, $msg ) = + $reminder->SetOwner( + $args->{ 'Reminder-Owner-' . $reminder->id }, "Force" ); + push @subresults, $msg; } - if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) { + if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) + && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) + { my $DateObj = RT::Date->new( $session{'CurrentUser'} ); + my $due = $args->{ 'Reminder-Due-' . $reminder->id }; + $DateObj->Set( Format => 'unknown', - Value => $args->{ 'Reminder-Due-' . $reminder->id } + Value => $due, ); - if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) { - my ($status, $msg) = $reminder->SetDue( $DateObj->ISO ); - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + if ( $DateObj->Unix != $reminder->DueObj->Unix ) { + ( $status, $msg ) = $reminder->SetDue( $DateObj->ISO ); } + else { + $msg = loc( "invalid due date: [_1]", $due ); + } + + push @subresults, $msg; } + + push @results, map { + loc( "Reminder '[_1]': [_2]", $old_subject || $reminder->Subject, $_ ) + } @subresults; } } @@ -2668,13 +3029,14 @@ sub ProcessTicketReminders { Format => 'unknown', Value => $args->{'NewReminder-Due'} ); - my ( $add_id, $msg ) = $Ticket->Reminders->Add( + my ( $status, $msg ) = $Ticket->Reminders->Add( Subject => $args->{'NewReminder-Subject'}, Owner => $args->{'NewReminder-Owner'}, Due => $due_obj->ISO ); - if ( $add_id ) { - push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'}); + if ( $status ) { + push @results, + loc( "Reminder '[_1]': [_2]", $args->{'NewReminder-Subject'}, loc("Created") ) } else { push @results, $msg; @@ -2683,41 +3045,13 @@ sub ProcessTicketReminders { return @results; } -sub ProcessTicketCustomFieldUpdates { - my %args = @_; - $args{'Object'} = delete $args{'TicketObj'}; - my $ARGSRef = { %{ $args{'ARGSRef'} } }; - - # Build up a list of objects that we want to work with - my %custom_fields_to_mod; - foreach my $arg ( keys %$ARGSRef ) { - if ( $arg =~ /^Ticket-(\d+-.*)/ ) { - $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg}; - } elsif ( $arg =~ /^CustomField-(\d+-.*)/ ) { - $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg}; - } elsif ( $arg =~ /^Object-RT::Transaction-(\d*)-CustomField/ ) { - delete $ARGSRef->{$arg}; # don't try to update transaction fields - } - } - - return ProcessObjectCustomFieldUpdates( %args, ARGSRef => $ARGSRef ); -} - sub ProcessObjectCustomFieldUpdates { my %args = @_; my $ARGSRef = $args{'ARGSRef'}; my @results; # Build up a list of objects that we want to work with - my %custom_fields_to_mod; - foreach my $arg ( keys %$ARGSRef ) { - - # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands> - next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/; - - # For each of those objects, find out what custom fields we want to work with. - $custom_fields_to_mod{$1}{ $2 || 0 }{$3}{$4} = $ARGSRef->{$arg}; - } + my %custom_fields_to_mod = _ParseObjectCustomFieldArgs($ARGSRef); # For each of those objects foreach my $class ( keys %custom_fields_to_mod ) { @@ -2740,12 +3074,34 @@ sub ProcessObjectCustomFieldUpdates { $RT::Logger->warning("Couldn't load custom field #$cf"); next; } + my @groupings = sort keys %{ $custom_fields_to_mod{$class}{$id}{$cf} }; + if (@groupings > 1) { + # Check for consistency, in case of JS fail + for my $key (qw/AddValue Value Values DeleteValues DeleteValueIds/) { + my $base = $custom_fields_to_mod{$class}{$id}{$cf}{$groupings[0]}{$key}; + $base = [ $base ] unless ref $base; + for my $grouping (@groupings[1..$#groupings]) { + my $other = $custom_fields_to_mod{$class}{$id}{$cf}{$grouping}{$key}; + $other = [ $other ] unless ref $other; + warn "CF $cf submitted with multiple differing values" + if grep {$_} List::MoreUtils::pairwise { + no warnings qw(uninitialized); + $a ne $b + } @{$base}, @{$other}; + } + } + # We'll just be picking the 1st grouping in the hash, alphabetically + } push @results, _ProcessObjectCustomFieldUpdates( - Prefix => "Object-$class-$id-CustomField-$cf-", - Object => $Object, - CustomField => $CustomFieldObj, - ARGS => $custom_fields_to_mod{$class}{$id}{$cf}, + Prefix => GetCustomFieldInputNamePrefix( + Object => $Object, + CustomField => $CustomFieldObj, + Grouping => $groupings[0], + ), + Object => $Object, + CustomField => $CustomFieldObj, + ARGS => $custom_fields_to_mod{$class}{$id}{$cf}{ $groupings[0] }, ); } } @@ -2753,6 +3109,26 @@ sub ProcessObjectCustomFieldUpdates { return @results; } +sub _ParseObjectCustomFieldArgs { + my $ARGSRef = shift || {}; + my %custom_fields_to_mod; + + foreach my $arg ( keys %$ARGSRef ) { + + # format: Object-<object class>-<object id>-CustomField[:<grouping>]-<CF id>-<commands> + # you can use GetCustomFieldInputName to generate the complement input name + next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField(?::(\w+))?-(\d+)-(.*)$/; + + next if $1 eq 'RT::Transaction';# don't try to update transaction fields + + # For each of those objects, find out what custom fields we want to work with. + # Class ID CF grouping command + $custom_fields_to_mod{$1}{ $2 || 0 }{$4}{$3 || ''}{$5} = $ARGSRef->{$arg}; + } + + return wantarray ? %custom_fields_to_mod : \%custom_fields_to_mod; +} + sub _ProcessObjectCustomFieldUpdates { my %args = @_; my $cf = $args{'CustomField'}; @@ -2762,7 +3138,7 @@ sub _ProcessObjectCustomFieldUpdates { # the browser gives you a blank value which causes CFs to be processed twice if ( defined $args{'ARGS'}->{'Values'} && !length $args{'ARGS'}->{'Values'} - && $args{'ARGS'}->{'Values-Magic'} ) + && ($args{'ARGS'}->{'Values-Magic'}) ) { delete $args{'ARGS'}->{'Values'}; } @@ -2771,14 +3147,14 @@ sub _ProcessObjectCustomFieldUpdates { foreach my $arg ( keys %{ $args{'ARGS'} } ) { # skip category argument - next if $arg eq 'Category'; + next if $arg =~ /-Category$/; # and TimeUnits next if $arg eq 'Value-TimeUnits'; # since http won't pass in a form element with a null value, we need # to fake it - if ( $arg eq 'Values-Magic' ) { + if ( $arg =~ /-Magic$/ ) { # We don't care about the magic, if there's really a values element; next if defined $args{'ARGS'}->{'Value'} && length $args{'ARGS'}->{'Value'}; @@ -2791,22 +3167,14 @@ sub _ProcessObjectCustomFieldUpdates { $args{'ARGS'}->{'Values'} = undef; } - my @values = (); - if ( ref $args{'ARGS'}->{$arg} eq 'ARRAY' ) { - @values = @{ $args{'ARGS'}->{$arg} }; - } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext - @values = ( $args{'ARGS'}->{$arg} ); - } else { - @values = split /\r*\n/, $args{'ARGS'}->{$arg} - if defined $args{'ARGS'}->{$arg}; - } - @values = grep length, map { - s/\r+\n/\n/g; - s/^\s+//; - s/\s+$//; - $_; - } - grep defined, @values; + my @values = _NormalizeObjectCustomFieldValue( + CustomField => $cf, + Param => $args{'Prefix'} . $arg, + Value => $args{'ARGS'}->{$arg} + ); + + # "Empty" values still don't mean anything for Image and Binary fields + next if $cf_type =~ /^(?:Image|Binary)$/ and not @values; if ( $arg eq 'AddValue' || $arg eq 'Value' ) { foreach my $value (@values) { @@ -2817,8 +3185,7 @@ sub _ProcessObjectCustomFieldUpdates { push( @results, $msg ); } } elsif ( $arg eq 'Upload' ) { - my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next; - my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( %$value_hash, Field => $cf, ); + my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( %{$values[0]}, Field => $cf, ); push( @results, $msg ); } elsif ( $arg eq 'DeleteValues' ) { foreach my $value (@values) { @@ -2836,7 +3203,7 @@ sub _ProcessObjectCustomFieldUpdates { ); push( @results, $msg ); } - } elsif ( $arg eq 'Values' && !$cf->Repeated ) { + } elsif ( $arg eq 'Values' ) { my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id ); my %values_hash; @@ -2870,29 +3237,6 @@ sub _ProcessObjectCustomFieldUpdates { ); push( @results, $msg ); } - } elsif ( $arg eq 'Values' ) { - my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id ); - - # keep everything up to the point of difference, delete the rest - my $delete_flag; - foreach my $old_cf ( @{ $cf_values->ItemsArrayRef } ) { - if ( !$delete_flag and @values and $old_cf->Content eq $values[0] ) { - shift @values; - next; - } - - $delete_flag ||= 1; - $old_cf->Delete; - } - - # now add/replace extra things, if any - foreach my $value (@values) { - my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( - Field => $cf, - Value => $value - ); - push( @results, $msg ); - } } else { push( @results, @@ -2906,6 +3250,107 @@ sub _ProcessObjectCustomFieldUpdates { return @results; } +sub ProcessObjectCustomFieldUpdatesForCreate { + my %args = ( + ARGSRef => {}, + ContextObject => undef, + @_ + ); + my $context = $args{'ContextObject'}; + my %parsed; + my %custom_fields = _ParseObjectCustomFieldArgs( $args{'ARGSRef'} ); + + for my $class (keys %custom_fields) { + # we're only interested in new objects, so only look at $id == 0 + for my $cfid (keys %{ $custom_fields{$class}{0} || {} }) { + my $cf = RT::CustomField->new( $session{'CurrentUser'} ); + if ($context) { + my $system_cf = RT::CustomField->new( RT->SystemUser ); + $system_cf->LoadById($cfid); + if ($system_cf->ValidateContextObject($context)) { + $cf->SetContextObject($context); + } else { + RT->Logger->error( + sprintf "Invalid context object %s (%d) for CF %d; skipping CF", + ref $context, $context->id, $system_cf->id + ); + next; + } + } + $cf->LoadById($cfid); + + unless ($cf->id) { + RT->Logger->warning("Couldn't load custom field #$cfid"); + next; + } + + my @groupings = sort keys %{ $custom_fields{$class}{0}{$cfid} }; + if (@groupings > 1) { + # Check for consistency, in case of JS fail + for my $key (qw/AddValue Value Values DeleteValues DeleteValueIds/) { + warn "CF $cfid submitted with multiple differing $key" + if grep {($custom_fields{$class}{0}{$cfid}{$_}{$key} || '') + ne ($custom_fields{$class}{0}{$cfid}{$groupings[0]}{$key} || '')} + @groupings; + } + # We'll just be picking the 1st grouping in the hash, alphabetically + } + + my @values; + my $name_prefix = GetCustomFieldInputNamePrefix( + CustomField => $cf, + Grouping => $groupings[0], + ); + while (my ($arg, $value) = each %{ $custom_fields{$class}{0}{$cfid}{$groupings[0]} }) { + # Values-Magic doesn't matter on create; no previous values are being removed + # Category is irrelevant for the actual value + next if $arg =~ /-Magic$/ or $arg =~ /-Category$/; + + push @values, + _NormalizeObjectCustomFieldValue( + CustomField => $cf, + Param => $name_prefix . $arg, + Value => $value, + ); + } + + $parsed{"CustomField-$cfid"} = \@values if @values; + } + } + + return wantarray ? %parsed : \%parsed; +} + +sub _NormalizeObjectCustomFieldValue { + my %args = ( + Param => "", + @_ + ); + my $cf_type = $args{CustomField}->Type; + my @values = (); + + if ( ref $args{'Value'} eq 'ARRAY' ) { + @values = @{ $args{'Value'} }; + } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext + @values = ( $args{'Value'} ); + } else { + @values = split /\r*\n/, $args{'Value'} + if defined $args{'Value'}; + } + @values = grep length, map { + s/\r+\n/\n/g; + s/^\s+//; + s/\s+$//; + $_; + } + grep defined, @values; + + if ($args{'Param'} =~ /-Upload$/ and $cf_type =~ /^(Image|Binary)$/) { + @values = _UploadedFile( $args{'Param'} ) || (); + } + + return @values; +} =head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS ); @@ -3010,7 +3455,6 @@ sub ProcessTicketDates { # Set date fields my @date_fields = qw( Told - Resolved Starts Started Due @@ -3031,9 +3475,7 @@ sub ProcessTicketDates { ); my $obj = $field . "Obj"; - if ( ( defined $DateObj->Unix ) - and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) ) - { + if ( $DateObj->Unix != $Ticket->$obj()->Unix() ) { my $method = "Set$field"; my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO ); push @results, "$msg"; @@ -3055,19 +3497,24 @@ Returns an array of results messages. sub ProcessTicketLinks { my %args = ( TicketObj => undef, + TicketId => undef, ARGSRef => undef, @_ ); my $Ticket = $args{'TicketObj'}; + my $TicketId = $args{'TicketId'} || $Ticket->Id; my $ARGSRef = $args{'ARGSRef'}; - my (@results) = ProcessRecordLinks( RecordObj => $Ticket, ARGSRef => $ARGSRef ); + my (@results) = ProcessRecordLinks( + %args, RecordObj => $Ticket, RecordId => $TicketId, ARGSRef => $ARGSRef, + ); #Merge if we need to - if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) { - $ARGSRef->{ $Ticket->Id . "-MergeInto" } =~ s/\s+//g; - my ( $val, $msg ) = $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ); + my $input = $TicketId .'-MergeInto'; + if ( $ARGSRef->{ $input } ) { + $ARGSRef->{ $input } =~ s/\s+//g; + my ( $val, $msg ) = $Ticket->MergeInto( $ARGSRef->{ $input } ); push @results, $msg; } @@ -3078,11 +3525,13 @@ sub ProcessTicketLinks { sub ProcessRecordLinks { my %args = ( RecordObj => undef, + RecordId => undef, ARGSRef => undef, @_ ); my $Record = $args{'RecordObj'}; + my $RecordId = $args{'RecordId'} || $Record->Id; my $ARGSRef = $args{'ARGSRef'}; my (@results); @@ -3109,11 +3558,12 @@ sub ProcessRecordLinks { my @linktypes = qw( DependsOn MemberOf RefersTo ); foreach my $linktype (@linktypes) { - if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) { - $ARGSRef->{ $Record->Id . "-$linktype" } = join( ' ', @{ $ARGSRef->{ $Record->Id . "-$linktype" } } ) - if ref( $ARGSRef->{ $Record->Id . "-$linktype" } ); + my $input = $RecordId .'-'. $linktype; + if ( $ARGSRef->{ $input } ) { + $ARGSRef->{ $input } = join( ' ', @{ $ARGSRef->{ $input } } ) + if ref $ARGSRef->{ $input }; - for my $luri ( split( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) { + for my $luri ( split( / /, $ARGSRef->{ $input } ) ) { next unless $luri; $luri =~ s/\s+$//; # Strip trailing whitespace my ( $val, $msg ) = $Record->AddLink( @@ -3123,11 +3573,12 @@ sub ProcessRecordLinks { push @results, $msg; } } - if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) { - $ARGSRef->{ "$linktype-" . $Record->Id } = join( ' ', @{ $ARGSRef->{ "$linktype-" . $Record->Id } } ) - if ref( $ARGSRef->{ "$linktype-" . $Record->Id } ); + $input = $linktype .'-'. $RecordId; + if ( $ARGSRef->{ $input } ) { + $ARGSRef->{ $input } = join( ' ', @{ $ARGSRef->{ $input } } ) + if ref $ARGSRef->{ $input }; - for my $luri ( split( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) { + for my $luri ( split( / /, $ARGSRef->{ $input } ) ) { next unless $luri; my ( $val, $msg ) = $Record->AddLink( Base => $luri, @@ -3142,6 +3593,41 @@ sub ProcessRecordLinks { return (@results); } +=head2 ProcessLinksForCreate + +Takes a hash with a single key, C<ARGSRef>, the value of which is a hashref to +C<%ARGS>. + +Converts and returns submitted args in the form of C<new-LINKTYPE> and +C<LINKTYPE-new> into their appropriate directional link types. For example, +C<new-DependsOn> becomes C<DependsOn> and C<DependsOn-new> becomes +C<DependedOnBy>. The incoming arg values are split on whitespace and +normalized into arrayrefs before being returned. + +Primarily used by object creation pages for transforming incoming form inputs +from F</Elements/EditLinks> into arguments appropriate for individual record +Create methods. + +Returns a hashref in scalar context and a hash in list context. + +=cut + +sub ProcessLinksForCreate { + my %args = @_; + my %links; + + foreach my $type ( keys %RT::Link::DIRMAP ) { + for ([Base => "new-$type"], [Target => "$type-new"]) { + my ($direction, $key) = @$_; + next unless $args{ARGSRef}->{$key}; + $links{ $RT::Link::DIRMAP{$type}->{$direction} } = [ + grep $_, split ' ', $args{ARGSRef}->{$key} + ]; + } + } + return wantarray ? %links : \%links; +} + =head2 ProcessTransactionSquelching Takes a hashref of the submitted form arguments, C<%ARGS>. @@ -3160,6 +3646,89 @@ sub ProcessTransactionSquelching { return %squelched; } +sub ProcessRecordBulkCustomFields { + my %args = (RecordObj => undef, ARGSRef => {}, @_); + + my $ARGSRef = $args{'ARGSRef'}; + + my %data; + + my @results; + foreach my $key ( keys %$ARGSRef ) { + next unless $key =~ /^Bulk-(Add|Delete)-CustomField-(\d+)-(.*)$/; + my ($op, $cfid, $rest) = ($1, $2, $3); + next if $rest =~ /-Category$/; + + my $res = $data{$cfid} ||= {}; + unless (keys %$res) { + my $cf = RT::CustomField->new( $session{'CurrentUser'} ); + $cf->Load( $cfid ); + next unless $cf->Id; + + $res->{'cf'} = $cf; + } + + if ( $op eq 'Delete' && $rest eq 'AllValues' ) { + $res->{'DeleteAll'} = $ARGSRef->{$key}; + next; + } + + my @values = _NormalizeObjectCustomFieldValue( + CustomField => $res->{'cf'}, + Value => $ARGSRef->{$key}, + Param => $key, + ); + next unless @values; + $res->{$op} = \@values; + } + + while ( my ($cfid, $data) = each %data ) { + my $current_values = $args{'RecordObj'}->CustomFieldValues( $cfid ); + + # just add one value for fields with single value + if ( $data->{'Add'} && $data->{'cf'}->MaxValues == 1 ) { + next if $current_values->HasEntry($data->{Add}[-1]); + + my ( $id, $msg ) = $args{'RecordObj'}->AddCustomFieldValue( + Field => $cfid, + Value => $data->{'Add'}[-1], + ); + push @results, $msg; + next; + } + + if ( $data->{'DeleteAll'} ) { + while ( my $value = $current_values->Next ) { + my ( $id, $msg ) = $args{'RecordObj'}->DeleteCustomFieldValue( + Field => $cfid, + ValueId => $value->id, + ); + push @results, $msg; + } + } + foreach my $value ( @{ $data->{'Delete'} || [] } ) { + my $entry = $current_values->HasEntry($value); + next unless $entry; + + my ( $id, $msg ) = $args{'RecordObj'}->DeleteCustomFieldValue( + Field => $cfid, + ValueId => $entry->id, + ); + push @results, $msg; + } + foreach my $value ( @{ $data->{'Add'} || [] } ) { + next if $current_values->HasEntry($value); + + my ( $id, $msg ) = $args{'RecordObj'}->AddCustomFieldValue( + Field => $cfid, + Value => $value + ); + push @results, $msg; + } + } + return @results; +} + =head2 _UploadedFile ( $arg ); Takes a CGI parameter name; if a file is uploaded under that name, @@ -3220,10 +3789,13 @@ sub ProcessColumnMapValue { } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) { return $$value; } + } else { + if ($args{'Escape'}) { + $value = $m->interp->apply_escapes( $value, 'h' ); + $value =~ s/\n/<br>/g if defined $value; + } + return $value; } - - return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'}; - return $value; } =head2 GetPrincipalsMap OBJECT, CATEGORIES @@ -3240,10 +3812,10 @@ sub GetPrincipalsMap { if (/System/) { my $system = RT::Groups->new($session{'CurrentUser'}); $system->LimitToSystemInternalGroups(); - $system->OrderBy( FIELD => 'Type', ORDER => 'ASC' ); + $system->OrderBy( FIELD => 'Name', ORDER => 'ASC' ); push @map, [ 'System' => $system, # loc_left_pair - 'Type' => 1, + 'Name' => 1, ]; } elsif (/Groups/) { @@ -3267,21 +3839,33 @@ sub GetPrincipalsMap { elsif (/Roles/) { my $roles = RT::Groups->new($session{'CurrentUser'}); - if ($object->isa('RT::System')) { - $roles->LimitToRolesForSystem(); - } - elsif ($object->isa('RT::Queue')) { - $roles->LimitToRolesForQueue($object->Id); + if ($object->isa("RT::CustomField")) { + # If we're a custom field, show the global roles for our LookupType. + my $class = $object->RecordClassFromLookupType; + if ($class and $class->DOES("RT::Record::Role::Roles")) { + $roles->LimitToRolesForObject(RT->System); + $roles->Limit( + FIELD => "Name", + FUNCTION => 'LOWER(?)', + OPERATOR => "IN", + VALUE => [ map {lc $_} $class->Roles ], + CASESENSITIVE => 1, + ); + } else { + # No roles to show; so show nothing + undef $roles; + } + } else { + $roles->LimitToRolesForObject($object); } - else { - $RT::Logger->warn("Skipping unknown object type ($object) for Role principals"); - next; + + if ($roles) { + $roles->OrderBy( FIELD => 'Name', ORDER => 'ASC' ); + push @map, [ + 'Roles' => $roles, # loc_left_pair + 'Name' => 1 + ]; } - $roles->OrderBy( FIELD => 'Type', ORDER => 'ASC' ); - push @map, [ - 'Roles' => $roles, # loc_left_pair - 'Type' => 1 - ]; } elsif (/Users/) { my $Users = RT->PrivilegedUsers->UserMembersObj(); @@ -3296,23 +3880,18 @@ sub GetPrincipalsMap { ); # Limit to UserEquiv groups - my $groups = $Users->NewAlias('Groups'); - $Users->Join( - ALIAS1 => $groups, - FIELD1 => 'id', - ALIAS2 => $group_members, - FIELD2 => 'GroupId' + my $groups = $Users->Join( + ALIAS1 => $group_members, + FIELD1 => 'GroupId', + TABLE2 => 'Groups', + FIELD2 => 'id', ); - $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence' ); - $Users->Limit( ALIAS => $groups, FIELD => 'Type', VALUE => 'UserEquiv' ); + $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence', CASESENSITIVE => 0 ); + $Users->Limit( ALIAS => $groups, FIELD => 'Name', VALUE => 'UserEquiv', CASESENSITIVE => 0 ); - - my $display = sub { - $m->scomp('/Elements/ShowUser', User => $_[0], NoEscape => 1) - }; push @map, [ 'Users' => $Users, # loc_left_pair - $display => 0 + 'Format' => 0 ]; } } @@ -3381,16 +3960,17 @@ following: =cut our @SCRUBBER_ALLOWED_TAGS = qw( - A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP STRIKE H1 H2 H3 H4 H5 + A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP S DEL STRIKE H1 H2 H3 H4 H5 H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO ); our %SCRUBBER_ALLOWED_ATTRIBUTES = ( # Match http, https, ftp, mailto and relative urls # XXX: we also scrub format strings with this module then allow simple config options - href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|BaseURL|URL)__)}i, + href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|HomePath|BaseURL|URL)__)}i, face => 1, size => 1, + color => 1, target => 1, style => qr{ ^(?:\s* @@ -3404,6 +3984,12 @@ our %SCRUBBER_ALLOWED_ATTRIBUTES = ( font-family: \s* [\w\s"',.\-]+ | font-weight: \s* [\w\-]+ | + border-style: \s* \w+ | + border-color: \s* [#\w]+ | + border-width: \s* [\s\w]+ | + padding: \s* [\s\w]+ | + margin: \s* [\s\w]+ | + # MS Office styles, which are probably fine. If we don't, then any # associated styles in the same attribute get stripped. mso-[\w\-]+?: \s* [\w\s"',.\-]+ @@ -3416,9 +4002,42 @@ our %SCRUBBER_ALLOWED_ATTRIBUTES = ( our %SCRUBBER_RULES = (); +# If we're displaying images, let embedded ones through +if (RT->Config->Get('ShowTransactionImages') or RT->Config->Get('ShowRemoteImages')) { + $SCRUBBER_RULES{'img'} = { + '*' => 0, + alt => 1, + }; + + my @src; + push @src, qr/^cid:/i + if RT->Config->Get('ShowTransactionImages'); + + push @src, $SCRUBBER_ALLOWED_ATTRIBUTES{'href'} + if RT->Config->Get('ShowRemoteImages'); + + $SCRUBBER_RULES{'img'}->{'src'} = join "|", @src; +} + sub _NewScrubber { require HTML::Scrubber; my $scrubber = HTML::Scrubber->new(); + + if (HTML::Gumbo->require) { + no warnings 'redefine'; + my $orig = \&HTML::Scrubber::scrub; + *HTML::Scrubber::scrub = sub { + my $self = shift; + + eval { $_[0] = HTML::Gumbo->new->parse( $_[0] ); chomp $_[0] }; + warn "HTML::Gumbo pre-parse failed: $@" if $@; + return $orig->($self, @_); + }; + push @SCRUBBER_ALLOWED_TAGS, qw/TABLE THEAD TBODY TFOOT TR TD TH/; + $SCRUBBER_ALLOWED_ATTRIBUTES{$_} = 1 for + qw/colspan rowspan align valign cellspacing cellpadding border width height/; + } + $scrubber->default( 0, { @@ -3447,6 +4066,21 @@ sub JSON { RT::Interface::Web::EncodeJSON(@_); } +sub CSSClass { + my $value = shift; + return '' unless defined $value; + $value =~ s/[^A-Za-z0-9_-]/_/g; + return $value; +} + +sub GetCustomFieldInputName { + RT::Interface::Web::GetCustomFieldInputName(@_); +} + +sub GetCustomFieldInputNamePrefix { + RT::Interface::Web::GetCustomFieldInputNamePrefix(@_); +} + package RT::Interface::Web; RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Interface/Web.pm.orig b/rt/lib/RT/Interface/Web.pm.orig deleted file mode 100644 index 59d3154..0000000 --- a/rt/lib/RT/Interface/Web.pm.orig +++ /dev/null @@ -1,3454 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} - -## Portions Copyright 2000 Tobias Brox <tobix@fsck.com> - -## This is a library of static subs to be used by the Mason web -## interface to RT - -=head1 NAME - -RT::Interface::Web - - -=cut - -use strict; -use warnings; - -package RT::Interface::Web; - -use RT::SavedSearches; -use URI qw(); -use RT::Interface::Web::Menu; -use RT::Interface::Web::Session; -use Digest::MD5 (); -use Encode qw(); -use List::MoreUtils qw(); -use JSON qw(); - -=head2 SquishedCSS $style - -=cut - -my %SQUISHED_CSS; -sub SquishedCSS { - my $style = shift or die "need name"; - return $SQUISHED_CSS{$style} if $SQUISHED_CSS{$style}; - require RT::Squish::CSS; - my $css = RT::Squish::CSS->new( Style => $style ); - $SQUISHED_CSS{ $css->Style } = $css; - return $css; -} - -=head2 SquishedJS - -=cut - -my $SQUISHED_JS; -sub SquishedJS { - return $SQUISHED_JS if $SQUISHED_JS; - - require RT::Squish::JS; - my $js = RT::Squish::JS->new(); - $SQUISHED_JS = $js; - return $js; -} - -=head2 ClearSquished - -Removes the cached CSS and JS entries, forcing them to be regenerated -on next use. - -=cut - -sub ClearSquished { - undef $SQUISHED_JS; - %SQUISHED_CSS = (); -} - -=head2 EscapeUTF8 SCALARREF - -does a css-busting but minimalist escaping of whatever html you're passing in. - -=cut - -sub EscapeUTF8 { - my $ref = shift; - return unless defined $$ref; - - $$ref =~ s/&/&/g; - $$ref =~ s/</</g; - $$ref =~ s/>/>/g; - $$ref =~ s/\(/(/g; - $$ref =~ s/\)/)/g; - $$ref =~ s/"/"/g; - $$ref =~ s/'/'/g; -} - - - -=head2 EscapeURI SCALARREF - -Escapes URI component according to RFC2396 - -=cut - -sub EscapeURI { - my $ref = shift; - return unless defined $$ref; - - use bytes; - $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg; -} - -=head2 EncodeJSON SCALAR - -Encodes the SCALAR to JSON and returns a JSON string. SCALAR may be a simple -value or a reference. - -=cut - -sub EncodeJSON { - JSON::to_json(shift, { utf8 => 1, allow_nonref => 1 }); -} - -sub _encode_surrogates { - my $uni = $_[0] - 0x10000; - return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00); -} - -sub EscapeJS { - my $ref = shift; - return unless defined $$ref; - - $$ref = "'" . join('', - map { - chr($_) =~ /[a-zA-Z0-9]/ ? chr($_) : - $_ <= 255 ? sprintf("\\x%02X", $_) : - $_ <= 65535 ? sprintf("\\u%04X", $_) : - sprintf("\\u%X\\u%X", _encode_surrogates($_)) - } unpack('U*', $$ref)) - . "'"; -} - -=head2 WebCanonicalizeInfo(); - -Different web servers set different environmental varibles. This -function must return something suitable for REMOTE_USER. By default, -just downcase $ENV{'REMOTE_USER'} - -=cut - -sub WebCanonicalizeInfo { - return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'}; -} - - - -=head2 WebExternalAutoInfo($user); - -Returns a hash of user attributes, used when WebExternalAuto is set. - -=cut - -sub WebExternalAutoInfo { - my $user = shift; - - my %user_info; - - # default to making Privileged users, even if they specify - # some other default Attributes - if ( !$RT::AutoCreate - || ( ref($RT::AutoCreate) && not exists $RT::AutoCreate->{Privileged} ) ) - { - $user_info{'Privileged'} = 1; - } - - if ( $^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/ ) { - - # Populate fields with information from Unix /etc/passwd - - my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ]; - $user_info{'Comments'} = $comments if defined $comments; - $user_info{'RealName'} = $realname if defined $realname; - } elsif ( $^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1' ) { - - # Populate fields with information from NT domain controller - } - - # and return the wad of stuff - return {%user_info}; -} - - -sub HandleRequest { - my $ARGS = shift; - - if (RT->Config->Get('DevelMode')) { - require Module::Refresh; - Module::Refresh->refresh; - } - - $HTML::Mason::Commands::r->content_type("text/html; charset=utf-8"); - - $HTML::Mason::Commands::m->{'rt_base_time'} = [ Time::HiRes::gettimeofday() ]; - - # Roll back any dangling transactions from a previous failed connection - $RT::Handle->ForceRollback() if $RT::Handle and $RT::Handle->TransactionDepth; - - MaybeEnableSQLStatementLog(); - - # avoid reentrancy, as suggested by masonbook - local *HTML::Mason::Commands::session unless $HTML::Mason::Commands::m->is_subrequest; - - $HTML::Mason::Commands::m->autoflush( $HTML::Mason::Commands::m->request_comp->attr('AutoFlush') ) - if ( $HTML::Mason::Commands::m->request_comp->attr_exists('AutoFlush') ); - - ValidateWebConfig(); - - DecodeARGS($ARGS); - local $HTML::Mason::Commands::DECODED_ARGS = $ARGS; - PreprocessTimeUpdates($ARGS); - - InitializeMenu(); - MaybeShowInstallModePage(); - - $HTML::Mason::Commands::m->comp( '/Elements/SetupSessionCookie', %$ARGS ); - SendSessionCookie(); - - if ( _UserLoggedIn() ) { - # make user info up to date - $HTML::Mason::Commands::session{'CurrentUser'} - ->Load( $HTML::Mason::Commands::session{'CurrentUser'}->id ); - undef $HTML::Mason::Commands::session{'CurrentUser'}->{'LangHandle'}; - } - else { - $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new(); - } - - # Process session-related callbacks before any auth attempts - $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Session', CallbackPage => '/autohandler' ); - - MaybeRejectPrivateComponentRequest(); - - MaybeShowNoAuthPage($ARGS); - - AttemptExternalAuth($ARGS) if RT->Config->Get('WebExternalAuthContinuous') or not _UserLoggedIn(); - - _ForceLogout() unless _UserLoggedIn(); - - # Process per-page authentication callbacks - $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' ); - - if ( $ARGS->{'NotMobile'} ) { - $HTML::Mason::Commands::session{'NotMobile'} = 1; - } - - unless ( _UserLoggedIn() ) { - _ForceLogout(); - - # Authenticate if the user is trying to login via user/pass query args - my ($authed, $msg) = AttemptPasswordAuthentication($ARGS); - - unless ($authed) { - my $m = $HTML::Mason::Commands::m; - - # REST urls get a special 401 response - if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) { - $HTML::Mason::Commands::r->content_type("text/plain"); - $m->error_format("text"); - $m->out("RT/$RT::VERSION 401 Credentials required\n"); - $m->out("\n$msg\n") if $msg; - $m->abort; - } - # Specially handle /index.html and /m/index.html so that we get a nicer URL - elsif ( $m->request_comp->path =~ m{^(/m)?/index\.html$} ) { - my $mobile = $1 ? 1 : 0; - my $next = SetNextPage($ARGS); - $m->comp('/NoAuth/Login.html', - next => $next, - actions => [$msg], - mobile => $mobile); - $m->abort; - } - else { - TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef)); - } - } - } - - MaybeShowInterstitialCSRFPage($ARGS); - - # now it applies not only to home page, but any dashboard that can be used as a workspace - $HTML::Mason::Commands::session{'home_refresh_interval'} = $ARGS->{'HomeRefreshInterval'} - if ( $ARGS->{'HomeRefreshInterval'} ); - - # Process per-page global callbacks - $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' ); - - ShowRequestedPage($ARGS); - LogRecordedSQLStatements(RequestData => { - Path => $HTML::Mason::Commands::m->request_path, - }); - - # Process per-page final cleanup callbacks - $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Final', CallbackPage => '/autohandler' ); - - $HTML::Mason::Commands::m->comp( '/Elements/Footer', %$ARGS ) - unless $HTML::Mason::Commands::r->content_type - =~ qr<^(text|application)/(x-)?(css|javascript)>; -} - -sub _ForceLogout { - - delete $HTML::Mason::Commands::session{'CurrentUser'}; -} - -sub _UserLoggedIn { - if ( $HTML::Mason::Commands::session{CurrentUser} && $HTML::Mason::Commands::session{'CurrentUser'}->id ) { - return 1; - } else { - return undef; - } - -} - -=head2 LoginError ERROR - -Pushes a login error into the Actions session store and returns the hash key. - -=cut - -sub LoginError { - my $new = shift; - my $key = Digest::MD5::md5_hex( rand(1024) ); - push @{ $HTML::Mason::Commands::session{"Actions"}->{$key} ||= [] }, $new; - $HTML::Mason::Commands::session{'i'}++; - return $key; -} - -=head2 SetNextPage ARGSRef [PATH] - -Intuits and stashes the next page in the sesssion hash. If PATH is -specified, uses that instead of the value of L<IntuitNextPage()>. Returns -the hash value. - -=cut - -sub SetNextPage { - my $ARGS = shift; - my $next = $_[0] ? $_[0] : IntuitNextPage(); - my $hash = Digest::MD5::md5_hex($next . $$ . rand(1024)); - my $page = { url => $next }; - - # If an explicit URL was passed and we didn't IntuitNextPage, then - # IsPossibleCSRF below is almost certainly unrelated to the actual - # destination. Currently explicit next pages aren't used in RT, but the - # API is available. - if (not $_[0] and RT->Config->Get("RestrictReferrer")) { - # This isn't really CSRF, but the CSRF heuristics are useful for catching - # requests which may have unintended side-effects. - my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS); - if ($is_csrf) { - RT->Logger->notice( - "Marking original destination as having side-effects before redirecting for login.\n" - ."Request: $next\n" - ."Reason: " . HTML::Mason::Commands::loc($msg, @loc) - ); - $page->{'HasSideEffects'} = [$msg, @loc]; - } - } - - $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $page; - $HTML::Mason::Commands::session{'i'}++; - return $hash; -} - -=head2 FetchNextPage HASHKEY - -Returns the stashed next page hashref for the given hash. - -=cut - -sub FetchNextPage { - my $hash = shift || ""; - return $HTML::Mason::Commands::session{'NextPage'}->{$hash}; -} - -=head2 RemoveNextPage HASHKEY - -Removes the stashed next page for the given hash and returns it. - -=cut - -sub RemoveNextPage { - my $hash = shift || ""; - return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash}; -} - -=head2 TangentForLogin ARGSRef [HASH] - -Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as -the next page. Takes a hashref of request %ARGS as the first parameter. -Optionally takes all other parameters as a hash which is dumped into query -params. - -=cut - -sub TangentForLogin { - my $ARGS = shift; - my $hash = SetNextPage($ARGS); - my %query = (@_, next => $hash); - - $query{mobile} = 1 - if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)}; - - my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?'; - $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query); - Redirect($login); -} - -=head2 TangentForLoginWithError ERROR - -Localizes the passed error message, stashes it with L<LoginError> and then -calls L<TangentForLogin> with the appropriate results key. - -=cut - -sub TangentForLoginWithError { - my $ARGS = shift; - my $key = LoginError(HTML::Mason::Commands::loc(@_)); - TangentForLogin( $ARGS, results => $key ); -} - -=head2 IntuitNextPage - -Attempt to figure out the path to which we should return the user after a -tangent. The current request URL is used, or failing that, the C<WebURL> -configuration variable. - -=cut - -sub IntuitNextPage { - my $req_uri; - - # This includes any query parameters. Redirect will take care of making - # it an absolute URL. - if ($ENV{'REQUEST_URI'}) { - $req_uri = $ENV{'REQUEST_URI'}; - - # collapse multiple leading slashes so the first part doesn't look like - # a hostname of a schema-less URI - $req_uri =~ s{^/+}{/}; - } - - my $next = defined $req_uri ? $req_uri : RT->Config->Get('WebURL'); - - # sanitize $next - my $uri = URI->new($next); - - # You get undef scheme with a relative uri like "/Search/Build.html" - unless (!defined($uri->scheme) || $uri->scheme eq 'http' || $uri->scheme eq 'https') { - $next = RT->Config->Get('WebURL'); - } - - # Make sure we're logging in to the same domain - # You can get an undef authority with a relative uri like "index.html" - my $uri_base_url = URI->new(RT->Config->Get('WebBaseURL')); - unless (!defined($uri->authority) || $uri->authority eq $uri_base_url->authority) { - $next = RT->Config->Get('WebURL'); - } - - return $next; -} - -=head2 MaybeShowInstallModePage - -This function, called exclusively by RT's autohandler, dispatches -a request to RT's Installation workflow, only if Install Mode is enabled in the configuration file. - -If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler - -=cut - -sub MaybeShowInstallModePage { - return unless RT->InstallMode; - - my $m = $HTML::Mason::Commands::m; - if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) { - $m->call_next(); - } elsif ( $m->request_comp->path !~ m{^(/+)Install/} ) { - RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" ); - } else { - $m->call_next(); - } - $m->abort(); -} - -=head2 MaybeShowNoAuthPage \%ARGS - -This function, called exclusively by RT's autohandler, dispatches -a request to the page a user requested (but only if it matches the "noauth" regex. - -If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler - -=cut - -sub MaybeShowNoAuthPage { - my $ARGS = shift; - - my $m = $HTML::Mason::Commands::m; - - return unless $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex'); - - # Don't show the login page to logged in users - Redirect(RT->Config->Get('WebURL')) - if $m->base_comp->path eq '/NoAuth/Login.html' and _UserLoggedIn(); - - # If it's a noauth file, don't ask for auth. - $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS ); - $m->abort; -} - -=head2 MaybeRejectPrivateComponentRequest - -This function will reject calls to private components, like those under -C</Elements>. If the requested path is a private component then we will -abort with a C<403> error. - -=cut - -sub MaybeRejectPrivateComponentRequest { - my $m = $HTML::Mason::Commands::m; - my $path = $m->request_comp->path; - - # We do not check for dhandler here, because requesting our dhandlers - # directly is okay. Mason will invoke the dhandler with a dhandler_arg of - # 'dhandler'. - - if ($path =~ m{ - / # leading slash - ( Elements | - _elements | # mobile UI - Callbacks | - Widgets | - autohandler | # requesting this directly is suspicious - l (_unsafe)? ) # loc component - ( $ | / ) # trailing slash or end of path - }xi - && $path !~ m{ /RTx/Statistics/\w+/Elements/Chart }xi - ) - { - warn "rejecting private component $path\n"; - $m->abort(403); - } - - return; -} - -sub InitializeMenu { - $HTML::Mason::Commands::m->notes('menu', RT::Interface::Web::Menu->new()); - $HTML::Mason::Commands::m->notes('page-menu', RT::Interface::Web::Menu->new()); - $HTML::Mason::Commands::m->notes('page-widgets', RT::Interface::Web::Menu->new()); - -} - - -=head2 ShowRequestedPage \%ARGS - -This function, called exclusively by RT's autohandler, dispatches -a request to the page a user requested (making sure that unpriviled users -can only see self-service pages. - -=cut - -sub ShowRequestedPage { - my $ARGS = shift; - - my $m = $HTML::Mason::Commands::m; - - # Ensure that the cookie that we send is up-to-date, in case the - # session-id has been modified in any way - SendSessionCookie(); - - # precache all system level rights for the current user - $HTML::Mason::Commands::session{CurrentUser}->PrincipalObj->HasRights( Object => RT->System ); - - # If the user isn't privileged, they can only see SelfService - unless ( $HTML::Mason::Commands::session{'CurrentUser'}->Privileged ) { - - # if the user is trying to access a ticket, redirect them - if ( $m->request_comp->path =~ m{^(/+)Ticket/Display.html} && $ARGS->{'id'} ) { - RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} ); - } - - # otherwise, drop the user at the SelfService default page - elsif ( $m->base_comp->path !~ RT->Config->Get('SelfServiceRegex') ) { - RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/" ); - } - - # if user is in SelfService dir let him do anything - else { - $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS ); - } - } else { - $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS ); - } - -} - -sub AttemptExternalAuth { - my $ARGS = shift; - - return unless ( RT->Config->Get('WebExternalAuth') ); - - my $user = $ARGS->{user}; - my $m = $HTML::Mason::Commands::m; - - # If RT is configured for external auth, let's go through and get REMOTE_USER - - # do we actually have a REMOTE_USER equivlent? - if ( RT::Interface::Web::WebCanonicalizeInfo() ) { - my $orig_user = $user; - - $user = RT::Interface::Web::WebCanonicalizeInfo(); - my $load_method = RT->Config->Get('WebExternalGecos') ? 'LoadByGecos' : 'Load'; - - if ( $^O eq 'MSWin32' and RT->Config->Get('WebExternalGecos') ) { - my $NodeName = Win32::NodeName(); - $user =~ s/^\Q$NodeName\E\\//i; - } - - my $next = RemoveNextPage($ARGS->{'next'}); - $next = $next->{'url'} if ref $next; - InstantiateNewSession() unless _UserLoggedIn; - $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new(); - $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user); - - if ( RT->Config->Get('WebExternalAuto') and not _UserLoggedIn() ) { - - # Create users on-the-fly - my $UserObj = RT::User->new(RT->SystemUser); - my ( $val, $msg ) = $UserObj->Create( - %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} }, - Name => $user, - Gecos => $user, - ); - - if ($val) { - - # now get user specific information, to better create our user. - my $new_user_info = RT::Interface::Web::WebExternalAutoInfo($user); - - # set the attributes that have been defined. - foreach my $attribute ( $UserObj->WritableAttributes ) { - $m->callback( - Attribute => $attribute, - User => $user, - UserInfo => $new_user_info, - CallbackName => 'NewUser', - CallbackPage => '/autohandler' - ); - my $method = "Set$attribute"; - $UserObj->$method( $new_user_info->{$attribute} ) if defined $new_user_info->{$attribute}; - } - $HTML::Mason::Commands::session{'CurrentUser'}->Load($user); - } else { - - # we failed to successfully create the user. abort abort abort. - delete $HTML::Mason::Commands::session{'CurrentUser'}; - - if (RT->Config->Get('WebFallbackToInternalAuth')) { - TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg); - } else { - $m->abort(); - } - } - } - - if ( _UserLoggedIn() ) { - $m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' ); - # It is possible that we did a redirect to the login page, - # if the external auth allows lack of auth through with no - # REMOTE_USER set, instead of forcing a "permission - # denied" message. Honor the $next. - Redirect($next) if $next; - # Unlike AttemptPasswordAuthentication below, we do not - # force a redirect to / if $next is not set -- otherwise, - # straight-up external auth would always redirect to / - # when you first hit it. - } else { - delete $HTML::Mason::Commands::session{'CurrentUser'}; - $user = $orig_user; - - unless ( RT->Config->Get('WebFallbackToInternalAuth') ) { - TangentForLoginWithError($ARGS, 'You are not an authorized user'); - } - } - } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) { - unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) { - # XXX unreachable due to prior defaulting in HandleRequest (check c34d108) - TangentForLoginWithError($ARGS, 'You are not an authorized user'); - } - } else { - - # WebExternalAuth is set, but we don't have a REMOTE_USER. abort - # XXX: we must return AUTH_REQUIRED status or we fallback to - # internal auth here too. - delete $HTML::Mason::Commands::session{'CurrentUser'} - if defined $HTML::Mason::Commands::session{'CurrentUser'}; - } -} - -sub AttemptPasswordAuthentication { - my $ARGS = shift; - return unless defined $ARGS->{user} && defined $ARGS->{pass}; - - my $user_obj = RT::CurrentUser->new(); - $user_obj->Load( $ARGS->{user} ); - - my $m = $HTML::Mason::Commands::m; - - unless ( $user_obj->id && $user_obj->IsPassword( $ARGS->{pass} ) ) { - $RT::Logger->error("FAILED LOGIN for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}"); - $m->callback( %$ARGS, CallbackName => 'FailedLogin', CallbackPage => '/autohandler' ); - return (0, HTML::Mason::Commands::loc('Your username or password is incorrect')); - } - else { - $RT::Logger->info("Successful login for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}"); - - # It's important to nab the next page from the session before we blow - # the session away - my $next = RemoveNextPage($ARGS->{'next'}); - $next = $next->{'url'} if ref $next; - - InstantiateNewSession(); - $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj; - - $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' ); - - # Really the only time we don't want to redirect here is if we were - # passed user and pass as query params in the URL. - if ($next) { - Redirect($next); - } - elsif ($ARGS->{'next'}) { - # Invalid hash, but still wants to go somewhere, take them to / - Redirect(RT->Config->Get('WebURL')); - } - - return (1, HTML::Mason::Commands::loc('Logged in')); - } -} - -=head2 LoadSessionFromCookie - -Load or setup a session cookie for the current user. - -=cut - -sub _SessionCookieName { - my $cookiename = "RT_SID_" . RT->Config->Get('rtname'); - $cookiename .= "." . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'}; - return $cookiename; -} - -sub LoadSessionFromCookie { - - my %cookies = CGI::Cookie->fetch; - my $cookiename = _SessionCookieName(); - my $SessionCookie = ( $cookies{$cookiename} ? $cookies{$cookiename}->value : undef ); - tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', $SessionCookie; - unless ( $SessionCookie && $HTML::Mason::Commands::session{'_session_id'} eq $SessionCookie ) { - InstantiateNewSession(); - } - if ( int RT->Config->Get('AutoLogoff') ) { - my $now = int( time / 60 ); - my $last_update = $HTML::Mason::Commands::session{'_session_last_update'} || 0; - - if ( $last_update && ( $now - $last_update - RT->Config->Get('AutoLogoff') ) > 0 ) { - InstantiateNewSession(); - } - - # save session on each request when AutoLogoff is turned on - $HTML::Mason::Commands::session{'_session_last_update'} = $now if $now != $last_update; - } -} - -sub InstantiateNewSession { - tied(%HTML::Mason::Commands::session)->delete if tied(%HTML::Mason::Commands::session); - tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', undef; - SendSessionCookie(); -} - -sub SendSessionCookie { - my $cookie = CGI::Cookie->new( - -name => _SessionCookieName(), - -value => $HTML::Mason::Commands::session{_session_id}, - -path => RT->Config->Get('WebPath'), - -secure => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 ), - -httponly => ( RT->Config->Get('WebHttpOnlyCookies') ? 1 : 0 ), - ); - - $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string; -} - -=head2 Redirect URL - -This routine ells the current user's browser to redirect to URL. -Additionally, it unties the user's currently active session, helping to avoid -A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use -a cached DBI statement handle twice at the same time. - -=cut - -sub Redirect { - my $redir_to = shift; - untie $HTML::Mason::Commands::session; - my $uri = URI->new($redir_to); - my $server_uri = URI->new( _NormalizeHost(RT->Config->Get('WebURL')) ); - - # Make relative URIs absolute from the server host and scheme - $uri->scheme($server_uri->scheme) if not defined $uri->scheme; - if (not defined $uri->host) { - $uri->host($server_uri->host); - $uri->port($server_uri->port); - } - - # If the user is coming in via a non-canonical - # hostname, don't redirect them to the canonical host, - # it will just upset them (and invalidate their credentials) - # don't do this if $RT::CanonicalizeRedirectURLs is true - if ( !RT->Config->Get('CanonicalizeRedirectURLs') - && $uri->host eq $server_uri->host - && $uri->port eq $server_uri->port ) - { - if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) { - $uri->scheme('https'); - } else { - $uri->scheme('http'); - } - - # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST - $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'}); - $uri->port( $ENV{'SERVER_PORT'} ); - } - - # not sure why, but on some systems without this call mason doesn't - # set status to 302, but 200 instead and people see blank pages - $HTML::Mason::Commands::r->status(302); - - # Perlbal expects a status message, but Mason's default redirect status - # doesn't provide one. See also rt.cpan.org #36689. - $HTML::Mason::Commands::m->redirect( $uri->canonical, "302 Found" ); - - $HTML::Mason::Commands::m->abort; -} - -=head2 CacheControlExpiresHeaders - -set both Cache-Control and Expires http headers - -=cut - -sub CacheControlExpiresHeaders { - my %args = @_; - - my $Visibility = 'private'; - if ( ! defined $args{Time} ) { - $args{Time} = 0; - } elsif ( $args{Time} eq 'no-cache' ) { - $args{Time} = 0; - } elsif ( $args{Time} eq 'forever' ) { - $args{Time} = 30 * 24 * 60 * 60; - $Visibility = 'public'; - } - - my $CacheControl = $args{Time} - ? sprintf "max-age=%d, %s", $args{Time}, $Visibility - : 'no-cache' - ; - $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = $CacheControl; - - my $expires = RT::Date->new(RT->SystemUser); - $expires->SetToNow; - $expires->AddSeconds( $args{Time} ) if $args{Time}; - - $HTML::Mason::Commands::r->headers_out->{'Expires'} = $expires->RFC2616; -} - -=head2 StaticFileHeaders - -Send the browser a few headers to try to get it to (somewhat agressively) -cache RT's static Javascript and CSS files. - -This routine could really use _accurate_ heuristics. (XXX TODO) - -=cut - -sub StaticFileHeaders { - my $date = RT::Date->new(RT->SystemUser); - - # remove any cookie headers -- if it is cached publicly, it - # shouldn't include anyone's cookie! - delete $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'}; - - # Expire things in a month. - CacheControlExpiresHeaders( Time => 'forever' ); - - # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since' - # request, but we don't handle it and generate full reply again - # Last modified at server start time - # $date->Set( Value => $^T ); - # $HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = $date->RFC2616; -} - -=head2 ComponentPathIsSafe PATH - -Takes C<PATH> and returns a boolean indicating that the user-specified partial -component path is safe. - -Currently "safe" means that the path does not start with a dot (C<.>), does -not contain a slash-dot C</.>, and does not contain any nulls. - -=cut - -sub ComponentPathIsSafe { - my $self = shift; - my $path = shift; - return($path !~ m{(?:^|/)\.} and $path !~ m{\0}); -} - -=head2 PathIsSafe - -Takes a C<< Path => path >> and returns a boolean indicating that -the path is safely within RT's control or not. The path I<must> be -relative. - -This function does not consult the filesystem at all; it is merely -a logical sanity checking of the path. This explicitly does not handle -symlinks; if you have symlinks in RT's webroot pointing outside of it, -then we assume you know what you are doing. - -=cut - -sub PathIsSafe { - my $self = shift; - my %args = @_; - my $path = $args{Path}; - - # Get File::Spec to clean up extra /s, ./, etc - my $cleaned_up = File::Spec->canonpath($path); - - if (!defined($cleaned_up)) { - $RT::Logger->info("Rejecting path that canonpath doesn't understand: $path"); - return 0; - } - - # Forbid too many ..s. We can't just sum then check because - # "../foo/bar/baz" should be illegal even though it has more - # downdirs than updirs. So as soon as we get a negative score - # (which means "breaking out" of the top level) we reject the path. - - my @components = split '/', $cleaned_up; - my $score = 0; - for my $component (@components) { - if ($component eq '..') { - $score--; - if ($score < 0) { - $RT::Logger->info("Rejecting unsafe path: $path"); - return 0; - } - } - elsif ($component eq '.' || $component eq '') { - # these two have no effect on $score - } - else { - $score++; - } - } - - return 1; -} - -=head2 SendStaticFile - -Takes a File => path and a Type => Content-type - -If Type isn't provided and File is an image, it will -figure out a sane Content-type, otherwise it will -send application/octet-stream - -Will set caching headers using StaticFileHeaders - -=cut - -sub SendStaticFile { - my $self = shift; - my %args = @_; - my $file = $args{File}; - my $type = $args{Type}; - my $relfile = $args{RelativeFile}; - - if (defined($relfile) && !$self->PathIsSafe(Path => $relfile)) { - $HTML::Mason::Commands::r->status(400); - $HTML::Mason::Commands::m->abort; - } - - $self->StaticFileHeaders(); - - unless ($type) { - if ( $file =~ /\.(gif|png|jpe?g)$/i ) { - $type = "image/$1"; - $type =~ s/jpg/jpeg/gi; - } - $type ||= "application/octet-stream"; - } - $HTML::Mason::Commands::r->content_type($type); - open( my $fh, '<', $file ) or die "couldn't open file: $!"; - binmode($fh); - { - local $/ = \16384; - $HTML::Mason::Commands::m->out($_) while (<$fh>); - $HTML::Mason::Commands::m->flush_buffer; - } - close $fh; -} - - - -sub MobileClient { - my $self = shift; - - -if (($ENV{'HTTP_USER_AGENT'} || '') =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60|Mobile)/io && !$HTML::Mason::Commands::session{'NotMobile'}) { - return 1; -} else { - return undef; -} - -} - - -sub StripContent { - my %args = @_; - my $content = $args{Content}; - return '' unless $content; - - # Make the content have no 'weird' newlines in it - $content =~ s/\r+\n/\n/g; - - my $return_content = $content; - - my $html = $args{ContentType} && $args{ContentType} eq "text/html"; - my $sigonly = $args{StripSignature}; - - # massage content to easily detect if there's any real content - $content =~ s/\s+//g; # yes! remove all the spaces - if ( $html ) { - # remove html version of spaces and newlines - $content =~ s! !!g; - $content =~ s!<br/?>!!g; - } - - # Filter empty content when type is text/html - return '' if $html && $content !~ /\S/; - - # If we aren't supposed to strip the sig, just bail now. - return $return_content unless $sigonly; - - # Find the signature - my $sig = $args{'CurrentUser'}->UserObj->Signature || ''; - $sig =~ s/\s+//g; - - # Check for plaintext sig - return '' if not $html and $content =~ /^(--)?\Q$sig\E$/; - - # Check for html-formatted sig; we don't use EscapeUTF8 here - # because we want to precisely match the escapting that FCKEditor - # uses. - $sig =~ s/&/&/g; - $sig =~ s/</</g; - $sig =~ s/>/>/g; - $sig =~ s/"/"/g; - $sig =~ s/'/'/g; - return '' if $html and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s; - - # Pass it through - return $return_content; -} - -sub DecodeARGS { - my $ARGS = shift; - - %{$ARGS} = map { - - # if they've passed multiple values, they'll be an array. if they've - # passed just one, a scalar whatever they are, mark them as utf8 - my $type = ref($_); - ( !$type ) - ? Encode::is_utf8($_) - ? $_ - : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) - : ( $type eq 'ARRAY' ) - ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) } - @$_ ] - : ( $type eq 'HASH' ) - ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) } - %$_ } - : $_ - } %$ARGS; -} - -sub PreprocessTimeUpdates { - my $ARGS = shift; - - # Later in the code we use - # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS ); - # instead of $m->call_next to avoid problems with UTF8 keys in arguments. - # The call_next method pass through original arguments and if you have - # an argument with unicode key then in a next component you'll get two - # records in the args hash: one with key without UTF8 flag and another - # with the flag, which may result into errors. "{ base_comp => $m->request_comp }" - # is copied from mason's source to get the same results as we get from - # call_next method, this feature is not documented, so we just leave it - # here to avoid possible side effects. - - # This code canonicalizes time inputs in hours into minutes - foreach my $field ( keys %$ARGS ) { - next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1}; - my $local = $1; - $ARGS->{$local} =~ s{\b (?: (\d+) \s+ )? (\d+)/(\d+) \b} - {($1 || 0) + $3 ? $2 / $3 : 0}xe; - if ( $ARGS->{$field} && $ARGS->{$field} =~ /hours/i ) { - $ARGS->{$local} *= 60; - } - delete $ARGS->{$field}; - } - -} - -sub MaybeEnableSQLStatementLog { - - my $log_sql_statements = RT->Config->Get('StatementLog'); - - if ($log_sql_statements) { - $RT::Handle->ClearSQLStatementLog; - $RT::Handle->LogSQLStatements(1); - } - -} - -sub LogRecordedSQLStatements { - my %args = @_; - - my $log_sql_statements = RT->Config->Get('StatementLog'); - - return unless ($log_sql_statements); - - my @log = $RT::Handle->SQLStatementLog; - $RT::Handle->ClearSQLStatementLog; - - $RT::Handle->AddRequestToHistory({ - %{ $args{RequestData} }, - Queries => \@log, - }); - - for my $stmt (@log) { - my ( $time, $sql, $bind, $duration ) = @{$stmt}; - my @bind; - if ( ref $bind ) { - @bind = @{$bind}; - } else { - - # Older DBIx-SB - $duration = $bind; - } - $RT::Logger->log( - level => $log_sql_statements, - message => "SQL(" - . sprintf( "%.6f", $duration ) - . "s): $sql;" - . ( @bind ? " [ bound values: @{[map{ defined $_ ? qq|'$_'| : 'undef'} @bind]} ]" : "" ) - ); - } - -} - -my $_has_validated_web_config = 0; -sub ValidateWebConfig { - my $self = shift; - - # do this once per server instance, not once per request - return if $_has_validated_web_config; - $_has_validated_web_config = 1; - - my $port = $ENV{SERVER_PORT}; - my $host = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER} - || $ENV{HTTP_HOST} || $ENV{SERVER_NAME}; - ($host, $port) = ($1, $2) if $host =~ /^(.*?):(\d+)$/; - - if ( $port != RT->Config->Get('WebPort') and not $ENV{'rt.explicit_port'}) { - $RT::Logger->warn("The requested port ($port) does NOT match the configured WebPort ($RT::WebPort). " - ."Perhaps you should Set(\$WebPort, $port); in RT_SiteConfig.pm, " - ."otherwise your internal links may be broken."); - } - - if ( $host ne RT->Config->Get('WebDomain') ) { - $RT::Logger->warn("The requested host ($host) does NOT match the configured WebDomain ($RT::WebDomain). " - ."Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, " - ."otherwise your internal links may be broken."); - } - - return; #next warning flooding our logs, doesn't seem applicable to our use - # (SCRIPT_NAME is the full path, WebPath is just the beginning) - #in vanilla RT does something eat the local part of SCRIPT_NAME 1st? - - # Unfortunately, there is no reliable way to get the _path_ that was - # requested at the proxy level; simply disable this warning if we're - # proxied and there's a mismatch. - my $proxied = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER}; - if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath') and not $proxied) { - $RT::Logger->warn("The requested path ($ENV{SCRIPT_NAME}) does NOT match the configured WebPath ($RT::WebPath). " - ."Perhaps you should Set(\$WebPath, '$ENV{SCRIPT_NAME}'); in RT_SiteConfig.pm, " - ."otherwise your internal links may be broken."); - } -} - -sub ComponentRoots { - my $self = shift; - my %args = ( Names => 0, @_ ); - my @roots; - if (defined $HTML::Mason::Commands::m) { - @roots = $HTML::Mason::Commands::m->interp->comp_root_array; - } else { - @roots = ( - [ local => $RT::MasonLocalComponentRoot ], - (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}), - [ standard => $RT::MasonComponentRoot ] - ); - } - @roots = map { $_->[1] } @roots unless $args{Names}; - return @roots; -} - -our %is_whitelisted_component = ( - # The RSS feed embeds an auth token in the path, but query - # information for the search. Because it's a straight-up read, in - # addition to embedding its own auth, it's fine. - '/NoAuth/rss/dhandler' => 1, - - # While these can be used for denial-of-service against RT - # (construct a very inefficient query and trick lots of users into - # running them against RT) it's incredibly useful to be able to link - # to a search result (or chart) or bookmark a result page. - '/Search/Results.html' => 1, - '/Search/Simple.html' => 1, - '/m/tickets/search' => 1, - '/Search/Chart.html' => 1, - - # This page takes Attachment and Transaction argument to figure - # out what to show, but it's read only and will deny information if you - # don't have ShowOutgoingEmail. - '/Ticket/ShowEmailRecord.html' => 1, -); - -# Components which are blacklisted from automatic, argument-based whitelisting. -# These pages are not idempotent when called with just an id. -our %is_blacklisted_component = ( - # Takes only id and toggles bookmark state - '/Helpers/Toggle/TicketBookmark' => 1, -); - -sub IsCompCSRFWhitelisted { - my $comp = shift; - my $ARGS = shift; - - return 1 if $is_whitelisted_component{$comp}; - - my %args = %{ $ARGS }; - - # If the user specifies a *correct* user and pass then they are - # golden. This acts on the presumption that external forms may - # hardcode a username and password -- if a malicious attacker knew - # both already, CSRF is the least of your problems. - my $AllowLoginCSRF = not RT->Config->Get('RestrictReferrerLogin'); - if ($AllowLoginCSRF and defined($args{user}) and defined($args{pass})) { - my $user_obj = RT::CurrentUser->new(); - $user_obj->Load($args{user}); - return 1 if $user_obj->id && $user_obj->IsPassword($args{pass}); - - delete $args{user}; - delete $args{pass}; - } - - # Some pages aren't idempotent even with safe args like id; blacklist - # them from the automatic whitelisting below. - return 0 if $is_blacklisted_component{$comp}; - - # Eliminate arguments that do not indicate an effectful request. - # For example, "id" is acceptable because that is how RT retrieves a - # record. - delete $args{id}; - - # If they have a results= from MaybeRedirectForResults, that's also fine. - delete $args{results}; - - # The homepage refresh, which uses the Refresh header, doesn't send - # a referer in most browsers; whitelist the one parameter it reloads - # with, HomeRefreshInterval, which is safe - delete $args{HomeRefreshInterval}; - - # The NotMobile flag is fine for any page; it's only used to toggle a flag - # in the session related to which interface you get. - delete $args{NotMobile}; - - # If there are no arguments, then it's likely to be an idempotent - # request, which are not susceptible to CSRF - return 1 if !%args; - - return 0; -} - -sub IsRefererCSRFWhitelisted { - my $referer = _NormalizeHost(shift); - my $base_url = _NormalizeHost(RT->Config->Get('WebBaseURL')); - $base_url = $base_url->host_port; - - my $configs; - for my $config ( $base_url, RT->Config->Get('ReferrerWhitelist') ) { - push @$configs,$config; - - my $host_port = $referer->host_port; - if ($config =~ /\*/) { - # Turn a literal * into a domain component or partial component match. - # Refer to http://tools.ietf.org/html/rfc2818#page-5 - my $regex = join "[a-zA-Z0-9\-]*", - map { quotemeta($_) } - split /\*/, $config; - - return 1 if $host_port =~ /^$regex$/i; - } else { - return 1 if $host_port eq $config; - } - } - - return (0,$referer,$configs); -} - -=head3 _NormalizeHost - -Takes a URI and creates a URI object that's been normalized -to handle common problems such as localhost vs 127.0.0.1 - -=cut - -sub _NormalizeHost { - my $s = shift; - $s = "http://$s" unless $s =~ /^http/i; - my $uri= URI->new($s); - $uri->host('127.0.0.1') if $uri->host eq 'localhost'; - - return $uri; - -} - -sub IsPossibleCSRF { - my $ARGS = shift; - - # If first request on this session is to a REST endpoint, then - # whitelist the REST endpoints -- and explicitly deny non-REST - # endpoints. We do this because using a REST cookie in a browser - # would open the user to CSRF attacks to the REST endpoints. - my $path = $HTML::Mason::Commands::r->path_info; - $HTML::Mason::Commands::session{'REST'} = $path =~ m{^/+REST/\d+\.\d+(/|$)} - unless defined $HTML::Mason::Commands::session{'REST'}; - - if ($HTML::Mason::Commands::session{'REST'}) { - return 0 if $path =~ m{^/+REST/\d+\.\d+(/|$)}; - my $why = <<EOT; -This login session belongs to a REST client, and cannot be used to -access non-REST interfaces of RT for security reasons. -EOT - my $details = <<EOT; -Please log out and back in to obtain a session for normal browsing. If -you understand the security implications, disabling RT's CSRF protection -will remove this restriction. -EOT - chomp $details; - HTML::Mason::Commands::Abort( $why, Details => $details ); - } - - return 0 if IsCompCSRFWhitelisted( - $HTML::Mason::Commands::m->request_comp->path, - $ARGS - ); - - # if there is no Referer header then assume the worst - return (1, - "your browser did not supply a Referrer header", # loc - ) if !$ENV{HTTP_REFERER}; - - my ($whitelisted, $browser, $configs) = IsRefererCSRFWhitelisted($ENV{HTTP_REFERER}); - return 0 if $whitelisted; - - if ( @$configs > 1 ) { - return (1, - "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2]) or whitelisted hosts ([_3])", # loc - $browser->host_port, - shift @$configs, - join(', ', @$configs) ); - } - - return (1, - "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2])", # loc - $browser->host_port, - $configs->[0]); -} - -sub ExpandCSRFToken { - my $ARGS = shift; - - my $token = delete $ARGS->{CSRF_Token}; - return unless $token; - - my $data = $HTML::Mason::Commands::session{'CSRF'}{$token}; - return unless $data; - return unless $data->{path} eq $HTML::Mason::Commands::r->path_info; - - my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj; - return unless $user->ValidateAuthString( $data->{auth}, $token ); - - %{$ARGS} = %{$data->{args}}; - $HTML::Mason::Commands::DECODED_ARGS = $ARGS; - - # We explicitly stored file attachments with the request, but not in - # the session yet, as that would itself be an attack. Put them into - # the session now, so they'll be visible. - if ($data->{attach}) { - my $filename = $data->{attach}{filename}; - my $mime = $data->{attach}{mime}; - $HTML::Mason::Commands::session{'Attachments'}{$filename} - = $mime; - } - - return 1; -} - -sub StoreRequestToken { - my $ARGS = shift; - - my $token = Digest::MD5::md5_hex(time . {} . $$ . rand(1024)); - my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj; - my $data = { - auth => $user->GenerateAuthString( $token ), - path => $HTML::Mason::Commands::r->path_info, - args => $ARGS, - }; - if ($ARGS->{Attach}) { - my $attachment = HTML::Mason::Commands::MakeMIMEEntity( AttachmentFieldName => 'Attach' ); - my $file_path = delete $ARGS->{'Attach'}; - $data->{attach} = { - filename => Encode::decode_utf8("$file_path"), - mime => $attachment, - }; - } - - $HTML::Mason::Commands::session{'CSRF'}->{$token} = $data; - $HTML::Mason::Commands::session{'i'}++; - return $token; -} - -sub MaybeShowInterstitialCSRFPage { - my $ARGS = shift; - - return unless RT->Config->Get('RestrictReferrer'); - - # Deal with the form token provided by the interstitial, which lets - # browsers which never set referer headers still use RT, if - # painfully. This blows values into ARGS - return if ExpandCSRFToken($ARGS); - - my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS); - return if !$is_csrf; - - $RT::Logger->notice("Possible CSRF: ".RT::CurrentUser->new->loc($msg, @loc)); - - my $token = StoreRequestToken($ARGS); - $HTML::Mason::Commands::m->comp( - '/Elements/CSRF', - OriginalURL => RT->Config->Get('WebPath') . $HTML::Mason::Commands::r->path_info, - Reason => HTML::Mason::Commands::loc( $msg, @loc ), - Token => $token, - ); - # Calls abort, never gets here -} - -our @POTENTIAL_PAGE_ACTIONS = ( - qr'/Ticket/Create.html' => "create a ticket", # loc - qr'/Ticket/' => "update a ticket", # loc - qr'/Admin/' => "modify RT's configuration", # loc - qr'/Approval/' => "update an approval", # loc - qr'/Articles/' => "update an article", # loc - qr'/Dashboards/' => "modify a dashboard", # loc - qr'/m/ticket/' => "update a ticket", # loc - qr'Prefs' => "modify your preferences", # loc - qr'/Search/' => "modify or access a search", # loc - qr'/SelfService/Create' => "create a ticket", # loc - qr'/SelfService/' => "update a ticket", # loc -); - -sub PotentialPageAction { - my $page = shift; - my @potentials = @POTENTIAL_PAGE_ACTIONS; - while (my ($pattern, $result) = splice @potentials, 0, 2) { - return HTML::Mason::Commands::loc($result) - if $page =~ $pattern; - } - return ""; -} - -package HTML::Mason::Commands; - -use vars qw/$r $m %session/; - -sub Menu { - return $HTML::Mason::Commands::m->notes('menu'); -} - -sub PageMenu { - return $HTML::Mason::Commands::m->notes('page-menu'); -} - -sub PageWidgets { - return $HTML::Mason::Commands::m->notes('page-widgets'); -} - - - -=head2 loc ARRAY - -loc is a nice clean global routine which calls $session{'CurrentUser'}->loc() -with whatever it's called with. If there is no $session{'CurrentUser'}, -it creates a temporary user, so we have something to get a localisation handle -through - -=cut - -sub loc { - - if ( $session{'CurrentUser'} - && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) ) - { - return ( $session{'CurrentUser'}->loc(@_) ); - } elsif ( - my $u = eval { - RT::CurrentUser->new(); - } - ) - { - return ( $u->loc(@_) ); - } else { - - # pathetic case -- SystemUser is gone. - return $_[0]; - } -} - - - -=head2 loc_fuzzy STRING - -loc_fuzzy is for handling localizations of messages that may already -contain interpolated variables, typically returned from libraries -outside RT's control. It takes the message string and extracts the -variable array automatically by matching against the candidate entries -inside the lexicon file. - -=cut - -sub loc_fuzzy { - my $msg = shift; - - if ( $session{'CurrentUser'} - && UNIVERSAL::can( $session{'CurrentUser'}, 'loc' ) ) - { - return ( $session{'CurrentUser'}->loc_fuzzy($msg) ); - } else { - my $u = RT::CurrentUser->new( RT->SystemUser->Id ); - return ( $u->loc_fuzzy($msg) ); - } -} - - -# Error - calls Error and aborts -sub Abort { - my $why = shift; - my %args = @_; - - if ( $session{'ErrorDocument'} - && $session{'ErrorDocumentType'} ) - { - $r->content_type( $session{'ErrorDocumentType'} ); - $m->comp( $session{'ErrorDocument'}, Why => $why, %args ); - $m->abort; - } else { - $m->comp( "/Elements/Error", Why => $why, %args ); - $m->abort; - } -} - -sub MaybeRedirectForResults { - my %args = ( - Path => $HTML::Mason::Commands::m->request_comp->path, - Arguments => {}, - Anchor => undef, - Actions => undef, - Force => 0, - @_ - ); - my $has_actions = $args{'Actions'} && grep( defined, @{ $args{'Actions'} } ); - return unless $has_actions || $args{'Force'}; - - my %arguments = %{ $args{'Arguments'} }; - - if ( $has_actions ) { - my $key = Digest::MD5::md5_hex( rand(1024) ); - push @{ $session{"Actions"}{ $key } ||= [] }, @{ $args{'Actions'} }; - $session{'i'}++; - $arguments{'results'} = $key; - } - - $args{'Path'} =~ s!^/+!!; - my $url = RT->Config->Get('WebURL') . $args{Path}; - - if ( keys %arguments ) { - $url .= '?'. $m->comp( '/Elements/QueryString', %arguments ); - } - if ( $args{'Anchor'} ) { - $url .= "#". $args{'Anchor'}; - } - return RT::Interface::Web::Redirect($url); -} - -=head2 MaybeRedirectToApproval Path => 'path', Whitelist => REGEX, ARGSRef => HASHREF - -If the ticket specified by C<< $ARGSRef->{id} >> is an approval ticket, -redirect to the approvals display page, preserving any arguments. - -C<Path>s matching C<Whitelist> are let through. - -This is a no-op if the C<ForceApprovalsView> option isn't enabled. - -=cut - -sub MaybeRedirectToApproval { - my %args = ( - Path => $HTML::Mason::Commands::m->request_comp->path, - ARGSRef => {}, - Whitelist => undef, - @_ - ); - - return unless $ENV{REQUEST_METHOD} eq 'GET'; - - my $id = $args{ARGSRef}->{id}; - - if ( $id - and RT->Config->Get('ForceApprovalsView') - and not $args{Path} =~ /$args{Whitelist}/) - { - my $ticket = RT::Ticket->new( $session{'CurrentUser'} ); - $ticket->Load($id); - - if ($ticket and $ticket->id and lc($ticket->Type) eq 'approval') { - MaybeRedirectForResults( - Path => "/Approvals/Display.html", - Force => 1, - Anchor => $args{ARGSRef}->{Anchor}, - Arguments => $args{ARGSRef}, - ); - } - } -} - -=head2 CreateTicket ARGS - -Create a new ticket, using Mason's %ARGS. returns @results. - -=cut - -sub CreateTicket { - my %ARGS = (@_); - - my (@Actions); - - my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); - - my $Queue = RT::Queue->new( $session{'CurrentUser'} ); - unless ( $Queue->Load( $ARGS{'Queue'} ) ) { - Abort('Queue not found'); - } - - unless ( $Queue->CurrentUserHasRight('CreateTicket') ) { - Abort('You have no permission to create tickets in that queue.'); - } - - my $due; - if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) { - $due = RT::Date->new( $session{'CurrentUser'} ); - $due->Set( Format => 'unknown', Value => $ARGS{'Due'} ); - } - my $starts; - if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) { - $starts = RT::Date->new( $session{'CurrentUser'} ); - $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} ); - } - - my $sigless = RT::Interface::Web::StripContent( - Content => $ARGS{Content}, - ContentType => $ARGS{ContentType}, - StripSignature => 1, - CurrentUser => $session{'CurrentUser'}, - ); - - my $MIMEObj = MakeMIMEEntity( - Subject => $ARGS{'Subject'}, - From => $ARGS{'From'}, - Cc => $ARGS{'Cc'}, - Body => $sigless, - Type => $ARGS{'ContentType'}, - Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', - ); - - if ( $ARGS{'Attachments'} ) { - my $rv = $MIMEObj->make_multipart; - $RT::Logger->error("Couldn't make multipart message") - if !$rv || $rv !~ /^(?:DONE|ALREADY)$/; - - foreach ( map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} } ) { - unless ($_) { - $RT::Logger->error("Couldn't add empty attachemnt"); - next; - } - $MIMEObj->add_part($_); - } - } - - for my $argument (qw(Encrypt Sign)) { - $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ); - } - - my %create_args = ( - Type => $ARGS{'Type'} || 'ticket', - Queue => $ARGS{'Queue'}, - Owner => $ARGS{'Owner'}, - - # note: name change - Requestor => $ARGS{'Requestors'}, - Cc => $ARGS{'Cc'}, - AdminCc => $ARGS{'AdminCc'}, - InitialPriority => $ARGS{'InitialPriority'}, - FinalPriority => $ARGS{'FinalPriority'}, - TimeLeft => $ARGS{'TimeLeft'}, - TimeEstimated => $ARGS{'TimeEstimated'}, - TimeWorked => $ARGS{'TimeWorked'}, - Subject => $ARGS{'Subject'}, - Status => $ARGS{'Status'}, - Due => $due ? $due->ISO : undef, - Starts => $starts ? $starts->ISO : undef, - MIMEObj => $MIMEObj - ); - - my @txn_squelch; - foreach my $type (qw(Requestor Cc AdminCc)) { - push @txn_squelch, map $_->address, Email::Address->parse( $create_args{$type} ) - if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] }; - } - $create_args{TransSquelchMailTo} = \@txn_squelch - if @txn_squelch; - - if ( $ARGS{'AttachTickets'} ) { - require RT::Action::SendEmail; - RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets, - ref $ARGS{'AttachTickets'} - ? @{ $ARGS{'AttachTickets'} } - : ( $ARGS{'AttachTickets'} ) ); - } - - foreach my $arg ( keys %ARGS ) { - next if $arg =~ /-(?:Magic|Category)$/; - - if ( $arg =~ /^Object-RT::Transaction--CustomField-/ ) { - $create_args{$arg} = $ARGS{$arg}; - } - - # Object-RT::Ticket--CustomField-3-Values - elsif ( $arg =~ /^Object-RT::Ticket--CustomField-(\d+)/ ) { - my $cfid = $1; - - my $cf = RT::CustomField->new( $session{'CurrentUser'} ); - $cf->SetContextObject( $Queue ); - $cf->Load($cfid); - unless ( $cf->id ) { - $RT::Logger->error( "Couldn't load custom field #" . $cfid ); - next; - } - - if ( $arg =~ /-Upload$/ ) { - $create_args{"CustomField-$cfid"} = _UploadedFile($arg); - next; - } - - my $type = $cf->Type; - - my @values = (); - if ( ref $ARGS{$arg} eq 'ARRAY' ) { - @values = @{ $ARGS{$arg} }; - } elsif ( $type =~ /text/i ) { - @values = ( $ARGS{$arg} ); - } else { - no warnings 'uninitialized'; - @values = split /\r*\n/, $ARGS{$arg}; - } - @values = grep length, map { - s/\r+\n/\n/g; - s/^\s+//; - s/\s+$//; - $_; - } - grep defined, @values; - - $create_args{"CustomField-$cfid"} = \@values; - } - } - - # turn new link lists into arrays, and pass in the proper arguments - my %map = ( - 'new-DependsOn' => 'DependsOn', - 'DependsOn-new' => 'DependedOnBy', - 'new-MemberOf' => 'Parents', - 'MemberOf-new' => 'Children', - 'new-RefersTo' => 'RefersTo', - 'RefersTo-new' => 'ReferredToBy', - ); - foreach my $key ( keys %map ) { - next unless $ARGS{$key}; - $create_args{ $map{$key} } = [ grep $_, split ' ', $ARGS{$key} ]; - - } - - my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args); - unless ($id) { - Abort($ErrMsg); - } - - push( @Actions, split( "\n", $ErrMsg ) ); - unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) { - Abort( "No permission to view newly created ticket #" . $Ticket->id . "." ); - } - return ( $Ticket, @Actions ); - -} - - - -=head2 LoadTicket id - -Takes a ticket id as its only variable. if it's handed an array, it takes -the first value. - -Returns an RT::Ticket object as the current user. - -=cut - -sub LoadTicket { - my $id = shift; - - if ( ref($id) eq "ARRAY" ) { - $id = $id->[0]; - } - - unless ($id) { - Abort("No ticket specified"); - } - - my $Ticket = RT::Ticket->new( $session{'CurrentUser'} ); - $Ticket->Load($id); - unless ( $Ticket->id ) { - Abort("Could not load ticket $id"); - } - return $Ticket; -} - - - -=head2 ProcessUpdateMessage - -Takes paramhash with fields ARGSRef, TicketObj and SkipSignatureOnly. - -Don't write message if it only contains current user's signature and -SkipSignatureOnly argument is true. Function anyway adds attachments -and updates time worked field even if skips message. The default value -is true. - -=cut - -# change from stock: if txn custom fields are set but there's no content -# or attachment, create a Touch txn instead of doing nothing - -sub ProcessUpdateMessage { - - my %args = ( - ARGSRef => undef, - TicketObj => undef, - SkipSignatureOnly => 1, - @_ - ); - - if ( $args{ARGSRef}->{'UpdateAttachments'} - && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } ) - { - delete $args{ARGSRef}->{'UpdateAttachments'}; - } - - # Strip the signature - $args{ARGSRef}->{UpdateContent} = RT::Interface::Web::StripContent( - Content => $args{ARGSRef}->{UpdateContent}, - ContentType => $args{ARGSRef}->{UpdateContentType}, - StripSignature => $args{SkipSignatureOnly}, - CurrentUser => $args{'TicketObj'}->CurrentUser, - ); - - my %txn_customfields; - - foreach my $key ( keys %{ $args{ARGSRef} } ) { - if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) { - next if $key =~ /(TimeUnits|Magic)$/; - $txn_customfields{$key} = $args{ARGSRef}->{$key}; - } - } - - # If, after stripping the signature, we have no message, create a - # Touch transaction if necessary - if ( not $args{ARGSRef}->{'UpdateAttachments'} - and not length $args{ARGSRef}->{'UpdateContent'} ) - { - #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) { - # $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + - # delete $args{ARGSRef}->{'UpdateTimeWorked'}; - # } - - my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'}; - if ( $timetaken or grep {length $_} values %txn_customfields ) { - my ( $Transaction, $Description, $Object ) = - $args{TicketObj}->Touch( - CustomFields => \%txn_customfields, - TimeTaken => $timetaken - ); - return $Description; - } - return; - } - - if ( $args{ARGSRef}->{'UpdateSubject'} eq ($args{'TicketObj'}->Subject || '') ) { - $args{ARGSRef}->{'UpdateSubject'} = undef; - } - - my $Message = MakeMIMEEntity( - Subject => $args{ARGSRef}->{'UpdateSubject'}, - Body => $args{ARGSRef}->{'UpdateContent'}, - Type => $args{ARGSRef}->{'UpdateContentType'}, - Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', - ); - - $Message->head->replace( 'Message-ID' => Encode::encode_utf8( - RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} ) - ) ); - my $old_txn = RT::Transaction->new( $session{'CurrentUser'} ); - if ( $args{ARGSRef}->{'QuoteTransaction'} ) { - $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} ); - } else { - $old_txn = $args{TicketObj}->Transactions->First(); - } - - if ( my $msg = $old_txn->Message->First ) { - RT::Interface::Email::SetInReplyTo( - Message => $Message, - InReplyTo => $msg - ); - } - - if ( $args{ARGSRef}->{'UpdateAttachments'} ) { - $Message->make_multipart; - $Message->add_part($_) foreach map $args{ARGSRef}->{UpdateAttachments}{$_}, - sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} }; - } - - if ( $args{ARGSRef}->{'AttachTickets'} ) { - require RT::Action::SendEmail; - RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets, - ref $args{ARGSRef}->{'AttachTickets'} - ? @{ $args{ARGSRef}->{'AttachTickets'} } - : ( $args{ARGSRef}->{'AttachTickets'} ) ); - } - - my %message_args = ( - Sign => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ), - Encrypt => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ), - MIMEObj => $Message, - TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}, - CustomFields => \%txn_customfields, - ); - - _ProcessUpdateMessageRecipients( - MessageArgs => \%message_args, - %args, - ); - - my @results; - if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) { - my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args); - push( @results, $Description ); - $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object; - } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) { - my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args); - push( @results, $Description ); - $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object; - } else { - push( @results, - loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") ); - } - return @results; -} - -sub _ProcessUpdateMessageRecipients { - my %args = ( - ARGSRef => undef, - TicketObj => undef, - MessageArgs => undef, - @_, - ); - - my $bcc = $args{ARGSRef}->{'UpdateBcc'}; - my $cc = $args{ARGSRef}->{'UpdateCc'}; - - my $message_args = $args{MessageArgs}; - - $message_args->{CcMessageTo} = $cc; - $message_args->{BccMessageTo} = $bcc; - - my @txn_squelch; - foreach my $type (qw(Cc AdminCc)) { - if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) { - push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{$type} ); - push @txn_squelch, $args{TicketObj}->$type->MemberEmailAddresses; - push @txn_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses; - } - } - if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) { - push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} ); - push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses; - } - - push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo}; - $message_args->{SquelchMailTo} = \@txn_squelch - if @txn_squelch; - - unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) { - foreach my $key ( keys %{ $args{ARGSRef} } ) { - next unless $key =~ /^Update(Cc|Bcc)-(.*)$/; - - my $var = ucfirst($1) . 'MessageTo'; - my $value = $2; - if ( $message_args->{$var} ) { - $message_args->{$var} .= ", $value"; - } else { - $message_args->{$var} = $value; - } - } - } -} - -sub ProcessAttachments { - my %args = ( - ARGSRef => {}, - @_ - ); - - my $ARGSRef = $args{ARGSRef} || {}; - # deal with deleting uploaded attachments - foreach my $key ( keys %$ARGSRef ) { - if ( $key =~ m/^DeleteAttach-(.+)$/ ) { - delete $session{'Attachments'}{$1}; - } - $session{'Attachments'} = { %{ $session{'Attachments'} || {} } }; - } - - # store the uploaded attachment in session - if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} ) - { # attachment? - my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' ); - - my $file_path = Encode::decode_utf8("$ARGSRef->{'Attach'}"); - $session{'Attachments'} = - { %{ $session{'Attachments'} || {} }, $file_path => $attachment, }; - } - - # delete temporary storage entry to make WebUI clean - unless ( keys %{ $session{'Attachments'} } and $ARGSRef->{'UpdateAttach'} ) - { - delete $session{'Attachments'}; - } -} - - -=head2 MakeMIMEEntity PARAMHASH - -Takes a paramhash Subject, Body and AttachmentFieldName. - -Also takes Form, Cc and Type as optional paramhash keys. - - Returns a MIME::Entity. - -=cut - -sub MakeMIMEEntity { - - #TODO document what else this takes. - my %args = ( - Subject => undef, - From => undef, - Cc => undef, - Body => undef, - AttachmentFieldName => undef, - Type => undef, - Interface => 'API', - @_, - ); - my $Message = MIME::Entity->build( - Type => 'multipart/mixed', - "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ), - "X-RT-Interface" => $args{Interface}, - map { $_ => Encode::encode_utf8( $args{ $_} ) } - grep defined $args{$_}, qw(Subject From Cc) - ); - - if ( defined $args{'Body'} && length $args{'Body'} ) { - - # Make the update content have no 'weird' newlines in it - $args{'Body'} =~ s/\r\n/\n/gs; - - $Message->attach( - Type => $args{'Type'} || 'text/plain', - Charset => 'UTF-8', - Data => $args{'Body'}, - ); - } - - if ( $args{'AttachmentFieldName'} ) { - - my $cgi_object = $m->cgi_object; - my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ); - if ( defined $filehandle && length $filehandle ) { - - my ( @content, $buffer ); - while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) { - push @content, $buffer; - } - - my $uploadinfo = $cgi_object->uploadInfo($filehandle); - - my $filename = "$filehandle"; - $filename =~ s{^.*[\\/]}{}; - - $Message->attach( - Type => $uploadinfo->{'Content-Type'}, - Filename => $filename, - Data => \@content, - ); - if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) { - $Message->head->set( 'Subject' => $filename ); - } - - # Attachment parts really shouldn't get a Message-ID or "interface" - $Message->head->delete('Message-ID'); - $Message->head->delete('X-RT-Interface'); - } - } - - $Message->make_singlepart; - - RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8 - - return ($Message); - -} - - - -=head2 ParseDateToISO - -Takes a date in an arbitrary format. -Returns an ISO date and time in GMT - -=cut - -sub ParseDateToISO { - my $date = shift; - - my $date_obj = RT::Date->new( $session{'CurrentUser'} ); - $date_obj->Set( - Format => 'unknown', - Value => $date - ); - return ( $date_obj->ISO ); -} - - - -sub ProcessACLChanges { - my $ARGSref = shift; - - my @results; - - foreach my $arg ( keys %$ARGSref ) { - next unless ( $arg =~ /^(GrantRight|RevokeRight)-(\d+)-(.+?)-(\d+)$/ ); - - my ( $method, $principal_id, $object_type, $object_id ) = ( $1, $2, $3, $4 ); - - my @rights; - if ( UNIVERSAL::isa( $ARGSref->{$arg}, 'ARRAY' ) ) { - @rights = @{ $ARGSref->{$arg} }; - } else { - @rights = $ARGSref->{$arg}; - } - @rights = grep $_, @rights; - next unless @rights; - - my $principal = RT::Principal->new( $session{'CurrentUser'} ); - $principal->Load($principal_id); - - my $obj; - if ( $object_type eq 'RT::System' ) { - $obj = $RT::System; - } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) { - $obj = $object_type->new( $session{'CurrentUser'} ); - $obj->Load($object_id); - unless ( $obj->id ) { - $RT::Logger->error("couldn't load $object_type #$object_id"); - next; - } - } else { - $RT::Logger->error("object type '$object_type' is incorrect"); - push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) ); - next; - } - - foreach my $right (@rights) { - my ( $val, $msg ) = $principal->$method( Object => $obj, Right => $right ); - push( @results, $msg ); - } - } - - return (@results); -} - - -=head2 ProcessACLs - -ProcessACLs expects values from a series of checkboxes that describe the full -set of rights a principal should have on an object. - -It expects form inputs with names like SetRights-PrincipalId-ObjType-ObjId -instead of with the prefixes Grant/RevokeRight. Each input should be an array -listing the rights the principal should have, and ProcessACLs will modify the -current rights to match. Additionally, the previously unused CheckACL input -listing PrincipalId-ObjType-ObjId is now used to catch cases when all the -rights are removed from a principal and as such no SetRights input is -submitted. - -=cut - -sub ProcessACLs { - my $ARGSref = shift; - my (%state, @results); - - my $CheckACL = $ARGSref->{'CheckACL'}; - my @check = grep { defined } (ref $CheckACL eq 'ARRAY' ? @$CheckACL : $CheckACL); - - # Check if we want to grant rights to a previously rights-less user - for my $type (qw(user group)) { - my $principal = _ParseACLNewPrincipal($ARGSref, $type) - or next; - - unless ($principal->PrincipalId) { - push @results, loc("Couldn't load the specified principal"); - next; - } - - my $principal_id = $principal->PrincipalId; - - # Turn our addprincipal rights spec into a real one - for my $arg (keys %$ARGSref) { - next unless $arg =~ /^SetRights-addprincipal-(.+?-\d+)$/; - - my $tuple = "$principal_id-$1"; - my $key = "SetRights-$tuple"; - - # If we have it already, that's odd, but merge them - if (grep { $_ eq $tuple } @check) { - $ARGSref->{$key} = [ - (ref $ARGSref->{$key} eq 'ARRAY' ? @{$ARGSref->{$key}} : $ARGSref->{$key}), - (ref $ARGSref->{$arg} eq 'ARRAY' ? @{$ARGSref->{$arg}} : $ARGSref->{$arg}), - ]; - } else { - $ARGSref->{$key} = $ARGSref->{$arg}; - push @check, $tuple; - } - } - } - - # Build our rights state for each Principal-Object tuple - foreach my $arg ( keys %$ARGSref ) { - next unless $arg =~ /^SetRights-(\d+-.+?-\d+)$/; - - my $tuple = $1; - my $value = $ARGSref->{$arg}; - my @rights = grep { $_ } (ref $value eq 'ARRAY' ? @$value : $value); - next unless @rights; - - $state{$tuple} = { map { $_ => 1 } @rights }; - } - - foreach my $tuple (List::MoreUtils::uniq @check) { - next unless $tuple =~ /^(\d+)-(.+?)-(\d+)$/; - - my ( $principal_id, $object_type, $object_id ) = ( $1, $2, $3 ); - - my $principal = RT::Principal->new( $session{'CurrentUser'} ); - $principal->Load($principal_id); - - my $obj; - if ( $object_type eq 'RT::System' ) { - $obj = $RT::System; - } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) { - $obj = $object_type->new( $session{'CurrentUser'} ); - $obj->Load($object_id); - unless ( $obj->id ) { - $RT::Logger->error("couldn't load $object_type #$object_id"); - next; - } - } else { - $RT::Logger->error("object type '$object_type' is incorrect"); - push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) ); - next; - } - - my $acls = RT::ACL->new($session{'CurrentUser'}); - $acls->LimitToObject( $obj ); - $acls->LimitToPrincipal( Id => $principal_id ); - - while ( my $ace = $acls->Next ) { - my $right = $ace->RightName; - - # Has right and should have right - next if delete $state{$tuple}->{$right}; - - # Has right and shouldn't have right - my ($val, $msg) = $principal->RevokeRight( Object => $obj, Right => $right ); - push @results, $msg; - } - - # For everything left, they don't have the right but they should - for my $right (keys %{ $state{$tuple} || {} }) { - delete $state{$tuple}->{$right}; - my ($val, $msg) = $principal->GrantRight( Object => $obj, Right => $right ); - push @results, $msg; - } - - # Check our state for leftovers - if ( keys %{ $state{$tuple} || {} } ) { - my $missed = join '|', %{$state{$tuple} || {}}; - $RT::Logger->warn( - "Uh-oh, it looks like we somehow missed a right in " - ."ProcessACLs. Here's what was leftover: $missed" - ); - } - } - - return (@results); -} - -=head2 _ParseACLNewPrincipal - -Takes a hashref of C<%ARGS> and a principal type (C<user> or C<group>). Looks -for the presence of rights being added on a principal of the specified type, -and returns undef if no new principal is being granted rights. Otherwise loads -up an L<RT::User> or L<RT::Group> object and returns it. Note that the object -may not be successfully loaded, and you should check C<->id> yourself. - -=cut - -sub _ParseACLNewPrincipal { - my $ARGSref = shift; - my $type = lc shift; - my $key = "AddPrincipalForRights-$type"; - - return unless $ARGSref->{$key}; - - my $principal; - if ( $type eq 'user' ) { - $principal = RT::User->new( $session{'CurrentUser'} ); - $principal->LoadByCol( Name => $ARGSref->{$key} ); - } - elsif ( $type eq 'group' ) { - $principal = RT::Group->new( $session{'CurrentUser'} ); - $principal->LoadUserDefinedGroup( $ARGSref->{$key} ); - } - return $principal; -} - - -=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs) - -@attribs is a list of ticket fields to check and update if they differ from the B<Object>'s current values. ARGSRef is a ref to HTML::Mason's %ARGS. - -Returns an array of success/failure messages - -=cut - -sub UpdateRecordObject { - my %args = ( - ARGSRef => undef, - AttributesRef => undef, - Object => undef, - AttributePrefix => undef, - @_ - ); - - my $Object = $args{'Object'}; - my @results = $Object->Update( - AttributesRef => $args{'AttributesRef'}, - ARGSRef => $args{'ARGSRef'}, - AttributePrefix => $args{'AttributePrefix'}, - ); - - return (@results); -} - - - -sub ProcessCustomFieldUpdates { - my %args = ( - CustomFieldObj => undef, - ARGSRef => undef, - @_ - ); - - my $Object = $args{'CustomFieldObj'}; - my $ARGSRef = $args{'ARGSRef'}; - - my @attribs = qw(Name Type Description Queue SortOrder); - my @results = UpdateRecordObject( - AttributesRef => \@attribs, - Object => $Object, - ARGSRef => $ARGSRef - ); - - my $prefix = "CustomField-" . $Object->Id; - if ( $ARGSRef->{"$prefix-AddValue-Name"} ) { - my ( $addval, $addmsg ) = $Object->AddValue( - Name => $ARGSRef->{"$prefix-AddValue-Name"}, - Description => $ARGSRef->{"$prefix-AddValue-Description"}, - SortOrder => $ARGSRef->{"$prefix-AddValue-SortOrder"}, - ); - push( @results, $addmsg ); - } - - my @delete_values - = ( ref $ARGSRef->{"$prefix-DeleteValue"} eq 'ARRAY' ) - ? @{ $ARGSRef->{"$prefix-DeleteValue"} } - : ( $ARGSRef->{"$prefix-DeleteValue"} ); - - foreach my $id (@delete_values) { - next unless defined $id; - my ( $err, $msg ) = $Object->DeleteValue($id); - push( @results, $msg ); - } - - my $vals = $Object->Values(); - while ( my $cfv = $vals->Next() ) { - if ( my $so = $ARGSRef->{ "$prefix-SortOrder" . $cfv->Id } ) { - if ( $cfv->SortOrder != $so ) { - my ( $err, $msg ) = $cfv->SetSortOrder($so); - push( @results, $msg ); - } - } - } - - return (@results); -} - - - -=head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS ); - -Returns an array of results messages. - -=cut - -sub ProcessTicketBasics { - - my %args = ( - TicketObj => undef, - ARGSRef => undef, - @_ - ); - - my $TicketObj = $args{'TicketObj'}; - my $ARGSRef = $args{'ARGSRef'}; - - my $OrigOwner = $TicketObj->Owner; - - # Set basic fields - my @attribs = qw( - Subject - FinalPriority - Priority - TimeEstimated - TimeWorked - TimeLeft - Type - Status - Queue - ); - - # Canonicalize Queue and Owner to their IDs if they aren't numeric - for my $field (qw(Queue Owner)) { - if ( $ARGSRef->{$field} and ( $ARGSRef->{$field} !~ /^(\d+)$/ ) ) { - my $class = $field eq 'Owner' ? "RT::User" : "RT::$field"; - my $temp = $class->new(RT->SystemUser); - $temp->Load( $ARGSRef->{$field} ); - if ( $temp->id ) { - $ARGSRef->{$field} = $temp->id; - } - } - } - - # Status isn't a field that can be set to a null value. - # RT core complains if you try - delete $ARGSRef->{'Status'} unless $ARGSRef->{'Status'}; - - my @results = UpdateRecordObject( - AttributesRef => \@attribs, - Object => $TicketObj, - ARGSRef => $ARGSRef, - ); - - # We special case owner changing, so we can use ForceOwnerChange - if ( $ARGSRef->{'Owner'} - && $ARGSRef->{'Owner'} !~ /\D/ - && ( $OrigOwner != $ARGSRef->{'Owner'} ) ) { - my ($ChownType); - if ( $ARGSRef->{'ForceOwnerChange'} ) { - $ChownType = "Force"; - } - else { - $ChownType = "Set"; - } - - my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType ); - push( @results, $msg ); - } - - # }}} - - return (@results); -} - -sub ProcessTicketReminders { - my %args = ( - TicketObj => undef, - ARGSRef => undef, - @_ - ); - - my $Ticket = $args{'TicketObj'}; - my $args = $args{'ARGSRef'}; - my @results; - - my $reminder_collection = $Ticket->Reminders->Collection; - - if ( $args->{'update-reminders'} ) { - while ( my $reminder = $reminder_collection->Next ) { - my $resolve_status = $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve; - if ( $reminder->Status ne $resolve_status && $args->{ 'Complete-Reminder-' . $reminder->id } ) { - my ($status, $msg) = $Ticket->Reminders->Resolve($reminder); - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); - - } - elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) { - my ($status, $msg) = $Ticket->Reminders->Open($reminder); - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); - } - - if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) { - my ($status, $msg) = $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ; - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); - } - - if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) { - my ($status, $msg) = $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ; - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); - } - - if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) { - my $DateObj = RT::Date->new( $session{'CurrentUser'} ); - $DateObj->Set( - Format => 'unknown', - Value => $args->{ 'Reminder-Due-' . $reminder->id } - ); - if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) { - my ($status, $msg) = $reminder->SetDue( $DateObj->ISO ); - push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); - } - } - } - } - - if ( $args->{'NewReminder-Subject'} ) { - my $due_obj = RT::Date->new( $session{'CurrentUser'} ); - $due_obj->Set( - Format => 'unknown', - Value => $args->{'NewReminder-Due'} - ); - my ( $add_id, $msg ) = $Ticket->Reminders->Add( - Subject => $args->{'NewReminder-Subject'}, - Owner => $args->{'NewReminder-Owner'}, - Due => $due_obj->ISO - ); - if ( $add_id ) { - push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'}); - } - else { - push @results, $msg; - } - } - return @results; -} - -sub ProcessTicketCustomFieldUpdates { - my %args = @_; - $args{'Object'} = delete $args{'TicketObj'}; - my $ARGSRef = { %{ $args{'ARGSRef'} } }; - - # Build up a list of objects that we want to work with - my %custom_fields_to_mod; - foreach my $arg ( keys %$ARGSRef ) { - if ( $arg =~ /^Ticket-(\d+-.*)/ ) { - $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg}; - } elsif ( $arg =~ /^CustomField-(\d+-.*)/ ) { - $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg}; - } elsif ( $arg =~ /^Object-RT::Transaction-(\d*)-CustomField/ ) { - delete $ARGSRef->{$arg}; # don't try to update transaction fields - } - } - - return ProcessObjectCustomFieldUpdates( %args, ARGSRef => $ARGSRef ); -} - -sub ProcessObjectCustomFieldUpdates { - my %args = @_; - my $ARGSRef = $args{'ARGSRef'}; - my @results; - - # Build up a list of objects that we want to work with - my %custom_fields_to_mod; - foreach my $arg ( keys %$ARGSRef ) { - - # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands> - next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/; - - # For each of those objects, find out what custom fields we want to work with. - $custom_fields_to_mod{$1}{ $2 || 0 }{$3}{$4} = $ARGSRef->{$arg}; - } - - # For each of those objects - foreach my $class ( keys %custom_fields_to_mod ) { - foreach my $id ( keys %{ $custom_fields_to_mod{$class} } ) { - my $Object = $args{'Object'}; - $Object = $class->new( $session{'CurrentUser'} ) - unless $Object && ref $Object eq $class; - - $Object->Load($id) unless ( $Object->id || 0 ) == $id; - unless ( $Object->id ) { - $RT::Logger->warning("Couldn't load object $class #$id"); - next; - } - - foreach my $cf ( keys %{ $custom_fields_to_mod{$class}{$id} } ) { - my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} ); - $CustomFieldObj->SetContextObject($Object); - $CustomFieldObj->LoadById($cf); - unless ( $CustomFieldObj->id ) { - $RT::Logger->warning("Couldn't load custom field #$cf"); - next; - } - push @results, - _ProcessObjectCustomFieldUpdates( - Prefix => "Object-$class-$id-CustomField-$cf-", - Object => $Object, - CustomField => $CustomFieldObj, - ARGS => $custom_fields_to_mod{$class}{$id}{$cf}, - ); - } - } - } - return @results; -} - -sub _ProcessObjectCustomFieldUpdates { - my %args = @_; - my $cf = $args{'CustomField'}; - my $cf_type = $cf->Type || ''; - - # Remove blank Values since the magic field will take care of this. Sometimes - # the browser gives you a blank value which causes CFs to be processed twice - if ( defined $args{'ARGS'}->{'Values'} - && !length $args{'ARGS'}->{'Values'} - && $args{'ARGS'}->{'Values-Magic'} ) - { - delete $args{'ARGS'}->{'Values'}; - } - - my @results; - foreach my $arg ( keys %{ $args{'ARGS'} } ) { - - # skip category argument - next if $arg eq 'Category'; - - # and TimeUnits - next if $arg eq 'Value-TimeUnits'; - - # since http won't pass in a form element with a null value, we need - # to fake it - if ( $arg eq 'Values-Magic' ) { - - # We don't care about the magic, if there's really a values element; - next if defined $args{'ARGS'}->{'Value'} && length $args{'ARGS'}->{'Value'}; - next if defined $args{'ARGS'}->{'Values'} && length $args{'ARGS'}->{'Values'}; - - # "Empty" values does not mean anything for Image and Binary fields - next if $cf_type =~ /^(?:Image|Binary)$/; - - $arg = 'Values'; - $args{'ARGS'}->{'Values'} = undef; - } - - my @values = (); - if ( ref $args{'ARGS'}->{$arg} eq 'ARRAY' ) { - @values = @{ $args{'ARGS'}->{$arg} }; - } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext - @values = ( $args{'ARGS'}->{$arg} ); - } else { - @values = split /\r*\n/, $args{'ARGS'}->{$arg} - if defined $args{'ARGS'}->{$arg}; - } - @values = grep length, map { - s/\r+\n/\n/g; - s/^\s+//; - s/\s+$//; - $_; - } - grep defined, @values; - - if ( $arg eq 'AddValue' || $arg eq 'Value' ) { - foreach my $value (@values) { - my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( - Field => $cf->id, - Value => $value - ); - push( @results, $msg ); - } - } elsif ( $arg eq 'Upload' ) { - my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next; - my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( %$value_hash, Field => $cf, ); - push( @results, $msg ); - } elsif ( $arg eq 'DeleteValues' ) { - foreach my $value (@values) { - my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue( - Field => $cf, - Value => $value, - ); - push( @results, $msg ); - } - } elsif ( $arg eq 'DeleteValueIds' ) { - foreach my $value (@values) { - my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue( - Field => $cf, - ValueId => $value, - ); - push( @results, $msg ); - } - } elsif ( $arg eq 'Values' && !$cf->Repeated ) { - my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id ); - - my %values_hash; - foreach my $value (@values) { - if ( my $entry = $cf_values->HasEntry($value) ) { - $values_hash{ $entry->id } = 1; - next; - } - - my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( - Field => $cf, - Value => $value - ); - push( @results, $msg ); - $values_hash{$val} = 1 if $val; - } - - # For Date Cfs, @values is empty when there is no changes (no datas in form input) - return @results if ( $cf->Type eq 'Date' && ! @values ); - - # For Date Cfs, @values is empty when there is no changes (no datas in form input) - return @results if ( $cf->Type =~ /^Date(?:Time)?$/ && ! @values ); - - $cf_values->RedoSearch; - while ( my $cf_value = $cf_values->Next ) { - next if $values_hash{ $cf_value->id }; - - my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue( - Field => $cf, - ValueId => $cf_value->id - ); - push( @results, $msg ); - } - } elsif ( $arg eq 'Values' ) { - my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id ); - - # keep everything up to the point of difference, delete the rest - my $delete_flag; - foreach my $old_cf ( @{ $cf_values->ItemsArrayRef } ) { - if ( !$delete_flag and @values and $old_cf->Content eq $values[0] ) { - shift @values; - next; - } - - $delete_flag ||= 1; - $old_cf->Delete; - } - - # now add/replace extra things, if any - foreach my $value (@values) { - my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue( - Field => $cf, - Value => $value - ); - push( @results, $msg ); - } - } else { - push( - @results, - loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]", - $cf->Name, ref $args{'Object'}, - $args{'Object'}->id - ) - ); - } - } - return @results; -} - - -=head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS ); - -Returns an array of results messages. - -=cut - -sub ProcessTicketWatchers { - my %args = ( - TicketObj => undef, - ARGSRef => undef, - @_ - ); - my (@results); - - my $Ticket = $args{'TicketObj'}; - my $ARGSRef = $args{'ARGSRef'}; - - # Munge watchers - - foreach my $key ( keys %$ARGSRef ) { - - # Delete deletable watchers - if ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) { - my ( $code, $msg ) = $Ticket->DeleteWatcher( - PrincipalId => $2, - Type => $1 - ); - push @results, $msg; - } - - # Delete watchers in the simple style demanded by the bulk manipulator - elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) { - my ( $code, $msg ) = $Ticket->DeleteWatcher( - Email => $ARGSRef->{$key}, - Type => $1 - ); - push @results, $msg; - } - - # Add new wathchers by email address - elsif ( ( $ARGSRef->{$key} || '' ) =~ /^(?:AdminCc|Cc|Requestor)$/ - and $key =~ /^WatcherTypeEmail(\d*)$/ ) - { - - #They're in this order because otherwise $1 gets clobbered :/ - my ( $code, $msg ) = $Ticket->AddWatcher( - Type => $ARGSRef->{$key}, - Email => $ARGSRef->{ "WatcherAddressEmail" . $1 } - ); - push @results, $msg; - } - - #Add requestors in the simple style demanded by the bulk manipulator - elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) { - my ( $code, $msg ) = $Ticket->AddWatcher( - Type => $1, - Email => $ARGSRef->{$key} - ); - push @results, $msg; - } - - # Add new watchers by owner - elsif ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) { - my $principal_id = $1; - my $form = $ARGSRef->{$key}; - foreach my $value ( ref($form) ? @{$form} : ($form) ) { - next unless $value =~ /^(?:AdminCc|Cc|Requestor)$/i; - - my ( $code, $msg ) = $Ticket->AddWatcher( - Type => $value, - PrincipalId => $principal_id - ); - push @results, $msg; - } - } - - } - return (@results); -} - - - -=head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS ); - -Returns an array of results messages. - -=cut - -sub ProcessTicketDates { - my %args = ( - TicketObj => undef, - ARGSRef => undef, - @_ - ); - - my $Ticket = $args{'TicketObj'}; - my $ARGSRef = $args{'ARGSRef'}; - - my (@results); - - # Set date fields - my @date_fields = qw( - Told - Resolved - Starts - Started - Due - WillResolve - ); - - #Run through each field in this list. update the value if apropriate - foreach my $field (@date_fields) { - next unless exists $ARGSRef->{ $field . '_Date' }; - next if $ARGSRef->{ $field . '_Date' } eq ''; - - my ( $code, $msg ); - - my $DateObj = RT::Date->new( $session{'CurrentUser'} ); - $DateObj->Set( - Format => 'unknown', - Value => $ARGSRef->{ $field . '_Date' } - ); - - my $obj = $field . "Obj"; - if ( ( defined $DateObj->Unix ) - and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) ) - { - my $method = "Set$field"; - my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO ); - push @results, "$msg"; - } - } - - # }}} - return (@results); -} - - - -=head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS ); - -Returns an array of results messages. - -=cut - -sub ProcessTicketLinks { - my %args = ( - TicketObj => undef, - ARGSRef => undef, - @_ - ); - - my $Ticket = $args{'TicketObj'}; - my $ARGSRef = $args{'ARGSRef'}; - - my (@results) = ProcessRecordLinks( RecordObj => $Ticket, ARGSRef => $ARGSRef ); - - #Merge if we need to - if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) { - $ARGSRef->{ $Ticket->Id . "-MergeInto" } =~ s/\s+//g; - my ( $val, $msg ) = $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ); - push @results, $msg; - } - - return (@results); -} - - -sub ProcessRecordLinks { - my %args = ( - RecordObj => undef, - ARGSRef => undef, - @_ - ); - - my $Record = $args{'RecordObj'}; - my $ARGSRef = $args{'ARGSRef'}; - - my (@results); - - # Delete links that are gone gone gone. - foreach my $arg ( keys %$ARGSRef ) { - if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) { - my $base = $1; - my $type = $2; - my $target = $3; - - my ( $val, $msg ) = $Record->DeleteLink( - Base => $base, - Type => $type, - Target => $target - ); - - push @results, $msg; - - } - - } - - my @linktypes = qw( DependsOn MemberOf RefersTo ); - - foreach my $linktype (@linktypes) { - if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) { - $ARGSRef->{ $Record->Id . "-$linktype" } = join( ' ', @{ $ARGSRef->{ $Record->Id . "-$linktype" } } ) - if ref( $ARGSRef->{ $Record->Id . "-$linktype" } ); - - for my $luri ( split( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) { - next unless $luri; - $luri =~ s/\s+$//; # Strip trailing whitespace - my ( $val, $msg ) = $Record->AddLink( - Target => $luri, - Type => $linktype - ); - push @results, $msg; - } - } - if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) { - $ARGSRef->{ "$linktype-" . $Record->Id } = join( ' ', @{ $ARGSRef->{ "$linktype-" . $Record->Id } } ) - if ref( $ARGSRef->{ "$linktype-" . $Record->Id } ); - - for my $luri ( split( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) { - next unless $luri; - my ( $val, $msg ) = $Record->AddLink( - Base => $luri, - Type => $linktype - ); - - push @results, $msg; - } - } - } - - return (@results); -} - -=head2 ProcessTransactionSquelching - -Takes a hashref of the submitted form arguments, C<%ARGS>. - -Returns a hash of squelched addresses. - -=cut - -sub ProcessTransactionSquelching { - my $args = shift; - my %checked = map { $_ => 1 } grep { defined } - ( ref $args->{'TxnSendMailTo'} eq "ARRAY" ? @{$args->{'TxnSendMailTo'}} : - defined $args->{'TxnSendMailTo'} ? ($args->{'TxnSendMailTo'}) : - () ); - my %squelched = map { $_ => 1 } grep { not $checked{$_} } split /,/, ($args->{'TxnRecipients'}||''); - return %squelched; -} - -=head2 _UploadedFile ( $arg ); - -Takes a CGI parameter name; if a file is uploaded under that name, -return a hash reference suitable for AddCustomFieldValue's use: -C<( Value => $filename, LargeContent => $content, ContentType => $type )>. - -Returns C<undef> if no files were uploaded in the C<$arg> field. - -=cut - -sub _UploadedFile { - my $arg = shift; - my $cgi_object = $m->cgi_object; - my $fh = $cgi_object->upload($arg) or return undef; - my $upload_info = $cgi_object->uploadInfo($fh); - - my $filename = "$fh"; - $filename =~ s#^.*[\\/]##; - binmode($fh); - - return { - Value => $filename, - LargeContent => do { local $/; scalar <$fh> }, - ContentType => $upload_info->{'Content-Type'}, - }; -} - -sub GetColumnMapEntry { - my %args = ( Map => {}, Name => '', Attribute => undef, @_ ); - - # deal with the simplest thing first - if ( $args{'Map'}{ $args{'Name'} } ) { - return $args{'Map'}{ $args{'Name'} }{ $args{'Attribute'} }; - } - - # complex things - elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.(.+)$/ ) { - $subkey =~ s/^\{(.*)\}$/$1/; - return undef unless $args{'Map'}->{$mainkey}; - return $args{'Map'}{$mainkey}{ $args{'Attribute'} } - unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE'; - - return sub { $args{'Map'}{$mainkey}{ $args{'Attribute'} }->( @_, $subkey ) }; - } - return undef; -} - -sub ProcessColumnMapValue { - my $value = shift; - my %args = ( Arguments => [], Escape => 1, @_ ); - - if ( ref $value ) { - if ( UNIVERSAL::isa( $value, 'CODE' ) ) { - my @tmp = $value->( @{ $args{'Arguments'} } ); - return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args ); - } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) { - return join '', map ProcessColumnMapValue( $_, %args ), @$value; - } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) { - return $$value; - } - } - - return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'}; - return $value; -} - -=head2 GetPrincipalsMap OBJECT, CATEGORIES - -Returns an array suitable for passing to /Admin/Elements/EditRights with the -principal collections mapped from the categories given. - -=cut - -sub GetPrincipalsMap { - my $object = shift; - my @map; - for (@_) { - if (/System/) { - my $system = RT::Groups->new($session{'CurrentUser'}); - $system->LimitToSystemInternalGroups(); - $system->OrderBy( FIELD => 'Type', ORDER => 'ASC' ); - push @map, [ - 'System' => $system, # loc_left_pair - 'Type' => 1, - ]; - } - elsif (/Groups/) { - my $groups = RT::Groups->new($session{'CurrentUser'}); - $groups->LimitToUserDefinedGroups(); - $groups->OrderBy( FIELD => 'Name', ORDER => 'ASC' ); - - # Only show groups who have rights granted on this object - $groups->WithGroupRight( - Right => '', - Object => $object, - IncludeSystemRights => 0, - IncludeSubgroupMembers => 0, - ); - - push @map, [ - 'User Groups' => $groups, # loc_left_pair - 'Name' => 0 - ]; - } - elsif (/Roles/) { - my $roles = RT::Groups->new($session{'CurrentUser'}); - - if ($object->isa('RT::System')) { - $roles->LimitToRolesForSystem(); - } - elsif ($object->isa('RT::Queue')) { - $roles->LimitToRolesForQueue($object->Id); - } - else { - $RT::Logger->warn("Skipping unknown object type ($object) for Role principals"); - next; - } - $roles->OrderBy( FIELD => 'Type', ORDER => 'ASC' ); - push @map, [ - 'Roles' => $roles, # loc_left_pair - 'Type' => 1 - ]; - } - elsif (/Users/) { - my $Users = RT->PrivilegedUsers->UserMembersObj(); - $Users->OrderBy( FIELD => 'Name', ORDER => 'ASC' ); - - # Only show users who have rights granted on this object - my $group_members = $Users->WhoHaveGroupRight( - Right => '', - Object => $object, - IncludeSystemRights => 0, - IncludeSubgroupMembers => 0, - ); - - # Limit to UserEquiv groups - my $groups = $Users->NewAlias('Groups'); - $Users->Join( - ALIAS1 => $groups, - FIELD1 => 'id', - ALIAS2 => $group_members, - FIELD2 => 'GroupId' - ); - $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence' ); - $Users->Limit( ALIAS => $groups, FIELD => 'Type', VALUE => 'UserEquiv' ); - - - my $display = sub { - $m->scomp('/Elements/ShowUser', User => $_[0], NoEscape => 1) - }; - push @map, [ - 'Users' => $Users, # loc_left_pair - $display => 0 - ]; - } - } - return @map; -} - -=head2 _load_container_object ( $type, $id ); - -Instantiate container object for saving searches. - -=cut - -sub _load_container_object { - my ( $obj_type, $obj_id ) = @_; - return RT::SavedSearch->new( $session{'CurrentUser'} )->_load_privacy_object( $obj_type, $obj_id ); -} - -=head2 _parse_saved_search ( $arg ); - -Given a serialization string for saved search, and returns the -container object and the search id. - -=cut - -sub _parse_saved_search { - my $spec = shift; - return unless $spec; - if ( $spec !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) { - return; - } - my $obj_type = $1; - my $obj_id = $2; - my $search_id = $3; - - return ( _load_container_object( $obj_type, $obj_id ), $search_id ); -} - -=head2 ScrubHTML content - -Removes unsafe and undesired HTML from the passed content - -=cut - -my $SCRUBBER; -sub ScrubHTML { - my $Content = shift; - $SCRUBBER = _NewScrubber() unless $SCRUBBER; - - $Content = '' if !defined($Content); - return $SCRUBBER->scrub($Content); -} - -=head2 _NewScrubber - -Returns a new L<HTML::Scrubber> object. - -If you need to be more lax about what HTML tags and attributes are allowed, -create C</opt/rt4/local/lib/RT/Interface/Web_Local.pm> with something like the -following: - - package HTML::Mason::Commands; - # Let tables through - push @SCRUBBER_ALLOWED_TAGS, qw(TABLE THEAD TBODY TFOOT TR TD TH); - 1; - -=cut - -our @SCRUBBER_ALLOWED_TAGS = qw( - A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP STRIKE H1 H2 H3 H4 H5 - H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO -); - -our %SCRUBBER_ALLOWED_ATTRIBUTES = ( - # Match http, https, ftp, mailto and relative urls - # XXX: we also scrub format strings with this module then allow simple config options - href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|BaseURL|URL)__)}i, - face => 1, - size => 1, - target => 1, - style => qr{ - ^(?:\s* - (?:(?:background-)?color: \s* - (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) | # rgb(d,d,d) - \#[a-f0-9]{3,6} | # #fff or #ffffff - [\w\-]+ # green, light-blue, etc. - ) | - text-align: \s* \w+ | - font-size: \s* [\w.\-]+ | - font-family: \s* [\w\s"',.\-]+ | - font-weight: \s* [\w\-]+ | - - # MS Office styles, which are probably fine. If we don't, then any - # associated styles in the same attribute get stripped. - mso-[\w\-]+?: \s* [\w\s"',.\-]+ - )\s* ;? \s*) - +$ # one or more of these allowed properties from here 'till sunset - }ix, - dir => qr/^(rtl|ltr)$/i, - lang => qr/^\w+(-\w+)?$/, -); - -our %SCRUBBER_RULES = (); - -sub _NewScrubber { - require HTML::Scrubber; - my $scrubber = HTML::Scrubber->new(); - $scrubber->default( - 0, - { - %SCRUBBER_ALLOWED_ATTRIBUTES, - '*' => 0, # require attributes be explicitly allowed - }, - ); - $scrubber->deny(qw[*]); - $scrubber->allow(@SCRUBBER_ALLOWED_TAGS); - $scrubber->rules(%SCRUBBER_RULES); - - # Scrubbing comments is vital since IE conditional comments can contain - # arbitrary HTML and we'd pass it right on through. - $scrubber->comment(0); - - return $scrubber; -} - -=head2 JSON - -Redispatches to L<RT::Interface::Web/EncodeJSON> - -=cut - -sub JSON { - RT::Interface::Web::EncodeJSON(@_); -} - -package RT::Interface::Web; -RT::Base->_ImportOverlays(); - -1; diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm index fc95aa1..8667f01 100644 --- a/rt/lib/RT/Interface/Web/Handler.pm +++ b/rt/lib/RT/Interface/Web/Handler.pm @@ -54,7 +54,6 @@ use CGI qw/-private_tempfiles/; use MIME::Entity; use Text::Wrapper; use CGI::Cookie; -use Time::ParseDate; use Time::HiRes; use HTML::Scrubber; use RT::Interface::Web; @@ -62,6 +61,9 @@ use RT::Interface::Web::Request; use File::Path qw( rmtree ); use File::Glob qw( bsd_glob ); use File::Spec::Unix; +use HTTP::Message::PSGI; +use HTTP::Request; +use HTTP::Response; sub DefaultHandlerArgs { ( comp_root => [ @@ -104,7 +106,6 @@ sub InitSessionDir { } -use UNIVERSAL::require; sub NewHandler { my $class = shift; $class->require or die $!; @@ -114,7 +115,7 @@ sub NewHandler { @_ ); - $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); + $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeHTML ); $handler->interp->set_escape( u => \&RT::Interface::Web::EscapeURI ); $handler->interp->set_escape( j => \&RT::Interface::Web::EscapeJS ); return($handler); @@ -154,7 +155,7 @@ and is not recommended to change. =item Clean up state of RT::Action::SendEmail using 'CleanSlate' method -=item Flush tmp GnuPG key preferences +=item Flush tmp crypt key preferences =back @@ -181,10 +182,9 @@ sub CleanupRequest { require RT::Action::SendEmail; RT::Action::SendEmail->CleanSlate; - if (RT->Config->Get('GnuPG')->{'Enable'}) { - require RT::Crypt::GnuPG; - RT::Crypt::GnuPG::UseKeyForEncryption(); - RT::Crypt::GnuPG::UseKeyForSigning( undef ); + if (RT->Config->Get('Crypt')->{'Enable'}) { + RT::Crypt->UseKeyForEncryption(); + RT::Crypt->UseKeyForSigning( undef ); } %RT::Ticket::MERGE_CACHE = ( effective => {}, merged => {} ); @@ -248,6 +248,7 @@ MODPERL use RT::Interface::Web::Handler; use CGI::Emulate::PSGI; +use Plack::Builder; use Plack::Request; use Plack::Response; use Plack::Util; @@ -262,7 +263,7 @@ sub PSGIApp { $self->InitSessionDir; - return sub { + my $mason = sub { my $env = shift; { @@ -270,7 +271,14 @@ sub PSGIApp { return $self->_psgi_response_cb( $res->finalize ) if $res; } - RT::ConnectToDatabase() unless RT->InstallMode; + unless (RT->InstallMode) { + unless (eval { RT::ConnectToDatabase() }) { + my $res = Plack::Response->new(503); + $res->content_type("text/plain"); + $res->body("Database inaccessible; contact the RT administrator (".RT->Config->Get("OwnerEmail").")"); + return $self->_psgi_response_cb( $res->finalize, sub { $self->CleanupRequest } ); + } + } my $req = Plack::Request->new($env); @@ -307,7 +315,59 @@ sub PSGIApp { sub { $self->CleanupRequest() }); -}; + }; + + my $app = $self->StaticWrap($mason); + for my $plugin (RT->Config->Get("Plugins")) { + my $wrap = $plugin->can("PSGIWrap") + or next; + $app = $wrap->($plugin, $app); + } + return $app; +} + +sub StaticWrap { + my $self = shift; + my $app = shift; + my $builder = Plack::Builder->new; + + my $headers = RT::Interface::Web::GetStaticHeaders(Time => 'forever'); + + for my $static ( RT->Config->Get('StaticRoots') ) { + if ( ref $static && ref $static eq 'HASH' ) { + $builder->add_middleware( + '+RT::Interface::Web::Middleware::StaticHeaders', + path => $static->{'path'}, + headers => $headers, + ); + $builder->add_middleware( + 'Plack::Middleware::Static', + pass_through => 1, + %$static + ); + } + else { + $RT::Logger->error( + "Invalid config StaticRoots: item can only be a hashref" ); + } + } + + my $path = sub { s!^/static/!! }; + $builder->add_middleware( + '+RT::Interface::Web::Middleware::StaticHeaders', + path => $path, + headers => $headers, + ); + for my $root (RT::Interface::Web->StaticRoots) { + $builder->add_middleware( + 'Plack::Middleware::Static', + path => $path, + root => $root, + pass_through => 1, + ); + } + return $builder->to_app($app); +} sub _psgi_response_cb { my $self = shift; @@ -334,7 +394,19 @@ sub _psgi_response_cb { return $_[0]; }; }); - } +} + +sub GetStatic { + my $class = shift; + my $path = shift; + my $static = $class->StaticWrap( + # Anything the static wrap doesn't handle gets 404'd. + sub { [404, [], []] } + ); + my $response = HTTP::Response->from_psgi( + $static->( HTTP::Request->new(GET => $path)->to_psgi ) + ); + return $response; } 1; diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm index 03ce8ac..8670b8a 100644 --- a/rt/lib/RT/Interface/Web/Menu.pm +++ b/rt/lib/RT/Interface/Web/Menu.pm @@ -57,7 +57,7 @@ use URI; use Scalar::Util qw(weaken); __PACKAGE__->mk_accessors(qw( - key title description raw_html escape_title sort_order target class + key title description raw_html escape_title sort_order target class attributes )); =head1 NAME @@ -70,9 +70,9 @@ RT::Interface::Web::Menu - Handle the API for menu navigation Creates a new L<RT::Interface::Web::Menu> object. Possible keys in the I<PARAMHASH> are L</parent>, L</title>, L</description>, L</path>, -L</raw_html>, L<escape_title>, L</sort_order>, L</class>, L</target> and -L</active>. See the subroutines with the respective name below for -each option's use. +L</raw_html>, L<escape_title>, L</sort_order>, L</class>, L</target>, +L<attributes>, and L</active>. See the subroutines with the respective name +below for each option's use. =cut @@ -139,6 +139,12 @@ Get or set the frame or pseudo-target for this link. something like L<_blank> Gets or sets the CSS class the menu item should have in addition to the default classes. This is only used if L</raw_html> isn't specified. +=head2 attributes [HASHREF] + +Gets or sets a hashref of HTML attribute name-value pairs that the menu item +should have in addition to the attributes which have their own accessor, like +L</class> and L</target>. This is only used if L</raw_html> isn't specified. + =head2 path Gets or sets the URL that the menu's link goes to. If the link diff --git a/rt/lib/RT/Interface/Web/Middleware/StaticHeaders.pm b/rt/lib/RT/Interface/Web/Middleware/StaticHeaders.pm new file mode 100644 index 0000000..6d98d9e --- /dev/null +++ b/rt/lib/RT/Interface/Web/Middleware/StaticHeaders.pm @@ -0,0 +1,80 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Interface::Web::Middleware::StaticHeaders; + +use strict; +use warnings; +use base 'Plack::Middleware'; +use Plack::Util; + +use Plack::Util::Accessor qw(path headers); + +sub call { + my ( $self, $env ) = @_; + my $res = $self->app->($env); + my $path_match = $self->path; + my $path = $env->{'PATH_INFO'}; + for ($path) { + my $matched = 'CODE' eq ref $path_match ? + $path_match->($_, $env) + : $_ =~ $path_match; + return $res unless $matched; + return $self->response_cb( $res, + sub { + my $res = shift; + my $headers = $res->[1]; + Plack::Util::header_iter( $self->headers, sub { + Plack::Util::header_set($headers, @_); + } ); + } + ); + } +} + +1; diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm index 1da160c..d7de61c 100755 --- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm +++ b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm @@ -113,9 +113,7 @@ sub GetReferencedQueues { return unless $clause->{Key} eq 'Queue'; return unless $clause->{Op} eq '='; - my $value = $clause->{Value}; - $value =~ s/\\(.)/$1/g if $value =~ s/^'(.*)'$/$1/; - $queues->{ $value } = 1; + $queues->{ $clause->{RawValue} } = 1; } ); @@ -257,6 +255,7 @@ sub ParseSQL { $callback{'EntryAggregator'} = sub { $node->setNodeValue( $_[0] ) }; $callback{'Condition'} = sub { my ($key, $op, $value) = @_; + my $rawvalue = $value; my ($main_key) = split /[.]/, $key; @@ -281,7 +280,7 @@ sub ParseSQL { $key = "'$key'"; } - my $clause = { Key => $key, Op => $op, Value => $value }; + my $clause = { Key => $key, Op => $op, Value => $value, RawValue => $rawvalue }; $node->addChild( __PACKAGE__->new( $clause ) ); }; $callback{'Error'} = sub { push @results, @_ }; diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm index 7a246a3..61cfa70 100644 --- a/rt/lib/RT/Interface/Web/Request.pm +++ b/rt/lib/RT/Interface/Web/Request.pm @@ -51,7 +51,6 @@ package RT::Interface::Web::Request; use strict; use warnings; -our $VERSION = '0.30'; use HTML::Mason::PSGIHandler; use base qw(HTML::Mason::Request::PSGI); use Params::Validate qw(:all); @@ -65,8 +64,6 @@ sub new { =head2 callback -Method replaces deprecated component C<Element/Callback>. - Takes hash with optional C<CallbackPage>, C<CallbackName> and C<CallbackOnce> arguments, other arguments are passed throught to callback components. diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm index d854130..c4cc930 100644 --- a/rt/lib/RT/Interface/Web/Session.pm +++ b/rt/lib/RT/Interface/Web/Session.pm @@ -84,8 +84,7 @@ sub Class { my $class = RT->Config->Get('WebSessionClass') || $self->Backends->{RT->Config->Get('DatabaseType')} || 'Apache::Session::File'; - eval "require $class"; - die $@ if $@; + $class->require or die "Can't load $class: $@"; return $class; } @@ -98,8 +97,9 @@ sessions class names as values. sub Backends { return { - mysql => 'Apache::Session::MySQL', - Pg => 'Apache::Session::Postgres', + mysql => 'Apache::Session::MySQL', + Pg => 'Apache::Session::Postgres', + Oracle => 'Apache::Session::Oracle', }; } @@ -112,15 +112,27 @@ new session objects. sub Attributes { my $class = $_[0]->Class; - return !$class->isa('Apache::Session::File') ? { - Handle => $RT::Handle->dbh, - LockHandle => $RT::Handle->dbh, - Transaction => 1, - } : { + my $res; + if ( my %props = RT->Config->Get('WebSessionProperties') ) { + $res = \%props; + } + elsif ( $class->isa('Apache::Session::File') ) { + $res = { Directory => $RT::MasonSessionDir, LockDirectory => $RT::MasonSessionDir, Transaction => 1, }; + } + else { + $res = { + Handle => $RT::Handle->dbh, + LockHandle => $RT::Handle->dbh, + Transaction => 1, + }; + } + $res->{LongReadLen} = RT->Config->Get('MaxAttachmentSize') + if $class->isa('Apache::Session::Oracle'); + return $res; } =head3 Ids diff --git a/rt/lib/RT/Lifecycle.pm b/rt/lib/RT/Lifecycle.pm index 3bd3f59..c2865bc 100644 --- a/rt/lib/RT/Lifecycle.pm +++ b/rt/lib/RT/Lifecycle.pm @@ -54,16 +54,10 @@ package RT::Lifecycle; our %LIFECYCLES; our %LIFECYCLES_CACHE; -__PACKAGE__->RegisterRights; +our %LIFECYCLES_TYPES; # cache structure: # { -# '' => { # all valid statuses -# '' => [...], -# initial => [...], -# active => [...], -# inactive => [...], -# }, # lifecycle_x => { # '' => [...], # all valid in lifecycle # initial => [...], @@ -119,66 +113,111 @@ sub new { return $self; } -=head2 Load +=head2 Load Name => I<NAME>, Type => I<TYPE> -Takes a name of the lifecycle and loads it. If name is empty or undefined then -loads the global lifecycle with statuses from all named lifecycles. +Takes a name of the lifecycle and loads it. If only a Type is provided, +loads the global lifecycle with statuses from all named lifecycles of +that type. Can be called as class method, returns a new object, for example: - my $lifecycle = RT::Lifecycle->Load('default'); + my $lifecycle = RT::Lifecycle->Load( Name => 'default'); + +Returns an object which may be a subclass of L<RT::Lifecycle> +(L<RT::Lifecycle::Ticket>, for example) depending on the type of the +lifecycle in question. =cut sub Load { my $self = shift; - my $name = shift || ''; - return $self->new->Load( $name, @_ ) + return $self->new->Load( @_ ) unless ref $self; - return unless exists $LIFECYCLES_CACHE{ $name }; + unshift @_, Type => "ticket", "Name" + if @_ % 2; - $self->{'name'} = $name; - $self->{'data'} = $LIFECYCLES_CACHE{ $name }; + my %args = ( + Type => "ticket", + Name => '', + @_, + ); + + if (defined $args{Name} and exists $LIFECYCLES_CACHE{ $args{Name} }) { + $self->{'name'} = $args{Name}; + $self->{'data'} = $LIFECYCLES_CACHE{ $args{Name} }; + $self->{'type'} = $args{Type}; + + my $found_type = $self->{'data'}{'type'}; + warn "Found type of $found_type ne $args{Type}" if $found_type ne $args{Type}; + } elsif (not $args{Name} and exists $LIFECYCLES_TYPES{ $args{Type} }) { + $self->{'data'} = $LIFECYCLES_TYPES{ $args{Type} }; + $self->{'type'} = $args{Type}; + } else { + return undef; + } + + my $class = "RT::Lifecycle::".ucfirst($args{Type}); + bless $self, $class if $class->require; return $self; } =head2 List -Returns sorted list of the lifecycles' names. +List available lifecycles. This list omits RT's default approvals +lifecycle. + +Takes: An optional parameter for lifecycle types other than tickets. + Defaults to 'ticket'. + +Returns: A sorted list of available lifecycles. =cut sub List { my $self = shift; + my $for = shift || 'ticket'; + + return grep { $_ ne 'approvals' } $self->ListAll( $for ); +} + +=head2 ListAll + +Returns a list of all lifecycles, including approvals. + +Takes: An optional parameter for lifecycle types other than tickets. + Defaults to 'ticket'. + +Returns: A sorted list of all available lifecycles. + +=cut + +sub ListAll { + my $self = shift; + my $for = shift || 'ticket'; $self->FillCache unless keys %LIFECYCLES_CACHE; - return sort grep length && $_ ne '__maps__', keys %LIFECYCLES_CACHE; + return sort grep {$LIFECYCLES_CACHE{$_}{type} eq $for} + grep $_ ne '__maps__', keys %LIFECYCLES_CACHE; } =head2 Name -Returns name of the laoded lifecycle. +Returns name of the loaded lifecycle. =cut sub Name { return $_[0]->{'name'} } -=head2 Queues +=head2 Type -Returns L<RT::Queues> collection with queues that use this lifecycle. +Returns the type of the loaded lifecycle. =cut -sub Queues { - my $self = shift; - require RT::Queues; - my $queues = RT::Queues->new( RT->SystemUser ); - $queues->Limit( FIELD => 'Lifecycle', VALUE => $self->Name ); - return $queues; -} +sub Type { return $_[0]->{'type'} } =head2 Getting statuses and validating. @@ -354,41 +393,6 @@ sub DefaultOnCreate { return $self->DefaultStatus('on_create'); } - -=head3 DefaultOnMerge - -Returns the status that should be used when tickets -are merged. - -=cut - -sub DefaultOnMerge { - my $self = shift; - return $self->DefaultStatus('on_merge'); -} - -=head3 ReminderStatusOnOpen - -Returns the status that should be used when reminders are opened. - -=cut - -sub ReminderStatusOnOpen { - my $self = shift; - return $self->DefaultStatus('reminder_on_open') || 'open'; -} - -=head3 ReminderStatusOnResolve - -Returns the status that should be used when reminders are resolved. - -=cut - -sub ReminderStatusOnResolve { - my $self = shift; - return $self->DefaultStatus('reminder_on_resolve') || 'resolved'; -} - =head2 Transitions, rights, labels and actions. =head3 Transitions @@ -452,33 +456,7 @@ sub CheckRight { return $to eq 'deleted' ? 'DeleteTicket' : 'ModifyTicket'; } -=head3 RegisterRights - -Registers all defined rights in the system, so they can be addigned -to users. No need to call it, as it's called when module is loaded. - -=cut - -sub RegisterRights { - my $self = shift; - - my %rights = $self->RightsDescription; - - require RT::ACE; - - require RT::Queue; - my $RIGHTS = $RT::Queue::RIGHTS; - - while ( my ($right, $description) = each %rights ) { - next if exists $RIGHTS->{ $right }; - - $RIGHTS->{ $right } = $description; - RT::Queue->AddRightCategories( $right => 'Status' ); - $RT::ACE::LOWERCASERIGHTNAMES{ lc $right } = $right; - } -} - -=head3 RightsDescription +=head3 RightsDescription [TYPE] Returns hash with description of rights that are defined for particular transitions. @@ -487,12 +465,14 @@ particular transitions. sub RightsDescription { my $self = shift; + my $type = shift; $self->FillCache unless keys %LIFECYCLES_CACHE; my %tmp; foreach my $lifecycle ( values %LIFECYCLES_CACHE ) { next unless exists $lifecycle->{'rights'}; + next if $type and $lifecycle->{type} ne $type; while ( my ($transition, $right) = each %{ $lifecycle->{'rights'} } ) { push @{ $tmp{ $right } ||=[] }, $transition; } @@ -562,7 +542,7 @@ move map from this cycle to provided. sub MoveMap { my $from = shift; # self my $to = shift; - $to = RT::Lifecycle->Load( $to ) unless ref $to; + $to = RT::Lifecycle->Load( Name => $to, Type => $from->Type ) unless ref $to; return $LIFECYCLES{'__maps__'}{ $from->Name .' -> '. $to->Name } || {}; } @@ -590,13 +570,14 @@ move maps. sub NoMoveMaps { my $self = shift; - my @list = $self->List; + my $type = $self->Type; + my @list = $self->List( $type ); my @res; foreach my $from ( @list ) { foreach my $to ( @list ) { next if $from eq $to; push @res, $from, $to - unless RT::Lifecycle->Load( $from )->HasMoveMap( $to ); + unless RT::Lifecycle->Load( Name => $from, Type => $type )->HasMoveMap( $to ); } } return @res; @@ -617,7 +598,7 @@ sub ForLocalization { my @res = (); - push @res, @{ $LIFECYCLES_CACHE{''}{''} || [] }; + push @res, @{$_->{''}} for values %LIFECYCLES_TYPES; foreach my $lifecycle ( values %LIFECYCLES ) { push @res, grep defined && length, @@ -646,29 +627,50 @@ sub FillCache { my $map = RT->Config->Get('Lifecycles') or return; + { + my @lifecycles; + + # if users are upgrading from 3.* where we don't have lifecycle column yet, + # this could die. we also don't want to frighten them by the errors out + eval { + local $RT::Logger = Log::Dispatch->new; + @lifecycles = grep { defined } RT::Queues->new( RT->SystemUser )->DistinctFieldValues( 'Lifecycle' ); + }; + unless ( $@ ) { + for my $name ( @lifecycles ) { + unless ( $map->{$name} ) { + warn "Lifecycle $name is missing in %Lifecycles config"; + } + } + } + } + %LIFECYCLES_CACHE = %LIFECYCLES = %$map; $_ = { %$_ } foreach values %LIFECYCLES_CACHE; - my %all = ( - '' => [], - initial => [], - active => [], - inactive => [], - ); foreach my $name ( keys %LIFECYCLES_CACHE ) { next if $name eq "__maps__"; my $lifecycle = $LIFECYCLES_CACHE{$name}; + my $type = $lifecycle->{type} ||= 'ticket'; + $LIFECYCLES_TYPES{$type} ||= { + '' => [], + initial => [], + active => [], + inactive => [], + actions => [], + }; + my @statuses; $lifecycle->{canonical_case} = {}; - foreach my $type ( qw(initial active inactive) ) { - for my $status (@{ $lifecycle->{ $type } || [] }) { + foreach my $category ( qw(initial active inactive) ) { + for my $status (@{ $lifecycle->{ $category } || [] }) { if (exists $lifecycle->{canonical_case}{lc $status}) { warn "Duplicate status @{[lc $status]} in lifecycle $name"; } else { $lifecycle->{canonical_case}{lc $status} = $status; } - push @{ $all{ $type } }, $status; + push @{ $LIFECYCLES_TYPES{$type}{$category} }, $status; push @statuses, $status; } } @@ -702,6 +704,13 @@ sub FillCache { unless $from eq '*' or $lifecycle->{canonical_case}{lc $from}; warn "Nonexistant status @{[lc $to]} in right transition in $name lifecycle" unless $to eq '*' or $lifecycle->{canonical_case}{lc $to}; + + warn "Invalid right name ($lifecycle->{rights}{$schema}) in $name lifecycle; right names must be ASCII" + if $lifecycle->{rights}{$schema} =~ /\P{ASCII}/; + + warn "Invalid right name ($lifecycle->{rights}{$schema}) in $name lifecycle; right names must be <= 25 characters" + if length($lifecycle->{rights}{$schema}) > 25; + $lifecycle->{rights}{lc($from) . " -> " .lc($to)} = delete $lifecycle->{rights}{$schema}; } @@ -765,12 +774,19 @@ sub FillCache { } } - foreach my $type ( qw(initial active inactive), '' ) { - my %seen; - @{ $all{ $type } } = grep !$seen{ lc $_ }++, @{ $all{ $type } }; - push @{ $all{''} }, @{ $all{ $type } } if $type; + for my $type (keys %LIFECYCLES_TYPES) { + for my $category ( qw(initial active inactive), '' ) { + my %seen; + @{ $LIFECYCLES_TYPES{$type}{$category} } = + grep !$seen{ lc $_ }++, @{ $LIFECYCLES_TYPES{$type}{$category} }; + push @{ $LIFECYCLES_TYPES{$type}{''} }, + @{ $LIFECYCLES_TYPES{$type}{$category} } if $category; + } + + my $class = "RT::Lifecycle::".ucfirst($type); + $class->RegisterRights if $class->require + and $class->can("RegisterRights"); } - $LIFECYCLES_CACHE{''} = \%all; return; } diff --git a/rt/lib/RT/Lifecycle/Ticket.pm b/rt/lib/RT/Lifecycle/Ticket.pm new file mode 100644 index 0000000..3f6dc5e --- /dev/null +++ b/rt/lib/RT/Lifecycle/Ticket.pm @@ -0,0 +1,125 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Lifecycle::Ticket; + +use base qw(RT::Lifecycle); + +=head2 Queues + +Returns L<RT::Queues> collection with queues that use this lifecycle. + +=cut + +sub Queues { + my $self = shift; + require RT::Queues; + my $queues = RT::Queues->new( RT->SystemUser ); + $queues->Limit( FIELD => 'Lifecycle', VALUE => $self->Name ); + return $queues; +} + +=head3 DefaultOnMerge + +Returns the status that should be used when tickets +are merged. + +=cut + +sub DefaultOnMerge { + my $self = shift; + return $self->DefaultStatus('on_merge'); +} + +=head3 ReminderStatusOnOpen + +Returns the status that should be used when reminders are opened. + +=cut + +sub ReminderStatusOnOpen { + my $self = shift; + return $self->DefaultStatus('reminder_on_open') || 'open'; +} + +=head3 ReminderStatusOnResolve + +Returns the status that should be used when reminders are resolved. + +=cut + +sub ReminderStatusOnResolve { + my $self = shift; + return $self->DefaultStatus('reminder_on_resolve') || 'resolved'; +} + +=head2 RegisterRights + +Ticket lifecycle rights are registered (and thus grantable) at the queue +level. + +=cut + +sub RegisterRights { + my $self = shift; + + my %rights = $self->RightsDescription( 'ticket' ); + + require RT::ACE; + + while ( my ($right, $description) = each %rights ) { + next if RT::ACE->CanonicalizeRightName( $right ); + + RT::Queue->AddRight( Status => $right => $description ); + } +} + +1; diff --git a/rt/lib/RT/Link.pm b/rt/lib/RT/Link.pm index bd8ad61..f82cf51 100644 --- a/rt/lib/RT/Link.pm +++ b/rt/lib/RT/Link.pm @@ -59,10 +59,6 @@ This module should never be called directly by client code. it's an internal module which should only be accessed through exported APIs in Ticket other similar objects. -=head1 METHODS - - - =cut @@ -78,8 +74,67 @@ use base 'RT::Record'; sub Table {'Links'} use Carp; use RT::URI; +use List::Util 'first'; +use List::MoreUtils 'uniq'; + +# Helper tables for links mapping to make it easier +# to build and parse links between objects. +our %TYPEMAP = ( + MemberOf => { Type => 'MemberOf', Mode => 'Target', Display => 0 }, + Parents => { Type => 'MemberOf', Mode => 'Target', Display => 1 }, + Parent => { Type => 'MemberOf', Mode => 'Target', Display => 0 }, + Members => { Type => 'MemberOf', Mode => 'Base', Display => 0 }, + Member => { Type => 'MemberOf', Mode => 'Base', Display => 0 }, + Children => { Type => 'MemberOf', Mode => 'Base', Display => 1 }, + Child => { Type => 'MemberOf', Mode => 'Base', Display => 0 }, + HasMember => { Type => 'MemberOf', Mode => 'Base', Display => 0 }, + RefersTo => { Type => 'RefersTo', Mode => 'Target', Display => 1 }, + ReferredToBy => { Type => 'RefersTo', Mode => 'Base', Display => 1 }, + DependsOn => { Type => 'DependsOn', Mode => 'Target', Display => 1 }, + DependedOnBy => { Type => 'DependsOn', Mode => 'Base', Display => 1 }, + MergedInto => { Type => 'MergedInto', Mode => 'Target', Display => 1 }, +); +our %DIRMAP = ( + MemberOf => { Base => 'MemberOf', Target => 'HasMember' }, + RefersTo => { Base => 'RefersTo', Target => 'ReferredToBy' }, + DependsOn => { Base => 'DependsOn', Target => 'DependedOnBy' }, + MergedInto => { Base => 'MergedInto', Target => 'MergedInto' }, +); + +__PACKAGE__->_BuildDisplayAs; + +my %DISPLAY_AS; +sub _BuildDisplayAs { + %DISPLAY_AS = (); + foreach my $in_db ( uniq map { $_->{Type} } values %TYPEMAP ) { + foreach my $mode (qw(Base Target)) { + $DISPLAY_AS{$in_db}{$mode} = first { + $TYPEMAP{$_}{Display} + && $TYPEMAP{$_}{Type} eq $in_db + && $TYPEMAP{$_}{Mode} eq $mode + } keys %TYPEMAP; + } + } +} + +=head1 CLASS METHODS +=head2 DisplayTypes +Returns a list of the standard link Types for display, including directional +variants but not aliases. + +=cut + +sub DisplayTypes { + sort { $a cmp $b } + uniq + grep { defined } + map { values %$_ } + values %DISPLAY_AS +} + +=head1 METHODS =head2 Create PARAMHASH @@ -171,20 +226,20 @@ sub LoadByParams { my $base = RT::URI->new($self->CurrentUser); $base->FromURI( $args{'Base'} ) - or return (0, $self->loc("Couldn't parse Base URI: [_1]", $args{Base})); + or return wantarray ? (0, $self->loc("Couldn't parse Base URI: [_1]", $args{Base})) : 0; my $target = RT::URI->new($self->CurrentUser); $target->FromURI( $args{'Target'} ) - or return (0, $self->loc("Couldn't parse Target URI: [_1]", $args{Target})); + or return wantarray ? (0, $self->loc("Couldn't parse Target URI: [_1]", $args{Target})) : 0; my ( $id, $msg ) = $self->LoadByCols( Base => $base->URI, Type => $args{'Type'}, Target => $target->URI ); unless ($id) { - return ( 0, $self->loc("Couldn't load link: [_1]", $msg) ); + return wantarray ? ( 0, $self->loc("Couldn't load link: [_1]", $msg) ) : 0; } else { - return ($id, $msg); + return wantarray ? ($id, $msg) : $id; } } @@ -204,14 +259,14 @@ sub Load { if ( $identifier !~ /^\d+$/ ) { - return ( 0, $self->loc("That's not a numerical id") ); + return wantarray ? ( 0, $self->loc("That's not a numerical id") ) : 0; } else { my ( $id, $msg ) = $self->LoadById($identifier); unless ( $self->Id ) { - return ( 0, $self->loc("Couldn't load link") ); + return wantarray ? ( 0, $self->loc("Couldn't load link") ) : 0; } - return ( $id, $msg ); + return wantarray ? ( $id, $msg ) : $id; } } @@ -265,7 +320,6 @@ sub BaseObj { return $self->BaseURI->Object; } - =head2 id Returns the current value of id. @@ -406,29 +460,136 @@ 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 => ''}, Base => - {read => 1, write => 1, sql_type => 12, length => 240, is_blob => 0, is_numeric => 0, type => 'varchar(240)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 240, is_blob => 0, is_numeric => 0, type => 'varchar(240)', default => ''}, Target => - {read => 1, write => 1, sql_type => 12, length => 240, is_blob => 0, is_numeric => 0, type => 'varchar(240)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 240, is_blob => 0, is_numeric => 0, type => 'varchar(240)', default => ''}, Type => - {read => 1, write => 1, sql_type => 12, length => 20, is_blob => 0, is_numeric => 0, type => 'varchar(20)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 20, is_blob => 0, is_numeric => 0, type => 'varchar(20)', default => ''}, LocalTarget => - {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'}, LocalBase => - {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'}, 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 => ''}, 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->BaseObj ) if $self->BaseObj and $self->BaseObj->id; + $deps->Add( out => $self->TargetObj ) if $self->TargetObj and $self->TargetObj->id; +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# AddLink transactions + my $map = { %RT::Link::TYPEMAP }; + my $link_meta = $map->{ $self->Type }; + unless ( $link_meta && $link_meta->{'Mode'} && $link_meta->{'Type'} ) { + RT::Shredder::Exception->throw( 'Wrong link link_meta, no record for '. $self->Type ); + } + if ( $self->BaseURI->IsLocal ) { + my $objs = $self->BaseObj->Transactions; + $objs->Limit( + FIELD => 'Type', + OPERATOR => '=', + VALUE => 'AddLink', + ); + $objs->Limit( FIELD => 'NewValue', VALUE => $self->Target ); + while ( my ($k, $v) = each %$map ) { + next unless $v->{'Type'} eq $link_meta->{'Type'}; + next unless $v->{'Mode'} eq $link_meta->{'Mode'}; + $objs->Limit( FIELD => 'Field', VALUE => $k ); + } + push( @$list, $objs ); + } + + my %reverse = ( Base => 'Target', Target => 'Base' ); + if ( $self->TargetURI->IsLocal ) { + my $objs = $self->TargetObj->Transactions; + $objs->Limit( + FIELD => 'Type', + OPERATOR => '=', + VALUE => 'AddLink', + ); + $objs->Limit( FIELD => 'NewValue', VALUE => $self->Base ); + while ( my ($k, $v) = each %$map ) { + next unless $v->{'Type'} eq $link_meta->{'Type'}; + next unless $v->{'Mode'} eq $reverse{ $link_meta->{'Mode'} }; + $objs->Limit( FIELD => 'Field', VALUE => $k ); + } + push( @$list, $objs ); + } + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON|RT::Shredder::Constants::WIPE_AFTER, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + return $self->SUPER::__DependsOn( %args ); +} + +sub Serialize { + my $self = shift; + my %args = (@_); + my %store = $self->SUPER::Serialize(@_); + + delete $store{LocalBase} if $store{Base}; + delete $store{LocalTarget} if $store{Target}; + return %store; +} + + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + for my $dir (qw/Base Target/) { + my $uid_ref = $data->{$dir}; + next unless $uid_ref and ref $uid_ref; + + my $to_uid = ${ $uid_ref }; + my $obj = $importer->LookupObj( $to_uid ); + if ($obj) { + $data->{$dir} = $obj->URI; + $data->{"Local$dir"} = $obj->Id if $obj->isa("RT::Ticket"); + } else { + $data->{$dir} = ""; + $importer->Postpone( + for => $to_uid, + uid => $uid, + uri => $dir, + column => ($to_uid =~ /RT::Ticket/ ? "Local$dir" : undef), + ); + } + + } + + return $class->SUPER::PreInflate( $importer, $uid, $data ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Links.pm b/rt/lib/RT/Links.pm index b9aba12..89e261b 100644 --- a/rt/lib/RT/Links.pm +++ b/rt/lib/RT/Links.pm @@ -70,11 +70,10 @@ package RT::Links; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::Link; -use base 'RT::SearchBuilder'; - sub Table { 'Links'} @@ -83,27 +82,27 @@ use RT::URI; sub Limit { my $self = shift; my %args = ( ENTRYAGGREGATOR => 'AND', - OPERATOR => '=', - @_); + OPERATOR => '=', + @_); # If we're limiting by target, order by base # (Order by the thing that's changing) - if ( ($args{'FIELD'} eq 'Target') or - ($args{'FIELD'} eq 'LocalTarget') ) { - $self->OrderByCols( + if ( ($args{'FIELD'} eq 'Target') or + ($args{'FIELD'} eq 'LocalTarget') ) { + $self->OrderByCols( { ALIAS => 'main', FIELD => 'LocalBase', ORDER => 'ASC' }, { ALIAS => 'main', FIELD => 'Base', ORDER => 'ASC' }, ); } - elsif ( ($args{'FIELD'} eq 'Base') or - ($args{'FIELD'} eq 'LocalBase') ) { - $self->OrderByCols( + elsif ( ($args{'FIELD'} eq 'Base') or + ($args{'FIELD'} eq 'LocalBase') ) { + $self->OrderByCols( { ALIAS => 'main', FIELD => 'LocalTarget', ORDER => 'ASC' }, { ALIAS => 'main', FIELD => 'Target', ORDER => 'ASC' }, ); } - + $self->SUPER::Limit(%args); } @@ -140,24 +139,12 @@ sub LimitReferredToBy { # }}} -=head2 NewItem - -Returns an empty new RT::Link item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Link->new($self->CurrentUser)); -} - sub AddRecord { my $self = shift; my $record = shift; return unless $self->IsValidLink($record); push @{$self->{'items'}}, $record; - $self->{'rows'}++; } =head2 IsValidLink diff --git a/rt/lib/RT/Migrate.pm b/rt/lib/RT/Migrate.pm new file mode 100644 index 0000000..c325ce1 --- /dev/null +++ b/rt/lib/RT/Migrate.pm @@ -0,0 +1,193 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Migrate; + +use strict; +use warnings; + +use Time::HiRes qw//; + +sub format_time { + my $time = shift; + my $s = ""; + + $s .= int($time/60/60)."hr " + if $time > 60*60; + $s .= int(($time % (60*60))/60)."min " + if $time > 60; + $s .= int($time % 60)."s" + if $time < 60*60; + + return $s; +} + +sub progress_bar { + my %args = ( + label => "", + now => 0, + max => 1, + cols => 80, + char => "=", + @_, + ); + $args{now} ||= 0; + + my $fraction = $args{max} ? $args{now} / $args{max} : 0; + + my $max_width = $args{cols} - 30; + my $bar_width = int($max_width * $fraction); + + return sprintf "%20s |%-" . $max_width . "s| %3d%%\n", + $args{label}, $args{char} x $bar_width, $fraction*100; +} + +sub progress { + my %args = ( + top => sub { print "\n\n" }, + bottom => sub {}, + every => 3, + bars => [qw/Ticket Transaction Attachment User Group/], + counts => sub {}, + max => {}, + @_, + ); + + my $max_objects = 0; + $max_objects += $_ for values %{ $args{max} }; + + my $last_time; + my $start; + my $left; + my $offset; + return sub { + my $obj = shift; + my $force = shift; + my $now = Time::HiRes::time(); + return if defined $last_time and $now - $last_time <= $args{every} and not $force; + + $start = $now unless $start; + $last_time = $now; + + my $elapsed = $now - $start; + + # Determine terminal size + print `clear`; + my ($cols, $rows) = (80, 25); + eval { + require Term::ReadKey; + ($cols, $rows) = Term::ReadKey::GetTerminalSize(); + }; + $cols -= 1; + + $args{top}->($elapsed, $rows, $cols); + + my %counts = $args{counts}->(); + for my $class (map {"RT::$_"} @{$args{bars}}) { + my $display = $class; + $display =~ s/^RT::(.*)/@{[$1]}s:/; + print progress_bar( + label => $display, + now => $counts{$class}, + max => $args{max}{$class}, + cols => $cols, + ); + } + + my $total = 0; + $total += $_ for map {$counts{$_}} grep {exists $args{max}{$_}} keys %counts; + $offset = $total unless defined $offset; + print "\n", progress_bar( + label => "Total", + now => $total, + max => $max_objects, + cols => $cols, + char => "#", + ); + + # Time estimates + my $fraction = $max_objects + ? ($total - $offset)/($max_objects - $offset) + : 0; + if ($fraction > 0.03) { + if (defined $left) { + $left = 0.75 * $left + + 0.25 * ($elapsed / $fraction - $elapsed); + } else { + $left = ($elapsed / $fraction - $elapsed); + } + } + print "\n"; + printf "%20s %s\n", "Elapsed time:", + format_time($elapsed); + printf "%20s %s\n", "Estimated left:", + (defined $left) ? format_time($left) : "-"; + + $args{bottom}->($elapsed, $rows, $cols); + } + +} + +sub setup_logging { + my ($dir, $file) = @_; + + + RT->Config->Set(LogToSTDERR => 'warning'); + RT->Config->Set(LogToFile => 'warning'); + RT->Config->Set(LogDir => $dir); + RT->Config->Set(LogToFileNamed => $file); + RT->Config->Set(LogStackTraces => 'error'); + + undef $RT::Logger; + RT->InitLogging(); + + my $logger = $RT::Logger->output('file') || $RT::Logger->output("rtlog"); + return $logger ? $logger->{filename} : undef; +} + +1; diff --git a/rt/lib/RT/Migrate/Importer.pm b/rt/lib/RT/Migrate/Importer.pm new file mode 100644 index 0000000..58ee632 --- /dev/null +++ b/rt/lib/RT/Migrate/Importer.pm @@ -0,0 +1,468 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Migrate::Importer; + +use strict; +use warnings; + +use Storable qw//; +use File::Spec; +use Carp qw/carp/; + +sub new { + my $class = shift; + my $self = bless {}, $class; + $self->Init(@_); + return $self; +} + +sub Init { + my $self = shift; + my %args = ( + OriginalId => undef, + Progress => undef, + Statefile => undef, + DumpObjects => undef, + HandleError => undef, + @_, + ); + + # Should we attempt to preserve record IDs as they are created? + $self->{OriginalId} = $args{OriginalId}; + + $self->{Progress} = $args{Progress}; + + $self->{HandleError} = sub { 0 }; + $self->{HandleError} = $args{HandleError} + if $args{HandleError} and ref $args{HandleError} eq 'CODE'; + + if ($args{DumpObjects}) { + require Data::Dumper; + $self->{DumpObjects} = { map { $_ => 1 } @{$args{DumpObjects}} }; + } + + # Objects we've created + $self->{UIDs} = {}; + + # Columns we need to update when an object is later created + $self->{Pending} = {}; + + # Objects missing from the source database before serialization + $self->{Invalid} = []; + + # What we created + $self->{ObjectCount} = {}; + + # To know what global CFs need to be unglobal'd and applied to what + $self->{NewQueues} = []; + $self->{NewCFs} = []; +} + +sub Metadata { + my $self = shift; + return $self->{Metadata}; +} + +sub LoadMetadata { + my $self = shift; + my ($data) = @_; + + return if $self->{Metadata}; + $self->{Metadata} = $data; + + die "Incompatible format version: ".$data->{Format} + if $data->{Format} ne "0.8"; + + $self->{Organization} = $data->{Organization}; + $self->{Clone} = $data->{Clone}; + $self->{Incremental} = $data->{Incremental}; + $self->{Files} = $data->{Files} if $data->{Final}; +} + +sub InitStream { + my $self = shift; + + die "Stream initialized after objects have been recieved!" + if keys %{ $self->{UIDs} }; + + die "Cloning does not support importing the Original Id separately\n" + if $self->{OriginalId} and $self->{Clone}; + + die "RT already contains data; overwriting will not work\n" + if ($self->{Clone} and not $self->{Incremental}) + and RT->SystemUser->Id; + + # Basic facts of life, as a safety net + $self->Resolve( RT->System->UID => ref RT->System, RT->System->Id ); + $self->SkipTransactions( RT->System->UID ); + + if ($self->{OriginalId}) { + # Where to shove the original ticket ID + my $cf = RT::CustomField->new( RT->SystemUser ); + $cf->LoadByName( Name => $self->{OriginalId}, LookupType => RT::Ticket->CustomFieldLookupType, ObjectId => 0 ); + unless ($cf->Id) { + warn "Failed to find global CF named $self->{OriginalId} -- creating one"; + $cf->Create( + Queue => 0, + Name => $self->{OriginalId}, + Type => 'FreeformSingle', + ); + } + } +} + +sub Resolve { + my $self = shift; + my ($uid, $class, $id) = @_; + $self->{UIDs}{$uid} = [ $class, $id ]; + return unless $self->{Pending}{$uid}; + + for my $ref (@{$self->{Pending}{$uid}}) { + my ($pclass, $pid) = @{ $self->Lookup( $ref->{uid} ) }; + my $obj = $pclass->new( RT->SystemUser ); + $obj->LoadByCols( Id => $pid ); + $obj->__Set( + Field => $ref->{column}, + Value => $id, + ) if defined $ref->{column}; + $obj->__Set( + Field => $ref->{classcolumn}, + Value => $class, + ) if defined $ref->{classcolumn}; + $obj->__Set( + Field => $ref->{uri}, + Value => $self->LookupObj($uid)->URI, + ) if defined $ref->{uri}; + } + delete $self->{Pending}{$uid}; +} + +sub Lookup { + my $self = shift; + my ($uid) = @_; + unless (defined $uid) { + carp "Tried to lookup an undefined UID"; + return; + } + return $self->{UIDs}{$uid}; +} + +sub LookupObj { + my $self = shift; + my ($uid) = @_; + my $ref = $self->Lookup( $uid ); + return unless $ref; + my ($class, $id) = @{ $ref }; + + my $obj = $class->new( RT->SystemUser ); + $obj->Load( $id ); + return $obj; +} + +sub Postpone { + my $self = shift; + my %args = ( + for => undef, + uid => undef, + column => undef, + classcolumn => undef, + uri => undef, + @_, + ); + my $uid = delete $args{for}; + + if (defined $uid) { + push @{$self->{Pending}{$uid}}, \%args; + } else { + push @{$self->{Invalid}}, \%args; + } +} + +sub SkipTransactions { + my $self = shift; + my ($uid) = @_; + return if $self->{Clone}; + $self->{SkipTransactions}{$uid} = 1; +} + +sub ShouldSkipTransaction { + my $self = shift; + my ($uid) = @_; + return exists $self->{SkipTransactions}{$uid}; +} + +sub MergeValues { + my $self = shift; + my ($obj, $data) = @_; + for my $col (keys %{$data}) { + next if defined $obj->__Value($col) and length $obj->__Value($col); + next unless defined $data->{$col} and length $data->{$col}; + + if (ref $data->{$col}) { + my $uid = ${ $data->{$col} }; + my $ref = $self->Lookup( $uid ); + if ($ref) { + $data->{$col} = $ref->[1]; + } else { + $self->Postpone( + for => $obj->UID, + uid => $uid, + column => $col, + ); + next; + } + } + $obj->__Set( Field => $col, Value => $data->{$col} ); + } +} + +sub SkipBy { + my $self = shift; + my ($column, $class, $uid, $data) = @_; + + my $obj = $class->new( RT->SystemUser ); + $obj->Load( $data->{$column} ); + return unless $obj->Id; + + $self->SkipTransactions( $uid ); + + $self->Resolve( $uid => $class => $obj->Id ); + return $obj; +} + +sub MergeBy { + my $self = shift; + my ($column, $class, $uid, $data) = @_; + + my $obj = $self->SkipBy(@_); + return unless $obj; + $self->MergeValues( $obj, $data ); + return 1; +} + +sub Qualify { + my $self = shift; + my ($string) = @_; + return $string if $self->{Clone}; + return $string if not defined $self->{Organization}; + return $string if $self->{Organization} eq $RT::Organization; + return $self->{Organization}.": $string"; +} + +sub Create { + my $self = shift; + my ($class, $uid, $data) = @_; + + # Use a simpler pre-inflation if we're cloning + if ($self->{Clone}) { + $class->RT::Record::PreInflate( $self, $uid, $data ); + } else { + # Non-cloning always wants to make its own id + delete $data->{id}; + return unless $class->PreInflate( $self, $uid, $data ); + } + + my $obj = $class->new( RT->SystemUser ); + my ($id, $msg) = eval { + # catch and rethrow on the outside so we can provide more info + local $SIG{__DIE__}; + $obj->DBIx::SearchBuilder::Record::Create( + %{$data} + ); + }; + if (not $id or $@) { + $msg ||= ''; # avoid undef + my $err = "Failed to create $uid: $msg $@\n" . Data::Dumper::Dumper($data) . "\n"; + if (not $self->{HandleError}->($self, $err)) { + die $err; + } else { + return; + } + } + + $self->{ObjectCount}{$class}++; + $self->Resolve( $uid => $class, $id ); + + # Load it back to get real values into the columns + $obj = $class->new( RT->SystemUser ); + $obj->Load( $id ); + $obj->PostInflate( $self ); + + return $obj; +} + +sub ReadStream { + my $self = shift; + my ($fh) = @_; + + no warnings 'redefine'; + local *RT::Ticket::Load = sub { + my $self = shift; + my $id = shift; + $self->LoadById( $id ); + return $self->Id; + }; + + my $loaded = Storable::fd_retrieve($fh); + + # Metadata is stored at the start of the stream as a hashref + if (ref $loaded eq "HASH") { + $self->LoadMetadata( $loaded ); + $self->InitStream; + return; + } + + my ($class, $uid, $data) = @{$loaded}; + + if ($self->{Incremental}) { + my $obj = $class->new( RT->SystemUser ); + $obj->Load( $data->{id} ); + if (not $uid) { + # undef $uid means "delete it" + $obj->Delete; + $self->{ObjectCount}{$class}++; + } elsif ( $obj->Id ) { + # If it exists, update it + $class->RT::Record::PreInflate( $self, $uid, $data ); + $obj->__Set( Field => $_, Value => $data->{$_} ) + for keys %{ $data }; + $self->{ObjectCount}{$class}++; + } else { + # Otherwise, make it + $obj = $self->Create( $class, $uid, $data ); + } + $self->{Progress}->($obj) if $obj and $self->{Progress}; + return; + } elsif ($self->{Clone}) { + my $obj = $self->Create( $class, $uid, $data ); + $self->{Progress}->($obj) if $obj and $self->{Progress}; + return; + } + + # If it's a queue, store its ID away, as we'll need to know + # it to split global CFs into non-global across those + # fields. We do this before inflating, so that queues which + # got merged still get the CFs applied + push @{$self->{NewQueues}}, $uid + if $class eq "RT::Queue"; + + my $origid = $data->{id}; + my $obj = $self->Create( $class, $uid, $data ); + return unless $obj; + + # If it's a ticket, we might need to create a + # TicketCustomField for the previous ID + if ($class eq "RT::Ticket" and $self->{OriginalId}) { + my ($id, $msg) = $obj->AddCustomFieldValue( + Field => $self->{OriginalId}, + Value => $self->Organization . ":$origid", + RecordTransaction => 0, + ); + warn "Failed to add custom field to $uid: $msg" + unless $id; + } + + # If it's a CF, we don't know yet if it's global (the OCF + # hasn't been created yet) to store away the CF for later + # inspection + push @{$self->{NewCFs}}, $uid + if $class eq "RT::CustomField" + and $obj->LookupType =~ /^RT::Queue/; + + $self->{Progress}->($obj) if $self->{Progress}; +} + +sub CloseStream { + my $self = shift; + + $self->{Progress}->(undef, 'force') if $self->{Progress}; + + return if $self->{Clone}; + + # Take global CFs which we made and make them un-global + my @queues = grep {$_} map {$self->LookupObj( $_ )} @{$self->{NewQueues}}; + for my $obj (map {$self->LookupObj( $_ )} @{$self->{NewCFs}}) { + my $ocf = $obj->IsGlobal or next; + $ocf->Delete; + $obj->AddToObject( $_ ) for @queues; + } + $self->{NewQueues} = []; + $self->{NewCFs} = []; +} + + +sub ObjectCount { + my $self = shift; + return %{ $self->{ObjectCount} }; +} + +sub Missing { + my $self = shift; + return wantarray ? sort keys %{ $self->{Pending} } + : keys %{ $self->{Pending} }; +} + +sub Invalid { + my $self = shift; + return wantarray ? sort { $a->{uid} cmp $b->{uid} } @{ $self->{Invalid} } + : $self->{Invalid}; +} + +sub Organization { + my $self = shift; + return $self->{Organization}; +} + +sub Progress { + my $self = shift; + return defined $self->{Progress} unless @_; + return $self->{Progress} = $_[0]; +} + +1; diff --git a/rt/lib/RT/Migrate/Importer/File.pm b/rt/lib/RT/Migrate/Importer/File.pm new file mode 100644 index 0000000..176bc26 --- /dev/null +++ b/rt/lib/RT/Migrate/Importer/File.pm @@ -0,0 +1,208 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Migrate::Importer::File; + +use strict; +use warnings; +use base qw(RT::Migrate::Importer); + +sub Init { + my $self = shift; + my %args = ( + Directory => undef, + Resume => undef, + @_ + ); + + # Directory is required + die "Directory is required" unless $args{Directory}; + die "Invalid path $args{Directory}" unless -d $args{Directory}; + $self->{Directory} = $args{Directory}; + + # Load metadata, if present + if (-e "$args{Directory}/rt-serialized") { + my $dat = eval { Storable::retrieve("$args{Directory}/rt-serialized"); } + or die "Failed to load metadata" . ($@ ? ": $@" : ""); + $self->LoadMetadata($dat); + } + + # Support resuming + $self->{Statefile} = $args{Statefile} || "$args{Directory}/partial-import"; + unlink $self->{Statefile} + if -f $self->{Statefile} and not $args{Resume}; + + return $self->SUPER::Init(@_); +} + +sub Import { + my $self = shift; + my $dir = $self->{Directory}; + + if ($self->{Metadata} and $self->{Metadata}{Files}) { + $self->{Files} = [ map {s|^.*/|$dir/|;$_} @{$self->{Metadata}{Files}} ]; + } else { + $self->{Files} = [ <$dir/*.dat> ]; + } + $self->{Files} = [ map {File::Spec->rel2abs($_)} @{ $self->{Files} } ]; + + $self->RestoreState( $self->{Statefile} ); + + local $SIG{ INT } = sub { $self->{INT} = 1 }; + local $SIG{__DIE__} = sub { warn "\n", @_; $self->SaveState; exit 1 }; + + $self->{Progress}->(undef) if $self->{Progress}; + while (@{$self->{Files}}) { + $self->{Filename} = shift @{$self->{Files}}; + open(my $fh, "<", $self->{Filename}) + or die "Can't read $self->{Filename}: $!"; + if ($self->{Seek}) { + seek($fh, $self->{Seek}, 0) + or die "Can't seek to $self->{Seek} in $self->{Filename}"; + $self->{Seek} = undef; + } + while (not eof($fh)) { + $self->{Position} = tell($fh); + + # Stop when we're at a good stopping point + die "Caught interrupt, quitting.\n" if $self->{INT}; + + $self->ReadStream( $fh ); + } + } + + $self->CloseStream; + + # Return creation counts + return $self->ObjectCount; +} + +sub List { + my $self = shift; + my $dir = $self->{Directory}; + + my %found = ( "RT::System" => 1 ); + my @files = ($self->{Metadata} and $self->{Metadata}{Files}) ? + @{ $self->{Metadata}{Files} } : <$dir/*.dat>; + @files = map {File::Spec->rel2abs($_)} @files; + + for my $filename (@files) { + open(my $fh, "<", $filename) + or die "Can't read $filename: $!"; + while (not eof($fh)) { + my $loaded = Storable::fd_retrieve($fh); + if (ref $loaded eq "HASH") { + $self->LoadMetadata( $loaded ); + next; + } + + if ($self->{DumpObjects}) { + print STDERR Data::Dumper::Dumper($loaded), "\n" + if $self->{DumpObjects}{ $loaded->[0] }; + } + + my ($class, $uid, $data) = @{$loaded}; + $self->{ObjectCount}{$class}++; + $found{$uid} = 1; + delete $self->{Pending}{$uid}; + for (grep {ref $data->{$_}} keys %{$data}) { + my $uid_ref = ${ $data->{$_} }; + unless (defined $uid_ref) { + push @{ $self->{Invalid} }, { uid => $uid, column => $_ }; + next; + } + next if $found{$uid_ref}; + next if $uid_ref =~ /^RT::Principal-/; + push @{$self->{Pending}{$uid_ref} ||= []}, {uid => $uid}; + } + } + } + + return $self->ObjectCount; +} + +sub RestoreState { + my $self = shift; + my ($statefile) = @_; + return unless $statefile && -f $statefile; + + my $state = Storable::retrieve( $self->{Statefile} ); + $self->{$_} = $state->{$_} for keys %{$state}; + unlink $self->{Statefile}; + + print STDERR "Resuming partial import...\n"; + sleep 2; + return 1; +} + +sub SaveState { + my $self = shift; + + my %data; + unshift @{$self->{Files}}, $self->{Filename}; + $self->{Seek} = $self->{Position}; + $data{$_} = $self->{$_} for + qw/Filename Seek Position Files + Organization ObjectCount + NewQueues NewCFs + SkipTransactions Pending Invalid + UIDs + OriginalId Clone + /; + Storable::nstore(\%data, $self->{Statefile}); + + print STDERR <<EOT; + +Importer state has been written to the file: + $self->{Statefile} + +It may be possible to resume the import by re-running rt-importer. +EOT +} + +1; diff --git a/rt/lib/RT/Migrate/Incremental.pm b/rt/lib/RT/Migrate/Incremental.pm new file mode 100644 index 0000000..61aea6c --- /dev/null +++ b/rt/lib/RT/Migrate/Incremental.pm @@ -0,0 +1,657 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Migrate::Incremental; + +use strict; +use warnings; +require Storable; +require MIME::Base64; + +our %UPGRADES = ( + '3.3.0' => { + 'RT::Transaction' => sub { + my ($ref) = @_; + $ref->{ObjectType} = 'RT::Ticket'; + $ref->{ObjectId} = delete $ref->{Ticket}; + delete $ref->{EffectiveTicket}; + }, + 'RT::TicketCustomFieldValue' => sub { + my ($ref, $classref) = @_; + $$classref = "RT::ObjectCustomFieldValue"; + $ref->{ObjectType} = 'RT::Ticket'; + $ref->{ObjectId} = delete $ref->{Ticket}; + }, + '-RT::TicketCustomFieldValue' => sub { + my ($ref, $classref) = @_; + $$classref = "RT::ObjectCustomFieldValue"; + }, + 'RT::CustomField' => sub { + my ($ref) = @_; + $ref->{MaxValues} = 0 if $ref->{Type} =~ /Multiple$/; + $ref->{MaxValues} = 1 if $ref->{Type} =~ /Single$/; + $ref->{Type} = 'Select' if $ref->{Type} =~ /^Select/; + $ref->{Type} = 'Freeform' if $ref->{Type} =~ /^Freeform/; + $ref->{LookupType} = 'RT::Queue-RT::Ticket'; + delete $ref->{Queue}; + }, + '+RT::CustomField' => sub { + my ($ref) = @_; + return [ + "RT::ObjectCustomField" => rand(1), + { + id => undef, + CustomField => $ref->{id}, + ObjectId => $ref->{Queue}, + SortOrder => $ref->{SortOrder}, + Creator => $ref->{Creator}, + LastUpdatedBy => $ref->{LastUpdatedBy}, + } + ]; + } + }, + + '3.3.11' => { + 'RT::ObjectCustomFieldValue' => sub { + my ($ref) = @_; + $ref->{Disabled} = not delete $ref->{Current}; + }, + }, + + '3.7.19' => { + 'RT::Scrip' => sub { + my ($ref) = @_; + return if defined $ref->{Description} and length $ref->{Description}; + + my $scrip = RT::Scrip->new( $RT::SystemUser ); + $scrip->Load( $ref->{id} ); + my $condition = $scrip->ConditionObj->Name + || $scrip->ConditionObj->Description + || ('On Condition #'. $scrip->Condition); + my $action = $scrip->ActionObj->Name + || $scrip->ActionObj->Description + || ('Run Action #'. $scrip->Action); + $ref->{Description} = join ' ', $condition, $action; + }, + }, + + # XXX BrandedQueues + # XXX iCal + + '3.8.2' => { + 'RT::Template' => sub { + my ($ref) = @_; + return unless $ref->{Queue}; + + my $queue = RT::Queue->new( $RT::SystemUser ); + $queue->Load( $ref->{Queue} ); + return unless $queue->Id and $queue->Name eq "___Approvals"; + + $ref->{Name} = "[OLD] ".$ref->{Name}; + }, + 'RT::Attribute' => sub { + my ($ref) = @_; + return unless $ref->{Name} eq "Dashboard"; + + my $v = eval { + Storable::thaw(MIME::Base64::decode_base64($ref->{Content})) + }; + return unless $v and exists $v->{Searches}; + $v->{Panes} = { + body => [ + map { + my ($privacy, $id, $desc) = @$_; + +{ + portlet_type => 'search', + privacy => $privacy, + id => $id, + description => $desc, + pane => 'body', + } + } @{ delete $v->{Searches} } + ], + }; + $ref->{Content} = MIME::Base64::encode_base64( + Storable::nfreeze($v) ); + }, + 'RT::Scrip' => sub { + my ($ref, $classref) = @_; + return unless $ref->{Queue}; + + my $queue = RT::Queue->new( $RT::SystemUser ); + $queue->Load( $ref->{Queue} ); + return unless $queue->Id and $queue->Name eq "___Approvals"; + + $$classref = undef; + }, + }, + + '3.8.3' => { + 'RT::ScripAction' => sub { + my ($ref) = @_; + return unless ($ref->{Argument}||"") eq "All"; + if ($ref->{ExecModule} eq "Notify") { + $ref->{Name} = 'Notify Owner, Requestors, Ccs and AdminCcs'; + $ref->{Description} = 'Send mail to owner and all watchers'; + } elsif ($ref->{ExecModule} eq "NotifyAsComment") { + $ref->{Name} = 'Notify Owner, Requestors, Ccs and AdminCcs as Comment'; + $ref->{Description} = 'Send mail to owner and all watchers as a "comment"'; + } + }, + }, + + '3.8.4' => { + 'RT::ScripAction' => sub { + my ($ref) = @_; + return unless $ref->{ExecModule} eq "NotifyGroup" + or $ref->{ExecModule} eq "NotifyGroupAsComment"; + + my $argument = $ref->{Argument}; + if ( my $struct = eval { Storable::thaw( $argument ) } ) { + my @res; + foreach my $r ( @{ $struct } ) { + my $obj; + next unless $r->{'Type'}; + if( lc $r->{'Type'} eq 'user' ) { + $obj = RT::User->new( $RT::SystemUser ); + } elsif ( lc $r->{'Type'} eq 'group' ) { + $obj = RT::Group->new( $RT::SystemUser ); + } else { + next; + } + $obj->Load( $r->{'Instance'} ); + next unless $obj->id ; + + push @res, $obj->id; + } + $ref->{Argument} = join ",", @res; + } else { + $ref->{Argument} = join ",", grep length, split /[^0-9]+/, $argument; + } + }, + }, + + '3.8.8' => { + 'RT::ObjectCustomField' => sub { + # XXX Removing OCFs applied both global and non-global + # XXX Fixing SortOrder on OCFs + }, + }, + + '3.8.9' => { + 'RT::Link' => sub { + my ($ref) = @_; + my $prefix = RT::URI::fsck_com_rt->LocalURIPrefix . '/ticket/'; + for my $dir (qw(Target Base)) { + next unless $ref->{$dir} =~ /^$prefix(.*)/; + next unless int($1) eq $1; + next if $ref->{'Local'.$dir}; + $ref->{'Local'.$dir} = $1; + } + }, + 'RT::Template' => sub { + my ($ref) = @_; + + return unless $ref->{Name} =~ + /^(All Approvals Passed|Approval Passed|Approval Rejected)$/; + + my $queue = RT::Queue->new( $RT::SystemUser ); + $queue->Load( $ref->{Queue} ); + return unless $queue->Id and $queue->Name eq "___Approvals"; + + $ref->{Content} =~ +s!(?<=Your ticket has been (?:approved|rejected) by \{ eval \{ )\$Approval->OwnerObj->Name!\$Approver->Name!; + }, + }, + + '3.9.1' => { + 'RT::Template' => sub { + my ($ref) = @_; + $ref->{Type} = 'Perl'; + }, + # XXX: Add ExecuteCode to principals that currently have ModifyTemplate or ModifyScrips + }, + + '3.9.2' => { + 'RT::ACE' => sub { + my ($ref, $classref) = @_; + $$classref = undef if $ref->{DelegatedBy} > 0 + or $ref->{DelegatedFrom} > 0; + }, + + 'RT::GroupMember' => sub { + my ($ref, $classref) = @_; + my $group = RT::Group->new( $RT::SystemUser ); + $group->Load( $ref->{GroupId} ); + $$classref = undef if $group->Domain eq "Personal"; + }, + 'RT::Group' => sub { + my ($ref, $classref) = @_; + $$classref = undef if $ref->{Domain} eq "Personal"; + }, + 'RT::Principal' => sub { + my ($ref, $classref) = @_; + return unless $ref->{PrincipalType} eq "Group"; + my $group = RT::Group->new( $RT::SystemUser ); + $group->Load( $ref->{ObjectId} ); + $$classref = undef if $group->Domain eq "Personal"; + }, + }, + + '3.9.3' => { + 'RT::ACE' => sub { + my ($ref) = @_; + delete $ref->{DelegatedBy}; + delete $ref->{DelegatedFrom}; + }, + }, + + '3.9.5' => { + 'RT::CustomFieldValue' => sub { + my ($ref) = @_; + my $attr = RT::Attribute->new( $RT::SystemUser ); + $attr->LoadByCols( + ObjectType => "RT::CustomFieldValue", + ObjectId => $ref->{Id}, + Name => "Category", + ); + $ref->{Category} = $attr->Content if $attr->id; + }, + 'RT::Attribute' => sub { + my ($ref, $classref) = @_; + $$classref = undef if $ref->{Name} eq "Category" + and $ref->{ObjectType} eq "RT::CustomFieldValue"; + }, + }, + + '3.9.7' => { + 'RT::User' => sub { + my ($ref) = @_; + my $attr = RT::Attribute->new( $RT::SystemUser ); + $attr->LoadByCols( + ObjectType => "RT::User", + ObjectId => $ref->{id}, + Name => "AuthToken", + ); + $ref->{AuthToken} = $attr->Content if $attr->id; + }, + 'RT::CustomField' => sub { + my ($ref) = @_; + for my $name (qw/RenderType BasedOn ValuesClass/) { + my $attr = RT::Attribute->new( $RT::SystemUser ); + $attr->LoadByCols( + ObjectType => "RT::CustomField", + ObjectId => $ref->{id}, + Name => $name, + ); + $ref->{$name} = $attr->Content if $attr->id; + } + }, + 'RT::Queue' => sub { + my ($ref) = @_; + my $attr = RT::Attribute->new( + ObjectType => "RT::System", + ObjectId => 1, + Name => "BrandedSubjectTag", + );; + return unless $attr->id; + my $map = $attr->Content || {}; + return unless $map->{$ref->{id}}; + $ref->{SubjectTag} = $map->{$ref->{id}}; + }, + 'RT::Attribute' => sub { + my ($ref, $classref) = @_; + if ($ref->{ObjectType} eq "RT::User" and $ref->{Name} eq "AuthToken") { + $$classref = undef; + } elsif ($ref->{ObjectType} eq "RT::CustomField" and $ref->{Name} eq "RenderType") { + $$classref = undef; + } elsif ($ref->{ObjectType} eq "RT::CustomField" and $ref->{Name} eq "BasedOn") { + $$classref = undef; + } elsif ($ref->{ObjectType} eq "RT::CustomField" and $ref->{Name} eq "ValuesClass") { + $$classref = undef; + } elsif ($ref->{ObjectType} eq "RT::System" and $ref->{Name} eq "BrandedSubjectTag") { + $$classref = undef; + } + }, + }, + + '3.9.8' => { + # XXX RTFM => Articles + }, + + '4.0.0rc7' => { + 'RT::Queue' => sub { + my ($ref) = @_; + return unless $ref->{Name} eq '___Approvals'; + $ref->{Lifecycle} = "approvals"; + }, + }, + + '4.0.1' => { + 'RT::ACE' => sub { + my ($ref, $classref) = @_; + my $group = RT::Group->new( $RT::SystemUser ); + $group->LoadByCols( + id => $ref->{PrincipalId}, + Domain => "Personal", + ); + $$classref = undef if $group->id; + $$classref = undef if $ref->{RightName} =~ + /^(AdminOwnPersonalGroups|AdminAllPersonalGroups|DelegateRights)$/; + $$classref = undef if $ref->{RightName} =~ + /^(RejectTicket|ModifyTicketStatus)$/; + }, + }, + + '4.0.4' => { + 'RT::Template' => sub { + my ($ref) = @_; + $ref->{Type} ||= 'Perl'; + }, + }, + + '4.0.6' => { + 'RT::Transaction' => sub { + my ($ref) = @_; + return unless $ref->{ObjectType} eq "RT::User" and $ref->{Field} eq "Password"; + $ref->{OldValue} = $ref->{NewValue} = '********'; + }, + }, + + '4.0.9' => { + 'RT::Queue' => sub { + my ($ref) = @_; + $ref->{Lifecycle} ||= 'default'; + }, + }, + + '4.0.19' => { + 'RT::CustomField' => sub { + my ($ref) = @_; + $ref->{LookupType} = 'RT::Class-RT::Article' + if $ref->{LookupType} eq 'RT::FM::Class-RT::FM::Article'; + }, + 'RT::ObjectCustomFieldValue' => sub { + my ($ref) = @_; + $ref->{ObjectType} = 'RT::Article' + if $ref->{ObjectType} eq 'RT::FM::Article'; + }, + }, + + + '4.1.0' => { + 'RT::Attribute' => sub { + my ($ref) = @_; + return unless $ref->{Name} eq "HomepageSettings"; + + my $v = eval { + Storable::thaw(MIME::Base64::decode_base64($ref->{Content})) + }; + return if not $v or $v->{sidebar}; + $v->{sidebar} = delete $v->{summary}; + $ref->{Content} = MIME::Base64::encode_base64( + Storable::nfreeze($v) ); + }, + }, + + '4.1.1' => { + '+RT::Scrip' => sub { + my ($ref) = @_; + my $new = [ + "RT::ObjectScrip" => rand(1), + { + id => undef, + Scrip => $ref->{id}, + Stage => delete $ref->{Stage}, + ObjectId => delete $ref->{Queue}, + Creator => $ref->{Creator}, + Created => $ref->{Created}, + LastUpdatedBy => $ref->{LastUpdatedBy}, + LastUpdated => $ref->{LastUpdated}, + } + ]; + if ( $new->[2]{Stage} eq "Disabled" ) { + $ref->{Disabled} = 1; + $new->[2]{Stage} = "TransactionCreate"; + } else { + $ref->{Disabled} = 0; + } + # XXX SortOrder + return $new; + }, + }, + + '4.1.4' => { + 'RT::Group' => sub { + my ($ref) = @_; + $ref->{Instance} = 1 + if $ref->{Domain} eq "RT::System-Role" + and $ref->{Instance} = 0; + }, + # XXX Invalid rights + }, + + '4.1.5' => { + 'RT::Scrip' => sub { + my ($ref) = @_; + my $template = RT::Template->new( $RT::SystemUser ); + $template->Load( $ref->{Template} ); + $ref->{Template} = $template->id ? $template->Name : 'Blank'; + }, + }, + + '4.1.6' => { + 'RT::Attribute' => sub { + my ($ref) = @_; + return unless $ref->{Name} eq RT::User::_PrefName( RT->System ) + and $ref->{ObjectType} eq "RT::User"; + my $v = eval { + Storable::thaw(MIME::Base64::decode_base64($ref->{Content})) + }; + return if not $v or $v->{ShowHistory}; + $v->{ShowHistory} = delete $v->{DeferTransactionLoading} + ? "click" : "delay"; + $ref->{Content} = MIME::Base64::encode_base64( + Storable::nfreeze($v) ); + }, + }, + + '4.1.7' => { + 'RT::Transaction' => sub { + my ($ref) = @_; + return unless $ref->{ObjectType} eq 'RT::Ticket' + and $ref->{Type} eq 'Set' + and $ref->{Field} eq 'TimeWorked'; + $ref->{TimeTaken} = $ref->{NewValue} - $ref->{OldValue}; + }, + }, + + '4.1.8' => { + 'RT::Ticket' => sub { + my ($ref) = @_; + $ref->{IsMerged} = 1 if $ref->{id} != $ref->{EffectiveId}; + }, + }, + + '4.1.10' => { + 'RT::ObjectcustomFieldValue' => sub { + my ($ref) = @_; + $ref->{Content} = undef if defined $ref->{LargeContent} + and defined $ref->{Content} and $ref->{Content} eq ''; + }, + }, + + '4.1.11' => { + 'RT::CustomField' => sub { + my ($ref) = @_; + delete $ref->{Repeated}; + }, + }, + + '4.1.13' => { + 'RT::Group' => sub { + my ($ref) = @_; + $ref->{Name} = $ref->{Type} + if $ref->{Domain} =~ /^(ACLEquivalence|SystemInternal|.*-Role)$/; + }, + }, + + '4.1.14' => { + 'RT::Scrip' => sub { + my ($ref) = @_; + delete $ref->{ConditionRules}; + delete $ref->{ActionRules}; + }, + }, + + '4.1.17' => { + 'RT::Attribute' => sub { + my ($ref) = @_; + return unless $ref->{Name} eq 'SavedSearch'; + my $v = eval { + Storable::thaw(MIME::Base64::decode_base64($ref->{Content})) + }; + return unless $v and ref $v and ($v->{SearchType}||'') eq 'Chart'; + + # Switch from PrimaryGroupBy to GroupBy name + # Switch from "CreatedMonthly" to "Created.Monthly" + $v->{GroupBy} ||= [delete $v->{PrimaryGroupBy}]; + for (@{$v->{GroupBy}}) { + next if /\./; + s/(?<=[a-z])(?=[A-Z])/./; + } + $ref->{Content} = MIME::Base64::encode_base64( + Storable::nfreeze($v) ); + }, + }, + + '4.1.19' => { + 'RT::Template' => sub { + my ($ref) = @_; + delete $ref->{Language}; + delete $ref->{TranslationOf}; + }, + }, + + '4.1.20' => { + 'RT::Template' => sub { + my ($ref) = @_; + if ($ref->{Name} eq 'Forward') { + $ref->{Description} = 'Forwarded message'; + if ( $ref->{Content} =~ + m/^\n*This is (a )?forward of transaction #\{\s*\$Transaction->id\s*\} of (a )?ticket #\{\s*\$Ticket->id\s*\}\n*$/ + ) { + $ref->{Content} = q{ +{ $ForwardTransaction->Content =~ /\S/ ? $ForwardTransaction->Content : "This is a forward of transaction #".$Transaction->id." of ticket #". $Ticket->id } +}; + } else { + RT->Logger->error('Current "Forward" template is not the default version, please check docs/UPGRADING-4.2'); + } + } elsif ($ref->{Name} eq 'Forward Ticket') { + $ref->{Description} = 'Forwarded ticket message'; + if ( $ref->{Content} eq q{ + +This is a forward of ticket #{ $Ticket->id } +} ) { + $ref->{Content} = q{ +{ $ForwardTransaction->Content =~ /\S/ ? $ForwardTransaction->Content : "This is a forward of ticket #". $Ticket->id } +}; + } else { + RT->Logger->error('Current "Forward Ticket" template is not the default version, please check docs/UPGRADING-4.2'); + } + } + }, + }, + + '4.1.21' => { + # XXX User dashboards + }, + + '4.1.22' => { + 'RT::Template' => sub { + my ($ref) = @_; + return unless $ref->{Name} eq 'Error: bad GnuPG data'; + $ref->{Name} = 'Error: bad encrypted data'; + $ref->{Description} = + 'Inform user that a message he sent has invalid encryption data'; + $ref->{Content} =~ s/GnuPG signature/signature/g; + }, + # XXX SMIME keys + 'RT::Attribute' => sub { + my ($ref, $classref) = @_; + if ($ref->{ObjectType} eq "RT::User" and $ref->{Name} eq "SMIMEKeyNotAfter") { + $$classref = undef; + } + }, + }, + + '4.2.1' => { + 'RT::Attribute' => sub { + my ($ref, $classref) = @_; + if ($ref->{ObjectType} eq "RT::System" and $ref->{Name} eq "BrandedSubjectTag") { + $$classref = undef; + } + }, + }, + + '4.2.2' => { + 'RT::CustomField' => sub { + my ($ref) = @_; + $ref->{LookupType} = 'RT::Class-RT::Article' + if $ref->{LookupType} eq 'RT::FM::Class-RT::FM::Article'; + }, + 'RT::ObjectCustomFieldValue' => sub { + my ($ref) = @_; + $ref->{ObjectType} = 'RT::Article' + if $ref->{ObjectType} eq 'RT::FM::Article'; + }, + }, + +); + +1; diff --git a/rt/lib/RT/Migrate/Serializer.pm b/rt/lib/RT/Migrate/Serializer.pm new file mode 100644 index 0000000..92be629 --- /dev/null +++ b/rt/lib/RT/Migrate/Serializer.pm @@ -0,0 +1,492 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Migrate::Serializer; + +use strict; +use warnings; + +use base 'RT::DependencyWalker'; + +use Storable qw//; +sub cmp_version($$) { RT::Handle::cmp_version($_[0],$_[1]) }; +use RT::Migrate::Incremental; +use RT::Migrate::Serializer::IncrementalRecord; +use RT::Migrate::Serializer::IncrementalRecords; + +sub Init { + my $self = shift; + + my %args = ( + AllUsers => 1, + AllGroups => 1, + FollowDeleted => 1, + + FollowScrips => 0, + FollowTickets => 1, + FollowACL => 0, + + Clone => 0, + Incremental => 0, + + Verbose => 1, + @_, + ); + + $self->{Verbose} = delete $args{Verbose}; + + $self->{$_} = delete $args{$_} + for qw/ + AllUsers + AllGroups + FollowDeleted + FollowScrips + FollowTickets + FollowACL + Clone + Incremental + /; + + $self->{Clone} = 1 if $self->{Incremental}; + + $self->SUPER::Init(@_, First => "top"); + + # Keep track of the number of each type of object written out + $self->{ObjectCount} = {}; + + if ($self->{Clone}) { + $self->PushAll; + } else { + $self->PushBasics; + } +} + +sub Metadata { + my $self = shift; + + # Determine the highest upgrade step that we run + my @versions = ($RT::VERSION, keys %RT::Migrate::Incremental::UPGRADES); + my ($max) = reverse sort cmp_version @versions; + # we don't want to run upgrades to 4.2.x if we're running + # the serializier on an 4.0 instance. + $max = $RT::VERSION unless $self->{Incremental}; + + return { + Format => "0.8", + VersionFrom => $RT::VERSION, + Version => $max, + Organization => $RT::Organization, + Clone => $self->{Clone}, + Incremental => $self->{Incremental}, + ObjectCount => { $self->ObjectCount }, + @_, + }, +} + +sub PushAll { + my $self = shift; + + # To keep unique constraints happy, we need to remove old records + # before we insert new ones. This fixes the case where a + # GroupMember was deleted and re-added (with a new id, but the same + # membership). + if ($self->{Incremental}) { + my $removed = RT::Migrate::Serializer::IncrementalRecords->new( RT->SystemUser ); + $removed->Limit( FIELD => "UpdateType", VALUE => 3 ); + $removed->OrderBy( FIELD => 'id' ); + $self->PushObj( $removed ); + } + # XXX: This is sadly not sufficient to deal with the general case of + # non-id unique constraints, such as queue names. If queues A and B + # existed, and B->C and A->B renames were done, these will be + # serialized with A->B first, which will fail because there already + # exists a B. + + # Principals first; while we don't serialize these separately during + # normal dependency walking (we fold them into users and groups), + # having them separate during cloning makes logic simpler. + $self->PushCollections(qw(Principals)); + + # Users and groups + $self->PushCollections(qw(Users Groups GroupMembers)); + + # Tickets + $self->PushCollections(qw(Queues Tickets Transactions Attachments Links)); + + # Articles + $self->PushCollections(qw(Articles), map { ($_, "Object$_") } qw(Classes Topics)); + + # Custom Fields + if (RT::ObjectCustomFields->require) { + $self->PushCollections(map { ($_, "Object$_") } qw(CustomFields CustomFieldValues)); + } elsif (RT::TicketCustomFieldValues->require) { + $self->PushCollections(qw(CustomFields CustomFieldValues TicketCustomFieldValues)); + } + + # ACLs + $self->PushCollections(qw(ACL)); + + # Scrips + $self->PushCollections(qw(Scrips ObjectScrips ScripActions ScripConditions Templates)); + + # Attributes + $self->PushCollections(qw(Attributes)); +} + +sub PushCollections { + my $self = shift; + + for my $type (@_) { + my $class = "RT::\u$type"; + + $class->require or next; + my $collection = $class->new( RT->SystemUser ); + $collection->FindAllRows; # be explicit + $collection->CleanSlate; # some collections (like groups and users) join in _Init + $collection->UnLimit; + $collection->OrderBy( FIELD => 'id' ); + + if ($self->{Clone}) { + if ($collection->isa('RT::Tickets')) { + $collection->{allow_deleted_search} = 1; + $collection->IgnoreType; # looking_at_type + } + elsif ($collection->isa('RT::ObjectCustomFieldValues')) { + # FindAllRows (find_disabled_rows) isn't used by OCFVs + $collection->{find_expired_rows} = 1; + } + + if ($self->{Incremental}) { + my $alias = $collection->Join( + ALIAS1 => "main", + FIELD1 => "id", + TABLE2 => "IncrementalRecords", + FIELD2 => "ObjectId", + ); + $collection->DBIx::SearchBuilder::Limit( + ALIAS => $alias, + FIELD => "ObjectType", + VALUE => ref($collection->NewItem), + ); + } + } + + $self->PushObj( $collection ); + } +} + +sub PushBasics { + my $self = shift; + + # System users + for my $name (qw/RT_System root nobody/) { + my $user = RT::User->new( RT->SystemUser ); + my ($id, $msg) = $user->Load( $name ); + warn "No '$name' user found: $msg" unless $id; + $self->PushObj( $user ) if $id; + } + + # System groups + foreach my $name (qw(Everyone Privileged Unprivileged)) { + my $group = RT::Group->new( RT->SystemUser ); + my ($id, $msg) = $group->LoadSystemInternalGroup( $name ); + warn "No '$name' group found: $msg" unless $id; + $self->PushObj( $group ) if $id; + } + + # System role groups + my $systemroles = RT::Groups->new( RT->SystemUser ); + $systemroles->LimitToRolesForObject( RT->System ); + $self->PushObj( $systemroles ); + + # CFs on Users, Groups, Queues + my $cfs = RT::CustomFields->new( RT->SystemUser ); + $cfs->Limit( + FIELD => 'LookupType', + OPERATOR => 'IN', + VALUE => [ qw/RT::User RT::Group RT::Queue/ ], + ); + $self->PushObj( $cfs ); + + # Global attributes + my $attributes = RT::Attributes->new( RT->SystemUser ); + $attributes->LimitToObject( $RT::System ); + $self->PushObj( $attributes ); + + # Global ACLs + if ($self->{FollowACL}) { + my $acls = RT::ACL->new( RT->SystemUser ); + $acls->LimitToObject( $RT::System ); + $self->PushObj( $acls ); + } + + # Global scrips + if ($self->{FollowScrips}) { + my $scrips = RT::Scrips->new( RT->SystemUser ); + $scrips->LimitToGlobal; + + my $templates = RT::Templates->new( RT->SystemUser ); + $templates->LimitToGlobal; + + $self->PushObj( $scrips, $templates ); + $self->PushCollections(qw(ScripActions ScripConditions)); + } + + if ($self->{AllUsers}) { + my $users = RT::Users->new( RT->SystemUser ); + $users->LimitToPrivileged; + $self->PushObj( $users ); + } + + if ($self->{AllGroups}) { + my $groups = RT::Groups->new( RT->SystemUser ); + $groups->LimitToUserDefinedGroups; + $self->PushObj( $groups ); + } + + if (RT::Articles->require) { + $self->PushCollections(qw(Topics Classes)); + } + + $self->PushCollections(qw(Queues)); +} + +sub InitStream { + my $self = shift; + + # Write the initial metadata + my $meta = $self->Metadata; + $! = 0; + Storable::nstore_fd( $meta, $self->{Filehandle} ); + die "Failed to write metadata: $!" if $!; + + return unless cmp_version($meta->{VersionFrom}, $meta->{Version}) < 0; + + my %transforms; + for my $v (sort cmp_version keys %RT::Migrate::Incremental::UPGRADES) { + for my $ref (keys %{$RT::Migrate::Incremental::UPGRADES{$v}}) { + push @{$transforms{$ref}}, $RT::Migrate::Incremental::UPGRADES{$v}{$ref}; + } + } + for my $ref (keys %transforms) { + # XXX Does not correctly deal with updates of $classref, which + # should technically apply all later transforms of the _new_ + # class. This is not relevant in the current upgrades, as + # RT::ObjectCustomFieldValues do not have interesting later + # upgrades if you start from 3.2 (which does + # RT::TicketCustomFieldValues -> RT::ObjectCustomFieldValues) + $self->{Transform}{$ref} = sub { + my ($dat, $classref) = @_; + my @extra; + for my $c (@{$transforms{$ref}}) { + push @extra, $c->($dat, $classref); + return @extra if not $$classref; + } + return @extra; + }; + } +} + +sub NextPage { + my $self = shift; + my ($collection, $last) = @_; + + $last ||= 0; + + if ($self->{Clone}) { + # Clone provides guaranteed ordering by id and with no other id limits + # worry about trampling + + # Use DBIx::SearchBuilder::Limit explicitly to avoid shenanigans in RT::Tickets + $collection->DBIx::SearchBuilder::Limit( + FIELD => 'id', + OPERATOR => '>', + VALUE => $last, + ENTRYAGGREGATOR => 'none', # replaces last limit on this field + ); + } else { + # XXX TODO: this could dig around inside the collection to see how it's + # limited and do the faster paging above under other conditions. + $self->SUPER::NextPage(@_); + } +} + +sub Process { + my $self = shift; + my %args = ( + object => undef, + @_ + ); + + my $obj = $args{object}; + my $uid = $obj->UID; + + # Skip all dependency walking if we're cloning; go straight to + # visiting them. + if ($self->{Clone} and $uid) { + return if $obj->isa("RT::System"); + $self->{progress}->($obj) if $self->{progress}; + return $self->Visit(%args); + } + + return $self->SUPER::Process( @_ ); +} + +sub StackSize { + my $self = shift; + return scalar @{$self->{stack}}; +} + +sub ObjectCount { + my $self = shift; + return %{ $self->{ObjectCount} }; +} + +sub Observe { + my $self = shift; + my %args = ( + object => undef, + direction => undef, + from => undef, + @_ + ); + + my $obj = $args{object}; + my $from = $args{from}; + if ($obj->isa("RT::Ticket")) { + return 0 if $obj->Status eq "deleted" and not $self->{FollowDeleted}; + return $self->{FollowTickets}; + } elsif ($obj->isa("RT::ACE")) { + return $self->{FollowACL}; + } elsif ($obj->isa("RT::Scrip") or $obj->isa("RT::Template") or $obj->isa("RT::ObjectScrip")) { + return $self->{FollowScrips}; + } elsif ($obj->isa("RT::GroupMember")) { + my $grp = $obj->GroupObj->Object; + if ($grp->Domain =~ /^RT::(Queue|Ticket)-Role$/) { + return 0 unless $grp->UID eq $from; + } elsif ($grp->Domain eq "SystemInternal") { + return 0 if $grp->UID eq $from; + } + } + + return 1; +} + +sub Visit { + my $self = shift; + my %args = ( + object => undef, + @_ + ); + + # Serialize it + my $obj = $args{object}; + warn "Writing ".$obj->UID."\n" if $self->{Verbose}; + my @store; + if ($obj->isa("RT::Migrate::Serializer::IncrementalRecord")) { + # These are stand-ins for record removals + my $class = $obj->ObjectType; + my %data = ( id => $obj->ObjectId ); + # -class is used for transforms when dropping a record + if ($self->{Transform}{"-$class"}) { + $self->{Transform}{"-$class"}->(\%data,\$class) + } + @store = ( + $class, + undef, + \%data, + ); + } elsif ($self->{Clone}) { + # Short-circuit and get Just The Basics, Sir if we're cloning + my $class = ref($obj); + my $uid = $obj->UID; + my %data = $obj->RT::Record::Serialize( UIDs => 0 ); + + # +class is used when seeing a record of one class might insert + # a separate record into the stream + if ($self->{Transform}{"+$class"}) { + my @extra = $self->{Transform}{"+$class"}->(\%data,\$class); + for my $e (@extra) { + $! = 0; + Storable::nstore_fd($e, $self->{Filehandle}); + die "Failed to write: $!" if $!; + $self->{ObjectCount}{$e->[0]}++; + } + } + + # Upgrade the record if necessary + if ($self->{Transform}{$class}) { + $self->{Transform}{$class}->(\%data,\$class); + } + + # Transforms set $class to undef to drop the record + return unless $class; + + @store = ( + $class, + $uid, + \%data, + ); + } else { + @store = ( + ref($obj), + $obj->UID, + { $obj->Serialize }, + ); + } + + # Write it out; nstore_fd doesn't trap failures to write, so we have + # to; by clearing $! and checking it afterwards. + $! = 0; + Storable::nstore_fd(\@store, $self->{Filehandle}); + die "Failed to write: $!" if $!; + + $self->{ObjectCount}{$store[0]}++; +} + +1; diff --git a/rt/lib/RT/Migrate/Serializer/File.pm b/rt/lib/RT/Migrate/Serializer/File.pm new file mode 100644 index 0000000..2832365 --- /dev/null +++ b/rt/lib/RT/Migrate/Serializer/File.pm @@ -0,0 +1,171 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Migrate::Serializer::File; + +use strict; +use warnings; + +use base 'RT::Migrate::Serializer'; + +sub Init { + my $self = shift; + + my %args = ( + Directory => undef, + Force => undef, + MaxFileSize => 32, + + @_, + ); + + # Set up the output directory we'll be writing to + my ($y,$m,$d) = (localtime)[5,4,3]; + $args{Directory} = $RT::Organization . + sprintf(":%d-%02d-%02d",$y+1900,$m+1,$d) + unless defined $args{Directory}; + system("rm", "-rf", $args{Directory}) if $args{Force}; + die "Output directory $args{Directory} already exists" + if -d $args{Directory}; + mkdir $args{Directory} + or die "Can't create output directory $args{Directory}: $!\n"; + $self->{Directory} = delete $args{Directory}; + + # How many megabytes each chunk should be, approximitely + $self->{MaxFileSize} = delete $args{MaxFileSize}; + + # Which file we're writing to + $self->{FileCount} = 1; + + $self->SUPER::Init(@_); +} + +sub Metadata { + my $self = shift; + return $self->SUPER::Metadata( + Files => [ $self->Files ], + @_, + ) +} + +sub Export { + my $self = shift; + + # Set up our output file + $self->OpenFile; + + # Write the initial metadata + $self->InitStream; + + # Walk the objects + $self->Walk( @_ ); + + # Close everything back up + $self->CloseFile; + + # Write the summary file + Storable::nstore( + $self->Metadata( Final => 1 ), + $self->Directory . "/rt-serialized" + ); + + return $self->ObjectCount; +} + +sub Visit { + my $self = shift; + + # Rotate if we get too big + my $maxsize = 1024 * 1024 * $self->{MaxFileSize}; + $self->RotateFile if tell($self->{Filehandle}) > $maxsize; + + # Serialize it + $self->SUPER::Visit( @_ ); +} + + +sub Files { + my $self = shift; + return @{ $self->{Files} }; +} + +sub Filename { + my $self = shift; + return sprintf( + "%s/%03d.dat", + $self->{Directory}, + $self->{FileCount} + ); +} + +sub Directory { + my $self = shift; + return $self->{Directory}; +} + +sub OpenFile { + my $self = shift; + open($self->{Filehandle}, ">", $self->Filename) + or die "Can't write to file @{[$self->Filename]}: $!"; + push @{$self->{Files}}, $self->Filename; +} + +sub CloseFile { + my $self = shift; + close($self->{Filehandle}) + or die "Can't close @{[$self->Filename]}: $!"; + $self->{FileCount}++; +} + +sub RotateFile { + my $self = shift; + $self->CloseFile; + $self->OpenFile; +} + +1; diff --git a/rt/lib/RT/Migrate/Serializer/IncrementalRecord.pm b/rt/lib/RT/Migrate/Serializer/IncrementalRecord.pm new file mode 100644 index 0000000..d5df8c8 --- /dev/null +++ b/rt/lib/RT/Migrate/Serializer/IncrementalRecord.pm @@ -0,0 +1,80 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Migrate::Serializer::IncrementalRecord; +use base qw/RT::Record/; + +use strict; +use warnings; + +sub Table {'IncrementalRecords'} + +sub _CoreAccessible { + return { + id => { read => 1 }, + ObjectType => { read => 1 }, + ObjectId => { read => 1 }, + UpdateType => { read => 1 }, + AlteredAt => { read => 1 }, + }; +}; + +1; + +__END__ + +CREATE TABLE IncrementalRecords ( + id INTEGER NOT NULL AUTO_INCREMENT, + ObjectType VARCHAR(50) NOT NULL, + ObjectId INTEGER NOT NULL, + UpdateType TINYINT NOT NULL, + AlteredAt TIMESTAMP NOT NULL, + PRIMARY KEY(ObjectType, ObjectId), + UNIQUE KEY(id), + KEY(UpdateType) +); diff --git a/rt/lib/RT/Shredder/ScripAction.pm b/rt/lib/RT/Migrate/Serializer/IncrementalRecords.pm index baa3d2a..a729caa 100644 --- a/rt/lib/RT/Shredder/ScripAction.pm +++ b/rt/lib/RT/Migrate/Serializer/IncrementalRecords.pm @@ -46,55 +46,24 @@ # # END BPS TAGGED BLOCK }}} -use RT::ScripAction (); -package RT::ScripAction; +package RT::Migrate::Serializer::IncrementalRecords; +use base qw/RT::SearchBuilder/; use strict; use warnings; -use warnings FATAL => 'redefine'; -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -sub __DependsOn -{ +sub _Init { my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Scrips - my $objs = RT::Scrips->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'ScripAction', VALUE => $self->Id ); - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $objs, - Shredder => $args{'Shredder'} - ); - - return $self->SUPER::__DependsOn( %args ); + $self->{'table'} = 'IncrementalRecords'; + $self->{'primary_key'} = 'id'; + return ( $self->SUPER::_Init(@_) ); } -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# TODO: Check here for exec module +sub Table {'IncrementalRecords'} - return $self->SUPER::__Relates( %args ); +sub NewItem { + my $self = shift; + return(RT::Migrate::Serializer::IncrementalRecord->new($self->CurrentUser)); } 1; diff --git a/rt/lib/RT/ObjectClass.pm b/rt/lib/RT/ObjectClass.pm index da664cf..ba96c59 100644 --- a/rt/lib/RT/ObjectClass.pm +++ b/rt/lib/RT/ObjectClass.pm @@ -114,10 +114,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 ObjectType @@ -197,25 +197,38 @@ sub _CoreAccessible { { id => - {read => 1, type => 'int(11)', default => ''}, + {read => 1, type => 'int(11)', default => ''}, Class => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, ObjectType => - {read => 1, write => 1, type => 'varchar(255)', default => ''}, + {read => 1, write => 1, type => 'varchar(255)', default => ''}, ObjectId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', 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); + + $deps->Add( out => $self->ClassObj ); + + my $obj = $self->ObjectType->new( $self->CurrentUser ); + $obj->Load( $self->ObjectId ); + $deps->Add( out => $obj ); +} + RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/ObjectClasses.pm b/rt/lib/RT/ObjectClasses.pm index 89acd9d..3370cf6 100644 --- a/rt/lib/RT/ObjectClasses.pm +++ b/rt/lib/RT/ObjectClasses.pm @@ -70,17 +70,7 @@ sub LimitToClass { } -=head2 NewItem - -Returns an empty new RT::ObjectClass item - -=cut - -sub NewItem { - my $self = shift; - return(RT::ObjectClass->new($self->CurrentUser)); -} - +sub _SingularClass { "RT::ObjectClass" } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/ObjectCustomField.pm b/rt/lib/RT/ObjectCustomField.pm index 4b449d6..b21543b 100644 --- a/rt/lib/RT/ObjectCustomField.pm +++ b/rt/lib/RT/ObjectCustomField.pm @@ -46,92 +46,29 @@ # # END BPS TAGGED BLOCK }}} -package RT::ObjectCustomField; - use strict; use warnings; +package RT::ObjectCustomField; +use base 'RT::Record::AddAndSort'; use RT::CustomField; -use base 'RT::Record'; +use RT::ObjectCustomFields; sub Table {'ObjectCustomFields'} - - - - - -sub Create { +sub ObjectCollectionClass { my $self = shift; - my %args = ( - CustomField => 0, - ObjectId => 0, - SortOrder => undef, - @_ - ); - - my $cf = $self->CustomFieldObj( $args{'CustomField'} ); - unless ( $cf->id ) { - $RT::Logger->error("Couldn't load '$args{'CustomField'}' custom field"); - return 0; - } - - #XXX: Where is ACL check for 'AssignCustomFields'? - - my $ObjectCFs = RT::ObjectCustomFields->new($self->CurrentUser); - $ObjectCFs->LimitToObjectId( $args{'ObjectId'} ); - $ObjectCFs->LimitToCustomField( $cf->id ); - $ObjectCFs->LimitToLookupType( $cf->LookupType ); - if ( my $first = $ObjectCFs->First ) { - $self->Load( $first->id ); - return $first->id; - } - - unless ( defined $args{'SortOrder'} ) { - my $ObjectCFs = RT::ObjectCustomFields->new( RT->SystemUser ); - $ObjectCFs->LimitToObjectId( $args{'ObjectId'} ); - $ObjectCFs->LimitToObjectId( 0 ) if $args{'ObjectId'}; - $ObjectCFs->LimitToLookupType( $cf->LookupType ); - $ObjectCFs->OrderBy( FIELD => 'SortOrder', ORDER => 'DESC' ); - if ( my $first = $ObjectCFs->First ) { - $args{'SortOrder'} = $first->SortOrder + 1; - } else { - $args{'SortOrder'} = 0; - } - } - - return $self->SUPER::Create( - CustomField => $args{'CustomField'}, - ObjectId => $args{'ObjectId'}, - SortOrder => $args{'SortOrder'}, - ); -} - -sub Delete { - my $self = shift; - - my $ObjectCFs = RT::ObjectCustomFields->new($self->CurrentUser); - $ObjectCFs->LimitToObjectId($self->ObjectId); - $ObjectCFs->LimitToLookupType($self->CustomFieldObj->LookupType); - - # Move everything below us up - my $sort_order = $self->SortOrder; - while (my $OCF = $ObjectCFs->Next) { - my $this_order = $OCF->SortOrder; - next if $this_order <= $sort_order; - $OCF->SetSortOrder($this_order - 1); - } - - $self->SUPER::Delete; + my %args = (@_); + return $args{'CustomField'}->CollectionClassFromLookupType; } +# XXX: Where is ACL check when we create a record? =head2 CustomFieldObj Returns the CustomField Object which has the id returned by CustomField - =cut sub CustomFieldObj { @@ -154,148 +91,17 @@ sub CustomFieldObj { return $CF; } -=head2 Sorting custom fields applications - -Custom fields sorted on multiple layers. First of all custom -fields with different lookup type are sorted independently. All -global custom fields have fixed order for all objects, but you -can insert object specific custom fields between them. Object -specific custom fields can be applied to several objects and -be on different place. For example you have GCF1, GCF2, LCF1, -LCF2 and LCF3 that applies to tickets. You can place GCF2 -above GCF1, but they will be in the same order in all queues. -However, LCF1 and other local can be placed at any place -for particular queue: above global, between them or below. - -=head3 MoveUp - -Moves custom field up. See </Sorting custom fields applications>. - -=cut - -sub MoveUp { - my $self = shift; - - my $ocfs = RT::ObjectCustomFields->new( $self->CurrentUser ); - - my $oid = $self->ObjectId; - $ocfs->LimitToObjectId( $oid ); - if ( $oid ) { - $ocfs->LimitToObjectId( 0 ); - } - - my $cf = $self->CustomFieldObj; - $ocfs->LimitToLookupType( $cf->LookupType ); - - $ocfs->Limit( FIELD => 'SortOrder', OPERATOR => '<', VALUE => $self->SortOrder ); - $ocfs->OrderByCols( { FIELD => 'SortOrder', ORDER => 'DESC' } ); - - my @above = ($ocfs->Next, $ocfs->Next); - unless ($above[0]) { - return (0, "Can not move up. It's already at the top"); - } - - my $new_sort_order; - if ( $above[0]->ObjectId == $self->ObjectId ) { - $new_sort_order = $above[0]->SortOrder; - my ($status, $msg) = $above[0]->SetSortOrder( $self->SortOrder ); - unless ( $status ) { - return (0, "Couldn't move custom field"); - } - } - elsif ( $above[1] && $above[0]->SortOrder == $above[1]->SortOrder + 1 ) { - my $move_ocfs = RT::ObjectCustomFields->new( RT->SystemUser ); - $move_ocfs->LimitToLookupType( $cf->LookupType ); - $move_ocfs->Limit( - FIELD => 'SortOrder', - OPERATOR => '>=', - VALUE => $above[0]->SortOrder, - ); - $move_ocfs->OrderByCols( { FIELD => 'SortOrder', ORDER => 'DESC' } ); - while ( my $record = $move_ocfs->Next ) { - my ($status, $msg) = $record->SetSortOrder( $record->SortOrder + 1 ); - unless ( $status ) { - return (0, "Couldn't move custom field"); - } - } - $new_sort_order = $above[0]->SortOrder; - } else { - $new_sort_order = $above[0]->SortOrder - 1; - } - - my ($status, $msg) = $self->SetSortOrder( $new_sort_order ); - unless ( $status ) { - return (0, "Couldn't move custom field"); - } - - return (1,"Moved custom field up"); -} - -=head3 MoveDown - -Moves custom field down. See </Sorting custom fields applications>. - -=cut - -sub MoveDown { +sub Neighbors { my $self = shift; + my %args = @_; - my $ocfs = RT::ObjectCustomFields->new( $self->CurrentUser ); - - my $oid = $self->ObjectId; - $ocfs->LimitToObjectId( $oid ); - if ( $oid ) { - $ocfs->LimitToObjectId( 0 ); - } - - my $cf = $self->CustomFieldObj; - $ocfs->LimitToLookupType( $cf->LookupType ); - - $ocfs->Limit( FIELD => 'SortOrder', OPERATOR => '>', VALUE => $self->SortOrder ); - $ocfs->OrderByCols( { FIELD => 'SortOrder', ORDER => 'ASC' } ); - - my @below = ($ocfs->Next, $ocfs->Next); - unless ($below[0]) { - return (0, "Can not move down. It's already at the bottom"); - } - - my $new_sort_order; - if ( $below[0]->ObjectId == $self->ObjectId ) { - $new_sort_order = $below[0]->SortOrder; - my ($status, $msg) = $below[0]->SetSortOrder( $self->SortOrder ); - unless ( $status ) { - return (0, "Couldn't move custom field"); - } - } - elsif ( $below[1] && $below[0]->SortOrder + 1 == $below[1]->SortOrder ) { - my $move_ocfs = RT::ObjectCustomFields->new( RT->SystemUser ); - $move_ocfs->LimitToLookupType( $cf->LookupType ); - $move_ocfs->Limit( - FIELD => 'SortOrder', - OPERATOR => '<=', - VALUE => $below[0]->SortOrder, - ); - $move_ocfs->OrderByCols( { FIELD => 'SortOrder', ORDER => 'ASC' } ); - while ( my $record = $move_ocfs->Next ) { - my ($status, $msg) = $record->SetSortOrder( $record->SortOrder - 1 ); - unless ( $status ) { - return (0, "Couldn't move custom field"); - } - } - $new_sort_order = $below[0]->SortOrder; - } else { - $new_sort_order = $below[0]->SortOrder + 1; - } - - my ($status, $msg) = $self->SetSortOrder( $new_sort_order ); - unless ( $status ) { - return (0, "Couldn't move custom field"); - } - - return (1,"Moved custom field down"); + my $res = $self->CollectionClass->new( $self->CurrentUser ); + $res->LimitToLookupType( + ($args{'CustomField'} || $self->CustomFieldObj)->LookupType + ); + return $res; } - =head2 id Returns the current value of id. @@ -400,25 +206,56 @@ 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 => ''}, CustomField => - {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 => ''}, 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 => ''}, SortOrder => - {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->CustomFieldObj ); + + if ($self->ObjectId) { + my $class = $self->CustomFieldObj->RecordClassFromLookupType; + my $obj = $class->new( $self->CurrentUser ); + $obj->Load( $self->ObjectId ); + $deps->Add( out => $obj ); + } +} + +sub Serialize { + my $self = shift; + my %args = (@_); + my %store = $self->SUPER::Serialize(@_); + + if ($store{ObjectId}) { + my $class = $self->CustomFieldObj->RecordClassFromLookupType; + my $obj = $class->new( RT->SystemUser ); + $obj->Load( $store{ObjectId} ); + $store{ObjectId} = \($obj->UID); + } + return %store; +} + + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ObjectCustomFieldValue.pm b/rt/lib/RT/ObjectCustomFieldValue.pm index 356a7f3..2434d6c 100644 --- a/rt/lib/RT/ObjectCustomFieldValue.pm +++ b/rt/lib/RT/ObjectCustomFieldValue.pm @@ -50,6 +50,7 @@ package RT::ObjectCustomFieldValue; use strict; use warnings; +use base 'RT::Record'; use RT::Interface::Web; use Regexp::Common qw(RE_net_IPv4); @@ -60,10 +61,7 @@ require Net::CIDR; # Allow the empty IPv6 address $IPv6_re = qr/(?:$IPv6_re|::)/; - - use RT::CustomField; -use base 'RT::Record'; sub Table {'ObjectCustomFieldValues'} @@ -96,8 +94,11 @@ sub Create { $RT::Logger->error("Content is longer than 255 bytes and LargeContent specified"); } else { - $args{'LargeContent'} = $args{'Content'}; - $args{'Content'} = ''; + # _EncodeLOB, and thus LargeContent, takes bytes; Content is + # in characters. Encode it; this may replace illegal + # codepoints (e.g. \x{FDD0}) with \x{FFFD}. + $args{'LargeContent'} = Encode::encode("UTF-8",$args{'Content'}); + $args{'Content'} = undef; $args{'ContentType'} ||= 'text/plain'; } } @@ -691,37 +692,47 @@ 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 => ''}, CustomField => - {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 => ''}, ObjectType => - {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 => ''}, 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 => ''}, SortOrder => - {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'}, Content => - {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 => ''}, LargeContent => - {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 => ''}, 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 => ''}, 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 => ''}, 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 FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + + $deps->Add( out => $self->CustomFieldObj ); + $deps->Add( out => $self->Object ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ObjectCustomFieldValues.pm b/rt/lib/RT/ObjectCustomFieldValues.pm index c6d2191..527ce7b 100644 --- a/rt/lib/RT/ObjectCustomFieldValues.pm +++ b/rt/lib/RT/ObjectCustomFieldValues.pm @@ -51,11 +51,10 @@ package RT::ObjectCustomFieldValues; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::ObjectCustomFieldValue; -use base 'RT::SearchBuilder'; - sub Table { 'ObjectCustomFieldValues'} sub _Init { @@ -63,12 +62,12 @@ sub _Init { # By default, order by SortOrder $self->OrderByCols( - { ALIAS => 'main', - FIELD => 'SortOrder', - ORDER => 'ASC' }, - { ALIAS => 'main', - FIELD => 'id', - ORDER => 'ASC' }, + { ALIAS => 'main', + FIELD => 'SortOrder', + ORDER => 'ASC' }, + { ALIAS => 'main', + FIELD => 'id', + ORDER => 'ASC' }, ); return ( $self->SUPER::_Init(@_) ); @@ -146,7 +145,7 @@ sub HasEntry { return $item if lc $item->Content eq lc $args->{Content}; } else { - if ( $item->_Value('Content') eq $args->{Content} ) { + if ( ($item->_Value('Content') || '') eq $args->{Content} ) { if ( defined $item->LargeContent ) { return $item if defined $args->{LargeContent} @@ -155,6 +154,8 @@ sub HasEntry { else { return $item unless defined $args->{LargeContent}; } + } elsif ( $item->LargeContent && $args->{Content} ) { + return $item if ($item->LargeContent eq $args->{Content}); } } } @@ -185,17 +186,6 @@ sub _DoCount { return $self->SUPER::_DoCount(@_); } - -=head2 NewItem - -Returns an empty new RT::ObjectCustomFieldValue item - -=cut - -sub NewItem { - my $self = shift; - return(RT::ObjectCustomFieldValue->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ObjectCustomFields.pm b/rt/lib/RT/ObjectCustomFields.pm index 1a488aa..8c31047 100644 --- a/rt/lib/RT/ObjectCustomFields.pm +++ b/rt/lib/RT/ObjectCustomFields.pm @@ -46,47 +46,23 @@ # # END BPS TAGGED BLOCK }}} -package RT::ObjectCustomFields; - use strict; use warnings; +package RT::ObjectCustomFields; +use base 'RT::SearchBuilder::AddAndSort'; +use RT::CustomField; use RT::ObjectCustomField; -use base 'RT::SearchBuilder'; - sub Table { 'ObjectCustomFields'} -sub _Init { - my $self = shift; - - # By default, order by SortOrder - $self->OrderByCols( - { ALIAS => 'main', - FIELD => 'SortOrder', - ORDER => 'ASC' }, - { ALIAS => 'main', - FIELD => 'id', - ORDER => 'ASC' }, - ); - - return ( $self->SUPER::_Init(@_) ); -} - - sub LimitToCustomField { my $self = shift; my $id = shift; $self->Limit( FIELD => 'CustomField', VALUE => $id ); } -sub LimitToObjectId { - my $self = shift; - my $id = shift || 0; - $self->Limit( FIELD => 'ObjectId', VALUE => $id ); -} - sub LimitToLookupType { my $self = shift; my $lookup = shift; @@ -112,22 +88,16 @@ sub HasEntryForCustomField { my @items = grep {$_->CustomField == $id } @{$self->ItemsArrayRef}; if ($#items > 1) { - die "$self HasEntry had a list with more than one of $id in it. this can never happen"; + die "$self HasEntry had a list with more than one of $id in it. this can never happen"; } if ($#items == -1 ) { - return undef; + return undef; } else { - return ($items[0]); + return ($items[0]); } } -sub CustomFields { - my $self = shift; - my %seen; - map { $_->CustomFieldObj } @{$self->ItemsArrayRef}; -} - sub _DoSearch { my $self = shift; if ($self->{'_cfs_alias'}) { @@ -139,17 +109,6 @@ sub _DoSearch { $self->SUPER::_DoSearch() } - -=head2 NewItem - -Returns an empty new RT::ObjectCustomField item - -=cut - -sub NewItem { - my $self = shift; - return(RT::ObjectCustomField->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ObjectScrip.pm b/rt/lib/RT/ObjectScrip.pm new file mode 100644 index 0000000..d2a024a --- /dev/null +++ b/rt/lib/RT/ObjectScrip.pm @@ -0,0 +1,277 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::ObjectScrip; +use base 'RT::Record::AddAndSort'; + +use RT::Scrip; +use RT::ObjectScrips; +use Scalar::Util 'blessed'; + +=head1 NAME + +RT::ObjectScrip - record representing addition of a scrip to a queue + +=head1 DESCRIPTION + +This record is created if you want to add a scrip to a queue or globally. + +Inherits methods from L<RT::Record::AddAndSort>. + +For most operations it's better to use methods in L<RT::Scrip>. + +=head1 METHODS + +=head2 Table + +Returns table name for records of this class. + +=cut + +sub Table {'ObjectScrips'} + +=head2 ObjectCollectionClass + +Returns class name of collection of records scrips can be added to. +Now it's only L<RT::Queue>, so 'RT::Queues' is returned. + +=cut + +sub ObjectCollectionClass {'RT::Queues'} + +=head2 ScripObj + +Returns the Scrip Object which has the id returned by Scrip + +=cut + +sub ScripObj { + my $self = shift; + my $id = shift || $self->Scrip; + my $obj = RT::Scrip->new( $self->CurrentUser ); + $obj->Load( $id ); + return $obj; +} + +=head2 Neighbors + +Stage splits scrips into neighborhoods. See L<RT::Record::AddAndSort/Neighbors and Siblings>. + +=cut + +sub Neighbors { + my $self = shift; + my %args = @_; + + my $res = $self->CollectionClass->new( $self->CurrentUser ); + $res->Limit( FIELD => 'Stage', VALUE => $args{'Stage'} || $self->Stage ); + return $res; +} + +=head2 id + +Returns the current value of id. +(In the database, id is stored as int(11).) + + +=cut + + +=head2 Scrip + +Returns the current value of Scrip. +(In the database, Scrip is stored as int(11).) + +=head2 FriendlyStage + +Returns a localized human-readable version of the stage. + +=cut + +sub FriendlyStage { + my $self = shift; + my $scrip_class = blessed($self->ScripObj); + return $scrip_class->FriendlyStage($self->Stage); +} + +=head2 SetScrip VALUE + + +Set Scrip to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Scrip will be stored as a int(11).) + +=head2 Stage + +Returns the current value of Stage. +(In the database, Stage is stored as varchar(32).) + +=head2 SetStage VALUE + +Set Stage to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, Stage will be stored as a varchar(32).) + +=head2 ObjectId + +Returns the current value of ObjectId. +(In the database, ObjectId is stored as int(11).) + + + +=head2 SetObjectId VALUE + + +Set ObjectId to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, ObjectId will be stored as a int(11).) + + +=cut + + +=head2 SortOrder + +Returns the current value of SortOrder. +(In the database, SortOrder is stored as int(11).) + + + +=head2 SetSortOrder VALUE + + +Set SortOrder to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, SortOrder will be stored as a int(11).) + + +=cut + + +=head2 Creator + +Returns the current value of Creator. +(In the database, Creator is stored as int(11).) + + +=cut + + +=head2 Created + +Returns the current value of Created. +(In the database, Created is stored as datetime.) + + +=cut + + +=head2 LastUpdatedBy + +Returns the current value of LastUpdatedBy. +(In the database, LastUpdatedBy is stored as int(11).) + + +=cut + + +=head2 LastUpdated + +Returns the current value of LastUpdated. +(In the database, LastUpdated is stored as datetime.) + + +=cut + + + +sub _CoreAccessible { + { + + id => + {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + Scrip => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + Stage => + {read => 1, write => 1, sql_type => 12, length => 32, is_blob => 0, is_numeric => 0, type => 'varchar(32)', default => 'TransactionCreate'}, + ObjectId => + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, + SortOrder => + {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'}, + Created => + {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'}, + LastUpdated => + {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->ScripObj ); + if ($self->ObjectId) { + my $obj = RT::Queue->new( $self->CurrentUser ); + $obj->Load( $self->ObjectId ); + $deps->Add( out => $obj ); + } +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Shredder/ScripCondition.pm b/rt/lib/RT/ObjectScrips.pm index 9598b43..c495211 100644 --- a/rt/lib/RT/Shredder/ScripCondition.pm +++ b/rt/lib/RT/ObjectScrips.pm @@ -46,56 +46,47 @@ # # END BPS TAGGED BLOCK }}} -use RT::ScripCondition (); -package RT::ScripCondition; - use strict; use warnings; -use warnings FATAL => 'redefine'; -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; +package RT::ObjectScrips; +use base 'RT::SearchBuilder::AddAndSort'; -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Scrips - my $objs = RT::Scrips->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'ScripCondition', VALUE => $self->Id ); - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $objs, - Shredder => $args{'Shredder'} - ); - - return $self->SUPER::__DependsOn( %args ); -} +use RT::Scrips; +use RT::ObjectScrip; -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; +=head1 NAME + +RT::ObjectScrips - collection of RT::ObjectScrip records + +=head1 DESCRIPTION + +Collection of L<RT::ObjectScrip> records. Inherits methods from L<RT::SearchBuilder::AddAndSort>. + +=head1 METHODS -# TODO: Check here for exec module +=cut - return $self->SUPER::__Relates( %args ); +=head2 Table + +Returns name of the table where records are stored. + +=cut + +sub Table { 'ObjectScrips'} + +=head2 LimitToScrip + +Takes id of a L<RT::Scrip> object and limits this collection. + +=cut + +sub LimitToScrip { + my $self = shift; + my $id = shift; + $self->Limit( FIELD => 'Scrip', VALUE => $id ); } +RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ObjectTopic.pm b/rt/lib/RT/ObjectTopic.pm index c17ca48..3364630 100644 --- a/rt/lib/RT/ObjectTopic.pm +++ b/rt/lib/RT/ObjectTopic.pm @@ -63,12 +63,10 @@ use strict; use warnings; no warnings 'redefine'; -use RT::Record; -use RT::Topic; - - use base qw( RT::Record ); +use RT::Topic; + sub _Init { my $self = shift; @@ -95,18 +93,16 @@ Create takes a hash of values and creates a row in the database: sub Create { my $self = shift; - my %args = ( + my %args = ( Topic => '0', ObjectType => '', ObjectId => '0', - - @_); + @_); $self->SUPER::Create( Topic => $args{'Topic'}, ObjectType => $args{'ObjectType'}, ObjectId => $args{'ObjectId'}, -); - + ); } @@ -146,10 +142,10 @@ Returns the Topic Object which has the id returned by Topic =cut sub TopicObj { - my $self = shift; - my $Topic = RT::Topic->new($self->CurrentUser); - $Topic->Load($self->Topic()); - return($Topic); + my $self = shift; + my $Topic = RT::Topic->new($self->CurrentUser); + $Topic->Load($self->Topic()); + return($Topic); } =head2 ObjectType @@ -191,19 +187,31 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure. sub _CoreAccessible { { - id => - {read => 1, type => 'int(11)', default => ''}, + {read => 1, type => 'int(11)', default => ''}, Topic => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, ObjectType => - {read => 1, write => 1, type => 'varchar(64)', default => ''}, + {read => 1, write => 1, type => 'varchar(64)', default => ''}, ObjectId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + + $deps->Add( out => $self->TopicObj ); + + my $obj = $self->ObjectType->new( $self->CurrentUser ); + $obj->Load( $self->ObjectId ); + $deps->Add( out => $obj ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ObjectTopics.pm b/rt/lib/RT/ObjectTopics.pm index c49db16..072a0eb 100644 --- a/rt/lib/RT/ObjectTopics.pm +++ b/rt/lib/RT/ObjectTopics.pm @@ -69,8 +69,8 @@ sub LimitToTopic { my $self = shift; my $cf = shift; return ($self->Limit( FIELD => 'Topic', - VALUE => $cf, - OPERATOR => '=')); + VALUE => $cf, + OPERATOR => '=')); } @@ -90,7 +90,7 @@ sub LimitToObject { my $object = shift; $self->Limit( FIELD => 'ObjectType', - VALUE => ref($object)); + VALUE => ref($object)); $self->Limit( FIELD => 'ObjectId', VALUE => $object->Id); @@ -98,18 +98,6 @@ sub LimitToObject { # }}} -=head2 NewItem - -Returns an empty new RT::ObjectTopic item - -=cut - -sub NewItem { - my $self = shift; - return(RT::ObjectTopic->new($self->CurrentUser)); -} - - RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/PlackRunner.pm b/rt/lib/RT/PlackRunner.pm new file mode 100644 index 0000000..0b98148 --- /dev/null +++ b/rt/lib/RT/PlackRunner.pm @@ -0,0 +1,165 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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 warnings; +use strict; + +package RT::PlackRunner; + +use base 'Plack::Runner'; + +sub new { + my $class = shift; + return $class->SUPER::new( default_middleware => 0, @_ ); +} + +sub parse_options { + my $self = shift; + my @args = @_; + # handle "rt-server 8888" for back-compat, but complain about it + if (@args && $args[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @args, '--port'; + } + + $self->SUPER::parse_options(@args); + + $self->{app} ||= $self->app; + $self->{server} ||= $self->loader->guess; + + my %args = @{$self->{options}}; + if ($self->{server} eq "FCGI") { + # We deal with the possible failure modes of this in ->run + } elsif ($args{port}) { + $self->{explicit_port} = 1; + my $old_app = $self->{app}; + $self->{app} = sub { + my $env = shift; + $env->{'rt.explicit_port'} = $args{port}; + $old_app->($env, @_); + }; + } else { + $self->set_options(port => (RT->Config->Get('WebPort') || '8080')); + } +} + +# Don't assume port 5000 with no port or socket supplied; this allows +# the WebPort default to kick in (above), and also to provide useful +# error messages when starting FCGI without any options. +sub mangle_host_port_socket { + my $self = shift; + my ($host, $port, $socket, @listen) = @_; + return $self->SUPER::mangle_host_port_socket(@_) + if @listen or $port or $socket; + + return host => $host, port => $port, socket => $socket, + @listen ? (listen => \@listen) : (); +} + +sub app { + require RT::Interface::Web::Handler; + my $app = RT::Interface::Web::Handler->PSGIApp; + + if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); + } + + return $app; +} + +sub run { + my $self = shift; + + my %args = @{$self->{options}}; + + # Plack::Handler::FCGI has its own catch for this, but doesn't + # notice that listen is an empty list, and we can also provide a + # better error message. + if ($self->{server} eq "FCGI" and not -S STDIN and not @{$args{listen} || []}) { + print STDERR "STDIN is not a socket, and no --listen, --socket, or --port provided\n"; + exit 1; + } + + eval { $self->SUPER::run(@_) }; + my $err = $@; + exit 0 unless $err; + + if ( $err =~ /listen/ ) { + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port $args{port}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($self->{explicit_port}) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } + exit 1; + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } +} + +1; diff --git a/rt/lib/RT/Plugin.pm b/rt/lib/RT/Plugin.pm index 3a04203..96a1412 100644 --- a/rt/lib/RT/Plugin.pm +++ b/rt/lib/RT/Plugin.pm @@ -90,7 +90,7 @@ Takes a name of sub directory and returns its full path, for example: my $plugin_etc_dir = $plugin->Path('etc'); -See also L</ComponentRoot>, L</PoDir> and other shortcut methods. +See also L</ComponentRoot>, L</StaticDir>, L</PoDir> and other shortcut methods. =cut @@ -120,6 +120,14 @@ Returns the directory this plugin has installed its L<HTML::Mason> templates int sub ComponentRoot { return $_[0]->Path('html') } +=head2 StaticDir + +Returns the directory this plugin has installed its static files into + +=cut + +sub StaticDir { return $_[0]->Path('static') } + =head2 PoDir Returns the directory this plugin has installed its message catalogs into. diff --git a/rt/lib/RT/Pod/HTML.pm b/rt/lib/RT/Pod/HTML.pm index 092d6a8..90e2017 100644 --- a/rt/lib/RT/Pod/HTML.pm +++ b/rt/lib/RT/Pod/HTML.pm @@ -145,6 +145,12 @@ sub resolve_local_link { # We process README separately in devel/tools/rt-static-docs $local = $name; } + elsif ($name =~ /^UPGRADING.*/) { + # If an UPGRADING file is referred to anywhere else (such as + # templates.pod) we won't have seen UPGRADING yet and will treat + # it as a non-local file. + $local = $name; + } # These matches handle links that look like filenames, such as those we # parse out of F<> tags. elsif ( $name =~ m{^(?:lib/)(RT/[\w/]+?)\.pm$} diff --git a/rt/lib/RT/Principal.pm b/rt/lib/RT/Principal.pm index bdb2a16..8cf509d 100644 --- a/rt/lib/RT/Principal.pm +++ b/rt/lib/RT/Principal.pm @@ -60,9 +60,6 @@ sub Table {'Principals'} -use Cache::Simple::TimedExpiry; - - use RT; use RT::Group; use RT::User; @@ -71,6 +68,8 @@ use RT::User; our $_ACL_CACHE; InvalidateACLCache(); +require RT::ACE; +RT::ACE->RegisterCacheHandler(sub { RT::Principal->InvalidateACLCache() }); =head2 IsGroup @@ -88,7 +87,18 @@ sub IsGroup { return undef; } +=head2 IsRoleGroup + +Returns true if this principal is a role group. +Returns undef, otherwise. + +=cut +sub IsRoleGroup { + my $self = shift; + return ($self->IsGroup and $self->Object->RoleClass) + ? 1 : undef; +} =head2 IsUser @@ -129,7 +139,7 @@ sub Object { $RT::Logger->crit("Found a principal (".$self->Id.") that was neither a user nor a group"); return(undef); } - $self->{'object'}->Load( $self->ObjectId() ); + $self->{'object'}->Load( $self->id ); } return ($self->{'object'}); @@ -157,7 +167,7 @@ sub GrantRight { @_ ); - return (0, "Permission denied") if $args{'Right'} eq 'ExecuteCode' + return (0, "Permission Denied") if $args{'Right'} eq 'ExecuteCode' and RT->Config->Get('DisallowExecuteCode'); #ACL check handled in ACE.pm @@ -165,16 +175,16 @@ sub GrantRight { my $type = $self->_GetPrincipalTypeForACL(); - RT->System->QueueCacheNeedsUpdate(1) if $args{'Right'} eq 'SeeQueue'; - # If it's a user, we really want to grant the right to their # user equivalence group - return $ace->Create( + my ($id, $msg) = $ace->Create( RightName => $args{'Right'}, Object => $args{'Object'}, PrincipalType => $type, PrincipalId => $self->Id, ); + + return ($id, $msg); } @@ -218,9 +228,12 @@ sub RevokeRight { return (1); } - RT->System->QueueCacheNeedsUpdate(1) if $args{'Right'} eq 'SeeQueue'; return ($status, $msg) unless $status; - return $ace->Delete; + + my $right = $ace->RightName; + ($status, $msg) = $ace->Delete; + + return ($status, $msg); } @@ -293,19 +306,16 @@ sub HasRight { } { - my $cached = $_ACL_CACHE->fetch( + my $cached = $_ACL_CACHE->{ $self->id .';:;'. ref($args{'Object'}) .'-'. $args{'Object'}->id - ); + }; return $cached->{'SuperUser'} || $cached->{ $args{'Right'} } if $cached; } unshift @{ $args{'EquivObjects'} }, $args{'Object'}->ACLEquivalenceObjects; - - unshift @{ $args{'EquivObjects'} }, $RT::System - unless $self->can('_IsOverrideGlobalACL') - && $self->_IsOverrideGlobalACL( $args{'Object'} ); + unshift @{ $args{'EquivObjects'} }, $RT::System; # If we've cached a win or loss for this lookup say so @@ -319,19 +329,19 @@ sub HasRight { $full_hashkey .= ";:;".$ref_id; my $short_hashkey = join(";:;", $self->id, $args{'Right'}, $ref_id); - my $cached_answer = $_ACL_CACHE->fetch($short_hashkey); + my $cached_answer = $_ACL_CACHE->{ $short_hashkey }; return $cached_answer > 0 if defined $cached_answer; } { - my $cached_answer = $_ACL_CACHE->fetch($full_hashkey); + my $cached_answer = $_ACL_CACHE->{ $full_hashkey }; return $cached_answer > 0 if defined $cached_answer; } my ( $hitcount, $via_obj ) = $self->_HasRight(%args); - $_ACL_CACHE->set( $full_hashkey => $hitcount ? 1 : -1 ); - $_ACL_CACHE->set( join(';:;', $self->id, $args{'Right'},$via_obj) => 1 ) + $_ACL_CACHE->{ $full_hashkey } = $hitcount ? 1 : -1; + $_ACL_CACHE->{ join ';:;', $self->id, $args{'Right'}, $via_obj } = 1 if $via_obj && $hitcount; return ($hitcount); @@ -372,15 +382,13 @@ sub HasRights { } my $cache_key = $self->id .';:;'. ref($object) .'-'. $object->id; - my $cached = $_ACL_CACHE->fetch($cache_key); + my $cached = $_ACL_CACHE->{ $cache_key }; return $cached if $cached; push @{ $args{'EquivObjects'} }, $object; unshift @{ $args{'EquivObjects'} }, $args{'Object'}->ACLEquivalenceObjects; - unshift @{ $args{'EquivObjects'} }, $RT::System - unless $self->can('_IsOverrideGlobalACL') - && $self->_IsOverrideGlobalACL( $object ); + unshift @{ $args{'EquivObjects'} }, $RT::System; my %res = (); { @@ -428,7 +436,7 @@ sub HasRights { delete $res{'ExecuteCode'} if RT->Config->Get('DisallowExecuteCode'); - $_ACL_CACHE->store( $cache_key, \%res ); + $_ACL_CACHE->{ $cache_key } = \%res; return \%res; } @@ -569,23 +577,13 @@ sub _HasRoleRightQuery { ; if ( $args{'Roles'} ) { - $query .= "AND (" . join( ' OR ', map "Groups.Type = '$_'", @{ $args{'Roles'} } ) . ")"; + $query .= "AND (" . join( ' OR ', + map $RT::Handle->__MakeClauseCaseInsensitive('Groups.Name', '=', "'$_'"), + @{ $args{'Roles'} } + ) . ")"; } - my (@object_clauses); - foreach my $obj ( @{ $args{'EquivObjects'} } ) { - my $type = ref($obj) ? ref($obj) : $obj; - - my $clause = "Groups.Domain = '$type-Role'"; - - # XXX: Groups.Instance is VARCHAR in DB, we should quote value - # if we want mysql 4.0 use indexes here. we MUST convert that - # field to integer and drop this quotes. - if ( my $id = eval { $obj->id } ) { - $clause .= " AND Groups.Instance = '$id'"; - } - push @object_clauses, "($clause)"; - } + my @object_clauses = RT::Users->_RoleClauses( Groups => @{ $args{'EquivObjects'} } ); $query .= " AND (" . join( ' OR ', @object_clauses ) . ")"; return $query; } @@ -683,10 +681,7 @@ Cleans out and reinitializes the user rights cache =cut sub InvalidateACLCache { - $_ACL_CACHE = Cache::Simple::TimedExpiry->new(); - my $lifetime; - $lifetime = $RT::Config->Get('ACLCacheLifetime') if $RT::Config; - $_ACL_CACHE->expire_after( $lifetime || 60 ); + $_ACL_CACHE = {} } @@ -702,8 +697,8 @@ return that. if it has no type, return group. sub _GetPrincipalTypeForACL { my $self = shift; - if ($self->PrincipalType eq 'Group' && $self->Object->Domain =~ /Role$/) { - return $self->Object->Type; + if ($self->IsRoleGroup) { + return $self->Object->Name; } else { return $self->PrincipalType; } @@ -734,7 +729,20 @@ sub _ReferenceId { } } +sub ObjectId { + my $self = shift; + RT->Deprecated( Instead => 'id', Remove => '4.4' ); + return $self->_Value('ObjectId'); +} +sub LoadByCols { + my $self = shift; + my %args = @_; + if ( exists $args{'ObjectId'} ) { + RT->Deprecated( Arguments => 'ObjectId', Instead => 'id', Remove => '4.4' ); + } + return $self->SUPER::LoadByCols( %args ); +} @@ -807,17 +815,61 @@ 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 => 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 => ''}, 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 => ''}, 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 __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# Group or User +# Could be wiped allready + my $obj = $self->Object; + if( defined $obj->id ) { + push( @$list, $obj ); + } + +# Access Control List + my $objs = RT::ACL->new( $self->CurrentUser ); + $objs->Limit( + FIELD => 'PrincipalId', + OPERATOR => '=', + VALUE => $self->Id + ); + push( @$list, $objs ); + +# AddWatcher/DelWatcher txns + foreach my $type ( qw(AddWatcher DelWatcher) ) { + my $objs = RT::Transactions->new( $self->CurrentUser ); + $objs->Limit( FIELD => $type =~ /Add/? 'NewValue': 'OldValue', VALUE => $self->Id ); + $objs->Limit( FIELD => 'Type', VALUE => $type ); + 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/Principals.pm b/rt/lib/RT/Principals.pm index 2f1793d..dcfdfd5 100644 --- a/rt/lib/RT/Principals.pm +++ b/rt/lib/RT/Principals.pm @@ -70,10 +70,10 @@ use strict; use warnings; -use RT::Principal; - use base 'RT::SearchBuilder'; +use RT::Principal; + sub Table { 'Principals'} sub _Init { @@ -82,17 +82,6 @@ sub _Init { return ( $self->SUPER::_Init(@_) ); } - -=head2 NewItem - -Returns an empty new RT::Principal item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Principal->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Queue.pm b/rt/lib/RT/Queue.pm index 0f2f660..6e2bc8d 100755 --- a/rt/lib/RT/Queue.pm +++ b/rt/lib/RT/Queue.pm @@ -69,296 +69,67 @@ use strict; use warnings; use base 'RT::Record'; -sub Table {'Queues'} - - - -use RT::Groups; -use RT::ACL; -use RT::Interface::Email; - -our @DEFAULT_ACTIVE_STATUS = qw(new open stalled); -our @DEFAULT_INACTIVE_STATUS = qw(resolved rejected deleted); - -# $self->loc('new'); # For the string extractor to get a string to localize -# $self->loc('open'); # For the string extractor to get a string to localize -# $self->loc('stalled'); # For the string extractor to get a string to localize -# $self->loc('resolved'); # For the string extractor to get a string to localize -# $self->loc('rejected'); # For the string extractor to get a string to localize -# $self->loc('deleted'); # For the string extractor to get a string to localize - - -our $RIGHTS = { - SeeQueue => 'View queue', # loc_pair - AdminQueue => 'Create, modify and delete queue', # loc_pair - ShowACL => 'Display Access Control List', # loc_pair - ModifyACL => 'Create, modify and delete Access Control List entries', # loc_pair - ModifyQueueWatchers => 'Modify queue watchers', # loc_pair - SeeCustomField => 'View custom field values', # loc_pair - ModifyCustomField => 'Modify custom field values', # loc_pair - AssignCustomFields => 'Assign and remove queue custom fields', # loc_pair - ModifyTemplate => 'Modify Scrip templates', # loc_pair - ShowTemplate => 'View Scrip templates', # loc_pair - - ModifyScrips => 'Modify Scrips', # loc_pair - ShowScrips => 'View Scrips', # loc_pair - - ShowTicket => 'View ticket summaries', # loc_pair - ShowTicketComments => 'View ticket private commentary', # loc_pair - ShowOutgoingEmail => 'View exact outgoing email messages and their recipients', # loc_pair - - Watch => 'Sign up as a ticket Requestor or ticket or queue Cc', # loc_pair - WatchAsAdminCc => 'Sign up as a ticket or queue AdminCc', # loc_pair - CreateTicket => 'Create tickets', # loc_pair - ReplyToTicket => 'Reply to tickets', # loc_pair - CommentOnTicket => 'Comment on tickets', # loc_pair - OwnTicket => 'Own tickets', # loc_pair - ModifyTicket => 'Modify tickets', # loc_pair - DeleteTicket => 'Delete tickets', # loc_pair - TakeTicket => 'Take tickets', # loc_pair - StealTicket => 'Steal tickets', # loc_pair - - ForwardMessage => 'Forward messages outside of RT', # loc_pair -}; - -our $RIGHT_CATEGORIES = { - SeeQueue => 'General', - AdminQueue => 'Admin', - ShowACL => 'Admin', - ModifyACL => 'Admin', - ModifyQueueWatchers => 'Admin', - SeeCustomField => 'General', - ModifyCustomField => 'Staff', - AssignCustomFields => 'Admin', - ModifyTemplate => 'Admin', - ShowTemplate => 'Admin', - ModifyScrips => 'Admin', - ShowScrips => 'Admin', - ShowTicket => 'General', - ShowTicketComments => 'Staff', - ShowOutgoingEmail => 'Staff', - Watch => 'General', - WatchAsAdminCc => 'Staff', - CreateTicket => 'General', - ReplyToTicket => 'General', - CommentOnTicket => 'General', - OwnTicket => 'Staff', - ModifyTicket => 'Staff', - DeleteTicket => 'Staff', - TakeTicket => 'Staff', - StealTicket => 'Staff', - ForwardMessage => 'Staff', -}; - -# Tell RT::ACE that this sort of object can get acls granted -$RT::ACE::OBJECT_TYPES{'RT::Queue'} = 1; - -# TODO: This should be refactored out into an RT::ACLedObject or something -# stuff the rights into a hash of rights that can exist. - -__PACKAGE__->AddRights(%$RIGHTS); -__PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES); -require RT::Lifecycle; - -=head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...] - -Adds the given rights to the list of possible rights. This method -should be called during server startup, not at runtime. - -=cut +use Role::Basic 'with'; +with "RT::Record::Role::Lifecycle", + "RT::Record::Role::Links" => { -excludes => ["_AddLinksOnCreate"] }, + "RT::Record::Role::Roles", + "RT::Record::Role::Rights"; -sub AddRights { - my $self = shift; - my %new = @_; - $RIGHTS = { %$RIGHTS, %new }; - %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES, - map { lc($_) => $_ } keys %new); -} - -=head2 AddRightCategories C<RIGHT>, C<CATEGORY> [, ...] - -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 }; -} +sub Table {'Queues'} -sub AddLink { - my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - @_ ); - - unless ( $self->CurrentUserHasRight('ModifyQueue') ) { - return ( 0, $self->loc("Permission Denied") ); - } +sub LifecycleType { "ticket" } - return $self->SUPER::_AddLink(%args); -} +sub ModifyLinkRight { "AdminQueue" } -sub DeleteLink { - my $self = shift; +require RT::ACE; +RT::ACE->RegisterCacheHandler(sub { my %args = ( - Base => undef, - Target => undef, - Type => undef, + Action => "", + RightName => "", @_ ); - #check acls - unless ( $self->CurrentUserHasRight('ModifyQueue') ) { - $RT::Logger->debug("No permission to delete links"); - return ( 0, $self->loc('Permission Denied')) - } - - return $self->SUPER::_DeleteLink(%args); -} - -=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 the rights do - -=cut - -sub AvailableRights { - my $self = shift; - return($RIGHTS); -} - -=head2 RightCategories - -Returns a hashref where the keys are rights for this type of object and the -values are the category (General, Staff, Admin) the right falls into. - -=cut - -sub RightCategories { - return $RIGHT_CATEGORIES; -} - - -sub Lifecycle { - my $self = shift; - unless (ref $self && $self->id) { - return RT::Lifecycle->Load('') - } - - my $name = $self->_Value( Lifecycle => @_ ); - $name ||= 'default'; - - my $res = RT::Lifecycle->Load( $name ); - unless ( $res ) { - $RT::Logger->error("Lifecycle '$name' for queue '".$self->Name."' doesn't exist"); - return RT::Lifecycle->Load('default'); - } - return $res; -} - -sub SetLifecycle { - my $self = shift; - my $value = shift || 'default'; - - return ( 0, $self->loc( '[_1] is not a valid lifecycle', $value ) ) - unless $self->ValidateLifecycle($value); - - return $self->_Set( Field => 'Lifecycle', Value => $value, @_ ); -} - -=head2 ValidateLifecycle NAME - -Takes a lifecycle name. Returns true if it's an ok name and such -lifecycle is configured. Returns undef otherwise. - -=cut - -sub ValidateLifecycle { - my $self = shift; - my $value = shift; - return undef unless RT::Lifecycle->Load( $value ); - return 1; -} - - -=head2 ActiveStatusArray - -Returns an array of all ActiveStatuses for this queue - -=cut - -sub ActiveStatusArray { - my $self = shift; - return $self->Lifecycle->Valid('initial', 'active'); -} - -=head2 InactiveStatusArray - -Returns an array of all InactiveStatuses for this queue - -=cut - -sub InactiveStatusArray { - my $self = shift; - return $self->Lifecycle->Inactive; -} - -=head2 StatusArray - -Returns an array of all statuses for this queue - -=cut - -sub StatusArray { - my $self = shift; - return $self->Lifecycle->Valid( @_ ); -} - -=head2 IsValidStatus value - -Returns true if value is a valid status. Otherwise, returns 0. - -=cut - -sub IsValidStatus { - my $self = shift; - return $self->Lifecycle->IsValid( shift ); -} - -=head2 IsActiveStatus value - -Returns true if value is a Active status. Otherwise, returns 0 - -=cut - -sub IsActiveStatus { - my $self = shift; - return $self->Lifecycle->IsValid( shift, 'initial', 'active'); -} - - - -=head2 IsInactiveStatus value - -Returns true if value is a Inactive status. Otherwise, returns 0 - - -=cut - -sub IsInactiveStatus { - my $self = shift; - return $self->Lifecycle->IsInactive( shift ); -} - - + return unless $args{Action} =~ /^(Grant|Revoke)$/i + and $args{RightName} =~ /^(SeeQueue|CreateTicket)$/; + RT->System->QueueCacheNeedsUpdate(1); +}); +use RT::Groups; +use RT::ACL; +use RT::Interface::Email; +__PACKAGE__->AddRight( General => SeeQueue => 'View queue' ); # loc +__PACKAGE__->AddRight( Admin => AdminQueue => 'Create, modify and delete queue' ); # 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( Admin => ModifyQueueWatchers => 'Modify queue watchers' ); # loc +__PACKAGE__->AddRight( General => SeeCustomField => 'View custom field values' ); # loc +__PACKAGE__->AddRight( Staff => ModifyCustomField => 'Modify custom field values' ); # loc +__PACKAGE__->AddRight( Admin => AssignCustomFields => 'Assign and remove queue custom fields' ); # loc +__PACKAGE__->AddRight( Admin => ModifyTemplate => 'Modify Scrip templates' ); # loc +__PACKAGE__->AddRight( Admin => ShowTemplate => 'View Scrip templates' ); # loc + +__PACKAGE__->AddRight( Admin => ModifyScrips => 'Modify Scrips' ); # loc +__PACKAGE__->AddRight( Admin => ShowScrips => 'View Scrips' ); # loc + +__PACKAGE__->AddRight( General => ShowTicket => 'View ticket summaries' ); # loc +__PACKAGE__->AddRight( Staff => ShowTicketComments => 'View ticket private commentary' ); # loc +__PACKAGE__->AddRight( Staff => ShowOutgoingEmail => 'View exact outgoing email messages and their recipients' ); # loc + +__PACKAGE__->AddRight( General => Watch => 'Sign up as a ticket Requestor or ticket or queue Cc' ); # loc +__PACKAGE__->AddRight( Staff => WatchAsAdminCc => 'Sign up as a ticket or queue AdminCc' ); # loc +__PACKAGE__->AddRight( General => CreateTicket => 'Create tickets' ); # loc +__PACKAGE__->AddRight( General => ReplyToTicket => 'Reply to tickets' ); # loc +__PACKAGE__->AddRight( General => CommentOnTicket => 'Comment on tickets' ); # loc +__PACKAGE__->AddRight( Staff => OwnTicket => 'Own tickets' ); # loc +__PACKAGE__->AddRight( Staff => ModifyTicket => 'Modify tickets' ); # loc +__PACKAGE__->AddRight( Staff => DeleteTicket => 'Delete tickets' ); # loc +__PACKAGE__->AddRight( Staff => TakeTicket => 'Take tickets' ); # loc +__PACKAGE__->AddRight( Staff => StealTicket => 'Steal tickets' ); # loc +__PACKAGE__->AddRight( Staff => ReassignTicket => 'Modify ticket owner on owned tickets' ); # loc + +__PACKAGE__->AddRight( Staff => ForwardMessage => 'Forward messages outside of RT' ); # loc =head2 Create(ARGS) @@ -421,7 +192,7 @@ sub Create { return ( 0, $self->loc('Queue could not be created') ); } - my $create_ret = $self->_CreateQueueGroups(); + my $create_ret = $self->_CreateRoleGroups(); unless ($create_ret) { $RT::Handle->Rollback(); return ( 0, $self->loc('Queue could not be created') ); @@ -467,22 +238,22 @@ sub SetDisabled { my $val = shift; $RT::Handle->BeginTransaction(); - my $set_err = $self->_Set( Field =>'Disabled', Value => $val); - unless ($set_err) { + my ($ok, $msg) = $self->_Set( Field =>'Disabled', Value => $val); + unless ($ok) { $RT::Handle->Rollback(); - $RT::Logger->warning("Couldn't ".($val == 1) ? "disable" : "enable"." queue ".$self->PrincipalObj->Id); - return (undef); + $RT::Logger->warning("Couldn't ".(($val == 0) ? "enable" : "disable")." queue ".$self->Name.": $msg"); + return ($ok, $msg); } - $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" ); + $self->_NewTransaction( Type => ($val == 0) ? "Enabled" : "Disabled" ); $RT::Handle->Commit(); RT->System->QueueCacheNeedsUpdate(1); - if ( $val == 1 ) { - return (1, $self->loc("Queue disabled")); - } else { + if ( $val == 0 ) { return (1, $self->loc("Queue enabled")); + } else { + return (1, $self->loc("Queue disabled")); } } @@ -662,7 +433,8 @@ sub Templates { =head2 CustomField NAME -Load the queue-specific custom field named NAME +Load the Ticket Custom Field applied to this Queue named NAME. +Does not load Global custom fields. =cut @@ -670,7 +442,11 @@ sub CustomField { my $self = shift; my $name = shift; my $cf = RT::CustomField->new($self->CurrentUser); - $cf->LoadByNameAndQueue(Name => $name, Queue => $self->Id); + $cf->LoadByName( + Name => $name, + LookupType => RT::Ticket->CustomFieldLookupType, + ObjectId => $self->id, + ); return ($cf); } @@ -689,8 +465,8 @@ sub TicketCustomFields { my $cfs = RT::CustomFields->new( $self->CurrentUser ); if ( $self->CurrentUserHasRight('SeeQueue') ) { $cfs->SetContextObject( $self ); - $cfs->LimitToGlobalOrObjectId( $self->Id ); - $cfs->LimitToLookupType( 'RT::Queue-RT::Ticket' ); + $cfs->LimitToGlobalOrObjectId( $self->Id ); + $cfs->LimitToLookupType( 'RT::Queue-RT::Ticket' ); $cfs->ApplySortOrder; } return ($cfs); @@ -711,8 +487,8 @@ sub TicketTransactionCustomFields { my $cfs = RT::CustomFields->new( $self->CurrentUser ); if ( $self->CurrentUserHasRight('SeeQueue') ) { $cfs->SetContextObject( $self ); - $cfs->LimitToGlobalOrObjectId( $self->Id ); - $cfs->LimitToLookupType( 'RT::Queue-RT::Ticket-RT::Transaction' ); + $cfs->LimitToGlobalOrObjectId( $self->Id ); + $cfs->LimitToLookupType( 'RT::Queue-RT::Ticket-RT::Transaction' ); $cfs->ApplySortOrder; } return ($cfs); @@ -724,43 +500,49 @@ sub TicketTransactionCustomFields { =head2 AllRoleGroupTypes -Returns a list of the names of the various role group types that this queue -has, including Requestor and Owner. If you don't want them, see -L</ManageableRoleGroupTypes>. +B<DEPRECATED> and will be removed in a future release. Use L</Roles> +instead. + +Returns a list of the names of the various role group types for Queues, +including roles used only for ACLs like Requestor and Owner. If you don't want +them, see L</ManageableRoleGroupTypes>. =cut sub AllRoleGroupTypes { - my $self = shift; - return ($self->ManageableRoleGroupTypes, qw(Requestor Owner)); + RT->Deprecated( + Remove => "4.4", + Instead => "RT::Queue->Roles", + ); + shift->Roles; } =head2 IsRoleGroupType +B<DEPRECATED> and will be removed in a future release. Use L</HasRole> instead. + Returns whether the passed-in type is a role group type. =cut sub IsRoleGroupType { - my $self = shift; - my $type = shift; - - for my $valid_type ($self->AllRoleGroupTypes) { - return 1 if $type eq $valid_type; - } - - return 0; + RT->Deprecated( + Remove => "4.4", + Instead => "RT::Queue->HasRole", + ); + shift->HasRole(@_); } =head2 ManageableRoleGroupTypes -Returns a list of the names of the various role group types that this queue -has, excluding Requestor and Owner. If you want them, see L</AllRoleGroupTypes>. +Returns a list of the names of the various role group types for Queues, +excluding ones used only for ACLs such as Requestor and Owner. If you want +them, see L</Roles>. =cut sub ManageableRoleGroupTypes { - return qw(Cc AdminCc); + shift->Roles( ACLOnly => 0 ) } =head2 IsManageableRoleGroupType @@ -772,102 +554,34 @@ Returns whether the passed-in type is a manageable role group type. sub IsManageableRoleGroupType { my $self = shift; my $type = shift; - - for my $valid_type ($self->ManageableRoleGroupTypes) { - return 1 if $type eq $valid_type; - } - - return 0; -} - - -=head2 _CreateQueueGroups - -Create the ticket groups and links for this ticket. -This routine expects to be called from Ticket->Create _inside of a transaction_ - -It will create four groups for this ticket: Requestor, Cc, AdminCc and Owner. - -It will return true on success and undef on failure. - - -=cut - -sub _CreateQueueGroups { - my $self = shift; - - my @types = $self->AllRoleGroupTypes; - - foreach my $type (@types) { - my $ok = $self->_CreateQueueRoleGroup($type); - return undef if !$ok; - } - - return 1; -} - -sub _CreateQueueRoleGroup { - my $self = shift; - my $type = shift; - - my $type_obj = RT::Group->new($self->CurrentUser); - my ($id, $msg) = $type_obj->CreateRoleGroup(Instance => $self->Id, - Type => $type, - Domain => 'RT::Queue-Role'); - unless ($id) { - $RT::Logger->error("Couldn't create a Queue group of type '$type' for queue ". - $self->Id.": ".$msg); - return(undef); - } - - return $id; + return( $self->HasRole($type) and not $self->Role($type)->{ACLOnly} ); } - -# _HasModifyWatcherRight {{{ sub _HasModifyWatcherRight { my $self = shift; - my %args = ( - Type => undef, - PrincipalId => undef, - Email => undef, - @_ - ); + my ($type, $principal) = @_; + # ModifyQueueWatchers works in any case return 1 if $self->CurrentUserHasRight('ModifyQueueWatchers'); - - #If the watcher we're trying to add is for the current user - if ( defined $args{'PrincipalId'} && $self->CurrentUser->PrincipalId eq $args{'PrincipalId'}) { - if ( $args{'Type'} eq 'AdminCc' ) { - return 1 if $self->CurrentUserHasRight('WatchAsAdminCc'); - } - elsif ( $args{'Type'} eq 'Cc' or $args{'Type'} eq 'Requestor' ) { - return 1 if $self->CurrentUserHasRight('Watch'); - } - else { - $RT::Logger->warning( "$self -> _HasModifyWatcher got passed a bogus type $args{Type}"); - return ( 0, $self->loc('Invalid queue role group type [_1]', $args{Type}) ); - } - } - - return ( 0, $self->loc("Permission Denied") ); + # If the watcher isn't the current user then the current user has no right + return 0 unless $self->CurrentUser->PrincipalId == $principal->id; + # If it's an AdminCc and they don't have 'WatchAsAdminCc', bail + return 0 if $type eq 'AdminCc' and not $self->CurrentUserHasRight('WatchAsAdminCc'); + # If it's a Requestor or Cc and they don't have 'Watch', bail + return 0 if ($type eq "Cc" or $type eq 'Requestor') + and not $self->CurrentUserHasRight('Watch'); + return 1; } =head2 AddWatcher -AddWatcher takes a parameter hash. The keys are as follows: - -Type One of Requestor, Cc, AdminCc - -PrinicpalId The RT::Principal id of the user or group that's being added as a watcher -Email The email address of the new watcher. If a user with this - email address can't be found, a new nonprivileged user will be created. +Applies access control checking, then calls +L<RT::Record::Role::Roles/AddRoleMember>. Additionally, C<Email> is +accepted as an alternative argument name for C<User>. -If the watcher you're trying to set has an RT account, set the Owner parameter to their User Id. Otherwise, set the Email parameter to their Email address. - -Returns a tuple of (status/id, message). +Returns a tuple of (status, message). =cut @@ -880,187 +594,43 @@ sub AddWatcher { @_ ); - return ( 0, "No principal specified" ) - unless $args{'Email'} or $args{'PrincipalId'}; - - if ( !$args{'PrincipalId'} && $args{'Email'} ) { - my $user = RT::User->new( $self->CurrentUser ); - $user->LoadByEmail( $args{'Email'} ); - $args{'PrincipalId'} = $user->PrincipalId if $user->id; - } - - return ( 0, "Unknown watcher type [_1]", $args{Type} ) - unless $self->IsRoleGroupType($args{Type}); + $args{ACL} = sub { $self->_HasModifyWatcherRight( @_ ) }; + $args{User} ||= delete $args{Email}; + my ($principal, $msg) = $self->AddRoleMember( %args ); + return ( 0, $msg) unless $principal; - my ($ok, $msg) = $self->_HasModifyWatcherRight(%args); - return ($ok, $msg) if !$ok; - - return $self->_AddWatcher(%args); + return ( 1, $self->loc("Added [_1] to members of [_2] for this queue.", + $principal->Object->Name, $self->loc($args{'Type'}) )); } -#This contains the meat of AddWatcher. but can be called from a routine like -# Create, which doesn't need the additional acl check -sub _AddWatcher { - my $self = shift; - my %args = ( - Type => undef, - Silent => undef, - PrincipalId => undef, - Email => undef, - @_ - ); - - - my $principal = RT::Principal->new( $self->CurrentUser ); - if ( $args{'PrincipalId'} ) { - $principal->Load( $args{'PrincipalId'} ); - if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) { - return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email, $self->loc($args{'Type'}))) - if RT::EmailParser->IsRTAddress( $email ); - } - } - elsif ( $args{'Email'} ) { - if ( RT::EmailParser->IsRTAddress( $args{'Email'} ) ) { - return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $args{'Email'}, $self->loc($args{'Type'}))); - } - my $user = RT::User->new($self->CurrentUser); - $user->LoadByEmail( $args{'Email'} ); - $user->Load( $args{'Email'} ) - unless $user->id; - - if ( $user->Id ) { # If the user exists - $principal->Load( $user->PrincipalId ); - } else { - # if the user doesn't exist, we need to create a new user - my $new_user = RT::User->new(RT->SystemUser); - - my ( $Address, $Name ) = - RT::Interface::Email::ParseAddressFromHeader($args{'Email'}); - - my ( $Val, $Message ) = $new_user->Create( - Name => $Address, - EmailAddress => $Address, - RealName => $Name, - Privileged => 0, - Comments => 'Autocreated when added as a watcher' - ); - unless ($Val) { - $RT::Logger->error("Failed to create user ".$args{'Email'} .": " .$Message); - # Deal with the race condition of two account creations at once - $new_user->LoadByEmail( $args{'Email'} ); - } - $principal->Load( $new_user->PrincipalId ); - } - } - # If we can't find this watcher, we need to bail. - unless ( $principal->Id ) { - return(0, $self->loc("Could not find or create that user")); - } - my $group = RT::Group->new($self->CurrentUser); - $group->LoadQueueRoleGroup(Type => $args{'Type'}, Queue => $self->Id); - unless ($group->id) { - return(0,$self->loc("Group not found")); - } +=head2 DeleteWatcher - if ( $group->HasMember( $principal)) { - - return ( 0, $self->loc('[_1] is already a [_2] for this queue', - $principal->Object->Name, $args{'Type'}) ); - } - - - my ($m_id, $m_msg) = $group->_AddMember(PrincipalId => $principal->Id); - unless ($m_id) { - $RT::Logger->error("Failed to add ".$principal->Id." as a member of group ".$group->Id.": ".$m_msg); - - return ( 0, $self->loc('Could not make [_1] a [_2] for this queue', - $principal->Object->Name, $args{'Type'}) ); - } - return ( 1, $self->loc("Added [_1] to members of [_2] for this queue.", $principal->Object->Name, $args{'Type'} )); -} - - - -=head2 DeleteWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL_ADDRESS } - - -Deletes a queue watcher. Takes two arguments: - -Type (one of Requestor,Cc,AdminCc) - -and one of - -PrincipalId (an RT::Principal Id of the watcher you want to remove) - OR -Email (the email address of an existing wathcer) +Applies access control checking, then calls +L<RT::Record::Role::Roles/DeleteRoleMember>. Additionally, C<Email> is +accepted as an alternative argument name for C<User>. +Returns a tuple of (status, message). =cut - sub DeleteWatcher { my $self = shift; - my %args = ( Type => undef, - PrincipalId => undef, - Email => undef, - @_ ); - - unless ( $args{'PrincipalId'} || $args{'Email'} ) { - return ( 0, $self->loc("No principal specified") ); - } - - if ( !$args{PrincipalId} and $args{Email} ) { - my $user = RT::User->new( $self->CurrentUser ); - my ($rv, $msg) = $user->LoadByEmail( $args{Email} ); - $args{PrincipalId} = $user->PrincipalId if $rv; - } - - my $principal = RT::Principal->new( $self->CurrentUser ); - if ( $args{'PrincipalId'} ) { - $principal->Load( $args{'PrincipalId'} ); - } - else { - my $user = RT::User->new( $self->CurrentUser ); - $user->LoadByEmail( $args{'Email'} ); - $principal->Load( $user->Id ); - } - - # If we can't find this watcher, we need to bail. - unless ( $principal->Id ) { - return ( 0, $self->loc("Could not find that principal") ); - } - - my $group = RT::Group->new($self->CurrentUser); - $group->LoadQueueRoleGroup(Type => $args{'Type'}, Queue => $self->Id); - unless ($group->id) { - return(0,$self->loc("Group not found")); - } - - return ( 0, $self->loc('Unknown watcher type [_1]', $args{Type}) ) - unless $self->IsRoleGroupType($args{Type}); - - my ($ok, $msg) = $self->_HasModifyWatcherRight(%args); - return ($ok, $msg) if !$ok; - - # see if this user is already a watcher. - - unless ( $group->HasMember($principal)) { - return ( 0, $self->loc('[_1] is not a [_2] for this queue', - $principal->Object->Name, $args{'Type'}) ); - } - - my ($m_id, $m_msg) = $group->_DeleteMember($principal->Id); - unless ($m_id) { - $RT::Logger->error("Failed to delete ".$principal->Id. - " as a member of group ".$group->Id.": ".$m_msg); + my %args = ( + Type => undef, + PrincipalId => undef, + Email => undef, + @_ + ); - return ( 0, $self->loc('Could not remove [_1] as a [_2] for this queue', - $principal->Object->Name, $args{'Type'}) ); - } + $args{ACL} = sub { $self->_HasModifyWatcherRight( @_ ) }; + $args{User} ||= delete $args{Email}; + my ($principal, $msg) = $self->DeleteRoleMember( %args ); + return ( 0, $msg) unless $principal; - return ( 1, $self->loc("Removed [_1] from members of [_2] for this queue.", $principal->Object->Name, $args{'Type'} )); + return ( 1, $self->loc("Removed [_1] from members of [_2] for this queue.", + $principal->Object->Name, $self->loc($args{'Type'}) )); } @@ -1114,12 +684,9 @@ If the user doesn't have "ShowQueue" permission, returns an empty group sub Cc { my $self = shift; - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('SeeQueue') ) { - $group->LoadQueueRoleGroup(Type => 'Cc', Queue => $self->Id); - } - return ($group); - + return RT::Group->new($self->CurrentUser) + unless $self->CurrentUserHasRight('SeeQueue'); + return $self->RoleGroup( 'Cc' ); } @@ -1135,12 +702,9 @@ If the user doesn't have "ShowQueue" permission, returns an empty group sub AdminCc { my $self = shift; - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('SeeQueue') ) { - $group->LoadQueueRoleGroup(Type => 'AdminCc', Queue => $self->Id); - } - return ($group); - + return RT::Group->new($self->CurrentUser) + unless $self->CurrentUserHasRight('SeeQueue'); + return $self->RoleGroup( 'AdminCc' ); } @@ -1168,9 +732,8 @@ sub IsWatcher { @_ ); - # Load the relevant group. - my $group = RT::Group->new($self->CurrentUser); - $group->LoadQueueRoleGroup(Type => $args{'Type'}, Queue => $self->id); + # Load the relevant group. + my $group = $self->RoleGroup( $args{'Type'} ); # Ask if it has the member in question my $principal = RT::Principal->new($self->CurrentUser); @@ -1249,29 +812,6 @@ sub _Value { return ( $self->__Value(@_) ); } - - -=head2 CurrentUserHasRight - -Takes one argument. A textual string with the name of the right we want to check. -Returns true if the current user has that right for this queue. -Returns undef otherwise. - -=cut - -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - - return ( - $self->HasRight( - Principal => $self->CurrentUser, - Right => "$right" - ) - ); - -} - =head2 CurrentUserCanSee Returns true if the current user can see the queue, using SeeQueue @@ -1284,39 +824,6 @@ sub CurrentUserCanSee { return $self->CurrentUserHasRight('SeeQueue'); } - -=head2 HasRight - -Takes a param hash with the fields 'Right' and 'Principal'. -Principal defaults to the current user. -Returns true if the principal has that right for this queue. -Returns undef otherwise. - -=cut - -# TAKES: Right and optional "Principal" which defaults to the current user -sub HasRight { - my $self = shift; - my %args = ( - Right => undef, - Principal => $self->CurrentUser, - @_ - ); - my $principal = delete $args{'Principal'}; - unless ( $principal ) { - $RT::Logger->error("Principal undefined in Queue::HasRight"); - return undef; - } - - return $principal->HasRight( - %args, - Object => ($self->Id ? $self : $RT::System), - ); -} - - - - =head2 id Returns the current value of id. @@ -1579,6 +1086,126 @@ sub _CoreAccessible { } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + + # Queue role groups( Cc, AdminCc ) + my $objs = RT::Groups->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role', CASESENSITIVE => 0 ); + $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); + $deps->Add( in => $objs ); + + # Scrips + $objs = RT::ObjectScrips->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'ObjectId', + OPERATOR => '=', + VALUE => $self->id, + ENTRYAGGREGATOR => 'OR' ); + $objs->Limit( FIELD => 'ObjectId', + OPERATOR => '=', + VALUE => 0, + ENTRYAGGREGATOR => 'OR' ); + $deps->Add( in => $objs ); + + # Templates (global ones have already been dealt with) + $objs = RT::Templates->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Queue', VALUE => $self->Id); + $deps->Add( in => $objs ); + + # Custom Fields on things _in_ this queue (CFs on the queue itself + # have already been dealt with) + $objs = RT::ObjectCustomFields->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'ObjectId', + OPERATOR => '=', + VALUE => $self->id, + ENTRYAGGREGATOR => 'OR' ); + $objs->Limit( FIELD => 'ObjectId', + OPERATOR => '=', + VALUE => 0, + ENTRYAGGREGATOR => 'OR' ); + my $cfs = $objs->Join( + ALIAS1 => 'main', + FIELD1 => 'CustomField', + TABLE2 => 'CustomFields', + FIELD2 => 'id', + ); + $objs->Limit( ALIAS => $cfs, + FIELD => 'LookupType', + OPERATOR => 'STARTSWITH', + VALUE => 'RT::Queue-' ); + $deps->Add( in => $objs ); + + # Tickets + $objs = RT::Tickets->new( $self->CurrentUser ); + $objs->Limit( FIELD => "Queue", VALUE => $self->Id ); + $objs->{allow_deleted_search} = 1; + $deps->Add( in => $objs ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# Tickets + my $objs = RT::Tickets->new( $self->CurrentUser ); + $objs->{'allow_deleted_search'} = 1; + $objs->Limit( FIELD => 'Queue', VALUE => $self->Id ); + push( @$list, $objs ); + +# Queue role groups( Cc, AdminCc ) + $objs = RT::Groups->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role', CASESENSITIVE => 0 ); + $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); + push( @$list, $objs ); + +# Scrips + $objs = RT::Scrips->new( $self->CurrentUser ); + $objs->LimitToQueue( $self->id ); + push( @$list, $objs ); + +# Templates + $objs = $self->Templates; + push( @$list, $objs ); + +# Custom Fields + $objs = RT::CustomFields->new( $self->CurrentUser ); + $objs->SetContextObject( $self ); + $objs->LimitToQueue( $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 ); +} + + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + $class->SUPER::PreInflate( $importer, $uid, $data ); + + $data->{Name} = $importer->Qualify($data->{Name}) + if $data->{Name} ne "___Approvals"; + + return if $importer->MergeBy( "Name", $class, $uid, $data ); + + return 1; +} + RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Queues.pm b/rt/lib/RT/Queues.pm index d6e5c76..b9aa3db 100755 --- a/rt/lib/RT/Queues.pm +++ b/rt/lib/RT/Queues.pm @@ -69,11 +69,10 @@ package RT::Queues; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::Queue; -use base 'RT::SearchBuilder'; - sub Table { 'Queues'} # {{{ sub _Init @@ -83,8 +82,8 @@ sub _Init { # By default, order by name $self->OrderBy( ALIAS => 'main', - FIELD => 'Name', - ORDER => 'ASC'); + FIELD => 'Name', + ORDER => 'ASC'); return ($self->SUPER::_Init(@_)); } @@ -92,7 +91,7 @@ sub _Init { sub Limit { my $self = shift; my %args = ( ENTRYAGGREGATOR => 'AND', - @_); + @_); $self->SUPER::Limit(%args); } @@ -113,19 +112,6 @@ sub AddRecord { $self->{'rows'}++; } - - - -=head2 NewItem - -Returns an empty new RT::Queue item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Queue->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Record.pm b/rt/lib/RT/Record.pm index 634a02e..d2ffc53 100755 --- a/rt/lib/RT/Record.pm +++ b/rt/lib/RT/Record.pm @@ -66,11 +66,18 @@ package RT::Record; use strict; use warnings; +use RT; +use base RT->Config->Get('RecordBaseClass'); +use base 'RT::Base'; -use RT::Date; -use RT::I18N; -use RT::User; -use RT::Attributes; +require RT::Date; +require RT::User; +require RT::Attributes; +require RT::Transactions; +require RT::Link; +use RT::Shredder::Dependencies; +use RT::Shredder::Constants; +use RT::Shredder::Exceptions; our $_TABLE_ATTR = { }; use base RT->Config->Get('RecordBaseClass'); @@ -127,21 +134,39 @@ sub Delete { } } -=head2 ObjectTypeStr +=head2 RecordType + +Returns a string which is this record's type. It's not localized and by +default last part (everything after last ::) of class name is returned. + +=cut -Returns a string which is this object's type. The type is the class, -without the "RT::" prefix. +sub RecordType { + my $res = ref($_[0]) || $_[0]; + $res =~ s/.*:://; + return $res; +} +=head2 ObjectTypeStr + +DEPRECATED. Stays here for backwards. Returns localized L</RecordType>. =cut +# we deprecate because of: +# * ObjectType is used in several classes with ObjectId to store +# records of different types, for example transactions use those +# and it's unclear what this method should return 'Transaction' +# or type of referenced record +# * returning localized thing is not good idea + sub ObjectTypeStr { my $self = shift; - if (ref($self) =~ /^.*::(\w+)$/) { - return $self->loc($1); - } else { - return $self->loc(ref($self)); - } + RT->Deprecated( + Remove => "4.4", + Instead => "RecordType", + ); + return $self->loc( $self->RecordType( @_ ) ); } =head2 Attributes @@ -372,7 +397,10 @@ sub LoadByCols { # We don't want to hang onto this $self->ClearAttributes; - return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive; + unless ( $self->_Handle->CaseSensitive ) { + my ( $ret, $msg ) = $self->SUPER::LoadByCols( @_ ); + return wantarray ? ( $ret, $msg ) : $ret; + } # If this database is case sensitive we need to uncase objects for # explicit loading @@ -390,7 +418,8 @@ sub LoadByCols { $hash{$key}->{function} = $func; } } - return $self->SUPER::LoadByCols( %hash ); + my ( $ret, $msg ) = $self->SUPER::LoadByCols( %hash ); + return wantarray ? ( $ret, $msg ) : $ret; } @@ -418,57 +447,44 @@ sub CreatedObj { } -# -# TODO: This should be deprecated -# +# B<DEPRECATED> and will be removed in 4.4 sub AgeAsString { my $self = shift; + RT->Deprecated( + Remove => "4.4", + Instead => "->CreatedObj->AgeAsString", + ); return ( $self->CreatedObj->AgeAsString() ); } - - -# TODO this should be deprecated +# B<DEPRECATED> and will be removed in 4.4 +sub LongSinceUpdateAsString { + my $self = shift; + RT->Deprecated( + Remove => "4.4", + Instead => "->LastUpdatedObj->AgeAsString", + ); + if ( $self->LastUpdated ) { + return ( $self->LastUpdatedObj->AgeAsString() ); + } else { + return "never"; + } +} sub LastUpdatedAsString { my $self = shift; if ( $self->LastUpdated ) { return ( $self->LastUpdatedObj->AsString() ); - - } - else { + } else { return "never"; } } - -# -# TODO This should be deprecated -# sub CreatedAsString { my $self = shift; return ( $self->CreatedObj->AsString() ); } - -# -# TODO This should be deprecated -# -sub LongSinceUpdateAsString { - my $self = shift; - if ( $self->LastUpdated ) { - - return ( $self->LastUpdatedObj->AgeAsString() ); - - } - else { - return "never"; - } -} - - - -# sub _Set { my $self = shift; @@ -531,7 +547,6 @@ It takes no options. Arguably, this is a bug sub _SetLastUpdated { my $self = shift; - use RT::Date; my $now = RT::Date->new( $self->CurrentUser ); $now->SetToNow(); @@ -642,6 +657,7 @@ sub __Value { } my $value = $self->SUPER::__Value($field); + return $value if ref $value; return undef if (!defined $value); @@ -727,15 +743,19 @@ sub _Accessible { my $self = shift; my $column = shift; my $attribute = lc(shift); - return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column}); - return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0; + + my $class = ref($self) || $self; + $class->_BuildTableAttributes unless ($_TABLE_ATTR->{$class}); + + return 0 unless defined ($_TABLE_ATTR->{$class}->{$column}); + return $_TABLE_ATTR->{$class}->{$column}->{$attribute} || 0; } =head2 _EncodeLOB BODY MIME_TYPE FILENAME Takes a potentially large attachment. Returns (ContentEncoding, -EncodedBody, MimeType, Filename) based on system configuration and +EncodedBody, MimeType, Filename, NoteArgs) based on system configuration and selected database. Returns a custom (short) text/plain message if DropLongAttachments causes an attachment to not be stored. @@ -747,6 +767,10 @@ encoded on databases which are strict. This function expects to receive an octet string in order to properly evaluate and encode it. It will return an octet string. +NoteArgs is currently used to indicate caller that the message is too long and +is truncated or dropped. It's a hashref which is expected to be passed to +L<RT::Record/_NewTransaction>. + =cut sub _EncodeLOB { @@ -756,6 +780,7 @@ sub _EncodeLOB { my $Filename = shift; my $ContentEncoding = 'none'; + my $note_args; RT::Util::assert_bytes( $Body ); @@ -783,11 +808,21 @@ sub _EncodeLOB { #if the attachment is larger than the maximum size if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { + my $size = length $Body; # if we're supposed to truncate large attachments if (RT->Config->Get('TruncateLongAttachments')) { + $RT::Logger->info("$self: Truncated an attachment of size $size"); + # truncate the attachment to that length. $Body = substr( $Body, 0, $MaxSize ); + $note_args = { + Type => 'AttachmentTruncate', + Data => $Filename, + OldValue => $size, + NewValue => $MaxSize, + ActivateScrips => 0, + }; } @@ -795,11 +830,17 @@ sub _EncodeLOB { elsif (RT->Config->Get('DropLongAttachments')) { # drop the attachment on the floor - $RT::Logger->info( "$self: Dropped an attachment of size " - . length($Body)); + $RT::Logger->info( "$self: Dropped an attachment of size $size" ); $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) ); - $Filename .= ".txt" if $Filename; - return ("none", "Large attachment dropped", "text/plain", $Filename ); + $note_args = { + Type => 'AttachmentDrop', + Data => $Filename, + OldValue => $size, + NewValue => $MaxSize, + ActivateScrips => 0, + }; + $Filename .= ".txt" if $Filename && $Filename !~ /\.txt$/; + return ("none", "Large attachment dropped", "text/plain", $Filename, $note_args ); } } @@ -812,7 +853,8 @@ sub _EncodeLOB { $Body = MIME::QuotedPrint::encode($Body); } - return ($ContentEncoding, $Body, $MIMEType, $Filename ); + + return ($ContentEncoding, $Body, $MIMEType, $Filename, $note_args ); } =head2 _DecodeLOB C<ContentType>, C<ContentEncoding>, C<Content> @@ -871,23 +913,6 @@ sub _DecodeLOB { return ($Content); } -# A helper table for links mapping to make it easier -# to build and parse links between tickets - -use vars '%LINKDIRMAP'; - -%LINKDIRMAP = ( - MemberOf => { Base => 'MemberOf', - Target => 'HasMember', }, - RefersTo => { Base => 'RefersTo', - Target => 'ReferredToBy', }, - DependsOn => { Base => 'DependsOn', - Target => 'DependedOnBy', }, - MergedInto => { Base => 'MergedInto', - Target => 'MergedInto', }, - -); - =head2 Update ARGSHASH Updates fields on an object for you using the proper Set methods, @@ -949,17 +974,16 @@ sub Update { do { no warnings "uninitialized"; local $@; - eval { + my $name = eval { my $object = $attribute . "Obj"; - my $name = $self->$object->Name; - next if $name eq $value || $name eq ($value || 0); + $self->$object->Name; }; + unless ($@) { + next if $name eq $value || $name eq ($value || 0); + } - my $current = $self->$attribute(); - # RT::Queue->Lifecycle returns a Lifecycle object instead of name - $current = eval { $current->Name } if ref $current; - next if $truncated_value eq $current; - next if ( $truncated_value || 0 ) eq $current; + next if $truncated_value eq $self->$attribute(); + next if ( $truncated_value || 0 ) eq $self->$attribute(); }; $new_values{$attribute} = $value; @@ -1117,12 +1141,9 @@ sub HasUnresolvedDependencies { my $deps = $self->UnresolvedDependencies; if ($args{Type}) { - $deps->Limit( FIELD => 'Type', - OPERATOR => '=', - VALUE => $args{Type}); - } - else { - $deps->IgnoreType; + $deps->LimitType( VALUE => $args{Type} ); + } else { + $deps->IgnoreType; } if ($deps->Count > 0) { @@ -1148,10 +1169,7 @@ sub UnresolvedDependencies { my $self = shift; my $deps = RT::Tickets->new($self->CurrentUser); - my @live_statuses = RT::Queue->ActiveStatusArray(); - foreach my $status (@live_statuses) { - $deps->LimitStatus(VALUE => $status); - } + $deps->LimitToActiveStatus; $deps->LimitDependedOnBy($self->Id); return($deps); @@ -1199,35 +1217,35 @@ sub _AllLinkedTickets { LinkType => undef, Direction => undef, Type => undef, - _found => {}, - _top => 1, + _found => {}, + _top => 1, @_ ); my $dep = $self->_Links( $args{Direction}, $args{LinkType}); while (my $link = $dep->Next()) { my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI; - next unless ($uri->IsLocal()); + next unless ($uri->IsLocal()); my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj; - next if $args{_found}{$obj->Id}; + next if $args{_found}{$obj->Id}; - if (!$args{Type}) { - $args{_found}{$obj->Id} = $obj; - $obj->_AllLinkedTickets( %args, _top => 0 ); - } - elsif ($obj->Type and $obj->Type eq $args{Type}) { - $args{_found}{$obj->Id} = $obj; - } - else { - $obj->_AllLinkedTickets( %args, _top => 0 ); - } + if (!$args{Type}) { + $args{_found}{$obj->Id} = $obj; + $obj->_AllLinkedTickets( %args, _top => 0 ); + } + elsif ($obj->Type and $obj->Type eq $args{Type}) { + $args{_found}{$obj->Id} = $obj; + } + else { + $obj->_AllLinkedTickets( %args, _top => 0 ); + } } if ($args{_top}) { - return map { $args{_found}{$_} } sort keys %{$args{_found}}; + return map { $args{_found}{$_} } sort keys %{$args{_found}}; } else { - return 1; + return 1; } } @@ -1362,8 +1380,8 @@ Takes a Type and returns a string that is more human readable. sub FormatType{ my $self = shift; my %args = ( Type => '', - @_ - ); + @_ + ); $args{Type} =~ s/([A-Z])/" " . lc $1/ge; $args{Type} =~ s/^\s+//; return $args{Type}; @@ -1381,35 +1399,51 @@ Takes either a Target or a Base and returns a string of human friendly text. sub FormatLink { my $self = shift; my %args = ( Object => undef, - FallBack => '', - @_ - ); + FallBack => '', + @_ + ); my $text = "URI " . $args{FallBack}; if ($args{Object} && $args{Object}->isa("RT::Ticket")) { - $text = "Ticket " . $args{Object}->id; + $text = "Ticket " . $args{Object}->id; } return $text; } - - =head2 _AddLink Takes a paramhash of Type and one of Base or Target. Adds that link to this object. -Returns C<link id>, C<message> and C<exist> flag. +If Silent is true then no transactions will be recorded. You can individually +control transactions on both base and target and with SilentBase and +SilentTarget respectively. By default both transactions are created. +If the link destination is a local object and does the +L<RT::Record::Role::Status> role, this method ensures object Status is not +"deleted". Linking to deleted objects is forbidden. + +If the link destination (i.e. not C<$self>) is a local object and the +C<$StrictLinkACL> option is enabled, this method checks the appropriate right +on the destination object (if any, as returned by the L</ModifyLinkRight> +method). B<< The subclass is expected to check the appropriate right on the +source object (i.e. C<$self>) before calling this method. >> This allows a +different right to be used on the source object during creation, for example. + +Returns a tuple of (link ID, message, flag if link already existed). =cut sub _AddLink { my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - @_ ); - + my %args = ( + Target => '', + Base => '', + Type => '', + Silent => undef, + Silent => undef, + SilentBase => undef, + SilentTarget => undef, + @_ + ); # Remote_link is the URI of the object that is not this ticket my $remote_link; @@ -1433,8 +1467,30 @@ sub _AddLink { return ( 0, $self->loc('Either base or target must be specified') ); } + my $remote_uri = RT::URI->new( $self->CurrentUser ); + if ($remote_uri->FromURI( $remote_link )) { + my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef; + if ($remote_obj and $remote_obj->id) { + # Enforce the remote end of StrictLinkACL + if (RT->Config->Get("StrictLinkACL")) { + my $right = $remote_obj->ModifyLinkRight; + + return (0, $self->loc("Permission denied")) + if $right and + not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj ); + } + + # Prevent linking to deleted objects + if ($remote_obj->DOES("RT::Record::Role::Status") + and $remote_obj->Status eq "deleted") { + return (0, $self->loc("Linking to a deleted [_1] is not allowed", $self->loc(lc($remote_obj->RecordType)))); + } + } + } else { + return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link)); + } + # Check if the link already exists - we don't want duplicates - use RT::Link; my $old_link = RT::Link->new( $self->CurrentUser ); $old_link->LoadByParams( Base => $args{'Base'}, Type => $args{'Type'}, @@ -1444,52 +1500,96 @@ sub _AddLink { return ( $old_link->id, $self->loc("Link already exists"), 1 ); } - # }}} + if ( $args{'Type'} =~ /^(?:DependsOn|MemberOf)$/ ) { + my @tickets = $self->_AllLinkedTickets( + LinkType => $args{'Type'}, + Direction => $direction eq 'Target' ? 'Base' : 'Target', + ); + if ( grep { $_->id == ( $direction eq 'Target' ? $args{'Base'} : $args{'Target'} ) } @tickets ) { + return ( 0, $self->loc("Refused to add link which would create a circular relationship") ); + } + } # Storing the link in the DB. my $link = RT::Link->new( $self->CurrentUser ); my ($linkid, $linkmsg) = $link->Create( Target => $args{Target}, - Base => $args{Base}, - Type => $args{Type} ); + Base => $args{Base}, + Type => $args{Type} ); unless ($linkid) { $RT::Logger->error("Link could not be created: ".$linkmsg); - return ( 0, $self->loc("Link could not be created") ); + return ( 0, $self->loc("Link could not be created: [_1]", $linkmsg) ); } - my $basetext = $self->FormatLink(Object => $link->BaseObj, - FallBack => $args{Base}); - my $targettext = $self->FormatLink(Object => $link->TargetObj, - FallBack => $args{Target}); + my $basetext = $self->FormatLink(Object => $link->BaseObj, + FallBack => $args{Base}); + my $targettext = $self->FormatLink(Object => $link->TargetObj, + FallBack => $args{Target}); my $typetext = $self->FormatType(Type => $args{Type}); - my $TransString = - "$basetext $typetext $targettext."; - return ( $linkid, $TransString ) ; -} + my $TransString = "$basetext $typetext $targettext."; + + # No transactions for you! + return ($linkid, $TransString) if $args{'Silent'}; + + my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target'; + # Some transactions? + unless ( $args{ 'Silent'. $direction } ) { + my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( + Type => 'AddLink', + Field => $RT::Link::DIRMAP{$args{'Type'}}->{$direction}, + NewValue => $remote_uri->URI || $remote_link, + TimeTaken => 0 + ); + $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; + } + if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) { + my $OtherObj = $remote_uri->Object; + my ( $val, $msg ) = $OtherObj->_NewTransaction( + Type => 'AddLink', + Field => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction}, + NewValue => $self->URI, + TimeTaken => 0, + ); + $RT::Logger->error("Couldn't create transaction: $msg") unless $val; + } + + return ($linkid, $TransString); +} =head2 _DeleteLink -Delete a link. takes a paramhash of Base, Target and Type. -Either Base or Target must be null. The null value will -be replaced with this ticket's id +Takes a paramhash of Type and one of Base or Target. Removes that link from this object. + +If Silent is true then no transactions will be recorded. You can individually +control transactions on both base and target and with SilentBase and +SilentTarget respectively. By default both transactions are created. + +If the link destination (i.e. not C<$self>) is a local object and the +C<$StrictLinkACL> option is enabled, this method checks the appropriate right +on the destination object (if any, as returned by the L</ModifyLinkRight> +method). B<< The subclass is expected to check the appropriate right on the +source object (i.e. C<$self>) before calling this method. >> + +Returns a tuple of (status flag, message). =cut sub _DeleteLink { my $self = shift; my %args = ( - Base => undef, - Target => undef, - Type => undef, + Base => undef, + Target => undef, + Type => undef, + Silent => undef, + SilentBase => undef, + SilentTarget => undef, @_ ); - #we want one of base and target. we don't care which - #but we only want _one_ - + # We want one of base and target. We don't care which but we only want _one_. my $direction; my $remote_link; @@ -1499,45 +1599,93 @@ sub _DeleteLink { } elsif ( $args{'Base'} ) { $args{'Target'} = $self->URI(); - $remote_link = $args{'Base'}; - $direction = 'Target'; + $remote_link = $args{'Base'}; + $direction = 'Target'; } elsif ( $args{'Target'} ) { $args{'Base'} = $self->URI(); - $remote_link = $args{'Target'}; - $direction='Base'; + $remote_link = $args{'Target'}; + $direction = 'Base'; } else { $RT::Logger->error("Base or Target must be specified"); return ( 0, $self->loc('Either base or target must be specified') ); } - my $link = RT::Link->new( $self->CurrentUser ); - $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} ); + my $remote_uri = RT::URI->new( $self->CurrentUser ); + if ($remote_uri->FromURI( $remote_link )) { + # Enforce the remote end of StrictLinkACL + my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef; + if ($remote_obj and $remote_obj->id and RT->Config->Get("StrictLinkACL")) { + my $right = $remote_obj->ModifyLinkRight; + + return (0, $self->loc("Permission denied")) + if $right and + not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj ); + } + } else { + return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link)); + } + my $link = RT::Link->new( $self->CurrentUser ); + $RT::Logger->debug( "Trying to load link: " + . $args{'Base'} . " " + . $args{'Type'} . " " + . $args{'Target'} ); + + $link->LoadByParams( + Base => $args{'Base'}, + Type => $args{'Type'}, + Target => $args{'Target'} + ); - $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} ); - #it's a real link. + unless ($link->id) { + $RT::Logger->debug("Couldn't find that link"); + return ( 0, $self->loc("Link not found") ); + } - if ( $link->id ) { - my $basetext = $self->FormatLink(Object => $link->BaseObj, + my $basetext = $self->FormatLink(Object => $link->BaseObj, FallBack => $args{Base}); - my $targettext = $self->FormatLink(Object => $link->TargetObj, + my $targettext = $self->FormatLink(Object => $link->TargetObj, FallBack => $args{Target}); - my $typetext = $self->FormatType(Type => $args{Type}); - my $linkid = $link->id; - $link->Delete(); - my $TransString = "$basetext no longer $typetext $targettext."; - return ( 1, $TransString); + my $typetext = $self->FormatType(Type => $args{Type}); + my $TransString = "$basetext no longer $typetext $targettext."; + + my ($ok, $msg) = $link->Delete(); + unless ($ok) { + RT->Logger->error("Link could not be deleted: $msg"); + return ( 0, $self->loc("Link could not be deleted: [_1]", $msg) ); } - #if it's not a link we can find - else { - $RT::Logger->debug("Couldn't find that link"); - return ( 0, $self->loc("Link not found") ); + # No transactions for you! + return (1, $TransString) if $args{'Silent'}; + + my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target'; + + # Some transactions? + unless ( $args{ 'Silent'. $direction } ) { + my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( + Type => 'DeleteLink', + Field => $RT::Link::DIRMAP{$args{'Type'}}->{$direction}, + OldValue => $remote_uri->URI || $remote_link, + TimeTaken => 0 + ); + $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; + } + + if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) { + my $OtherObj = $remote_uri->Object; + my ( $val, $msg ) = $OtherObj->_NewTransaction( + Type => 'DeleteLink', + Field => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction}, + OldValue => $self->URI, + TimeTaken => 0, + ); + $RT::Logger->error("Couldn't create transaction: $msg") unless $val; } -} + return (1, $TransString); +} =head1 LockForUpdate @@ -1604,20 +1752,20 @@ sub _NewTransaction { my $new_ref = $args{'NewReference'}; my $ref_type = $args{'ReferenceType'}; if ($old_ref or $new_ref) { - $ref_type ||= ref($old_ref) || ref($new_ref); - if (!$ref_type) { - $RT::Logger->error("Reference type not specified for transaction"); - return; - } - $old_ref = $old_ref->Id if ref($old_ref); - $new_ref = $new_ref->Id if ref($new_ref); + $ref_type ||= ref($old_ref) || ref($new_ref); + if (!$ref_type) { + $RT::Logger->error("Reference type not specified for transaction"); + return; + } + $old_ref = $old_ref->Id if ref($old_ref); + $new_ref = $new_ref->Id if ref($new_ref); } require RT::Transaction; my $trans = RT::Transaction->new( $self->CurrentUser ); my ( $transaction, $msg ) = $trans->Create( - ObjectId => $self->Id, - ObjectType => ref($self), + ObjectId => $self->Id, + ObjectType => ref($self), TimeTaken => $args{'TimeTaken'}, Type => $args{'Type'}, Data => $args{'Data'}, @@ -1642,10 +1790,10 @@ sub _NewTransaction { $self->_SetLastUpdated; if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) { - $self->_UpdateTimeTaken( $args{'TimeTaken'} ); + $self->_UpdateTimeTaken( $args{'TimeTaken'}, Transaction => $trans ); } if ( RT->Config->Get('UseTransactionBatch') and $transaction ) { - push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; + push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; } RT->DatabaseHandle->Commit unless $in_txn; @@ -1657,17 +1805,14 @@ sub _NewTransaction { =head2 Transactions - Returns an RT::Transactions object of all transactions on this record object +Returns an L<RT::Transactions> object of all transactions on this record object =cut sub Transactions { my $self = shift; - use RT::Transactions; my $transactions = RT::Transactions->new( $self->CurrentUser ); - - #If the user has no rights, return an empty object $transactions->Limit( FIELD => 'ObjectId', VALUE => $self->id, @@ -1677,10 +1822,138 @@ sub Transactions { VALUE => ref($self), ); - return ($transactions); + return $transactions; } -# +=head2 SortedTransactions + +Returns the result of L</Transactions> ordered per the +I<OldestTransactionsFirst> preference/option. + +=cut + +sub SortedTransactions { + my $self = shift; + my $txns = $self->Transactions; + my $order = RT->Config->Get("OldestTransactionsFirst", $self->CurrentUser) + ? 'ASC' : 'DESC'; + $txns->OrderByCols( + { FIELD => 'Created', ORDER => $order }, + { FIELD => 'id', ORDER => $order }, + ); + return $txns; +} + +our %TRANSACTION_CLASSIFICATION = ( + Create => 'message', + Correspond => 'message', + Comment => 'message', + + AddWatcher => 'people', + DelWatcher => 'people', + + Take => 'people', + Untake => 'people', + Force => 'people', + Steal => 'people', + Give => 'people', + + AddLink => 'links', + DeleteLink => 'links', + + Status => 'basics', + Set => { + __default => 'basics', + map( { $_ => 'dates' } qw( + Told Starts Started Due LastUpdated Created LastUpdated + ) ), + map( { $_ => 'people' } qw( + Owner Creator LastUpdatedBy + ) ), + }, + SystemError => 'error', + AttachmentTruncate => 'attachment-truncate', + AttachmentDrop => 'attachment-drop', + AttachmentError => 'error', + __default => 'other', +); + +sub ClassifyTransaction { + my $self = shift; + my $txn = shift; + + my $type = $txn->Type; + + my $res = $TRANSACTION_CLASSIFICATION{ $type }; + return $res || $TRANSACTION_CLASSIFICATION{ '__default' } + unless ref $res; + + return $res->{ $txn->Field } || $res->{'__default'} + || $TRANSACTION_CLASSIFICATION{ '__default' }; +} + +=head2 Attachments + +Returns an L<RT::Attachments> object of all attachments on this record object +(for all its L</Transactions>). + +By default Content and Headers of attachments are not fetched right away from +database. Use C<WithContent> and C<WithHeaders> options to override this. + +=cut + +sub Attachments { + my $self = shift; + my %args = ( + WithHeaders => 0, + WithContent => 0, + @_ + ); + my @columns = grep { not /^(Headers|Content)$/ } + RT::Attachment->ReadableAttributes; + push @columns, 'Headers' if $args{'WithHeaders'}; + push @columns, 'Content' if $args{'WithContent'}; + + my $res = RT::Attachments->new( $self->CurrentUser ); + $res->Columns( @columns ); + my $txn_alias = $res->TransactionAlias; + $res->Limit( + ALIAS => $txn_alias, + FIELD => 'ObjectType', + VALUE => ref($self), + ); + $res->Limit( + ALIAS => $txn_alias, + FIELD => 'ObjectId', + VALUE => $self->id, + ); + return $res; +} + +=head2 TextAttachments + +Returns an L<RT::Attachments> object of all attachments, like L<Attachments>, +but only those that are text. + +By default Content and Headers are fetched. Use C<WithContent> and +C<WithHeaders> options to override this. + +=cut + +sub TextAttachments { + my $self = shift; + my $res = $self->Attachments( + WithHeaders => 1, + WithContent => 1, + @_ + ); + $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text/plain'); + $res->Limit( FIELD => 'ContentType', OPERATOR => 'STARTSWITH', VALUE => 'message/'); + $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text'); + $res->Limit( FIELD => 'Filename', OPERATOR => 'IS', VALUE => 'NULL') + if RT->Config->Get( 'SuppressInlineTextFiles', $self->CurrentUser ); + return $res; +} sub CustomFields { my $self = shift; @@ -1710,8 +1983,8 @@ sub CustomFieldLookupId { # Save a ->Load call by not calling ->FooObj->Id, just ->Foo my $final = shift @classes; foreach my $class (reverse @classes) { - my $method = "${class}Obj"; - $object = $object->$method; + my $method = "${class}Obj"; + $object = $object->$method; } my $id = $object->$final; @@ -1900,11 +2173,9 @@ sub _AddCustomFieldValue { # otherwise, just add a new value and record "new value added" else { - if ( !$cf->Repeated ) { - my $values = $cf->ValuesForObject($self); - if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { - return $entry->id; - } + my $values = $cf->ValuesForObject($self); + if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { + return $entry->id; } my ($new_value_id, $msg) = $cf->AddValueForObject( @@ -2104,12 +2375,359 @@ sub LoadCustomFieldByIdentifier { sub ACLEquivalenceObjects { } +=head2 HasRight + + Takes a paramhash with the attributes 'Right' and 'Principal' + 'Right' is a ticket-scoped textual right from RT::ACE + 'Principal' is an RT::User object + + Returns 1 if the principal has the right. Returns undef if not. + +=cut + +sub HasRight { + my $self = shift; + my %args = ( + Right => undef, + Principal => undef, + @_ + ); + + $args{Principal} ||= $self->CurrentUser->PrincipalObj; + + return $args{'Principal'}->HasRight( + Object => $self->Id ? $self : $RT::System, + Right => $args{'Right'} + ); +} + +sub CurrentUserHasRight { + my $self = shift; + return $self->HasRight( Right => @_ ); +} + +sub ModifyLinkRight { } + +=head2 ColumnMapClassName + +ColumnMap needs a massaged collection class name to load the correct list +display. Equivalent to L<RT::SearchBuilder/ColumnMapClassName>, but provided +for a record instead of a collection. + +Returns a string. May be called as a package method. + +=cut + +sub ColumnMapClassName { + my $self = shift; + my $Class = ref($self) || $self; + $Class =~ s/:/_/g; + return $Class; +} + sub BasicColumns { } sub WikiBase { return RT->Config->Get('WebPath'). "/index.html?q="; } +sub UID { + my $self = shift; + return undef unless defined $self->Id; + return "@{[ref $self]}-$RT::Organization-@{[$self->Id]}"; +} + +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + for my $col (qw/Creator LastUpdatedBy/) { + if ( $self->_Accessible( $col, 'read' ) ) { + next unless $self->$col; + my $obj = RT::Principal->new( $self->CurrentUser ); + $obj->Load( $self->$col ); + $deps->Add( out => $obj->Object ); + } + } + + # Object attributes, we have to check on every object + my $objs = $self->Attributes; + $deps->Add( in => $objs ); + + # Transactions + if ( $self->isa("RT::Ticket") + or $self->isa("RT::User") + or $self->isa("RT::Group") + or $self->isa("RT::Article") + or $self->isa("RT::Queue") ) + { + $objs = RT::Transactions->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'ObjectType', VALUE => ref $self ); + $objs->Limit( FIELD => 'ObjectId', VALUE => $self->id ); + $deps->Add( in => $objs ); + } + + # Object custom field values + if (( $self->isa("RT::Transaction") + or $self->isa("RT::Ticket") + or $self->isa("RT::User") + or $self->isa("RT::Group") + or $self->isa("RT::Queue") + or $self->isa("RT::Article") ) + and $self->can("CustomFieldValues") ) + { + $objs = $self->CustomFieldValues; # Actually OCFVs + $objs->{find_expired_rows} = 1; + $deps->Add( in => $objs ); + } + + # ACE records + if ( $self->isa("RT::Group") + or $self->isa("RT::Class") + or $self->isa("RT::Queue") + or $self->isa("RT::CustomField") ) + { + $objs = RT::ACL->new( $self->CurrentUser ); + $objs->LimitToObject( $self ); + $deps->Add( in => $objs ); + } +} + +sub Serialize { + my $self = shift; + my %args = ( + Methods => {}, + UIDs => 1, + @_, + ); + my %methods = ( + Creator => "CreatorObj", + LastUpdatedBy => "LastUpdatedByObj", + %{ $args{Methods} || {} }, + ); + + my %values = %{$self->{values}}; + + my %ca = %{ $self->_ClassAccessible }; + my @cols = grep {exists $values{lc $_} and defined $values{lc $_}} keys %ca; + + my %store; + $store{$_} = $values{lc $_} for @cols; + $store{id} = $values{id}; # Explicitly necessary in some cases + + # Un-apply the _transfer_ encoding, but don't mess with the octets + # themselves. Calling ->Content directly would, in some cases, + # decode from some mostly-unknown character set -- which reversing + # on the far end would be complicated. + if ($ca{ContentEncoding} and $ca{ContentType}) { + my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/; + $store{$content_col} = $self->_DecodeLOB( + "application/octet-stream", # Lie so that we get bytes, not characters + $self->ContentEncoding, + $self->_Value( $content_col, decode_utf8 => 0 ) + ); + delete $store{ContentEncoding}; + } + return %store unless $args{UIDs}; + + # Use FooObj to turn Foo into a reference to the UID + for my $col ( grep {$store{$_}} @cols ) { + my $method = $methods{$col}; + if (not $method) { + $method = $col; + $method =~ s/(Id)?$/Obj/; + } + next unless $self->can($method); + + my $obj = $self->$method; + next unless $obj and $obj->isa("RT::Record"); + $store{$col} = \($obj->UID); + } + + # Anything on an object should get the UID stored instead + if ($store{ObjectType} and $store{ObjectId} and $self->can("Object")) { + delete $store{$_} for qw/ObjectType ObjectId/; + $store{Object} = \($self->Object->UID); + } + + return %store; +} + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + my $ca = $class->_ClassAccessible; + my %ca = %{ $ca }; + + if ($ca{ContentEncoding} and $ca{ContentType}) { + my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/; + if (defined $data->{$content_col}) { + my ($ContentEncoding, $Content) = $class->_EncodeLOB( + $data->{$content_col}, $data->{ContentType}, + ); + $data->{ContentEncoding} = $ContentEncoding; + $data->{$content_col} = $Content; + } + } + + if ($data->{Object} and not $ca{Object}) { + my $ref_uid = ${ delete $data->{Object} }; + my $ref = $importer->Lookup( $ref_uid ); + if ($ref) { + my ($class, $id) = @{$ref}; + $data->{ObjectId} = $id; + $data->{ObjectType} = $class; + } else { + $data->{ObjectId} = 0; + $data->{ObjectType} = ""; + $importer->Postpone( + for => $ref_uid, + uid => $uid, + column => "ObjectId", + classcolumn => "ObjectType", + ); + } + } + + for my $col (keys %{$data}) { + if (ref $data->{$col}) { + my $ref_uid = ${ $data->{$col} }; + my $ref = $importer->Lookup( $ref_uid ); + if ($ref) { + my (undef, $id) = @{$ref}; + $data->{$col} = $id; + } else { + $data->{$col} = 0; + $importer->Postpone( + for => $ref_uid, + uid => $uid, + column => $col, + ); + } + } + } + + return 1; +} + +sub PostInflate { +} + +=head2 _AsInsertQuery + +Returns INSERT query string that duplicates current record and +can be used to insert record back into DB after delete. + +=cut + +sub _AsInsertQuery +{ + my $self = shift; + + my $dbh = $RT::Handle->dbh; + + my $res = "INSERT INTO ". $dbh->quote_identifier( $self->Table ); + my $values = $self->{'values'}; + $res .= "(". join( ",", map { $dbh->quote_identifier( $_ ) } sort keys %$values ) .")"; + $res .= " VALUES"; + $res .= "(". join( ",", map { $dbh->quote( $values->{$_} ) } sort keys %$values ) .")"; + $res .= ";"; + + return $res; +} + +sub BeforeWipeout { return 1 } + +=head2 Dependencies + +Returns L<RT::Shredder::Dependencies> object. + +=cut + +sub Dependencies +{ + my $self = shift; + my %args = ( + Shredder => undef, + Flags => RT::Shredder::Constants::DEPENDS_ON, + @_, + ); + + unless( $self->id ) { + RT::Shredder::Exception->throw('Object is not loaded'); + } + + my $deps = RT::Shredder::Dependencies->new(); + if( $args{'Flags'} & RT::Shredder::Constants::DEPENDS_ON ) { + $self->__DependsOn( %args, Dependencies => $deps ); + } + return $deps; +} + +sub __DependsOn +{ + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# Object custom field values + my $objs = $self->CustomFieldValues; + $objs->{'find_expired_rows'} = 1; + push( @$list, $objs ); + +# Object attributes + $objs = $self->Attributes; + push( @$list, $objs ); + +# Transactions + $objs = RT::Transactions->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'ObjectType', VALUE => ref $self ); + $objs->Limit( FIELD => 'ObjectId', VALUE => $self->id ); + push( @$list, $objs ); + +# Links + if ( $self->can('Links') ) { + # make sure we don't skip any record + no warnings 'redefine'; + local *RT::Links::IsValidLink = sub { 1 }; + + foreach ( qw(Base Target) ) { + my $objs = $self->Links( $_ ); + $objs->_DoSearch; + push @$list, $objs->ItemsArrayRef; + } + } + +# ACE records + $objs = RT::ACL->new( $self->CurrentUser ); + $objs->LimitToObject( $self ); + push( @$list, $objs ); + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + return; +} + +# implement proxy method because some RT classes +# override Delete method +sub __Wipeout +{ + my $self = shift; + my $msg = $self->UID ." wiped out"; + $self->SUPER::Delete; + $RT::Logger->info( $msg ); + return; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Record/AddAndSort.pm b/rt/lib/RT/Record/AddAndSort.pm new file mode 100644 index 0000000..4b5d7ac --- /dev/null +++ b/rt/lib/RT/Record/AddAndSort.pm @@ -0,0 +1,621 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Record::AddAndSort; +use base 'RT::Record'; + +=head1 NAME + +RT::Record::AddAndSort - base class for records that can be added and sorted + +=head1 DESCRIPTION + +Base class for L<RT::ObjectCustomField> and L<RT::ObjectScrip> that unifies +application of L<RT::CustomField>s and L<RT::Scrip>s to various objects. Also, +deals with order of the records. + +=head1 METHODS + +=head2 Meta information + +=head3 CollectionClass + +Returns class representing collection for this record class. Basicly adds 's' +at the end. Should be overriden if default doesn't work. + +For example returns L<RT::ObjectCustomFields> when called on L<RT::ObjectCustomField>. + +=cut + +sub CollectionClass { + return (ref($_[0]) || $_[0]).'s'; +} + +=head3 TargetField + +Returns name of the field in the table where id of object we add is stored. +By default deletes everything up to '::Object' from class name. +This method allows to use friendlier argument names and methods. + +For example returns 'Scrip' for L<RT::ObjectScrip>. + +=cut + +sub TargetField { + my $class = ref($_[0]) || $_[0]; + $class =~ s/.*::Object// or return undef; + return $class; +} + +=head3 ObjectCollectionClass + +Takes an object under L</TargetField> name and should return class +name representing collection the object can be added to. + +Must be overriden by sub classes. + + +See L<RT::ObjectScrip/ObjectCollectionClass> and L<RT::ObjectCustomField/CollectionClass>. + +=cut + +sub ObjectCollectionClass { die "should be subclassed" } + +=head2 Manipulation + +=head3 Create + +Takes 'ObjectId' with id of an object we can be added to, object we can +add to under L</TargetField> name, Disabled and SortOrder. + +This method doesn't create duplicates. If record already exists then it's not created, but +loaded instead. Note that nothing is updated if record exist. + +If SortOrder is not defined then it's calculated to place new record last. If it's +provided then it's caller's duty to make sure it is correct value. + +Example: + + my $ocf = RT::ObjectCustomField->new( RT->SystemUser ); + my ($id, $msg) = $ocf->Create( CustomField => 1, ObjectId => 0 ); + +See L</Add> which has more error checks. Also, L<RT::Scrip> and L<RT::CustomField> +have more appropriate methods that B<should be> prefered over calling this directly. + +=cut + +sub Create { + my $self = shift; + my %args = ( + ObjectId => 0, + SortOrder => undef, + @_ + ); + + my $tfield = $self->TargetField; + + my $target = $self->TargetObj( $args{ $tfield } ); + unless ( $target->id ) { + $RT::Logger->error("Couldn't load ". ref($target) ." '$args{$tfield}'"); + return 0; + } + + my $exist = $self->new($self->CurrentUser); + $exist->LoadByCols( ObjectId => $args{'ObjectId'}, $tfield => $target->id ); + if ( $exist->id ) { + $self->Load( $exist->id ); + return $self->id; + } + + unless ( defined $args{'SortOrder'} ) { + $args{'SortOrder'} = $self->NextSortOrder( + %args, + $tfield => $target, + ); + } + + return $self->SUPER::Create( + %args, + $tfield => $target->id, + ); +} + +=head3 Add + +Helper method that wraps L</Create> and does more checks to make sure +result is consistent. Doesn't allow adding a record to an object if the +record is already global. Removes record from particular objects when +asked to add the record globally. + +=cut + +sub Add { + my $self = shift; + my %args = (@_); + + my $field = $self->TargetField; + + my $tid = $args{ $field }; + $tid = $tid->id if ref $tid; + $tid ||= $self->TargetObj->id; + + my $oid = $args{'ObjectId'}; + $oid = $oid->id if ref $oid; + $oid ||= 0; + + if ( $self->IsAdded( $tid => $oid ) ) { + return ( 0, $self->loc("Is already added to the object") ); + } + + if ( $oid ) { + # adding locally + return (0, $self->loc("Couldn't add as it's global already") ) + if $self->IsAdded( $tid => 0 ); + } + else { + $self->DeleteAll( $field => $tid ); + } + + return $self->Create( + %args, $field => $tid, ObjectId => $oid, + ); +} + +sub IsAdded { + my $self = shift; + my ($tid, $oid) = @_; + my $record = $self->new( $self->CurrentUser ); + $record->LoadByCols( $self->TargetField => $tid, ObjectId => $oid ); + return $record->id; +} + +=head3 AddedTo + +Returns collection with objects target of this record is added to. +Class of the collection depends on L</ObjectCollectionClass>. +See all L</NotAddedTo>. + +For example returns L<RT::Queues> collection if the target is L<RT::Scrip>. + +Returns empty collection if target is added globally. + +=cut + +sub AddedTo { + my $self = shift; + + my ($res, $alias) = $self->_AddedTo( @_ ); + return $res unless $res; + + $res->Limit( + ALIAS => $alias, + FIELD => 'id', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + + return $res; +} + +=head3 NotAddedTo + +Returns collection with objects target of this record is not added to. +Class of the collection depends on L</ObjectCollectionClass>. +See all L</AddedTo>. + +Returns empty collection if target is added globally. + +=cut + +sub NotAddedTo { + my $self = shift; + + my ($res, $alias) = $self->_AddedTo( @_ ); + return $res unless $res; + + $res->Limit( + ALIAS => $alias, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + + return $res; +} + +sub _AddedTo { + my $self = shift; + my %args = (@_); + + my $field = $self->TargetField; + my $target = $args{ $field } || $self->TargetObj; + + my ($class) = $self->ObjectCollectionClass( $field => $target ); + return undef unless $class; + + my $res = $class->new( $self->CurrentUser ); + + # If target added to a Group, only display user-defined groups + $res->LimitToUserDefinedGroups if $class eq 'RT::Groups'; + + $res->OrderBy( FIELD => 'Name' ); + my $alias = $res->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => $self->Table, + FIELD2 => 'ObjectId', + ); + $res->Limit( + LEFTJOIN => $alias, + ALIAS => $alias, + FIELD => $field, + VALUE => $target->id, + ); + return ($res, $alias); +} + +=head3 Delete + +Deletes this record. + +=cut + +sub Delete { + my $self = shift; + + return $self->SUPER::Delete if $self->IsSortOrderShared; + + # Move everything below us up + my $siblings = $self->Neighbors; + $siblings->Limit( FIELD => 'SortOrder', OPERATOR => '>=', VALUE => $self->SortOrder ); + $siblings->OrderBy( FIELD => 'SortOrder', ORDER => 'ASC' ); + foreach my $record ( @{ $siblings->ItemsArrayRef } ) { + $record->SetSortOrder($record->SortOrder - 1); + } + + return $self->SUPER::Delete; +} + +=head3 DeleteAll + +Helper method to delete all applications for one target (Scrip, CustomField, ...). +Target can be provided in arguments. If it's not then L</TargetObj> is used. + + $object_scrip->DeleteAll; + + $object_scrip->DeleteAll( Scrip => $scrip ); + +=cut + +sub DeleteAll { + my $self = shift; + my %args = (@_); + + my $field = $self->TargetField; + + my $id = $args{ $field }; + $id = $id->id if ref $id; + $id ||= $self->TargetObj->id; + + my $list = $self->CollectionClass->new( $self->CurrentUser ); + $list->Limit( FIELD => $field, VALUE => $id ); + $_->Delete foreach @{ $list->ItemsArrayRef }; +} + +=head3 MoveUp + +Moves record up. + +=cut + +sub MoveUp { return shift->Move( Up => @_ ) } + +=head3 MoveDown + +Moves record down. + +=cut + +sub MoveDown { return shift->Move( Down => @_ ) } + +=head3 Move + +Takes 'up' or 'down'. One method that implements L</MoveUp> and L</MoveDown>. + +=cut + +sub Move { + my $self = shift; + my $dir = lc(shift || 'up'); + + my %meta; + if ( $dir eq 'down' ) { + %meta = qw( + next_op > + next_order ASC + prev_op <= + diff +1 + ); + } else { + %meta = qw( + next_op < + next_order DESC + prev_op >= + diff -1 + ); + } + + my $siblings = $self->Siblings; + $siblings->Limit( FIELD => 'SortOrder', OPERATOR => $meta{'next_op'}, VALUE => $self->SortOrder ); + $siblings->OrderBy( FIELD => 'SortOrder', ORDER => $meta{'next_order'} ); + + my @next = ($siblings->Next, $siblings->Next); + unless ($next[0]) { + return $dir eq 'down' + ? (0, "Can not move down. It's already at the bottom") + : (0, "Can not move up. It's already at the top") + ; + } + + my ($new_sort_order, $move); + + unless ( $self->ObjectId ) { + # moving global, it can not share sort order, so just move it + # on place of next global and move everything in between one number + + $new_sort_order = $next[0]->SortOrder; + $move = $self->Neighbors; + $move->Limit( + FIELD => 'SortOrder', OPERATOR => $meta{'next_op'}, VALUE => $self->SortOrder, + ); + $move->Limit( + FIELD => 'SortOrder', OPERATOR => $meta{'prev_op'}, VALUE => $next[0]->SortOrder, + ENTRYAGGREGATOR => 'AND', + ); + } + elsif ( $next[0]->ObjectId == $self->ObjectId ) { + # moving two locals, just swap them, they should follow 'so = so+/-1' rule + $new_sort_order = $next[0]->SortOrder; + $move = $next[0]; + } + else { + # moving local behind global + unless ( $self->IsSortOrderShared ) { + # not shared SO allows us to swap + $new_sort_order = $next[0]->SortOrder; + $move = $next[0]; + } + elsif ( $next[1] ) { + # more records there and shared SO, we have to move everything + $new_sort_order = $next[0]->SortOrder; + $move = $self->Neighbors; + $move->Limit( + FIELD => 'SortOrder', OPERATOR => $meta{prev_op}, VALUE => $next[0]->SortOrder, + ); + } + else { + # shared SO and place after is free, so just jump + $new_sort_order = $next[0]->SortOrder + $meta{'diff'}; + } + } + + if ( $move ) { + foreach my $record ( $move->isa('RT::Record')? ($move) : @{ $move->ItemsArrayRef } ) { + my ($status, $msg) = $record->SetSortOrder( + $record->SortOrder - $meta{'diff'} + ); + return (0, "Couldn't move: $msg") unless $status; + } + } + + my ($status, $msg) = $self->SetSortOrder( $new_sort_order ); + unless ( $status ) { + return (0, "Couldn't move: $msg"); + } + + return (1,"Moved"); +} + +=head2 Accessors, instrospection and traversing. + +=head3 TargetObj + +Returns target object of this record. Returns L<RT::Scrip> object for +L<RT::ObjectScrip>. + +=cut + +sub TargetObj { + my $self = shift; + my $id = shift; + + my $method = $self->TargetField .'Obj'; + return $self->$method( $id ); +} + +=head3 NextSortOrder + +Returns next available SortOrder value in the L<neighborhood|/Neighbors>. +Pass arguments to L</Neighbors> and can take optional ObjectId argument, +calls ObjectId if it's not provided. + +=cut + +sub NextSortOrder { + my $self = shift; + my %args = (@_); + + my $oid = $args{'ObjectId'}; + $oid = $self->ObjectId unless defined $oid; + $oid ||= 0; + + my $neighbors = $self->Neighbors( %args ); + if ( $oid ) { + $neighbors->LimitToObjectId( $oid ); + $neighbors->LimitToObjectId( 0 ); + } elsif ( !$neighbors->_isLimited ) { + $neighbors->UnLimit; + } + $neighbors->OrderBy( FIELD => 'SortOrder', ORDER => 'DESC' ); + return 0 unless my $first = $neighbors->First; + return $first->SortOrder + 1; +} + +=head3 IsSortOrderShared + +Returns true if this record shares SortOrder value with a L<neighbor|/Neighbors>. + +=cut + +sub IsSortOrderShared { + my $self = shift; + return 0 unless $self->ObjectId; + + my $neighbors = $self->Neighbors; + $neighbors->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->id ); + $neighbors->Limit( FIELD => 'SortOrder', VALUE => $self->SortOrder ); + return $neighbors->Count; +} + +=head2 Neighbors and Siblings + +These two methods should only be understood by developers who wants +to implement new classes of records that can be added to other records +and sorted. + +Main purpose is to maintain SortOrder values. + +Let's take a look at custom fields. A custom field can be created for tickets, +queues, transactions, users... Custom fields created for tickets can +be added globally or to particular set of queues. Custom fields for +tickets are neighbors. Neighbor custom fields added to the same objects +are siblings. Custom fields added globally are sibling to all neighbors. + +For scrips Stage defines neighborhood. + +Let's look at the three scrips in create stage S1, S2 and S3, queues Q1 and Q2 and +G for global. + + S1@Q1, S3@Q2 0 + S2@G 1 + S1@Q2 2 + +Above table says that S2 is added globally, S1 is added to Q1 and executed +before S2 in this queue, also S1 is added to Q1, but exectued after S2 in this +queue, S3 is only added to Q2 and executed before S2 and S1. + +Siblings are scrips added to an object including globally added or only +globally added. In our example there are three different collection +of siblings: (S2) - global, (S1, S2) for Q1, (S3, S2, S1) for Q2. + +Sort order can be shared between neighbors, but can not be shared between siblings. + +Here is what happens with sort order if we move S1@Q2 one position up: + + S3@Q2 0 + S1@Q1, S1@Q2 1 + S2@G 2 + +One position more: + + S1@Q2 0 + S1@Q1, S3@Q2 1 + S2@G 2 + +Hopefuly it's enough to understand how it works. + +Targets from different neighborhood can not be sorted against each other. + +=head3 Neighbors + +Returns collection of records of this class with all +neighbors. By default all possible targets are neighbors. + +Takes the same arguments as L</Create> method. If arguments are not passed +then uses the current record. + +See L</Neighbors and Siblings> for detailed description. + +See L<RT::ObjectCustomField/Neighbors> for example. + +=cut + +sub Neighbors { + my $self = shift; + return $self->CollectionClass->new( $self->CurrentUser ); +} + +=head3 Siblings + +Returns collection of records of this class with siblings. + +Takes the same arguments as L</Neighbors>. Siblings is subset of L</Neighbors>. + +=cut + +sub Siblings { + my $self = shift; + my %args = @_; + + my $oid = $args{'ObjectId'}; + $oid = $self->ObjectId unless defined $oid; + $oid ||= 0; + + my $res = $self->Neighbors( %args ); + $res->LimitToObjectId( $oid ); + $res->LimitToObjectId( 0 ) if $oid; + return $res; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/Record/Role.pm b/rt/lib/RT/Record/Role.pm new file mode 100644 index 0000000..9d95ea1 --- /dev/null +++ b/rt/lib/RT/Record/Role.pm @@ -0,0 +1,78 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Record::Role; +use Role::Basic; + +=head1 NAME + +RT::Record::Role - Common requirements for roles which are consumed by records + +=head1 DESCRIPTION + +Various L<RT::Record> (and by inheritance L<DBIx::SearchBuilder::Record>) +methods are required by this role. It provides no methods on its own but is +simply a contract for other roles to require (usually under the +I<RT::Record::Role::> namespace). + +=cut + +requires $_ for qw( + id + loc + CurrentUser + + _Set + _Accessible + _NewTransaction +); + +1; diff --git a/rt/lib/RT/Record/Role/Lifecycle.pm b/rt/lib/RT/Record/Role/Lifecycle.pm new file mode 100644 index 0000000..0474a06 --- /dev/null +++ b/rt/lib/RT/Record/Role/Lifecycle.pm @@ -0,0 +1,219 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Record::Role::Lifecycle; +use Role::Basic; +use Scalar::Util qw(blessed); + +=head1 NAME + +RT::Record::Role::Lifecycle - Common methods for records which have a Lifecycle column + +=head1 REQUIRES + +=head2 L<RT::Record::Role> + +=head2 LifecycleType + +Used as a role parameter. Must return a string of the type of lifecycles the +record consumes, i.e. I<ticket> for L<RT::Queue>. + +=head2 Lifecycle + +A Lifecycle method which returns a lifecycle name is required. Currently +unenforced at compile-time due to poor interactions with +L<DBIx::SearchBuilder::Record/AUTOLOAD>. You'll hit run-time errors if this +method isn't available in consuming classes, however. + +=cut + +with 'RT::Record::Role'; +requires 'LifecycleType'; + +# XXX: can't require column methods due to DBIx::SB::Record's AUTOLOAD +#requires 'Lifecycle'; + +=head1 PROVIDES + +=head2 LifecycleObj + +Returns an L<RT::Lifecycle> object for this record's C<Lifecycle>. If called +as a class method, returns an L<RT::Lifecycle> object which is an aggregation +of all lifecycles of the appropriate type. + +=cut + +sub LifecycleObj { + my $self = shift; + my $type = $self->LifecycleType; + my $fallback = $self->_Accessible( Lifecycle => "default" ); + + unless (blessed($self) and $self->id) { + return RT::Lifecycle->Load( Type => $type ); + } + + my $name = $self->Lifecycle || $fallback; + my $res = RT::Lifecycle->Load( Name => $name, Type => $type ); + unless ( $res ) { + RT->Logger->error( + sprintf "Lifecycle '%s' of type %s for %s #%d doesn't exist", + $name, $type, ref($self), $self->id); + return RT::Lifecycle->Load( Name => $fallback, Type => $type ); + } + return $res; +} + +=head2 SetLifecycle + +Validates that the specified lifecycle exists before updating the record. + +Takes a lifecycle name. + +=cut + +sub SetLifecycle { + my $self = shift; + my $value = shift || $self->_Accessible( Lifecycle => "default" ); + + return (0, $self->loc('[_1] is not a valid lifecycle', $value)) + unless $self->ValidateLifecycle($value); + + return $self->_Set( Field => 'Lifecycle', Value => $value, @_ ); +} + +=head2 ValidateLifecycle + +Takes a lifecycle name. Returns true if it's an OK name and such lifecycle is +configured. Returns false otherwise. + +=cut + +sub ValidateLifecycle { + my $self = shift; + my $value = shift; + return unless $value; + return unless RT::Lifecycle->Load( Name => $value, Type => $self->LifecycleType ); + return 1; +} + +=head2 ActiveStatusArray + +Returns an array of all ActiveStatuses for the lifecycle + +=cut + +sub ActiveStatusArray { + my $self = shift; + return $self->LifecycleObj->Valid('initial', 'active'); +} + +=head2 InactiveStatusArray + +Returns an array of all InactiveStatuses for the lifecycle + +=cut + +sub InactiveStatusArray { + my $self = shift; + return $self->LifecycleObj->Inactive; +} + +=head2 StatusArray + +Returns an array of all statuses for the lifecycle + +=cut + +sub StatusArray { + my $self = shift; + return $self->LifecycleObj->Valid( @_ ); +} + +=head2 IsValidStatus + +Takes a status. + +Returns true if STATUS is a valid status. Otherwise, returns 0. + +=cut + +sub IsValidStatus { + my $self = shift; + return $self->LifecycleObj->IsValid( shift ); +} + +=head2 IsActiveStatus + +Takes a status. + +Returns true if STATUS is a Active status. Otherwise, returns 0 + +=cut + +sub IsActiveStatus { + my $self = shift; + return $self->LifecycleObj->IsValid( shift, 'initial', 'active'); +} + +=head2 IsInactiveStatus + +Takes a status. + +Returns true if STATUS is a Inactive status. Otherwise, returns 0 + +=cut + +sub IsInactiveStatus { + my $self = shift; + return $self->LifecycleObj->IsInactive( shift ); +} + +1; diff --git a/rt/lib/RT/Record/Role/Links.pm b/rt/lib/RT/Record/Role/Links.pm new file mode 100644 index 0000000..f865090 --- /dev/null +++ b/rt/lib/RT/Record/Role/Links.pm @@ -0,0 +1,174 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Record::Role::Links; +use Role::Basic; + +=head1 NAME + +RT::Record::Role::Links - Common methods for records which handle links + +=head1 REQUIRES + +=head2 L<RT::Record::Role> + +=head2 _AddLink + +Usually provided by L<RT::Record/_AddLink>. + +=head2 _DeleteLink + +Usually provided by L<RT::Record/_DeleteLink>. + +=head2 ModifyLinkRight + +The right name to check in L<AddLink> and L<DeleteLink>. + +=head2 CurrentUserHasRight + +=cut + +with 'RT::Record::Role'; + +requires '_AddLink'; +requires '_DeleteLink'; + +requires 'ModifyLinkRight'; +requires 'CurrentUserHasRight'; + +=head1 PROVIDES + +=head2 _AddLinksOnCreate + +Calls _AddLink (usually L<RT::Record/_AddLink>) for all valid link types and +aliases found in the hash. Refer to L<RT::Link/%TYPEMAP> for details of link +types. Key values may be a single URI or an arrayref of URIs. + +Takes two hashrefs. The first is the argument hash provided to the consuming +class's Create method. The second is optional and contains extra arguments to +pass to _AddLink. + +By default records a transaction on the link's destination object (if any), but +not on the origin object. + +Returns an array of localized error messages, if any. + +=cut + +sub _AddLinksOnCreate { + my $self = shift; + my %args = %{shift || {}}; + my %AddLink = %{shift || {}}; + my @results; + + foreach my $type ( keys %RT::Link::TYPEMAP ) { + next unless defined $args{$type}; + + my $links = $args{$type}; + $links = [$links] unless ref $links; + + for my $link (@$links) { + my $typemap = $RT::Link::TYPEMAP{$type}; + my $opposite_mode = $typemap->{Mode} eq "Base" ? "Target" : "Base"; + my ($ok, $msg) = $self->_AddLink( + Type => $typemap->{Type}, + $typemap->{Mode} => $link, + "Silent$opposite_mode" => 1, + %AddLink, + ); + push @results, + $self->loc("Unable to add [_1] link: [_2]", $self->loc($type), $msg) + unless $ok; + } + } + return @results; +} + +=head2 AddLink + +Takes a paramhash of Type and one of Base or Target. Adds that link to this +record. + +Refer to L<RT::Record/_AddLink> for full documentation. This method implements +permissions and ticket validity checks before calling into L<RT::Record> +(usually). + +=cut + +sub AddLink { + my $self = shift; + + return (0, $self->loc("Permission Denied")) + unless $self->CurrentUserHasRight($self->ModifyLinkRight); + + return $self->_AddLink(@_); +} + +=head2 DeleteLink + +Takes a paramhash of Type and one of Base or Target. Removes that link from the +record. + +Refer to L<RT::Record/_DeleteLink> for full documentation. This method +implements permission checks before calling into L<RT::Record> (usually). + +=cut + +sub DeleteLink { + my $self = shift; + + return (0, $self->loc("Permission Denied")) + unless $self->CurrentUserHasRight($self->ModifyLinkRight); + + return $self->_DeleteLink(@_); +} + +1; diff --git a/rt/lib/RT/Shredder/Template.pm b/rt/lib/RT/Record/Role/Rights.pm index a23477e..cd2d60a 100644 --- a/rt/lib/RT/Shredder/Template.pm +++ b/rt/lib/RT/Record/Role/Rights.pm @@ -46,75 +46,88 @@ # # END BPS TAGGED BLOCK }}} -use RT::Template (); -package RT::Template; - use strict; use warnings; -use warnings FATAL => 'redefine'; -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; +package RT::Record::Role::Rights; +use Role::Basic; +use Scalar::Util qw(blessed); +=head1 NAME -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Scrips - my $objs = RT::Scrips->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'Template', VALUE => $self->Id ); - push( @$list, $objs ); - - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'}, - ); - - return $self->SUPER::__DependsOn( %args ); +RT::Record::Role::Rights - Common methods for records which can provide rights + +=head1 DESCRIPTION + +=head1 REQUIRES + +=head2 L<RT::Record::Role> + +=cut + +with 'RT::Record::Role'; + +=head1 PROVIDES + +=cut + +=head2 AddRight C<CATEGORY>, C<RIGHT>, C<DESCRIPTION> + +Adds the given rights to the list of possible rights. This method +should be called during server startup, not at runtime. + +=cut + +sub AddRight { + my $class = shift; + $class = ref($class) || $class; + my ($category, $name, $description) = @_; + + require RT::ACE; + if (exists $RT::ACE::RIGHTS{$class}{lc $name}) { + warn "Duplicate right '$name' found"; + return; + } + + $RT::ACE::RIGHTS{$class}{lc $name} = { + Name => $name, + Category => $category, + Description => $description, + }; } -sub __Relates -{ +=head2 AvailableRights + +Returns a hashref of available rights for this object. The keys are the +right names and the values are a description of what the rights do. + +=cut + +sub AvailableRights { my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Queue - my $obj = $self->QueueObj; - if( $obj && defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Queue #". $self->id ." object"; - } + my $class = ref($self) || $self; -# TODO: Users(Creator, LastUpdatedBy) + my %rights; + $rights{$_->{Name}} = $_->{Description} + for values %{$RT::ACE::RIGHTS{$class} || {} }; + return \%rights; +} + +=head2 RightCategories + +Returns a hashref where the keys are rights for this type of object and the +values are the category (General, Staff, Admin) the right falls into. + +=cut + +sub RightCategories { + my $self = shift; + my $class = ref($self) || $self; - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); + my %rights; + $rights{$_->{Name}} = $_->{Category} + for values %{ $RT::ACE::RIGHTS{$class} || {} }; + return \%rights; } 1; diff --git a/rt/lib/RT/Record/Role/Roles.pm b/rt/lib/RT/Record/Role/Roles.pm new file mode 100644 index 0000000..725c0d7 --- /dev/null +++ b/rt/lib/RT/Record/Role/Roles.pm @@ -0,0 +1,633 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Record::Role::Roles; +use Role::Basic; +use Scalar::Util qw(blessed); + +=head1 NAME + +RT::Record::Role::Roles - Common methods for records which "watchers" or "roles" + +=head1 REQUIRES + +=head2 L<RT::Record::Role> + +=cut + +with 'RT::Record::Role'; + +require RT::System; +require RT::Principal; +require RT::Group; +require RT::User; + +require RT::EmailParser; + +=head1 PROVIDES + +=head2 RegisterRole + +Registers an RT role which applies to this class for role-based access control. +Arguments: + +=over 4 + +=item Name + +Required. The role name (i.e. Requestor, Owner, AdminCc, etc). + +=item EquivClasses + +Optional. Array ref of classes through which this role percolates up to +L<RT::System>. You can think of this list as: + + map { ref } $record_object->ACLEquivalenceObjects; + +You should not include L<RT::System> itself in this list. + +Simply calls RegisterRole on each equivalent class. + +=item Single + +Optional. A true value indicates that this role may only contain a single user +as a member at any given time. When adding a new member to a Single role, any +existing member will be removed. If all members are removed, L<RT/Nobody> is +added automatically. + +=item Column + +Optional, implies Single. Specifies a column on the announcing class into +which the single role member's user ID is denormalized. The column will be +kept updated automatically as the role member changes. This is used, for +example, for ticket owners and makes searching simpler (among other benefits). + +=item ACLOnly + +Optional. A true value indicates this role is only used for ACLs and should +not be populated with members. + +This flag is advisory only, and the Perl API still allows members to be added +to ACLOnly roles. + +=item ACLOnlyInEquiv + +Optional. Automatically sets the ACLOnly flag for all EquivClasses, but not +the announcing class. + +=item SortOrder + +Optional. A numeric value indicating the position of this role when sorted +ascending with other roles in a list. Roles with the same sort order are +ordered alphabetically by name within themselves. + +=back + +=cut + +sub RegisterRole { + my $self = shift; + my $class = ref($self) || $self; + my %role = ( + Name => undef, + EquivClasses => [], + SortOrder => 0, + @_ + ); + return unless $role{Name}; + + # Keep track of the class this role came from originally + $role{ Class } ||= $class; + + # Some groups are limited to a single user + $role{ Single } = 1 if $role{Column}; + + # Stash the role on ourself + $class->_ROLES->{ $role{Name} } = { %role }; + + # Register it with any equivalent classes... + my $equiv = delete $role{EquivClasses} || []; + + # ... and globally unless we ARE global + unless ($class eq "RT::System") { + push @$equiv, "RT::System"; + } + + # ... marked as "for ACLs only" if flagged as such by the announcing class + $role{ACLOnly} = 1 if delete $role{ACLOnlyInEquiv}; + + $_->RegisterRole(%role) for @$equiv; + + # XXX TODO: Register which classes have roles on them somewhere? + + return 1; +} + +=head2 UnregisterRole + +Removes an RT role which applies to this class for role-based access control. +Any roles on equivalent classes (via EquivClasses passed to L</RegisterRole>) +are also unregistered. + +Takes a role name as the sole argument. + +B<Use this carefully:> Objects created after a role is unregistered will not +have an associated L<RT::Group> for the removed role. If you later decide to +stop unregistering the role, operations on those objects created in the +meantime will fail when trying to interact with the missing role groups. + +B<Unregistering a role may break code which assumes the role exists.> + +=cut + +sub UnregisterRole { + my $self = shift; + my $class = ref($self) || $self; + my $name = shift + or return; + + my $role = delete $self->_ROLES->{$name} + or return; + + $_->UnregisterRole($name) + for "RT::System", reverse @{$role->{EquivClasses}}; +} + +=head2 Role + +Takes a role name; returns a hashref describing the role. This hashref +contains the same attributes used to register the role (see L</RegisterRole>), +as well as some extras, including: + +=over + +=item Class + +The original class which announced the role. This is set automatically by +L</RegisterRole> and is the same across all EquivClasses. + +=back + +Returns an empty hashref if the role doesn't exist. + +=cut + +sub Role { + return \%{ $_[0]->_ROLES->{$_[1]} || {} }; +} + +=head2 Roles + +Returns a list of role names registered for this class, sorted ascending by +SortOrder and then alphabetically by name. + +Optionally takes a hash specifying attributes the returned roles must possess +or lack. Testing is done on a simple truthy basis and the actual values of +the role attributes and arguments you pass are not compared string-wise or +numerically; they must simply evaluate to the same truthiness. + +For example: + + # Return role names which are not only for ACL purposes + $object->Roles( ACLOnly => 0 ); + + # Return role names which are denormalized into a column; note that the + # role's Column attribute contains a string. + $object->Roles( Column => 1 ); + +=cut + +sub Roles { + my $self = shift; + my %attr = @_; + + return map { $_->[0] } + sort { $a->[1]{SortOrder} <=> $b->[1]{SortOrder} + or $a->[0] cmp $b->[0] } + grep { + my $ok = 1; + for my $k (keys %attr) { + $ok = 0, last if $attr{$k} xor $_->[1]{$k}; + } + $ok } + map { [ $_, $self->Role($_) ] } + keys %{ $self->_ROLES }; +} + +{ + my %ROLES; + sub _ROLES { + my $class = ref($_[0]) || $_[0]; + return $ROLES{$class} ||= {}; + } +} + +=head2 HasRole + +Returns true if the name provided is a registered role for this class. +Otherwise returns false. + +=cut + +sub HasRole { + my $self = shift; + my $type = shift; + return scalar grep { $type eq $_ } $self->Roles; +} + +=head2 RoleGroup + +Expects a role name as the first parameter which is used to load the +L<RT::Group> for the specified role on this record. Returns an unloaded +L<RT::Group> object on failure. + +=cut + +sub RoleGroup { + my $self = shift; + my $name = shift; + my $group = RT::Group->new( $self->CurrentUser ); + + if ($self->HasRole($name)) { + $group->LoadRoleGroup( + Object => $self, + Name => $name, + ); + } + return $group; +} + +=head2 AddRoleMember + +Adds the described L<RT::Principal> to the specified role group for this record. + +Takes a set of key-value pairs: + +=over 4 + +=item PrincipalId + +Optional. The ID of the L<RT::Principal> object to add. + +=item User + +Optional. The Name or EmailAddress of an L<RT::User> to use as the +principal. If an email address is given, but a user matching it cannot +be found, a new user will be created. + +=item Group + +Optional. The Name of an L<RT::Group> to use as the principal. + +=item Type + +Required. One of the valid roles for this record, as returned by L</Roles>. + +=item ACL + +Optional. A subroutine reference which will be passed the role type and +principal being added. If it returns false, the method will fail with a +status of "Permission denied". + +=back + +One, and only one, of I<PrincipalId>, I<User>, or I<Group> is required. + +Returns a tuple of (principal object which was added, message). + +=cut + +sub AddRoleMember { + my $self = shift; + my %args = (@_); + + return (0, $self->loc("One, and only one, of PrincipalId/User/Group is required")) + if 1 != grep { $_ } @args{qw/PrincipalId User Group/}; + + my $type = delete $args{Type}; + return (0, $self->loc("No valid Type specified")) + unless $type and $self->HasRole($type); + + if ($args{PrincipalId}) { + # Check the PrincipalId for loops + my $principal = RT::Principal->new( $self->CurrentUser ); + $principal->Load($args{'PrincipalId'}); + if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) { + return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", + $email, $self->loc($type))) + if RT::EmailParser->IsRTAddress( $email ); + } + } else { + if ($args{User}) { + my $name = delete $args{User}; + # Sanity check the address + return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", + $name, $self->loc($type) )) + if RT::EmailParser->IsRTAddress( $name ); + + # Create as the SystemUser, not the current user + my $user = RT::User->new(RT->SystemUser); + my ($ok, $msg); + if ($name =~ /@/) { + ($ok, $msg) = $user->LoadOrCreateByEmail( $name ); + } else { + ($ok, $msg) = $user->Load( $name ); + } + unless ($user->Id) { + # If we can't find this watcher, we need to bail. + $RT::Logger->error("Could not load or create a user '$name' to add as a watcher: $msg"); + return (0, $self->loc("Could not find or create user '[_1]'", $name)); + } + $args{PrincipalId} = $user->PrincipalId; + } + elsif ($args{Group}) { + my $name = delete $args{Group}; + my $group = RT::Group->new( $self->CurrentUser ); + $group->LoadUserDefinedGroup($name); + unless ($group->id) { + $RT::Logger->error("Could not load group '$name' to add as a watcher"); + return (0, $self->loc("Could not find group '[_1]'", $name)); + } + $args{PrincipalId} = $group->PrincipalObj->id; + } + } + + my $principal = RT::Principal->new( $self->CurrentUser ); + $principal->Load( $args{PrincipalId} ); + + my $acl = delete $args{ACL}; + return (0, $self->loc("Permission denied")) + if $acl and not $acl->($type => $principal); + + my $group = $self->RoleGroup( $type ); + return (0, $self->loc("Role group '[_1]' not found", $type)) + unless $group->id; + + return (0, $self->loc('[_1] is already a [_2]', + $principal->Object->Name, $self->loc($type)) ) + if $group->HasMember( $principal ); + + return (0, $self->loc('[_1] cannot be a group', $self->loc($type)) ) + if $group->SingleMemberRoleGroup and $principal->IsGroup; + + my ( $ok, $msg ) = $group->_AddMember( %args, RecordTransaction => !$args{Silent} ); + unless ($ok) { + $RT::Logger->error("Failed to add $args{PrincipalId} as a member of group ".$group->Id.": ".$msg); + + return ( 0, $self->loc('Could not make [_1] a [_2]', + $principal->Object->Name, $self->loc($type)) ); + } + + return ($principal, $msg); +} + +=head2 DeleteRoleMember + +Removes the specified L<RT::Principal> from the specified role group for this +record. + +Takes a set of key-value pairs: + +=over 4 + +=item PrincipalId + +Optional. The ID of the L<RT::Principal> object to remove. + +=item User + +Optional. The Name or EmailAddress of an L<RT::User> to use as the +principal + +=item Type + +Required. One of the valid roles for this record, as returned by L</Roles>. + +=item ACL + +Optional. A subroutine reference which will be passed the role type and +principal being removed. If it returns false, the method will fail with a +status of "Permission denied". + +=back + +One, and only one, of I<PrincipalId> or I<User> is required. + +Returns a tuple of (principal object that was removed, message). + +=cut + +sub DeleteRoleMember { + my $self = shift; + my %args = (@_); + + return (0, $self->loc("No valid Type specified")) + unless $args{Type} and $self->HasRole($args{Type}); + + if ($args{User}) { + my $user = RT::User->new( $self->CurrentUser ); + $user->LoadByEmail( $args{User} ); + $user->Load( $args{User} ) unless $user->id; + return (0, $self->loc("Could not load user '[_1]'", $args{User}) ) + unless $user->id; + $args{PrincipalId} = $user->PrincipalId; + } + + return (0, $self->loc("No valid PrincipalId")) + unless $args{PrincipalId}; + + my $principal = RT::Principal->new( $self->CurrentUser ); + $principal->Load( $args{PrincipalId} ); + + my $acl = delete $args{ACL}; + return (0, $self->loc("Permission denied")) + if $acl and not $acl->($args{Type} => $principal); + + my $group = $self->RoleGroup( $args{Type} ); + return (0, $self->loc("Role group '[_1]' not found", $args{Type})) + unless $group->id; + + return ( 0, $self->loc( '[_1] is not a [_2]', + $principal->Object->Name, $self->loc($args{Type}) ) ) + unless $group->HasMember($principal); + + my ($ok, $msg) = $group->_DeleteMember($args{PrincipalId}, RecordTransaction => !$args{Silent}); + unless ($ok) { + $RT::Logger->error("Failed to remove $args{PrincipalId} as a member of group ".$group->Id.": ".$msg); + + return ( 0, $self->loc('Could not remove [_1] as a [_2]', + $principal->Object->Name, $self->loc($args{Type})) ); + } + + return ($principal, $msg); +} + +sub _ResolveRoles { + my $self = shift; + my ($roles, %args) = (@_); + + my @errors; + for my $role ($self->Roles) { + if ($self->_ROLES->{$role}{Single}) { + # Default to nobody if unspecified + my $value = $args{$role} || RT->Nobody; + $value = $value->[0] if ref $value eq 'ARRAY'; + if (Scalar::Util::blessed($value) and $value->isa("RT::User")) { + # Accept a user; it may not be loaded, which we catch below + $roles->{$role} = $value->PrincipalObj; + } else { + # Try loading by id, name, then email. If all fail, catch that below + my $user = RT::User->new( $self->CurrentUser ); + $user->Load( $value ); + # XXX: LoadOrCreateByEmail ? + $user->LoadByEmail( $value ) unless $user->id; + $roles->{$role} = $user->PrincipalObj; + } + unless (Scalar::Util::blessed($roles->{$role}) and $roles->{$role}->id) { + push @errors, $self->loc("Invalid value for [_1]",$self->loc($role)); + $roles->{$role} = RT->Nobody->PrincipalObj; + } + # For consistency, we always return an arrayref + $roles->{$role} = [ $roles->{$role} ]; + } else { + $roles->{$role} = []; + my @values = ref $args{ $role } ? @{ $args{$role} } : ($args{$role}); + for my $value (grep {defined} @values) { + if ( $value =~ /^\d+$/ ) { + # This implicitly allows groups, if passed by id. + my $principal = RT::Principal->new( $self->CurrentUser ); + my ($ok, $msg) = $principal->Load( $value ); + if ($ok) { + push @{ $roles->{$role} }, $principal; + } else { + push @errors, + $self->loc("Couldn't load principal: [_1]", $msg); + } + } else { + my @addresses = RT::EmailParser->ParseEmailAddress( $value ); + for my $address ( @addresses ) { + my $user = RT::User->new( RT->SystemUser ); + my ($id, $msg) = $user->LoadOrCreateByEmail( $address ); + if ( $id ) { + # Load it back as us, not as the system + # user, to be completely safe. + $user = RT::User->new( $self->CurrentUser ); + $user->Load( $id ); + push @{ $roles->{$role} }, $user->PrincipalObj; + } else { + push @errors, + $self->loc("Couldn't load or create user: [_1]", $msg); + } + } + } + } + } + } + return (@errors); +} + +sub _CreateRoleGroups { + my $self = shift; + my %args = (@_); + for my $name ($self->Roles) { + my $type_obj = RT::Group->new($self->CurrentUser); + my ($id, $msg) = $type_obj->CreateRoleGroup( + Name => $name, + Object => $self, + %args, + ); + unless ($id) { + $RT::Logger->error("Couldn't create a role group of type '$name' for ".ref($self)." ". + $self->id.": ".$msg); + return(undef); + } + } + return(1); +} + +sub _AddRolesOnCreate { + my $self = shift; + my ($roles, %acls) = @_; + + my @errors; + { + my $changed = 0; + + for my $role (keys %{$roles}) { + my $group = $self->RoleGroup($role); + my @left; + for my $principal (@{$roles->{$role}}) { + if ($acls{$role}->($principal)) { + next if $group->HasMember($principal); + my ($ok, $msg) = $group->_AddMember( + PrincipalId => $principal->id, + InsideTransaction => 1, + RecordTransaction => 0, + Object => $self, + ); + push @errors, $self->loc("Couldn't set [_1] watcher: [_2]", $role, $msg) + unless $ok; + $changed++; + } else { + push @left, $principal; + } + } + $roles->{$role} = [ @left ]; + } + + redo if $changed; + } + + return @errors; +} + + +1; diff --git a/rt/lib/RT/Record/Role/Status.pm b/rt/lib/RT/Record/Role/Status.pm new file mode 100644 index 0000000..98f699c --- /dev/null +++ b/rt/lib/RT/Record/Role/Status.pm @@ -0,0 +1,314 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Record::Role::Status; +use Role::Basic; +use Scalar::Util qw(blessed); + +=head1 NAME + +RT::Record::Role::Status - Common methods for records which have a Status column + +=head1 DESCRIPTION + +Lifecycles are generally set on container records, and Statuses on records +which belong to one of those containers. L<RT::Record::Role::Lifecycle> +handles the containers with the I<Lifecycle> column. This role is for the +records with a I<Status> column within those containers. It includes +convenience methods for grabbing an L<RT::Lifecycle> object as well setters for +validating I<Status> and the column which points to the container object. + +=head1 REQUIRES + +=head2 L<RT::Record::Role> + +=head2 LifecycleColumn + +Used as a role parameter. Must return a string of the column name which points +to the container object that consumes L<RT::Record::Role::Lifecycle> (or +conforms to it). The resulting string is used to construct two method names: +as-is to fetch the column value and suffixed with "Obj" to fetch the object. + +=head2 Status + +A Status method which returns a lifecycle name is required. Currently +unenforced at compile-time due to poor interactions with +L<DBIx::SearchBuilder::Record/AUTOLOAD>. You'll hit run-time errors if this +method isn't available in consuming classes, however. + +=cut + +with 'RT::Record::Role'; +requires 'LifecycleColumn'; + +=head1 PROVIDES + +=head2 Status + +Returns the Status for this record, in the canonical casing. + +=cut + +sub Status { + my $self = shift; + my $value = $self->_Value( 'Status' ); + my $lifecycle = $self->LifecycleObj; + return $value unless $lifecycle; + return $lifecycle->CanonicalCase( $value ); +} + +=head2 LifecycleObj + +Returns an L<RT::Lifecycle> object for this record's C<Lifecycle>. If called +as a class method, returns an L<RT::Lifecycle> object which is an aggregation +of all lifecycles of the appropriate type. + +=cut + +sub LifecycleObj { + my $self = shift; + my $obj = $self->LifecycleColumn . "Obj"; + return $self->$obj->LifecycleObj; +} + +=head2 Lifecycle + +Returns the L<RT::Lifecycle/Name> of this record's L</LifecycleObj>. + +=cut + +sub Lifecycle { + my $self = shift; + return $self->LifecycleObj->Name; +} + +=head2 ValidateStatus + +Takes a status. Returns true if that status is a valid status for this record, +otherwise returns false. + +=cut + +sub ValidateStatus { + my $self = shift; + return $self->LifecycleObj->IsValid(@_); +} + +=head2 ValidateStatusChange + +Validates the new status with the current lifecycle. Returns a tuple of (OK, +message). + +Expected to be called from this role's L</SetStatus> or the consuming class' +equivalent. + +=cut + +sub ValidateStatusChange { + my $self = shift; + my $new = shift; + my $old = $self->Status; + + my $lifecycle = $self->LifecycleObj; + + unless ( $lifecycle->IsValid( $new ) ) { + return (0, $self->loc("Status '[_1]' isn't a valid status for this [_2].", $self->loc($new), $self->loc($lifecycle->Type))); + } + + unless ( $lifecycle->IsTransition( $old => $new ) ) { + return (0, $self->loc("You can't change status from '[_1]' to '[_2]'.", $self->loc($old), $self->loc($new))); + } + + my $check_right = $lifecycle->CheckRight( $old => $new ); + unless ( $self->CurrentUser->HasRight( Right => $check_right, Object => $self ) ) { + return ( 0, $self->loc('Permission Denied') ); + } + + return 1; +} + +=head2 SetStatus + +Validates the status transition before updating the Status column. This method +may want to be overridden by a more specific method in the consuming class. + +=cut + +sub SetStatus { + my $self = shift; + my $new = shift; + + my ($valid, $error) = $self->ValidateStatusChange($new); + return ($valid, $error) unless $valid; + + return $self->_SetStatus( Status => $new ); +} + +=head2 _SetStatus + +Sets the Status column without validating the change. Intended to be used +as-is by methods provided by the role, or overridden in the consuming class to +take additional action. For example, L<RT::Ticket/_SetStatus> sets the Started +and Resolved dates on the ticket as necessary. + +Takes a paramhash where the only required key is Status. Other keys may +include Lifecycle and NewLifecycle when called from L</_SetLifecycleColumn>, +which may assist consuming classes. NewLifecycle defaults to Lifecycle if not +provided; this indicates the lifecycle isn't changing. + +=cut + +sub _SetStatus { + my $self = shift; + my %args = ( + Status => undef, + Lifecycle => $self->LifecycleObj, + @_, + ); + $args{Status} = lc $args{Status} if defined $args{Status}; + $args{NewLifecycle} ||= $args{Lifecycle}; + + return $self->_Set( + Field => 'Status', + Value => $args{Status}, + ); +} + +=head2 _SetLifecycleColumn + +Validates and updates the column named by L</LifecycleColumn>. The Status +column is also updated if necessary (via lifecycle transition maps). + +On success, returns a tuple of (1, I<message>, I<new status>) where I<new +status> is the status that was transitioned to, if any. On failure, returns +(0, I<error message>). + +Takes a paramhash with keys I<Value> and (optionally) I<RequireRight>. +I<RequireRight> is a right name which the current user must have on the new +L</LifecycleColumn> object in order for the method to succeed. + +This method is expected to be used from within another method such as +L<RT::Ticket/SetQueue>. + +=cut + +sub _SetLifecycleColumn { + my $self = shift; + my %args = @_; + + my $column = $self->LifecycleColumn; + my $column_obj = "${column}Obj"; + + my $current = $self->$column_obj; + my $class = blessed($current); + + my $new = $class->new( $self->CurrentUser ); + $new->Load($args{Value}); + + return (0, $self->loc("[_1] [_2] does not exist", $self->loc($column), $args{Value})) + unless $new->id; + + my $name = eval { $current->Name } || $current->id; + + return (0, $self->loc("[_1] [_2] is disabled", $self->loc($column), $name)) + if $new->Disabled; + + return (0, $self->loc("[_1] is already set to [_2]", $self->loc($column), $name)) + if $new->id == $current->id; + + return (0, $self->loc("Permission Denied")) + if $args{RequireRight} and not $self->CurrentUser->HasRight( + Right => $args{RequireRight}, + Object => $new, + ); + + my $new_status; + my $old_lifecycle = $current->LifecycleObj; + my $new_lifecycle = $new->LifecycleObj; + if ( $old_lifecycle->Name ne $new_lifecycle->Name ) { + unless ( $old_lifecycle->HasMoveMap( $new_lifecycle ) ) { + return ( 0, $self->loc("There is no mapping for statuses between lifecycle [_1] and [_2]. Contact your system administrator.", $old_lifecycle->Name, $new_lifecycle->Name) ); + } + $new_status = $old_lifecycle->MoveMap( $new_lifecycle )->{ lc $self->Status }; + return ( 0, $self->loc("Mapping between lifecycle [_1] and [_2] is incomplete. Contact your system administrator.", $old_lifecycle->Name, $new_lifecycle->Name) ) + unless $new_status; + } + + my ($ok, $msg) = $self->_Set( Field => $column, Value => $new->id ); + if ($ok) { + if ( $new_status and $new_status ne $self->Status ) { + my $as_system = blessed($self)->new( RT->SystemUser ); + $as_system->Load( $self->Id ); + unless ( $as_system->Id ) { + return ( 0, $self->loc("Couldn't load copy of [_1] #[_2]", blessed($self), $self->Id) ); + } + + my ($val, $msg) = $as_system->_SetStatus( + Lifecycle => $old_lifecycle, + NewLifecycle => $new_lifecycle, + Status => $new_status, + ); + + if ($val) { + # Pick up the change made by the clone above + $self->Load( $self->id ); + } else { + RT->Logger->error("Status change to $new_status failed on $column change: $msg"); + undef $new_status; + } + } + return (1, $msg, $new_status); + } else { + return (0, $msg); + } +} + +1; diff --git a/rt/lib/RT/Reminders.pm b/rt/lib/RT/Reminders.pm index fcd7c26..e3e533a 100644 --- a/rt/lib/RT/Reminders.pm +++ b/rt/lib/RT/Reminders.pm @@ -90,8 +90,8 @@ sub Collection { $col->FromSQL($query); - $col->OrderBy( FIELD => 'Due' ); - + $col->OrderByCols( { FIELD => 'Due' }, { FIELD => 'id' } ); + return($col); } @@ -126,15 +126,26 @@ sub Add { return ( 0, $self->loc("Can't link to a deleted ticket") ); } + return ( 0, $self->loc('Permission Denied') ) + unless $self->CurrentUser->HasRight( + Right => 'CreateTicket', + Object => $self->TicketObj->QueueObj, + ) + && $self->CurrentUser->HasRight( + Right => 'ModifyTicket', + Object => $self->TicketObj, + ); + my $reminder = RT::Ticket->new($self->CurrentUser); - my ( $status, $msg ) = $reminder->Create( + # the 2nd return value is txn id, which is useless here + my ( $status, undef, $msg ) = $reminder->Create( Subject => $args{'Subject'}, Owner => $args{'Owner'}, Due => $args{'Due'}, RefersTo => $self->Ticket, Type => 'reminder', Queue => $self->TicketObj->Queue, - Status => $self->TicketObj->QueueObj->Lifecycle->ReminderStatusOnOpen, + Status => $self->TicketObj->QueueObj->LifecycleObj->ReminderStatusOnOpen, ); $self->TicketObj->_NewTransaction( Type => 'AddReminder', @@ -149,7 +160,7 @@ sub Open { my $reminder = shift; my ( $status, $msg ) = - $reminder->SetStatus( $reminder->QueueObj->Lifecycle->ReminderStatusOnOpen ); + $reminder->SetStatus( $reminder->LifecycleObj->ReminderStatusOnOpen ); $self->TicketObj->_NewTransaction( Type => 'OpenReminder', Field => 'RT::Ticket', @@ -162,7 +173,7 @@ sub Resolve { my $self = shift; my $reminder = shift; my ( $status, $msg ) = - $reminder->SetStatus( $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve ); + $reminder->SetStatus( $reminder->LifecycleObj->ReminderStatusOnResolve ); $self->TicketObj->_NewTransaction( Type => 'ResolveReminder', Field => 'RT::Ticket', diff --git a/rt/lib/RT/Report/Tickets.pm b/rt/lib/RT/Report/Tickets.pm index f977673..19bca18 100644 --- a/rt/lib/RT/Report/Tickets.pm +++ b/rt/lib/RT/Report/Tickets.pm @@ -54,109 +54,533 @@ use RT::Report::Tickets::Entry; use strict; use warnings; +use Scalar::Util qw(weaken); + +our @GROUPINGS = ( + Status => 'Enum', #loc_left_pair + + Queue => 'Queue', #loc_left_pair + + InitialPriority => 'Priority', #loc_left_pair + FinalPriority => 'Priority', #loc_left_pair + Priority => 'Priority', #loc_left_pair + + Owner => 'User', #loc_left_pair + Creator => 'User', #loc_left_pair + LastUpdatedBy => 'User', #loc_left_pair + + Requestor => 'Watcher', #loc_left_pair + Cc => 'Watcher', #loc_left_pair + AdminCc => 'Watcher', #loc_left_pair + Watcher => 'Watcher', #loc_left_pair + + Created => 'Date', #loc_left_pair + Starts => 'Date', #loc_left_pair + Started => 'Date', #loc_left_pair + Resolved => 'Date', #loc_left_pair + Due => 'Date', #loc_left_pair + Told => 'Date', #loc_left_pair + LastUpdated => 'Date', #loc_left_pair + + CF => 'CustomField', #loc_left_pair +); +our %GROUPINGS; + +our %GROUPINGS_META = ( + Queue => { + Display => sub { + my $self = shift; + my %args = (@_); + + my $queue = RT::Queue->new( $self->CurrentUser ); + $queue->Load( $args{'VALUE'} ); + return $queue->Name; + }, + Localize => 1, + }, + Priority => { + Sort => 'numeric raw', + }, + User => { + SubFields => [grep RT::User->_Accessible($_, "public"), qw( + Name RealName NickName + EmailAddress + Organization + Lang City Country Timezone + )], + Function => 'GenerateUserFunction', + }, + Watcher => { + SubFields => [grep RT::User->_Accessible($_, "public"), qw( + Name RealName NickName + EmailAddress + Organization + Lang City Country Timezone + )], + Function => 'GenerateWatcherFunction', + }, + Date => { + SubFields => [qw( + Time + Hourly Hour + Date Daily + DayOfWeek Day DayOfMonth DayOfYear + Month Monthly + Year Annually + WeekOfYear + )], # loc_qw + Function => 'GenerateDateFunction', + Display => sub { + my $self = shift; + my %args = (@_); + + my $raw = $args{'VALUE'}; + return $raw unless defined $raw; + + if ( $args{'SUBKEY'} eq 'DayOfWeek' ) { + return $self->loc($RT::Date::DAYS_OF_WEEK[ int $raw ]); + } + elsif ( $args{'SUBKEY'} eq 'Month' ) { + return $self->loc($RT::Date::MONTHS[ int($raw) - 1 ]); + } + return $raw; + }, + Sort => 'raw', + }, + CustomField => { + SubFields => sub { + my $self = shift; + my $args = shift; + + + my $queues = $args->{'Queues'}; + if ( !$queues && $args->{'Query'} ) { + require RT::Interface::Web::QueryBuilder::Tree; + my $tree = RT::Interface::Web::QueryBuilder::Tree->new('AND'); + $tree->ParseSQL( Query => $args->{'Query'}, CurrentUser => $self->CurrentUser ); + $queues = $args->{'Queues'} = $tree->GetReferencedQueues; + } + return () unless $queues; + + my @res; + + my $CustomFields = RT::CustomFields->new( $self->CurrentUser ); + foreach my $id (keys %$queues) { + my $queue = RT::Queue->new( $self->CurrentUser ); + $queue->Load($id); + next unless $queue->id; + + $CustomFields->LimitToQueue($queue->id); + } + $CustomFields->LimitToGlobal; + while ( my $CustomField = $CustomFields->Next ) { + push @res, ["Custom field", $CustomField->Name], "CF.{". $CustomField->id ."}"; + } + return @res; + }, + Function => 'GenerateCustomFieldFunction', + Label => sub { + my $self = shift; + my %args = (@_); + + my ($cf) = ( $args{'SUBKEY'} =~ /^\{(.*)\}$/ ); + if ( $cf =~ /^\d+$/ ) { + my $obj = RT::CustomField->new( $self->CurrentUser ); + $obj->Load( $cf ); + $cf = $obj->Name; + } + + return 'Custom field [_1]', $cf; + }, + }, + Enum => { + Localize => 1, + }, +); + +# loc'able strings below generated with (s/loq/loc/): +# perl -MRT=-init -MRT::Report::Tickets -E 'say qq{\# loq("$_->[0]")} while $_ = splice @RT::Report::Tickets::STATISTICS, 0, 2' +# +# loc("Ticket count") +# loc("Summary of time worked") +# loc("Total time worked") +# loc("Average time worked") +# loc("Minimum time worked") +# loc("Maximum time worked") +# loc("Summary of time estimated") +# loc("Total time estimated") +# loc("Average time estimated") +# loc("Minimum time estimated") +# loc("Maximum time estimated") +# loc("Summary of time left") +# loc("Total time left") +# loc("Average time left") +# loc("Minimum time left") +# loc("Maximum time left") +# loc("Summary of Created-Started") +# loc("Total Created-Started") +# loc("Average Created-Started") +# loc("Minimum Created-Started") +# loc("Maximum Created-Started") +# loc("Summary of Created-Resolved") +# loc("Total Created-Resolved") +# loc("Average Created-Resolved") +# loc("Minimum Created-Resolved") +# loc("Maximum Created-Resolved") +# loc("Summary of Created-LastUpdated") +# loc("Total Created-LastUpdated") +# loc("Average Created-LastUpdated") +# loc("Minimum Created-LastUpdated") +# loc("Maximum Created-LastUpdated") +# loc("Summary of Starts-Started") +# loc("Total Starts-Started") +# loc("Average Starts-Started") +# loc("Minimum Starts-Started") +# loc("Maximum Starts-Started") +# loc("Summary of Due-Resolved") +# loc("Total Due-Resolved") +# loc("Average Due-Resolved") +# loc("Minimum Due-Resolved") +# loc("Maximum Due-Resolved") +# loc("Summary of Started-Resolved") +# loc("Total Started-Resolved") +# loc("Average Started-Resolved") +# loc("Minimum Started-Resolved") +# loc("Maximum Started-Resolved") + +our @STATISTICS = ( + COUNT => ['Ticket count', 'Count', 'id'], +); + +foreach my $field (qw(TimeWorked TimeEstimated TimeLeft)) { + my $friendly = lc join ' ', split /(?<=[a-z])(?=[A-Z])/, $field; + push @STATISTICS, ( + "ALL($field)" => ["Summary of $friendly", 'TimeAll', $field ], + "SUM($field)" => ["Total $friendly", 'Time', 'SUM', $field ], + "AVG($field)" => ["Average $friendly", 'Time', 'AVG', $field ], + "MIN($field)" => ["Minimum $friendly", 'Time', 'MIN', $field ], + "MAX($field)" => ["Maximum $friendly", 'Time', 'MAX', $field ], + ); +} + + +foreach my $pair (qw( + Created-Started + Created-Resolved + Created-LastUpdated + Starts-Started + Due-Resolved + Started-Resolved +)) { + my ($from, $to) = split /-/, $pair; + push @STATISTICS, ( + "ALL($pair)" => ["Summary of $pair", 'DateTimeIntervalAll', $from, $to ], + "SUM($pair)" => ["Total $pair", 'DateTimeInterval', 'SUM', $from, $to ], + "AVG($pair)" => ["Average $pair", 'DateTimeInterval', 'AVG', $from, $to ], + "MIN($pair)" => ["Minimum $pair", 'DateTimeInterval', 'MIN', $from, $to ], + "MAX($pair)" => ["Maximum $pair", 'DateTimeInterval', 'MAX', $from, $to ], + ); +} + +our %STATISTICS; + +our %STATISTICS_META = ( + Count => { + Function => sub { + my $self = shift; + my $field = shift || 'id'; + + return ( + FUNCTION => 'COUNT', + FIELD => 'id' + ); + }, + }, + Simple => { + Function => sub { + my $self = shift; + my ($function, $field) = @_; + return (FUNCTION => $function, FIELD => $field); + }, + }, + Time => { + Function => sub { + my $self = shift; + my ($function, $field) = @_; + return (FUNCTION => "$function(?)*60", FIELD => $field); + }, + Display => 'DurationAsString', + }, + TimeAll => { + SubValues => sub { return ('Minimum', 'Average', 'Maximum', 'Total') }, + Function => sub { + my $self = shift; + my $field = shift; + return ( + Minimum => { FUNCTION => "MIN(?)*60", FIELD => $field }, + Average => { FUNCTION => "AVG(?)*60", FIELD => $field }, + Maximum => { FUNCTION => "MAX(?)*60", FIELD => $field }, + Total => { FUNCTION => "SUM(?)*60", FIELD => $field }, + ); + }, + Display => 'DurationAsString', + }, + DateTimeInterval => { + Function => sub { + my $self = shift; + my ($function, $from, $to) = @_; + + my $interval = $self->_Handle->DateTimeIntervalFunction( + From => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $from ) }, + To => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $to ) }, + ); + + return (FUNCTION => "$function($interval)"); + }, + Display => 'DurationAsString', + }, + DateTimeIntervalAll => { + SubValues => sub { return ('Minimum', 'Average', 'Maximum', 'Total') }, + Function => sub { + my $self = shift; + my ($from, $to) = @_; + + my $interval = $self->_Handle->DateTimeIntervalFunction( + From => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $from ) }, + To => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $to ) }, + ); + + return ( + Minimum => { FUNCTION => "MIN($interval)" }, + Average => { FUNCTION => "AVG($interval)" }, + Maximum => { FUNCTION => "MAX($interval)" }, + Total => { FUNCTION => "SUM($interval)" }, + ); + }, + Display => 'DurationAsString', + }, +); + sub Groupings { my $self = shift; my %args = (@_); - my @fields = - map { $self->CurrentUser->loc($_), $_ } qw( Status Queue ); # loc_qw - - foreach my $type ( qw(Owner Creator LastUpdatedBy Requestor Cc AdminCc Watcher) ) { # loc_qw - for my $field ( - qw( Name EmailAddress RealName NickName Organization Lang City Country Timezone ) # loc_qw - ) - { - push @fields, - $self->CurrentUser->loc($type) . ' ' - . $self->CurrentUser->loc($field), $type . '.' . $field; - } - } + my @fields; - for my $field (qw(Due Resolved Created LastUpdated Started Starts Told)) { # loc_qw - for my $frequency (qw(Hourly Daily Monthly Annually)) { # loc_qw - push @fields, - $self->CurrentUser->loc($field) - . $self->CurrentUser->loc($frequency), - $field . $frequency; + my @tmp = @GROUPINGS; + while ( my ($field, $type) = splice @tmp, 0, 2 ) { + my $meta = $GROUPINGS_META{ $type } || {}; + unless ( $meta->{'SubFields'} ) { + push @fields, [$field, $field], $field; } - } - - my $queues = $args{'Queues'}; - if ( !$queues && $args{'Query'} ) { - require RT::Interface::Web::QueryBuilder::Tree; - my $tree = RT::Interface::Web::QueryBuilder::Tree->new('AND'); - $tree->ParseSQL( Query => $args{'Query'}, CurrentUser => $self->CurrentUser ); - $queues = $tree->GetReferencedQueues; - } - - if ( $queues ) { - my $CustomFields = RT::CustomFields->new( $self->CurrentUser ); - foreach my $id (keys %$queues) { - my $queue = RT::Queue->new( $self->CurrentUser ); - $queue->Load($id); - $CustomFields->LimitToQueue($queue->Id) if $queue->Id; + elsif ( ref( $meta->{'SubFields'} ) eq 'ARRAY' ) { + push @fields, map { ([$field, $_], "$field.$_") } @{ $meta->{'SubFields'} }; } - $CustomFields->LimitToGlobal; - while ( my $CustomField = $CustomFields->Next ) { - push @fields, $self->CurrentUser->loc( - "Custom field '[_1]'", - $CustomField->Name - ), - "CF.{" . $CustomField->id . "}"; + elsif ( my $code = $self->FindImplementationCode( $meta->{'SubFields'} ) ) { + push @fields, $code->( $self, \%args ); + } + else { + $RT::Logger->error( + "$type has unsupported SubFields." + ." Not an array, a method name or a code reference" + ); } } return @fields; } -sub Label { +sub IsValidGrouping { + my $self = shift; + my %args = (@_); + return 0 unless $args{'GroupBy'}; + + my ($key, $subkey) = split /\./, $args{'GroupBy'}, 2; + + %GROUPINGS = @GROUPINGS unless keys %GROUPINGS; + my $type = $GROUPINGS{$key}; + return 0 unless $type; + return 1 unless $subkey; + + my $meta = $GROUPINGS_META{ $type } || {}; + unless ( $meta->{'SubFields'} ) { + return 0; + } + elsif ( ref( $meta->{'SubFields'} ) eq 'ARRAY' ) { + return 1 if grep $_ eq $subkey, @{ $meta->{'SubFields'} }; + } + elsif ( my $code = $self->FindImplementationCode( $meta->{'SubFields'}, 'silent' ) ) { + return 1 if grep $_ eq "$key.$subkey", $code->( $self, \%args ); + } + return 0; +} + +sub Statistics { my $self = shift; - my $field = shift; - if ( $field =~ /^(?:CF|CustomField)\.\{(.*)\}$/ ) { - my $cf = $1; - return $self->CurrentUser->loc( "Custom field '[_1]'", $cf ) if $cf =~ /\D/; - my $obj = RT::CustomField->new( $self->CurrentUser ); - $obj->Load( $cf ); - return $self->CurrentUser->loc( "Custom field '[_1]'", $obj->Name ); - } - return $self->CurrentUser->loc($field); + return map { ref($_)? $_->[0] : $_ } @STATISTICS; } -sub SetupGroupings { +sub Label { my $self = shift; - my %args = (Query => undef, GroupBy => undef, @_); + my $column = shift; - $self->FromSQL( $args{'Query'} ); - my @group_by = ref( $args{'GroupBy'} )? @{ $args{'GroupBy'} } : ($args{'GroupBy'}); - $self->GroupBy( map { {FIELD => $_} } @group_by ); + my $info = $self->ColumnInfo( $column ); + unless ( $info ) { + $RT::Logger->error("Unknown column '$column'"); + return $self->CurrentUser->loc('(Incorrect data)'); + } - # UseSQLForACLChecks may add late joins - my $joined = ($self->_isJoined || RT->Config->Get('UseSQLForACLChecks')) ? 1 : 0; + if ( $info->{'META'}{'Label'} ) { + my $code = $self->FindImplementationCode( $info->{'META'}{'Label'} ); + return $self->CurrentUser->loc( $code->( $self, %$info ) ) + if $code; + } - my @res; - push @res, $self->Column( FUNCTION => ($joined? 'DISTINCT COUNT' : 'COUNT'), FIELD => 'id' ); - push @res, map $self->Column( FIELD => $_ ), @group_by; - return @res; + my $res = ''; + if ( $info->{'TYPE'} eq 'statistic' ) { + $res = $info->{'INFO'}[0]; + } + else { + $res = join ' ', grep defined && length, @{ $info }{'KEY', 'SUBKEY'}; + } + return $self->CurrentUser->loc( $res ); } -sub GroupBy { +sub ColumnInfo { my $self = shift; - my @args = ref $_[0]? @_ : { @_ }; + my $column = shift; - @{ $self->{'_group_by_field'} ||= [] } = map $_->{'FIELD'}, @args; - $_ = { $self->_FieldToFunction( %$_ ) } foreach @args; + return $self->{'column_info'}{$column}; +} - $self->SUPER::GroupBy( @args ); +sub ColumnsList { + my $self = shift; + return sort { $self->{'column_info'}{$a}{'POSITION'} <=> $self->{'column_info'}{$b}{'POSITION'} } + keys %{ $self->{'column_info'} || {} }; } -sub Column { +sub SetupGroupings { my $self = shift; - my %args = (@_); + my %args = ( + Query => undef, + GroupBy => undef, + Function => undef, + @_ + ); + + $self->FromSQL( $args{'Query'} ) if $args{'Query'}; + + # Apply ACL checks + $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks'); + + # See if our query is distinct + if (not $self->{'joins_are_distinct'} and $self->_isJoined) { + # If it isn't, we need to do this in two stages -- first, find + # the distinct matching tickets (with no group by), then search + # within the matching tickets grouped by what is wanted. + my @match = (0); + $self->Columns( 'id' ); + while (my $row = $self->Next) { + push @match, $row->id; + } + + # Replace the query with one that matches precisely those + # tickets, with no joins. We then mark it as having been ACL'd, + # since it was by dint of being in the search results above + $self->CleanSlate; + while ( @match > 1000 ) { + my @batch = splice( @match, 0, 1000 ); + $self->Limit( FIELD => 'Id', OPERATOR => 'IN', VALUE => \@batch ); + } + $self->Limit( FIELD => 'Id', OPERATOR => 'IN', VALUE => \@match ); + $self->{'_sql_current_user_can_see_applied'} = 1 + } + + + %GROUPINGS = @GROUPINGS unless keys %GROUPINGS; + + my $i = 0; + + my @group_by = grep defined && length, + ref( $args{'GroupBy'} )? @{ $args{'GroupBy'} } : ($args{'GroupBy'}); + @group_by = ('Status') unless @group_by; + + foreach my $e ( splice @group_by ) { + unless ($self->IsValidGrouping( Query => $args{Query}, GroupBy => $e )) { + RT->Logger->error("'$e' is not a valid grouping for reports; skipping"); + next; + } + my ($key, $subkey) = split /\./, $e, 2; + $e = { $self->_FieldToFunction( KEY => $key, SUBKEY => $subkey ) }; + $e->{'TYPE'} = 'grouping'; + $e->{'INFO'} = $GROUPINGS{ $key }; + $e->{'META'} = $GROUPINGS_META{ $e->{'INFO'} }; + $e->{'POSITION'} = $i++; + push @group_by, $e; + } + $self->GroupBy( map { { + ALIAS => $_->{'ALIAS'}, + FIELD => $_->{'FIELD'}, + FUNCTION => $_->{'FUNCTION'}, + } } @group_by ); + + my %res = (Groups => [], Functions => []); + my %column_info; + + foreach my $group_by ( @group_by ) { + $group_by->{'NAME'} = $self->Column( %$group_by ); + $column_info{ $group_by->{'NAME'} } = $group_by; + push @{ $res{'Groups'} }, $group_by->{'NAME'}; + } + + %STATISTICS = @STATISTICS unless keys %STATISTICS; - if ( $args{'FIELD'} && !$args{'FUNCTION'} ) { - %args = $self->_FieldToFunction( %args ); + my @function = grep defined && length, + ref( $args{'Function'} )? @{ $args{'Function'} } : ($args{'Function'}); + push @function, 'COUNT' unless @function; + foreach my $e ( @function ) { + $e = { + TYPE => 'statistic', + KEY => $e, + INFO => $STATISTICS{ $e }, + META => $STATISTICS_META{ $STATISTICS{ $e }[1] }, + POSITION => $i++, + }; + unless ( $e->{'INFO'} && $e->{'META'} ) { + $RT::Logger->error("'". $e->{'KEY'} ."' is not valid statistic for report"); + $e->{'FUNCTION'} = 'NULL'; + $e->{'NAME'} = $self->Column( FUNCTION => 'NULL' ); + } + elsif ( $e->{'META'}{'Function'} ) { + my $code = $self->FindImplementationCode( $e->{'META'}{'Function'} ); + unless ( $code ) { + $e->{'FUNCTION'} = 'NULL'; + $e->{'NAME'} = $self->Column( FUNCTION => 'NULL' ); + } + elsif ( $e->{'META'}{'SubValues'} ) { + my %tmp = $code->( $self, @{ $e->{INFO} }[2 .. $#{$e->{INFO}}] ); + $e->{'NAME'} = 'postfunction'. $self->{'postfunctions'}++; + while ( my ($k, $v) = each %tmp ) { + $e->{'MAP'}{ $k }{'NAME'} = $self->Column( %$v ); + @{ $e->{'MAP'}{ $k } }{'FUNCTION', 'ALIAS', 'FIELD'} = + @{ $v }{'FUNCTION', 'ALIAS', 'FIELD'}; + } + } + else { + my %tmp = $code->( $self, @{ $e->{INFO} }[2 .. $#{$e->{INFO}}] ); + $e->{'NAME'} = $self->Column( %tmp ); + @{ $e }{'FUNCTION', 'ALIAS', 'FIELD'} = @tmp{'FUNCTION', 'ALIAS', 'FIELD'}; + } + } + elsif ( $e->{'META'}{'Calculate'} ) { + $e->{'NAME'} = 'postfunction'. $self->{'postfunctions'}++; + } + push @{ $res{'Functions'} }, $e->{'NAME'}; + $column_info{ $e->{'NAME'} } = $e; } - return $self->SUPER::Column( %args ); + $self->{'column_info'} = \%column_info; + + return %res; } =head2 _DoSearch @@ -175,7 +599,7 @@ sub _DoSearch { ); } else { - $self->AddEmptyRows; + $self->PostProcessRecords; } } @@ -190,131 +614,488 @@ sub _FieldToFunction { my $self = shift; my %args = (@_); - my $field = $args{'FIELD'}; + $args{'FIELD'} ||= $args{'KEY'}; - if ($field =~ /^(.*)(Hourly|Daily|Monthly|Annually)$/) { - my ($field, $grouping) = ($1, $2); - my $alias = $args{'ALIAS'} || 'main'; + my $meta = $GROUPINGS_META{ $GROUPINGS{ $args{'KEY'} } }; + return ('FUNCTION' => 'NULL') unless $meta; - my $func = "$alias.$field"; + return %args unless $meta->{'Function'}; - my $db_type = RT->Config->Get('DatabaseType'); - if ( RT->Config->Get('ChartsTimezonesInDB') ) { - my $tz = $self->CurrentUser->UserObj->Timezone - || RT->Config->Get('Timezone') - || 'UTC'; - if ( lc $tz eq 'utc' ) { - # do nothing - } - elsif ( $db_type eq 'Pg' ) { - $func = "timezone('UTC', $func)"; - $func = "timezone(". $self->_Handle->dbh->quote($tz) .", $func)"; - } - elsif ( $db_type eq 'mysql' ) { - $func = "CONVERT_TZ($func, 'UTC', " - . $self->_Handle->dbh->quote($tz) - .")"; - } - else { - $RT::Logger->warning( - "ChartsTimezonesInDB config option" - ." is not supported on $db_type." - ); - } + my $code = $self->FindImplementationCode( $meta->{'Function'} ); + return ('FUNCTION' => 'NULL') unless $code; + + return $code->( $self, %args ); +} + + +# Gotta skip over RT::Tickets->Next, since it does all sorts of crazy magic we +# don't want. +sub Next { + my $self = shift; + $self->RT::SearchBuilder::Next(@_); + +} + +sub NewItem { + my $self = shift; + my $res = RT::Report::Tickets::Entry->new($self->CurrentUser); + $res->{'report'} = $self; + weaken $res->{'report'}; + return $res; +} + +# This is necessary since normally NewItem (above) is used to intuit the +# correct class. However, since we're abusing a subclass, it's incorrect. +sub _RoleGroupClass { "RT::Ticket" } +sub _SingularClass { "RT::Report::Tickets::Entry" } + +sub SortEntries { + my $self = shift; + + $self->_DoSearch if $self->{'must_redo_search'}; + return unless $self->{'items'} && @{ $self->{'items'} }; + + my @groups = + grep $_->{'TYPE'} eq 'grouping', + map $self->ColumnInfo($_), + $self->ColumnsList; + return unless @groups; + + my @SORT_OPS; + my $by_multiple = sub ($$) { + for my $f ( @SORT_OPS ) { + my $r = $f->($_[0], $_[1]); + return $r if $r; } + }; + my @data = map [$_], @{ $self->{'items'} }; + + for ( my $i = 0; $i < @groups; $i++ ) { + my $group_by = $groups[$i]; + my $idx = $i+1; + my $method; + + # If this is a CF, traverse the values being used for labels. + # If they all look like numbers or undef, flag for a numeric sort + + my $looks_like_number; + if ( $group_by->{'KEY'} eq 'CF' ){ + $looks_like_number = 1; - # Pg 8.3 requires explicit casting - $func .= '::text' if $db_type eq 'Pg'; + foreach my $item (@data){ + my $cf_label = $item->[0]->RawValue($group_by->{'NAME'}); - if ( $grouping eq 'Hourly' ) { - $func = "SUBSTR($func,1,13)"; + $looks_like_number = 0 + unless (not defined $cf_label) + or Scalar::Util::looks_like_number( $cf_label ); + } } - if ( $grouping eq 'Daily' ) { - $func = "SUBSTR($func,1,10)"; + + my $order = $looks_like_number ? 'numeric label' : 'label'; + $order = $group_by->{'META'}{Sort} if exists $group_by->{'META'}{Sort}; + + if ( $order eq 'label' ) { + push @SORT_OPS, sub { $_[0][$idx] cmp $_[1][$idx] }; + $method = 'LabelValue'; } - elsif ( $grouping eq 'Monthly' ) { - $func = "SUBSTR($func,1,7)"; + elsif ( $order eq 'numeric label' ) { + my $nv = $self->loc("(no value)"); + # Sort the (no value) elements first, by comparing for them + # first, and falling back to a numeric sort on all other + # values. + push @SORT_OPS, sub { + (($_[0][$idx] ne $nv) <=> ($_[1][$idx] ne $nv)) + || ( $_[0][$idx] <=> $_[1][$idx] ) }; + $method = 'LabelValue'; } - elsif ( $grouping eq 'Annually' ) { - $func = "SUBSTR($func,1,4)"; + elsif ( $order eq 'raw' ) { + push @SORT_OPS, sub { ($_[0][$idx]//'') cmp ($_[1][$idx]//'') }; + $method = 'RawValue'; } - $args{'FUNCTION'} = $func; - } elsif ( $field =~ /^(?:CF|CustomField)\.\{(.*)\}$/ ) { #XXX: use CFDecipher method - my $cf_name = $1; - my $cf = RT::CustomField->new( $self->CurrentUser ); - $cf->Load($cf_name); - unless ( $cf->id ) { - $RT::Logger->error("Couldn't load CustomField #$cf_name"); + elsif ( $order eq 'numeric raw' ) { + push @SORT_OPS, sub { $_[0][$idx] <=> $_[1][$idx] }; + $method = 'RawValue'; } else { - my ($ticket_cf_alias, $cf_alias) = $self->_CustomFieldJoin($cf->id, $cf->id, $cf_name); - @args{qw(ALIAS FIELD)} = ($ticket_cf_alias, 'Content'); + $RT::Logger->error("Unknown sorting function '$order'"); + next; } - } elsif ( $field =~ /^(?:(Owner|Creator|LastUpdatedBy))(?:\.(.*))?$/ ) { - my $type = $1 || ''; - my $column = $2 || 'Name'; - my $u_alias = $self->{"_sql_report_${type}_users_${column}"} - ||= $self->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => $type, - TABLE2 => 'Users', - FIELD2 => 'id', - ); - @args{qw(ALIAS FIELD)} = ($u_alias, $column); - } elsif ( $field =~ /^(?:Watcher|(Requestor|Cc|AdminCc))(?:\.(.*))?$/ ) { - my $type = $1 || ''; - my $column = $2 || 'Name'; - my $u_alias = $self->{"_sql_report_watcher_users_alias_$type"}; - unless ( $u_alias ) { - my ($g_alias, $gm_alias); - ($g_alias, $gm_alias, $u_alias) = $self->_WatcherJoin( $type ); - $self->{"_sql_report_watcher_users_alias_$type"} = $u_alias; + $_->[$idx] = $_->[0]->$method( $group_by->{'NAME'} ) for @data; + } + $self->{'items'} = [ + map $_->[0], + sort $by_multiple @data + ]; +} + +sub PostProcessRecords { + my $self = shift; + + my $info = $self->{'column_info'}; + foreach my $column ( values %$info ) { + next unless $column->{'TYPE'} eq 'statistic'; + if ( $column->{'META'}{'Calculate'} ) { + $self->CalculatePostFunction( $column ); + } + elsif ( $column->{'META'}{'SubValues'} ) { + $self->MapSubValues( $column ); + } + } +} + +sub CalculatePostFunction { + my $self = shift; + my $info = shift; + + my $code = $self->FindImplementationCode( $info->{'META'}{'Calculate'} ); + unless ( $code ) { + # TODO: fill in undefs + return; + } + + my $column = $info->{'NAME'}; + + my $base_query = $self->Query; + foreach my $item ( @{ $self->{'items'} } ) { + $item->{'values'}{ lc $column } = $code->( + $self, + Query => join( + ' AND ', map "($_)", grep defined && length, $base_query, $item->Query, + ), + ); + $item->{'fetched'}{ lc $column } = 1; + } +} + +sub MapSubValues { + my $self = shift; + my $info = shift; + + my $to = $info->{'NAME'}; + my $map = $info->{'MAP'}; + + foreach my $item ( @{ $self->{'items'} } ) { + my $dst = $item->{'values'}{ lc $to } = { }; + while (my ($k, $v) = each %{ $map } ) { + $dst->{ $k } = delete $item->{'values'}{ lc $v->{'NAME'} }; + # This mirrors the logic in RT::Record::__Value When that + # ceases tp use the UTF-8 flag as a character/byte + # distinction from the database, this can as well. + utf8::decode( $dst->{ $k } ) + if defined $dst->{ $k } + and not utf8::is_utf8( $dst->{ $k } ); + delete $item->{'fetched'}{ lc $v->{'NAME'} }; } - @args{qw(ALIAS FIELD)} = ($u_alias, $column); + $item->{'fetched'}{ lc $to } = 1; + } +} + +sub GenerateDateFunction { + my $self = shift; + my %args = @_; + + my $tz; + if ( RT->Config->Get('ChartsTimezonesInDB') ) { + my $to = $self->CurrentUser->UserObj->Timezone + || RT->Config->Get('Timezone'); + $tz = { From => 'UTC', To => $to } + if $to && lc $to ne 'utc'; } + + $args{'FUNCTION'} = $RT::Handle->DateTimeFunction( + Type => $args{'SUBKEY'}, + Field => $self->NotSetDateToNullFunction, + Timezone => $tz, + ); return %args; } -1; +sub GenerateCustomFieldFunction { + my $self = shift; + my %args = @_; + my ($name) = ( $args{'SUBKEY'} =~ /^\{(.*)\}$/ ); + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->Load($name); + unless ( $cf->id ) { + $RT::Logger->error("Couldn't load CustomField #$name"); + @args{qw(FUNCTION FIELD)} = ('NULL', undef); + } else { + my ($ticket_cf_alias, $cf_alias) = $self->_CustomFieldJoin($cf->id, $cf); + @args{qw(ALIAS FIELD)} = ($ticket_cf_alias, 'Content'); + } + return %args; +} +sub GenerateUserFunction { + my $self = shift; + my %args = @_; -# Gotta skip over RT::Tickets->Next, since it does all sorts of crazy magic we -# don't want. -sub Next { + my $column = $args{'SUBKEY'} || 'Name'; + my $u_alias = $self->{"_sql_report_$args{FIELD}_users_$column"} + ||= $self->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => $args{'FIELD'}, + TABLE2 => 'Users', + FIELD2 => 'id', + ); + @args{qw(ALIAS FIELD)} = ($u_alias, $column); + return %args; +} + +sub GenerateWatcherFunction { my $self = shift; - $self->RT::SearchBuilder::Next(@_); + my %args = @_; + + my $type = $args{'FIELD'}; + $type = '' if $type eq 'Watcher'; + my $column = $args{'SUBKEY'} || 'Name'; + + my $u_alias = $self->{"_sql_report_watcher_users_alias_$type"}; + unless ( $u_alias ) { + my ($g_alias, $gm_alias); + ($g_alias, $gm_alias, $u_alias) = $self->_WatcherJoin( Name => $type ); + $self->{"_sql_report_watcher_users_alias_$type"} = $u_alias; + } + @args{qw(ALIAS FIELD)} = ($u_alias, $column); + + return %args; } -sub NewItem { +sub DurationAsString { my $self = shift; - return RT::Report::Tickets::Entry->new(RT->SystemUser); # $self->CurrentUser); + my %args = @_; + my $v = $args{'VALUE'}; + unless ( ref $v ) { + return $self->loc("(no value)") unless defined $v && length $v; + return RT::Date->new( $self->CurrentUser )->DurationAsString( + $v, Show => 3, Short => 1 + ); + } + + my $date = RT::Date->new( $self->CurrentUser ); + my %res = %$v; + foreach my $e ( values %res ) { + $e = $date->DurationAsString( $e, Short => 1, Show => 3 ) + if defined $e && length $e; + $e = $self->loc("(no value)") unless defined $e && length $e; + } + return \%res; } +sub LabelValueCode { + my $self = shift; + my $name = shift; + + my $display = $self->ColumnInfo( $name )->{'META'}{'Display'}; + return undef unless $display; + return $self->FindImplementationCode( $display ); +} -=head2 AddEmptyRows -If we're grouping on a criterion we know how to add zero-value rows -for, do that. +sub FindImplementationCode { + my $self = shift; + my $value = shift; + my $silent = shift; -=cut + my $code; + unless ( $value ) { + $RT::Logger->error("Value is not defined. Should be method name or code reference") + unless $silent; + return undef; + } + elsif ( !ref $value ) { + $code = $self->can( $value ); + unless ( $code ) { + $RT::Logger->error("No method $value in ". (ref $self || $self) ." class" ) + unless $silent; + return undef; + } + } + elsif ( ref( $value ) eq 'CODE' ) { + $code = $value; + } + else { + $RT::Logger->error("$value is not method name or code reference") + unless $silent; + return undef; + } + return $code; +} -sub AddEmptyRows { +sub Serialize { my $self = shift; - if ( @{ $self->{'_group_by_field'} || [] } == 1 && $self->{'_group_by_field'}[0] eq 'Status' ) { - my %has = map { $_->__Value('Status') => 1 } @{ $self->ItemsArrayRef || [] }; - foreach my $status ( grep !$has{$_}, RT::Queue->new($self->CurrentUser)->StatusArray ) { + my %clone = %$self; +# current user, handle and column_info + delete @clone{'user', 'DBIxHandle', 'column_info'}; + $clone{'items'} = [ map $_->{'values'}, @{ $clone{'items'} || [] } ]; + $clone{'column_info'} = {}; + while ( my ($k, $v) = each %{ $self->{'column_info'} } ) { + $clone{'column_info'}{$k} = { %$v }; + delete $clone{'column_info'}{$k}{'META'}; + } + return \%clone; +} - my $record = $self->NewItem; - $record->LoadFromHash( { - id => 0, - status => $status - } ); - $self->AddRecord($record); +sub Deserialize { + my $self = shift; + my $data = shift; + + $self->CleanSlate; + %$self = (%$self, %$data); + + $self->{'items'} = [ + map { my $r = $self->NewItem; $r->LoadFromHash( $_ ); $r } + @{ $self->{'items'} } + ]; + foreach my $e ( values %{ $self->{column_info} } ) { + $e->{'META'} = $e->{'TYPE'} eq 'grouping' + ? $GROUPINGS_META{ $e->{'INFO'} } + : $STATISTICS_META{ $e->{'INFO'}[1] } + } +} + + +sub FormatTable { + my $self = shift; + my %columns = @_; + + my (@head, @body, @footer); + + @head = ({ cells => []}); + foreach my $column ( @{ $columns{'Groups'} } ) { + push @{ $head[0]{'cells'} }, { type => 'head', value => $self->Label( $column ) }; + } + + my $i = 0; + while ( my $entry = $self->Next ) { + $body[ $i ] = { even => ($i+1)%2, cells => [] }; + $i++; + } + @footer = ({ even => ++$i%2, cells => []}); + + my $g = 0; + foreach my $column ( @{ $columns{'Groups'} } ) { + $i = 0; + my $last; + while ( my $entry = $self->Next ) { + my $value = $entry->LabelValue( $column ); + if ( !$last || $last->{'value'} ne $value ) { + push @{ $body[ $i++ ]{'cells'} }, $last = { type => 'label', value => $value }; + $last->{even} = $g++ % 2 + unless $column eq $columns{'Groups'}[-1]; + } + else { + $i++; + $last->{rowspan} = ($last->{rowspan}||1) + 1; + } + } + } + push @{ $footer[0]{'cells'} }, { + type => 'label', + value => $self->loc('Total'), + colspan => scalar @{ $columns{'Groups'} }, + }; + + my $pick_color = do { + my @colors = RT->Config->Get("ChartColors"); + sub { $colors[ $_[0] % @colors - 1 ] } + }; + + my $function_count = 0; + foreach my $column ( @{ $columns{'Functions'} } ) { + $i = 0; + + my $info = $self->ColumnInfo( $column ); + + my @subs = (''); + if ( $info->{'META'}{'SubValues'} ) { + @subs = $self->FindImplementationCode( $info->{'META'}{'SubValues'} )->( + $self + ); + } + + my %total; + unless ( $info->{'META'}{'NoTotals'} ) { + while ( my $entry = $self->Next ) { + my $raw = $entry->RawValue( $column ) || {}; + $raw = { '' => $raw } unless ref $raw; + $total{ $_ } += $raw->{ $_ } foreach grep $raw->{$_}, @subs; + } + @subs = grep $total{$_}, @subs + unless $info->{'META'}{'NoHideEmpty'}; + } + + my $label = $self->Label( $column ); + + unless (@subs) { + while ( my $entry = $self->Next ) { + push @{ $body[ $i++ ]{'cells'} }, { + type => 'value', + value => undef, + query => $entry->Query, + }; + } + push @{ $head[0]{'cells'} }, { + type => 'head', + value => $label, + rowspan => scalar @head, + color => $pick_color->(++$function_count), + }; + push @{ $footer[0]{'cells'} }, { type => 'value', value => undef }; + next; + } + + if ( @subs > 1 && @head == 1 ) { + $_->{rowspan} = 2 foreach @{ $head[0]{'cells'} }; + } + + if ( @subs == 1 ) { + push @{ $head[0]{'cells'} }, { + type => 'head', + value => $label, + rowspan => scalar @head, + color => $pick_color->(++$function_count), + }; + } else { + push @{ $head[0]{'cells'} }, { type => 'head', value => $label, colspan => scalar @subs }; + push @{ $head[1]{'cells'} }, { type => 'head', value => $_, color => $pick_color->(++$function_count) } + foreach @subs; + } + + while ( my $entry = $self->Next ) { + my $query = $entry->Query; + my $value = $entry->LabelValue( $column ) || {}; + $value = { '' => $value } unless ref $value; + foreach my $e ( @subs ) { + push @{ $body[ $i ]{'cells'} }, { + type => 'value', + value => $value->{ $e }, + query => $query, + }; + } + $i++; + } + + unless ( $info->{'META'}{'NoTotals'} ) { + my $total_code = $self->LabelValueCode( $column ); + foreach my $e ( @subs ) { + my $total = $total{ $e }; + $total = $total_code->( $self, %$info, VALUE => $total ) + if $total_code; + push @{ $footer[0]{'cells'} }, { type => 'value', value => $total }; + } + } + else { + foreach my $e ( @subs ) { + push @{ $footer[0]{'cells'} }, { type => 'value', value => undef }; + } } } + + return thead => \@head, tbody => \@body, tfoot => \@footer; } RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Report/Tickets/Entry.pm b/rt/lib/RT/Report/Tickets/Entry.pm index ee6b94b..24cb4f6 100644 --- a/rt/lib/RT/Report/Tickets/Entry.pm +++ b/rt/lib/RT/Report/Tickets/Entry.pm @@ -66,27 +66,84 @@ and ensuring that dates are in local not DB timezones. sub LabelValue { my $self = shift; - my $field = shift; - my $value = $self->__Value( $field ); - - if ( $field =~ /(Daily|Monthly|Annually|Hourly)$/ ) { - my $re; - # it's not just 1970-01-01 00:00:00 because of timezone shifts - # and conversion from UTC to user's TZ - $re = qr{19(?:70-01-01|69-12-31) [0-9]{2}} if $field =~ /Hourly$/; - $re = qr{19(?:70-01-01|69-12-31)} if $field =~ /Daily$/; - $re = qr{19(?:70-01|69-12)} if $field =~ /Monthly$/; - $re = qr{19(?:70|69)} if $field =~ /Annually$/; - $value =~ s/^$re/Not Set/; + my $name = shift; + + my $raw = $self->RawValue( $name, @_ ); + + if ( my $code = $self->Report->LabelValueCode( $name ) ) { + $raw = $code->( $self, %{ $self->Report->ColumnInfo( $name ) }, VALUE => $raw ); + return $self->loc('(no value)') unless defined $raw && length $raw; + return $raw; } - return $value; + unless ( ref $raw ) { + return $self->loc('(no value)') unless defined $raw && length $raw; + return $self->loc($raw) if $self->Report->ColumnInfo( $name )->{'META'}{'Localize'}; + return $raw; + } else { + my $loc = $self->Report->ColumnInfo( $name )->{'META'}{'Localize'}; + my %res = %$raw; + if ( $loc ) { + $res{ $self->loc($_) } = delete $res{ $_ } foreach keys %res; + $_ = $self->loc($_) foreach values %res; + } + $_ = $self->loc('(no value)') foreach grep !defined || !length, values %res; + return \%res; + } +} + +sub RawValue { + return (shift)->__Value( @_ ); } sub ObjectType { return 'RT::Ticket'; } +sub CustomFieldLookupType { + RT::Ticket->CustomFieldLookupType +} + +sub Query { + my $self = shift; + + my @parts; + foreach my $column ( $self->Report->ColumnsList ) { + my $info = $self->Report->ColumnInfo( $column ); + next unless $info->{'TYPE'} eq 'grouping'; + + my $custom = $info->{'META'}{'Query'}; + if ( $custom and my $code = $self->Report->FindImplementationCode( $custom ) ) { + push @parts, $code->( $self, COLUMN => $column, %$info ); + } + else { + my $field = join '.', grep $_, $info->{KEY}, $info->{SUBKEY}; + my $value = $self->RawValue( $column ); + my $op = '='; + if ( defined $value ) { + unless ( $value =~ /^\d+$/ ) { + $value =~ s/(['\\])/\\$1/g; + $value = "'$value'"; + } + } + else { + ($op, $value) = ('IS', 'NULL'); + } + unless ( $field =~ /^[{}\w\.]+$/ ) { + $field =~ s/(['\\])/\\$1/g; + $field = "'$field'"; + } + push @parts, "$field $op $value"; + } + } + return () unless @parts; + return join ' AND ', map "($_)", grep defined && length, @parts; +} + +sub Report { + return $_[0]->{'report'}; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Rule.pm b/rt/lib/RT/Rule.pm index 3b3e8b7..bdbbe0b 100644 --- a/rt/lib/RT/Rule.pm +++ b/rt/lib/RT/Rule.pm @@ -103,11 +103,10 @@ sub RunScripAction { my $action = $ScripAction->LoadAction( TransactionObj => $self->TransactionObj, TicketObj => $self->TicketObj, + TemplateObj => $template, %args, ); - # XXX: fix template to allow additional arguments to be passed from here - $action->{'TemplateObj'} = $template; $action->{'ScripObj'} = RT::Scrip->new($self->CurrentUser); # Stub. sendemail action really wants a scripobj available $action->Prepare or return; $action->Commit; diff --git a/rt/lib/RT/Ruleset.pm b/rt/lib/RT/Ruleset.pm index 9d6b965..a84ba08 100644 --- a/rt/lib/RT/Ruleset.pm +++ b/rt/lib/RT/Ruleset.pm @@ -52,7 +52,6 @@ use warnings; use base 'Class::Accessor::Fast'; -use UNIVERSAL::require; __PACKAGE__->mk_accessors(qw(Name Rules)); diff --git a/rt/lib/RT/SQL.pm b/rt/lib/RT/SQL.pm index 84c1dee..9f8dad8 100644 --- a/rt/lib/RT/SQL.pm +++ b/rt/lib/RT/SQL.pm @@ -52,11 +52,6 @@ use strict; use warnings; -use constant HAS_BOOLEAN_PARSER => do { - local $@; - eval { require Parse::BooleanLogic; 1 } -}; - # States use constant VALUE => 1; use constant AGGREG => 2; @@ -197,7 +192,7 @@ sub Parse { } if( $depth ) { - my $msg = $loc->("Incomplete query, [quant,_1,unclosed paren] in '[_2]'", $depth, $string); + my $msg = $loc->("Incomplete query, [quant,_1,unclosed paren,unclosed parens] in '[_2]'", $depth, $string); return $cb->{'Error'}->( $msg ) if $cb->{'Error'}; die $msg; } @@ -217,80 +212,6 @@ sub _BitmaskToString { return join ' or ', @res; } -sub PossibleCustomFields { - my %args = (Query => undef, CurrentUser => undef, @_); - - my $cfs = RT::CustomFields->new( $args{'CurrentUser'} ); - my $ocf_alias = $cfs->_OCFAlias; - $cfs->LimitToLookupType( 'RT::Queue-RT::Ticket' ); - - my $tree; - if ( HAS_BOOLEAN_PARSER ) { - $tree = Parse::BooleanLogic->filter( - RT::SQL::ParseToArray( $args{'Query'} ), - sub { $_[0]->{'key'} =~ /^Queue(?:\z|\.)/ }, - ); - } - if ( $tree && @$tree ) { - my $clause = 'QUEUES'; - my $queue_alias = $cfs->Join( - TYPE => 'LEFT', - ALIAS1 => $ocf_alias, - FIELD1 => 'ObjectId', - TABLE2 => 'Queues', - FIELD2 => 'id', - ); - $cfs->_OpenParen($clause); - $cfs->Limit( - SUBCLAUSE => $clause, - ENTRYAGGREGATOR => 'AND', - ALIAS => $ocf_alias, - FIELD => 'ObjectId', - VALUE => 0, - ); - $cfs->_OpenParen($clause); - - my $ea = 'OR'; - Parse::BooleanLogic->walk( - $tree, - { - open_paren => sub { $cfs->_OpenParen($clause) }, - close_paren => sub { $cfs->_CloseParen($clause) }, - operator => sub { $ea = $_[0] }, - operand => sub { - my ($key, $op, $value) = @{$_[0]}{'key', 'op', 'value'}; - my (undef, @sub) = split /\./, $key; - push @sub, $value =~ /\D/? 'Name' : 'id' - unless @sub; - - die "Couldn't handle ". join('.', 'Queue', @sub) if @sub > 1; - $cfs->Limit( - SUBCLAUSE => $clause, - ENTRYAGGREGATOR => $ea, - ALIAS => $queue_alias, - FIELD => $sub[0], - OPERATOR => $op, - VALUE => $value, - ); - }, - } - ); - - $cfs->_CloseParen($clause); - $cfs->_CloseParen($clause); - } else { - $cfs->Limit( - ENTRYAGGREGATOR => 'AND', - ALIAS => $ocf_alias, - FIELD => 'ObjectId', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - ); - } - return $cfs; -} - - RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/SavedSearches.pm b/rt/lib/RT/SavedSearches.pm index 6f09757..c060701 100644 --- a/rt/lib/RT/SavedSearches.pm +++ b/rt/lib/RT/SavedSearches.pm @@ -67,12 +67,12 @@ package RT::SavedSearches; -use RT::SavedSearch; - use strict; use warnings; use base 'RT::SharedSettings'; +use RT::SavedSearch; + sub RecordClass { return 'RT::SavedSearch'; } @@ -109,15 +109,6 @@ sub LimitToPrivacy { } } -### Internal methods - -sub _PrivacyObjects { - my $self = shift; - Carp::carp("RT::SavedSearches->_PrivacyObjects is deprecated. Please use RT::SavedSearch->_PrivacyObjects"); - my $search = RT::SavedSearch->new($self->CurrentUser); - return $search->_PrivacyObjects(@_); -} - RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Scrip.pm b/rt/lib/RT/Scrip.pm index b03d6b5..eedd406 100755 --- a/rt/lib/RT/Scrip.pm +++ b/rt/lib/RT/Scrip.pm @@ -67,13 +67,14 @@ package RT::Scrip; use strict; use warnings; - +use base 'RT::Record'; use RT::Queue; use RT::Template; use RT::ScripCondition; use RT::ScripAction; -use base 'RT::Record'; +use RT::Scrips; +use RT::ObjectScrip; sub Table {'Scrips'} @@ -104,7 +105,7 @@ sub Create { my $self = shift; my %args = ( Queue => 0, - Template => 0, # name or id + Template => undef, # name or id ScripAction => 0, # name or id ScripCondition => 0, # name or id Stage => 'TransactionCreate', @@ -147,7 +148,6 @@ sub Create { #TODO +++ validate input - require RT::ScripAction; return ( 0, $self->loc("Action is mandatory argument") ) unless $args{'ScripAction'}; my $action = RT::ScripAction->new( $self->CurrentUser ); @@ -155,15 +155,26 @@ sub Create { return ( 0, $self->loc( "Action '[_1]' not found", $args{'ScripAction'} ) ) unless $action->Id; - require RT::Template; return ( 0, $self->loc("Template is mandatory argument") ) unless $args{'Template'}; my $template = RT::Template->new( $self->CurrentUser ); - $template->Load( $args{'Template'} ); - return ( 0, $self->loc( "Template '[_1]' not found", $args{'Template'} ) ) - unless $template->Id; + if ( $args{'Template'} =~ /\D/ ) { + $template->LoadByName( Name => $args{'Template'}, Queue => $args{'Queue'} ); + return ( 0, $self->loc( "Global template '[_1]' not found", $args{'Template'} ) ) + if !$template->Id && !$args{'Queue'}; + return ( 0, $self->loc( "Global or queue specific template '[_1]' not found", $args{'Template'} ) ) + if !$template->Id; + } else { + $template->Load( $args{'Template'} ); + return ( 0, $self->loc( "Template '[_1]' not found", $args{'Template'} ) ) + unless $template->Id; + + return (0, $self->loc( "Template '[_1]' is not global" )) + if !$args{'Queue'} && $template->Queue; + return (0, $self->loc( "Template '[_1]' is not global nor queue specific" )) + if $args{'Queue'} && $template->Queue && $template->Queue != $args{'Queue'}; + } - require RT::ScripCondition; return ( 0, $self->loc("Condition is mandatory argument") ) unless $args{'ScripCondition'}; my $condition = RT::ScripCondition->new( $self->CurrentUser ); @@ -171,12 +182,18 @@ sub Create { return ( 0, $self->loc( "Condition '[_1]' not found", $args{'ScripCondition'} ) ) unless $condition->Id; + if ( $args{'Stage'} eq 'Disabled' ) { + $RT::Logger->warning("Disabled Stage is deprecated"); + $args{'Stage'} = 'TransactionCreate'; + $args{'Disabled'} = 1; + } + $args{'Disabled'} ||= 0; + my ( $id, $msg ) = $self->SUPER::Create( - Queue => $args{'Queue'}, - Template => $template->Id, + Template => $template->Name, ScripCondition => $condition->id, - Stage => $args{'Stage'}, ScripAction => $action->Id, + Disabled => $args{'Disabled'}, Description => $args{'Description'}, CustomPrepareCode => $args{'CustomPrepareCode'}, CustomCommitCode => $args{'CustomCommitCode'}, @@ -184,12 +201,16 @@ sub Create { ConditionRules => $args{'ConditionRules'}, ActionRules => $args{'ActionRules'}, ); - if ( $id ) { - return ( $id, $self->loc('Scrip Created') ); - } - else { - return ( $id, $msg ); - } + return ( $id, $msg ) unless $id; + + (my $status, $msg) = RT::ObjectScrip->new( $self->CurrentUser )->Add( + Scrip => $self, + Stage => $args{'Stage'}, + ObjectId => $args{'Queue'}, + ); + $RT::Logger->error( "Couldn't add scrip: $msg" ) unless $status; + + return ( $id, $self->loc('Scrip Created') ); } @@ -207,29 +228,154 @@ sub Delete { return ( 0, $self->loc('Permission Denied') ); } + RT::ObjectScrip->new( $self->CurrentUser )->DeleteAll( Scrip => $self ); + return ( $self->SUPER::Delete(@_) ); } +sub IsGlobal { return shift->IsAdded(0) } + +sub IsAdded { + my $self = shift; + my $record = RT::ObjectScrip->new( $self->CurrentUser ); + $record->LoadByCols( Scrip => $self->id, ObjectId => shift || 0 ); + return undef unless $record->id; + return $record; +} + +sub IsAddedToAny { + my $self = shift; + my $record = RT::ObjectScrip->new( $self->CurrentUser ); + $record->LoadByCols( Scrip => $self->id ); + return $record->id ? 1 : 0; +} + +sub AddedTo { + my $self = shift; + return RT::ObjectScrip->new( $self->CurrentUser ) + ->AddedTo( Scrip => $self ); +} + +sub NotAddedTo { + my $self = shift; + return RT::ObjectScrip->new( $self->CurrentUser ) + ->NotAddedTo( Scrip => $self ); +} + +=head2 AddToObject + +Adds (applies) the current scrip to the provided queue (ObjectId). +Accepts a param hash of: -=head2 QueueObj +=over -Retuns an RT::Queue object with this Scrip's queue +=item C<ObjectId> + +Queue name or id. 0 makes the scrip global. + +=item C<Stage> + +Stage to run in. Valid stages are TransactionCreate or +TransactionBatch. Defaults to TransactionCreate. As of RT 4.2, Disabled +is no longer a stage. + +=item C<Template> + +Name of global or queue-specific template for the scrip. Use 'Blank' for +non-notification scrips. + +=item C<SortOrder> + +Number indicating the relative order the scrip should run in. + +=back + +Returns (val, message). If val is false, the message contains an error +message. =cut -sub QueueObj { +sub AddToObject { my $self = shift; + my %args = @_%2? (ObjectId => @_) : (@_); + + # Default Stage explicitly rather than in %args assignment to handle + # Stage coming in set to undef. + $args{'Stage'} //= 'TransactionCreate'; - if ( !$self->{'QueueObj'} ) { - require RT::Queue; - $self->{'QueueObj'} = RT::Queue->new( $self->CurrentUser ); - $self->{'QueueObj'}->Load( $self->__Value('Queue') ); + my $queue; + if ( $args{'ObjectId'} ) { + $queue = RT::Queue->new( $self->CurrentUser ); + $queue->Load( $args{'ObjectId'} ); + return (0, $self->loc('Invalid queue')) + unless $queue->id; + + $args{'ObjectId'} = $queue->id; + } + return ( 0, $self->loc('Permission Denied') ) + unless $self->CurrentUser->PrincipalObj->HasRight( + Object => $queue || $RT::System, Right => 'ModifyScrips', + ) + ; + + my $tname = $self->Template; + my $template = RT::Template->new( $self->CurrentUser ); + $template->LoadByName( Queue => $queue? $queue->id : 0, Name => $tname ); + unless ( $template->id ) { + if ( $queue ) { + return (0, $self->loc('No template [_1] in queue [_2] or global', + $tname, $queue->Name||$queue->id)); + } else { + return (0, $self->loc('No global template [_1]', $tname)); + } } - return ( $self->{'QueueObj'} ); + + my $rec = RT::ObjectScrip->new( $self->CurrentUser ); + return $rec->Add( %args, Scrip => $self ); } +=head2 RemoveFromObject + +Removes the current scrip to the provided queue (ObjectId). + +Accepts a param hash of: + +=over + +=item C<ObjectId> +Queue name or id. 0 makes the scrip global. + +=back + +Returns (val, message). If val is false, the message contains an error +message. + +=cut + +sub RemoveFromObject { + my $self = shift; + my %args = @_%2? (ObjectId => @_) : (@_); + + my $queue; + if ( $args{'ObjectId'} ) { + $queue = RT::Queue->new( $self->CurrentUser ); + $queue->Load( $args{'ObjectId'} ); + return (0, $self->loc('Invalid queue id')) + unless $queue->id; + } + return ( 0, $self->loc('Permission Denied') ) + unless $self->CurrentUser->PrincipalObj->HasRight( + Object => $queue || $RT::System, Right => 'ModifyScrips', + ) + ; + + my $rec = RT::ObjectScrip->new( $self->CurrentUser ); + $rec->LoadByCols( Scrip => $self->id, ObjectId => $args{'ObjectId'} ); + return (0, $self->loc('Scrip is not added') ) unless $rec->id; + return $rec->Delete; +} =head2 ActionObj @@ -242,12 +388,8 @@ sub ActionObj { unless ( defined $self->{'ScripActionObj'} ) { require RT::ScripAction; - $self->{'ScripActionObj'} = RT::ScripAction->new( $self->CurrentUser ); - - #TODO: why are we loading Actions with templates like this. - # two separate methods might make more sense - $self->{'ScripActionObj'}->Load( $self->ScripAction, $self->Template ); + $self->{'ScripActionObj'}->Load( $self->ScripAction ); } return ( $self->{'ScripActionObj'} ); } @@ -291,17 +433,54 @@ Retuns an RT::Template object with this Scrip's Template sub TemplateObj { my $self = shift; + my $queue = shift; - unless ( defined $self->{'TemplateObj'} ) { - require RT::Template; - $self->{'TemplateObj'} = RT::Template->new( $self->CurrentUser ); - $self->{'TemplateObj'}->Load( $self->Template ); - } - return ( $self->{'TemplateObj'} ); + my $res = RT::Template->new( $self->CurrentUser ); + $res->LoadByName( Queue => $queue, Name => $self->Template ); + return $res; } +=head2 Stage + +Takes TicketObj named argument and returns scrip's stage when +added to ticket's queue. + +=cut + +sub Stage { + my $self = shift; + my %args = ( TicketObj => undef, @_ ); + my $queue = $args{'TicketObj'}->Queue; + my $rec = RT::ObjectScrip->new( $self->CurrentUser ); + $rec->LoadByCols( Scrip => $self->id, ObjectId => $queue ); + return $rec->Stage if $rec->id; + $rec->LoadByCols( Scrip => $self->id, ObjectId => 0 ); + return $rec->Stage if $rec->id; + + return undef; +} + +=head2 FriendlyStage($Stage) + +Helper function that returns a localized human-readable version of the +C<$Stage> argument. + +=cut + +sub FriendlyStage { + my ( $class, $stage ) = @_; + my $stage_i18n_lookup = { + TransactionCreate => 'Normal', # loc + TransactionBatch => 'Batch', # loc + TransactionBatchDisabled => 'Batch (disabled by config)', # loc + }; + $stage = 'TransactionBatchDisabled' + if $stage eq 'TransactionBatch' + and not RT->Config->Get('UseTransactionBatch'); + return $stage_i18n_lookup->{$stage}; +} =head2 Apply { TicketObj => undef, TransactionObj => undef} @@ -385,38 +564,46 @@ sub IsApplicable { my $return; eval { - my @Transactions; + my @Transactions; - if ( $self->Stage eq 'TransactionCreate') { - # Only look at our current Transaction - @Transactions = ( $args{'TransactionObj'} ); + my $stage = $self->Stage( TicketObj => $args{'TicketObj'} ); + unless ( $stage ) { + $RT::Logger->error( + "Scrip #". $self->id ." is not applied to" + ." queue #". $args{'TicketObj'}->Queue + ); + return (undef); } - elsif ( $self->Stage eq 'TransactionBatch') { - # Look at all Transactions in this Batch + elsif ( $stage eq 'TransactionCreate') { + # Only look at our current Transaction + @Transactions = ( $args{'TransactionObj'} ); + } + elsif ( $stage eq 'TransactionBatch') { + # Look at all Transactions in this Batch @Transactions = @{ $args{'TicketObj'}->TransactionBatch || [] }; } - else { - $RT::Logger->error( "Unknown Scrip stage:" . $self->Stage ); - return (undef); - } - my $ConditionObj = $self->ConditionObj; - foreach my $TransactionObj ( @Transactions ) { - # in TxnBatch stage we can select scrips that are not applicable to all txns - my $txn_type = $TransactionObj->Type; - next unless( $ConditionObj->ApplicableTransTypes =~ /(?:^|,)(?:Any|\Q$txn_type\E)(?:,|$)/i ); - # Load the scrip's Condition object - $ConditionObj->LoadCondition( - ScripObj => $self, - TicketObj => $args{'TicketObj'}, - TransactionObj => $TransactionObj, - ); + else { + $RT::Logger->error( "Unknown Scrip stage: '$stage'" ); + return (undef); + } + my $ConditionObj = $self->ConditionObj; + foreach my $TransactionObj ( @Transactions ) { + # in TxnBatch stage we can select scrips that are not applicable to all txns + my $txn_type = $TransactionObj->Type; + next unless( $ConditionObj->ApplicableTransTypes =~ /(?:^|,)(?:Any|\Q$txn_type\E)(?:,|$)/i ); + # Load the scrip's Condition object + $ConditionObj->LoadCondition( + ScripObj => $self, + TicketObj => $args{'TicketObj'}, + TransactionObj => $TransactionObj, + ); if ( $ConditionObj->IsApplicable() ) { - # We found an application Transaction -- return it + # We found an application Transaction -- return it $return = $TransactionObj; last; } - } + } }; if ($@) { @@ -444,9 +631,11 @@ sub Prepare { my $return; eval { - $self->ActionObj->LoadAction( ScripObj => $self, - TicketObj => $args{'TicketObj'}, - TransactionObj => $args{'TransactionObj'}, + $self->ActionObj->LoadAction( + ScripObj => $self, + TicketObj => $args{'TicketObj'}, + TransactionObj => $args{'TransactionObj'}, + TemplateObj => $self->TemplateObj( $args{'TicketObj'}->Queue ), ); $return = $self->ActionObj->Prepare(); @@ -508,8 +697,7 @@ sub _Set { ); unless ( $self->CurrentUserHasRight('ModifyScrips') ) { - $RT::Logger->debug( - "CurrentUser can't modify Scrips for " . $self->Queue . "\n" ); + $RT::Logger->debug( "CurrentUser can't modify Scrips" ); return ( 0, $self->loc('Permission Denied') ); } @@ -553,61 +741,22 @@ sub _Set { sub _Value { my $self = shift; - unless ( $self->CurrentUserHasRight('ShowScrips') ) { - $RT::Logger->debug( "CurrentUser can't modify Scrips for " - . $self->__Value('Queue') - . "\n" ); - return (undef); - } + return unless $self->CurrentUserHasRight('ShowScrips'); return $self->__Value(@_); } +=head2 ACLEquivalenceObjects - -=head2 CurrentUserHasRight - -Helper menthod for HasRight. Presets Principal to CurrentUser then -calls HasRight. - -=cut - -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - return ( $self->HasRight( Principal => $self->CurrentUser->UserObj, - Right => $right ) ); - -} - - - -=head2 HasRight - -Takes a param-hash consisting of "Right" and "Principal" Principal is -an RT::User object or an RT::CurrentUser object. "Right" is a textual -Right string that applies to Scrips. +Having rights on any of the queues the scrip applies to is equivalent to +having rights on the scrip. =cut -sub HasRight { +sub ACLEquivalenceObjects { my $self = shift; - my %args = ( Right => undef, - Principal => undef, - @_ ); - - if ( $self->SUPER::_Value('Queue') ) { - return $args{'Principal'}->HasRight( - Right => $args{'Right'}, - Object => $self->QueueObj - ); - } - else { - return $args{'Principal'}->HasRight( - Object => $RT::System, - Right => $args{'Right'}, - ); - } + return unless $self->id; + return @{ $self->AddedTo->ItemsArrayRef }; } @@ -699,7 +848,7 @@ sub SetTemplate { return ( 0, $self->loc( "Template '[_1]' not found", $value ) ) unless $template->Id; - return $self->_Set( Field => 'Template', Value => $template->Id ); + return $self->_Set( Field => 'Template', Value => $template->Name ); } 1; @@ -762,10 +911,10 @@ Returns the ScripCondition Object which has the id returned by ScripCondition =cut sub ScripConditionObj { - my $self = shift; - my $ScripCondition = RT::ScripCondition->new($self->CurrentUser); - $ScripCondition->Load($self->__Value('ScripCondition')); - return($ScripCondition); + my $self = shift; + my $ScripCondition = RT::ScripCondition->new($self->CurrentUser); + $ScripCondition->Load($self->__Value('ScripCondition')); + return($ScripCondition); } =head2 ScripAction @@ -794,48 +943,12 @@ Returns the ScripAction Object which has the id returned by ScripAction =cut sub ScripActionObj { - my $self = shift; - my $ScripAction = RT::ScripAction->new($self->CurrentUser); - $ScripAction->Load($self->__Value('ScripAction')); - return($ScripAction); + my $self = shift; + my $ScripAction = RT::ScripAction->new($self->CurrentUser); + $ScripAction->Load($self->__Value('ScripAction')); + return($ScripAction); } -=head2 ConditionRules - -Returns the current value of ConditionRules. -(In the database, ConditionRules is stored as text.) - - - -=head2 SetConditionRules VALUE - - -Set ConditionRules to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ConditionRules will be stored as a text.) - - -=cut - - -=head2 ActionRules - -Returns the current value of ActionRules. -(In the database, ActionRules is stored as text.) - - - -=head2 SetActionRules VALUE - - -Set ActionRules to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, ActionRules will be stored as a text.) - - -=cut - - =head2 CustomIsApplicableCode Returns the current value of CustomIsApplicableCode. @@ -890,37 +1003,19 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure. =cut -=head2 Stage - -Returns the current value of Stage. -(In the database, Stage is stored as varchar(32).) - - - -=head2 SetStage VALUE - - -Set Stage to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Stage will be stored as a varchar(32).) - - -=cut - - -=head2 Queue +=head2 Disabled -Returns the current value of Queue. -(In the database, Queue is stored as int(11).) +Returns the current value of Disabled. +(In the database, Disabled is stored as smallint(6).) -=head2 SetQueue VALUE +=head2 SetDisabled VALUE -Set Queue to VALUE. +Set Disabled to VALUE. Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Queue will be stored as a int(11).) +(In the database, Disabled will be stored as a smallint(6).) =cut @@ -929,7 +1024,7 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure. =head2 Template Returns the current value of Template. -(In the database, Template is stored as int(11).) +(In the database, Template is stored as varchar(200).) @@ -938,7 +1033,7 @@ Returns the current value of Template. Set Template to VALUE. Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Template will be stored as a int(11).) +(In the database, Template will be stored as a varchar(200).) =cut @@ -985,41 +1080,85 @@ 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 => ''}, 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 => ''}, ScripCondition => - {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'}, ScripAction => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - ConditionRules => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, - ActionRules => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, CustomIsApplicableCode => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, CustomPrepareCode => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, CustomCommitCode => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, - Stage => - {read => 1, write => 1, sql_type => 12, length => 32, is_blob => 0, is_numeric => 0, type => 'varchar(32)', default => ''}, - Queue => - {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 => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, + Disabled => + {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, Template => - {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 => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => 'Blank'}, 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); + + my $applied = RT::ObjectScrips->new( $self->CurrentUser ); + $applied->LimitToScrip( $self->id ); + $deps->Add( in => $applied ); + + $deps->Add( out => $self->ScripConditionObj ); + $deps->Add( out => $self->ScripActionObj ); + $deps->Add( out => $self->TemplateObj ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + + my $objs = RT::ObjectScrips->new( $self->CurrentUser ); + $objs->LimitToScrip( $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 ); +} + +sub Serialize { + my $self = shift; + my %args = (@_); + my %store = $self->SUPER::Serialize(@_); + + # Store the string, not a reference to the object + $store{Template} = $self->Template; + + return %store; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ScripAction.pm b/rt/lib/RT/ScripAction.pm index 5d84673..428ad5d 100755 --- a/rt/lib/RT/ScripAction.pm +++ b/rt/lib/RT/ScripAction.pm @@ -48,21 +48,13 @@ =head1 NAME - RT::ScripAction - RT Action object - -=head1 SYNOPSIS - - use RT::ScripAction; - +RT::ScripAction - RT Action object =head1 DESCRIPTION -This module should never be called directly by client code. it's an internal module which -should only be accessed through exported APIs in other modules. - - - -=head1 METHODS +This module should never be called directly by client code. it's an +internal module which should only be accessed through exported APIs +in other modules. =cut @@ -74,31 +66,32 @@ use warnings; use base 'RT::Record'; -sub Table {'ScripActions'} - +sub Table {'ScripActions'} use RT::Template; sub _Accessible { my $self = shift; - my %Cols = ( Name => 'read', - Description => 'read', - ExecModule => 'read', - Argument => 'read', - Creator => 'read/auto', - Created => 'read/auto', - LastUpdatedBy => 'read/auto', - LastUpdated => 'read/auto' - ); + my %Cols = ( + Name => 'read', + Description => 'read', + ExecModule => 'read', + Argument => 'read', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); return($self->SUPER::_Accessible(@_, %Cols)); } +=head1 METHODS + =head2 Create -Takes a hash. Creates a new Action entry. should be better -documented. +Takes a hash. Creates a new Action entry. =cut @@ -110,7 +103,6 @@ sub Create { sub Delete { my $self = shift; - return (0, "ScripAction->Delete not implemented"); } @@ -126,78 +118,86 @@ Returns: Id, Error Message sub Load { my $self = shift; my $identifier = shift; - + if (!$identifier) { - return (0, $self->loc('Input error')); - } - + return wantarray ? (0, $self->loc('Input error')) : 0; + } + my ($ok, $msg); if ($identifier !~ /\D/) { - ($ok, $msg) = $self->SUPER::Load($identifier); + ($ok, $msg) = $self->SUPER::Load($identifier); } else { - ($ok, $msg) = $self->LoadByCol('Name', $identifier); - + ($ok, $msg) = $self->LoadByCol('Name', $identifier); } if (@_) { - # Set the template Id to the passed in template - my $template = shift; - - $self->{'Template'} = $template; + RT->Deprecated( + Arguments => "Template as second argument", + Remove => "4.4", + ); + $self->{'Template'} = shift; } - return ($ok, $msg); + return wantarray ? ($ok, $msg) : $ok; } =head2 LoadAction HASH - Takes a hash consisting of TicketObj and TransactionObj. Loads an RT::Action:: module. +Takes a hash consisting of TicketObj and TransactionObj. Loads an RT::Action:: module. =cut sub LoadAction { my $self = shift; - my %args = ( TransactionObj => undef, - TicketObj => undef, - @_ ); + my %args = ( + TransactionObj => undef, + TicketObj => undef, + ScripObj => undef, + @_ + ); + + # XXX: this whole block goes with TemplateObj method + unless ( @_ && exists $args{'TemplateObj'} ) { + local $self->{_TicketObj} = $args{TicketObj}; + $args{'TemplateObj'} = $self->TemplateObj; + } + else { + $self->{'TemplateObj'} = $args{'TemplateObj'}; + } - $self->{_TicketObj} = $args{TicketObj}; - - #TODO: Put this in an eval $self->ExecModule =~ /^(\w+)$/; my $module = $1; my $type = "RT::Action::". $module; - - eval "require $type" || die "Require of $type failed.\n$@\n"; - - $self->{'Action'} = $type->new ( Argument => $self->Argument, - CurrentUser => $self->CurrentUser, - ScripActionObj => $self, - ScripObj => $args{'ScripObj'}, - TemplateObj => $self->TemplateObj, - TicketObj => $args{'TicketObj'}, - TransactionObj => $args{'TransactionObj'}, - ); -} + $type->require or die "Require of $type action module failed.\n$@\n"; -=head2 TemplateObj + return $self->{'Action'} = $type->new( + %args, + Argument => $self->Argument, + CurrentUser => $self->CurrentUser, + ScripActionObj => $self, + ); +} -Return this action's template object -TODO: Why are we not using the Scrip's template object? +=head2 TemplateObj +Return this action's template object. Deprecated. =cut sub TemplateObj { my $self = shift; - return undef unless $self->{Template}; + RT->Deprecated( + Remove => "4.4", + ); + if ( !$self->{'TemplateObj'} ) { + return undef unless $self->{Template}; $self->{'TemplateObj'} = RT::Template->new( $self->CurrentUser ); - $self->{'TemplateObj'}->LoadById( $self->{'Template'} ); + $self->{'TemplateObj'}->Load( $self->{'Template'} ); if ( ( $self->{'TemplateObj'}->__Value('Queue') == 0 ) && $self->{'_TicketObj'} ) { @@ -217,27 +217,20 @@ sub TemplateObj { return ( $self->{'TemplateObj'} ); } -# The following methods call the action object - - sub Prepare { my $self = shift; $self->{_Message_ID} = 0; - return ($self->Action->Prepare()); - + return $self->Action->Prepare( @_ ); } sub Commit { my $self = shift; - return($self->Action->Commit()); - - + return $self->Action->Commit( @_ ); } sub Describe { my $self = shift; - return ($self->Action->Describe()); - + return $self->Action->Describe( @_ ); } =head2 Action @@ -248,169 +241,142 @@ Return the actual RT::Action object for this scrip. sub Action { my $self = shift; - return ($self->{'Action'}); -} - -sub DESTROY { - my $self=shift; - $self->{'_TicketObj'} = undef; - $self->{'Action'} = undef; - $self->{'TemplateObj'} = undef; + return $self->{'Action'}; } -=head2 TODO - -Between this, RT::Scrip and RT::Action::*, we need to be able to get rid of a -class. This just reeks of too much complexity -- jesse - -=cut - - - - =head2 id Returns the current value of id. (In the database, id is stored as int(11).) -=cut - - =head2 Name Returns the current value of Name. (In the database, Name is stored as varchar(200).) - - =head2 SetName VALUE - Set Name to VALUE. Returns (1, 'Status message') on success and (0, 'Error Message') on failure. (In the database, Name will be stored as a varchar(200).) -=cut - - =head2 Description Returns the current value of Description. (In the database, Description is stored as varchar(255).) - - =head2 SetDescription VALUE - Set Description to VALUE. Returns (1, 'Status message') on success and (0, 'Error Message') on failure. (In the database, Description will be stored as a varchar(255).) -=cut - - =head2 ExecModule Returns the current value of ExecModule. (In the database, ExecModule is stored as varchar(60).) - - =head2 SetExecModule VALUE - Set ExecModule to VALUE. Returns (1, 'Status message') on success and (0, 'Error Message') on failure. (In the database, ExecModule will be stored as a varchar(60).) -=cut - - =head2 Argument Returns the current value of Argument. (In the database, Argument is stored as varbinary(255).) - - =head2 SetArgument VALUE - Set Argument to VALUE. Returns (1, 'Status message') on success and (0, 'Error Message') on failure. (In the database, Argument will be stored as a varbinary(255).) -=cut - - =head2 Creator Returns the current value of Creator. (In the database, Creator is stored as int(11).) - -=cut - - =head2 Created Returns the current value of Created. (In the database, Created is stored as datetime.) - -=cut - - =head2 LastUpdatedBy Returns the current value of LastUpdatedBy. (In the database, LastUpdatedBy is stored as int(11).) - -=cut - - =head2 LastUpdated Returns the current value of LastUpdated. (In the database, LastUpdated is stored as datetime.) - =cut - 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 => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', 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 => ''}, ExecModule => - {read => 1, write => 1, sql_type => 12, length => 60, is_blob => 0, is_numeric => 0, type => 'varchar(60)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 60, is_blob => 0, is_numeric => 0, type => 'varchar(60)', default => ''}, Argument => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varbinary(255)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varbinary(255)', 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 PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + $class->SUPER::PreInflate( $importer, $uid, $data ); + + return not $importer->SkipBy( "Name", $class, $uid, $data ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + +# Scrips + my $objs = RT::Scrips->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'ScripAction', VALUE => $self->Id ); + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $objs, + Shredder => $args{'Shredder'} + ); + + return $self->SUPER::__DependsOn( %args ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ScripActions.pm b/rt/lib/RT/ScripActions.pm index 2de5689..f663480 100755 --- a/rt/lib/RT/ScripActions.pm +++ b/rt/lib/RT/ScripActions.pm @@ -84,29 +84,19 @@ sub LimitToType { my $self = shift; my $type = shift; $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Type', - VALUE => "$type") + FIELD => 'Type', + VALUE => "$type") if defined $type; $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Type', - VALUE => "Correspond") + FIELD => 'Type', + VALUE => "Correspond") if $type eq "Create"; $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Type', - VALUE => 'any'); - -} - -=head2 NewItem - -Returns an empty new RT::ScripAction item + FIELD => 'Type', + VALUE => 'any'); -=cut - -sub NewItem { - my $self = shift; - return(RT::ScripAction->new($self->CurrentUser)); } + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ScripCondition.pm b/rt/lib/RT/ScripCondition.pm index e0eedf5..46110a9 100755 --- a/rt/lib/RT/ScripCondition.pm +++ b/rt/lib/RT/ScripCondition.pm @@ -75,28 +75,22 @@ use warnings; use base 'RT::Record'; -sub Table {'ScripConditions'} - +sub Table {'ScripConditions'} -sub _Init { - my $self = shift; - $self->{'table'} = "ScripConditions"; - return ($self->SUPER::_Init(@_)); -} sub _Accessible { my $self = shift; my %Cols = ( Name => 'read', - Description => 'read', - ApplicableTransTypes => 'read', - ExecModule => 'read', - Argument => 'read', - Creator => 'read/auto', - Created => 'read/auto', - LastUpdatedBy => 'read/auto', - LastUpdated => 'read/auto' - ); + Description => 'read', + ApplicableTransTypes => 'read', + ExecModule => 'read', + Argument => 'read', + Creator => 'read/auto', + Created => 'read/auto', + LastUpdatedBy => 'read/auto', + LastUpdated => 'read/auto' + ); return($self->SUPER::_Accessible(@_, %Cols)); } @@ -135,16 +129,16 @@ Loads a condition takes a name or ScripCondition id. sub Load { my $self = shift; my $identifier = shift; - + unless (defined $identifier) { - return (undef); - } - + return (undef); + } + if ($identifier !~ /\D/) { - return ($self->SUPER::LoadById($identifier)); + return ($self->SUPER::LoadById($identifier)); } else { - return ($self->LoadByCol('Name', $identifier)); + return ($self->LoadByCol('Name', $identifier)); } } @@ -160,24 +154,24 @@ Loads the Condition module in question. sub LoadCondition { my $self = shift; my %args = ( TransactionObj => undef, - TicketObj => undef, - @_ ); - - #TODO: Put this in an eval + TicketObj => undef, + @_ ); + + #TODO: Put this in an eval $self->ExecModule =~ /^(\w+)$/; my $module = $1; my $type = "RT::Condition::". $module; - - eval "require $type" || die "Require of $type failed.\n$@\n"; - - $self->{'Condition'} = $type->new ( 'ScripConditionObj' => $self, - 'TicketObj' => $args{'TicketObj'}, - 'ScripObj' => $args{'ScripObj'}, - 'TransactionObj' => $args{'TransactionObj'}, - 'Argument' => $self->Argument, - 'ApplicableTransTypes' => $self->ApplicableTransTypes, - CurrentUser => $self->CurrentUser - ); + + $type->require or die "Require of $type condition module failed.\n$@\n"; + + $self->{'Condition'} = $type->new ( 'ScripConditionObj' => $self, + 'TicketObj' => $args{'TicketObj'}, + 'ScripObj' => $args{'ScripObj'}, + 'TransactionObj' => $args{'TransactionObj'}, + 'Argument' => $self->Argument, + 'ApplicableTransTypes' => $self->ApplicableTransTypes, + CurrentUser => $self->CurrentUser + ); } @@ -209,16 +203,6 @@ sub IsApplicable { } -sub DESTROY { - my $self=shift; - $self->{'Condition'} = undef; -} - - - - - - =head2 id @@ -360,29 +344,60 @@ 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 => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', 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 => ''}, ExecModule => - {read => 1, write => 1, sql_type => 12, length => 60, is_blob => 0, is_numeric => 0, type => 'varchar(60)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 60, is_blob => 0, is_numeric => 0, type => 'varchar(60)', default => ''}, Argument => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varbinary(255)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varbinary(255)', default => ''}, ApplicableTransTypes => - {read => 1, write => 1, sql_type => 12, length => 60, is_blob => 0, is_numeric => 0, type => 'varchar(60)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 60, is_blob => 0, is_numeric => 0, type => 'varchar(60)', 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 PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + $class->SUPER::PreInflate( $importer, $uid, $data ); + + return not $importer->SkipBy( "Name", $class, $uid, $data ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + +# Scrips + my $objs = RT::Scrips->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'ScripCondition', VALUE => $self->Id ); + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $objs, + Shredder => $args{'Shredder'} + ); + + return $self->SUPER::__DependsOn( %args ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/ScripConditions.pm b/rt/lib/RT/ScripConditions.pm index 9555e22..dc97a16 100755 --- a/rt/lib/RT/ScripConditions.pm +++ b/rt/lib/RT/ScripConditions.pm @@ -70,41 +70,29 @@ package RT::ScripConditions; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::ScripCondition; -use base 'RT::SearchBuilder'; - sub Table { 'ScripConditions'} sub LimitToType { my $self = shift; my $type = shift; $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Type', - VALUE => "$type") + FIELD => 'Type', + VALUE => "$type") if defined $type; $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Type', - VALUE => "Correspond") + FIELD => 'Type', + VALUE => "Correspond") if $type eq "Create"; $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Type', - VALUE => 'any'); - -} - + FIELD => 'Type', + VALUE => 'any'); -=head2 NewItem - -Returns an empty new RT::ScripCondition item - -=cut - -sub NewItem { - my $self = shift; - return(RT::ScripCondition->new($self->CurrentUser)); } + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Scrips.pm b/rt/lib/RT/Scrips.pm index 4649885..85f1961 100755 --- a/rt/lib/RT/Scrips.pm +++ b/rt/lib/RT/Scrips.pm @@ -69,12 +69,20 @@ package RT::Scrips; use strict; use warnings; -use RT::Scrip; - use base 'RT::SearchBuilder'; +use RT::Scrip; +use RT::ObjectScrips; + sub Table { 'Scrips'} +sub _Init { + my $self = shift; + + $self->{'with_disabled_column'} = 1; + + return ( $self->SUPER::_Init(@_) ); +} =head2 LimitToQueue @@ -85,14 +93,17 @@ another call to this method =cut sub LimitToQueue { - my $self = shift; - my $queue = shift; - - $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Queue', - VALUE => "$queue") - if defined $queue; - + my $self = shift; + my $queue = shift; + return unless defined $queue; + + my $alias = RT::ObjectScrips->new( $self->CurrentUser ) + ->JoinTargetToThis( $self ); + $self->Limit( + ALIAS => $alias, + FIELD => 'ObjectId', + VALUE => int $queue, + ); } @@ -106,12 +117,125 @@ another call to this method or LimitToQueue sub LimitToGlobal { - my $self = shift; - - $self->Limit (ENTRYAGGREGATOR => 'OR', - FIELD => 'Queue', - VALUE => 0); - + my $self = shift; + return $self->LimitToQueue(0); +} + +sub LimitToAdded { + my $self = shift; + return RT::ObjectScrips->new( $self->CurrentUser ) + ->LimitTargetToAdded( $self => @_ ); +} + +sub LimitToNotAdded { + my $self = shift; + return RT::ObjectScrips->new( $self->CurrentUser ) + ->LimitTargetToNotAdded( $self => @_ ); +} + +sub LimitByStage { + my $self = shift; + my %args = @_%2? (Stage => @_) : @_; + return unless defined $args{'Stage'}; + + my $alias = RT::ObjectScrips->new( $self->CurrentUser ) + ->JoinTargetToThis( $self, %args ); + $self->Limit( + ALIAS => $alias, + FIELD => 'Stage', + VALUE => $args{'Stage'}, + ); +} + +=head2 LimitByTemplate + +Takes a L<RT::Template> object and limits scrips to those that +use the template. + +=cut + +sub LimitByTemplate { + my $self = shift; + my $template = shift; + + $self->Limit( FIELD => 'Template', VALUE => $template->Name ); + + if ( $template->Queue ) { + # if template is local then we are interested in global and + # queue specific scrips + $self->LimitToQueue( $template->Queue ); + $self->LimitToGlobal; + } + else { # template is global + + # if every queue has a custom version then there + # is no scrip that uses the template + { + my $queues = RT::Queues->new( RT->SystemUser ); + my $alias = $queues->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => 'Templates', + FIELD2 => 'Queue', + ); + $queues->Limit( + LEFTJOIN => $alias, + ALIAS => $alias, + FIELD => 'Name', + VALUE => $template->Name, + ); + $queues->Limit( + ALIAS => $alias, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + return $self->Limit( FIELD => 'id', VALUE => 0 ) + unless $queues->Count; + } + + # otherwise it's either a global scrip or application to + # a queue with custom version of the template. + my $os_alias = RT::ObjectScrips->new( $self->CurrentUser ) + ->JoinTargetToThis( $self ); + my $tmpl_alias = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $os_alias, + FIELD1 => 'ObjectId', + TABLE2 => 'Templates', + FIELD2 => 'Queue', + ); + $self->Limit( + LEFTJOIN => $tmpl_alias, ALIAS => $tmpl_alias, FIELD => 'Name', VALUE => $template->Name, + ); + $self->Limit( + LEFTJOIN => $tmpl_alias, ALIAS => $tmpl_alias, FIELD => 'Queue', OPERATOR => '!=', VALUE => 0, + ); + + $self->_OpenParen('UsedBy'); + $self->Limit( SUBCLAUSE => 'UsedBy', ALIAS => $os_alias, FIELD => 'ObjectId', VALUE => 0 ); + $self->Limit( + SUBCLAUSE => 'UsedBy', + ALIAS => $tmpl_alias, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + $self->_CloseParen('UsedBy'); + } +} + +sub ApplySortOrder { + my $self = shift; + my $order = shift || 'ASC'; + $self->OrderByCols( { + ALIAS => RT::ObjectScrips->new( $self->CurrentUser ) + ->JoinTargetToThis( $self => @_ ) + , + FIELD => 'SortOrder', + ORDER => $order, + } ); } =head2 AddRecord @@ -299,10 +423,8 @@ sub _SetupSourceObjects { =head2 _FindScrips -Find only the apropriate scrips for whatever we're doing now. Order them -by their description. (Most common use case is to prepend a number to the -description, forcing the scrips to display and run in ascending alphanumerical -order.) +Find only the appropriate scrips for whatever we're doing now. Order +them by the SortOrder field from the ObjectScrips table. =cut @@ -314,32 +436,27 @@ sub _FindScrips { @_ ); - $self->LimitToQueue( $self->{'TicketObj'}->QueueObj->Id ) - ; #Limit it to $Ticket->QueueObj->Id - $self->LimitToGlobal(); - # or to "global" - - $self->Limit( FIELD => "Stage", VALUE => $args{'Stage'} ); + $self->LimitToQueue( $self->{'TicketObj'}->QueueObj->Id ); + $self->LimitToGlobal; + $self->LimitByStage( $args{'Stage'} ); - my $ConditionsAlias = $self->NewAlias('ScripConditions'); - - $self->Join( + my $ConditionsAlias = $self->Join( ALIAS1 => 'main', FIELD1 => 'ScripCondition', - ALIAS2 => $ConditionsAlias, - FIELD2 => 'id' + TABLE2 => 'ScripConditions', + FIELD2 => 'id', ); #We only want things where the scrip applies to this sort of transaction # TransactionBatch stage can define list of transaction foreach( split /\s*,\s*/, ($args{'Type'} || '') ) { - $self->Limit( - ALIAS => $ConditionsAlias, - FIELD => 'ApplicableTransTypes', - OPERATOR => 'LIKE', - VALUE => $_, - ENTRYAGGREGATOR => 'OR', - ) + $self->Limit( + ALIAS => $ConditionsAlias, + FIELD => 'ApplicableTransTypes', + OPERATOR => 'LIKE', + VALUE => $_, + ENTRYAGGREGATOR => 'OR', + ) } # Or where the scrip applies to any transaction @@ -351,8 +468,7 @@ sub _FindScrips { ENTRYAGGREGATOR => 'OR', ); - # Promise some kind of ordering - $self->OrderBy( FIELD => 'Description' ); + $self->ApplySortOrder; # we call Count below, but later we always do search # so just do search and get count from results @@ -366,19 +482,6 @@ sub _FindScrips { ); } - - - -=head2 NewItem - -Returns an empty new RT::Scrip item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Scrip->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Search/ActiveTicketsInQueue.pm b/rt/lib/RT/Search/ActiveTicketsInQueue.pm index 8cb6d33..7a1f726 100644 --- a/rt/lib/RT/Search/ActiveTicketsInQueue.pm +++ b/rt/lib/RT/Search/ActiveTicketsInQueue.pm @@ -79,10 +79,7 @@ sub Prepare { my $self = shift; $self->TicketsObj->LimitQueue(VALUE => $self->Argument); - - foreach my $status (RT::Queue->ActiveStatusArray()) { - $self->TicketsObj->LimitStatus(VALUE => $status); - } + $self->TicketsObj->LimitToActiveStatus; return(1); } diff --git a/rt/lib/RT/Search/Googleish.pm b/rt/lib/RT/Search/Simple.pm index a688f58..4cb2482 100644 --- a/rt/lib/RT/Search/Googleish.pm +++ b/rt/lib/RT/Search/Simple.pm @@ -48,19 +48,19 @@ =head1 NAME - RT::Search::Googleish + RT::Search::Simple =head1 SYNOPSIS =head1 DESCRIPTION -Use the argument passed in as a "Google-style" set of keywords +Use the argument passed in as a simple set of keywords =head1 METHODS =cut -package RT::Search::Googleish; +package RT::Search::Simple; use strict; use warnings; @@ -71,6 +71,7 @@ use Regexp::Common qw/delimited/; # Only a subset of limit types AND themselves together. "queue:foo # queue:bar" is an OR, but "subject:foo subject:bar" is an AND our %AND = ( + default => 1, content => 1, subject => 1, ); @@ -173,6 +174,16 @@ sub Finalize { my $self = shift; my ($limits) = @_; + # Assume that numbers were actually "default"s if we have other limits + if ($limits->{id} and keys %{$limits} > 1) { + my $values = delete $limits->{id}; + for my $value (@{$values}) { + $value =~ /(\d+)/ or next; + my ($key, @tsql) = $self->HandleDefault($1); + push @{$limits->{$key}}, @tsql; + } + } + # Apply default "active status" limit if we don't have any status # limits ourselves, and we're not limited by id if (not $limits->{status} and not $limits->{id} @@ -194,7 +205,7 @@ sub Finalize { } our @GUESS = ( - [ 10 => sub { return "subject" if $_[1] } ], + [ 10 => sub { return "default" if $_[1] } ], [ 20 => sub { return "id" if /^#?\d+$/ } ], [ 30 => sub { return "requestor" if /\w+@\w+/} ], [ 35 => sub { return "domain" if /^@\w+/} ], @@ -231,7 +242,14 @@ sub GuessType { # $_[2] is a boolean of "was quoted by the user?" # ensure this is false before you do smart matching like $_[1] eq "me" # $_[3] is escaped subkey, if any (see HandleCf) -sub HandleDefault { return subject => "Subject LIKE '$_[1]'"; } +sub HandleDefault { + my $fts = RT->Config->Get('FullTextSearch'); + if ($fts->{Enable} and $fts->{Indexed}) { + return default => "Content LIKE '$_[1]'"; + } else { + return default => "Subject LIKE '$_[1]'"; + } +} sub HandleSubject { return subject => "Subject LIKE '$_[1]'"; } sub HandleFulltext { return content => "Content LIKE '$_[1]'"; } sub HandleContent { return content => "Content LIKE '$_[1]'"; } diff --git a/rt/lib/RT/SearchBuilder.pm b/rt/lib/RT/SearchBuilder.pm index bfc0cd3..44200b5 100644 --- a/rt/lib/RT/SearchBuilder.pm +++ b/rt/lib/RT/SearchBuilder.pm @@ -64,24 +64,26 @@ package RT::SearchBuilder; -use RT::Base; -use DBIx::SearchBuilder "1.50"; - use strict; use warnings; - +use 5.010; use base qw(DBIx::SearchBuilder RT::Base); +use RT::Base; +use DBIx::SearchBuilder "1.50"; + +use Scalar::Util qw/blessed/; + sub _Init { my $self = shift; $self->{'user'} = shift; unless(defined($self->CurrentUser)) { - use Carp; - Carp::confess("$self was created without a CurrentUser"); - $RT::Logger->err("$self was created without a CurrentUser"); - return(0); + use Carp; + Carp::confess("$self was created without a CurrentUser"); + $RT::Logger->err("$self was created without a CurrentUser"); + return(0); } $self->SUPER::_Init( 'Handle' => $RT::Handle); } @@ -96,6 +98,17 @@ sub CleanSlate { return $self->SUPER::CleanSlate(@_); } +sub Join { + my $self = shift; + my %args = @_; + + $args{'DISTINCT'} = 1 if + !exists $args{'DISTINCT'} + && $args{'TABLE2'} && lc($args{'FIELD2'}||'') eq 'id'; + + return $self->SUPER::Join( %args ); +} + sub JoinTransactions { my $self = shift; my %args = ( New => 0, @_ ); @@ -110,6 +123,7 @@ sub JoinTransactions { FIELD2 => 'ObjectId', ); + # NewItem is necessary here because of RT::Report::Tickets and RT::Report::Tickets::Entry my $item = $self->NewItem; my $object_type = $item->can('ObjectType') ? $item->ObjectType : ref $item; @@ -124,6 +138,40 @@ sub JoinTransactions { return $alias; } +sub _OrderByCF { + my $self = shift; + my ($row, $cfkey, $cf) = @_; + + $cfkey .= ".ordering" if !blessed($cf) || ($cf->MaxValues||0) != 1; + my ($ocfvs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cf ); + # this is described in _LimitCustomField + $self->Limit( + ALIAS => $CFs, + FIELD => 'Name', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'AND', + SUBCLAUSE => ".ordering", + ) if $CFs; + my $CFvs = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $ocfvs, + FIELD1 => 'CustomField', + TABLE2 => 'CustomFieldValues', + FIELD2 => 'CustomField', + ); + $self->Limit( + LEFTJOIN => $CFvs, + FIELD => 'Name', + QUOTEVALUE => 0, + VALUE => "$ocfvs.Content", + ENTRYAGGREGATOR => 'AND' + ); + + return { %$row, ALIAS => $CFvs, FIELD => 'SortOrder' }, + { %$row, ALIAS => $ocfvs, FIELD => 'Content' }; +} + sub OrderByCols { my $self = shift; my @sort; @@ -202,49 +250,604 @@ Takes a paramhash of key/value pairs with the following keys: sub _SingularClass { my $self = shift; - my $class = ref($self); + my $class = ref($self) || $self; $class =~ s/s$// or die "Cannot deduce SingularClass for $class"; return $class; } -sub LimitCustomField { +=head2 RecordClass + +Returns class name of records in this collection. This generic implementation +just strips trailing 's'. + +=cut + +sub RecordClass { + $_[0]->_SingularClass +} + +=head2 RegisterCustomFieldJoin + +Takes a pair of arguments, the first a class name and the second a callback +function. The class will be used to call +L<RT::Record/CustomFieldLookupType>. The callback will be called when +limiting a collection of the caller's class by a CF of the passed class's +lookup type. + +The callback is passed a single argument, the current collection object (C<$self>). + +An example from L<RT::Tickets>: + + __PACKAGE__->RegisterCustomFieldJoin( + "RT::Transaction" => sub { $_[0]->JoinTransactions } + ); + +Returns true on success, undef on failure. + +=cut + +sub RegisterCustomFieldJoin { + my $class = shift; + my ($type, $callback) = @_; + + $type = $type->CustomFieldLookupType if $type; + + die "Unknown LookupType '$type'" + unless $type and grep { $_ eq $type } RT::CustomField->LookupTypes; + + die "Custom field join callbacks must be CODE references" + unless ref($callback) eq 'CODE'; + + warn "Another custom field join callback is already registered for '$type'" + if $class->_JOINS_FOR_LOOKUP_TYPES->{$type}; + + # Stash the callback on ourselves + $class->_JOINS_FOR_LOOKUP_TYPES->{ $type } = $callback; + + return 1; +} + +=head2 _JoinForLookupType + +Takes an L<RT::CustomField> LookupType and joins this collection as +appropriate to reach the object records to which LookupType applies. The +object records will be of the class returned by +L<RT::CustomField/ObjectTypeFromLookupType>. + +Returns the join alias suitable for further limiting against object +properties. + +Returns undef on failure. + +Used by L</_CustomFieldJoin>. + +=cut + +sub _JoinForLookupType { my $self = shift; - my %args = ( VALUE => undef, - CUSTOMFIELD => undef, - OPERATOR => '=', - @_ ); + my $type = shift or return; - my $alias = $self->Join( - TYPE => 'left', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'ObjectCustomFieldValues', - FIELD2 => 'ObjectId' + # Convenience shortcut so that classes don't need to register a handler + # for their native lookup type + return "main" if $type eq $self->RecordClass->CustomFieldLookupType + and grep { $_ eq $type } RT::CustomField->LookupTypes; + + my $JOINS = $self->_JOINS_FOR_LOOKUP_TYPES; + return $JOINS->{$type}->($self) + if ref $JOINS->{$type} eq 'CODE'; + + return; +} + +sub _JOINS_FOR_LOOKUP_TYPES { + my $class = blessed($_[0]) || $_[0]; + state %JOINS; + return $JOINS{$class} ||= {}; +} + +=head2 _CustomFieldJoin + +Factor out the Join of custom fields so we can use it for sorting too + +=cut + +sub _CustomFieldJoin { + my ($self, $cfkey, $cf, $type) = @_; + $type ||= $self->RecordClass->CustomFieldLookupType; + + # Perform one Join per CustomField + if ( $self->{_sql_object_cfv_alias}{$cfkey} || + $self->{_sql_cf_alias}{$cfkey} ) + { + return ( $self->{_sql_object_cfv_alias}{$cfkey}, + $self->{_sql_cf_alias}{$cfkey} ); + } + + my $ObjectAlias = $self->_JoinForLookupType($type) + or die "We don't know how to join for LookupType $type"; + + my ($ocfvalias, $CFs); + if ( blessed($cf) ) { + $ocfvalias = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $ObjectAlias, + FIELD1 => 'id', + TABLE2 => 'ObjectCustomFieldValues', + FIELD2 => 'ObjectId', + $cf->SingleValue? (DISTINCT => 1) : (), + ); + $self->Limit( + LEFTJOIN => $ocfvalias, + FIELD => 'CustomField', + VALUE => $cf->id, + ENTRYAGGREGATOR => 'AND' + ); + } + else { + ($ocfvalias, $CFs) = $self->_CustomFieldJoinByName( $ObjectAlias, $cf, $type ); + $self->{_sql_cf_alias}{$cfkey} = $CFs; + $self->{_sql_object_cfv_alias}{$cfkey} = $ocfvalias; + } + $self->Limit( + LEFTJOIN => $ocfvalias, + FIELD => 'ObjectType', + VALUE => RT::CustomField->ObjectTypeFromLookupType($type), + ENTRYAGGREGATOR => 'AND' ); $self->Limit( - ALIAS => $alias, - FIELD => 'CustomField', - OPERATOR => '=', - VALUE => $args{'CUSTOMFIELD'}, - ) if ($args{'CUSTOMFIELD'}); + LEFTJOIN => $ocfvalias, + FIELD => 'Disabled', + OPERATOR => '=', + VALUE => '0', + ENTRYAGGREGATOR => 'AND' + ); + + return ($ocfvalias, $CFs); +} + +sub _CustomFieldJoinByName { + my $self = shift; + my ($ObjectAlias, $cf, $type) = @_; + my $ocfalias = $self->Join( + TYPE => 'LEFT', + EXPRESSION => q|'0'|, + TABLE2 => 'ObjectCustomFields', + FIELD2 => 'ObjectId', + ); + + my $CFs = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $ocfalias, + FIELD1 => 'CustomField', + TABLE2 => 'CustomFields', + FIELD2 => 'id', + ); $self->Limit( - ALIAS => $alias, - FIELD => 'ObjectType', - OPERATOR => '=', - VALUE => $self->_SingularClass, + LEFTJOIN => $CFs, + ENTRYAGGREGATOR => 'AND', + FIELD => 'LookupType', + VALUE => $type, ); $self->Limit( - ALIAS => $alias, - FIELD => 'Content', - OPERATOR => $args{'OPERATOR'}, - VALUE => $args{'VALUE'}, + LEFTJOIN => $CFs, + ENTRYAGGREGATOR => 'AND', + FIELD => 'Name', + CASESENSITIVE => 0, + VALUE => $cf, + ); + + my $ocfvalias = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $CFs, + FIELD1 => 'id', + TABLE2 => 'ObjectCustomFieldValues', + FIELD2 => 'CustomField', ); $self->Limit( - ALIAS => $alias, - FIELD => 'Disabled', - OPERATOR => '=', - VALUE => 0, + LEFTJOIN => $ocfvalias, + FIELD => 'ObjectId', + VALUE => "$ObjectAlias.id", + QUOTEVALUE => 0, + ENTRYAGGREGATOR => 'AND', ); + + return ($ocfvalias, $CFs, $ocfalias); +} + +sub LimitCustomField { + my $self = shift; + return $self->_LimitCustomField( @_ ); +} + +use Regexp::Common qw(RE_net_IPv4); +use Regexp::Common::net::CIDR; + +sub _LimitCustomField { + my $self = shift; + my %args = ( VALUE => undef, + CUSTOMFIELD => undef, + OPERATOR => '=', + KEY => undef, + PREPARSE => 1, + @_ ); + + my $op = delete $args{OPERATOR}; + my $value = delete $args{VALUE}; + my $ltype = delete $args{LOOKUPTYPE} || $self->RecordClass->CustomFieldLookupType; + my $cf = delete $args{CUSTOMFIELD}; + my $column = delete $args{COLUMN}; + my $cfkey = delete $args{KEY}; + if (blessed($cf) and $cf->id) { + $cfkey ||= $cf->id; + } elsif ($cf =~ /^\d+$/) { + # Intentionally load as the system user, so we can build better + # queries; this is necessary as we don't have a context object + # which might grant the user rights to see the CF. This object + # is only used to inspect the properties of the CF itself. + my $obj = RT::CustomField->new( RT->SystemUser ); + $obj->Load($cf); + if ($obj->id) { + $cf = $obj; + $cfkey ||= $cf->id; + } else { + $cfkey ||= "$ltype-$cf"; + } + } else { + $cfkey ||= "$ltype-$cf"; + } + + $args{SUBCLAUSE} ||= "cf-$cfkey"; + + + my $fix_op = sub { + return @_ unless RT->Config->Get('DatabaseType') eq 'Oracle'; + + my %args = @_; + return %args unless $args{'FIELD'} eq 'LargeContent'; + + my $op = $args{'OPERATOR'}; + if ( $op eq '=' ) { + $args{'OPERATOR'} = 'MATCHES'; + } + elsif ( $op eq '!=' ) { + $args{'OPERATOR'} = 'NOT MATCHES'; + } + elsif ( $op =~ /^[<>]=?$/ ) { + $args{'FUNCTION'} = "TO_CHAR( $args{'ALIAS'}.LargeContent )"; + } + return %args; + }; + + # Special Limit (we can exit early) + # IS NULL and IS NOT NULL checks + if ( $op =~ /^IS( NOT)?$/i ) { + my ($ocfvalias, $CFs) = $self->_CustomFieldJoin( $cfkey, $cf, $ltype ); + $self->_OpenParen( $args{SUBCLAUSE} ); + $self->Limit( + %args, + ALIAS => $ocfvalias, + FIELD => ($column || 'id'), + OPERATOR => $op, + VALUE => $value, + ); + # See below for an explanation of this limit + $self->Limit( + ALIAS => $CFs, + FIELD => 'Name', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'AND', + SUBCLAUSE => $args{SUBCLAUSE}, + ) if $CFs; + $self->_CloseParen( $args{SUBCLAUSE} ); + return; + } + + ########## Content pre-parsing if we know things about the CF + if ( blessed($cf) and delete $args{PREPARSE} ) { + my $type = $cf->Type; + if ( $type eq 'IPAddress' ) { + my $parsed = RT::ObjectCustomFieldValue->ParseIP($value); + if ($parsed) { + $value = $parsed; + } else { + $RT::Logger->warn("$value is not a valid IPAddress"); + } + } elsif ( $type eq 'IPAddressRange' ) { + my ( $start_ip, $end_ip ) = + RT::ObjectCustomFieldValue->ParseIPRange($value); + if ( $start_ip && $end_ip ) { + if ( $op =~ /^<=?$/ ) { + $value = $start_ip; + } elsif ($op =~ /^>=?$/ ) { + $value = $end_ip; + } else { + $value = join '-', $start_ip, $end_ip; + } + } else { + $RT::Logger->warn("$value is not a valid IPAddressRange"); + } + + # Recurse if they want a range comparison + if ( $op !~ /^[<>]=?$/ ) { + my ($start_ip, $end_ip) = split /-/, $value; + $self->_OpenParen( $args{SUBCLAUSE} ); + # Ideally we would limit >= 000.000.000.000 and <= + # 255.255.255.255 so DB optimizers could use better + # estimations and scan less rows, but this breaks with IPv6. + if ( $op !~ /NOT|!=|<>/i ) { # positive equation + $self->_LimitCustomField( + %args, + OPERATOR => '<=', + VALUE => $end_ip, + LOOKUPTYPE => $ltype, + CUSTOMFIELD => $cf, + COLUMN => 'Content', + PREPARSE => 0, + ); + $self->_LimitCustomField( + %args, + OPERATOR => '>=', + VALUE => $start_ip, + LOOKUPTYPE => $ltype, + CUSTOMFIELD => $cf, + COLUMN => 'LargeContent', + ENTRYAGGREGATOR => 'AND', + PREPARSE => 0, + ); + } else { # negative equation + $self->_LimitCustomField( + %args, + OPERATOR => '>', + VALUE => $end_ip, + LOOKUPTYPE => $ltype, + CUSTOMFIELD => $cf, + COLUMN => 'Content', + PREPARSE => 0, + ); + $self->_LimitCustomField( + %args, + OPERATOR => '<', + VALUE => $start_ip, + LOOKUPTYPE => $ltype, + CUSTOMFIELD => $cf, + COLUMN => 'LargeContent', + ENTRYAGGREGATOR => 'OR', + PREPARSE => 0, + ); + } + $self->_CloseParen( $args{SUBCLAUSE} ); + return; + } + } elsif ( $type =~ /^Date(?:Time)?$/ ) { + my $date = RT::Date->new( $self->CurrentUser ); + $date->Set( Format => 'unknown', Value => $value ); + if ( $date->IsSet ) { + if ( + $type eq 'Date' + # Heuristics to determine if a date, and not + # a datetime, was entered: + || $value =~ /^\s*(?:today|tomorrow|yesterday)\s*$/i + || ( $value !~ /midnight|\d+:\d+:\d+/i + && $date->Time( Timezone => 'user' ) eq '00:00:00' ) + ) + { + $value = $date->Date( Timezone => 'user' ); + } else { + $value = $date->DateTime; + } + } else { + $RT::Logger->warn("$value is not a valid date string"); + } + + # Recurse if day equality is being checked on a datetime + if ( $type eq 'DateTime' and $op eq '=' && $value !~ /:/ ) { + my $date = RT::Date->new( $self->CurrentUser ); + $date->Set( Format => 'unknown', Value => $value ); + my $daystart = $date->ISO; + $date->AddDay; + my $dayend = $date->ISO; + + $self->_OpenParen( $args{SUBCLAUSE} ); + $self->_LimitCustomField( + %args, + OPERATOR => ">=", + VALUE => $daystart, + LOOKUPTYPE => $ltype, + CUSTOMFIELD => $cf, + COLUMN => 'Content', + ENTRYAGGREGATOR => 'AND', + PREPARSE => 0, + ); + + $self->_LimitCustomField( + %args, + OPERATOR => "<", + VALUE => $dayend, + LOOKUPTYPE => $ltype, + CUSTOMFIELD => $cf, + COLUMN => 'Content', + ENTRYAGGREGATOR => 'AND', + PREPARSE => 0, + ); + $self->_CloseParen( $args{SUBCLAUSE} ); + return; + } + } + } + + ########## Limits + + my $single_value = !blessed($cf) || $cf->SingleValue; + my $negative_op = ($op eq '!=' || $op =~ /\bNOT\b/i); + my $value_is_long = (length( Encode::encode( "UTF-8", $value)) > 255) ? 1 : 0; + + $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++ + if not $single_value and $op =~ /^(!?=|(NOT )?LIKE)$/i; + my ($ocfvalias, $CFs) = $self->_CustomFieldJoin( $cfkey, $cf, $ltype ); + + # A negative limit on a multi-value CF means _none_ of the values + # are the given value + if ( $negative_op and not $single_value ) { + # Reverse the limit we apply to the join, and check IS NULL + $op =~ s/!|NOT\s+//i; + + # Ideally we would check both Content and LargeContent here, as + # the positive searches do below -- however, we cannot place + # complex limits inside LEFTJOINs due to searchbuilder + # limitations. Guessing which to check based on the value's + # string length is sufficient for !=, but sadly insufficient for + # NOT LIKE checks, giving false positives. + $column ||= $value_is_long ? 'LargeContent' : 'Content'; + $self->Limit( $fix_op->( + LEFTJOIN => $ocfvalias, + ALIAS => $ocfvalias, + FIELD => $column, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ) ); + $self->Limit( + %args, + ALIAS => $ocfvalias, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + return; + } + + # If column is defined, then we just search it that, with no magic + if ( $column ) { + $self->_OpenParen( $args{SUBCLAUSE} ); + $self->Limit( $fix_op->( + %args, + ALIAS => $ocfvalias, + FIELD => $column, + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ) ); + $self->Limit( + ALIAS => $ocfvalias, + FIELD => $column, + OPERATOR => 'IS', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'OR', + SUBCLAUSE => $args{SUBCLAUSE}, + ) if $negative_op; + $self->_CloseParen( $args{SUBCLAUSE} ); + return; + } + + $self->_OpenParen( $args{SUBCLAUSE} ); # For negative_op "OR it is null" clause + $self->_OpenParen( $args{SUBCLAUSE} ); # NAME IS NOT NULL clause + + $self->_OpenParen( $args{SUBCLAUSE} ); # Check Content / LargeContent + if ($value_is_long and $op eq "=") { + # Doesn't matter what Content contains, as it cannot match the + # too-long value; we just look in LargeContent, below. + } elsif ($value_is_long and $op =~ /^(!=|<>)$/) { + # If Content is non-null, that's a valid way to _not_ contain the too-long value. + $self->Limit( + %args, + ALIAS => $ocfvalias, + FIELD => 'Content', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + } else { + # Otherwise, go looking at the Content + $self->Limit( + %args, + ALIAS => $ocfvalias, + FIELD => 'Content', + OPERATOR => $op, + VALUE => $value, + CASESENSITIVE => 0, + ); + } + + if (!$value_is_long and $op eq "=") { + # Doesn't matter what LargeContent contains, as it cannot match + # the short value. + } elsif (!$value_is_long and $op =~ /^(!=|<>)$/) { + # If LargeContent is non-null, that's a valid way to _not_ + # contain the too-short value. + $self->Limit( + %args, + ALIAS => $ocfvalias, + FIELD => 'LargeContent', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'OR', + ); + } else { + $self->_OpenParen( $args{SUBCLAUSE} ); # LargeContent check + $self->_OpenParen( $args{SUBCLAUSE} ); # Content is null? + $self->Limit( + ALIAS => $ocfvalias, + FIELD => 'Content', + OPERATOR => '=', + VALUE => '', + ENTRYAGGREGATOR => 'OR', + SUBCLAUSE => $args{SUBCLAUSE}, + ); + $self->Limit( + ALIAS => $ocfvalias, + FIELD => 'Content', + OPERATOR => 'IS', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'OR', + SUBCLAUSE => $args{SUBCLAUSE}, + ); + $self->_CloseParen( $args{SUBCLAUSE} ); # Content is null? + $self->Limit( $fix_op->( + ALIAS => $ocfvalias, + FIELD => 'LargeContent', + OPERATOR => $op, + VALUE => $value, + ENTRYAGGREGATOR => 'AND', + SUBCLAUSE => $args{SUBCLAUSE}, + CASESENSITIVE => 0, + ) ); + $self->_CloseParen( $args{SUBCLAUSE} ); # LargeContent check + } + + $self->_CloseParen( $args{SUBCLAUSE} ); # Check Content/LargeContent + + # XXX: if we join via CustomFields table then + # because of order of left joins we get NULLs in + # CF table and then get nulls for those records + # in OCFVs table what result in wrong results + # as decifer method now tries to load a CF then + # we fall into this situation only when there + # are more than one CF with the name in the DB. + # the same thing applies to order by call. + # TODO: reorder joins T <- OCFVs <- CFs <- OCFs if + # we want treat IS NULL as (not applies or has + # no value) + $self->Limit( + ALIAS => $CFs, + FIELD => 'Name', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'AND', + SUBCLAUSE => $args{SUBCLAUSE}, + ) if $CFs; + $self->_CloseParen( $args{SUBCLAUSE} ); # Name IS NOT NULL clause + + # If we were looking for != or NOT LIKE, we need to include the + # possibility that the row had no value. + $self->Limit( + ALIAS => $ocfvalias, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'OR', + SUBCLAUSE => $args{SUBCLAUSE}, + ) if $negative_op; + $self->_CloseParen( $args{SUBCLAUSE} ); # negative_op clause } =head2 Limit PARAMHASH @@ -259,10 +862,23 @@ injection attacks when we pass through user specified values. =cut +my %check_case_sensitivity = ( + groups => { 'name' => 1, domain => 1 }, + queues => { 'name' => 1 }, + users => { 'name' => 1, emailaddress => 1 }, + customfields => { 'name' => 1 }, +); + +my %deprecated = ( + groups => { + type => 'Name', + }, + principals => { objectid => 'id' }, +); + sub Limit { my $self = shift; my %ARGS = ( - CASESENSITIVE => 1, OPERATOR => '=', @_, ); @@ -274,27 +890,50 @@ sub Limit { $ARGS{'VALUE'} = 'NULL'; } - if ($ARGS{FUNCTION}) { - ($ARGS{ALIAS}, $ARGS{FIELD}) = split /\./, delete $ARGS{FUNCTION}, 2; - $self->SUPER::Limit(%ARGS); - } elsif ($ARGS{FIELD} =~ /\W/ + if (($ARGS{FIELD}||'') =~ /\W/ or $ARGS{OPERATOR} !~ /^(=|<|>|!=|<>|<=|>= |(NOT\s*)?LIKE |(NOT\s*)?(STARTS|ENDS)WITH |(NOT\s*)?MATCHES |IS(\s*NOT)? |(NOT\s*)?IN - |\@\@)$/ix) { + |\@\@ + |AGAINST)$/ix) { $RT::Logger->crit("Possible SQL injection attack: $ARGS{FIELD} $ARGS{OPERATOR}"); - $self->SUPER::Limit( + %ARGS = ( %ARGS, FIELD => 'id', OPERATOR => '<', VALUE => '0', ); - } else { - $self->SUPER::Limit(%ARGS); } + + my $table; + ($table) = $ARGS{'ALIAS'} && $ARGS{'ALIAS'} ne 'main' + ? ($ARGS{'ALIAS'} =~ /^(.*)_\d+$/) + : $self->Table + ; + + if ( $table and $ARGS{FIELD} and my $instead = $deprecated{ lc $table }{ lc $ARGS{'FIELD'} } ) { + RT->Deprecated( + Message => "$table.$ARGS{'FIELD'} column is deprecated", + Instead => $instead, Remove => '4.4' + ); + } + + unless ( exists $ARGS{CASESENSITIVE} or (exists $ARGS{QUOTEVALUE} and not $ARGS{QUOTEVALUE}) ) { + if ( $ARGS{FIELD} and $ARGS{'OPERATOR'} !~ /IS/i + && $table && $check_case_sensitivity{ lc $table }{ lc $ARGS{'FIELD'} } + ) { + RT->Logger->warning( + "Case sensitive search by $table.$ARGS{'FIELD'}" + ." at ". (caller)[1] . " line ". (caller)[2] + ); + } + $ARGS{'CASESENSITIVE'} = 1; + } + + return $self->SUPER::Limit( %ARGS ); } =head2 ItemsOrderBy @@ -310,10 +949,10 @@ sub ItemsOrderBy { my $self = shift; my $items = shift; - if ($self->NewItem()->_Accessible('SortOrder','read')) { + if ($self->RecordClass->_Accessible('SortOrder','read')) { $items = [ sort { $a->SortOrder <=> $b->SortOrder } @{$items} ]; } - elsif ($self->NewItem()->_Accessible('Name','read')) { + elsif ($self->RecordClass->_Accessible('Name','read')) { $items = [ sort { lc($a->Name) cmp lc($b->Name) } @{$items} ]; } @@ -367,13 +1006,47 @@ algorithm that this code uses. =cut sub ColumnMapClassName { - my $self = shift; - my $Class = ref $self; - $Class =~ s/s$//; - $Class =~ s/:/_/g; + my $self = shift; + my $Class = $self->_SingularClass; + $Class =~ s/:/_/g; return $Class; } +=head2 NewItem + +Returns a new item based on L</RecordClass> using the current user. + +=cut + +sub NewItem { + my $self = shift; + return $self->RecordClass->new($self->CurrentUser); +} + +=head2 NotSetDateToNullFunction + +Takes a paramhash with an optional FIELD key whose value is the name of a date +column. If no FIELD is provided, a literal C<?> placeholder is used so the +caller can fill in the field later. + +Returns a SQL function which evaluates to C<NULL> if the FIELD is set to the +Unix epoch; otherwise it evaluates to FIELD. This is useful because RT +currently stores unset dates as a Unix epoch timestamp instead of NULL, but +NULLs are often more desireable. + +=cut + +sub NotSetDateToNullFunction { + my $self = shift; + my %args = ( FIELD => undef, @_ ); + + my $res = "CASE WHEN ? BETWEEN '1969-12-31 11:59:59' AND '1970-01-01 12:00:01' THEN NULL ELSE ? END"; + if ( $args{FIELD} ) { + $res = $self->CombineFunctionWithField( %args, FUNCTION => $res ); + } + return $res; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/SearchBuilder/AddAndSort.pm b/rt/lib/RT/SearchBuilder/AddAndSort.pm new file mode 100644 index 0000000..abe8aa6 --- /dev/null +++ b/rt/lib/RT/SearchBuilder/AddAndSort.pm @@ -0,0 +1,219 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::SearchBuilder::AddAndSort; +use base 'RT::SearchBuilder'; + +=head1 NAME + +RT::SearchBuilder::AddAndSort - base class for 'add and sort' collections + +=head1 DESCRIPTION + +Base class for collections where records can be added to objects with order. +See also L<RT::Record::AddAndSort>. Used by L<RT::ObjectScrips> and +L<RT::ObjectCustomFields>. + +As it's about sorting then collection is sorted by SortOrder field. + +=head1 METHODS + +=cut + +sub _Init { + my $self = shift; + + # By default, order by SortOrder + $self->OrderByCols( + { ALIAS => 'main', + FIELD => 'SortOrder', + ORDER => 'ASC' }, + { ALIAS => 'main', + FIELD => 'id', + ORDER => 'ASC' }, + ); + + return $self->SUPER::_Init(@_); +} + +=head2 LimitToObjectId + +Takes id of an object and limits collection. + +=cut + +sub LimitToObjectId { + my $self = shift; + my $id = shift || 0; + $self->Limit( FIELD => 'ObjectId', VALUE => $id ); +} + +=head1 METHODS FOR TARGETS + +Rather than implementing a base class for targets (L<RT::Scrip>, +L<RT::CustomField>) and its collections. This class provides +class methods to limit target collections. + +=head2 LimitTargetToNotAdded + +Takes a collection object and optional list of object ids. Limits the +collection to records not added to listed objects or if the list is +empty then any object. Use 0 (zero) to mean global. + +=cut + +sub LimitTargetToNotAdded { + my $self = shift; + my $collection = shift; + my @ids = @_; + + my $alias = $self->JoinTargetToAdded($collection => @ids); + + $collection->Limit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $alias, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + return $alias; +} + +=head2 LimitTargetToAdded + +L</LimitTargetToNotAdded> with reverse meaning. Takes the same +arguments. + +=cut + +sub LimitTargetToAdded { + my $self = shift; + my $collection = shift; + my @ids = @_; + + my $alias = $self->JoinTargetToAdded($collection => @ids); + + $collection->Limit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $alias, + FIELD => 'id', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + return $alias; +} + +=head2 JoinTargetToAdded + +Joins collection to this table using left join, limits joined table +by ids if those are provided. + +Returns alias of the joined table. Join is cached and re-used for +multiple calls. + +=cut + +sub JoinTargetToAdded { + my $self = shift; + my $collection = shift; + my @ids = @_; + + my $alias = $self->JoinTargetToThis( $collection, New => 0, Left => 1 ); + return $alias unless @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; + $collection->Limit( + LEFTJOIN => $alias, + ALIAS => $alias, + FIELD => 'ObjectId', + OPERATOR => 'IN', + VALUE => [ @ids ], + ); + + return $alias; +} + +=head2 JoinTargetToThis + +Joins target collection to this table using TargetField. + +Takes New and Left arguments. Use New to avoid caching and re-using +this join. Use Left to create LEFT JOIN rather than inner. + +=cut + +sub JoinTargetToThis { + my $self = shift; + my $collection = shift; + my %args = ( New => 0, Left => 0, Distinct => 0, @_ ); + + my $table = $self->Table; + my $key = "_sql_${table}_alias"; + + return $collection->{ $key } if $collection->{ $key } && !$args{'New'}; + + my $alias = $collection->Join( + $args{'Left'} ? (TYPE => 'LEFT') : (), + ALIAS1 => 'main', + FIELD1 => 'id', + TABLE2 => $table, + FIELD2 => $self->RecordClass->TargetField, + DISTINCT => $args{Distinct}, + ); + return $alias if $args{'New'}; + return $collection->{ $key } = $alias; +} + +RT::Base->_ImportOverlays(); + +1; diff --git a/rt/lib/RT/SearchBuilder/Role.pm b/rt/lib/RT/SearchBuilder/Role.pm new file mode 100644 index 0000000..ec20de2 --- /dev/null +++ b/rt/lib/RT/SearchBuilder/Role.pm @@ -0,0 +1,77 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::SearchBuilder::Role; +use Role::Basic; + +=head1 NAME + +RT::SearchBuilder::Role - Common requirements for roles which are consumed by collections + +=head1 DESCRIPTION + +Various L<RT::SearchBuilder> (and by inheritance L<DBIx::SearchBuilder>) +methods are required by this role. It provides no methods on its own but is +simply a contract for other roles to require (usually under the +I<RT::SearchBuilder::Role::> namespace). + +=cut + +requires $_ for qw( + Join + Limit + NewItem + CurrentUser + _OpenParen + _CloseParen +); + +1; diff --git a/rt/lib/RT/SearchBuilder/Role/Roles.pm b/rt/lib/RT/SearchBuilder/Role/Roles.pm new file mode 100644 index 0000000..914c74b --- /dev/null +++ b/rt/lib/RT/SearchBuilder/Role/Roles.pm @@ -0,0 +1,399 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::SearchBuilder::Role::Roles; +use Role::Basic; +use Scalar::Util qw(blessed); + +=head1 NAME + +RT::Record::Role::Roles - Common methods for records which "watchers" or "roles" + +=head1 REQUIRES + +=head2 L<RT::SearchBuilder::Role> + +=cut + +with 'RT::SearchBuilder::Role'; + +require RT::System; +require RT::Principal; +require RT::Group; +require RT::User; + +require RT::EmailParser; + +=head1 PROVIDES + +=head2 _RoleGroupClass + +Returns the class name on which role searches should be based. This relates to +the internal L<RT::Group/Domain> and distinguishes between roles on the objects +being searched and their counterpart roles on containing classes. For example, +limiting on L<RT::Queue> roles while searching for L<RT::Ticket>s. + +The default implementation is: + + $self->RecordClass + +which is the class that this collection object searches and instatiates objects +for. If you're doing something hinky, you may need to override this method. + +=cut + +sub _RoleGroupClass { + my $self = shift; + return $self->RecordClass; +} + +sub _RoleGroupsJoin { + my $self = shift; + my %args = (New => 0, Class => '', Name => '', @_); + + $args{'Class'} ||= $self->_RoleGroupClass; + + my $name = $args{'Name'}; + if ( exists $args{'Type'} ) { + RT->Deprecated( Arguments => 'Type', Instead => 'Name', Remove => '4.4' ); + $name = $args{'Type'}; + } + + return $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $name } + if $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $name } + && !$args{'New'}; + + # If we're looking at a role group on a class that "contains" this record + # (i.e. roles on queues for tickets), then we assume that the current + # record has a column named after the containing class (i.e. + # Tickets.Queue). + my $instance = $self->_RoleGroupClass eq $args{Class} ? "id" : $args{Class}; + $instance =~ s/^RT:://; + + # Watcher groups are always created for each record, so we use INNER join. + my $groups = $self->Join( + ALIAS1 => 'main', + FIELD1 => $instance, + TABLE2 => 'Groups', + FIELD2 => 'Instance', + ENTRYAGGREGATOR => 'AND', + DISTINCT => !!$args{'Type'}, + ); + $self->Limit( + LEFTJOIN => $groups, + ALIAS => $groups, + FIELD => 'Domain', + VALUE => $args{'Class'} .'-Role', + CASESENSITIVE => 0, + ); + $self->Limit( + LEFTJOIN => $groups, + ALIAS => $groups, + FIELD => 'Name', + VALUE => $name, + CASESENSITIVE => 0, + ) if $name; + + $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $name } = $groups + unless $args{'New'}; + + return $groups; +} + +sub _GroupMembersJoin { + my $self = shift; + my %args = (New => 1, GroupsAlias => undef, Left => 1, @_); + + return $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } + if $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } + && !$args{'New'}; + + my $alias = $self->Join( + $args{'Left'} ? (TYPE => 'LEFT') : (), + ALIAS1 => $args{'GroupsAlias'}, + FIELD1 => 'id', + TABLE2 => 'CachedGroupMembers', + FIELD2 => 'GroupId', + ENTRYAGGREGATOR => 'AND', + ); + $self->Limit( + LEFTJOIN => $alias, + ALIAS => $alias, + FIELD => 'Disabled', + VALUE => 0, + ); + + $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } = $alias + unless $args{'New'}; + + return $alias; +} + +=head2 _WatcherJoin + +Helper function which provides joins to a watchers table both for limits +and for ordering. + +=cut + +sub _WatcherJoin { + my $self = shift; + + my $groups = $self->_RoleGroupsJoin(@_); + my $group_members = $self->_GroupMembersJoin( GroupsAlias => $groups ); + # XXX: work around, we must hide groups that + # are members of the role group we search in, + # otherwise them result in wrong NULLs in Users + # table and break ordering. Now, we know that + # RT doesn't allow to add groups as members of the + # ticket roles, so we just hide entries in CGM table + # with MemberId == GroupId from results + $self->Limit( + LEFTJOIN => $group_members, + FIELD => 'GroupId', + OPERATOR => '!=', + VALUE => "$group_members.MemberId", + QUOTEVALUE => 0, + ); + my $users = $self->Join( + TYPE => 'LEFT', + ALIAS1 => $group_members, + FIELD1 => 'MemberId', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + return ($groups, $group_members, $users); +} + + +sub RoleLimit { + my $self = shift; + my %args = ( + TYPE => '', + CLASS => '', + FIELD => undef, + OPERATOR => '=', + VALUE => undef, + @_ + ); + + my $class = $args{CLASS} || $self->_RoleGroupClass; + + $args{FIELD} ||= 'id' if $args{VALUE} =~ /^\d+$/; + + my $type = delete $args{TYPE}; + if ($type and not $class->HasRole($type)) { + RT->Logger->warn("RoleLimit called with invalid role $type for $class"); + return; + } + + my $column = $type ? $class->Role($type)->{Column} : undef; + + # if it's equality op and search by Email or Name then we can preload user + # we do it to help some DBs better estimate number of rows and get better plans + if ( $args{OPERATOR} =~ /^!?=$/ + && (!$args{FIELD} || $args{FIELD} eq 'Name' || $args{FIELD} eq 'EmailAddress') ) { + my $o = RT::User->new( $self->CurrentUser ); + my $method = + !$args{FIELD} + ? ($column ? 'Load' : 'LoadByEmail') + : $args{FIELD} eq 'EmailAddress' ? 'LoadByEmail': 'Load'; + $o->$method( $args{VALUE} ); + $args{FIELD} = 'id'; + $args{VALUE} = $o->id || 0; + } + + if ( $column and $args{FIELD} and $args{FIELD} eq 'id' ) { + $self->Limit( + %args, + FIELD => $column, + ); + return; + } + + $args{FIELD} ||= 'EmailAddress'; + + my ($groups, $group_members, $users); + if ( $args{'BUNDLE'} ) { + ($groups, $group_members, $users) = @{ $args{'BUNDLE'} }; + } else { + $groups = $self->_RoleGroupsJoin( Name => $type, Class => $class, New => !$type ); + } + + $self->_OpenParen( $args{SUBCLAUSE} ) if $args{SUBCLAUSE}; + if ( $args{OPERATOR} =~ /^IS(?: NOT)?$/i ) { + # is [not] empty case + + $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); + # to avoid joining the table Users into the query, we just join GM + # and make sure we don't match records where group is member of itself + $self->Limit( + LEFTJOIN => $group_members, + FIELD => 'GroupId', + OPERATOR => '!=', + VALUE => "$group_members.MemberId", + QUOTEVALUE => 0, + ); + $self->Limit( + %args, + ALIAS => $group_members, + FIELD => 'GroupId', + OPERATOR => $args{OPERATOR}, + VALUE => $args{VALUE}, + ); + } + elsif ( $args{OPERATOR} =~ /^!=$|^NOT\s+/i ) { + # negative condition case + + # reverse op + $args{OPERATOR} =~ s/!|NOT\s+//i; + + # XXX: we have no way to build correct "Watcher.X != 'Y'" when condition + # "X = 'Y'" matches more then one user so we try to fetch two records and + # do the right thing when there is only one exist and semi-working solution + # otherwise. + my $users_obj = RT::Users->new( $self->CurrentUser ); + $users_obj->Limit( + FIELD => $args{FIELD}, + OPERATOR => $args{OPERATOR}, + VALUE => $args{VALUE}, + ); + $users_obj->OrderBy; + $users_obj->RowsPerPage(2); + my @users = @{ $users_obj->ItemsArrayRef }; + + $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); + if ( @users <= 1 ) { + my $uid = 0; + $uid = $users[0]->id if @users; + $self->Limit( + LEFTJOIN => $group_members, + ALIAS => $group_members, + FIELD => 'MemberId', + VALUE => $uid, + ); + $self->Limit( + %args, + ALIAS => $group_members, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + } else { + $self->Limit( + LEFTJOIN => $group_members, + FIELD => 'GroupId', + OPERATOR => '!=', + VALUE => "$group_members.MemberId", + QUOTEVALUE => 0, + ); + $users ||= $self->Join( + TYPE => 'LEFT', + ALIAS1 => $group_members, + FIELD1 => 'MemberId', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + $self->Limit( + LEFTJOIN => $users, + ALIAS => $users, + FIELD => $args{FIELD}, + OPERATOR => $args{OPERATOR}, + VALUE => $args{VALUE}, + CASESENSITIVE => 0, + ); + $self->Limit( + %args, + ALIAS => $users, + FIELD => 'id', + OPERATOR => 'IS', + VALUE => 'NULL', + ); + } + } else { + # positive condition case + + $group_members ||= $self->_GroupMembersJoin( + GroupsAlias => $groups, New => 1, Left => 0 + ); + if ($args{FIELD} eq "id") { + # Save a left join to Users, if possible + $self->Limit( + %args, + ALIAS => $group_members, + FIELD => "MemberId", + OPERATOR => $args{OPERATOR}, + VALUE => $args{VALUE}, + CASESENSITIVE => 0, + ); + } else { + $users ||= $self->Join( + TYPE => 'LEFT', + ALIAS1 => $group_members, + FIELD1 => 'MemberId', + TABLE2 => 'Users', + FIELD2 => 'id', + ); + $self->Limit( + %args, + ALIAS => $users, + FIELD => $args{FIELD}, + OPERATOR => $args{OPERATOR}, + VALUE => $args{VALUE}, + CASESENSITIVE => 0, + ); + } + } + $self->_CloseParen( $args{SUBCLAUSE} ) if $args{SUBCLAUSE}; + return ($groups, $group_members, $users); +} + +1; diff --git a/rt/lib/RT/SharedSetting.pm b/rt/lib/RT/SharedSetting.pm index 43df379..4a08d07 100644 --- a/rt/lib/RT/SharedSetting.pm +++ b/rt/lib/RT/SharedSetting.pm @@ -64,10 +64,10 @@ It consists of an ID, a name, and some arbitrary data. package RT::SharedSetting; use strict; use warnings; +use base qw/RT::Base/; use RT::Attribute; use Scalar::Util 'blessed'; -use base qw/RT::Base/; =head1 METHODS @@ -103,27 +103,28 @@ sub Load { my $object = $self->_GetObject($privacy); if ($object) { - $self->{'Attribute'} = $object->Attributes->WithId($id); + $self->{'Attribute'} = RT::Attribute->new($self->CurrentUser); + $self->{'Attribute'}->Load( $id ); if ($self->{'Attribute'}->Id) { $self->{'Id'} = $self->{'Attribute'}->Id; $self->{'Privacy'} = $privacy; $self->PostLoad(); - return (0, $self->loc("Permission denied")) + return wantarray ? (0, $self->loc("Permission Denied")) : 0 unless $self->CurrentUserCanSee; my ($ok, $msg) = $self->PostLoadValidate; - return ($ok, $msg) if !$ok; + return wantarray ? ($ok, $msg) : $ok if !$ok; - return (1, $self->loc("Loaded [_1] [_2]", $self->ObjectName, $self->Name)); + return wantarray ? (1, $self->loc("Loaded [_1] [_2]", $self->ObjectName, $self->Name)) : 1; } else { $RT::Logger->error("Could not load attribute " . $id . " for object " . $privacy); - return (0, $self->loc("Failed to load [_1] [_2]", $self->ObjectName, $id)) + return wantarray ? (0, $self->loc("Failed to load [_1] [_2]", $self->ObjectName, $id)) : 0; } } else { $RT::Logger->warning("Could not load object $privacy when loading " . $self->ObjectName); - return (0, $self->loc("Could not load object for [_1]", $privacy)); + return wantarray ? (0, $self->loc("Could not load object for [_1]", $privacy)) : 0; } } @@ -143,11 +144,11 @@ sub LoadById { my ($ok, $msg) = $attr->LoadById($id); if (!$ok) { - return (0, $self->loc("Failed to load [_1] [_2]: [_3]", $self->ObjectName, $id, $msg)) + return wantarray ? (0, $self->loc("Failed to load [_1] [_2]: [_3]", $self->ObjectName, $id, $msg)) : 0; } my $privacy = $self->_build_privacy($attr->ObjectType, $attr->ObjectId); - return (0, $self->loc("Bad privacy for attribute [_1]", $id)) + return wantarray ? (0, $self->loc("Bad privacy for attribute [_1]", $id)) : 0 if !$privacy; return $self->Load($privacy, $id); @@ -191,7 +192,7 @@ sub Save { my %args = ( 'Privacy' => 'RT::User-' . $self->CurrentUser->Id, 'Name' => "new " . $self->ObjectName, - @_, + @_, ); my $privacy = $args{'Privacy'}; @@ -201,13 +202,14 @@ sub Save { return (0, $self->loc("Failed to load object for [_1]", $privacy)) unless $object; - return (0, $self->loc("Permission denied")) + return (0, $self->loc("Permission Denied")) unless $self->CurrentUserCanCreate($privacy); my ($att_id, $att_msg) = $self->SaveAttribute($object, \%args); if ($att_id) { - $self->{'Attribute'} = $object->Attributes->WithId($att_id); + $self->{'Attribute'} = RT::Attribute->new($self->CurrentUser); + $self->{'Attribute'}->Load( $att_id ); $self->{'Id'} = $att_id; $self->{'Privacy'} = $privacy; return ( 1, $self->loc( "Saved [_1] [_2]", $self->loc( $self->ObjectName ), $name ) ); @@ -242,7 +244,7 @@ sub Update { return(0, $self->loc("Could not load [_1] attribute", $self->ObjectName)) unless $self->{'Attribute'}->Id; - return (0, $self->loc("Permission denied")) + return (0, $self->loc("Permission Denied")) unless $self->CurrentUserCanModify; my ($status, $msg) = $self->UpdateAttribute(\%args); @@ -274,7 +276,7 @@ where status is true upon success. sub Delete { my $self = shift; - return (0, $self->loc("Permission denied")) + return (0, $self->loc("Permission Denied")) unless $self->CurrentUserCanDelete; my ($status, $msg) = $self->{'Attribute'}->Delete; diff --git a/rt/lib/RT/SharedSettings.pm b/rt/lib/RT/SharedSettings.pm index 30c6b13..9623645 100644 --- a/rt/lib/RT/SharedSettings.pm +++ b/rt/lib/RT/SharedSettings.pm @@ -67,12 +67,12 @@ package RT::SharedSettings; -use RT::SharedSetting; - use strict; use warnings; use base 'RT::Base'; +use RT::SharedSetting; + sub new { my $proto = shift; my $class = ref($proto) || $proto; diff --git a/rt/lib/RT/Shredder.pm b/rt/lib/RT/Shredder.pm index e4cb157..af675bd4 100644 --- a/rt/lib/RT/Shredder.pm +++ b/rt/lib/RT/Shredder.pm @@ -105,7 +105,7 @@ See also 'rt-shredder --help'. =head2 Web based interface (WebUI) Shredder's WebUI integrates into RT's WebUI. You can find it in the -Configuration->Tools->Shredder tab. The interface is similar to the +Admin->Tools->Shredder tab. The interface is similar to the CLI and gives you the same functionality. You can find 'Shredder' link at the bottom of tickets search results, so you could wipeout tickets in the way similar to the bulk update. @@ -212,7 +212,6 @@ objects in the cache and backups storage. =cut -our $VERSION = '0.04'; use File::Spec (); @@ -224,29 +223,6 @@ BEGIN { ### after: push @INC, qw(@RT_LIB_PATH@); use RT::Shredder::Constants; use RT::Shredder::Exceptions; - - require RT; - - require RT::Shredder::Record; - - require RT::Shredder::ACE; - require RT::Shredder::Attachment; - require RT::Shredder::CachedGroupMember; - require RT::Shredder::CustomField; - require RT::Shredder::CustomFieldValue; - require RT::Shredder::GroupMember; - require RT::Shredder::Group; - require RT::Shredder::Link; - require RT::Shredder::Principal; - require RT::Shredder::Queue; - require RT::Shredder::Scrip; - require RT::Shredder::ScripAction; - require RT::Shredder::ScripCondition; - require RT::Shredder::Template; - require RT::Shredder::ObjectCustomFieldValue; - require RT::Shredder::Ticket; - require RT::Shredder::Transaction; - require RT::Shredder::User; } our @SUPPORTED_OBJECTS = qw( @@ -291,6 +267,7 @@ sub Init %opt = @_; RT::LoadConfig(); RT::Init(); + return; } =head4 new @@ -307,8 +284,7 @@ sub new { my $proto = shift; my $self = bless( {}, ref $proto || $proto ); - $self->_Init( @_ ); - return $self; + return $self->_Init( @_ ); } sub _Init @@ -318,6 +294,7 @@ sub _Init $self->{'cache'} = {}; $self->{'resolver'} = {}; $self->{'dump_plugins'} = []; + return $self; } =head4 CastObjectsToRecords( Objects => undef ) @@ -367,12 +344,18 @@ sub CastObjectsToRecords } } elsif ( UNIVERSAL::isa( $targets, 'SCALAR' ) || !ref $targets ) { $targets = $$targets if ref $targets; - my ($class, $id) = split /-/, $targets; + my ($class, $org, $id); + if ($targets =~ /-.*-/) { + ($class, $org, $id) = split /-/, $targets; + RT::Shredder::Exception->throw( "Can't wipeout remote object $targets" ) + unless $org eq RT->Config->Get('Organization'); + } else { + ($class, $id) = split /-/, $targets; + } RT::Shredder::Exception->throw( "Unsupported class $class" ) unless $class =~ /^\w+(::\w+)*$/; $class = 'RT::'. $class unless $class =~ /^RTx?::/i; - eval "require $class"; - die "Couldn't load '$class' module" if $@; + $class->require or die "Failed to load $class: $@"; my $obj = $class->new( RT->SystemUser ); die "Couldn't construct new '$class' object" unless $obj; $obj->Load( $id ); @@ -434,8 +417,11 @@ sub PutObject RT::Shredder::Exception->throw( "Unsupported type '". (ref $obj || $obj || '(undef)')."'" ); } - my $str = $obj->_AsString; - return ($self->{'cache'}->{ $str } ||= { State => ON_STACK, Object => $obj } ); + my $str = $obj->UID; + return ($self->{'cache'}->{ $str } ||= { + State => RT::Shredder::Constants::ON_STACK, + Object => $obj + } ); } =head4 GetObject, GetState, GetRecord( String => ''| Object => '' ) @@ -463,7 +449,7 @@ sub _ParseRefStrArgs Carp::croak( "both String and Object args passed" ); } return $args{'String'} if $args{'String'}; - return $args{'Object'}->_AsString if UNIVERSAL::can($args{'Object'}, '_AsString' ); + return $args{'Object'}->UID if UNIVERSAL::can($args{'Object'}, 'UID' ); return ''; } @@ -557,9 +543,10 @@ sub WipeoutAll my $self = $_[0]; foreach my $cache_val ( values %{ $self->{'cache'} } ) { - next if $cache_val->{'State'} & (WIPED | IN_WIPING); + next if $cache_val->{'State'} & (RT::Shredder::Constants::WIPED | RT::Shredder::Constants::IN_WIPING); $self->Wipeout( Object => $cache_val->{'Object'} ); } + return; } sub Wipeout @@ -580,6 +567,7 @@ sub Wipeout die $error if RT::Shredder::Exception::Info->caught; die "Couldn't wipeout object: $error"; } + return; } sub _Wipeout @@ -589,9 +577,9 @@ sub _Wipeout my $record = $args{'CacheRecord'}; $record = $self->PutObject( Object => $args{'Object'} ) unless $record; - return if $record->{'State'} & (WIPED | IN_WIPING); + return if $record->{'State'} & (RT::Shredder::Constants::WIPED | RT::Shredder::Constants::IN_WIPING); - $record->{'State'} |= IN_WIPING; + $record->{'State'} |= RT::Shredder::Constants::IN_WIPING; my $object = $record->{'Object'}; $self->DumpObject( Object => $object, State => 'before any action' ); @@ -602,25 +590,25 @@ sub _Wipeout my $deps = $object->Dependencies( Shredder => $self ); $deps->List( - WithFlags => DEPENDS_ON | VARIABLE, + WithFlags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::VARIABLE, Callback => sub { $self->ApplyResolvers( Dependency => $_[0] ) }, ); $self->DumpObject( Object => $object, State => 'after resolvers' ); $deps->List( - WithFlags => DEPENDS_ON, - WithoutFlags => WIPE_AFTER | VARIABLE, + WithFlags => RT::Shredder::Constants::DEPENDS_ON, + WithoutFlags => RT::Shredder::Constants::WIPE_AFTER | RT::Shredder::Constants::VARIABLE, Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) }, ); $self->DumpObject( Object => $object, State => 'after wiping dependencies' ); $object->__Wipeout; - $record->{'State'} |= WIPED; delete $record->{'Object'}; + $record->{'State'} |= RT::Shredder::Constants::WIPED; delete $record->{'Object'}; $self->DumpObject( Object => $object, State => 'after wipeout' ); $deps->List( - WithFlags => DEPENDS_ON | WIPE_AFTER, - WithoutFlags => VARIABLE, + WithFlags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::WIPE_AFTER, + WithoutFlags => RT::Shredder::Constants::VARIABLE, Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) }, ); $self->DumpObject( Object => $object, State => 'after late dependencies' ); @@ -628,17 +616,6 @@ sub _Wipeout return; } -sub ValidateRelations -{ - my $self = shift; - my %args = ( @_ ); - - foreach my $record( values %{ $self->{'cache'} } ) { - next if( $record->{'State'} & VALID ); - $record->{'Object'}->ValidateRelations( Shredder => $self ); - } -} - =head3 Data storage and backups =head4 GetFileName( FileName => '<ISO DATETIME>-XXXX.sql', FromStorage => 1 ) @@ -788,6 +765,7 @@ sub DumpObject { my ($state, $msg) = $_->Run( %args ); die "Couldn't run plugin: $msg" unless $state; } + return; } { my $mark = 1; # XXX: integer overflows? @@ -803,9 +781,10 @@ sub PushDumpMark { sub PopDumpMark { my $self = shift; foreach (@{ $self->{'dump_plugins'} }) { - my ($state, $msg) = $_->PushMark( @_ ); + my ($state, $msg) = $_->PopMark( @_ ); die "Couldn't pop mark: $msg" unless $state; } + return; } sub RollbackDumpTo { my $self = shift; @@ -813,6 +792,7 @@ sub RollbackDumpTo { my ($state, $msg) = $_->RollbackTo( @_ ); die "Couldn't rollback to mark: $msg" unless $state; } + return; } } diff --git a/rt/lib/RT/Shredder/Attachment.pm b/rt/lib/RT/Shredder/Attachment.pm deleted file mode 100644 index 00aecf3..0000000 --- a/rt/lib/RT/Shredder/Attachment.pm +++ /dev/null @@ -1,136 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Attachment (); -package RT::Attachment; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Exceptions; -use RT::Shredder::Constants; -use RT::Shredder::Dependencies; - -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 => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Parent, nested parts - if( $self->Parent ) { - if( $self->ParentObj && $self->ParentId ) { - push( @$list, $self->ParentObj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no parent attachment #". $self->Parent ." object"; - } - } - -# Transaction - my $obj = $self->TransactionObj; - if( defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related transaction #". $self->TransactionId ." object"; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} -1; diff --git a/rt/lib/RT/Shredder/CachedGroupMember.pm b/rt/lib/RT/Shredder/CachedGroupMember.pm deleted file mode 100644 index 646035e..0000000 --- a/rt/lib/RT/Shredder/CachedGroupMember.pm +++ /dev/null @@ -1,143 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::CachedGroupMember (); -package RT::CachedGroupMember; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependency; - - -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 => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - - return $self->SUPER::__DependsOn( %args ); -} - -#TODO: If we plan write export tool we also should fetch parent groups -# now we only wipeout things. - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - - my $obj = $self->MemberObj; - if( $obj && $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Principal #". $self->MemberId ." object."; - } - - $obj = $self->GroupObj; - if( $obj && $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Principal #". $self->GroupId ." object."; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} -1; diff --git a/rt/lib/RT/Shredder/Constants.pm b/rt/lib/RT/Shredder/Constants.pm index 64ee0b0..82445a7 100644 --- a/rt/lib/RT/Shredder/Constants.pm +++ b/rt/lib/RT/Shredder/Constants.pm @@ -51,15 +51,13 @@ package RT::Shredder::Constants; use strict; use warnings; -use base qw(Exporter); - =head1 NAME RT::Shredder::Constants - RT::Shredder constants that is used to mark state of RT objects. =head1 DESCRIPTION -This module exports two group of bit constants. +This module contains two group of bit constants. First group is group of flags which are used to clarify dependecies between objects, and second group is states of RT objects in Shredder cache. @@ -84,19 +82,12 @@ This flag is used to mark dependencies that can be resolved with changing value in target object. For example ticket can be created by user we can change this reference when we delete user. -=head2 RELATES - -This flag is used to validate relationships integrity. Base object -is valid only when all target objects which are marked with this flags -exist. - =cut use constant { - DEPENDS_ON => 0x000001, - WIPE_AFTER => 0x000010, - RELATES => 0x000100, - VARIABLE => 0x001000, + DEPENDS_ON => 0x001, + WIPE_AFTER => 0x002, + VARIABLE => 0x004, }; =head1 STATES @@ -112,33 +103,12 @@ Objects with this state are not exist any more in DB, but perl object is still in memory. This state is used to be shure that delete query is called once. -=head2 VALID - -Object is marked with this state only when its relationships -are valid. - -=head2 INVALID - =cut use constant { - ON_STACK => 0x00000, - IN_WIPING => 0x00001, - WIPED => 0x00010, - VALID => 0x00100, - INVALID => 0x01000, + ON_STACK => 0x000, + IN_WIPING => 0x010, + WIPED => 0x020, }; -our @EXPORT = qw( - DEPENDS_ON - WIPE_AFTER - RELATES - VARIABLE - ON_STACK - IN_WIPING - WIPED - VALID - INVALID - ); - 1; diff --git a/rt/lib/RT/Shredder/Dependencies.pm b/rt/lib/RT/Shredder/Dependencies.pm index 3ffebfd..a78fd0c 100644 --- a/rt/lib/RT/Shredder/Dependencies.pm +++ b/rt/lib/RT/Shredder/Dependencies.pm @@ -107,7 +107,7 @@ sub _PushDependency @_ ); my $rec = $args{'Shredder'}->PutObject( Object => $args{'TargetObject'} ); - return if $rec->{'State'} & WIPED; # there is no object anymore + return if $rec->{'State'} & RT::Shredder::Constants::WIPED; # there is no object anymore push @{ $self->{'list'} }, RT::Shredder::Dependency->new( diff --git a/rt/lib/RT/Shredder/Dependency.pm b/rt/lib/RT/Shredder/Dependency.pm index bdfdfc1..ad72f3b 100644 --- a/rt/lib/RT/Shredder/Dependency.pm +++ b/rt/lib/RT/Shredder/Dependency.pm @@ -54,10 +54,9 @@ use RT::Shredder::Constants; use RT::Shredder::Exceptions; my %FlagDescs = ( - DEPENDS_ON, 'depends on', - VARIABLE, 'resolvable dependency', - WIPE_AFTER, 'delete after', - RELATES, 'relates with', + RT::Shredder::Constants::DEPENDS_ON, 'depends on', + RT::Shredder::Constants::VARIABLE, 'resolvable dependency', + RT::Shredder::Constants::WIPE_AFTER, 'delete after', ); sub new @@ -71,7 +70,7 @@ sub new sub Set { my $self = shift; - my %args = ( Flags => DEPENDS_ON, @_ ); + my %args = ( Flags => RT::Shredder::Constants::DEPENDS_ON, @_ ); my @keys = qw(Flags BaseObject TargetObject); @$self{ @keys } = @args{ @keys }; @@ -81,9 +80,9 @@ sub Set sub AsString { my $self = shift; - my $res = $self->BaseObject->_AsString; + my $res = $self->BaseObject->UID; $res .= " ". $self->FlagsAsString; - $res .= " ". $self->TargetObject->_AsString; + $res .= " ". $self->TargetObject->UID; return $res; } diff --git a/rt/lib/RT/Shredder/Exceptions.pm b/rt/lib/RT/Shredder/Exceptions.pm index 85f8800..da0464d 100644 --- a/rt/lib/RT/Shredder/Exceptions.pm +++ b/rt/lib/RT/Shredder/Exceptions.pm @@ -67,27 +67,27 @@ use base qw(RT::Shredder::Exception); my %DESCRIPTION = ( DependenciesLimit => <<END, -Dependecies list have reached its limit. +Dependencies list has reached its limit. See \$RT::DependenciesLimit in RT::Shredder docs. END SystemObject => <<END, -System object was requested for deletion, shredder couldn't -do that because system would be unusable than. +System object was selected for deletion, shredder couldn't +do that because system would be unusable then. END CouldntLoadObject => <<END, -Shredder couldn't load object. Most probably it's not fatal error. -May be you've used Objects plugin and asked to delete object that +Shredder couldn't load object. Most likely it's not a fatal error. +Perhaps you've used the Objects plugin and asked to delete an object that doesn't exist in the system. If you think that your request was -correct and it's problem of the Shredder then you can get full error -message from RT log files and send bug report. +correct and it's a problem of the Shredder then you can get a full error +message from RT log files and send a bug report. END NoResolver => <<END, Object has dependency that could be resolved, but resolver -wasn't defined. You have to re-read documentation of the -plugin you're using, for example the 'Users' plugin has +wasn't defined. You have to re-read the documentation of the +plugin you're using. For example the 'Users' plugin has option 'replace_relations' argument. END ); diff --git a/rt/lib/RT/Shredder/Group.pm b/rt/lib/RT/Shredder/Group.pm deleted file mode 100644 index 8f93b8f..0000000 --- a/rt/lib/RT/Shredder/Group.pm +++ /dev/null @@ -1,185 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Group (); -package RT::Group; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# User is inconsistent without own Equivalence group - if( $self->Domain eq 'ACLEquivalence' ) { - # delete user entry after ACL equiv group - # in other case we will get deep recursion - my $objs = RT::User->new($self->CurrentUser); - $objs->Load( $self->Instance ); - $deps->_PushDependency( - BaseObject => $self, - Flags => DEPENDS_ON | WIPE_AFTER, - TargetObject => $objs, - Shredder => $args{'Shredder'} - ); - } - -# Principal - $deps->_PushDependency( - BaseObject => $self, - Flags => DEPENDS_ON | WIPE_AFTER, - TargetObject => $self->PrincipalObj, - Shredder => $args{'Shredder'} - ); - -# Group members records - my $objs = RT::GroupMembers->new( $self->CurrentUser ); - $objs->LimitToMembersOfGroup( $self->PrincipalId ); - push( @$list, $objs ); - -# Group member records group belongs to - $objs = RT::GroupMembers->new( $self->CurrentUser ); - $objs->Limit( - VALUE => $self->PrincipalId, - FIELD => 'MemberId', - ENTRYAGGREGATOR => 'OR', - QUOTEVALUE => 0 - ); - push( @$list, $objs ); - -# Cached group members records - push( @$list, $self->DeepMembersObj ); - -# Cached group member records group belongs to - $objs = RT::GroupMembers->new( $self->CurrentUser ); - $objs->Limit( - VALUE => $self->PrincipalId, - FIELD => 'MemberId', - ENTRYAGGREGATOR => 'OR', - QUOTEVALUE => 0 - ); - push( @$list, $objs ); - - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Equivalence group id inconsistent without User - if( $self->Domain eq 'ACLEquivalence' ) { - my $obj = RT::User->new($self->CurrentUser); - $obj->Load( $self->Instance ); - if( $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "ACLEguvivalence group have no related User #". $self->Instance ." object."; - } - } - -# Principal - my $obj = $self->PrincipalObj; - if( $obj && $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Principal #". $self->id ." object."; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} - -sub BeforeWipeout -{ - my $self = shift; - if( $self->Domain eq 'SystemInternal' ) { - RT::Shredder::Exception::Info->throw('SystemObject'); - } - return $self->SUPER::BeforeWipeout( @_ ); -} - -1; diff --git a/rt/lib/RT/Shredder/GroupMember.pm b/rt/lib/RT/Shredder/GroupMember.pm deleted file mode 100644 index 936fb64..0000000 --- a/rt/lib/RT/Shredder/GroupMember.pm +++ /dev/null @@ -1,183 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::GroupMember (); -package RT::GroupMember; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -# No dependencies that should be deleted with record - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - - my $objs = RT::CachedGroupMembers->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'MemberId', VALUE => $self->MemberId ); - $objs->Limit( FIELD => 'ImmediateParentId', VALUE => $self->GroupId ); - push( @$list, $objs ); - - # XXX: right delegations should be cleaned here - - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - - my $group = $self->GroupObj->Object; - # XXX: If we delete member of the ticket owner role group then we should also - # fix ticket object, but only if we don't plan to delete group itself! - unless( ($group->Type || '') eq 'Owner' && - ($group->Domain || '') eq 'RT::Ticket-Role' ) { - return $self->SUPER::__DependsOn( %args ); - } - - # we don't delete group, so we have to fix Ticket and Group - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON | VARIABLE, - TargetObjects => $group, - Shredder => $args{'Shredder'} - ); - $args{'Shredder'}->PutResolver( - BaseClass => ref $self, - TargetClass => ref $group, - Code => sub { - my %args = (@_); - my $group = $args{'TargetObject'}; - return if $args{'Shredder'}->GetState( Object => $group ) & (WIPED|IN_WIPING); - return unless ($group->Type || '') eq 'Owner'; - return unless ($group->Domain || '') eq 'RT::Ticket-Role'; - - return if $group->MembersObj->Count > 1; - - my $group_member = $args{'BaseObject'}; - - if( $group_member->MemberObj->id == RT->Nobody->id ) { - RT::Shredder::Exception->throw( "Couldn't delete Nobody from owners role group" ); - } - - my( $status, $msg ) = $group->AddMember( RT->Nobody->id ); - RT::Shredder::Exception->throw( $msg ) unless $status; - - my $ticket = RT::Ticket->new( $group->CurrentUser ); - $ticket->Load( $group->Instance ); - RT::Shredder::Exception->throw( "Couldn't load ticket" ) unless $ticket->id; - - ( $status, $msg ) = $ticket->_Set( Field => 'Owner', - Value => RT->Nobody->id, - ); - RT::Shredder::Exception->throw( $msg ) unless $status; - - return; - }, - ); - - return $self->SUPER::__DependsOn( %args ); -} - - -#TODO: If we plan write export tool we also should fetch parent groups -# now we only wipeout things. - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - - my $obj = $self->MemberObj; - if( $obj && $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Principal #". $self->MemberId ." object."; - } - - $obj = $self->GroupObj; - if( $obj && $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Principal #". $self->GroupId ." object."; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/Link.pm b/rt/lib/RT/Shredder/Link.pm deleted file mode 100644 index 5180c43..0000000 --- a/rt/lib/RT/Shredder/Link.pm +++ /dev/null @@ -1,140 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Link (); -package RT::Link; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; -use RT::Shredder::Constants; - -use RT::Shredder::Transaction; -use RT::Shredder::Record; - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# AddLink transactions - my $map = RT::Ticket->LINKTYPEMAP; - my $link_meta = $map->{ $self->Type }; - unless ( $link_meta && $link_meta->{'Mode'} && $link_meta->{'Type'} ) { - RT::Shredder::Exception->throw( 'Wrong link link_meta, no record for '. $self->Type ); - } - if ( $self->BaseURI->IsLocal ) { - my $objs = $self->BaseObj->Transactions; - $objs->Limit( - FIELD => 'Type', - OPERATOR => '=', - VALUE => 'AddLink', - ); - $objs->Limit( FIELD => 'NewValue', VALUE => $self->Target ); - while ( my ($k, $v) = each %$map ) { - next unless $v->{'Type'} eq $link_meta->{'Type'}; - next unless $v->{'Mode'} eq $link_meta->{'Mode'}; - $objs->Limit( FIELD => 'Field', VALUE => $k ); - } - push( @$list, $objs ); - } - - my %reverse = ( Base => 'Target', Target => 'Base' ); - if ( $self->TargetURI->IsLocal ) { - my $objs = $self->TargetObj->Transactions; - $objs->Limit( - FIELD => 'Type', - OPERATOR => '=', - VALUE => 'AddLink', - ); - $objs->Limit( FIELD => 'NewValue', VALUE => $self->Base ); - while ( my ($k, $v) = each %$map ) { - next unless $v->{'Type'} eq $link_meta->{'Type'}; - next unless $v->{'Mode'} eq $reverse{ $link_meta->{'Mode'} }; - $objs->Limit( FIELD => 'Field', VALUE => $k ); - } - push( @$list, $objs ); - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON|WIPE_AFTER, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__DependsOn( %args ); -} - -#TODO: Link record has small strength, but should be encountered -# if we plan write export tool. - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; -# FIXME: if link is local then object should exist - - return $self->SUPER::__Relates( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/ObjectCustomFieldValue.pm b/rt/lib/RT/Shredder/ObjectCustomFieldValue.pm deleted file mode 100644 index d040f97..0000000 --- a/rt/lib/RT/Shredder/ObjectCustomFieldValue.pm +++ /dev/null @@ -1,116 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::ObjectCustomFieldValue (); -package RT::ObjectCustomFieldValue; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Ticket - my $obj = $self->TicketObj; - if( defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Ticket #". $self->id ." object"; - } - -# Custom Field - $obj = $self->CustomFieldObj; - if( defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related CustomField #". $self->id ." object"; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/POD.pm b/rt/lib/RT/Shredder/POD.pm index b2156f9..c6aaeb1 100644 --- a/rt/lib/RT/Shredder/POD.pm +++ b/rt/lib/RT/Shredder/POD.pm @@ -59,6 +59,7 @@ sub plugin_html my $parser = RT::Shredder::POD::HTML->new; $parser->select('ARGUMENTS', 'USAGE'); $parser->parse_from_file( $file, $out_fh ); + return; } sub plugin_cli @@ -69,6 +70,7 @@ sub plugin_cli $parser->select('SYNOPSIS', 'ARGUMENTS', 'USAGE'); $parser->add_selection('NAME') unless $no_name; $parser->parse_from_file( $file, $out_fh ); + return; } sub shredder_cli @@ -78,6 +80,7 @@ sub shredder_cli my $parser = Pod::PlainText->new(); $parser->select('NAME', 'SYNOPSIS', 'USAGE', 'OPTIONS'); $parser->parse_from_file( $file, $out_fh ); + return; } package RT::Shredder::POD::HTML; @@ -97,6 +100,7 @@ sub command print $out_fh $expansion; print $out_fh "</$tag>" if $tag; print $out_fh "\n"; + return; } sub verbatim @@ -107,6 +111,7 @@ sub verbatim print $out_fh $paragraph; print $out_fh "</pre>"; print $out_fh "\n"; + return; } sub textblock { @@ -118,6 +123,7 @@ sub textblock { print $out_fh $expansion; print $out_fh "</p>"; print $out_fh "\n"; + return; } sub interior_sequence { diff --git a/rt/lib/RT/Shredder/Plugin.pm b/rt/lib/RT/Shredder/Plugin.pm index 9ee2b93..2c7a790 100644 --- a/rt/lib/RT/Shredder/Plugin.pm +++ b/rt/lib/RT/Shredder/Plugin.pm @@ -103,6 +103,7 @@ sub _Init my $self = shift; my %args = ( @_ ); $self->{'opt'} = \%args; + return; } =head2 List @@ -137,7 +138,7 @@ sub List delete $res{'Base'}; foreach my $name( keys %res ) { my $class = join '::', qw(RT Shredder Plugin), $name; - unless( eval "require $class" ) { + unless( $class->require ) { delete $res{ $name }; next; } @@ -161,6 +162,8 @@ Other arguments are sent to the constructor of the plugin Returns C<$status> and C<$message>. On errors status is C<false> value. +In scalar context, returns $status only. + =cut sub LoadByName @@ -169,17 +172,16 @@ sub LoadByName my $name = shift or return (0, "Name not specified"); $name =~ /^\w+(::\w+)*$/ or return (0, "Invalid plugin name"); - local $@; my $plugin = "RT::Shredder::Plugin::$name"; - eval "require $plugin" or return( 0, $@ ); - return( 0, "Plugin '$plugin' has no method new") unless $plugin->can('new'); + $plugin->require or return( 0, "Failed to load $plugin" ); + return wantarray ? ( 0, "Plugin '$plugin' has no method new") : 0 unless $plugin->can('new'); my $obj = eval { $plugin->new( @_ ) }; - return( 0, $@ ) if $@; - return( 0, 'constructor returned empty object' ) unless $obj; + return wantarray ? ( 0, $@ ) : 0 if $@; + return wantarray ? ( 0, 'constructor returned empty object' ) : 0 unless $obj; $self->Rebless( $obj ); - return( 1, "successfuly load plugin" ); + return wantarray ? ( 1, "successfuly load plugin" ) : 1; } =head2 LoadByString diff --git a/rt/lib/RT/Shredder/Plugin/Attachments.pm b/rt/lib/RT/Shredder/Plugin/Attachments.pm index c33ffe8..5a573ad 100644 --- a/rt/lib/RT/Shredder/Plugin/Attachments.pm +++ b/rt/lib/RT/Shredder/Plugin/Attachments.pm @@ -132,7 +132,7 @@ sub Run } return (0, "Internal error: '". $sth->err ."'. Please send bug report.") if $sth->err; - map { $_ = "RT::Attachment-$_" } @objs; + @objs = map {"RT::Attachment-$_"} @objs; return (1, @objs); } diff --git a/rt/lib/RT/Shredder/Plugin/Base.pm b/rt/lib/RT/Shredder/Plugin/Base.pm index a8acf39..30fa3f3 100644 --- a/rt/lib/RT/Shredder/Plugin/Base.pm +++ b/rt/lib/RT/Shredder/Plugin/Base.pm @@ -61,14 +61,14 @@ sub new { my $proto = shift; my $self = bless( {}, ref $proto || $proto ); - $self->_Init( @_ ); - return $self; + return $self->_Init( @_ ); } sub _Init { my $self = shift; $self->{'opt'} = { @_ }; + return $self; } =head1 USAGE @@ -125,8 +125,9 @@ sub HasSupportForArgs foreach my $a( @args ) { push @unsupported, $a unless grep $_ eq $a, $self->SupportArgs; } - return( 1 ) unless @unsupported; - return( 0, "Plugin doesn't support argument(s): @unsupported" ) if @unsupported; + return( 0, "Plugin doesn't support argument(s): @unsupported" ) + if @unsupported; + return( 1 ); } =head3 TestArgs diff --git a/rt/lib/RT/Shredder/Plugin/Summary.pm b/rt/lib/RT/Shredder/Plugin/Summary.pm index bd21284..7442c6d 100644 --- a/rt/lib/RT/Shredder/Plugin/Summary.pm +++ b/rt/lib/RT/Shredder/Plugin/Summary.pm @@ -76,7 +76,6 @@ sub Run my $method = 'WriteDown'. $class; $method = 'WriteDownDefault' unless $self->can($method); return $self->$method( %args ); - return 1; } my %skip_refs_to = (); @@ -114,8 +113,8 @@ sub WriteDownPrincipal { return 1 } sub WriteDownGroup { my $self = shift; my %args = ( Object => undef, @_ ); - if ( $args{'Object'}->Domain =~ /-Role$/ ) { - return $skip_refs_to{ $args{'Object'}->_AsString } = 1; + if ( $args{'Object'}->RoleClass ) { + return $skip_refs_to{ $args{'Object'}->UID } = 1; } return $self->WriteDownDefault( %args ); } @@ -142,7 +141,7 @@ sub WriteDownScrip { my $props = $self->_MakeHash( $args{'Object'} ); $props->{'Action'} = $args{'Object'}->ActionObj->Name; $props->{'Condition'} = $args{'Object'}->ConditionObj->Name; - $props->{'Template'} = $args{'Object'}->TemplateObj->Name; + $props->{'Template'} = $args{'Object'}->Template; $props->{'Queue'} = $args{'Object'}->QueueObj->Name || 'global'; return $self->_WriteDownHash( $args{'Object'}, $props ); @@ -154,7 +153,7 @@ sub _MakeHash { foreach (grep exists $hash->{$_}, qw(Creator LastUpdatedBy)) { my $method = $_ .'Obj'; my $u = $obj->$method(); - $hash->{ $_ } = $u->EmailAddress || $u->Name || $u->_AsString; + $hash->{ $_ } = $u->EmailAddress || $u->Name || $u->UID; } return $hash; } @@ -171,7 +170,7 @@ sub _WriteDownHash { my ($self, $obj, $hash) = @_; return (0, 'no handle') unless my $fh = $self->{'opt'}{'file_handle'}; - print $fh "=== ". $obj->_AsString ." ===\n" + print $fh "=== ". $obj->UID ." ===\n" or return (0, "Couldn't write to filehandle"); foreach my $key( sort keys %$hash ) { diff --git a/rt/lib/RT/Shredder/Plugin/Users.pm b/rt/lib/RT/Shredder/Plugin/Users.pm index 2f6fbd9..7e1c31f 100644 --- a/rt/lib/RT/Shredder/Plugin/Users.pm +++ b/rt/lib/RT/Shredder/Plugin/Users.pm @@ -79,6 +79,11 @@ be selected for deletion. Identifier is name of user defined group or id of a group, as well C<Privileged> or <unprivileged> can used to select people from system groups. +=head2 not_member_of - group identifier + +Like member_of, but selects users who are not members of the provided +group. + =head2 replace_relations - user identifier When you delete a user there could be minor links to them in the RT database. @@ -108,7 +113,7 @@ want to use C<replace_relations> option. sub SupportArgs { return $_[0]->SUPER::SupportArgs, - qw(status name email member_of replace_relations no_tickets); + qw(status name email member_of not_member_of replace_relations no_tickets); } sub TestArgs @@ -128,19 +133,22 @@ sub TestArgs if( $args{'name'} ) { $args{'name'} = $self->ConvertMaskToSQL( $args{'name'} ); } - if( $args{'member_of'} ) { - my $group = RT::Group->new( RT->SystemUser ); - if ( $args{'member_of'} =~ /^(Everyone|Privileged|Unprivileged)$/i ) { - $group->LoadSystemInternalGroup( $args{'member_of'} ); - } - else { - $group->LoadUserDefinedGroup( $args{'member_of'} ); - } - unless ( $group->id ) { - return (0, "Couldn't load group '$args{'member_of'}'" ); - } - $args{'member_of'} = $group->id; + if( $args{'member_of'} or $args{'not_member_of'} ) { + foreach my $group_option ( qw(member_of not_member_of) ){ + next unless $args{$group_option}; + my $group = RT::Group->new( RT->SystemUser ); + if ( $args{$group_option} =~ /^(Everyone|Privileged|Unprivileged)$/i ) { + $group->LoadSystemInternalGroup( $args{$group_option} ); + } + else { + $group->LoadUserDefinedGroup( $args{$group_option} ); + } + unless ( $group->id ) { + return (0, "Couldn't load group '$args{$group_option}'" ); + } + $args{$group_option} = $group->id; + } } if( $args{'replace_relations'} ) { my $uid = $args{'replace_relations'}; @@ -183,20 +191,38 @@ sub Run $objs->Limit( FIELD => 'Name', OPERATOR => 'MATCHES', VALUE => $self->{'opt'}{'name'}, + CASESENSITIVE => 0, ); } if( $self->{'opt'}{'member_of'} ) { $objs->MemberOfGroup( $self->{'opt'}{'member_of'} ); } + my @filter; + if( $self->{'opt'}{'not_member_of'} ) { + push @filter, $self->FilterNotMemberOfGroup( + Shredder => $args{'Shredder'}, + GroupId => $self->{'opt'}{'not_member_of'}, + ); + } if( $self->{'opt'}{'no_tickets'} ) { - return $self->FilterWithoutTickets( + push @filter, $self->FilterWithoutTickets( Shredder => $args{'Shredder'}, - Objects => $objs, ); - } else { - if( $self->{'opt'}{'limit'} ) { - $objs->RowsPerPage( $self->{'opt'}{'limit'} ); + } + + if (@filter) { + $self->FetchNext( $objs, 'init' ); + my @res; + USER: while ( my $user = $self->FetchNext( $objs ) ) { + for my $filter (@filter) { + next USER unless $filter->($user); + } + push @res, $user; + last if $self->{'opt'}{'limit'} && @res >= $self->{'opt'}{'limit'}; } + $objs = \@res; + } elsif ( $self->{'opt'}{'limit'} ) { + $objs->RowsPerPage( $self->{'opt'}{'limit'} ); } return (1, $objs); } @@ -221,6 +247,23 @@ sub SetResolvers return (1); } +sub FilterNotMemberOfGroup { + my $self = shift; + my %args = ( + Shredder => undef, + GroupId => undef, + @_, + ); + + my $group = RT::Group->new(RT->SystemUser); + $group->Load($args{'GroupId'}); + + return sub { + my $user = shift; + not $group->HasMemberRecursively($user->id); + }; +} + sub FilterWithoutTickets { my $self = shift; my %args = ( @@ -228,15 +271,11 @@ sub FilterWithoutTickets { Objects => undef, @_, ); - my $users = $args{Objects}; - $self->FetchNext( $users, 'init' ); - my @res; - while ( my $user = $self->FetchNext( $users ) ) { - push @res, $user if $self->_WithoutTickets( $user ); - return (1, \@res) if $self->{'opt'}{'limit'} && @res >= $self->{'opt'}{'limit'}; - } - return (1, \@res); + return sub { + my $user = shift; + $self->_WithoutTickets( $user ) + }; } sub _WithoutTickets { diff --git a/rt/lib/RT/Shredder/Principal.pm b/rt/lib/RT/Shredder/Principal.pm deleted file mode 100644 index 226a78c..0000000 --- a/rt/lib/RT/Shredder/Principal.pm +++ /dev/null @@ -1,127 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Principal (); -package RT::Principal; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Exceptions; -use RT::Shredder::Constants; -use RT::Shredder::Dependencies; - - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Group or User -# Could be wiped allready - my $obj = $self->Object; - if( defined $obj->id ) { - push( @$list, $obj ); - } - -# Access Control List - my $objs = RT::ACL->new( $self->CurrentUser ); - $objs->Limit( - FIELD => 'PrincipalId', - OPERATOR => '=', - VALUE => $self->Id - ); - push( @$list, $objs ); - - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - - my $obj = $self->Object; - if( defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related ". $self->Type ." #". $self->id ." object"; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/Queue.pm b/rt/lib/RT/Shredder/Queue.pm deleted file mode 100644 index 58904f1..0000000 --- a/rt/lib/RT/Shredder/Queue.pm +++ /dev/null @@ -1,107 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Queue (); -package RT::Queue; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Tickets - my $objs = RT::Tickets->new( $self->CurrentUser ); - $objs->{'allow_deleted_search'} = 1; - $objs->Limit( FIELD => 'Queue', VALUE => $self->Id ); - push( @$list, $objs ); - -# Queue role groups( Cc, AdminCc ) - $objs = RT::Groups->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role' ); - $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); - push( @$list, $objs ); - -# Scrips - $objs = RT::Scrips->new( $self->CurrentUser ); - $objs->LimitToQueue( $self->id ); - push( @$list, $objs ); - -# Templates - $objs = $self->Templates; - push( @$list, $objs ); - -# Custom Fields - $objs = RT::CustomFields->new( $self->CurrentUser ); - $objs->SetContextObject( $self ); - $objs->LimitToQueue( $self->id ); - push( @$list, $objs ); - - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__DependsOn( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/Record.pm b/rt/lib/RT/Shredder/Record.pm index 684176c..1e777ba 100644 --- a/rt/lib/RT/Shredder/Record.pm +++ b/rt/lib/RT/Shredder/Record.pm @@ -46,8 +46,8 @@ # # END BPS TAGGED BLOCK }}} -use RT::Record (); package RT::Record; +use RT::Record (); use strict; use warnings; @@ -56,14 +56,6 @@ use warnings FATAL => 'redefine'; use RT::Shredder::Constants; use RT::Shredder::Exceptions; -=head2 _AsString - -Returns string in format ClassName-ObjectId. - -=cut - -sub _AsString { return ref($_[0]) ."-". $_[0]->id } - =head2 _AsInsertQuery Returns INSERT query string that duplicates current record and @@ -100,7 +92,7 @@ sub Dependencies my $self = shift; my %args = ( Shredder => undef, - Flags => DEPENDS_ON, + Flags => RT::Shredder::Constants::DEPENDS_ON, @_, ); @@ -109,12 +101,9 @@ sub Dependencies } my $deps = RT::Shredder::Dependencies->new(); - if( $args{'Flags'} & DEPENDS_ON ) { + if( $args{'Flags'} & RT::Shredder::Constants::DEPENDS_ON ) { $self->__DependsOn( %args, Dependencies => $deps ); } - if( $args{'Flags'} & RELATES ) { - $self->__Relates( %args, Dependencies => $deps ); - } return $deps; } @@ -145,12 +134,13 @@ sub __DependsOn push( @$list, $objs ); # Links - if ( $self->can('_Links') ) { - # XXX: We don't use Links->Next as it's dies when object - # is linked to object that doesn't exist - # also, ->Next skip links to deleted tickets :( + if ( $self->can('Links') ) { + # make sure we don't skip any record + no warnings 'redefine'; + local *RT::Links::IsValidLink = sub { 1 }; + foreach ( qw(Base Target) ) { - my $objs = $self->_Links( $_ ); + my $objs = $self->Links( $_ ); $objs->_DoSearch; push @$list, $objs->ItemsArrayRef; } @@ -163,111 +153,22 @@ sub __DependsOn $deps->_PushDependencies( BaseObject => $self, - Flags => DEPENDS_ON, + Flags => RT::Shredder::Constants::DEPENDS_ON, TargetObjects => $list, Shredder => $args{'Shredder'} ); return; } -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - - if( $self->_Accessible( 'Creator', 'read' ) ) { - my $obj = RT::Principal->new( $self->CurrentUser ); - $obj->Load( $self->Creator ); - - if( $obj && defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - push @{ $rec->{'Description'} }, - "Have no related User(Creator) #". $self->Creator ." object"; - } - } - - if( $self->_Accessible( 'LastUpdatedBy', 'read' ) ) { - my $obj = RT::Principal->new( $self->CurrentUser ); - $obj->Load( $self->LastUpdatedBy ); - - if( $obj && defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - push @{ $rec->{'Description'} }, - "Have no related User(LastUpdatedBy) #". $self->LastUpdatedBy ." object"; - } - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - - # cause of this $self->SUPER::__Relates should be called last - # in overridden subs - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $rec->{'State'} |= VALID unless( $rec->{'State'} & INVALID ); - - return; -} - # implement proxy method because some RT classes # override Delete method sub __Wipeout { my $self = shift; - my $msg = $self->_AsString ." wiped out"; + my $msg = $self->UID ." wiped out"; $self->SUPER::Delete; $RT::Logger->info( $msg ); return; } -sub ValidateRelations -{ - my $self = shift; - my %args = ( - Shredder => undef, - @_ - ); - unless( $args{'Shredder'} ) { - $args{'Shredder'} = RT::Shredder->new(); - } - - my $rec = $args{'Shredder'}->PutObject( Object => $self ); - return if( $rec->{'State'} & VALID ); - $self = $rec->{'Object'}; - - $self->_ValidateRelations( %args, Flags => RELATES ); - $rec->{'State'} |= VALID unless( $rec->{'State'} & INVALID ); - - return; -} - -sub _ValidateRelations -{ - my $self = shift; - my %args = ( @_ ); - - my $deps = $self->Dependencies( %args ); - - $deps->ValidateRelations( %args ); - - return; -} - 1; diff --git a/rt/lib/RT/Shredder/Scrip.pm b/rt/lib/RT/Shredder/Scrip.pm deleted file mode 100644 index c3a1e7d..0000000 --- a/rt/lib/RT/Shredder/Scrip.pm +++ /dev/null @@ -1,130 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Scrip (); -package RT::Scrip; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# No dependencies that should be deleted with record -# Scrip actions and conditions should be exported in feature with it. - - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Queue - my $obj = $self->QueueObj; - if( defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Queue #". $self->id ." object"; - } - -# Condition - $obj = $self->ConditionObj; - if( defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related ScripCondition #". $self->id ." object"; - } -# Action - $obj = $self->ActionObj; - if( defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related ScripAction #". $self->id ." object"; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - - return $self->SUPER::__Relates( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/Ticket.pm b/rt/lib/RT/Shredder/Ticket.pm deleted file mode 100644 index d34131b..0000000 --- a/rt/lib/RT/Shredder/Ticket.pm +++ /dev/null @@ -1,126 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Ticket (); -package RT::Ticket; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Tickets which were merged in - my $objs = RT::Tickets->new( $self->CurrentUser ); - $objs->{'allow_deleted_search'} = 1; - $objs->Limit( FIELD => 'EffectiveId', VALUE => $self->Id ); - $objs->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->Id ); - push( @$list, $objs ); - -# Ticket role groups( Owner, Requestors, Cc, AdminCc ) - $objs = RT::Groups->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'Domain', VALUE => 'RT::Ticket-Role' ); - $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); - push( @$list, $objs ); - -#TODO: Users, Queues if we wish export tool - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Queue - my $obj = $self->QueueObj; - if( $obj && defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Queue #". $self->Queue ." object"; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/Transaction.pm b/rt/lib/RT/Shredder/Transaction.pm deleted file mode 100644 index a8593c6..0000000 --- a/rt/lib/RT/Shredder/Transaction.pm +++ /dev/null @@ -1,115 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::Transaction (); -package RT::Transaction; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Attachments - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $self->Attachments, - Shredder => $args{'Shredder'} - ); - - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Ticket - my $obj = $self->TicketObj; - if( $obj && defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Ticket #". $self->id ." object"; - } - -# TODO: Users(Creator, LastUpdatedBy) - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} - -1; diff --git a/rt/lib/RT/Shredder/User.pm b/rt/lib/RT/Shredder/User.pm deleted file mode 100644 index cf001a8..0000000 --- a/rt/lib/RT/Shredder/User.pm +++ /dev/null @@ -1,191 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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 RT::User (); -package RT::User; - -use strict; -use warnings; -use warnings FATAL => 'redefine'; - -use RT::Shredder::Constants; -use RT::Shredder::Exceptions; -use RT::Shredder::Dependencies; - -my @OBJECTS = qw( - Attachments - CachedGroupMembers - CustomFields - CustomFieldValues - GroupMembers - Groups - Links - Principals - Queues - ScripActions - ScripConditions - Scrips - Templates - ObjectCustomFieldValues - Tickets - Transactions - Users -); - -sub __DependsOn -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Principal - $deps->_PushDependency( - BaseObject => $self, - Flags => DEPENDS_ON | WIPE_AFTER, - TargetObject => $self->PrincipalObj, - Shredder => $args{'Shredder'} - ); - -# ACL equivalence group -# don't use LoadACLEquivalenceGroup cause it may not exists any more - my $objs = RT::Groups->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'Domain', VALUE => 'ACLEquivalence' ); - $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); - push( @$list, $objs ); - -# Cleanup user's membership - $objs = RT::GroupMembers->new( $self->CurrentUser ); - $objs->Limit( FIELD => 'MemberId', VALUE => $self->Id ); - push( @$list, $objs ); - - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - -# TODO: Almost all objects has Creator, LastUpdatedBy and etc. fields -# which are references on users(Principal actualy) - my @var_objs; - foreach( @OBJECTS ) { - my $class = "RT::$_"; - foreach my $method ( qw(Creator LastUpdatedBy) ) { - my $objs = $class->new( $self->CurrentUser ); - next unless $objs->NewItem->_Accessible( $method => 'read' ); - $objs->Limit( FIELD => $method, VALUE => $self->id ); - push @var_objs, $objs; - } - } - $deps->_PushDependencies( - BaseObject => $self, - Flags => DEPENDS_ON | VARIABLE, - TargetObjects => \@var_objs, - Shredder => $args{'Shredder'} - ); - - return $self->SUPER::__DependsOn( %args ); -} - -sub __Relates -{ - my $self = shift; - my %args = ( - Shredder => undef, - Dependencies => undef, - @_, - ); - my $deps = $args{'Dependencies'}; - my $list = []; - -# Principal - my $obj = $self->PrincipalObj; - if( $obj && defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related ACL equivalence Group object"; - } - - $obj = RT::Group->new( RT->SystemUser ); - $obj->LoadACLEquivalenceGroup( $self->PrincipalObj ); - if( $obj && defined $obj->id ) { - push( @$list, $obj ); - } else { - my $rec = $args{'Shredder'}->GetRecord( Object => $self ); - $self = $rec->{'Object'}; - $rec->{'State'} |= INVALID; - $rec->{'Description'} = "Have no related Principal #". $self->id ." object"; - } - - $deps->_PushDependencies( - BaseObject => $self, - Flags => RELATES, - TargetObjects => $list, - Shredder => $args{'Shredder'} - ); - return $self->SUPER::__Relates( %args ); -} - -sub BeforeWipeout -{ - my $self = shift; - if( $self->Name =~ /^(RT_System|Nobody)$/ ) { - RT::Shredder::Exception::Info->throw('SystemObject'); - } - return $self->SUPER::BeforeWipeout( @_ ); -} - -1; diff --git a/rt/lib/RT/Squish/CSS.pm b/rt/lib/RT/Squish/CSS.pm index ad9b553..ccfbc27 100644 --- a/rt/lib/RT/Squish/CSS.pm +++ b/rt/lib/RT/Squish/CSS.pm @@ -78,27 +78,8 @@ sub Squish { return $self->concatenate( "$style/main.css", RT->Config->Get('CSSFiles') ); } -=head2 file_handle - -subclass CSS::Squish::file_handle for RT - -=cut - -sub file_handle { - my $self = shift; - my $file = shift; - - my $path = "/NoAuth/css/$file"; - my $content; - if ( $HTML::Mason::Commands::m->comp_exists($path) ) { - $content = $HTML::Mason::Commands::m->scomp("$path"); - } else { - RT->Logger->error("Unable to open $path for CSS Squishing"); - return undef; - } - - open( my $fh, '<', \$content ) or die $!; - return $fh; +sub roots { + map { "$_/css" } RT::Interface::Web->StaticRoots } 1; diff --git a/rt/lib/RT/Squish/JS.pm b/rt/lib/RT/Squish/JS.pm index 5445689..c44f455 100644 --- a/rt/lib/RT/Squish/JS.pm +++ b/rt/lib/RT/Squish/JS.pm @@ -73,14 +73,16 @@ not only concatenate files, but also minify them sub Squish { my $self = shift; - my $content; + my $content = ""; - for my $file ( RT->Config->Get('JSFiles') ) { - my $path = "/NoAuth/js/$file"; - if ( $HTML::Mason::Commands::m->comp_exists($path) ) { - $content .= $HTML::Mason::Commands::m->scomp($path); + for my $file ( RT::Interface::Web->JSFiles ) { + my $uri = $file =~ m{^/} ? $file : "/static/js/$file"; + my $res = RT::Interface::Web::Handler->GetStatic($uri); + + if ($res->is_success) { + $content .= $res->decoded_content; } else { - RT->Logger->error("Unable to open $path for JS Squishing"); + RT->Logger->error("Unable to fetch $uri for JS Squishing: " . $res->status_line); next; } } diff --git a/rt/lib/RT/StyleGuide.pod b/rt/lib/RT/StyleGuide.pod index 8fdfc7b..3a75562 100644 --- a/rt/lib/RT/StyleGuide.pod +++ b/rt/lib/RT/StyleGuide.pod @@ -30,7 +30,7 @@ want to make up for it now. If you have any questions, please ask us on the B<rt-devel> mailing list: - http://www.bestpractical.com/rt/lists.html + http://www.bestpractical.com/rt/lists.html We don't always follow this guide. We are making changes throughout our code to be in line with it. But just because we didn't do @@ -44,8 +44,7 @@ We hope to add any significant changes at the bottom of the document. =head2 Perl Version -We code everything to perl 5.8.3 or higher. Complete unicode support -requires bugfixes found in 5.8.3. +We code everything to Perl 5.10.1 or higher. =head2 Documentation @@ -75,7 +74,7 @@ purpose, and use in a mason comment block. Any external documents, and documentation for command-line programs and modules, should be written in POD, where appropriate. From there, they -can be translated to many formats with the various pod2* translators. +can be translated to many formats with the various pod2* translators. Read the perlpod manpage before writing any POD, because although POD is not difficult, it is not what most people are used to. It is not a regular markup language; it is just a way to make easy documentation @@ -90,15 +89,15 @@ major revision, the second number is the version, and third number is the subversion. Odd-numbered versions are development versions. Examples: - 1.0.0 First release of RT 1 - 1.0.1 Second release of RT 1.0 - 1.0.10 etc. - 1.1.0 First development release of RT 1.2 (or 2.0) - 2.0.0 First release of RT 2 + 1.0.0 First release of RT 1 + 1.0.1 Second release of RT 1.0 + 1.0.10 etc. + 1.1.0 First development release of RT 1.2 (or 2.0) + 2.0.0 First release of RT 2 Versions may end in "rc" and a number if they are release candidates: - 2.0.0rc1 First release candiate for real 2.0.0 + 2.0.0rc1 First release candiate for real 2.0.0 =head2 Comments @@ -107,8 +106,8 @@ All code should be self-documenting as much as possible. Only include necessary comments. Use names like "$ticket_count", so you don't need to do something like: - # ticket count - my $tc = 0; + # ticket count + my $tc = 0; Include any comments that are, or might be, necessary in order for someone else to understand the code. Sometimes a simple one-line @@ -150,21 +149,21 @@ Arrays and hashes should be passed to and from functions by reference only. Note that a list and an array are NOT the same thing. This is perfectly fine: - return($user, $form, $constants); + return($user, $form, $constants); An exception might be a temporary array of discrete arguments: - my @return = ($user, $form); - push @return, $constants if $flag; - return @return; + my @return = ($user, $form); + push @return, $constants if $flag; + return @return; Although, usually, this is better (faster, easier to read, etc.): - if ($flag) { - return($user, $form, $constants); - } else { - return($user, $form); - } + if ($flag) { + return($user, $form, $constants); + } else { + return($user, $form); + } We need to talk about Class::ReturnValue here. @@ -248,7 +247,7 @@ use the logging API. =head2 System Calls Always check return values from system calls, including open(), -close(), mkdir(), or anything else that talks directly to the system. +close(), mkdir(), or anything else that talks directly to the system. Perl built-in system calls return the error in $!; some functions in modules might return an error in $@ or some other way, so read the module's documentation if you don't know. Always do something, even if it is @@ -280,7 +279,7 @@ are optionally called constructors. =item Users "users" are normally users of RT, the ones hitting the site; if using -it in any other context, specify. +it in any other context, specify. "system users" are user names on the operating system. "database users" are the user names in the database server. None of these needs to be capitalized. @@ -297,28 +296,28 @@ Don't use two-character variables just to spite us over the above rule. Constants are in all caps; these are variables whose value will I<never> change during the course of the program. - $Minimum = 10; # wrong - $MAXIMUM = 50; # right + $Minimum = 10; # wrong + $MAXIMUM = 50; # right -Other variables are lowercase, with underscores separating the words. +Other variables are lowercase, with underscores separating the words. They words used should, in general, form a noun (usually singular), unless the variable is a flag used to denote some action that should be taken, in which case they should be verbs (or gerunds, as appropriate) describing that action. - $thisVar = 'foo'; # wrong - $this_var = 'foo'; # right - $work_hard = 1; # right, verb, boolean flag - $running_fast = 0; # right, gerund, boolean flag + $thisVar = 'foo'; # wrong + $this_var = 'foo'; # right + $work_hard = 1; # right, verb, boolean flag + $running_fast = 0; # right, gerund, boolean flag Arrays and hashes should be plural nouns, whether as regular arrays and hashes or array and hash references. Do not name references with "ref" or the data type in the name. - @stories = (1, 2, 3); # right - $comment_ref = [4, 5, 6]; # wrong - $comments = [4, 5, 6]; # right - $comment = $comments->[0]; # right + @stories = (1, 2, 3); # right + $comment_ref = [4, 5, 6]; # wrong + $comments = [4, 5, 6]; # right + $comment = $comments->[0]; # right Make the name descriptive. Don't use variables like "$sc" when you could call it "$story_count". See L<"Comments">. @@ -328,7 +327,7 @@ that you should use in your code. Do not use these variable names for anything other than how they are normally used, and do not use any other variable names in their place. Some of these are: - $self # first named argument in object method + $self # first named argument in object method Subroutines (except for special cases, like AUTOLOAD and simple accessors) begin with a verb, with words following to complete the action. Accessors @@ -340,13 +339,13 @@ This section needs clarification for RT. Words begin with a capital letter. They should as clearly as possible describe the activity to be peformed, and -the data to be returned. +the data to be returned. - Load(); # good - LoadByName(); # good - LoadById(); # good + Load(); # good + LoadByName(); # good + LoadById(); # good Subroutines beginning with C<_> are special: they are not to be used outside the current object. There is not to be enforced by the code @@ -357,11 +356,11 @@ Do not use $_ (or assume it) except for when it is absolutely clear what is going on, or when it is required (such as with map() and grep()). - for (@list) { - print; # OK; everyone knows this one - print uc; # wrong; few people know this - print uc $_; # better - } + for (@list) { + print; # OK; everyone knows this one + print uc; # wrong; few people know this + print uc $_; # better + } Note that the special variable C<_> I<should> be used when possible. It is a placeholder that can be passed to stat() and the file test @@ -370,22 +369,22 @@ example below, using C<$file> over for each file test, instead of C<_> for subsequent uses, is a performance hit. You should be careful that the last-tested file is what you think it is, though. - if (-d $file) { # $file is a directory - # ... - } elsif (-l _) { # $file is a symlink - # ... - } + if (-d $file) { # $file is a directory + # ... + } elsif (-l _) { # $file is a symlink + # ... + } Package names begin with a capital letter in each word, followed by lower case letters (for the most part). Multiple words should be StudlyCapped. - RT::User # good - RT::Database::MySQL # proper name - RT::Display::Provider # good - RT::CustomField # not so good, but OK + RT::User # good + RT::Database::MySQL # proper name + RT::Display::Provider # good + RT::CustomField # not so good, but OK Plugin modules should begin with "RT::Extension::", followed by the name -of the plugin. +of the plugin. =head1 Code formatting @@ -397,25 +396,25 @@ All indents should be four spaces; hard tabs are forbidden. No space before a semicolon that closes a statement. - foo(@bar) ; # wrong - foo(@bar); # right + foo(@bar) ; # wrong + foo(@bar); # right Line up corresponding items vertically. - my $foo = 1; - my $bar = 2; - my $xyzzy = 3; + my $foo = 1; + my $bar = 2; + my $xyzzy = 3; - open(FILE, $fh) or die $!; - open(FILE2, $fh2) or die $!; + open(FILE, $fh) or die $!; + open(FILE2, $fh2) or die $!; - $rot13 =~ tr[abcedfghijklmnopqrstuvwxyz] - [nopqrstuvwxyzabcdefghijklm]; + $rot13 =~ tr[abcedfghijklmnopqrstuvwxyz] + [nopqrstuvwxyzabcdefghijklm]; - # note we use a-mn-z instead of a-z, - # for readability - $rot13 =~ tr[a-mn-z] - [n-za-m]; + # note we use a-mn-z instead of a-z, + # for readability + $rot13 =~ tr[a-mn-z] + [n-za-m]; Put blank lines between groups of code that do different things. Put blank lines after your variable declarations. Put a blank line before a @@ -424,19 +423,19 @@ before, with the exception of comment lines). An example: - # this is my function! - sub foo { - my $val = shift; - my $obj = new Constructor; - my($var1, $var2); + # this is my function! + sub foo { + my $val = shift; + my $obj = new Constructor; + my($var1, $var2); - $obj->SetFoo($val); - $var1 = $obj->Foo(); + $obj->SetFoo($val); + $var1 = $obj->Foo(); - return($val); - } + return($val); + } - print 1; + print 1; =head2 Parentheses @@ -444,19 +443,19 @@ An example: For control structures, there is a space between the keyword and opening parenthesis. For functions, there is not. - for(@list) # wrong - for (@list) # right + for(@list) # wrong + for (@list) # right - my ($ref) # wrong - my($ref) # right + my ($ref) # wrong + my($ref) # right Be careful about list vs. scalar context with parentheses! - my @array = ('a', 'b', 'c'); - my($first_element) = @array; # a - my($first_element) = ('a', 'b', 'c'); # a - my $element_count = @array; # 3 - my $last_element = ('a', 'b', 'c'); # c + my @array = ('a', 'b', 'c'); + my($first_element) = @array; # a + my($first_element) = ('a', 'b', 'c'); # a + my $element_count = @array; # 3 + my $last_element = ('a', 'b', 'c'); # c Always include parentheses after functions, even if there are no arguments. There are some exceptions, such as list operators (like print) and unary @@ -465,27 +464,27 @@ operators (like undef, delete, uc). There is no space inside the parentheses, unless it is needed for readability. - for ( map { [ $_, 1 ] } @list ) # OK - for ( @list ) # not really OK, not horrible + for ( map { [ $_, 1 ] } @list ) # OK + for ( @list ) # not really OK, not horrible On multi-line expressions, match up the closing parenthesis with either the opening statement, or the opening parenthesis, whichever works best. Examples: - @list = qw( - bar - baz - ); # right + @list = qw( + bar + baz + ); # right - if ($foo && $bar && $baz - && $buz && $xyzzy) { - print $foo; - } + if ($foo && $bar && $baz + && $buz && $xyzzy) { + print $foo; + } Whether or not there is space following a closing parenthesis is dependent on what it is that follows. - print foo(@bar), baz(@buz) if $xyzzy; + print foo(@bar), baz(@buz) if $xyzzy; Note also that parentheses around single-statement control expressions, as in C<if $xyzzy>, are optional (and discouraged) C<if> it is I<absolutely> @@ -500,19 +499,19 @@ function call in the statement, or the function call is separated by a flow control operator). User-supplied functions must always include parentheses. - print 1, 2, 3; # good - delete $hash{key} if isAnon($uid); # good + print 1, 2, 3; # good + delete $hash{key} if isAnon($uid); # good However, if there is any possible confusion at all, then include the parentheses. Remember the words of Larry Wall in the perlstyle manpage: - When in doubt, parenthesize. At the very least it will - let some poor schmuck bounce on the % key in vi. + When in doubt, parenthesize. At the very least it will + let some poor schmuck bounce on the % key in vi. - Even if you aren't in doubt, consider the mental welfare - of the person who has to maintain the code after you, and - who will probably put parens in the wrong place. + Even if you aren't in doubt, consider the mental welfare + of the person who has to maintain the code after you, and + who will probably put parens in the wrong place. So leave them out when it is absoutely clear to a programmer, but if there is any question, leave them in. @@ -524,30 +523,30 @@ there is any question, leave them in. There is always a space befor the opening brace. - while (<$fh>){ # wrong - while (<$fh>) { # right + while (<$fh>){ # wrong + while (<$fh>) { # right A one-line block may be put on one line, and the semicolon may be omitted. - for (@list) { print } + for (@list) { print } Otherwise, finish each statement with a semicolon, put the keyword and opening curly on the first line, and the ending curly lined up with the keyword at the end. - for (@list) { - print; - smell(); - } + for (@list) { + print; + smell(); + } Generally, we prefer "cuddled elses": - if ($foo) { - print; - } else { - die; - } + if ($foo) { + print; + } else { + die; + } =head2 Operators @@ -555,28 +554,28 @@ Put space around most operators. The primary exception is the for aesthetics; e.g., sometimes the space around "**" is ommitted, and there is never a space before a ",", but always after. - print $x , $y; # wrong - print $x, $y; # right + print $x , $y; # wrong + print $x, $y; # right - $x = 2 >> 1; # good - $y = 2**2; # ok + $x = 2 >> 1; # good + $y = 2**2; # ok -Note that "&&" and "||" have a higher precedence than "and" and "or". +Note that "&&" and "||" have a higher precedence than "and" and "or". Other than that, they are exactly the same. It is best to use the lower precedence version for control, and the higher for testing/returning values. Examples: - $bool = $flag1 or $flag2; # WRONG (doesn't work) - $value = $foo || $bar; # right - open(FILE, $file) or die $!; + $bool = $flag1 or $flag2; # WRONG (doesn't work) + $value = $foo || $bar; # right + open(FILE, $file) or die $!; - $true = foo($bar) && baz($buz); - foo($bar) and baz($buz); + $true = foo($bar) && baz($buz); + foo($bar) and baz($buz); Note that "and" is seldom ever used, because the statement above is better written using "if": - baz($buz) if foo($bar); + baz($buz) if foo($bar); Most of the time, the confusion between and/&&, or/|| can be alleviated by using parentheses. If you want to leave off the parentheses then you @@ -589,51 +588,51 @@ Break long lines AFTER operators, except for ".", "and", "or", "&&", "||". Try to keep the two parts to a binary operator (an operator that has two operands) together when possible. - print "foo" . "bar" . "baz" . - "buz"; # wrong + print "foo" . "bar" . "baz" . + "buz"; # wrong - print "foo" . "bar" . "baz" - . "buz"; # right + print "foo" . "bar" . "baz" + . "buz"; # right - print $foo unless $x == 3 && $y == - 4 && $z == 5; # wrong + print $foo unless $x == 3 && $y == + 4 && $z == 5; # wrong - print $foo unless $x == 3 && $y == 4 - && $z == 5; # right + print $foo unless $x == 3 && $y == 4 + && $z == 5; # right =head2 Other Put space around a complex subscript inside the brackets or braces. - $foo{$bar{baz}{buz}}; # OK - $foo{ $bar{baz}{buz} }; # better + $foo{$bar{baz}{buz}}; # OK + $foo{ $bar{baz}{buz} }; # better In general, use single-quotes around literals, and double-quotes -when the text needs to be interpolated. +when the text needs to be interpolated. It is OK to omit quotes around names in braces and when using the => operator, but be careful not to use a name that doubles as a function; in that case, quote. - $what{'time'}{it}{is} = time(); + $what{'time'}{it}{is} = time(); When making compound statements, put the primary action first. - open(FILE, $fh) or die $!; # right - die $! unless open(FILE, $fh); # wrong + open(FILE, $fh) or die $!; # right + die $! unless open(FILE, $fh); # wrong - print "Starting\n" if $verbose; # right - $verbose && print "Starting\n"; # wrong + print "Starting\n" if $verbose; # right + $verbose && print "Starting\n"; # wrong Use here-docs instead of repeated print statements. - print <<EOT; - This is a whole bunch of text. - I like it. I don't need to worry about messing - with lots of print statements and lining them up. - EOT + print <<EOT; + This is a whole bunch of text. + I like it. I don't need to worry about messing + with lots of print statements and lining them up. + EOT Just remember that unless you put single quotes around your here-doc token (<<'EOT'), the text will be interpolated, so escape any "$" or "@" @@ -651,50 +650,50 @@ as needed. Templates should use the /l filtering component to call the localisation framework -The string Foo! +The string Foo! -Should become <&|/l&>Foo!</&> +Should become <&|/l&>Foo!</&> -All newlines should be removed from localized strings, to make it easy to +All newlines should be removed from localized strings, to make it easy to grep the codebase for strings to be localized -The string Foo - Bar - Baz +The string Foo + Bar + Baz -Should become <&|/l&>Foo Bar Baz</&> +Should become <&|/l&>Foo Bar Baz</&> Variable subsititutions should be moved to Locale::MakeText format -The string Hello, <%$name %> +The string Hello, <%$name %> -should become <&|/l, $name &>Hello, [_1]</&> +should become <&|/l, $name &>Hello, [_1]</&> Multiple variables work just like single variables - -The string You found <%$num%> tickets in queue <%$queue%> -should become <&|/l, $num, $queue &>You found [_1] tickets in queue [_2]</&> +The string You found <%$num%> tickets in queue <%$queue%> + +should become <&|/l, $num, $queue &>You found [_1] tickets in queue [_2]</&> When subcomponents are called in the middle of a phrase, they need to be escaped too: -The string <input type="submit" value="New ticket in"> <& /Elements/SelectNewTicketQueue&> +The string <input type="submit" value="New ticket in"> <& /Elements/SelectNewTicketQueue&> -should become <&|/l, $m->scomp('/Elements/SelectNewTicketQueue')&><input type="submit" value="New ticket in"> [_1]</&> +should become <&|/l, $m->scomp('/Elements/SelectNewTicketQueue')&><input type="submit" value="New ticket in"> [_1]</&> -The string <& /Elements/TitleBoxStart, width=> "40%", titleright => "RT $RT::VERSION for RT->Config->Get('rtname')", title => 'Login' &> +The string <& /Widgets/TitleBoxStart, width=> "40%", titleright => "RT $RT::VERSION for RT->Config->Get('rtname')", title => 'Login' &> -should become <& /Elements/TitleBoxStart, - width=> "40%", - titleright => loc("RT [_1] for [_2]",$RT::VERSION, RT->Config->Get('rtname')), - title => loc('Login'), - &> +should become <& /Widgets/TitleBoxStart, + width=> "40%", + titleright => loc("RT [_1] for [_2]",$RT::VERSION, RT->Config->Get('rtname')), + title => loc('Login'), + &> =item Library code @@ -702,15 +701,15 @@ should become <& /Elements/TitleBoxStart, Within RT's core code, every module has a localization handle available through the 'loc' method: -The code return ( $id, "Queue created" ); +The code return ( $id, "Queue created" ); -should become return ( $id, $self->loc("Queue created") ); +should become return ( $id, $self->loc("Queue created") ); When returning or localizing a single string, the "extra" set of parenthesis () should be omitted. -The code return ("Subject changed to ". $self->Data ); +The code return ("Subject changed to ". $self->Data ); -should become return $self->loc( "Subject changed to [_1]", $self->Data ); +should become return $self->loc( "Subject changed to [_1]", $self->Data ); It is important not to localize the names of rights or statuses within RT's core, as there is logic that depends on them as string identifiers. The proper place to localize these values is when they're presented for display in the web or commandline interfaces. @@ -727,7 +726,7 @@ This is for new programs, modules, specific APIs, or anything else. =item Present idea to rt-devel We may know of a better way to approach the problem, or know of an -existing way to deal with it, or know someone else is working on it. +existing way to deal with it, or know someone else is working on it. This is mostly informal, but a fairly complete explanation for the need and use of the code should be provided. @@ -823,7 +822,7 @@ Talk about DBIx::SearchBuilder Talk about mason component style cascading style sheets - + Talk about adding a new translation Talk more about logging diff --git a/rt/lib/RT/System.pm b/rt/lib/RT/System.pm index 4562238..994825d 100644 --- a/rt/lib/RT/System.pm +++ b/rt/lib/RT/System.pm @@ -72,75 +72,64 @@ use warnings; use base qw/RT::Record/; -use RT::ACL; +use Role::Basic 'with'; +with "RT::Record::Role::Roles", + "RT::Record::Role::Rights" => { -excludes => [qw/AvailableRights RightCategories/] }; -# System rights are rights granted to the whole system -# XXX TODO Can't localize these outside of having an object around. -our $RIGHTS = { - SuperUser => 'Do anything and everything', # loc_pair - AdminUsers => 'Create, modify and delete users', # loc_pair - ModifySelf => "Modify one's own RT account", # loc_pair - ShowConfigTab => "Show Configuration tab", # loc_pair - ShowApprovalsTab => "Show Approvals tab", # loc_pair - ShowGlobalTemplates => "Show global templates", # loc_pair - LoadSavedSearch => "Allow loading of saved searches", # loc_pair - CreateSavedSearch => "Allow creation of saved searches", # loc_pair - ExecuteCode => "Allow writing Perl code in templates, scrips, etc", # loc_pair -}; - -our $RIGHT_CATEGORIES = { - SuperUser => 'Admin', - AdminUsers => 'Admin', - ModifySelf => 'Staff', - ShowConfigTab => 'Admin', - ShowApprovalsTab => 'Admin', - ShowGlobalTemplates => 'Staff', - LoadSavedSearch => 'General', - CreateSavedSearch => 'General', - ExecuteCode => 'Admin', -}; - -# Tell RT::ACE that this sort of object can get acls granted -$RT::ACE::OBJECT_TYPES{'RT::System'} = 1; - -__PACKAGE__->AddRights(%$RIGHTS); -__PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES); +use RT::ACL; +use RT::ACE; +use Data::GUID; + +__PACKAGE__->AddRight( Admin => SuperUser => 'Do anything and everything'); # loc +__PACKAGE__->AddRight( Staff => ShowUserHistory => 'Show history of public user properties'); # loc +__PACKAGE__->AddRight( Admin => AdminUsers => 'Create, modify and delete users'); # loc +__PACKAGE__->AddRight( Staff => ModifySelf => "Modify one's own RT account"); # loc +__PACKAGE__->AddRight( Staff => ShowArticlesMenu => 'Show Articles menu'); # loc +__PACKAGE__->AddRight( Admin => ShowConfigTab => 'Show Admin menu'); # loc +__PACKAGE__->AddRight( Admin => ShowApprovalsTab => 'Show Approvals tab'); # loc +__PACKAGE__->AddRight( Staff => ShowGlobalTemplates => 'Show global templates'); # loc +__PACKAGE__->AddRight( General => LoadSavedSearch => 'Allow loading of saved searches'); # loc +__PACKAGE__->AddRight( General => CreateSavedSearch => 'Allow creation of saved searches'); # loc +__PACKAGE__->AddRight( Admin => ExecuteCode => 'Allow writing Perl code in templates, scrips, etc'); # loc =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 the rights do. +Returns a hashref of available rights for this object. The keys are the +right names and the values are a description of what the rights do. -This method as well returns rights of other RT objects, -like L<RT::Queue> or L<RT::Group>. To allow users to apply -those rights globally. +This method as well returns rights of other RT objects, like +L<RT::Queue> or L<RT::Group>, to allow users to apply those rights +globally. -=cut +If an L<RT::Principal> is passed as the first argument, the available +rights will be limited to ones which make sense for the principal. +Currently only role groups are supported and rights announced by object +types to which the role group doesn't apply are not returned. +=cut -use RT::CustomField; -use RT::Queue; -use RT::Group; -use RT::Class; sub AvailableRights { my $self = shift; + my $principal = shift; + my $class = ref($self) || $self; + + my @rights; + if ($principal and $principal->IsRoleGroup) { + my $role = $principal->Object->Name; + for my $class (keys %RT::ACE::RIGHTS) { + next unless $class->DOES('RT::Record::Role::Roles') and $class->HasRole($role) and $class ne "RT::System"; + push @rights, values %{ $RT::ACE::RIGHTS{$class} }; + } + } else { + @rights = map {values %{$_}} values %RT::ACE::RIGHTS; + } - my $queue = RT::Queue->new(RT->SystemUser); - my $group = RT::Group->new(RT->SystemUser); - my $cf = RT::CustomField->new(RT->SystemUser); - my $class = RT::Class->new(RT->SystemUser); - - my $qr = $queue->AvailableRights(); - my $gr = $group->AvailableRights(); - my $cr = $cf->AvailableRights(); - my $clr = $class->AvailableRights(); + my %rights; + $rights{$_->{Name}} = $_->{Description} for @rights; - # Build a merged list of all system wide rights, queue rights and group rights. - my %rights = (%{$RIGHTS}, %{$gr}, %{$qr}, %{$cr}, %{$clr}); delete $rights{ExecuteCode} if RT->Config->Get('DisallowExecuteCode'); - return(\%rights); + return \%rights; } =head2 RightCategories @@ -152,49 +141,12 @@ values are the category (General, Staff, Admin) the right falls into. sub RightCategories { my $self = shift; + my $class = ref($self) || $self; - my $queue = RT::Queue->new(RT->SystemUser); - my $group = RT::Group->new(RT->SystemUser); - my $cf = RT::CustomField->new(RT->SystemUser); - my $class = RT::Class->new(RT->SystemUser); - - my $qr = $queue->RightCategories(); - my $gr = $group->RightCategories(); - my $cr = $cf->RightCategories(); - my $clr = $class->RightCategories(); - - # Build a merged list of all system wide rights, queue rights and group rights. - my %rights = (%{$RIGHT_CATEGORIES}, %{$gr}, %{$qr}, %{$cr}, %{$clr}); - - return(\%rights); -} - -=head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...] - -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 if ref $_[0] or $_[0] eq __PACKAGE__; - my %new = @_; - $RIGHTS = { %$RIGHTS, %new }; - %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES, - map { lc($_) => $_ } keys %new); -} - -=head2 AddRightCategories C<RIGHT>, C<CATEGORY> [, ...] - -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 }; + my %rights; + $rights{$_->{Name}} = $_->{Category} + for map {values %{$_}} values %RT::ACE::RIGHTS; + return \%rights; } sub _Init { @@ -211,6 +163,8 @@ Returns RT::System's id. It's 1. *Id = \&id; sub id { return 1 } +sub UID { return "RT::System" } + =head2 Load Since this object is pretending to be an RT::Record, we need a load method. @@ -261,6 +215,122 @@ sub QueueCacheNeedsUpdate { } } +=head2 AddUpgradeHistory package, data + +Adds an entry to the upgrade history database. The package can be either C<RT> +for core RT upgrades, or the fully qualified name of a plugin. The data must be +a hash reference. + +=cut + +sub AddUpgradeHistory { + my $self = shift; + my $package = shift; + my $data = shift; + + $data->{timestamp} ||= time; + $data->{rt_version} ||= $RT::VERSION; + + my $upgrade_history_attr = $self->FirstAttribute('UpgradeHistory'); + my $upgrade_history = $upgrade_history_attr ? $upgrade_history_attr->Content : {}; + + push @{ $upgrade_history->{$package} }, $data; + + $self->SetAttribute( + Name => 'UpgradeHistory', + Content => $upgrade_history, + ); +} + +=head2 UpgradeHistory [package] + +Returns the entries of RT's upgrade history. If a package is specified, the list +of upgrades for that package will be returned. Otherwise a hash reference of +C<< package => [upgrades] >> will be returned. + +=cut + +sub UpgradeHistory { + my $self = shift; + my $package = shift; + + my $upgrade_history_attr = $self->FirstAttribute('UpgradeHistory'); + my $upgrade_history = $upgrade_history_attr ? $upgrade_history_attr->Content : {}; + + if ($package) { + return @{ $upgrade_history->{$package} || [] }; + } + + return $upgrade_history; +} + +sub ParsedUpgradeHistory { + my $self = shift; + my $package = shift; + + my $version_status = "Current version: "; + if ( $package eq 'RT' ){ + $version_status .= $RT::VERSION; + } elsif ( grep {/$package/} @{RT->Config->Get('Plugins')} ) { + no strict 'refs'; + $version_status .= ${ $package . '::VERSION' }; + } else { + $version_status = "Not currently loaded"; + } + + my %ids; + my @lines; + + my @events = $self->UpgradeHistory( $package ); + for my $event (@events) { + if ($event->{stage} eq 'before' or (($event->{action}||'') eq 'insert' and not $event->{full_id})) { + if (not $event->{full_id}) { + # For upgrade done in the 4.1 series without GUIDs + if (($event->{type}||'') eq 'full upgrade') { + $event->{full_id} = $event->{individual_id} = Data::GUID->new->as_string; + } else { + $event->{individual_id} = Data::GUID->new->as_string; + $event->{full_id} = (@lines ? $lines[-1]{full_id} : Data::GUID->new->as_string); + } + $event->{return_value} = [1] if $event->{stage} eq 'after'; + } + if ($ids{$event->{full_id}}) { + my $kids = $ids{$event->{full_id}}{sub_events} ||= []; + # Stitch non-"upgrade"s beneath the previous "upgrade" + if ( @{$kids} and $event->{action} ne 'upgrade' and $kids->[-1]{action} eq 'upgrade') { + push @{ $kids->[-1]{sub_events} }, $event; + } else { + push @{ $kids }, $event; + } + } else { + push @lines, $event; + } + $ids{$event->{individual_id}} = $event; + } elsif ($event->{stage} eq 'after') { + if (not $event->{individual_id}) { + if (($event->{type}||'') eq 'full upgrade') { + $lines[-1]{end} = $event->{timestamp} if @lines; + } elsif (($event->{type}||'') eq 'individual upgrade') { + $lines[-1]{sub_events}[-1]{end} = $event->{timestamp} + if @lines and @{ $lines[-1]{sub_events} }; + } + } elsif ($ids{$event->{individual_id}}) { + my $end = $event; + $event = $ids{$event->{individual_id}}; + $event->{end} = $end->{timestamp}; + + $end->{return_value} = [ split ', ', $end->{return_value}, 2 ] + if $end->{return_value} and not ref $end->{return_value}; + $event->{return_value} = $end->{return_value}; + $event->{content} ||= $end->{content}; + } + } + } + + return ($version_status, @lines); +} + + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Template.pm b/rt/lib/RT/Template.pm index ecf0946..4b55443 100755 --- a/rt/lib/RT/Template.pm +++ b/rt/lib/RT/Template.pm @@ -70,7 +70,9 @@ package RT::Template; use strict; use warnings; +use base 'RT::Record'; +use RT::Queue; use Text::Template; use MIME::Entity; @@ -151,7 +153,7 @@ Load a template, either by number or by name. Note that loading templates by name using this method B<is ambiguous>. Several queues may have template with the same name and as well global template with the same name may exist. -Use L</LoadGlobalTemplate> and/or L<LoadQueueTemplate> to get +Use L</LoadByName>, L</LoadGlobalTemplate> or L<LoadQueueTemplate> to get precise result. =cut @@ -167,6 +169,37 @@ sub Load { return $self->LoadById( $identifier ); } +=head2 LoadByName + +Takes Name and Queue arguments. Tries to load queue specific template +first, then global. If Queue argument is omitted then global template +is tried, not template with the name in any queue. + +=cut + +sub LoadByName { + my $self = shift; + my %args = ( + Queue => undef, + Name => undef, + @_ + ); + my $queue = $args{'Queue'}; + if ( blessed $queue ) { + $queue = $queue->id; + } elsif ( defined $queue and $queue =~ /\D/ ) { + my $tmp = RT::Queue->new( $self->CurrentUser ); + $tmp->Load($queue); + $queue = $tmp->id; + } + + return $self->LoadGlobalTemplate( $args{'Name'} ) unless $queue; + + $self->LoadQueueTemplate( Queue => $queue, Name => $args{'Name'} ); + return $self->id if $self->id; + return $self->LoadGlobalTemplate( $args{'Name'} ); +} + =head2 LoadGlobalTemplate NAME Load the global template with the name NAME @@ -185,18 +218,7 @@ sub LoadGlobalTemplate { Loads the Queue template named NAME for Queue QUEUE. Note that this method doesn't load a global template with the same name -if template in the queue doesn't exist. THe following code can be used: - - $template->LoadQueueTemplate( Queue => $queue_id, Name => $template_name ); - unless ( $template->id ) { - $template->LoadGlobalTemplate( $template_name ); - unless ( $template->id ) { - # no template - ... - } - } - # ok, template either queue's or global - ... +if template in the queue doesn't exist. Use L</LoadByName>. =cut @@ -256,6 +278,16 @@ sub Create { $args{'Queue'} = $QueueObj->Id; } + return ( undef, $self->loc('Name is required') ) + unless $args{Name}; + + { + my $tmp = $self->new( RT->SystemUser ); + $tmp->LoadByCols( Name => $args{'Name'}, Queue => $args{'Queue'} ); + return ( undef, $self->loc('A Template with that name already exists') ) + if $tmp->id; + } + my ( $result, $msg ) = $self->SUPER::Create( Content => $args{'Content'}, Queue => $args{'Queue'}, @@ -285,9 +317,28 @@ sub Delete { return ( 0, $self->loc('Permission Denied') ); } + if ( !$self->IsOverride && $self->UsedBy->Count ) { + return ( 0, $self->loc('Template is in use') ); + } + return ( $self->SUPER::Delete(@_) ); } +=head2 UsedBy + +Returns L<RT::Scrips> limitted to scrips that use this template. Takes +into account that template can be overriden in a queue. + +=cut + +sub UsedBy { + my $self = shift; + + my $scrips = RT::Scrips->new( $self->CurrentUser ); + $scrips->LimitByTemplate( $self ); + return $scrips; +} + =head2 IsEmpty Returns true value if content of the template is empty, otherwise @@ -302,6 +353,23 @@ sub IsEmpty { return 1; } +=head2 IsOverride + +Returns true if it's queue specific template and there is global +template with the same name. + +=cut + +sub IsOverride { + my $self = shift; + return 0 unless $self->Queue; + + my $template = RT::Template->new( $self->CurrentUser ); + $template->LoadGlobalTemplate( $self->Name ); + return $template->id; +} + + =head2 MIMEObj Returns L<MIME::Entity> object parsed using L</Parse> method. Returns @@ -419,9 +487,6 @@ sub _ParseContent { } my $content = $self->SUPER::_Value('Content'); - # We need to untaint the content of the template, since we'll be working - # with it - $content =~ s/^(.*)$/$1/; $args{'Ticket'} = delete $args{'TicketObj'} if $args{'TicketObj'}; $args{'Transaction'} = delete $args{'TransactionObj'} if $args{'TransactionObj'}; @@ -571,7 +636,10 @@ sub _MassageSimpleTemplateArgs { my $cfs = $ticket->CustomFields; while (my $cf = $cfs->Next) { - $template_args->{"TicketCF" . $cf->Name} = $ticket->CustomFieldValuesAsString($cf->Name); + my $simple = $cf->Name; + $simple =~ s/\W//g; + $template_args->{"TicketCF" . $simple} + = $ticket->CustomFieldValuesAsString($cf->Name); } } @@ -582,7 +650,10 @@ sub _MassageSimpleTemplateArgs { my $cfs = $txn->CustomFields; while (my $cf = $cfs->Next) { - $template_args->{"TransactionCF" . $cf->Name} = $txn->CustomFieldValuesAsString($cf->Name); + my $simple = $cf->Name; + $simple =~ s/\W//g; + $template_args->{"TransactionCF" . $simple} + = $txn->CustomFieldValuesAsString($cf->Name); } } } @@ -597,23 +668,16 @@ sub _DowngradeFromHTML { $orig_entity->head->mime_attr( "Content-Type" => 'text/html' ); $orig_entity->head->mime_attr( "Content-Type.charset" => 'utf-8' ); - $orig_entity->make_multipart('alternative', Force => 1); - require HTML::FormatText; - require HTML::TreeBuilder; - # MIME objects are always bytes, not characters - my $tree = HTML::TreeBuilder->new_from_content( - Encode::decode( 'UTF-8', $new_entity->bodyhandle->as_string) - ); - my $text = HTML::FormatText->new( - leftmargin => 0, - rightmargin => 78, - )->format( $tree ); - $text = Encode::encode( "UTF-8", $text ); + my $body = $new_entity->bodyhandle->as_string; + $body = Encode::decode( "UTF-8", $body ); + my $html = RT::Interface::Email::ConvertHTMLToText( $body ); + $html = Encode::encode( "UTF-8", $html ); + return unless defined $html; - $new_entity->bodyhandle(MIME::Body::InCore->new( \$text )); - $tree->delete; + $new_entity->bodyhandle(MIME::Body::InCore->new( \$html )); + $orig_entity->make_multipart('alternative', Force => 1); $orig_entity->add_part($new_entity, 0); # plain comes before html $self->{MIMEObj} = $orig_entity; @@ -631,6 +695,41 @@ sub CurrentUserHasQueueRight { return ( $self->QueueObj->CurrentUserHasRight(@_) ); } +=head2 SetQueue + +Changing queue is not implemented. + +=cut + +sub SetQueue { + my $self = shift; + return ( undef, $self->loc('Changing queue is not implemented') ); +} + +=head2 SetName + +Change name of the template. + +=cut + +sub SetName { + my $self = shift; + my $value = shift; + + return ( undef, $self->loc('Name is required') ) + unless $value; + + return $self->_Set( Field => 'Name', Value => $value ) + if lc($self->Name) eq lc($value); + + my $tmp = $self->new( RT->SystemUser ); + $tmp->LoadByCols( Name => $value, Queue => $self->Queue ); + return ( undef, $self->loc('A Template with that name already exists') ) + if $tmp->id; + + return $self->_Set( Field => 'Name', Value => $value ); +} + =head2 SetType If setting Type to Perl, require the ExecuteCode right. @@ -754,9 +853,6 @@ sub CurrentUserCanRead { 1; -use RT::Queue; -use base 'RT::Record'; - sub Table {'Templates'} @@ -799,10 +895,10 @@ Returns the Queue Object which has the id returned by Queue =cut sub QueueObj { - my $self = shift; - my $Queue = RT::Queue->new($self->CurrentUser); - $Queue->Load($self->__Value('Queue')); - return($Queue); + my $self = shift; + my $Queue = RT::Queue->new($self->CurrentUser); + $Queue->Load($self->__Value('Queue')); + return($Queue); } =head2 Name @@ -859,42 +955,6 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure. =cut -=head2 Language - -Returns the current value of Language. -(In the database, Language is stored as varchar(16).) - - - -=head2 SetLanguage VALUE - - -Set Language to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Language will be stored as a varchar(16).) - - -=cut - - -=head2 TranslationOf - -Returns the current value of TranslationOf. -(In the database, TranslationOf is stored as int(11).) - - - -=head2 SetTranslationOf VALUE - - -Set TranslationOf to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TranslationOf will be stored as a int(11).) - - -=cut - - =head2 Content Returns the current value of Content. @@ -954,33 +1014,82 @@ 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 => ''}, Queue => - {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'}, Name => - {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', 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 => ''}, Type => - {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, - Language => - {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, - TranslationOf => - {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 => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, Content => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, 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 => ''}, 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'}, 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->QueueObj ) if $self->QueueObj->Id; +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# Scrips + push( @$list, $self->UsedBy ); + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'}, + ); + + return $self->SUPER::__DependsOn( %args ); +} + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + $class->SUPER::PreInflate( $importer, $uid, $data ); + + my $obj = RT::Template->new( RT->SystemUser ); + if ($data->{Queue} == 0) { + $obj->LoadGlobalTemplate( $data->{Name} ); + } else { + $obj->LoadQueueTemplate( Queue => $data->{Queue}, Name => $data->{Name} ); + } + + if ($obj->Id) { + $importer->Resolve( $uid => ref($obj) => $obj->Id ); + return; + } + + return 1; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Templates.pm b/rt/lib/RT/Templates.pm index 06d2191..93ed4fc 100755 --- a/rt/lib/RT/Templates.pm +++ b/rt/lib/RT/Templates.pm @@ -68,10 +68,10 @@ package RT::Templates; use strict; use warnings; -use RT::Template; - use base 'RT::SearchBuilder'; +use RT::Template; + sub Table { 'Templates'} @@ -140,18 +140,6 @@ sub AddRecord { return $self->SUPER::AddRecord( $record ); } -=head2 NewItem - -Returns an empty new RT::Template item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Template->new($self->CurrentUser)); -} - - RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Test.pm b/rt/lib/RT/Test.pm index 8b227a7..6afb311 100644 --- a/rt/lib/RT/Test.pm +++ b/rt/lib/RT/Test.pm @@ -55,6 +55,11 @@ BEGIN { $^W = 1 }; use base 'Test::More'; +BEGIN { + # Warn about role consumers overriding role methods so we catch it in tests. + $ENV{PERL_ROLE_OVERRIDE_WARN} = 1; +} + # We use the Test::NoWarnings catching and reporting functionality, but need to # wrap it in our own special handler because of the warn handler installed via # RT->InitLogging(). @@ -67,6 +72,8 @@ use Socket; use File::Temp qw(tempfile); use File::Path qw(mkpath); use File::Spec; +use File::Which qw(); +use Scalar::Util qw(blessed); our @EXPORT = qw(is_empty diag parse_mail works fails plan done_testing); @@ -110,7 +117,8 @@ BEGIN { sub import { my $class = shift; - my %args = %rttest_opt = @_; + my %args = @_; + %rttest_opt = %args; $rttest_opt{'nodb'} = $args{'nodb'} = 1 if $^C; @@ -133,6 +141,8 @@ sub import { if $args{'requires'}; push @{ $args{'plugins'} ||= [] }, $args{'testing'} if $args{'testing'}; + push @{ $args{'plugins'} ||= [] }, split " ", $ENV{RT_TEST_PLUGINS} + if $ENV{RT_TEST_PLUGINS}; $class->bootstrap_tempdir; @@ -143,13 +153,15 @@ sub import { $class->bootstrap_config( %args ); use RT; - RT::LoadConfig; - if (RT->Config->Get('DevelMode')) { require Module::Refresh; } + RT::LoadConfig; RT::InitPluginPaths(); RT::InitClasses(); + RT::I18N->Init(); + + $class->set_config_wrapper; $class->bootstrap_db( %args ); __reconnect_rt() @@ -159,11 +171,8 @@ sub import { RT->Plugins; - RT::I18N->Init(); RT->Config->PostLoadCheck; - $class->set_config_wrapper; - $class->encode_output; my $screen_logger = $RT::Logger->remove( 'screen' ); @@ -185,6 +194,12 @@ sub import { $level++; } + # By default we test HTML templates, but text templates are + # available on request + if ( $args{'text_templates'} ) { + $class->switch_templates_ok('text'); + } + Test::More->export_to_level($level); Test::NoWarnings->export_to_level($level); @@ -291,8 +306,9 @@ sub bootstrap_config { Set( \$WebDomain, "localhost"); Set( \$WebPort, $port); Set( \$WebPath, ""); -Set( \@LexiconLanguages, qw(en zh_TW fr ja)); +Set( \@LexiconLanguages, qw(en zh_TW zh_CN fr ja)); Set( \$RTAddressRegexp , qr/^bad_re_that_doesnt_match\$/i); +Set( \$ShowHistory, "always"); }; if ( $ENV{'RT_TEST_DB_SID'} ) { # oracle case print $config "Set( \$DatabaseName , '$ENV{'RT_TEST_DB_SID'}' );\n"; @@ -370,7 +386,7 @@ sub bootstrap_logging { print $config <<END; Set( \$LogToSyslog , undef); -Set( \$LogToScreen , "warning"); +Set( \$LogToSTDERR , "warning"); Set( \$LogToFile, 'debug' ); Set( \$LogDir, q{$tmp{'directory'}} ); Set( \$LogToFileNamed, 'rt.debug.log' ); @@ -382,6 +398,56 @@ sub set_config_wrapper { my $old_sub = \&RT::Config::Set; no warnings 'redefine'; + + *RT::Config::WriteSet = sub { + my ($self, $name) = @_; + my $type = $RT::Config::META{$name}->{'Type'} || 'SCALAR'; + my %sigils = ( + HASH => '%', + ARRAY => '@', + SCALAR => '$', + ); + my $sigil = $sigils{$type} || $sigils{'SCALAR'}; + open( my $fh, '<', $tmp{'config'}{'RT'} ) + or die "Couldn't open config file: $!"; + my @lines; + while (<$fh>) { + if (not @lines or /^Set\(/) { + push @lines, $_; + } else { + $lines[-1] .= $_; + } + } + close $fh; + + # Traim trailing newlines and "1;" + $lines[-1] =~ s/(^1;\n|^\n)*\Z//m; + + # Remove any previous definitions of this var + @lines = grep {not /^Set\(\s*\Q$sigil$name\E\b/} @lines; + + # Format the new value for output + require Data::Dumper; + local $Data::Dumper::Terse = 1; + my $dump = Data::Dumper::Dumper([@_[2 .. $#_]]); + $dump =~ s/;?\s+\Z//; + push @lines, "Set( ${sigil}${name}, \@{". $dump ."});\n"; + push @lines, "\n1;\n"; + + # Re-write the configuration file + open( $fh, '>', $tmp{'config'}{'RT'} ) + or die "Couldn't open config file: $!"; + print $fh $_ for @lines; + close $fh; + + if ( @SERVERS ) { + warn "you're changing config option in a test file" + ." when server is active"; + } + + return $old_sub->(@_); + }; + *RT::Config::Set = sub { # Determine if the caller is either from a test script, or # from helper functions called by test script to alter @@ -391,30 +457,9 @@ sub set_config_wrapper { my @caller = caller(1); # preserve list context @caller = caller(0) unless @caller; - if ( ($caller[1]||'') =~ /\.t$/) { - my ($self, $name) = @_; - my $type = $RT::Config::META{$name}->{'Type'} || 'SCALAR'; - my %sigils = ( - HASH => '%', - ARRAY => '@', - SCALAR => '$', - ); - my $sigil = $sigils{$type} || $sigils{'SCALAR'}; - open( my $fh, '>>', $tmp{'config'}{'RT'} ) - or die "Couldn't open config file: $!"; - require Data::Dumper; - local $Data::Dumper::Terse = 1; - my $dump = Data::Dumper::Dumper([@_[2 .. $#_]]); - $dump =~ s/;\s+$//; - print $fh - "\nSet(${sigil}${name}, \@{". $dump ."});\n1;\n"; - close $fh; - - if ( @SERVERS ) { - warn "you're changing config option in a test file" - ." when server is active"; - } - } + return RT::Config::WriteSet(@_) + if ($caller[1]||'') =~ /\.t$/; + return $old_sub->(@_); }; } @@ -450,6 +495,11 @@ sub bootstrap_db { } my $db_type = RT->Config->Get('DatabaseType'); + + if ($db_type eq "SQLite") { + RT->Config->WriteSet( DatabaseName => File::Spec->catfile( $self->temp_directory, "rt4test" ) ); + } + __create_database(); __reconnect_rt('as dba'); $RT::Handle->InsertSchema; @@ -490,7 +540,7 @@ sub bootstrap_plugins_paths { if ( grep $name eq $_, @plugins ) { my $variants = join "(?:|::|-|_)", map "\Q$_\E", split /::/, $name; - my ($path) = map $ENV{$_}, grep /^CHIMPS_(?:$variants).*_ROOT$/i, keys %ENV; + my ($path) = map $ENV{$_}, grep /^RT_TEST_PLUGIN_(?:$variants).*_ROOT$/i, keys %ENV; return $path if $path; } return $old_func->(@_); @@ -695,7 +745,10 @@ sub load_or_create_user { my $groups_alias = $gms->Join( FIELD1 => 'GroupId', TABLE2 => 'Groups', FIELD2 => 'id', ); - $gms->Limit( ALIAS => $groups_alias, FIELD => 'Domain', VALUE => 'UserDefined' ); + $gms->Limit( + ALIAS => $groups_alias, FIELD => 'Domain', VALUE => 'UserDefined', + CASESENSITIVE => 0, + ); $gms->Limit( FIELD => 'MemberId', VALUE => $obj->id ); while ( my $group_member_record = $gms->Next ) { $group_member_record->Delete; @@ -805,7 +858,7 @@ sub create_tickets { while ( @data ) { my %args = %{ shift @data }; $args{$_} = $res[ $args{$_} ]->id foreach - grep $args{ $_ }, keys %RT::Ticket::LINKTYPEMAP; + grep $args{ $_ }, keys %RT::Link::TYPEMAP; push @res, $self->create_ticket( %$defaults, %args ); } return @res; @@ -817,7 +870,10 @@ sub create_ticket { my $self = shift; my %args = @_; - if ($args{Queue} && $args{Queue} =~ /\D/) { + if ( blessed $args{'Queue'} ) { + $args{Queue} = $args{'Queue'}->id; + } + elsif ($args{Queue} && $args{Queue} =~ /\D/) { my $queue = RT::Queue->new(RT->SystemUser); if (my $id = $queue->Load($args{Queue}) ) { $args{Queue} = $id; @@ -836,6 +892,20 @@ sub create_ticket { ); } + if ( my $cfs = delete $args{'CustomFields'} ) { + my $q = RT::Queue->new( RT->SystemUser ); + $q->Load( $args{'Queue'} ); + while ( my ($k, $v) = each %$cfs ) { + my $cf = $q->CustomField( $k ); + unless ($cf->id) { + RT->Logger->error("Couldn't load custom field $k"); + next; + } + + $args{'CustomField-'. $cf->id} = $v; + } + } + my $ticket = RT::Ticket->new( RT->SystemUser ); my ( $id, undef, $msg ) = $ticket->Create( %args ); Test::More::ok( $id, "ticket created" ) @@ -894,7 +964,11 @@ sub load_or_create_custom_field { my %args = ( Disabled => 0, @_ ); my $obj = RT::CustomField->new( RT->SystemUser ); if ( $args{'Name'} ) { - $obj->LoadByName( Name => $args{'Name'}, Queue => $args{'Queue'} ); + $obj->LoadByName( + Name => $args{'Name'}, + LookupType => RT::Ticket->CustomFieldLookupType, + ObjectId => $args{'Queue'}, + ); } else { die "Name is required"; } @@ -932,7 +1006,7 @@ sub store_rights { my @res; while ( my $ace = $acl->Next ) { my $obj = $ace->PrincipalObj->Object; - if ( $obj->isa('RT::Group') && $obj->Type eq 'UserEquiv' && $obj->Instance == RT->Nobody->id ) { + if ( $obj->isa('RT::Group') && $obj->Domain eq 'ACLEquivalence' && $obj->Instance == RT->Nobody->id ) { next; } @@ -965,7 +1039,7 @@ sub set_rights { $acl->Limit( FIELD => 'RightName', OPERATOR => '!=', VALUE => 'SuperUser' ); while ( my $ace = $acl->Next ) { my $obj = $ace->PrincipalObj->Object; - if ( $obj->isa('RT::Group') && ($obj->Type||'') eq 'UserEquiv' && $obj->Instance == RT->Nobody->id ) { + if ( $obj->isa('RT::Group') && $obj->Domain eq 'ACLEquivalence' && $obj->Instance == RT->Nobody->id ) { next; } $ace->Delete; @@ -984,16 +1058,16 @@ sub add_rights { if ( $principal =~ /^(everyone|(?:un)?privileged)$/i ) { $principal = RT::Group->new( RT->SystemUser ); $principal->LoadSystemInternalGroup($1); - } elsif ( $principal =~ /^(Owner|Requestor|(?:Admin)?Cc)$/i ) { + } else { + my $type = $principal; $principal = RT::Group->new( RT->SystemUser ); - $principal->LoadByCols( - Domain => (ref($e->{'Object'})||'RT::System').'-Role', - Type => $1, - ref($e->{'Object'})? (Instance => $e->{'Object'}->id): (), + $principal->LoadRoleGroup( + Object => ($e->{'Object'} || RT->System), + Name => $type ); - } else { - die "principal is not an object, but also is not name of a system group"; } + die "Principal is not an object nor the name of a system or role group" + unless $principal->id; } unless ( $principal->isa('RT::Principal') ) { if ( $principal->can('PrincipalObj') ) { @@ -1009,6 +1083,46 @@ sub add_rights { return 1; } +=head2 switch_templates_to TYPE + +This runs /opt/rt4/etc/upgrade/switch-templates-to in order to change the templates from +HTML to text or vice versa. TYPE is the type to switch to, either C<html> or +C<text>. + +=cut + +sub switch_templates_to { + my $self = shift; + my $type = shift; + + return $self->run_and_capture( + command => "$RT::EtcPath/upgrade/switch-templates-to", + args => $type, + ); +} + +=head2 switch_templates_ok TYPE + +Calls L<switch_template_to> and tests the return values. + +=cut + +sub switch_templates_ok { + my $self = shift; + my $type = shift; + + my ($exit, $output) = $self->switch_templates_to($type); + + if ($exit >> 8) { + Test::More::fail("Switched templates to $type cleanly"); + diag("**** $RT::EtcPath/upgrade/switch-templates-to exited with ".($exit >> 8).":\n$output"); + } else { + Test::More::pass("Switched templates to $type cleanly"); + } + + return ($exit, $output); +} + sub run_mailgate { my $self = shift; @@ -1036,43 +1150,6 @@ sub run_mailgate { $self->run_and_capture(%args); } -sub run_validator { - my $self = shift; - my %args = (check => 1, resolve => 0, force => 1, timeout => 0, @_ ); - - my $validator_path = "$RT::SbinPath/rt-validator"; - - my $cmd = $validator_path; - die "Couldn't find $cmd command" unless -f $cmd; - - my $timeout = delete $args{timeout}; - - while( my ($k,$v) = each %args ) { - next unless $v; - $cmd .= " --$k '$v'"; - } - $cmd .= ' 2>&1'; - - require IPC::Open2; - my ($child_out, $child_in); - my $pid = IPC::Open2::open2($child_out, $child_in, $cmd); - close $child_in; - - local $SIG{ALRM} = sub { kill KILL => $pid; die "Timeout!" }; - - alarm $timeout if $timeout; - my $result = eval { local $/; <$child_out> }; - warn $@ if $@; - close $child_out; - waitpid $pid, 0; - alarm 0; - - DBIx::SearchBuilder::Record::Cachable->FlushCache - if $args{'resolve'}; - - return ($?, $result); -} - sub run_and_capture { my $self = shift; my %args = @_; @@ -1084,10 +1161,13 @@ sub run_and_capture { $cmd .= ' --debug' if delete $args{'debug'}; + my $args = delete $args{'args'}; + while( my ($k,$v) = each %args ) { next unless $v; $cmd .= " --$k '$v'"; } + $cmd .= " $args" if defined $args; $cmd .= ' 2>&1'; DBIx::SearchBuilder::Record::Cachable->FlushCache; @@ -1144,12 +1224,20 @@ sub send_via_mailgate { my ( $status, $error_message, $ticket ) = RT::Interface::Email::Gateway( {%args, message => $message} ); + + # Invert the status to act like a syscall; failing return code is 1, + # and it will be right-shifted before being examined. + $status = ($status == 1) ? 0 + : ($status == -75) ? (-75 << 8) + : (1 << 8); + return ( $status, $ticket ? $ticket->id : 0 ); } sub open_mailgate_ok { + local $Test::Builder::Level = $Test::Builder::Level + 1; my $class = shift; my $baseurl = shift; my $queue = shift || 'general'; @@ -1160,6 +1248,7 @@ sub open_mailgate_ok { sub close_mailgate_ok { + local $Test::Builder::Level = $Test::Builder::Level + 1; my $class = shift; my $mail = shift; close $mail; @@ -1167,6 +1256,7 @@ sub close_mailgate_ok { } sub mailsent_ok { + local $Test::Builder::Level = $Test::Builder::Level + 1; my $class = shift; my $expected = shift; @@ -1197,6 +1287,96 @@ sub clean_caught_mails { unlink $tmp{'mailbox'}; } +sub run_validator { + my $self = shift; + my %args = (check => 1, resolve => 0, force => 1, timeout => 0, @_ ); + + my $cmd = "$RT::SbinPath/rt-validator"; + die "Couldn't find $cmd command" unless -f $cmd; + + my $timeout = delete $args{timeout}; + + while( my ($k,$v) = each %args ) { + next unless $v; + $cmd .= " --$k '$v'"; + } + $cmd .= ' 2>&1'; + + require IPC::Open2; + my ($child_out, $child_in); + my $pid = IPC::Open2::open2($child_out, $child_in, $cmd); + close $child_in; + + local $SIG{ALRM} = sub { kill KILL => $pid; die "Timeout!" }; + + alarm $timeout if $timeout; + my $result = eval { local $/; <$child_out> }; + warn $@ if $@; + close $child_out; + waitpid $pid, 0; + alarm 0; + + DBIx::SearchBuilder::Record::Cachable->FlushCache + if $args{'resolve'}; + + return ($?, $result); +} + +sub db_is_valid { + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $self = shift; + my ($ecode, $res) = $self->run_validator; + Test::More::is( $ecode, 0, 'no invalid records' ) + or Test::More::diag "errors:\n$res"; +} + +=head2 object_scrips_are + +Takes an L<RT::Scrip> object or ID as the first argument and an arrayref of +L<RT::Queue> objects and/or Queue IDs as the second argument. + +The scrip's applications (L<RT::ObjectScrip> records) are tested to ensure they +exactly match the arrayref. + +An optional third arrayref may be passed to enumerate and test the queues the +scrip is B<not> added to. This is most useful for testing the API returns the +correct results. + +=cut + +sub object_scrips_are { + local $Test::Builder::Level = $Test::Builder::Level + 1; + my $self = shift; + my $scrip = shift; + my $to = shift || []; + my $not_to = shift; + + unless (blessed($scrip)) { + my $id = $scrip; + $scrip = RT::Scrip->new( RT->SystemUser ); + $scrip->Load($id); + } + + $to = [ map { blessed($_) ? $_->id : $_ } @$to ]; + Test::More::ok($scrip->IsAdded($_), "added to queue $_" ) foreach @$to; + Test::More::is_deeply( + [sort map $_->id, @{ $scrip->AddedTo->ItemsArrayRef }], + [sort grep $_, @$to ], + 'correct list of added to queues', + ); + + if ($not_to) { + $not_to = [ map { blessed($_) ? $_->id : $_ } @$not_to ]; + Test::More::ok(!$scrip->IsAdded($_), "not added to queue $_" ) foreach @$not_to; + Test::More::is_deeply( + [sort map $_->id, @{ $scrip->NotAddedTo->ItemsArrayRef }], + [sort grep $_, @$not_to ], + 'correct list of not added to queues', + ); + } +} + =head2 get_relocatable_dir Takes a path relative to the location of the test file that is being @@ -1241,6 +1421,21 @@ sub get_relocatable_file { return File::Spec->catfile(get_relocatable_dir(@_), $file); } +sub find_relocatable_path { + my @path = @_; + + # A simple strategy to find e.g., t/data/gnupg/keys, from the dir + # where test file lives. We try up to 3 directories up + my $path = File::Spec->catfile( @path ); + for my $up ( 0 .. 2 ) { + my $p = get_relocatable_dir($path); + return $p if -e $p; + + $path = File::Spec->catfile( File::Spec->updir(), $path ); + } + return undef; +} + sub get_abs_relocatable_dir { (my $volume, my $directories, my $file) = File::Spec->splitpath($0); if (File::Spec->file_name_is_absolute($directories)) { @@ -1266,154 +1461,59 @@ sub import_gnupg_key { $key =~ s/\@/-at-/g; $key .= ".$type.key"; - require RT::Crypt::GnuPG; - - # simple strategy find data/gnupg/keys, from the dir where test file lives - # to updirs, try 3 times in total - my $path = File::Spec->catfile( 'data', 'gnupg', 'keys' ); - my $abs_path; - for my $up ( 0 .. 2 ) { - my $p = get_relocatable_dir($path); - if ( -e $p ) { - $abs_path = $p; - last; - } - else { - $path = File::Spec->catfile( File::Spec->updir(), $path ); - } - } + my $path = find_relocatable_path( 'data', 'gnupg', 'keys' ); die "can't find the dir where gnupg keys are stored" - unless $abs_path; + unless $path; - return RT::Crypt::GnuPG::ImportKey( - RT::Test->file_content( [ $abs_path, $key ] ) ); + return RT::Crypt::GnuPG->ImportKey( + RT::Test->file_content( [ $path, $key ] ) ); } - sub lsign_gnupg_key { my $self = shift; my $key = shift; - require RT::Crypt::GnuPG; require GnuPG::Interface; - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - $gnupg->options->hash_init( - RT::Crypt::GnuPG::_PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); - - my %handle; - my $handles = GnuPG::Handles->new( - stdin => ($handle{'input'} = IO::Handle->new()), - stdout => ($handle{'output'} = IO::Handle->new()), - stderr => ($handle{'error'} = IO::Handle->new()), - logger => ($handle{'logger'} = IO::Handle->new()), - status => ($handle{'status'} = IO::Handle->new()), - command => ($handle{'command'} = IO::Handle->new()), - ); - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - local @ENV{'LANG', 'LC_ALL'} = ('C', 'C'); - my $pid = $gnupg->wrap_call( - handles => $handles, - commands => ['--lsign-key'], - command_args => [$key], - ); - close $handle{'input'}; - while ( my $str = readline $handle{'status'} ) { - if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL sign_uid\..*/ ) { - print { $handle{'command'} } "y\n"; + return RT::Crypt::GnuPG->CallGnuPG( + Command => '--lsign-key', + CommandArgs => [$key], + Callback => sub { + my %handle = @_; + while ( my $str = readline $handle{'status'} ) { + if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL sign_uid\..*/ ) { + print { $handle{'command'} } "y\n"; + } } - } - waitpid $pid, 0; - }; - my $err = $@; - close $handle{'output'}; - - my %res; - $res{'exit_code'} = $?; - foreach ( qw(error 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{'error'} ) if $res{'error'}; - $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 trust_gnupg_key { my $self = shift; my $key = shift; - require RT::Crypt::GnuPG; require GnuPG::Interface; - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - $gnupg->options->hash_init( - RT::Crypt::GnuPG::_PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); - - my %handle; - my $handles = GnuPG::Handles->new( - stdin => ($handle{'input'} = IO::Handle->new()), - stdout => ($handle{'output'} = IO::Handle->new()), - stderr => ($handle{'error'} = IO::Handle->new()), - logger => ($handle{'logger'} = IO::Handle->new()), - status => ($handle{'status'} = IO::Handle->new()), - command => ($handle{'command'} = IO::Handle->new()), - ); - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - local @ENV{'LANG', 'LC_ALL'} = ('C', 'C'); - my $pid = $gnupg->wrap_call( - handles => $handles, - commands => ['--edit-key'], - command_args => [$key], - ); - close $handle{'input'}; - - my $done = 0; - while ( my $str = readline $handle{'status'} ) { - if ( $str =~ /^\[GNUPG:\]\s*\QGET_LINE keyedit.prompt/ ) { - if ( $done ) { - print { $handle{'command'} } "quit\n"; - } else { - print { $handle{'command'} } "trust\n"; + return RT::Crypt::GnuPG->CallGnuPG( + Command => '--edit-key', + CommandArgs => [$key], + Callback => sub { + my %handle = @_; + my $done = 0; + while ( my $str = readline $handle{'status'} ) { + if ( $str =~ /^\[GNUPG:\]\s*\QGET_LINE keyedit.prompt/ ) { + if ( $done ) { + print { $handle{'command'} } "quit\n"; + } else { + print { $handle{'command'} } "trust\n"; + } + } elsif ( $str =~ /^\[GNUPG:\]\s*\QGET_LINE edit_ownertrust.value/ ) { + print { $handle{'command'} } "5\n"; + } elsif ( $str =~ /^\[GNUPG:\]\s*\QGET_BOOL edit_ownertrust.set_ultimate.okay/ ) { + print { $handle{'command'} } "y\n"; + $done = 1; } - } elsif ( $str =~ /^\[GNUPG:\]\s*\QGET_LINE edit_ownertrust.value/ ) { - print { $handle{'command'} } "5\n"; - } elsif ( $str =~ /^\[GNUPG:\]\s*\QGET_BOOL edit_ownertrust.set_ultimate.okay/ ) { - print { $handle{'command'} } "y\n"; - $done = 1; } - } - waitpid $pid, 0; - }; - my $err = $@; - close $handle{'output'}; - - my %res; - $res{'exit_code'} = $?; - foreach ( qw(error 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{'error'} ) if $res{'error'}; - $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 started_ok { @@ -1476,7 +1576,7 @@ sub test_app { require Plack::Middleware::Auth::Basic; $app = Plack::Middleware::Auth::Basic->wrap( $app, - authenticator => sub { + authenticator => $server_opt{basic_auth} eq 'anon' ? sub { 1 } : sub { my ($username, $password) = @_; return $username eq 'root' && $password eq 'password'; } @@ -1490,6 +1590,7 @@ sub test_app { } sub start_plack_server { + local $Test::Builder::Level = $Test::Builder::Level + 1; my $self = shift; require Plack::Loader; @@ -1524,10 +1625,8 @@ sub start_plack_server { } require POSIX; - if ( $^O !~ /MSWin32/ ) { - POSIX::setsid() - or die "Can't start a new session: $!"; - } + POSIX::setsid() + or die "Can't start a new session: $!"; # stick this in a scope so that when $app is garbage collected, # StashWarnings can complain about unhandled warnings @@ -1540,6 +1639,7 @@ sub start_plack_server { our $TEST_APP; sub start_inline_server { + local $Test::Builder::Level = $Test::Builder::Level + 1; my $self = shift; require Test::WWW::Mechanize::PSGI; @@ -1557,6 +1657,7 @@ sub start_inline_server { } sub start_apache_server { + local $Test::Builder::Level = $Test::Builder::Level + 1; my $self = shift; my %server_opt = @_; $server_opt{variant} ||= 'mod_perl'; @@ -1618,17 +1719,8 @@ sub file_content { sub find_executable { my $self = shift; - my $name = shift; - require File::Spec; - foreach my $dir ( split /:/, $ENV{'PATH'} ) { - my $fpath = File::Spec->catpath( - (File::Spec->splitpath( $dir, 'no file' ))[0..1], $name - ); - next unless -e $fpath && -r _ && -x _; - return $fpath; - } - return undef; + return File::Which::which( @_ ); } sub diag { diff --git a/rt/lib/RT/Test/Apache.pm b/rt/lib/RT/Test/Apache.pm index f761e3c..29f5ed1 100644 --- a/rt/lib/RT/Test/Apache.pm +++ b/rt/lib/RT/Test/Apache.pm @@ -83,6 +83,23 @@ sub basic_auth { EOT } +sub basic_auth_anon { + my $self = shift; + + return <<"EOT"; + AuthType Basic + AuthName "restricted area" + AuthBasicProvider anon + + Anonymous * + Anonymous_NoUserID On + Anonymous_MustGiveEmail Off + Anonymous_VerifyEmail Off + + Require valid-user +EOT +} + sub start_server { my ($self, %config) = @_; my %tmp = %{$config{tmp}}; @@ -108,8 +125,14 @@ sub start_server { rt_sbin_path => $RT::SbinPath, rt_site_config => $ENV{'RT_SITE_CONFIG'}, load_modules => $info{load_modules}, - basic_auth => $config{basic_auth} ? $self->basic_auth : "", ); + if (not $config{basic_auth}) { + $opt{basic_auth} = ""; + } elsif ($config{basic_auth} eq 'anon') { + $opt{basic_auth} = $self->basic_auth_anon; + } else { + $opt{basic_auth} = $self->basic_auth; + } foreach (qw(log pid lock)) { $opt{$_ .'_file'} = File::Spec->catfile( "$tmp{'directory'}", "apache.$_" @@ -193,7 +216,10 @@ sub apache_server_info { ) unless exists $MODULES{$res{version}}{$res{variant}}; my @mlist = @{$MODULES{$res{version}}{$res{variant}}}; - push @mlist, "authn_file", "auth_basic", "authz_user" if $res{basic_auth}; + if ($res{basic_auth}) { + push @mlist, "auth_basic", "authz_user"; + push @mlist, $res{basic_auth} eq 'anon' ? "authn_anon" : "authn_file"; + } $res{'load_modules'} = ''; foreach my $mod ( @mlist ) { diff --git a/rt/lib/RT/Test/GnuPG.pm b/rt/lib/RT/Test/GnuPG.pm index 0ba47f7..e864845 100644 --- a/rt/lib/RT/Test/GnuPG.pm +++ b/rt/lib/RT/Test/GnuPG.pm @@ -65,12 +65,11 @@ sub import { my $t = $class->builder; $t->plan( skip_all => 'GnuPG required.' ) - unless eval { require GnuPG::Interface; 1 }; + unless GnuPG::Interface->require; $t->plan( skip_all => 'gpg executable is required.' ) unless RT::Test->find_executable('gpg'); $class->SUPER::import(%args); - require RT::Crypt::GnuPG; return $class->export_to_level(1) if $^C; @@ -107,7 +106,7 @@ Set(\%GnuPG, ( OutgoingMessagesFormat => 'RFC', )); Set(\%GnuPGOptions => \%{ $dumped_gnupg_options }); -Set(\@MailPlugins => qw(Auth::MailFrom Auth::GnuPG)); +Set(\@MailPlugins => qw(Auth::MailFrom Auth::Crypt)); }; } @@ -167,7 +166,7 @@ sub update_ticket { $m->click('SubmitTicket'); is $m->status, 200, "request successful"; - $m->content_contains("Message recorded", 'Message recorded') or diag $m->content; + $m->content_contains("Correspondence added", 'Correspondence added') or diag $m->content; my @mail = RT::Test->fetch_caught_mails; @@ -231,7 +230,7 @@ sub cleanup_headers { # strip id from subject to create new ticket $mail =~ s/^(Subject:)\s*\[.*?\s+#\d+\]\s*/$1 /m; # strip several headers - foreach my $field ( qw(Message-ID X-RT-Original-Encoding RT-Originator RT-Ticket X-RT-Loop-Prevention) ) { + foreach my $field ( qw(Message-ID RT-Originator RT-Ticket X-RT-Loop-Prevention) ) { $mail =~ s/^$field:.*?\n(?! |\t)//gmsi; } return $mail; @@ -276,7 +275,7 @@ sub send_email_and_check_transaction { "RT's outgoing mail looks not signed"; } elsif ( $type eq 'signed' ) { - is $msg->GetHeader('X-RT-Privacy'), 'PGP', + is $msg->GetHeader('X-RT-Privacy'), 'GnuPG', "RT's outgoing mail has crypto"; is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Not encrypted', "RT's outgoing mail looks not encrypted"; @@ -285,7 +284,7 @@ sub send_email_and_check_transaction { "RT's outgoing mail looks signed"; } elsif ( $type eq 'encrypted' ) { - is $msg->GetHeader('X-RT-Privacy'), 'PGP', + is $msg->GetHeader('X-RT-Privacy'), 'GnuPG', "RT's outgoing mail has crypto"; is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success', "RT's outgoing mail looks encrypted"; @@ -294,7 +293,7 @@ sub send_email_and_check_transaction { } elsif ( $type eq 'signed_encrypted' ) { - is $msg->GetHeader('X-RT-Privacy'), 'PGP', + is $msg->GetHeader('X-RT-Privacy'), 'GnuPG', "RT's outgoing mail has crypto"; is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success', "RT's outgoing mail looks encrypted"; diff --git a/rt/lib/RT/Test/SMIME.pm b/rt/lib/RT/Test/SMIME.pm new file mode 100644 index 0000000..d39c4b4 --- /dev/null +++ b/rt/lib/RT/Test/SMIME.pm @@ -0,0 +1,164 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Test::SMIME; + +use Test::More; +use base qw(RT::Test); +use File::Temp qw(tempdir); + +sub import { + my $class = shift; + my %args = @_; + my $t = $class->builder; + + $t->plan( skip_all => 'openssl executable is required.' ) + unless RT::Test->find_executable('openssl'); + + require RT::Crypt; + $class->SUPER::import(%args); + + $class->set_rights( + Principal => 'Everyone', + Right => ['CreateTicket', 'ShowTicket', 'SeeQueue', 'ReplyToTicket', 'ModifyTicket'], + ); + + $class->export_to_level(1); +} + +sub bootstrap_more_config { + my $self = shift; + my $handle = shift; + my $args = shift; + + $self->SUPER::bootstrap_more_config($handle, $args, @_); + + my $openssl = $self->find_executable('openssl'); + + my $keyring = $self->keyring_path; + mkdir($keyring); + + my $ca = $self->key_path("demoCA", "cacert.pem"); + + print $handle qq{ + Set(\%GnuPG, Enable => 0); + Set(\%SMIME => + Enable => 1, + Passphrase => { + 'root\@example.com' => '123456', + 'sender\@example.com' => '123456', + }, + OpenSSL => q{$openssl}, + Keyring => q{$keyring}, + CAPath => q{$ca}, + ); + Set(\@MailPlugins => qw(Auth::MailFrom Auth::Crypt)); + }; + +} + +sub keyring_path { + return File::Spec->catfile( RT::Test->temp_directory, "smime" ); +} + +sub key_path { + my $self = shift; + my $keys = RT::Test::get_abs_relocatable_dir( + (File::Spec->updir()) x 2, + qw(data smime keys), + ); + return File::Spec->catfile( $keys => @_ ), +} + +sub mail_set_path { + my $self = shift; + return RT::Test::get_abs_relocatable_dir( + (File::Spec->updir()) x 2, + qw(data smime mails), + ); +} + +sub import_key { + my $self = shift; + my $key = shift; + my $user = shift; + + my $path = RT::Test::find_relocatable_path( 'data', 'smime', 'keys' ); + die "can't find the dir where smime keys are stored" + unless $path; + + my $keyring = RT->Config->Get('SMIME')->{'Keyring'}; + die "SMIME keyring '$keyring' doesn't exist" + unless $keyring && -e $keyring; + + $key .= ".pem" unless $key =~ /\.(pem|crt|key)$/; + + my $content = RT::Test->file_content( [ $path, $key ] ); + + if ( $user ) { + my ($status, $msg) = $user->SetSMIMECertificate( $content ); + die "Couldn't set CF: $msg" unless $status; + } else { + my $keyring = RT->Config->Get('SMIME')->{'Keyring'}; + die "SMIME keyring '$keyring' doesn't exist" + unless $keyring && -e $keyring; + + open my $fh, '>:raw', File::Spec->catfile($keyring, $key) + or die "can't open file: $!"; + print $fh $content; + close $fh; + } + + return; +} + +1; diff --git a/rt/lib/RT/Test/Shredder.pm b/rt/lib/RT/Test/Shredder.pm new file mode 100644 index 0000000..e6314e7 --- /dev/null +++ b/rt/lib/RT/Test/Shredder.pm @@ -0,0 +1,324 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (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::Test::Shredder; +use base 'RT::Test'; + +require File::Copy; +require Cwd; + +=head1 DESCRIPTION + +RT::Shredder test suite utilities + +=head1 TESTING + +Since RT:Shredder 0.01_03 we have a test suite. You +can run tests and see if everything works as expected +before you try shredder on your actual data. +Tests also help in the development process. + +The test suite uses SQLite databases to store data in individual files, +so you could sun tests on your production servers without risking +damage to your production data. + +You'll want to run the test suite almost every time you install or update +the shredder distribution, especialy if you have local customizations of +the DB schema and/or RT code. + +Tests are one thing you can write even if you don't know much perl, +but want to learn more about RT's internals. New tests are very welcome. + +=head2 WRITING TESTS + +The shredder distribution has several files to help write new tests. + + t/shredder/utils.pl - this file, utilities + t/00skeleton.t - skeleteton .t file for new tests + +All tests follow this algorithm: + + require "t/shredder/utils.pl"; # plug in utilities + init_db(); # create new tmp RT DB and init RT API + # create RT data you want to be always in the RT DB + # ... + create_savepoint('mysp'); # create DB savepoint + # create data you want delete with shredder + # ... + # run shredder on the objects you've created + # ... + # check that shredder deletes things you want + # this command will compare savepoint DB with current + cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint"); + # then you can create another object and delete it, then check again + +Savepoints are named and you can create two or more savepoints. + +=cut + +sub import { + my $class = shift; + + $class->SUPER::import(@_, tests => undef ); + + RT::Test::plan( skip_all => 'Shredder tests only work on SQLite' ) + unless RT->Config->Get('DatabaseType') eq 'SQLite'; + + my %args = @_; + RT::Test::plan( tests => $args{'tests'} ) if $args{tests}; + + $class->export_to_level(1); +} + +=head1 FUNCTIONS + +=head2 DATABASES + +=head3 db_name + +Returns the absolute file path to the current DB. +It is C<<RT::Test->temp_directory . "rt4test" >>. + +=cut + +sub db_name { return RT->Config->Get("DatabaseName") } + +=head3 connect_sqlite + +Returns connected DBI DB handle. + +Takes path to sqlite db. + +=cut + +sub connect_sqlite +{ + my $self = shift; + return DBI->connect("dbi:SQLite:dbname=". shift, "", ""); +} + +=head2 SHREDDER + +=head3 shredder_new + +Creates and returns a new RT::Shredder object. + +=cut + +sub shredder_new +{ + my $self = shift; + + require RT::Shredder; + my $obj = RT::Shredder->new; + + my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' ); + $obj->AddDumpPlugin( Arguments => { + file_name => $file, + from_storage => 0, + } ); + + return $obj; +} + + +=head2 SAVEPOINTS + +=head3 savepoint_name + +Returns the absolute path to the named savepoint DB file. +Takes one argument - savepoint name, by default C<sp>. + +=cut + +sub savepoint_name +{ + my $self = shift; + my $name = shift || 'default'; + return File::Spec->catfile( $self->temp_directory, "sp.$name.db" ); +} + +=head3 create_savepoint + +Creates savepoint DB from the current DB. +Takes name of the savepoint as argument. + +=head3 restore_savepoint + +Restores current DB to savepoint state. +Takes name of the savepoint as argument. + +=cut + +sub create_savepoint { + my $self = shift; + return $self->__cp_db( $self->db_name => $self->savepoint_name( shift ) ); +} +sub restore_savepoint { + my $self = shift; + return $self->__cp_db( $self->savepoint_name( shift ) => $self->db_name ); +} +sub __cp_db +{ + my $self = shift; + my( $orig, $dest ) = @_; + RT::Test::__disconnect_rt(); + File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!"; + RT::Test::__reconnect_rt(); + return; +} + + +=head2 DUMPS + +=head3 dump_sqlite + +Returns DB dump as a complex hash structure: + { + TableName => { + #id => { + lc_field => 'value', + } + } + } + +Takes named argument C<CleanDates>. If true, clean all date fields from +dump. True by default. + +=cut + +sub dump_sqlite +{ + my $self = shift; + my $dbh = shift; + my %args = ( CleanDates => 1, @_ ); + + my $old_fhkn = $dbh->{'FetchHashKeyName'}; + $dbh->{'FetchHashKeyName'} = 'NAME_lc'; + + my @tables = $RT::Handle->_TableNames( $dbh ); + + my $res = {}; + foreach my $t( @tables ) { + next if lc($t) eq 'sessions'; + $res->{$t} = $dbh->selectall_hashref( + "SELECT * FROM $t". $self->dump_sqlite_exceptions($t), 'id' + ); + $self->clean_dates( $res->{$t} ) if $args{'CleanDates'}; + die $DBI::err if $DBI::err; + } + + $dbh->{'FetchHashKeyName'} = $old_fhkn; + return $res; +} + +=head3 dump_sqlite_exceptions + +If there are parts of the DB which can change from creating and deleting +a queue, skip them when doing the comparison. One example is the global +queue cache attribute on RT::System which will be updated on Queue creation +and can't be rolled back by the shredder. It may actually make sense for +Shredder to be updating this at some point in the future. + +=cut + +sub dump_sqlite_exceptions { + my $self = shift; + my $table = shift; + + my $special_wheres = { + attributes => " WHERE Name != 'QueueCacheNeedsUpdate'" + }; + + return $special_wheres->{lc $table}||''; + +} + +=head3 dump_current_and_savepoint + +Returns dump of the current DB and of the named savepoint. +Takes one argument - savepoint name. + +=cut + +sub dump_current_and_savepoint +{ + my $self = shift; + my $orig = $self->savepoint_name( shift ); + die "Couldn't find savepoint file" unless -f $orig && -r _; + my $odbh = $self->connect_sqlite( $orig ); + return ( $self->dump_sqlite( $RT::Handle->dbh, @_ ), $self->dump_sqlite( $odbh, @_ ) ); +} + +=head3 dump_savepoint_and_current + +Returns the same data as C<dump_current_and_savepoint> function, +but in reversed order. + +=cut + +sub dump_savepoint_and_current { return reverse (shift)->dump_current_and_savepoint(@_) } + +sub clean_dates +{ + my $self = shift; + my $h = shift; + my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i; + foreach my $id ( keys %{ $h } ) { + next unless $h->{ $id }; + foreach ( keys %{ $h->{ $id } } ) { + delete $h->{$id}{$_} if $h->{$id}{$_} && + $h->{$id}{$_} =~ /$date_re/; + } + } +} + +1; diff --git a/rt/lib/RT/Test/Web.pm b/rt/lib/RT/Test/Web.pm index ad730c6..74da61c 100644 --- a/rt/lib/RT/Test/Web.pm +++ b/rt/lib/RT/Test/Web.pm @@ -53,6 +53,7 @@ use warnings; use base qw(Test::WWW::Mechanize); use Scalar::Util qw(weaken); +use MIME::Base64 qw//; BEGIN { require RT::Test; } require Test::More; @@ -76,6 +77,8 @@ sub get_ok { if ( $url =~ s!^/!! ) { $url = $self->rt_base_url . $url; } + + local $Test::Builder::Level = $Test::Builder::Level + 1; my $rv = $self->SUPER::get_ok($url, @_); Test::More::diag( "Couldn't get $url" ) unless $rv; return $rv; @@ -96,15 +99,25 @@ sub login { my $url = $self->rt_base_url; $self->get($url . "?user=$user;pass=$pass"); - unless ( $self->status == 200 ) { - Test::More::diag( "error: status is ". $self->status ); - return 0; - } + + return 0 unless $self->logged_in_as($user); + unless ( $self->content =~ m/Logout/i ) { Test::More::diag("error: page has no Logout"); return 0; } - RT::Interface::Web::EscapeUTF8(\$user); + return 1; +} + +sub logged_in_as { + my $self = shift; + my $user = shift || ''; + + unless ( $self->status == 200 ) { + Test::More::diag( "error: status is ". $self->status ); + return 0; + } + RT::Interface::Web::EscapeHTML(\$user); unless ( $self->content =~ m{<span class="current-user">\Q$user\E</span>}i ) { Test::More::diag("Page has no user name"); return 0; @@ -165,7 +178,10 @@ sub goto_create_ticket { } elsif ( $queue =~ /^\d+$/ ) { $id = $queue; } else { - die "not yet implemented"; + my $queue_obj = RT::Queue->new(RT->SystemUser); + my ($ok, $msg) = $queue_obj->Load($queue); + die "Unable to load queue '$queue': $msg" if !$ok; + $id = $queue_obj->id; } $self->get($self->rt_base_url . 'Ticket/Create.html?Queue='.$id); @@ -323,7 +339,11 @@ sub custom_field_input { my $cf_name = shift; my $cf_obj = RT::CustomField->new( $RT::SystemUser ); - $cf_obj->LoadByName( Queue => $queue, Name => $cf_name ); + $cf_obj->LoadByName( + Name => $cf_name, + LookupType => RT::Ticket->CustomFieldLookupType, + ObjectId => $queue, + ); unless ( $cf_obj->id ) { Test::More::diag("Can not load custom field '$cf_name' in queue '$queue'"); return undef; @@ -331,7 +351,7 @@ sub custom_field_input { my $cf_id = $cf_obj->id; my ($res) = - grep /^Object-RT::Ticket-\d*-CustomField-$cf_id-Values?$/, + grep /^Object-RT::Ticket-\d*-CustomField(?::\w+)?-$cf_id-Values?$/, map $_->name, $self->current_form->inputs; unless ( $res ) { @@ -341,6 +361,24 @@ sub custom_field_input { return $res; } +sub value_name { + my $self = shift; + my $field = shift; + + my $input = $self->current_form->find_input( $field ) + or return undef; + + my @names = $input->value_names; + return $input->value unless @names; + + my @values = $input->possible_values; + for ( my $i = 0; $i < @values; $i++ ) { + return $names[ $i ] if $values[ $i ] eq $input->value; + } + return undef; +} + + sub check_links { my $self = shift; my %args = @_; @@ -368,6 +406,25 @@ sub check_links { return Test::More::ok( 1, "expected links" ); } +sub auth { + my $self = shift; + $self->default_header( $self->auth_header(@_) ); +} + +sub auth_header { + my $self = shift; + return Authorization => "Basic " . + MIME::Base64::encode( join(":", @_) ); +} + +sub dom { + my $self = shift; + Carp::croak("Can not get DOM, not HTML repsone") + unless $self->is_html; + require Mojo::DOM; + return Mojo::DOM->new( $self->content ); +} + sub DESTROY { my $self = shift; if ( !$RT::Test::Web::DESTROY++ ) { diff --git a/rt/lib/RT/Ticket.pm b/rt/lib/RT/Ticket.pm index 068eec0..e7478ad 100755 --- a/rt/lib/RT/Ticket.pm +++ b/rt/lib/RT/Ticket.pm @@ -67,11 +67,21 @@ package RT::Ticket; use strict; use warnings; +use base 'RT::Record'; + +use Role::Basic 'with'; +# SetStatus and _SetStatus are reimplemented below (using other pieces of the +# role) to deal with ACLs, moving tickets between queues, and automatically +# setting dates. +with "RT::Record::Role::Status" => { -excludes => [qw(SetStatus _SetStatus)] }, + "RT::Record::Role::Links", + "RT::Record::Role::Roles"; use RT::Queue; use RT::User; use RT::Record; +use RT::Link; use RT::Links; use RT::Date; use RT::CustomFields; @@ -84,53 +94,24 @@ use RT::URI::freeside; use MIME::Entity; use Devel::GlobalDestruction; +sub LifecycleColumn { "Queue" } -# A helper table for links mapping to make it easier -# to build and parse links between tickets - -our %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', }, - MergedInto => { Type => 'MergedInto', - Mode => 'Target', }, - +my %ROLES = ( + # name => description + 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 ); - -# A helper table for links mapping to make it easier -# to build and parse links between tickets - -our %LINKDIRMAP = ( - MemberOf => { Base => 'MemberOf', - Target => 'HasMember', }, - RefersTo => { Base => 'RefersTo', - Target => 'ReferredToBy', }, - DependsOn => { Base => 'DependsOn', - Target => 'DependedOnBy', }, - MergedInto => { Base => 'MergedInto', - Target => 'MergedInto', }, - -); - - -sub LINKTYPEMAP { return \%LINKTYPEMAP } -sub LINKDIRMAP { return \%LINKDIRMAP } +for my $role (sort keys %ROLES) { + RT::Ticket->RegisterRole( + Name => $role, + EquivClasses => ['RT::Queue'], + ( $role eq "Owner" ? ( Column => "Owner") : () ), + ( $role !~ /Cc/ ? ( ACLOnlyInEquiv => 1) : () ), + ); +} our %MERGE_CACHE = ( effective => {}, @@ -287,7 +268,7 @@ sub Create { $self->CurrentUser->HasRight( Right => 'CreateTicket', Object => $QueueObj - ) + ) and $QueueObj->Disabled != 1 ) { return ( @@ -295,7 +276,7 @@ sub Create { $self->loc( "No permission to create tickets in the queue '[_1]'", $QueueObj->Name)); } - my $cycle = $QueueObj->Lifecycle; + my $cycle = $QueueObj->LifecycleObj; unless ( defined $args{'Status'} && length $args{'Status'} ) { $args{'Status'} = $cycle->DefaultOnCreate; } @@ -382,90 +363,14 @@ sub Create { $Resolved->SetToNow; } - # }}} - # Dealing with time fields - $args{'TimeEstimated'} = 0 unless defined $args{'TimeEstimated'}; $args{'TimeWorked'} = 0 unless defined $args{'TimeWorked'}; $args{'TimeLeft'} = 0 unless defined $args{'TimeLeft'}; - # }}} - - # Deal with setting the owner - - my $Owner; - if ( ref( $args{'Owner'} ) eq 'RT::User' ) { - if ( $args{'Owner'}->id ) { - $Owner = $args{'Owner'}; - } else { - $RT::Logger->error('Passed an empty RT::User for owner'); - push @non_fatal_errors, - $self->loc("Owner could not be set.") . " ". - $self->loc("Invalid value for [_1]",loc('owner')); - $Owner = undef; - } - } - - #If we've been handed something else, try to load the user. - elsif ( $args{'Owner'} ) { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( $args{'Owner'} ); - if (!$Owner->id) { - $Owner->LoadByEmail( $args{'Owner'} ) - } - unless ( $Owner->Id ) { - push @non_fatal_errors, - $self->loc("Owner could not be set.") . " " - . $self->loc( "User '[_1]' could not be found.", $args{'Owner'} ); - $Owner = undef; - } - } - - #If we have a proposed owner and they don't have the right - #to own a ticket, scream about it and make them not the owner - - my $DeferOwner; - if ( $Owner && $Owner->Id != RT->Nobody->Id - && !$Owner->HasRight( Object => $QueueObj, Right => 'OwnTicket' ) ) - { - $DeferOwner = $Owner; - $Owner = undef; - $RT::Logger->debug('going to deffer setting owner'); - - } - - #If we haven't been handed a valid owner, make it nobody. - unless ( defined($Owner) && $Owner->Id ) { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( RT->Nobody->Id ); - } - - # }}} - -# We attempt to load or create each of the people who might have a role for this ticket -# _outside_ the transaction, so we don't get into ticket creation races - foreach my $type ( "Cc", "AdminCc", "Requestor" ) { - $args{ $type } = [ $args{ $type } ] unless ref $args{ $type }; - foreach my $watcher ( splice @{ $args{$type} } ) { - next unless $watcher; - if ( $watcher =~ /^\d+$/ ) { - push @{ $args{$type} }, $watcher; - } else { - my @addresses = RT::EmailParser->ParseEmailAddress( $watcher ); - foreach my $address( @addresses ) { - my $user = RT::User->new( RT->SystemUser ); - my ($uid, $msg) = $user->LoadOrCreateByEmail( $address ); - unless ( $uid ) { - push @non_fatal_errors, - $self->loc("Couldn't load or create user: [_1]", $msg); - } else { - push @{ $args{$type} }, $user->id; - } - } - } - } - } + # Figure out users for roles + my $roles = {}; + push @non_fatal_errors, $self->_ResolveRoles( $roles, %args ); $args{'Type'} = lc $args{'Type'} if $args{'Type'} =~ /^(ticket|approval|reminder)$/i; @@ -476,7 +381,6 @@ sub Create { my %params = ( Queue => $QueueObj->Id, - Owner => $Owner->Id, Subject => $args{'Subject'}, InitialPriority => $args{'InitialPriority'}, FinalPriority => $args{'FinalPriority'}, @@ -531,7 +435,8 @@ sub Create { ); } - my $create_groups_ret = $self->_CreateTicketGroups(); + # Create (empty) role groups + my $create_groups_ret = $self->_CreateRoleGroups(); unless ($create_groups_ret) { $RT::Logger->crit( "Couldn't create ticket groups for ticket " . $self->Id @@ -542,52 +447,40 @@ sub Create { ); } - # Set the owner in the Groups table - # We denormalize it into the Ticket table too because doing otherwise would - # kill performance, bigtime. It gets kept in lockstep thanks to the magic of transactionalization - $self->OwnerGroup->_AddMember( - PrincipalId => $Owner->PrincipalId, - InsideTransaction => 1 - ) unless $DeferOwner; - - - - # Deal with setting up watchers - - foreach my $type ( "Cc", "AdminCc", "Requestor" ) { - # we know it's an array ref - foreach my $watcher ( @{ $args{$type} } ) { - - # Note that we're using AddWatcher, rather than _AddWatcher, as we - # actually _want_ that ACL check. Otherwise, random ticket creators - # could make themselves adminccs and maybe get ticket rights. that would - # be poor - my $method = $type eq 'AdminCc'? 'AddWatcher': '_AddWatcher'; + # Codify what it takes to add each kind of group + my %acls = ( + Cc => sub { 1 }, + Requestor => sub { 1 }, + AdminCc => sub { + my $principal = shift; + return 1 if $self->CurrentUserHasRight('ModifyTicket'); + return unless $self->CurrentUserHasRight("WatchAsAdminCc"); + return unless $principal->id == $self->CurrentUser->PrincipalId; + return 1; + }, + Owner => sub { + my $principal = shift; + return 1 if $principal->id == RT->Nobody->PrincipalId; + return $principal->HasRight( Object => $self, Right => 'OwnTicket' ); + }, + ); - my ($val, $msg) = $self->$method( - Type => $type, - PrincipalId => $watcher, - Silent => 1, - ); - push @non_fatal_errors, $self->loc("Couldn't set [_1] watcher: [_2]", $type, $msg) - unless $val; - } - } + # Populate up the role groups. This call modifies $roles. + push @non_fatal_errors, $self->_AddRolesOnCreate( $roles, %acls ); + # Squelching if ($args{'SquelchMailTo'}) { my @squelch = ref( $args{'SquelchMailTo'} ) ? @{ $args{'SquelchMailTo'} } : $args{'SquelchMailTo'}; $self->_SquelchMailTo( @squelch ); } - - # }}} - # Add all the custom fields - foreach my $arg ( keys %args ) { next unless $arg =~ /^CustomField-(\d+)$/i; my $cfid = $1; + my $cf = $self->LoadCustomFieldByIdentifier($cfid); + next unless $cf->ObjectTypeFromLookupType($cf->__Value('LookupType'))->isa(ref $self); foreach my $value ( UNIVERSAL::isa( $args{$arg} => 'ARRAY' ) ? @{ $args{$arg} } : ( $args{$arg} ) ) @@ -607,8 +500,6 @@ sub Create { } } - # }}} - # Deal with setting up links # TODO: Adding link may fire scrips on other end and those scrips @@ -621,44 +512,9 @@ sub Create { # transaction and only then fire scrips on the other ends of links. # # //RUZ - - foreach my $type ( keys %LINKTYPEMAP ) { - next unless ( defined $args{$type} ); - foreach my $link ( - ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) ) - { - my ( $val, $msg, $obj ) = $self->__GetTicketFromURI( URI => $link ); - unless ($val) { - push @non_fatal_errors, $msg; - next; - } - - # Check rights on the other end of the link if we must - # then run _AddLink that doesn't check for ACLs - if ( RT->Config->Get( 'StrictLinkACL' ) ) { - if ( $obj && !$obj->CurrentUserHasRight('ModifyTicket') ) { - push @non_fatal_errors, $self->loc('Linking. Permission denied'); - next; - } - } - - if ( $obj && lc $obj->Status eq 'deleted' ) { - push @non_fatal_errors, - $self->loc("Linking. Can't link to a deleted ticket"); - next; - } - - my ( $wval, $wmsg ) = $self->_AddLink( - Type => $LINKTYPEMAP{$type}->{'Type'}, - $LINKTYPEMAP{$type}->{'Mode'} => $link, - Silent => !$args{'_RecordTransaction'} || $self->Type eq 'reminder', - 'Silent'. ( $LINKTYPEMAP{$type}->{'Mode'} eq 'Base'? 'Target': 'Base' ) - => 1, - ); - - push @non_fatal_errors, $wmsg unless ($wval); - } - } + push @non_fatal_errors, $self->_AddLinksOnCreate(\%args, { + Silent => !$args{'_RecordTransaction'} || ($self->Type || '') eq 'reminder', + }); # }}} @@ -724,26 +580,29 @@ sub Create { # }}} - # Now that we've created the ticket and set up its metadata, we can actually go and check OwnTicket on the ticket itself. - # This might be different than before in cases where extensions like RTIR are doing clever things with RT's ACL system - if ( $DeferOwner ) { - if (!$DeferOwner->HasRight( Object => $self, Right => 'OwnTicket')) { - - $RT::Logger->warning( "User " . $DeferOwner->Name . "(" . $DeferOwner->id + push @non_fatal_errors, $self->_AddLinksOnCreate(\%args, { + Silent => !$args{'_RecordTransaction'} || ($self->Type || '') eq 'reminder', + }); + + # Try to add roles once more. + push @non_fatal_errors, $self->_AddRolesOnCreate( $roles, %acls ); + + # Anything left is failure of ACLs; Cc and Requestor have no ACLs, + # so we don't bother checking them. + if (@{ $roles->{Owner} }) { + my $owner = $roles->{Owner}[0]->Object; + $RT::Logger->warning( "User " . $owner->Name . "(" . $owner->id . ") was proposed as a ticket owner but has no rights to own " . "tickets in " . $QueueObj->Name ); - push @non_fatal_errors, $self->loc( - "Owner '[_1]' does not have rights to own this ticket.", - $DeferOwner->Name - ); - } else { - $Owner = $DeferOwner; - $self->__Set(Field => 'Owner', Value => $Owner->id); - - } - $self->OwnerGroup->_AddMember( - PrincipalId => $Owner->PrincipalId, - InsideTransaction => 1 + push @non_fatal_errors, $self->loc( + "Owner '[_1]' does not have rights to own this ticket.", + $owner->Name + ); + } + for my $principal (@{ $roles->{AdminCc} }) { + push @non_fatal_errors, $self->loc( + "No rights to add '[_1]' as an AdminCc on this ticket", + $principal->Object->Name ); } @@ -761,7 +620,6 @@ sub Create { if ( $self->Id && $Trans ) { - #$TransObj->UpdateCustomFields(ARGSRef => \%args); $TransObj->UpdateCustomFields(%args); $RT::Logger->info( "Ticket " . $self->Id . " created in queue '" . $QueueObj->Name . "' by " . $self->CurrentUser->Name ); @@ -782,8 +640,6 @@ sub Create { } $RT::Handle->Commit(); return ( $self->Id, $TransObj->Id, $ErrStr ); - - # }}} } else { @@ -806,298 +662,6 @@ sub SetType { return $self->_Set(Field => 'Type', Value => $value, @_); } - - -=head2 _Parse822HeadersForAttributes Content - -Takes an RFC822 style message and parses its attributes into a hash. - -=cut - -sub _Parse822HeadersForAttributes { - my $self = shift; - my $content = shift; - my %args; - - my @lines = ( split ( /\n/, $content ) ); - while ( defined( my $line = shift @lines ) ) { - if ( $line =~ /^(.*?):(?:\s+(.*))?$/ ) { - my $value = $2; - my $tag = lc($1); - - $tag =~ s/-//g; - if ( defined( $args{$tag} ) ) - { #if we're about to get a second value, make it an array - $args{$tag} = [ $args{$tag} ]; - } - if ( ref( $args{$tag} ) ) - { #If it's an array, we want to push the value - push @{ $args{$tag} }, $value; - } - else { #if there's nothing there, just set the value - $args{$tag} = $value; - } - } elsif ($line =~ /^$/) { - - #TODO: this won't work, since "" isn't of the form "foo:value" - - while ( defined( my $l = shift @lines ) ) { - push @{ $args{'content'} }, $l; - } - } - - } - - foreach my $date (qw(due starts started resolved)) { - my $dateobj = RT::Date->new(RT->SystemUser); - if ( defined ($args{$date}) and $args{$date} =~ /^\d+$/ ) { - $dateobj->Set( Format => 'unix', Value => $args{$date} ); - } - else { - $dateobj->Set( Format => 'unknown', Value => $args{$date} ); - } - $args{$date} = $dateobj->ISO; - } - $args{'mimeobj'} = MIME::Entity->build( - Type => ( $args{'contenttype'} || 'text/plain' ), - Charset => "UTF-8", - Data => Encode::encode("UTF-8", ($args{'content'} || '')) - ); - - return (%args); -} - - - -=head2 Import PARAMHASH - -Import a ticket. -Doesn't create a transaction. -Doesn't supply queue defaults, etc. - -Returns: TICKETID - -=cut - -sub Import { - my $self = shift; - my ( $ErrStr, $QueueObj, $Owner ); - - my %args = ( - id => undef, - EffectiveId => undef, - Queue => undef, - Requestor => undef, - Type => 'ticket', - Owner => RT->Nobody->Id, - Subject => '[no subject]', - InitialPriority => undef, - FinalPriority => undef, - Status => 'new', - TimeWorked => "0", - Due => undef, - Created => undef, - Updated => undef, - Resolved => undef, - Told => undef, - @_ - ); - - if ( ( defined( $args{'Queue'} ) ) && ( !ref( $args{'Queue'} ) ) ) { - $QueueObj = RT::Queue->new(RT->SystemUser); - $QueueObj->Load( $args{'Queue'} ); - - #TODO error check this and return 0 if it's not loading properly +++ - } - elsif ( ref( $args{'Queue'} ) eq 'RT::Queue' ) { - $QueueObj = RT::Queue->new(RT->SystemUser); - $QueueObj->Load( $args{'Queue'}->Id ); - } - else { - $RT::Logger->debug( - "$self " . $args{'Queue'} . " not a recognised queue object." ); - } - - #Can't create a ticket without a queue. - unless ( defined($QueueObj) and $QueueObj->Id ) { - $RT::Logger->debug("$self No queue given for ticket creation."); - return ( 0, $self->loc('Could not create ticket. Queue not set') ); - } - - #Now that we have a queue, Check the ACLS - unless ( - $self->CurrentUser->HasRight( - Right => 'CreateTicket', - Object => $QueueObj - ) - ) - { - return ( 0, - $self->loc("No permission to create tickets in the queue '[_1]'" - , $QueueObj->Name)); - } - - # Deal with setting the owner - - # Attempt to take user object, user name or user id. - # Assign to nobody if lookup fails. - if ( defined( $args{'Owner'} ) ) { - if ( ref( $args{'Owner'} ) ) { - $Owner = $args{'Owner'}; - } - else { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( $args{'Owner'} ); - if ( !defined( $Owner->id ) ) { - $Owner->Load( RT->Nobody->id ); - } - } - } - - #If we have a proposed owner and they don't have the right - #to own a ticket, scream about it and make them not the owner - if ( - ( defined($Owner) ) - and ( $Owner->Id != RT->Nobody->Id ) - and ( - !$Owner->HasRight( - Object => $QueueObj, - Right => 'OwnTicket' - ) - ) - ) - { - - $RT::Logger->warning( "$self user " - . $Owner->Name . "(" - . $Owner->id - . ") was proposed " - . "as a ticket owner but has no rights to own " - . "tickets in '" - . $QueueObj->Name . "'" ); - - $Owner = undef; - } - - #If we haven't been handed a valid owner, make it nobody. - unless ( defined($Owner) ) { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( RT->Nobody->UserObj->Id ); - } - - # }}} - - unless ( $self->ValidateStatus( $args{'Status'} ) ) { - return ( 0, $self->loc("'[_1]' is an invalid value for status", $args{'Status'}) ); - } - - $self->{'_AccessibleCache'}{Created} = { 'read' => 1, 'write' => 1 }; - $self->{'_AccessibleCache'}{Creator} = { 'read' => 1, 'auto' => 1 }; - $self->{'_AccessibleCache'}{LastUpdated} = { 'read' => 1, 'write' => 1 }; - $self->{'_AccessibleCache'}{LastUpdatedBy} = { 'read' => 1, 'auto' => 1 }; - - # If we're coming in with an id, set that now. - my $EffectiveId = undef; - if ( $args{'id'} ) { - $EffectiveId = $args{'id'}; - - } - - my $id = $self->SUPER::Create( - id => $args{'id'}, - EffectiveId => $EffectiveId, - Queue => $QueueObj->Id, - Owner => $Owner->Id, - Subject => $args{'Subject'}, # loc - InitialPriority => $args{'InitialPriority'}, # loc - FinalPriority => $args{'FinalPriority'}, # loc - Priority => $args{'InitialPriority'}, # loc - Status => $args{'Status'}, # loc - TimeWorked => $args{'TimeWorked'}, # loc - Type => $args{'Type'}, # loc - Created => $args{'Created'}, # loc - Told => $args{'Told'}, # loc - LastUpdated => $args{'Updated'}, # loc - Resolved => $args{'Resolved'}, # loc - Due => $args{'Due'}, # loc - ); - - # If the ticket didn't have an id - # Set the ticket's effective ID now that we've created it. - if ( $args{'id'} ) { - $self->Load( $args{'id'} ); - } - else { - my ( $val, $msg ) = - $self->__Set( Field => 'EffectiveId', Value => $id ); - - unless ($val) { - $RT::Logger->err( - $self . "->Import couldn't set EffectiveId: $msg" ); - } - } - - my $create_groups_ret = $self->_CreateTicketGroups(); - unless ($create_groups_ret) { - $RT::Logger->crit( - "Couldn't create ticket groups for ticket " . $self->Id ); - } - - $self->OwnerGroup->_AddMember( PrincipalId => $Owner->PrincipalId ); - - foreach my $watcher ( @{ $args{'Cc'} } ) { - $self->_AddWatcher( Type => 'Cc', Email => $watcher, Silent => 1 ); - } - foreach my $watcher ( @{ $args{'AdminCc'} } ) { - $self->_AddWatcher( Type => 'AdminCc', Email => $watcher, - Silent => 1 ); - } - foreach my $watcher ( @{ $args{'Requestor'} } ) { - $self->_AddWatcher( Type => 'Requestor', Email => $watcher, - Silent => 1 ); - } - - return ( $self->Id, $ErrStr ); -} - - - - -=head2 _CreateTicketGroups - -Create the ticket groups and links for this ticket. -This routine expects to be called from Ticket->Create _inside of a transaction_ - -It will create four groups for this ticket: Requestor, Cc, AdminCc and Owner. - -It will return true on success and undef on failure. - - -=cut - - -sub _CreateTicketGroups { - my $self = shift; - - my @types = (qw(Requestor Owner Cc AdminCc)); - - foreach my $type (@types) { - my $type_obj = RT::Group->new($self->CurrentUser); - my ($id, $msg) = $type_obj->CreateRoleGroup(Domain => 'RT::Ticket-Role', - Instance => $self->Id, - Type => $type); - unless ($id) { - $RT::Logger->error("Couldn't create a ticket group of type '$type' for ticket ". - $self->Id.": ".$msg); - return(undef); - } - } - return(1); - -} - - - =head2 OwnerGroup A constructor which returns an RT::Group object containing the owner of this ticket. @@ -1106,26 +670,34 @@ A constructor which returns an RT::Group object containing the owner of this tic sub OwnerGroup { my $self = shift; - my $owner_obj = RT::Group->new($self->CurrentUser); - $owner_obj->LoadTicketRoleGroup( Ticket => $self->Id, Type => 'Owner'); - return ($owner_obj); + return $self->RoleGroup( 'Owner' ); } +sub _HasModifyWatcherRight { + my $self = shift; + my ($type, $principal) = @_; + # ModifyTicket works in any case + return 1 if $self->CurrentUserHasRight('ModifyTicket'); + # If the watcher isn't the current user then the current user has no right + return 0 unless $self->CurrentUser->PrincipalId == $principal->id; + # If it's an AdminCc and they don't have 'WatchAsAdminCc', bail + return 0 if $type eq 'AdminCc' and not $self->CurrentUserHasRight('WatchAsAdminCc'); + # If it's a Requestor or Cc and they don't have 'Watch', bail + return 0 if ($type eq "Cc" or $type eq 'Requestor') + and not $self->CurrentUserHasRight('Watch'); + return 1; +} -=head2 AddWatcher - -AddWatcher takes a parameter hash. The keys are as follows: - -Type One of Requestor, Cc, AdminCc -PrincipalId The RT::Principal id of the user or group that's being added as a watcher +=head2 AddWatcher -Email The email address of the new watcher. If a user with this - email address can't be found, a new nonprivileged user will be created. +Applies access control checking, then calls +L<RT::Record::Role::Roles/AddRoleMember>. Additionally, C<Email> is +accepted as an alternative argument name for C<User>. -If the watcher you're trying to set has an RT account, set the PrincipalId paremeter to their User Id. Otherwise, set the Email parameter to their Email address. +Returns a tuple of (status, message). =cut @@ -1138,138 +710,26 @@ sub AddWatcher { @_ ); - # ModifyTicket works in any case - return $self->_AddWatcher( %args ) - if $self->CurrentUserHasRight('ModifyTicket'); - if ( $args{'Email'} ) { - my ($addr) = RT::EmailParser->ParseEmailAddress( $args{'Email'} ); - return (0, $self->loc("Couldn't parse address from '[_1]' string", $args{'Email'} )) - unless $addr; - - if ( lc $self->CurrentUser->EmailAddress - eq lc RT::User->CanonicalizeEmailAddress( $addr->address ) ) - { - $args{'PrincipalId'} = $self->CurrentUser->id; - delete $args{'Email'}; - } - } - - # If the watcher isn't the current user then the current user has no right - # bail - unless ( $args{'PrincipalId'} && $self->CurrentUser->id == $args{'PrincipalId'} ) { - return ( 0, $self->loc("Permission Denied") ); - } - - # If it's an AdminCc and they don't have 'WatchAsAdminCc', bail - if ( $args{'Type'} eq 'AdminCc' ) { - unless ( $self->CurrentUserHasRight('WatchAsAdminCc') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - - # If it's a Requestor or Cc and they don't have 'Watch', bail - elsif ( $args{'Type'} eq 'Cc' || $args{'Type'} eq 'Requestor' ) { - unless ( $self->CurrentUserHasRight('Watch') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - else { - $RT::Logger->warning( "AddWatcher got passed a bogus type"); - return ( 0, $self->loc('Error in parameters to Ticket->AddWatcher') ); - } - - return $self->_AddWatcher( %args ); -} - -#This contains the meat of AddWatcher. but can be called from a routine like -# Create, which doesn't need the additional acl check -sub _AddWatcher { - my $self = shift; - my %args = ( - Type => undef, - Silent => undef, - PrincipalId => undef, - Email => undef, - @_ + $args{ACL} = sub { $self->_HasModifyWatcherRight( @_ ) }; + $args{User} ||= delete $args{Email}; + my ($principal, $msg) = $self->AddRoleMember( + %args, + InsideTransaction => 1, ); - - - my $principal = RT::Principal->new($self->CurrentUser); - if ($args{'Email'}) { - if ( RT::EmailParser->IsRTAddress( $args{'Email'} ) ) { - return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $args{'Email'}, $self->loc($args{'Type'}))); - } - my $user = RT::User->new(RT->SystemUser); - my ($pid, $msg) = $user->LoadOrCreateByEmail( $args{'Email'} ); - $args{'PrincipalId'} = $pid if $pid; - } - if ($args{'PrincipalId'}) { - $principal->Load($args{'PrincipalId'}); - if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) { - return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email, $self->loc($args{'Type'}))) - if RT::EmailParser->IsRTAddress( $email ); - - } - } - - - # If we can't find this watcher, we need to bail. - unless ($principal->Id) { - $RT::Logger->error("Could not load create a user with the email address '".$args{'Email'}. "' to add as a watcher for ticket ".$self->Id); - return(0, $self->loc("Could not find or create that user")); - } - - - my $group = RT::Group->new($self->CurrentUser); - $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->Id); - unless ($group->id) { - return(0,$self->loc("Group not found")); - } - - if ( $group->HasMember( $principal)) { - - return ( 0, $self->loc('[_1] is already a [_2] for this ticket', - $principal->Object->Name, $self->loc($args{'Type'})) ); - } - - - my ( $m_id, $m_msg ) = $group->_AddMember( PrincipalId => $principal->Id, - InsideTransaction => 1 ); - unless ($m_id) { - $RT::Logger->error("Failed to add ".$principal->Id." as a member of group ".$group->Id.": ".$m_msg); - - return ( 0, $self->loc('Could not make [_1] a [_2] for this ticket', - $principal->Object->Name, $self->loc($args{'Type'})) ); - } - - unless ( $args{'Silent'} ) { - $self->_NewTransaction( - Type => 'AddWatcher', - NewValue => $principal->Id, - Field => $args{'Type'} - ); - } + return ( 0, $msg) unless $principal; return ( 1, $self->loc('Added [_1] as a [_2] for this ticket', $principal->Object->Name, $self->loc($args{'Type'})) ); } +=head2 DeleteWatcher +Applies access control checking, then calls +L<RT::Record::Role::Roles/DeleteRoleMember>. Additionally, C<Email> is +accepted as an alternative argument name for C<User>. -=head2 DeleteWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL_ADDRESS } - - -Deletes a Ticket watcher. Takes two arguments: - -Type (one of Requestor,Cc,AdminCc) - -and one of - -PrincipalId (an RT::Principal Id of the watcher you want to remove) - OR -Email (the email address of an existing wathcer) - +Returns a tuple of (status, message). =cut @@ -1282,102 +742,15 @@ sub DeleteWatcher { Email => undef, @_ ); - unless ( $args{'PrincipalId'} || $args{'Email'} ) { - return ( 0, $self->loc("No principal specified") ); - } - my $principal = RT::Principal->new( $self->CurrentUser ); - if ( $args{'PrincipalId'} ) { - - $principal->Load( $args{'PrincipalId'} ); - } - else { - my $user = RT::User->new( $self->CurrentUser ); - $user->LoadByEmail( $args{'Email'} ); - $principal->Load( $user->Id ); - } - - # If we can't find this watcher, we need to bail. - unless ( $principal->Id ) { - return ( 0, $self->loc("Could not find that principal") ); - } - - my $group = RT::Group->new( $self->CurrentUser ); - $group->LoadTicketRoleGroup( Type => $args{'Type'}, Ticket => $self->Id ); - unless ( $group->id ) { - return ( 0, $self->loc("Group not found") ); - } - - # Check ACLS - #If the watcher we're trying to add is for the current user - if ( $self->CurrentUser->PrincipalId == $principal->id ) { - - # If it's an AdminCc and they don't have - # 'WatchAsAdminCc' or 'ModifyTicket', bail - if ( $args{'Type'} eq 'AdminCc' ) { - unless ( $self->CurrentUserHasRight('ModifyTicket') - or $self->CurrentUserHasRight('WatchAsAdminCc') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - - # If it's a Requestor or Cc and they don't have - # 'Watch' or 'ModifyTicket', bail - elsif ( ( $args{'Type'} eq 'Cc' ) or ( $args{'Type'} eq 'Requestor' ) ) - { - unless ( $self->CurrentUserHasRight('ModifyTicket') - or $self->CurrentUserHasRight('Watch') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - else { - $RT::Logger->warning("$self -> DeleteWatcher got passed a bogus type"); - return ( 0, - $self->loc('Error in parameters to Ticket->DeleteWatcher') ); - } - } - - # If the watcher isn't the current user - # and the current user doesn't have 'ModifyTicket' bail - else { - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - } - - # }}} - - # see if this user is already a watcher. - - unless ( $group->HasMember($principal) ) { - return ( 0, - $self->loc( '[_1] is not a [_2] for this ticket', - $principal->Object->Name, $args{'Type'} ) ); - } - - my ( $m_id, $m_msg ) = $group->_DeleteMember( $principal->Id ); - unless ($m_id) { - $RT::Logger->error( "Failed to delete " - . $principal->Id - . " as a member of group " - . $group->Id . ": " - . $m_msg ); - - return (0, - $self->loc( - 'Could not remove [_1] as a [_2] for this ticket', - $principal->Object->Name, $args{'Type'} ) ); - } - - unless ( $args{'Silent'} ) { - $self->_NewTransaction( Type => 'DelWatcher', - OldValue => $principal->Id, - Field => $args{'Type'} ); - } + $args{ACL} = sub { $self->_HasModifyWatcherRight( @_ ) }; + $args{User} ||= delete $args{Email}; + my ($principal, $msg) = $self->DeleteRoleMember( %args ); + return ( 0, $msg ) unless $principal; return ( 1, $self->loc( "[_1] is no longer a [_2] for this ticket.", $principal->Object->Name, - $args{'Type'} ) ); + $self->loc($args{'Type'}) ) ); } @@ -1497,22 +870,23 @@ sub CcAddresses { -=head2 Requestors +=head2 Requestor Takes nothing. Returns this ticket's Requestors as an RT::Group object =cut -sub Requestors { +sub Requestor { my $self = shift; + return RT::Group->new($self->CurrentUser) + unless $self->CurrentUserHasRight('ShowTicket'); + return $self->RoleGroup( 'Requestor' ); +} - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('ShowTicket') ) { - $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id); - } - return ($group); - +sub Requestors { + my $self = shift; + return $self->Requestor; } =head2 _Requestors @@ -1541,12 +915,9 @@ If the user doesn't have "ShowTicket" permission, returns an empty group sub Cc { my $self = shift; - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('ShowTicket') ) { - $group->LoadTicketRoleGroup(Type => 'Cc', Ticket => $self->Id); - } - return ($group); - + return RT::Group->new($self->CurrentUser) + unless $self->CurrentUserHasRight('ShowTicket'); + return $self->RoleGroup( 'Cc' ); } @@ -1562,12 +933,9 @@ If the user doesn't have "ShowTicket" permission, returns an empty group sub AdminCc { my $self = shift; - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('ShowTicket') ) { - $group->LoadTicketRoleGroup(Type => 'AdminCc', Ticket => $self->Id); - } - return ($group); - + return RT::Group->new($self->CurrentUser) + unless $self->CurrentUserHasRight('ShowTicket'); + return $self->RoleGroup( 'AdminCc' ); } @@ -1599,9 +967,8 @@ sub IsWatcher { @_ ); - # Load the relevant group. - my $group = RT::Group->new($self->CurrentUser); - $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->id); + # Load the relevant group. + my $group = $self->RoleGroup( $args{'Type'} ); # Find the relevant principal. if (!$args{PrincipalId} && $args{Email}) { @@ -1730,16 +1097,12 @@ sub TransactionAddresses { $attachments->LimitByTicket( $self->id ); $attachments->Columns( qw( id Headers TransactionId)); - - foreach my $type (qw(Create Comment Correspond)) { - $attachments->Limit( ALIAS => $attachments->TransactionAlias, - FIELD => 'Type', - OPERATOR => '=', - VALUE => $type, - ENTRYAGGREGATOR => 'OR', - CASESENSITIVE => 1 - ); - } + $attachments->Limit( + ALIAS => $attachments->TransactionAlias, + FIELD => 'Type', + OPERATOR => 'IN', + VALUE => [ qw(Create Comment Correspond) ], + ); while ( my $att = $attachments->Next ) { foreach my $addrlist ( values %{$att->Addresses } ) { @@ -1787,94 +1150,26 @@ sub ValidateQueue { } } - - sub SetQueue { - my $self = shift; - my $NewQueue = shift; + my $self = shift; + my $value = shift; - #Redundant. ACL gets checked in _Set; unless ( $self->CurrentUserHasRight('ModifyTicket') ) { return ( 0, $self->loc("Permission Denied") ); } - my $NewQueueObj = RT::Queue->new( $self->CurrentUser ); - $NewQueueObj->Load($NewQueue); - - unless ( $NewQueueObj->Id() ) { - return ( 0, $self->loc("That queue does not exist") ); - } - - if ( $NewQueueObj->Id == $self->QueueObj->Id ) { - return ( 0, $self->loc('That is the same value') ); - } - unless ( $self->CurrentUser->HasRight( Right => 'CreateTicket', Object => $NewQueueObj)) { - return ( 0, $self->loc("You may not create requests in that queue.") ); - } - - my $new_status; - my $old_lifecycle = $self->QueueObj->Lifecycle; - my $new_lifecycle = $NewQueueObj->Lifecycle; - if ( $old_lifecycle->Name ne $new_lifecycle->Name ) { - unless ( $old_lifecycle->HasMoveMap( $new_lifecycle ) ) { - return ( 0, $self->loc("There is no mapping for statuses between these queues. Contact your system administrator.") ); - } - $new_status = $old_lifecycle->MoveMap( $new_lifecycle )->{ lc $self->Status }; - return ( 0, $self->loc("Mapping between queues' lifecycles is incomplete. Contact your system administrator.") ) - unless $new_status; - } - - if ( $new_status ) { - my $clone = RT::Ticket->new( RT->SystemUser ); - $clone->Load( $self->Id ); - unless ( $clone->Id ) { - return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) ); - } - - my $now = RT::Date->new( $self->CurrentUser ); - $now->SetToNow; - - my $old_status = $clone->Status; - - #If we're changing the status from initial in old to not intial in new, - # record that we've started - if ( $old_lifecycle->IsInitial($old_status) && !$new_lifecycle->IsInitial($new_status) && $clone->StartedObj->Unix == 0 ) { - #Set the Started time to "now" - $clone->_Set( - Field => 'Started', - Value => $now->ISO, - RecordTransaction => 0 - ); - } - - #When we close a ticket, set the 'Resolved' attribute to now. - # It's misnamed, but that's just historical. - if ( $new_lifecycle->IsInactive($new_status) ) { - $clone->_Set( - Field => 'Resolved', - Value => $now->ISO, - RecordTransaction => 0, - ); - } - - #Actually update the status - my ($val, $msg)= $clone->_Set( - Field => 'Status', - Value => $new_status, - RecordTransaction => 0, - ); - $RT::Logger->error( 'Status change failed on queue change: '. $msg ) - unless $val; - } - - my ($status, $msg) = $self->_Set( Field => 'Queue', Value => $NewQueueObj->Id() ); + my ($ok, $msg, $status) = $self->_SetLifecycleColumn( + Value => $value, + RequireRight => "CreateTicket" + ); - if ( $status ) { + if ($ok) { # Clear the queue object cache; $self->{_queue_obj} = undef; + my $queue = $self->QueueObj; # Untake the ticket if we have no permissions in the new queue - unless ( $self->OwnerObj->HasRight( Right => 'OwnTicket', Object => $NewQueueObj ) ) { + unless ($self->OwnerObj->HasRight( Right => 'OwnTicket', Object => $queue )) { my $clone = RT::Ticket->new( RT->SystemUser ); $clone->Load( $self->Id ); unless ( $clone->Id ) { @@ -1887,12 +1182,17 @@ sub SetQueue { # On queue change, change queue for reminders too my $reminder_collection = $self->Reminders->Collection; while ( my $reminder = $reminder_collection->Next ) { - my ($status, $msg) = $reminder->SetQueue($NewQueue); + my ($status, $msg) = $reminder->_Set( Field => 'Queue', Value => $queue->Id(), RecordTransaction => 0 ); $RT::Logger->error('Queue change failed for reminder #' . $reminder->Id . ': ' . $msg) unless $status; } + + # Pick up any changes made by the clones above + $self->Load( $self->id ); + RT->Logger->error("Unable to reload ticket #" . $self->id) + unless $self->id; } - return ($status, $msg); + return ($ok, $msg); } @@ -1927,7 +1227,7 @@ sub SetSubject { Takes nothing. Returns SubjectTag for this ticket. Includes queue's subject tag or rtname if that is not set, ticket -id and braces, for example: +id and brackets, for example: [support.example.com #123456] @@ -1970,12 +1270,19 @@ sub DueObj { =head2 DueAsString -Returns this ticket's due date as a human readable string +Returns this ticket's due date as a human readable string. + +B<DEPRECATED> and will be removed in 4.4; use C<< +$ticket->DueObj->AsString >> instead. =cut sub DueAsString { my $self = shift; + RT->Deprecated( + Instead => "->DueObj->AsString", + Remove => "4.4", + ); return $self->DueObj->AsString(); } @@ -1995,7 +1302,6 @@ sub ResolvedObj { return $time; } - =head2 FirstActiveStatus Returns the first active status that the ticket could transition to, @@ -2008,7 +1314,7 @@ This is used in L<RT::Action::AutoOpen>, for instance. sub FirstActiveStatus { my $self = shift; - my $lifecycle = $self->QueueObj->Lifecycle; + my $lifecycle = $self->LifecycleObj; my $status = $self->Status; my @active = $lifecycle->Active; # no change if no active statuses in the lifecycle @@ -2033,7 +1339,7 @@ This is used in resolve action in UnsafeEmailCommands, for instance. sub FirstInactiveStatus { my $self = shift; - my $lifecycle = $self->QueueObj->Lifecycle; + my $lifecycle = $self->LifecycleObj; my $status = $self->Status; my @inactive = $lifecycle->Inactive; # no change if no inactive statuses in the lifecycle @@ -2072,16 +1378,6 @@ sub SetStarted { $time_obj->SetToNow(); } - # We need $TicketAsSystem, in case the current user doesn't have - # ShowTicket - my $TicketAsSystem = RT::Ticket->new(RT->SystemUser); - $TicketAsSystem->Load( $self->Id ); - # Now that we're starting, open this ticket - # TODO: do we really want to force this as policy? it should be a scrip - my $next = $TicketAsSystem->FirstActiveStatus; - - $self->SetStatus( $next ) if defined $next; - return ( $self->_Set( Field => 'Started', Value => $time_obj->ISO ) ); } @@ -2143,12 +1439,17 @@ sub ToldObj { A convenience method that returns ToldObj->AsString -TODO: This should be deprecated +B<DEPRECATED> and will be removed in 4.4; use C<< +$ticket->ToldObj->AsString >> instead. =cut sub ToldAsString { my $self = shift; + RT->Deprecated( + Instead => "->ToldObj->AsString", + Remove => "4.4", + ); if ( $self->Told ) { return $self->ToldObj->AsString(); } @@ -2159,39 +1460,45 @@ sub ToldAsString { +sub _DurationAsString { + my $self = shift; + my $value = shift; + return "" unless $value; + return RT::Date->new( $self->CurrentUser ) + ->DurationAsString( $value * 60 ); +} + =head2 TimeWorkedAsString -Returns the amount of time worked on this ticket as a Text String +Returns the amount of time worked on this ticket as a text string. =cut sub TimeWorkedAsString { my $self = shift; - my $value = $self->TimeWorked; - - # return the # of minutes worked turned into seconds and written as - # a simple text string, this is not really a date object, but if we - # diff a number of seconds vs the epoch, we'll get a nice description - # of time worked. - return "" unless $value; - return RT::Date->new( $self->CurrentUser ) - ->DurationAsString( $value * 60 ); + return $self->_DurationAsString( $self->TimeWorked ); } - - =head2 TimeLeftAsString -Returns the amount of time left on this ticket as a Text String +Returns the amount of time left on this ticket as a text string. =cut sub TimeLeftAsString { my $self = shift; - my $value = $self->TimeLeft; - return "" unless $value; - return RT::Date->new( $self->CurrentUser ) - ->DurationAsString( $value * 60 ); + return $self->_DurationAsString( $self->TimeLeft ); +} + +=head2 TimeEstimatedAsString + +Returns the amount of time estimated on this ticket as a text string. + +=cut + +sub TimeEstimatedAsString { + my $self = shift; + return $self->_DurationAsString( $self->TimeEstimated ); } @@ -2376,7 +1683,7 @@ sub _RecordNote { foreach my $argument (qw(Encrypt Sign)) { $args{'MIMEObj'}->head->replace( - "X-RT-$argument" => Encode::encode( "UTF-8", $args{ $argument } ) + "X-RT-$argument" => $args{ $argument } ? 1 : 0 ) if defined $args{ $argument }; } @@ -2386,7 +1693,7 @@ sub _RecordNote { my $org = RT->Config->Get('Organization'); my $msgid = Encode::decode( "UTF-8", $args{'MIMEObj'}->head->get('Message-ID') ); unless (defined $msgid && $msgid =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>/) { - $args{'MIMEObj'}->head->set( + $args{'MIMEObj'}->head->replace( 'RT-Message-ID' => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId( Ticket => $self ) ) @@ -2409,7 +1716,12 @@ sub _RecordNote { return ( $Trans, $self->loc("Message could not be recorded"), undef ); } - return ( $Trans, $self->loc("Message recorded"), $TransObj ); + if ($args{NoteType} eq "Comment") { + $msg = $self->loc("Comments added"); + } else { + $msg = $self->loc("Correspondence added"); + } + return ( $Trans, $msg, $TransObj ); } @@ -2444,6 +1756,7 @@ sub DryRun { MIMEObj => $Message, TimeTaken => $args{'UpdateTimeWorked'}, DryRun => 1, + SquelchMailTo => $args{'SquelchMailTo'}, ); unless ( $Transaction ) { $RT::Logger->error("Couldn't fire '$action' action: $Description"); @@ -2517,21 +1830,14 @@ sub _Links { } # Maybe this ticket is a merge ticket - #my $limit_on = 'Local'. $field; + my $limit_on = 'Local'. $field; # at least to myself $links->Limit( - FIELD => $field, #$limit_on, - OPERATOR => 'MATCHES', - VALUE => 'fsck.com-rt://%/ticket/'. $self->id, - ENTRYAGGREGATOR => 'OR', + FIELD => $limit_on, + OPERATOR => 'IN', + VALUE => [ $self->id, $self->Merged ], ); $links->Limit( - FIELD => $field, #$limit_on, - OPERATOR => 'MATCHES', - VALUE => 'fsck.com-rt://%/ticket/'. $_, - ENTRYAGGREGATOR => 'OR', - ) foreach $self->Merged; - $links->Limit( FIELD => 'Type', VALUE => $type, ) if $type; @@ -2539,236 +1845,6 @@ sub _Links { return $links; } - - -=head2 DeleteLink - -Delete a link. takes a paramhash of Base, Target, Type, Silent, -SilentBase and SilentTarget. Either Base or Target must be null. -The null value will be replaced with this ticket's id. - -If Silent is true then no transaction would be recorded, in other -case you can control creation of transactions on both base and -target with SilentBase and SilentTarget respectively. By default -both transactions are created. - -=cut - -sub DeleteLink { - my $self = shift; - my %args = ( - Base => undef, - Target => undef, - Type => undef, - Silent => undef, - SilentBase => undef, - SilentTarget => undef, - @_ - ); - - unless ( $args{'Target'} || $args{'Base'} ) { - $RT::Logger->error("Base or Target must be specified"); - return ( 0, $self->loc('Either base or target must be specified') ); - } - - #check acls - my $right = 0; - $right++ if $self->CurrentUserHasRight('ModifyTicket'); - if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) { - return ( 0, $self->loc("Permission Denied") ); - } - - # If the other URI is an RT::Ticket, we want to make sure the user - # can modify it too... - my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} ); - return (0, $msg) unless $status; - if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) { - $right++; - } - if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) || - ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) ) - { - return ( 0, $self->loc("Permission Denied") ); - } - - my ($val, $Msg) = $self->SUPER::_DeleteLink(%args); - return ( 0, $Msg ) unless $val; - - return ( $val, $Msg ) if $args{'Silent'}; - - my ($direction, $remote_link); - - if ( $args{'Base'} ) { - $remote_link = $args{'Base'}; - $direction = 'Target'; - } - elsif ( $args{'Target'} ) { - $remote_link = $args{'Target'}; - $direction = 'Base'; - } - - my $remote_uri = RT::URI->new( $self->CurrentUser ); - $remote_uri->FromURI( $remote_link ); - - unless ( $args{ 'Silent'. $direction } ) { - my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( - Type => 'DeleteLink', - Field => $LINKDIRMAP{$args{'Type'}}->{$direction}, - OldValue => $remote_uri->URI || $remote_link, - TimeTaken => 0 - ); - $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; - } - - if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) { - my $OtherObj = $remote_uri->Object; - my ( $val, $Msg ) = $OtherObj->_NewTransaction( - Type => 'DeleteLink', - Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base} - : $LINKDIRMAP{$args{'Type'}}->{Target}, - OldValue => $self->URI, - ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'), - TimeTaken => 0, - ); - $RT::Logger->error("Couldn't create transaction: $Msg") unless $val; - } - - return ( $val, $Msg ); -} - - - -=head2 AddLink - -Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket. - -If Silent is true then no transaction would be recorded, in other -case you can control creation of transactions on both base and -target with SilentBase and SilentTarget respectively. By default -both transactions are created. - -=cut - -sub AddLink { - my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - SilentBase => undef, - SilentTarget => undef, - @_ ); - - unless ( $args{'Target'} || $args{'Base'} ) { - $RT::Logger->error("Base or Target must be specified"); - return ( 0, $self->loc('Either base or target must be specified') ); - } - - my $right = 0; - $right++ if $self->CurrentUserHasRight('ModifyTicket'); - if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) { - return ( 0, $self->loc("Permission Denied") ); - } - - # If the other URI is an RT::Ticket, we want to make sure the user - # can modify it too... - my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} ); - return (0, $msg) unless $status; - if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) { - $right++; - } - if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) || - ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) ) - { - return ( 0, $self->loc("Permission Denied") ); - } - - return ( 0, "Can't link to a deleted ticket" ) - if $other_ticket && lc $other_ticket->Status eq 'deleted'; - - return $self->_AddLink(%args); -} - -sub __GetTicketFromURI { - my $self = shift; - my %args = ( URI => '', @_ ); - - # If the other URI is an RT::Ticket, we want to make sure the user - # can modify it too... - my $uri_obj = RT::URI->new( $self->CurrentUser ); - unless ($uri_obj->FromURI( $args{'URI'} )) { - my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} ); - $RT::Logger->warning( $msg ); - return( 0, $msg ); - } - my $obj = $uri_obj->Resolver->Object; - unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) { - return (1, 'Found not a ticket', undef); - } - return (1, 'Found ticket', $obj); -} - -=head2 _AddLink - -Private non-acled variant of AddLink so that links can be added during create. - -=cut - -sub _AddLink { - my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - SilentBase => undef, - SilentTarget => undef, - @_ ); - - my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args); - return ($val, $msg) if !$val || $exist; - return ($val, $msg) if $args{'Silent'}; - - my ($direction, $remote_link); - if ( $args{'Target'} ) { - $remote_link = $args{'Target'}; - $direction = 'Base'; - } elsif ( $args{'Base'} ) { - $remote_link = $args{'Base'}; - $direction = 'Target'; - } - - my $remote_uri = RT::URI->new( $self->CurrentUser ); - $remote_uri->FromURI( $remote_link ); - - unless ( $args{ 'Silent'. $direction } ) { - my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( - Type => 'AddLink', - Field => $LINKDIRMAP{$args{'Type'}}->{$direction}, - NewValue => $remote_uri->URI || $remote_link, - TimeTaken => 0 - ); - $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; - } - - if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) { - my $OtherObj = $remote_uri->Object; - my ( $val, $msg ) = $OtherObj->_NewTransaction( - Type => 'AddLink', - Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base} - : $LINKDIRMAP{$args{'Type'}}->{Target}, - NewValue => $self->URI, - ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'), - TimeTaken => 0, - ); - $RT::Logger->error("Couldn't create transaction: $msg") unless $val; - } - - return ( $val, $msg ); -} - - - - =head2 MergeInto MergeInto take the id of the ticket to merge this ticket into. @@ -2792,6 +1868,11 @@ sub MergeInto { return ( 0, $self->loc("New ticket doesn't exist") ); } + # Can't merge into yourself + if ( $MergeInto->Id == $self->Id ) { + return ( 0, $self->loc("Can't merge a ticket into itself") ); + } + # Make sure the current user can modify the new ticket. unless ( $MergeInto->CurrentUserHasRight('ModifyTicket') ) { return ( 0, $self->loc("Permission Denied") ); @@ -2804,11 +1885,11 @@ sub MergeInto { $RT::Handle->BeginTransaction(); - $self->_MergeInto( $MergeInto ); + my ($ok, $msg) = $self->_MergeInto( $MergeInto ); - $RT::Handle->Commit(); + $RT::Handle->Commit() if $ok; - return ( 1, $self->loc("Merge Successful") ); + return ($ok, $msg); } sub _MergeInto { @@ -2832,8 +1913,13 @@ sub _MergeInto { return ( 0, $self->loc("Merge failed. Couldn't set EffectiveId") ); } + ( $id_val, $id_msg ) = $self->__Set( Field => 'IsMerged', Value => 1 ); + unless ($id_val) { + $RT::Handle->Rollback(); + return ( 0, $self->loc("Merge failed. Couldn't set IsMerged") ); + } - my $force_status = $self->QueueObj->Lifecycle->DefaultOnMerge; + my $force_status = $self->LifecycleObj->DefaultOnMerge; if ( $force_status && $force_status ne $self->__Value('Status') ) { my ( $status_val, $status_msg ) = $self->__Set( Field => 'Status', Value => $force_status ); @@ -2899,31 +1985,28 @@ sub _MergeInto { # Update time fields foreach my $type (qw(TimeEstimated TimeWorked TimeLeft)) { - - my $mutator = "Set$type"; - $MergeInto->$mutator( - ( $MergeInto->$type() || 0 ) + ( $self->$type() || 0 ) ); - + $MergeInto->_Set( + Field => $type, + Value => ( $MergeInto->$type() || 0 ) + ( $self->$type() || 0 ), + RecordTransaction => 0, + ); } -#add all of this ticket's watchers to that ticket. - foreach my $watcher_type (qw(Requestors Cc AdminCc)) { - - my $people = $self->$watcher_type->MembersObj; - my $addwatcher_type = $watcher_type; - $addwatcher_type =~ s/s$//; + # add all of this ticket's watchers to that ticket. + for my $role ($self->Roles) { + next if $self->RoleGroup($role)->SingleMemberRoleGroup; + my $people = $self->RoleGroup($role)->MembersObj; while ( my $watcher = $people->Next ) { - - my ($val, $msg) = $MergeInto->_AddWatcher( - Type => $addwatcher_type, - Silent => 1, - PrincipalId => $watcher->MemberId + my ($val, $msg) = $MergeInto->AddRoleMember( + Type => $role, + Silent => 1, + PrincipalId => $watcher->MemberId, + InsideTransaction => 1, ); unless ($val) { $RT::Logger->debug($msg); } - } - + } } #find all of the tickets that were merged into this ticket. @@ -2946,6 +2029,8 @@ sub _MergeInto { $self->AddLink( Type => 'MergedInto', Target => $MergeInto->Id()); $MergeInto->_SetLastUpdated; + + return ( 1, $self->loc("Merge Successful") ); } =head2 Merged @@ -2962,11 +2047,11 @@ sub Merged { if $MERGE_CACHE{'merged'}{ $id }; my $mergees = RT::Tickets->new( $self->CurrentUser ); - $mergees->Limit( + $mergees->LimitField( FIELD => 'EffectiveId', VALUE => $id, ); - $mergees->Limit( + $mergees->LimitField( FIELD => 'id', OPERATOR => '!=', VALUE => $id, @@ -3040,131 +2125,247 @@ sub SetOwner { my $NewOwnerObj = RT::User->new( $self->CurrentUser ); $NewOwnerObj->Load( $NewOwner ); - unless ( $NewOwnerObj->Id ) { + + my ( $val, $msg ) = $self->CurrentUserCanSetOwner( + NewOwnerObj => $NewOwnerObj, + Type => $Type ); + + unless ($val) { $RT::Handle->Rollback(); - return ( 0, $self->loc("That user does not exist") ); + return ( $val, $msg ); + } + + ($val, $msg ) = $self->OwnerGroup->_AddMember( + PrincipalId => $NewOwnerObj->PrincipalId, + InsideTransaction => 1, + Object => $self, + ); + unless ($val) { + $RT::Handle->Rollback; + return ( 0, $self->loc("Could not change owner: [_1]", $msg) ); } + $msg = $self->loc( "Owner changed from [_1] to [_2]", + $OldOwnerObj->Name, $NewOwnerObj->Name ); + + $RT::Handle->Commit(); + + return ( $val, $msg ); +} + +=head2 CurrentUserCanSetOwner + +Confirm the current user can set the owner of the current ticket. + +There are several different rights to manage owner changes and +this method evaluates these rights, guided by parameters provided. + +This method evaluates these rights in the context of the state of +the current ticket. For example, it evaluates Take for tickets that +are owned by Nobody because that is the context appropriate for the +TakeTicket right. If you need to strictly test a user for a right, +use HasRight to check for the right directly. + +For some custom types of owner changes (C<Take> and C<Steal>), it also +verifies that those actions are possible given the current ticket owner. + +=head3 Rights to Set Owner + +The current user can set or change the Owner field in the following +cases: + +=over + +=item * + +ReassignTicket unconditionally grants the right to set the owner +to any user who has OwnTicket. This can be used to break an +Owner lock held by another user (see below) and can be a convenient +right for managers or administrators who need to assign tickets +without necessarily owning them. + +=item * + +ModifyTicket grants the right to set the owner to any user who +has OwnTicket, provided the ticket is currently owned by the current +user or is not owned (owned by Nobody). (See the details on the Force +parameter below for exceptions to this.) + +=item * + +If the ticket is currently not owned (owned by Nobody), +TakeTicket is sufficient to set the owner to yourself (but not +an arbitrary person), but only if you have OwnTicket. It is +thus a subset of the possible changes provided by ModifyTicket. +This exists to allow granting TakeTicket freely, and +the broader ModifyTicket only to Owners. + +=item * + +If the ticket is currently owned by someone who is not you or +Nobody, StealTicket is sufficient to set the owner to yourself, +but only if you have OwnTicket. This is hence non-overlapping +with the changes provided by ModifyTicket, and is used to break +a lock held by another user. + +=back - # must have ModifyTicket rights - # or TakeTicket/StealTicket and $NewOwner is self - # see if it's a take +=head3 Parameters + +This method returns ($result, $message) with $result containing +true or false indicating if the current user can set owner and $message +containing a message, typically in the case of a false response. + +If called with no parameters, this method determines if the current +user could set the owner of the current ticket given any +permutation of the rights described above. This can be useful +when determining whether to make owner-setting options available +in the GUI. + +This method accepts the following parameters as a paramshash: + +=over + +=item C<NewOwnerObj> + +Optional; an L<RT::User> object representing the proposed new owner of +the ticket. + +=item C<Type> + +Optional; the type of set owner operation. Valid values are C<Take>, +C<Steal>, or C<Force>. Note that if the type is C<Take>, this method +will return false if the current user is already the owner; similarly, +it will return false for C<Steal> if the ticket has no owner or the +owner is the current user. + +=back + +As noted above, there are exceptions to the standard ticket-based rights +described here. The Force option allows for these and is used +when moving tickets between queues, for reminders (because the full +owner rights system is too complex for them), and optionally during +bulk update. + +=cut + +sub CurrentUserCanSetOwner { + my $self = shift; + my %args = ( Type => '', + @_); + my $OldOwnerObj = $self->OwnerObj; + + $args{NewOwnerObj} ||= $self->CurrentUser->UserObj + if $args{Type} eq "Take" or $args{Type} eq "Steal"; + + # Confirm rights for new owner if we got one + if ( $args{'NewOwnerObj'} ){ + my ($ok, $message) = $self->_NewOwnerCanOwnTicket($args{'NewOwnerObj'}, $OldOwnerObj); + return ($ok, $message) if not $ok; + } + + # ReassignTicket allows you to SetOwner, but we also need to check ticket's + # current owner for Take and Steal Types + return ( 1, undef ) if $self->CurrentUserHasRight('ReassignTicket') + && $args{Type} ne 'Take' && $args{Type} ne 'Steal'; + + # Ticket is unowned if ( $OldOwnerObj->Id == RT->Nobody->Id ) { - unless ( $self->CurrentUserHasRight('ModifyTicket') - || $self->CurrentUserHasRight('TakeTicket') ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Permission Denied") ); + + # Steal is not applicable for unowned tickets. + if ( $args{'Type'} eq 'Steal' ){ + return ( 0, $self->loc("You can only steal a ticket owned by someone else") ) + } + + # Can set owner to yourself with ModifyTicket, ReassignTicket, + # or TakeTicket; in all of these cases, OwnTicket is checked by + # _NewOwnerCanOwnTicket above. + if ( $args{'Type'} eq 'Take' + or ( $args{'NewOwnerObj'} + and $args{'NewOwnerObj'}->id == $self->CurrentUser->id )) { + unless ( $self->CurrentUserHasRight('ModifyTicket') + or $self->CurrentUserHasRight('ReassignTicket') + or $self->CurrentUserHasRight('TakeTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } + } else { + # Nobody -> someone else requires ModifyTicket or ReassignTicket + unless ( $self->CurrentUserHasRight('ModifyTicket') + or $self->CurrentUserHasRight('ReassignTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } } } - # see if it's a steal + # Ticket is owned by someone else + # Can set owner to yourself with ModifyTicket or StealTicket + # and OwnTicket. elsif ( $OldOwnerObj->Id != RT->Nobody->Id && $OldOwnerObj->Id != $self->CurrentUser->id ) { unless ( $self->CurrentUserHasRight('ModifyTicket') + || $self->CurrentUserHasRight('ReassignTicket') || $self->CurrentUserHasRight('StealTicket') ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Permission Denied") ); + return ( 0, $self->loc("Permission Denied") ) } - } - else { - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - $RT::Handle->Rollback(); + + if ( $args{'Type'} eq 'Steal' || $args{'Type'} eq 'Force' ){ + return ( 1, undef ) if $self->CurrentUserHasRight('OwnTicket'); return ( 0, $self->loc("Permission Denied") ); } - } - - # If we're not stealing and the ticket has an owner and it's not - # the current user - if ( $Type ne 'Steal' and $Type ne 'Force' - and $OldOwnerObj->Id != RT->Nobody->Id - and $OldOwnerObj->Id != $self->CurrentUser->Id ) - { - $RT::Handle->Rollback(); - return ( 0, $self->loc("You can only take tickets that are unowned") ) - if $NewOwnerObj->id == $self->CurrentUser->id; - return ( - 0, - $self->loc("You can only reassign tickets that you own or that are unowned" ) - ); - } - #If we've specified a new owner and that user can't modify the ticket - elsif ( !$NewOwnerObj->HasRight( Right => 'OwnTicket', Object => $self ) ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("That user may not own tickets in that queue") ); - } + # Not a steal or force + if ( $args{'Type'} eq 'Take' + or ( $args{'NewOwnerObj'} + and $args{'NewOwnerObj'}->id == $self->CurrentUser->id )) { + return ( 0, $self->loc("You can only take tickets that are unowned") ); + } - # If the ticket has an owner and it's the new owner, we don't need - # To do anything - elsif ( $NewOwnerObj->Id == $OldOwnerObj->Id ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("That user already owns that ticket") ); - } + unless ( $self->CurrentUserHasRight('ReassignTicket') ) { + return ( 0, $self->loc( "You can only reassign tickets that you own or that are unowned")); + } - # Delete the owner in the owner group, then add a new one - # TODO: is this safe? it's not how we really want the API to work - # for most things, but it's fast. - my ( $del_id, $del_msg ); - for my $owner (@{$self->OwnerGroup->MembersObj->ItemsArrayRef}) { - ($del_id, $del_msg) = $owner->Delete(); - last unless ($del_id); } + # You own the ticket + # Untake falls through to here, so we don't need to explicitly handle that Type + else { + if ( $args{'Type'} eq 'Take' || $args{'Type'} eq 'Steal' ) { + return ( 0, $self->loc("You already own this ticket") ); + } - unless ($del_id) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Could not change owner: [_1]", $del_msg) ); + unless ( $self->CurrentUserHasRight('ModifyTicket') + || $self->CurrentUserHasRight('ReassignTicket') ) { + return ( 0, $self->loc("Permission Denied") ); + } } - my ( $add_id, $add_msg ) = $self->OwnerGroup->_AddMember( - PrincipalId => $NewOwnerObj->PrincipalId, - InsideTransaction => 1 ); - unless ($add_id) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Could not change owner: [_1]", $add_msg ) ); - } + return ( 1, undef ); +} - # We call set twice with slightly different arguments, so - # as to not have an SQL transaction span two RT transactions +# Verify the proposed new owner can own the ticket. - my ( $val, $msg ) = $self->_Set( - Field => 'Owner', - RecordTransaction => 0, - Value => $NewOwnerObj->Id, - TimeTaken => 0, - TransactionType => 'Set', - CheckACL => 0, # don't check acl - ); +sub _NewOwnerCanOwnTicket { + my $self = shift; + my $NewOwnerObj = shift; + my $OldOwnerObj = shift; - unless ($val) { - $RT::Handle->Rollback; - return ( 0, $self->loc("Could not change owner: [_1]", $msg) ); + unless ( $NewOwnerObj->Id ) { + return ( 0, $self->loc("That user does not exist") ); } - ($val, $msg) = $self->_NewTransaction( - Type => 'Set', - Field => 'Owner', - NewValue => $NewOwnerObj->Id, - OldValue => $OldOwnerObj->Id, - TimeTaken => 0, - ); - - if ( $val ) { - $msg = $self->loc( "Owner changed from [_1] to [_2]", - $OldOwnerObj->Name, $NewOwnerObj->Name ); - } - else { - $RT::Handle->Rollback(); - return ( 0, $msg ); + # The proposed new owner can't own the ticket + if ( !$NewOwnerObj->HasRight( Right => 'OwnTicket', Object => $self ) ){ + return ( 0, $self->loc("That user may not own tickets in that queue") ); } - $RT::Handle->Commit(); + # Ticket's current owner is the same as the new owner, nothing to do + elsif ( $NewOwnerObj->Id == $OldOwnerObj->Id ) { + return ( 0, $self->loc("That user already owns that ticket") ); + } - return ( $val, $msg ); + return (1, undef); } - - =head2 Take A convenince method to set the ticket's owner to the current user @@ -3211,46 +2412,13 @@ sub Steal { } - - - - -=head2 ValidateStatus STATUS - -Takes a string. Returns true if that status is a valid status for this ticket. -Returns false otherwise. - -=cut - -sub ValidateStatus { - my $self = shift; - my $status = shift; - - #Make sure the status passed in is valid - return 1 if $self->QueueObj->IsValidStatus($status); - - my $i = 0; - while ( my $caller = (caller($i++))[3] ) { - return 1 if $caller eq 'RT::Ticket::SetQueue'; - } - - return 0; -} - -sub Status { - my $self = shift; - my $value = $self->_Value( 'Status' ); - return $value unless $self->QueueObj; - return $self->QueueObj->Lifecycle->CanonicalCase( $value ); -} - =head2 SetStatus STATUS -Set this ticket's status. STATUS can be one of: new, open, stalled, resolved, rejected or deleted. +Set this ticket's status. Alternatively, you can pass in a list of named parameters (Status => STATUS, Force => FORCE, SetStarted => SETSTARTED ). If FORCE is true, ignore unresolved dependencies and force a status change. -if SETSTARTED is true( it's the default value), set Started to current datetime if Started +if SETSTARTED is true (it's the default value), set Started to current datetime if Started is not set and the status is changed from initial to not initial. =cut @@ -3269,27 +2437,36 @@ sub SetStatus { # this option was added for rtir initially $args{SetStarted} = 1 unless exists $args{SetStarted}; + my ($valid, $msg) = $self->ValidateStatusChange($args{Status}); + return ($valid, $msg) unless $valid; - my $lifecycle = $self->QueueObj->Lifecycle; - - my $new = lc $args{'Status'}; - unless ( $lifecycle->IsValid( $new ) ) { - return (0, $self->loc("Status '[_1]' isn't a valid status for tickets in this queue.", $self->loc($new))); - } + my $lifecycle = $self->LifecycleObj; - my $old = $self->__Value('Status'); - unless ( $lifecycle->IsTransition( $old => $new ) ) { - return (0, $self->loc("You can't change status from '[_1]' to '[_2]'.", $self->loc($old), $self->loc($new))); + if ( !$args{Force} + && !$lifecycle->IsInactive($self->Status) + && $lifecycle->IsInactive($args{Status}) + && $self->HasUnresolvedDependencies ) + { + return ( 0, $self->loc('That ticket has unresolved dependencies') ); } - my $check_right = $lifecycle->CheckRight( $old => $new ); - unless ( $self->CurrentUserHasRight( $check_right ) ) { - return ( 0, $self->loc('Permission Denied') ); - } + return $self->_SetStatus( + Status => $args{Status}, + SetStarted => $args{SetStarted}, + ); +} - if ( !$args{Force} && $lifecycle->IsInactive( $new ) && $self->HasUnresolvedDependencies) { - return (0, $self->loc('That ticket has unresolved dependencies')); - } +sub _SetStatus { + my $self = shift; + my %args = ( + Status => undef, + SetStarted => 1, + RecordTransaction => 1, + Lifecycle => $self->LifecycleObj, + @_, + ); + $args{Status} = lc $args{Status} if defined $args{Status}; + $args{NewLifecycle} ||= $args{Lifecycle}; my $now = RT::Date->new( $self->CurrentUser ); $now->SetToNow(); @@ -3297,9 +2474,14 @@ sub SetStatus { my $raw_started = RT::Date->new(RT->SystemUser); $raw_started->Set(Format => 'ISO', Value => $self->__Value('Started')); - #If we're changing the status from new, record that we've started - if ( $args{SetStarted} && $lifecycle->IsInitial($old) && !$lifecycle->IsInitial($new) && !$raw_started->Unix) { - #Set the Started time to "now" + my $old = $self->__Value('Status'); + + # If we're changing the status from new, record that we've started + if ( $args{SetStarted} + && $args{Lifecycle}->IsInitial($old) + && !$args{NewLifecycle}->IsInitial($args{Status}) + && !$raw_started->IsSet) { + # Set the Started time to "now" $self->_Set( Field => 'Started', Value => $now->ISO, @@ -3307,9 +2489,9 @@ sub SetStatus { ); } - #When we close a ticket, set the 'Resolved' attribute to now. + # When we close a ticket, set the 'Resolved' attribute to now. # It's misnamed, but that's just historical. - if ( $lifecycle->IsInactive($new) ) { + if ( $args{NewLifecycle}->IsInactive($args{Status}) ) { $self->_Set( Field => 'Resolved', Value => $now->ISO, @@ -3317,18 +2499,30 @@ sub SetStatus { ); } - #Actually update the status + # Actually update the status my ($val, $msg)= $self->_Set( Field => 'Status', - Value => $new, + Value => $args{Status}, TimeTaken => 0, CheckACL => 0, TransactionType => 'Status', + RecordTransaction => $args{RecordTransaction}, ); return ($val, $msg); } +sub SetTimeWorked { + my $self = shift; + my $value = shift; + + my $taken = ($value||0) - ($self->__Value('TimeWorked')||0); + return $self->_Set( + Field => 'TimeWorked', + Value => $value, + TimeTaken => $taken, + ); +} =head2 Delete @@ -3338,7 +2532,7 @@ Takes no arguments. Marks this ticket for garbage collection sub Delete { my $self = shift; - unless ( $self->QueueObj->Lifecycle->IsValid('deleted') ) { + unless ( $self->LifecycleObj->IsValid('deleted') ) { return (0, $self->loc('Delete operation is disabled by lifecycle configuration') ); #loc } return ( $self->SetStatus('deleted') ); @@ -3581,57 +2775,42 @@ sub _Set { Value => undef, TimeTaken => 0, RecordTransaction => 1, - UpdateTicket => 1, CheckACL => 1, TransactionType => 'Set', @_ ); if ($args{'CheckACL'}) { - unless ( $self->CurrentUserHasRight('ModifyTicket')) { - return ( 0, $self->loc("Permission Denied")); - } - } - - unless ($args{'UpdateTicket'} || $args{'RecordTransaction'}) { - $RT::Logger->error("Ticket->_Set called without a mandate to record an update or update the ticket"); - return(0, $self->loc("Internal Error")); + unless ( $self->CurrentUserHasRight('ModifyTicket')) { + return ( 0, $self->loc("Permission Denied")); + } } - #if the user is trying to modify the record + # Avoid ACL loops using _Value + my $Old = $self->SUPER::_Value($args{'Field'}); - #Take care of the old value we really don't want to get in an ACL loop. - # so ask the super::_Value - my $Old = $self->SUPER::_Value("$args{'Field'}"); - - my ($ret, $msg); - if ( $args{'UpdateTicket'} ) { + # Set the new value + my ( $ret, $msg ) = $self->SUPER::_Set( + Field => $args{'Field'}, + Value => $args{'Value'} + ); + return ( 0, $msg ) unless $ret; - #Set the new value - ( $ret, $msg ) = $self->SUPER::_Set( Field => $args{'Field'}, - Value => $args{'Value'} ); - - #If we can't actually set the field to the value, don't record - # a transaction. instead, get out of here. - return ( 0, $msg ) unless $ret; - } + return ( $ret, $msg ) unless $args{'RecordTransaction'}; - if ( $args{'RecordTransaction'} == 1 ) { + my $trans; + ( $ret, $msg, $trans ) = $self->_NewTransaction( + Type => $args{'TransactionType'}, + Field => $args{'Field'}, + NewValue => $args{'Value'}, + OldValue => $Old, + TimeTaken => $args{'TimeTaken'}, + ); - my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( - Type => $args{'TransactionType'}, - Field => $args{'Field'}, - NewValue => $args{'Value'}, - OldValue => $Old, - TimeTaken => $args{'TimeTaken'}, - ); - # Ensure that we can read the transaction, even if the change - # just made the ticket unreadable to us - $TransObj->{ _object_is_readable } = 1; - return ( $Trans, scalar $TransObj->BriefDescription ); - } - else { - return ( $ret, $msg ); - } + # Ensure that we can read the transaction, even if the change + # just made the ticket unreadable to us + $trans->{ _object_is_readable } = 1; + + return ( $ret, scalar $trans->BriefDescription ); } @@ -3665,52 +2844,110 @@ sub _Value { } +=head2 Attachments +Customization of L<RT::Record/Attachments> for tickets. -=head2 _UpdateTimeTaken +=cut -This routine will increment the timeworked counter. it should -only be called from _NewTransaction +sub Attachments { + my $self = shift; + my %args = ( + WithHeaders => 0, + WithContent => 0, + @_ + ); + my $res = RT::Attachments->new( $self->CurrentUser ); + unless ( $self->CurrentUserHasRight('ShowTicket') ) { + $res->Limit( + SUBCLAUSE => 'acl', + FIELD => 'id', + VALUE => 0, + ENTRYAGGREGATOR => 'AND' + ); + return $res; + } + + my @columns = grep { not /^(Headers|Content)$/ } + RT::Attachment->ReadableAttributes; + push @columns, 'Headers' if $args{'WithHeaders'}; + push @columns, 'Content' if $args{'WithContent'}; + + $res->Columns( @columns ); + my $txn_alias = $res->TransactionAlias; + $res->Limit( + ALIAS => $txn_alias, + FIELD => 'ObjectType', + VALUE => ref($self), + ); + my $ticket_alias = $res->Join( + ALIAS1 => $txn_alias, + FIELD1 => 'ObjectId', + TABLE2 => 'Tickets', + FIELD2 => 'id', + ); + $res->Limit( + ALIAS => $ticket_alias, + FIELD => 'EffectiveId', + VALUE => $self->id, + ); + return $res; +} + +=head2 TextAttachments + +Customization of L<RT::Record/TextAttachments> for tickets. =cut -sub _UpdateTimeTaken { - my $self = shift; - my $Minutes = shift; - my ($Total); +sub TextAttachments { + my $self = shift; - $Total = $self->SUPER::_Value("TimeWorked"); - $Total = ( $Total || 0 ) + ( $Minutes || 0 ); - $self->SUPER::_Set( - Field => "TimeWorked", - Value => $Total - ); + my $res = $self->SUPER::TextAttachments( @_ ); + unless ( $self->CurrentUserHasRight('ShowTicketComments') ) { + # if the user may not see comments do not return them + $res->Limit( + SUBCLAUSE => 'ACL', + ALIAS => $res->TransactionAlias, + FIELD => 'Type', + OPERATOR => '!=', + VALUE => 'Comment', + ); + } - return ($Total); + return $res; } +=head2 _UpdateTimeTaken +This routine will increment the timeworked counter. it should +only be called from _NewTransaction -=head2 CurrentUserHasRight +=cut - Takes the textual name of a Ticket scoped right (from RT::ACE) and returns -1 if the user has that right. It returns 0 if the user doesn't have that right. +sub _UpdateTimeTaken { + my $self = shift; + my $Minutes = shift; + my %rest = @_; -=cut + if ( my $txn = $rest{'Transaction'} ) { + return if $txn->__Value('Type') eq 'Set' && $txn->__Value('Field') eq 'TimeWorked'; + } -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; + my $Total = $self->__Value("TimeWorked"); + $Total = ( $Total || 0 ) + ( $Minutes || 0 ); + $self->_Set( + Field => "TimeWorked", + Value => $Total, + RecordTransaction => 0, + CheckACL => 0, + ); - return $self->CurrentUser->PrincipalObj->HasRight( - Object => $self, - Right => $right, - ) + return ($Total); } - =head2 CurrentUserCanSee Returns true if the current user can see the ticket, using ShowTicket @@ -3719,44 +2956,30 @@ Returns true if the current user can see the ticket, using ShowTicket sub CurrentUserCanSee { my $self = shift; - return $self->CurrentUserHasRight('ShowTicket'); -} - -=head2 HasRight - - Takes a paramhash with the attributes 'Right' and 'Principal' - 'Right' is a ticket-scoped textual right from RT::ACE - 'Principal' is an RT::User object + my ($what, $txn) = @_; + return 0 unless $self->CurrentUserHasRight('ShowTicket'); - Returns 1 if the principal has the right. Returns undef if not. + return 1 if $what ne "Transaction"; -=cut - -sub HasRight { - my $self = shift; - my %args = ( - Right => undef, - Principal => undef, - @_ - ); - - unless ( ( defined $args{'Principal'} ) and ( ref( $args{'Principal'} ) ) ) - { - Carp::cluck("Principal attrib undefined for Ticket::HasRight"); - $RT::Logger->crit("Principal attrib undefined for Ticket::HasRight"); - return(undef); + # If it's a comment, we need to be extra special careful + my $type = $txn->__Value('Type'); + if ( $type eq 'Comment' ) { + unless ( $self->CurrentUserHasRight('ShowTicketComments') ) { + return 0; + } + } elsif ( $type eq 'CommentEmailRecord' ) { + unless ( $self->CurrentUserHasRight('ShowTicketComments') + && $self->CurrentUserHasRight('ShowOutgoingEmail') ) { + return 0; + } + } elsif ( $type eq 'EmailRecord' ) { + unless ( $self->CurrentUserHasRight('ShowOutgoingEmail') ) { + return 0; + } } - - return ( - $args{'Principal'}->HasRight( - Object => $self, - Right => $args{'Right'} - ) - ); + return 1; } - - =head2 Reminders Return the Reminders object for this ticket. (It's an RT::Reminders object.) @@ -3856,8 +3079,12 @@ sub LoadCustomFieldByIdentifier { my $cf = RT::CustomField->new( $self->CurrentUser ); $cf->SetContextObject( $self ); - $cf->LoadByNameAndQueue( Name => $field, Queue => $self->Queue ); - $cf->LoadByNameAndQueue( Name => $field, Queue => 0 ) unless $cf->id; + $cf->LoadByName( + Name => $field, + LookupType => $self->CustomFieldLookupType, + ObjectId => $self->Queue, + IncludeGlobal => 1, + ); return $cf; } @@ -3890,6 +3117,87 @@ sub ACLEquivalenceObjects { } +=head2 ModifyLinkRight + +=cut + +sub ModifyLinkRight { "ModifyTicket" } + +=head2 Forward Transaction => undef, To => '', Cc => '', Bcc => '' + +Forwards transaction with all attachments as 'message/rfc822'. + +=cut + +sub Forward { + my $self = shift; + my %args = ( + Transaction => undef, + Subject => '', + To => '', + Cc => '', + Bcc => '', + Content => '', + ContentType => 'text/plain', + DryRun => 0, + CommitScrips => 1, + @_ + ); + + unless ( $self->CurrentUserHasRight('ForwardMessage') ) { + return ( 0, $self->loc("Permission Denied") ); + } + + $args{$_} = join ", ", map { $_->format } RT::EmailParser->ParseEmailAddress( $args{$_} || '' ) for qw(To Cc Bcc); + + return (0, $self->loc("Can't forward: no valid email addresses specified") ) + unless grep {length $args{$_}} qw/To Cc Bcc/; + + my $mime = MIME::Entity->build( + Type => $args{ContentType}, + Data => Encode::encode( "UTF-8", $args{Content} ), + ); + + $mime->head->replace( $_ => Encode::encode('UTF-8',$args{$_} ) ) + for grep defined $args{$_}, qw(Subject To Cc Bcc); + $mime->head->replace( + From => Encode::encode( 'UTF-8', + RT::Interface::Email::GetForwardFrom( + Transaction => $args{Transaction}, + Ticket => $self, + ) + ) + ); + + if ($args{'DryRun'}) { + $RT::Handle->BeginTransaction(); + $args{'CommitScrips'} = 0; + } + + my ( $ret, $msg ) = $self->_NewTransaction( + $args{Transaction} + ? ( + Type => 'Forward Transaction', + Field => $args{Transaction}->id, + ) + : ( + Type => 'Forward Ticket', + Field => $self->id, + ), + Data => join( ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc} ), + MIMEObj => $mime, + CommitScrips => $args{'CommitScrips'}, + ); + + unless ($ret) { + $RT::Logger->error("Failed to create transaction: $msg"); + } + + if ($args{'DryRun'}) { + $RT::Handle->Rollback(); + } + return ( $ret, $self->loc('Message recorded') ); +} 1; @@ -3903,10 +3211,6 @@ RT =cut - -use RT::Queue; -use base 'RT::Record'; - sub Table {'Tickets'} @@ -4324,59 +3628,142 @@ 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 => ''}, EffectiveId => - {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'}, + IsMerged => + {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => undef}, Queue => - {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'}, Type => - {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 => ''}, IssueStatement => - {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'}, Resolution => - {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'}, Owner => - {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'}, Subject => - {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => '[no subject]'}, + {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => '[no subject]'}, InitialPriority => - {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'}, FinalPriority => - {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'}, Priority => - {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'}, TimeEstimated => - {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'}, TimeWorked => - {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'}, Status => - {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 => ''}, TimeLeft => - {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'}, Told => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, Starts => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, Started => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, Due => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, Resolved => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, + {read => 1, write => 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 => ''}, 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 => ''}, 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 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 ); + + # Tickets which were merged in + my $objs = RT::Tickets->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'EffectiveId', VALUE => $self->Id ); + $objs->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->Id ); + $deps->Add( in => $objs ); + + # Ticket role groups( Owner, Requestors, Cc, AdminCc ) + $objs = RT::Groups->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Domain', VALUE => 'RT::Ticket-Role', CASESENSITIVE => 0 ); + $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); + $deps->Add( in => $objs ); + + # Queue + $deps->Add( out => $self->QueueObj ); + + # Owner + $deps->Add( out => $self->OwnerObj ); +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# Tickets which were merged in + my $objs = RT::Tickets->new( $self->CurrentUser ); + $objs->{'allow_deleted_search'} = 1; + $objs->Limit( FIELD => 'EffectiveId', VALUE => $self->Id ); + $objs->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->Id ); + push( @$list, $objs ); + +# Ticket role groups( Owner, Requestors, Cc, AdminCc ) + $objs = RT::Groups->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Domain', VALUE => 'RT::Ticket-Role', CASESENSITIVE => 0 ); + $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); + push( @$list, $objs ); + +#TODO: Users, Queues if we wish export tool + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + + return $self->SUPER::__DependsOn( %args ); +} + +sub Serialize { + my $self = shift; + my %args = (@_); + my %store = $self->SUPER::Serialize(@_); + + my $obj = RT::Ticket->new( RT->SystemUser ); + $obj->Load( $store{EffectiveId} ); + $store{EffectiveId} = \($obj->UID); + + return %store; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Tickets.pm b/rt/lib/RT/Tickets.pm index c826b6f..e349518 100755 --- a/rt/lib/RT/Tickets.pm +++ b/rt/lib/RT/Tickets.pm @@ -46,17 +46,6 @@ # # END BPS TAGGED BLOCK }}} -# Major Changes: - -# - Decimated ProcessRestrictions and broke it into multiple -# functions joined by a LUT -# - Semi-Generic SQL stuff moved to another file - -# Known Issues: FIXME! - -# - ClearRestrictions and Reinitialization is messy and unclear. The -# only good way to do it is to create a new RT::Tickets object. - =head1 NAME RT::Tickets - A collection of Ticket objects @@ -81,22 +70,40 @@ package RT::Tickets; use strict; use warnings; +use base 'RT::SearchBuilder'; -use RT::Ticket; +use Role::Basic 'with'; +with 'RT::SearchBuilder::Role::Roles'; -use base 'RT::SearchBuilder'; +use Scalar::Util qw/blessed/; + +use RT::Ticket; +use RT::SQL; sub Table { 'Tickets'} use RT::CustomFields; +__PACKAGE__->RegisterCustomFieldJoin(@$_) for + [ "RT::Transaction" => sub { $_[0]->JoinTransactions } ], + [ "RT::Queue" => sub { + # XXX: Could avoid join and use main.Queue with some refactoring? + return $_[0]->{_sql_aliases}{queues} ||= $_[0]->Join( + ALIAS1 => 'main', + FIELD1 => 'Queue', + TABLE2 => 'Queues', + FIELD2 => 'id', + ); + } + ]; + # Configuration Tables: # FIELD_METADATA is a mapping of searchable Field name, to Type, and other # metadata. our %FIELD_METADATA = ( - Status => [ 'ENUM', ], #loc_left_pair + Status => [ 'STRING', ], #loc_left_pair Queue => [ 'ENUM' => 'Queue', ], #loc_left_pair Type => [ 'ENUM', ], #loc_left_pair Creator => [ 'ENUM' => 'User', ], #loc_left_pair @@ -144,7 +151,13 @@ our %FIELD_METADATA = ( CustomFieldValue => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair CustomField => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair CF => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair + TxnCF => [ 'CUSTOMFIELD' => 'Transaction' ], #loc_left_pair + TransactionCF => [ 'CUSTOMFIELD' => 'Transaction' ], #loc_left_pair + QueueCF => [ 'CUSTOMFIELD' => 'Queue' ], #loc_left_pair + Lifecycle => [ 'LIFECYCLE' ], #loc_left_pair Updated => [ 'TRANSDATE', ], #loc_left_pair + UpdatedBy => [ 'TRANSCREATOR', ], #loc_left_pair + OwnerGroup => [ 'MEMBERSHIPFIELD' => 'Owner', ], #loc_left_pair RequestorGroup => [ 'MEMBERSHIPFIELD' => 'Requestor', ], #loc_left_pair CCGroup => [ 'MEMBERSHIPFIELD' => 'Cc', ], #loc_left_pair AdminCCGroup => [ 'MEMBERSHIPFIELD' => 'AdminCc', ], #loc_left_pair @@ -163,7 +176,7 @@ our %LOWER_CASE_FIELDS = map { ( lc($_) => $_ ) } (keys %FIELD_METADATA); our %SEARCHABLE_SUBFIELDS = ( User => [qw( EmailAddress Name RealName Nickname Organization Address1 Address2 - WorkPhone HomePhone MobilePhone PagerPhone id + City State Zip Country WorkPhone HomePhone MobilePhone PagerPhone id )], ); @@ -178,13 +191,14 @@ our %dispatch = ( TRANSFIELD => \&_TransLimit, TRANSCONTENT => \&_TransContentLimit, TRANSDATE => \&_TransDateLimit, + TRANSCREATOR => \&_TransCreatorLimit, WATCHERFIELD => \&_WatcherLimit, MEMBERSHIPFIELD => \&_WatcherMembershipLimit, CUSTOMFIELD => \&_CustomFieldLimit, HASATTRIBUTE => \&_HasAttributeLimit, + LIFECYCLE => \&_LifecycleLimit, FREESIDEFIELD => \&_FreesideFieldLimit, ); -our %can_bundle = ();# WATCHERFIELD => "yes", ); # Default EntryAggregator per type # if you specify OP, you must specify all valid OPs @@ -195,6 +209,8 @@ my %DefaultEA = ( '!=' => 'AND' }, DATE => { + 'IS' => 'OR', + 'IS NOT' => 'OR', '=' => 'OR', '>=' => 'AND', '<=' => 'AND', @@ -228,15 +244,7 @@ my %DefaultEA = ( CUSTOMFIELD => 'OR', ); -# Helper functions for passing the above lexically scoped tables above -# into Tickets_SQL. sub FIELDS { return \%FIELD_METADATA } -sub dispatch { return \%dispatch } -sub can_bundle { return \%can_bundle } - -# Bring in the clowns. -require RT::Tickets_SQL; - our @SORTFIELDS = qw(id Status Queue Subject @@ -310,14 +318,9 @@ sub _BookmarkLimit { die "Invalid operator $op for __Bookmarked__ search on $field" unless $op =~ /^(=|!=)$/; - my @bookmarks = do { - my $tmp = $sb->CurrentUser->UserObj->FirstAttribute('Bookmarks'); - $tmp = $tmp->Content if $tmp; - $tmp ||= {}; - grep $_, keys %$tmp; - }; + my @bookmarks = $sb->CurrentUser->UserObj->Bookmarks; - return $sb->_SQLLimit( + return $sb->Limit( FIELD => $field, OPERATOR => $op, VALUE => 0, @@ -333,20 +336,15 @@ sub _BookmarkLimit { TABLE2 => 'Tickets', FIELD2 => 'EffectiveId', ); - $sb->_OpenParen; - my $first = 1; - my $ea = $op eq '='? 'OR': 'AND'; - foreach my $id ( sort @bookmarks ) { - $sb->_SQLLimit( - ALIAS => $tickets_alias, - FIELD => 'id', - OPERATOR => $op, - VALUE => $id, - $first? (@rest): ( ENTRYAGGREGATOR => $ea ) - ); - $first = 0 if $first; - } - $sb->_CloseParen; + + $op = $op eq '='? 'IN': 'NOT IN'; + $sb->Limit( + ALIAS => $tickets_alias, + FIELD => 'id', + OPERATOR => $op, + VALUE => [ @bookmarks ], + @rest, + ); } =head2 _EnumLimit @@ -384,10 +382,8 @@ sub _EnumLimit { $value = $o->Id || 0; } elsif ( $field eq "Type" ) { $value = lc $value if $value =~ /^(ticket|approval|reminder)$/i; - } elsif ($field eq "Status") { - $value = lc $value; } - $sb->_SQLLimit( + $sb->Limit( FIELD => $field, VALUE => $value, OPERATOR => $op, @@ -408,10 +404,20 @@ Meta Data: sub _IntLimit { my ( $sb, $field, $op, $value, @rest ) = @_; - die "Invalid Operator $op for $field" - unless $op =~ /^(=|!=|>|<|>=|<=)$/; + my $is_a_like = $op =~ /MATCHES|ENDSWITH|STARTSWITH|LIKE/i; + + # We want to support <id LIKE '1%'> for ticket autocomplete, + # but we need to explicitly typecast on Postgres + if ( $is_a_like && RT->Config->Get('DatabaseType') eq 'Pg' ) { + return $sb->Limit( + FUNCTION => "CAST(main.$field AS TEXT)", + OPERATOR => $op, + VALUE => $value, + @rest, + ); + } - $sb->_SQLLimit( + $sb->Limit( FIELD => $field, VALUE => $value, OPERATOR => $op, @@ -487,13 +493,13 @@ sub _LinkLimit { TABLE2 => 'Links', FIELD2 => 'Local' . $linkfield ); - $sb->SUPER::Limit( + $sb->Limit( LEFTJOIN => $linkalias, FIELD => 'Type', OPERATOR => '=', VALUE => $meta->[2], ) if $meta->[2]; - $sb->_SQLLimit( + $sb->Limit( @rest, ALIAS => $linkalias, FIELD => $matchfield, @@ -510,19 +516,19 @@ sub _LinkLimit { TABLE2 => 'Links', FIELD2 => 'Local' . $linkfield ); - $sb->SUPER::Limit( + $sb->Limit( LEFTJOIN => $linkalias, FIELD => 'Type', OPERATOR => '=', VALUE => $meta->[2], ) if $meta->[2]; - $sb->SUPER::Limit( + $sb->Limit( LEFTJOIN => $linkalias, FIELD => $matchfield, OPERATOR => '=', VALUE => $value, ); - $sb->_SQLLimit( + $sb->Limit( @rest, ALIAS => $linkalias, FIELD => $matchfield, @@ -543,22 +549,90 @@ Meta Data: =cut sub _DateLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; + my ( $sb, $field, $op, $value, %rest ) = @_; die "Invalid Date Op: $op" - unless $op =~ /^(=|>|<|>=|<=)$/; + unless $op =~ /^(=|>|<|>=|<=|IS(\s+NOT)?)$/i; my $meta = $FIELD_METADATA{$field}; die "Incorrect Meta Data for $field" unless ( defined $meta->[1] ); - $sb->_DateFieldLimit( $meta->[1], $op, $value, @rest ); + $sb->_DateFieldLimit( $meta->[1], $op, $value, %rest ); } # Factor this out for use by custom fields sub _DateFieldLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; + my ( $sb, $field, $op, $value, %rest ) = @_; + + if ( $op =~ /^(IS(\s+NOT)?)$/i) { + return $sb->Limit( + FUNCTION => $sb->NotSetDateToNullFunction, + FIELD => $field, + OPERATOR => $op, + VALUE => "NULL", + %rest, + ); + } + + if ( my $subkey = $rest{SUBKEY} ) { + if ( $subkey eq 'DayOfWeek' && $op !~ /IS/i && $value =~ /[^0-9]/ ) { + for ( my $i = 0; $i < @RT::Date::DAYS_OF_WEEK; $i++ ) { + # Use a case-insensitive regex for better matching across + # locales since we don't have fc() and lc() is worse. Really + # we should be doing Unicode normalization too, but we don't do + # that elsewhere in RT. + # + # XXX I18N: Replace the regex with fc() once we're guaranteed 5.16. + next unless lc $RT::Date::DAYS_OF_WEEK[ $i ] eq lc $value + or $sb->CurrentUser->loc($RT::Date::DAYS_OF_WEEK[ $i ]) =~ /^\Q$value\E$/i; + + $value = $i; last; + } + return $sb->Limit( FIELD => 'id', VALUE => 0, %rest ) + if $value =~ /[^0-9]/; + } + elsif ( $subkey eq 'Month' && $op !~ /IS/i && $value =~ /[^0-9]/ ) { + for ( my $i = 0; $i < @RT::Date::MONTHS; $i++ ) { + # Use a case-insensitive regex for better matching across + # locales since we don't have fc() and lc() is worse. Really + # we should be doing Unicode normalization too, but we don't do + # that elsewhere in RT. + # + # XXX I18N: Replace the regex with fc() once we're guaranteed 5.16. + next unless lc $RT::Date::MONTHS[ $i ] eq lc $value + or $sb->CurrentUser->loc($RT::Date::MONTHS[ $i ]) =~ /^\Q$value\E$/i; + + $value = $i + 1; last; + } + return $sb->Limit( FIELD => 'id', VALUE => 0, %rest ) + if $value =~ /[^0-9]/; + } + + my $tz; + if ( RT->Config->Get('ChartsTimezonesInDB') ) { + my $to = $sb->CurrentUser->UserObj->Timezone + || RT->Config->Get('Timezone'); + $tz = { From => 'UTC', To => $to } + if $to && lc $to ne 'utc'; + } + + # $subkey is validated by DateTimeFunction + my $function = $RT::Handle->DateTimeFunction( + Type => $subkey, + Field => $sb->NotSetDateToNullFunction, + Timezone => $tz, + ); + + return $sb->Limit( + FUNCTION => $function, + FIELD => $field, + OPERATOR => $op, + VALUE => $value, + %rest, + ); + } my $date = RT::Date->new( $sb->CurrentUser ); $date->Set( Format => 'unknown', Value => $value ); @@ -597,18 +671,18 @@ sub _DateFieldLimit { $sb->_OpenParen; - $sb->_SQLLimit( + $sb->Limit( FIELD => $field, OPERATOR => ">=", VALUE => $daystart, - @rest, + %rest, ); - $sb->_SQLLimit( + $sb->Limit( FIELD => $field, OPERATOR => "<", VALUE => $dayend, - @rest, + %rest, ENTRYAGGREGATOR => 'AND', ); @@ -616,11 +690,12 @@ sub _DateFieldLimit { } else { - $sb->_SQLLimit( + $sb->Limit( + FUNCTION => $sb->NotSetDateToNullFunction, FIELD => $field, OPERATOR => $op, VALUE => $date->ISO, - @rest, + %rest, ); } } @@ -652,7 +727,11 @@ sub _StringLimit { $value = 'NULL'; } - $sb->_SQLLimit( + if ($field eq "Status") { + $value = lc $value; + } + + $sb->Limit( FIELD => $field, OPERATOR => $op, VALUE => $value, @@ -695,14 +774,14 @@ sub _TransDateLimit { $date->AddDay; my $dayend = $date->ISO; - $sb->_SQLLimit( + $sb->Limit( ALIAS => $txn_alias, FIELD => 'Created', OPERATOR => ">=", VALUE => $daystart, @rest ); - $sb->_SQLLimit( + $sb->Limit( ALIAS => $txn_alias, FIELD => 'Created', OPERATOR => "<=", @@ -717,7 +796,7 @@ sub _TransDateLimit { else { #Search for the right field - $sb->_SQLLimit( + $sb->Limit( ALIAS => $txn_alias, FIELD => 'Created', OPERATOR => $op, @@ -729,6 +808,21 @@ sub _TransDateLimit { $sb->_CloseParen; } +sub _TransCreatorLimit { + my ( $sb, $field, $op, $value, @rest ) = @_; + $op = "!=" if $op eq "<>"; + die "Invalid Operation: $op for $field" unless $op eq "=" or $op eq "!="; + + # See the comments for TransLimit, they apply here too + my $txn_alias = $sb->JoinTransactions; + if ( defined $value && $value !~ /^\d+$/ ) { + my $u = RT::User->new( $sb->CurrentUser ); + $u->Load($value); + $value = $u->id || 0; + } + $sb->Limit( ALIAS => $txn_alias, FIELD => 'Creator', OPERATOR => $op, VALUE => $value, @rest ); +} + =head2 _TransLimit Limit based on the ContentType or the Filename of a transaction. @@ -740,7 +834,7 @@ sub _TransLimit { my $txn_alias = $self->JoinTransactions; unless ( defined $self->{_sql_trattachalias} ) { - $self->{_sql_trattachalias} = $self->_SQLJoin( + $self->{_sql_trattachalias} = $self->Join( TYPE => 'LEFT', # not all txns have an attachment ALIAS1 => $txn_alias, FIELD1 => 'id', @@ -749,7 +843,7 @@ sub _TransLimit { ); } - $self->_SQLLimit( + $self->Limit( %rest, ALIAS => $self->{_sql_trattachalias}, FIELD => $field, @@ -775,8 +869,7 @@ sub _TransContentLimit { #Basically, we want to make sure that the limits apply to #the same attachment, rather than just another attachment #for the same ticket, no matter how many clauses we lump - #on. We put them in TicketAliases so that they get nuked - #when we redo the join. + #on. # In the SQL, we might have # (( Content = foo ) or ( Content = bar AND Content = baz )) @@ -804,13 +897,13 @@ sub _TransContentLimit { my $config = RT->Config->Get('FullTextSearch') || {}; unless ( $config->{'Enable'} ) { - $self->_SQLLimit( %rest, FIELD => 'id', VALUE => 0 ); + $self->Limit( %rest, FIELD => 'id', VALUE => 0 ); return; } my $txn_alias = $self->JoinTransactions; unless ( defined $self->{_sql_trattachalias} ) { - $self->{_sql_trattachalias} = $self->_SQLJoin( + $self->{_sql_trattachalias} = $self->Join( TYPE => 'LEFT', # not all txns have an attachment ALIAS1 => $txn_alias, FIELD1 => 'id', @@ -825,7 +918,7 @@ sub _TransContentLimit { my $alias; if ( $config->{'Table'} and $config->{'Table'} ne "Attachments") { - $alias = $self->{'_sql_aliases'}{'full_text'} ||= $self->_SQLJoin( + $alias = $self->{'_sql_aliases'}{'full_text'} ||= $self->Join( TYPE => 'LEFT', ALIAS1 => $self->{'_sql_trattachalias'}, FIELD1 => 'id', @@ -841,7 +934,7 @@ sub _TransContentLimit { if ( $db_type eq 'Oracle' ) { my $dbh = $RT::Handle->dbh; my $alias = $self->{_sql_trattachalias}; - $self->_SQLLimit( + $self->Limit( %rest, FUNCTION => "CONTAINS( $alias.$field, ".$dbh->quote($value) .")", OPERATOR => '>', @@ -851,7 +944,7 @@ sub _TransContentLimit { ); # this is required to trick DBIx::SB's LEFT JOINS optimizer # into deciding that join is redundant as it is - $self->_SQLLimit( + $self->Limit( ENTRYAGGREGATOR => 'AND', ALIAS => $self->{_sql_trattachalias}, FIELD => 'Content', @@ -861,7 +954,7 @@ sub _TransContentLimit { } elsif ( $db_type eq 'Pg' ) { my $dbh = $RT::Handle->dbh; - $self->_SQLLimit( + $self->Limit( %rest, ALIAS => $alias, FIELD => $index, @@ -870,6 +963,28 @@ sub _TransContentLimit { QUOTEVALUE => 0, ); } + elsif ( $db_type eq 'mysql' and not $config->{Sphinx}) { + my $dbh = $RT::Handle->dbh; + $self->Limit( + %rest, + FUNCTION => "MATCH($alias.Content)", + OPERATOR => 'AGAINST', + VALUE => "(". $dbh->quote($value) ." IN BOOLEAN MODE)", + QUOTEVALUE => 0, + ); + # As with Oracle, above, this forces the LEFT JOINs into + # JOINS, which allows the FULLTEXT index to be used. + # Orthogonally, the IS NOT NULL clause also helps the + # optimizer decide to use the index. + $self->Limit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $alias, + FIELD => "Content", + OPERATOR => 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 0, + ); + } elsif ( $db_type eq 'mysql' ) { # XXX: We could theoretically skip the join to Attachments, # and have Sphinx simply index and group by the TicketId, @@ -885,7 +1000,7 @@ sub _TransContentLimit { $value =~ s/;/\\;/g; my $max = $config->{'MaxMatches'}; - $self->_SQLLimit( + $self->Limit( %rest, ALIAS => $alias, FIELD => 'query', @@ -894,7 +1009,7 @@ sub _TransContentLimit { ); } } else { - $self->_SQLLimit( + $self->Limit( %rest, ALIAS => $self->{_sql_trattachalias}, FIELD => $field, @@ -904,7 +1019,7 @@ sub _TransContentLimit { ); } if ( RT->Config->Get('DontSearchFileAttachments') ) { - $self->_SQLLimit( + $self->Limit( ENTRYAGGREGATOR => 'AND', ALIAS => $self->{_sql_trattachalias}, FIELD => 'Filename', @@ -944,257 +1059,15 @@ sub _WatcherLimit { die "Invalid watcher subfield: '$rest{SUBKEY}'"; } - # if it's equality op and search by Email or Name then we can preload user - # we do it to help some DBs better estimate number of rows and get better plans - if ( $op =~ /^!?=$/ && (!$rest{'SUBKEY'} || $rest{'SUBKEY'} eq 'Name' || $rest{'SUBKEY'} eq 'EmailAddress') ) { - my $o = RT::User->new( $self->CurrentUser ); - my $method = - !$rest{'SUBKEY'} - ? $field eq 'Owner'? 'Load' : 'LoadByEmail' - : $rest{'SUBKEY'} eq 'EmailAddress' ? 'LoadByEmail': 'Load'; - $o->$method( $value ); - $rest{'SUBKEY'} = 'id'; - $value = $o->id || 0; - } - - # Owner was ENUM field, so "Owner = 'xxx'" allowed user to - # search by id and Name at the same time, this is workaround - # to preserve backward compatibility - if ( $field eq 'Owner' ) { - if ( ($rest{'SUBKEY'}||'') eq 'id' ) { - $self->_SQLLimit( - FIELD => 'Owner', - OPERATOR => $op, - VALUE => $value, - %rest, - ); - return; - } - } - $rest{SUBKEY} ||= 'EmailAddress'; - - my ($groups, $group_members, $users); - if ( $rest{'BUNDLE'} ) { - ($groups, $group_members, $users) = @{ $rest{'BUNDLE'} }; - } else { - $groups = $self->_RoleGroupsJoin( Type => $type, Class => $class, New => !$type ); - } - - $self->_OpenParen; - if ( $op =~ /^IS(?: NOT)?$/i ) { - # is [not] empty case - - $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); - # to avoid joining the table Users into the query, we just join GM - # and make sure we don't match records where group is member of itself - $self->SUPER::Limit( - LEFTJOIN => $group_members, - FIELD => 'GroupId', - OPERATOR => '!=', - VALUE => "$group_members.MemberId", - QUOTEVALUE => 0, - ); - $self->_SQLLimit( - ALIAS => $group_members, - FIELD => 'GroupId', - OPERATOR => $op, - VALUE => $value, - %rest, - ); - } - elsif ( $op =~ /^!=$|^NOT\s+/i ) { - # negative condition case - - # reverse op - $op =~ s/!|NOT\s+//i; - - # XXX: we have no way to build correct "Watcher.X != 'Y'" when condition - # "X = 'Y'" matches more then one user so we try to fetch two records and - # do the right thing when there is only one exist and semi-working solution - # otherwise. - my $users_obj = RT::Users->new( $self->CurrentUser ); - $users_obj->Limit( - FIELD => $rest{SUBKEY}, - OPERATOR => $op, - VALUE => $value, - ); - $users_obj->OrderBy; - $users_obj->RowsPerPage(2); - my @users = @{ $users_obj->ItemsArrayRef }; - - $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); - if ( @users <= 1 ) { - my $uid = 0; - $uid = $users[0]->id if @users; - $self->SUPER::Limit( - LEFTJOIN => $group_members, - ALIAS => $group_members, - FIELD => 'MemberId', - VALUE => $uid, - ); - $self->_SQLLimit( - %rest, - ALIAS => $group_members, - FIELD => 'id', - OPERATOR => 'IS', - VALUE => 'NULL', - ); - } else { - $self->SUPER::Limit( - LEFTJOIN => $group_members, - FIELD => 'GroupId', - OPERATOR => '!=', - VALUE => "$group_members.MemberId", - QUOTEVALUE => 0, - ); - $users ||= $self->Join( - TYPE => 'LEFT', - ALIAS1 => $group_members, - FIELD1 => 'MemberId', - TABLE2 => 'Users', - FIELD2 => 'id', - ); - $self->SUPER::Limit( - LEFTJOIN => $users, - ALIAS => $users, - FIELD => $rest{SUBKEY}, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ); - $self->_SQLLimit( - %rest, - ALIAS => $users, - FIELD => 'id', - OPERATOR => 'IS', - VALUE => 'NULL', - ); - } - } else { - # positive condition case - - $group_members ||= $self->_GroupMembersJoin( - GroupsAlias => $groups, New => 1, Left => 0 - ); - $users ||= $self->Join( - TYPE => 'LEFT', - ALIAS1 => $group_members, - FIELD1 => 'MemberId', - TABLE2 => 'Users', - FIELD2 => 'id', - ); - $self->_SQLLimit( - %rest, - ALIAS => $users, - FIELD => $rest{'SUBKEY'}, - VALUE => $value, - OPERATOR => $op, - CASESENSITIVE => 0, - ); - } - $self->_CloseParen; - return ($groups, $group_members, $users); -} - -sub _RoleGroupsJoin { - my $self = shift; - my %args = (New => 0, Class => 'Ticket', Type => '', @_); - return $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } - if $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } - && !$args{'New'}; - - # we always have watcher groups for ticket, so we use INNER join - my $groups = $self->Join( - ALIAS1 => 'main', - FIELD1 => $args{'Class'} eq 'Queue'? 'Queue': 'id', - TABLE2 => 'Groups', - FIELD2 => 'Instance', - ENTRYAGGREGATOR => 'AND', - ); - $self->SUPER::Limit( - LEFTJOIN => $groups, - ALIAS => $groups, - FIELD => 'Domain', - VALUE => 'RT::'. $args{'Class'} .'-Role', - ); - $self->SUPER::Limit( - LEFTJOIN => $groups, - ALIAS => $groups, - FIELD => 'Type', - VALUE => $args{'Type'}, - ) if $args{'Type'}; - - $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } = $groups - unless $args{'New'}; - - return $groups; -} - -sub _GroupMembersJoin { - my $self = shift; - my %args = (New => 1, GroupsAlias => undef, Left => 1, @_); - - return $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } - if $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } - && !$args{'New'}; - - my $alias = $self->Join( - $args{'Left'} ? (TYPE => 'LEFT') : (), - ALIAS1 => $args{'GroupsAlias'}, - FIELD1 => 'id', - TABLE2 => 'CachedGroupMembers', - FIELD2 => 'GroupId', - ENTRYAGGREGATOR => 'AND', - ); - $self->SUPER::Limit( - $args{'Left'} ? (LEFTJOIN => $alias) : (), - ALIAS => $alias, - FIELD => 'Disabled', - VALUE => 0, - ); - - $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } = $alias - unless $args{'New'}; - - return $alias; -} - -=head2 _WatcherJoin - -Helper function which provides joins to a watchers table both for limits -and for ordering. - -=cut - -sub _WatcherJoin { - my $self = shift; - my $type = shift || ''; - - - my $groups = $self->_RoleGroupsJoin( Type => $type ); - my $group_members = $self->_GroupMembersJoin( GroupsAlias => $groups ); - # XXX: work around, we must hide groups that - # are members of the role group we search in, - # otherwise them result in wrong NULLs in Users - # table and break ordering. Now, we know that - # RT doesn't allow to add groups as members of the - # ticket roles, so we just hide entries in CGM table - # with MemberId == GroupId from results - $self->SUPER::Limit( - LEFTJOIN => $group_members, - FIELD => 'GroupId', - OPERATOR => '!=', - VALUE => "$group_members.MemberId", - QUOTEVALUE => 0, - ); - my $users = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $group_members, - FIELD1 => 'MemberId', - TABLE2 => 'Users', - FIELD2 => 'id', + $self->RoleLimit( + TYPE => $type, + CLASS => "RT::$class", + FIELD => $rest{SUBKEY}, + OPERATOR => $op, + VALUE => $value, + SUBCLAUSE => "ticketsql", + %rest, ); - return ($groups, $group_members, $users); } =head2 _WatcherMembershipLimit @@ -1203,141 +1076,54 @@ Handle watcher membership limits, i.e. whether the watcher belongs to a specific group or not. Meta Data: - 1: Field to query on - -SELECT DISTINCT main.* -FROM - Tickets main, - Groups Groups_1, - CachedGroupMembers CachedGroupMembers_2, - Users Users_3 -WHERE ( - (main.EffectiveId = main.id) -) AND ( - (main.Status != 'deleted') -) AND ( - (main.Type = 'ticket') -) AND ( - ( - (Users_3.EmailAddress = '22') - AND - (Groups_1.Domain = 'RT::Ticket-Role') - AND - (Groups_1.Type = 'RequestorGroup') - ) -) AND - Groups_1.Instance = main.id -AND - Groups_1.id = CachedGroupMembers_2.GroupId -AND - CachedGroupMembers_2.MemberId = Users_3.id -ORDER BY main.id ASC -LIMIT 25 + 1: Role to query on =cut sub _WatcherMembershipLimit { - my ( $self, $field, $op, $value, @rest ) = @_; - my %rest = @rest; + my ( $self, $field, $op, $value, %rest ) = @_; - $self->_OpenParen; + # we don't support anything but '=' + die "Invalid $field Op: $op" + unless $op =~ /^=$/; - my $groups = $self->NewAlias('Groups'); - my $groupmembers = $self->NewAlias('CachedGroupMembers'); - my $users = $self->NewAlias('Users'); - my $memberships = $self->NewAlias('CachedGroupMembers'); - - if ( ref $field ) { # gross hack - my @bundle = @$field; - $self->_OpenParen; - for my $chunk (@bundle) { - ( $field, $op, $value, @rest ) = @$chunk; - $self->_SQLLimit( - ALIAS => $memberships, - FIELD => 'GroupId', - VALUE => $value, - OPERATOR => $op, - @rest, - ); - } - $self->_CloseParen; + unless ( $value =~ /^\d+$/ ) { + my $group = RT::Group->new( $self->CurrentUser ); + $group->LoadUserDefinedGroup( $value ); + $value = $group->id || 0; } - else { - $self->_SQLLimit( - ALIAS => $memberships, - FIELD => 'GroupId', - VALUE => $value, - OPERATOR => $op, - @rest, - ); - } - - # Tie to groups for tickets we care about - $self->_SQLLimit( - ALIAS => $groups, - FIELD => 'Domain', - VALUE => 'RT::Ticket-Role', - ENTRYAGGREGATOR => 'AND' - ); - - $self->Join( - ALIAS1 => $groups, - FIELD1 => 'Instance', - ALIAS2 => 'main', - FIELD2 => 'id' - ); - - # }}} - # If we care about which sort of watcher my $meta = $FIELD_METADATA{$field}; - my $type = ( defined $meta->[1] ? $meta->[1] : undef ); - - if ($type) { - $self->_SQLLimit( - ALIAS => $groups, - FIELD => 'Type', - VALUE => $type, - ENTRYAGGREGATOR => 'AND' - ); - } + my $type = $meta->[1] || ''; - $self->Join( - ALIAS1 => $groups, - FIELD1 => 'id', - ALIAS2 => $groupmembers, - FIELD2 => 'GroupId' - ); + my ($members_alias, $members_column); + if ( $type eq 'Owner' ) { + ($members_alias, $members_column) = ('main', 'Owner'); + } else { + (undef, undef, $members_alias) = $self->_WatcherJoin( New => 1, Name => $type ); + $members_column = 'id'; + } - $self->Join( - ALIAS1 => $groupmembers, - FIELD1 => 'MemberId', - ALIAS2 => $users, - FIELD2 => 'id' + my $cgm_alias = $self->Join( + ALIAS1 => $members_alias, + FIELD1 => $members_column, + TABLE2 => 'CachedGroupMembers', + FIELD2 => 'MemberId', ); - $self->Limit( - ALIAS => $groupmembers, + LEFTJOIN => $cgm_alias, + ALIAS => $cgm_alias, FIELD => 'Disabled', VALUE => 0, ); - $self->Join( - ALIAS1 => $memberships, - FIELD1 => 'MemberId', - ALIAS2 => $users, - FIELD2 => 'id' - ); - $self->Limit( - ALIAS => $memberships, - FIELD => 'Disabled', - VALUE => 0, + ALIAS => $cgm_alias, + FIELD => 'GroupId', + VALUE => $value, + OPERATOR => $op, + %rest, ); - - - $self->_CloseParen; - } =head2 _CustomFieldDecipher @@ -1353,7 +1139,7 @@ sub _CustomFieldDecipher { $lookuptype ||= $self->_SingularClass->CustomFieldLookupType; my ($object, $field, $column) = ($string =~ /^(?:(.+?)\.)?\{(.+)\}(?:\.(Content|LargeContent))?$/); - $field ||= ($string =~ /^{(.*?)}$/)[0] || $string; + $field ||= ($string =~ /^\{(.*?)\}$/)[0] || $string; my ($cf, $applied_to); @@ -1375,7 +1161,7 @@ sub _CustomFieldDecipher { if ( $field =~ /\D/ ) { $object ||= ''; my $cfs = RT::CustomFields->new( $self->CurrentUser ); - $cfs->Limit( FIELD => 'Name', VALUE => $field, ($applied_to ? (CASESENSITIVE => 0) : ()) ); + $cfs->Limit( FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0 ); $cfs->LimitToLookupType($lookuptype); if ($applied_to) { @@ -1401,116 +1187,6 @@ sub _CustomFieldDecipher { return ($object, $field, $cf, $column); } -=head2 _CustomFieldJoin - -Factor out the Join of custom fields so we can use it for sorting too - -=cut - -our %JOIN_ALIAS_FOR_LOOKUP_TYPE = ( - RT::Ticket->CustomFieldLookupType => sub { "main" }, -); - -sub _CustomFieldJoin { - my ($self, $cfkey, $cfid, $field, $type) = @_; - $type ||= RT::Ticket->CustomFieldLookupType; - - # Perform one Join per CustomField - if ( $self->{_sql_object_cfv_alias}{$cfkey} || - $self->{_sql_cf_alias}{$cfkey} ) - { - return ( $self->{_sql_object_cfv_alias}{$cfkey}, - $self->{_sql_cf_alias}{$cfkey} ); - } - - my $ObjectAlias = $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type} - ? $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type}->($self) - : die "We don't know how to join on $type"; - - my ($ObjectCFs, $CFs); - if ( $cfid ) { - $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $ObjectAlias, - FIELD1 => 'id', - TABLE2 => 'ObjectCustomFieldValues', - FIELD2 => 'ObjectId', - ); - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'CustomField', - VALUE => $cfid, - ENTRYAGGREGATOR => 'AND' - ); - } - else { - my $ocfalias = $self->Join( - TYPE => 'LEFT', - FIELD1 => 'Queue', - TABLE2 => 'ObjectCustomFields', - FIELD2 => 'ObjectId', - ); - - $self->SUPER::Limit( - LEFTJOIN => $ocfalias, - ENTRYAGGREGATOR => 'OR', - FIELD => 'ObjectId', - VALUE => '0', - ); - - $CFs = $self->{_sql_cf_alias}{$cfkey} = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $ocfalias, - FIELD1 => 'CustomField', - TABLE2 => 'CustomFields', - FIELD2 => 'id', - ); - $self->SUPER::Limit( - LEFTJOIN => $CFs, - ENTRYAGGREGATOR => 'AND', - FIELD => 'LookupType', - VALUE => $type, - ); - $self->SUPER::Limit( - LEFTJOIN => $CFs, - ENTRYAGGREGATOR => 'AND', - FIELD => 'Name', - VALUE => $field, - ); - - $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $CFs, - FIELD1 => 'id', - TABLE2 => 'ObjectCustomFieldValues', - FIELD2 => 'CustomField', - ); - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'ObjectId', - VALUE => "$ObjectAlias.id", - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'AND', - ); - } - - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'ObjectType', - VALUE => RT::CustomField->ObjectTypeFromLookupType($type), - ENTRYAGGREGATOR => 'AND' - ); - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'Disabled', - OPERATOR => '=', - VALUE => '0', - ENTRYAGGREGATOR => 'AND' - ); - - return ($ObjectCFs, $CFs); -} - =head2 _CustomFieldLimit Limit based on CustomFields @@ -1520,10 +1196,6 @@ Meta Data: =cut -use Regexp::Common qw(RE_net_IPv4); -use Regexp::Common::net::CIDR; - - sub _CustomFieldLimit { my ( $self, $_field, $op, $value, %rest ) = @_; @@ -1533,370 +1205,37 @@ sub _CustomFieldLimit { my $field = $rest{'SUBKEY'} || die "No field specified"; - # For our sanity, we can only limit on one queue at a time + # For our sanity, we can only limit on one object at a time my ($object, $cfid, $cf, $column); ($object, $field, $cf, $column) = $self->_CustomFieldDecipher( $field, $type ); - $cfid = $cf ? $cf->id : 0 ; - -# If we're trying to find custom fields that don't match something, we -# want tickets where the custom field has no value at all. Note that -# we explicitly don't include the "IS NULL" case, since we would -# otherwise end up with a redundant clause. - - my ($negative_op, $null_op, $inv_op, $range_op) - = $self->ClassifySQLOperation( $op ); - - my $fix_op = sub { - return @_ unless RT->Config->Get('DatabaseType') eq 'Oracle'; - - my %args = @_; - return %args unless $args{'FIELD'} eq 'LargeContent'; - - my $op = $args{'OPERATOR'}; - if ( $op eq '=' ) { - $args{'OPERATOR'} = 'MATCHES'; - } - elsif ( $op eq '!=' ) { - $args{'OPERATOR'} = 'NOT MATCHES'; - } - elsif ( $op =~ /^[<>]=?$/ ) { - $args{'FUNCTION'} = "TO_CHAR( $args{'ALIAS'}.LargeContent )"; - } - return %args; - }; - - if ( $cf && $cf->Type eq 'IPAddress' ) { - my $parsed = RT::ObjectCustomFieldValue->ParseIP($value); - if ($parsed) { - $value = $parsed; - } - else { - $RT::Logger->warn("$value is not a valid IPAddress"); - } - } - - if ( $cf && $cf->Type eq 'IPAddressRange' ) { - my ( $start_ip, $end_ip ) = - RT::ObjectCustomFieldValue->ParseIPRange($value); - if ( $start_ip && $end_ip ) { - if ( $op =~ /^([<>])=?$/ ) { - my $is_less = $1 eq '<' ? 1 : 0; - if ( $is_less ) { - $value = $start_ip; - } - else { - $value = $end_ip; - } - } - else { - $value = join '-', $start_ip, $end_ip; - } - } - else { - $RT::Logger->warn("$value is not a valid IPAddressRange"); - } - } - if ( $cf && $cf->Type =~ /^Date(?:Time)?$/ ) { - my $date = RT::Date->new( $self->CurrentUser ); - $date->Set( Format => 'unknown', Value => $value ); - if ( $date->Unix ) { - if ( - $cf->Type eq 'Date' - || $value =~ /^\s*(?:today|tomorrow|yesterday)\s*$/i - || ( $value !~ /midnight|\d+:\d+:\d+/i - && $date->Time( Timezone => 'user' ) eq '00:00:00' ) - ) - { - $value = $date->Date( Timezone => 'user' ); - } - else { - $value = $date->DateTime; - } - } - else { - $RT::Logger->warn("$value is not a valid date string"); - } - } - - my $single_value = !$cf || !$cfid || $cf->SingleValue; - - my $cfkey = $cfid ? $cfid : "$type-$object.$field"; - - if ( $null_op && !$column ) { - # IS[ NOT] NULL without column is the same as has[ no] any CF value, - # we can reuse our default joins for this operation - # with column specified we have different situation - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); - $self->_OpenParen; - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'id', - OPERATOR => $op, - VALUE => $value, - %rest - ); - $self->_SQLLimit( - ALIAS => $CFs, - FIELD => 'Name', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'AND', - ) if $CFs; - $self->_CloseParen; - } - elsif ( $op !~ /^[<>]=?$/ && ( $cf && $cf->Type eq 'IPAddressRange')) { - - my ($start_ip, $end_ip) = split /-/, $value; - - $self->_OpenParen; - if ( $op !~ /NOT|!=|<>/i ) { # positive equation - $self->_CustomFieldLimit( - $_field, '<=', $end_ip, %rest, - SUBKEY => $rest{'SUBKEY'}. '.Content', - ); - $self->_CustomFieldLimit( - $_field, '>=', $start_ip, %rest, - SUBKEY => $rest{'SUBKEY'}. '.LargeContent', - ENTRYAGGREGATOR => 'AND', - ); - # as well limit borders so DB optimizers can use better - # estimations and scan less rows -# have to disable this tweak because of ipv6 -# $self->_CustomFieldLimit( -# $_field, '>=', '000.000.000.000', %rest, -# SUBKEY => $rest{'SUBKEY'}. '.Content', -# ENTRYAGGREGATOR => 'AND', -# ); -# $self->_CustomFieldLimit( -# $_field, '<=', '255.255.255.255', %rest, -# SUBKEY => $rest{'SUBKEY'}. '.LargeContent', -# ENTRYAGGREGATOR => 'AND', -# ); - } - else { # negative equation - $self->_CustomFieldLimit($_field, '>', $end_ip, %rest); - $self->_CustomFieldLimit( - $_field, '<', $start_ip, %rest, - SUBKEY => $rest{'SUBKEY'}. '.LargeContent', - ENTRYAGGREGATOR => 'OR', - ); - # TODO: as well limit borders so DB optimizers can use better - # estimations and scan less rows, but it's harder to do - # as we have OR aggregator - } - $self->_CloseParen; - } - elsif ( !$negative_op || $single_value ) { - $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++ if !$single_value && !$range_op; - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); - - $self->_OpenParen; - - $self->_OpenParen; - - $self->_OpenParen; - # if column is defined then deal only with it - # otherwise search in Content and in LargeContent - if ( $column ) { - $self->_SQLLimit( $fix_op->( - ALIAS => $ObjectCFs, - FIELD => $column, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - %rest - ) ); - $self->_CloseParen; - $self->_CloseParen; - $self->_CloseParen; - } - else { - # need special treatment for Date - if ( $cf and $cf->Type eq 'DateTime' and $op eq '=' && $value !~ /:/ ) { - # no time specified, that means we want everything on a - # particular day. in the database, we need to check for > - # and < the edges of that day. - my $date = RT::Date->new( $self->CurrentUser ); - $date->Set( Format => 'unknown', Value => $value ); - my $daystart = $date->ISO; - $date->AddDay; - my $dayend = $date->ISO; - - $self->_OpenParen; - - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => ">=", - VALUE => $daystart, - %rest, - ); - - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => "<", - VALUE => $dayend, - %rest, - ENTRYAGGREGATOR => 'AND', - ); - - $self->_CloseParen; - } - elsif ( $op eq '=' || $op eq '!=' || $op eq '<>' ) { - if ( length( Encode::encode( "UTF-8", $value) ) < 256 ) { - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - %rest - ); - } - else { - $self->_OpenParen; - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => '=', - VALUE => '', - ENTRYAGGREGATOR => 'OR' - ); - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => 'IS', - VALUE => 'NULL', - ENTRYAGGREGATOR => 'OR' - ); - $self->_CloseParen; - $self->_SQLLimit( $fix_op->( - ALIAS => $ObjectCFs, - FIELD => 'LargeContent', - OPERATOR => $op, - VALUE => $value, - ENTRYAGGREGATOR => 'AND', - CASESENSITIVE => 0, - ) ); - } - } - else { - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - %rest - ); + $self->_LimitCustomField( + %rest, + LOOKUPTYPE => $type, + CUSTOMFIELD => $cf || $field, + KEY => $cf ? $cf->id : "$type-$object.$field", + OPERATOR => $op, + VALUE => $value, + COLUMN => $column, + SUBCLAUSE => "ticketsql", + ); +} - $self->_OpenParen; - $self->_OpenParen; - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => '=', - VALUE => '', - ENTRYAGGREGATOR => 'OR' - ); - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => 'IS', - VALUE => 'NULL', - ENTRYAGGREGATOR => 'OR' - ); - $self->_CloseParen; - $self->_SQLLimit( $fix_op->( - ALIAS => $ObjectCFs, - FIELD => 'LargeContent', - OPERATOR => $op, - VALUE => $value, - ENTRYAGGREGATOR => 'AND', - CASESENSITIVE => 0, - ) ); - $self->_CloseParen; - } - $self->_CloseParen; - - # XXX: if we join via CustomFields table then - # because of order of left joins we get NULLs in - # CF table and then get nulls for those records - # in OCFVs table what result in wrong results - # as decifer method now tries to load a CF then - # we fall into this situation only when there - # are more than one CF with the name in the DB. - # the same thing applies to order by call. - # TODO: reorder joins T <- OCFVs <- CFs <- OCFs if - # we want treat IS NULL as (not applies or has - # no value) - $self->_SQLLimit( - ALIAS => $CFs, - FIELD => 'Name', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'AND', - ) if $CFs; - $self->_CloseParen; - - if ($negative_op) { - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => $column || 'Content', - OPERATOR => 'IS', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'OR', - ); - } +sub _CustomFieldJoinByName { + my $self = shift; + my ($ObjectAlias, $cf, $type) = @_; - $self->_CloseParen; - } - } - else { - $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++; - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); - - # reverse operation - $op =~ s/!|NOT\s+//i; - - # if column is defined then deal only with it - # otherwise search in Content and in LargeContent - if ( $column ) { - $self->SUPER::Limit( $fix_op->( - LEFTJOIN => $ObjectCFs, - ALIAS => $ObjectCFs, - FIELD => $column, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ) ); - } - else { - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ); - } - $self->_SQLLimit( - %rest, - ALIAS => $ObjectCFs, - FIELD => 'id', - OPERATOR => 'IS', - VALUE => 'NULL', - QUOTEVALUE => 0, - ); - } + my ($ocfvalias, $CFs, $ocfalias) = $self->SUPER::_CustomFieldJoinByName(@_); + $self->Limit( + LEFTJOIN => $ocfalias, + ENTRYAGGREGATOR => 'OR', + FIELD => 'ObjectId', + VALUE => 'main.Queue', + QUOTEVALUE => 0, + ); + return ($ocfvalias, $CFs, $ocfalias); } sub _HasAttributeLimit { @@ -1909,20 +1248,20 @@ sub _HasAttributeLimit { TABLE2 => 'Attributes', FIELD2 => 'ObjectId', ); - $self->SUPER::Limit( + $self->Limit( LEFTJOIN => $alias, FIELD => 'ObjectType', VALUE => 'RT::Ticket', ENTRYAGGREGATOR => 'AND' ); - $self->SUPER::Limit( + $self->Limit( LEFTJOIN => $alias, FIELD => 'Name', OPERATOR => $op, VALUE => $value, ENTRYAGGREGATOR => 'AND' ); - $self->_SQLLimit( + $self->Limit( %rest, ALIAS => $alias, FIELD => 'id', @@ -1932,6 +1271,26 @@ sub _HasAttributeLimit { ); } +sub _LifecycleLimit { + my ( $self, $field, $op, $value, %rest ) = @_; + + die "Invalid Operator $op for $field" if $op =~ /^(IS|IS NOT)$/io; + my $queue = $self->{_sql_aliases}{queues} ||= $_[0]->Join( + ALIAS1 => 'main', + FIELD1 => 'Queue', + TABLE2 => 'Queues', + FIELD2 => 'id', + ); + + $self->Limit( + ALIAS => $queue, + FIELD => 'Lifecycle', + OPERATOR => $op, + VALUE => $value, + %rest, + ); +} + # End Helper Functions # End of SQL Stuff ------------------------------------------------- @@ -1957,7 +1316,7 @@ sub OrderByCols { next; } if ( $row->{FIELD} !~ /\./ ) { - my $meta = $self->FIELDS->{ $row->{FIELD} }; + my $meta = $FIELD_METADATA{ $row->{FIELD} }; unless ( $meta ) { push @res, $row; next; @@ -1971,7 +1330,7 @@ sub OrderByCols { TABLE2 => 'Queues', FIELD2 => 'id', ); - push @res, { %$row, ALIAS => $alias, FIELD => "Name" }; + push @res, { %$row, ALIAS => $alias, FIELD => "Name", CASESENSITIVE => 0 }; } elsif ( ( $meta->[0] eq 'ENUM' && ($meta->[1]||'') eq 'User' ) || ( $meta->[0] eq 'WATCHERFIELD' && ($meta->[1]||'') eq 'Owner' ) ) { @@ -1982,7 +1341,7 @@ sub OrderByCols { TABLE2 => 'Users', FIELD2 => 'id', ); - push @res, { %$row, ALIAS => $alias, FIELD => "Name" }; + push @res, { %$row, ALIAS => $alias, FIELD => "Name", CASESENSITIVE => 0 }; } else { push @res, $row; } @@ -1990,46 +1349,20 @@ sub OrderByCols { } my ( $field, $subkey ) = split /\./, $row->{FIELD}, 2; - my $meta = $self->FIELDS->{$field}; + my $meta = $FIELD_METADATA{$field}; if ( defined $meta->[0] && $meta->[0] eq 'WATCHERFIELD' ) { # cache alias as we want to use one alias per watcher type for sorting - my $users = $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] }; + my $cache_key = join "-", map { $_ || "" } @$meta[1,2]; + my $users = $self->{_sql_u_watchers_alias_for_sort}{ $cache_key }; unless ( $users ) { - $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] } - = $users = ( $self->_WatcherJoin( $meta->[1] ) )[2]; + $self->{_sql_u_watchers_alias_for_sort}{ $cache_key } + = $users = ( $self->_WatcherJoin( Name => $meta->[1], Class => "RT::" . ($meta->[2] || 'Ticket') ) )[2]; } push @res, { %$row, ALIAS => $users, FIELD => $subkey }; } elsif ( defined $meta->[0] && $meta->[0] eq 'CUSTOMFIELD' ) { - my ($object, $field, $cf_obj, $column) = $self->_CustomFieldDecipher( $subkey ); - my $cfkey = $cf_obj ? $cf_obj->id : "$object.$field"; - $cfkey .= ".ordering" if !$cf_obj || ($cf_obj->MaxValues||0) != 1; - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, ($cf_obj ?$cf_obj->id :0) , $field ); - # this is described in _CustomFieldLimit - $self->_SQLLimit( - ALIAS => $CFs, - FIELD => 'Name', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 1, - ENTRYAGGREGATOR => 'AND', - ) if $CFs; - my $CFvs = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $ObjectCFs, - FIELD1 => 'CustomField', - TABLE2 => 'CustomFieldValues', - FIELD2 => 'CustomField', - ); - $self->SUPER::Limit( - LEFTJOIN => $CFvs, - FIELD => 'Name', - QUOTEVALUE => 0, - VALUE => $ObjectCFs . ".Content", - ENTRYAGGREGATOR => 'AND' - ); - - push @res, { %$row, ALIAS => $CFvs, FIELD => 'SortOrder' }; - push @res, { %$row, ALIAS => $ObjectCFs, FIELD => 'Content' }; + my ($object, $field, $cf, $column) = $self->_CustomFieldDecipher( $subkey ); + my $cfkey = $cf ? $cf->id : "$object.$field"; + push @res, $self->_OrderByCF( $row, $cfkey, ($cf || $field) ); } elsif ( $field eq "Custom" && $subkey eq "Ownership") { # PAW logic is "reversed" my $order = "ASC"; @@ -2102,6 +1435,46 @@ sub OrderByCols { return $self->SUPER::OrderByCols(@res); } +sub _SQLLimit { + my $self = shift; + RT->Deprecated( Remove => "4.4", Instead => "Limit" ); + $self->Limit(@_); +} +sub _SQLJoin { + my $self = shift; + RT->Deprecated( Remove => "4.4", Instead => "Join" ); + $self->Join(@_); +} + +sub _OpenParen { + $_[0]->SUPER::_OpenParen( $_[1] || 'ticketsql' ); +} +sub _CloseParen { + $_[0]->SUPER::_CloseParen( $_[1] || 'ticketsql' ); +} + +sub Limit { + my $self = shift; + my %args = @_; + $self->{'must_redo_search'} = 1; + delete $self->{'raw_rows'}; + delete $self->{'count_all'}; + + if ($self->{'using_restrictions'}) { + RT->Deprecated( Message => "Mixing old-style LimitFoo methods with Limit is deprecated" ); + $self->LimitField(@_); + } + + $args{SUBCLAUSE} ||= "ticketsql" + if $self->{parsing_ticketsql} and not $args{LEFTJOIN}; + + $self->{_sql_looking_at}{ lc $args{FIELD} } = 1 + if $args{FIELD} and (not $args{ALIAS} or $args{ALIAS} eq "main"); + + $self->SUPER::Limit(%args); +} + + #Freeside sub JoinToCustLinks { @@ -2328,16 +1701,16 @@ sub _FreesideFieldLimit { } -#Freeside +#end Freeside -=head2 Limit +=head2 LimitField Takes a paramhash with the fields FIELD, OPERATOR, VALUE and DESCRIPTION Generally best called from LimitFoo methods =cut -sub Limit { +sub LimitField { my $self = shift; my %args = ( FIELD => undef, @@ -2352,6 +1725,12 @@ sub Limit { ) if ( !defined $args{'DESCRIPTION'} ); + + if ($self->_isLimited > 1) { + RT->Deprecated( Message => "Mixing old-style LimitFoo methods with Limit is deprecated" ); + } + $self->{using_restrictions} = 1; + my $index = $self->_NextIndex; # make the TicketRestrictions hash the equivalent of whatever we just passed in; @@ -2360,20 +1739,6 @@ sub Limit { $self->{'RecalcTicketLimits'} = 1; -# If we're looking at the effective id, we don't want to append the other clause -# which limits us to tickets where id = effective id - if ( $args{'FIELD'} eq 'EffectiveId' - && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) - { - $self->{'looking_at_effective_id'} = 1; - } - - if ( $args{'FIELD'} eq 'Type' - && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) - { - $self->{'looking_at_type'} = 1; - } - return ($index); } @@ -2409,7 +1774,7 @@ sub LimitQueue { #TODO check for a valid queue here - $self->Limit( + $self->LimitField( FIELD => 'Queue', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2441,7 +1806,7 @@ sub LimitStatus { OPERATOR => '=', @_ ); - $self->Limit( + $self->LimitField( FIELD => 'Status', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2451,7 +1816,43 @@ sub LimitStatus { ); } +=head2 LimitToActiveStatus + +Limits the status to L<RT::Queue/ActiveStatusArray> + +TODO: make this respect lifecycles for the queues associated with the search + +=cut +sub LimitToActiveStatus { + my $self = shift; + + my @active = RT::Queue->ActiveStatusArray(); + for my $active (@active) { + $self->LimitStatus( + VALUE => $active, + ); + } +} + +=head2 LimitToInactiveStatus + +Limits the status to L<RT::Queue/InactiveStatusArray> + +TODO: make this respect lifecycles for the queues associated with the search + +=cut + +sub LimitToInactiveStatus { + my $self = shift; + + my @active = RT::Queue->InactiveStatusArray(); + for my $active (@active) { + $self->LimitStatus( + VALUE => $active, + ); + } +} =head2 IgnoreType @@ -2466,10 +1867,10 @@ sub IgnoreType { # Instead of faking a Limit that later gets ignored, fake up the # fact that we're already looking at type, so that the check in - # Tickets_SQL/FromSQL goes down the right branch + # FromSQL goes down the right branch # $self->LimitType(VALUE => '__any'); - $self->{looking_at_type} = 1; + $self->{_sql_looking_at}{type} = 1; } @@ -2491,7 +1892,7 @@ sub LimitType { VALUE => undef, @_ ); - $self->Limit( + $self->LimitField( FIELD => 'Type', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2515,7 +1916,7 @@ VALUE is a string to search for in the subject of the ticket. sub LimitSubject { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'Subject', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2544,7 +1945,7 @@ sub LimitId { @_ ); - $self->Limit( + $self->LimitField( FIELD => 'id', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2566,7 +1967,7 @@ VALUE is a value to match the ticket's priority against sub LimitPriority { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'Priority', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2590,7 +1991,7 @@ VALUE is a value to match the ticket's initial priority against sub LimitInitialPriority { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'InitialPriority', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2613,7 +2014,7 @@ VALUE is a value to match the ticket's final priority against sub LimitFinalPriority { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'FinalPriority', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2636,7 +2037,7 @@ VALUE is a value to match the ticket's TimeWorked attribute sub LimitTimeWorked { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'TimeWorked', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2659,7 +2060,7 @@ VALUE is a value to match the ticket's TimeLeft attribute sub LimitTimeLeft { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'TimeLeft', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2684,7 +2085,7 @@ VALUE is a string to search for in the body of the ticket sub LimitContent { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'Content', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2707,7 +2108,7 @@ VALUE is a string to search for in the body of the ticket sub LimitFilename { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'Filename', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2729,7 +2130,7 @@ VALUE is a content type to search ticket attachments for sub LimitContentType { my $self = shift; my %args = (@_); - $self->Limit( + $self->LimitField( FIELD => 'ContentType', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2762,7 +2163,7 @@ sub LimitOwner { $owner->Load( $args{'VALUE'} ); # FIXME: check for a valid $owner - $self->Limit( + $self->LimitField( FIELD => 'Owner', VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2803,7 +2204,7 @@ sub LimitWatcher { $watcher_type = "Watcher"; } - $self->Limit( + $self->LimitField( FIELD => $watcher_type, VALUE => $args{'VALUE'}, OPERATOR => $args{'OPERATOR'}, @@ -2839,7 +2240,7 @@ sub LimitLinkedTo { @_ ); - $self->Limit( + $self->LimitField( FIELD => 'LinkedTo', BASE => undef, TARGET => $args{'TARGET'}, @@ -2882,7 +2283,7 @@ sub LimitLinkedFrom { my $type = $args{'TYPE'}; $type = $fromToMap{$type} if exists( $fromToMap{$type} ); - $self->Limit( + $self->LimitField( FIELD => 'LinkedTo', TARGET => undef, BASE => $args{'BASE'}, @@ -3004,7 +2405,7 @@ sub LimitDate { . $args{'VALUE'} . " GMT"; } - $self->Limit(%args); + $self->LimitField(%args); } @@ -3078,7 +2479,7 @@ sub LimitTransactionDate { . $args{'VALUE'} . " GMT"; } - $self->Limit(%args); + $self->LimitField(%args); } @@ -3118,9 +2519,10 @@ sub LimitCustomField { $CF->Load( $args{CUSTOMFIELD} ); } else { - $CF->LoadByNameAndQueue( - Name => $args{CUSTOMFIELD}, - Queue => $args{QUEUE} + $CF->LoadByName( + Name => $args{CUSTOMFIELD}, + LookupType => RT::Ticket->CustomFieldLookupType, + ObjectId => $args{QUEUE}, ); $args{CUSTOMFIELD} = $CF->Id; } @@ -3152,7 +2554,7 @@ sub LimitCustomField { @rest = ( ENTRYAGGREGATOR => 'AND' ) if ( $CF->Type eq 'SelectMultiple' ); - $self->Limit( + $self->LimitField( VALUE => $args{VALUE}, FIELD => "CF" .(defined $args{'QUEUE'}? ".$args{'QUEUE'}" : '' ) @@ -3185,8 +2587,6 @@ sub _Init { my $self = shift; $self->{'table'} = "Tickets"; $self->{'RecalcTicketLimits'} = 1; - $self->{'looking_at_effective_id'} = 0; - $self->{'looking_at_type'} = 0; $self->{'restriction_index'} = 1; $self->{'primary_key'} = "id"; delete $self->{'items_array'}; @@ -3194,8 +2594,19 @@ sub _Init { delete $self->{'columns_to_display'}; $self->SUPER::_Init(@_); - $self->_InitSQL; + $self->_InitSQL(); +} +sub _InitSQL { + my $self = shift; + # Private Member Variables (which should get cleaned) + $self->{'_sql_transalias'} = undef; + $self->{'_sql_trattachalias'} = undef; + $self->{'_sql_cf_alias'} = undef; + $self->{'_sql_object_cfv_alias'} = undef; + $self->{'_sql_watcher_join_users_alias'} = undef; + $self->{'_sql_query'} = ''; + $self->{'_sql_looking_at'} = {}; } @@ -3277,7 +2688,7 @@ sub Next { # if we found a ticket with this option enabled then # all tickets we found are ACLed, cache this fact my $key = join ";:;", $self->CurrentUser->id, 'ShowTicket', 'RT::Ticket-'. $Ticket->id; - $RT::Principal::_ACL_CACHE->set( $key => 1 ); + $RT::Principal::_ACL_CACHE->{ $key } = 1; return $Ticket; } elsif ( $Ticket->CurrentUserHasRight('ShowTicket') ) { @@ -3307,7 +2718,7 @@ sub _RolesCanSee { my $cache_key = 'RolesHasRight;:;ShowTicket'; - if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) { + if ( my $cached = $RT::Principal::_ACL_CACHE->{ $cache_key } ) { return %$cached; } @@ -3337,7 +2748,7 @@ sub _RolesCanSee { $RT::Logger->error('ShowTicket right is granted on unsupported object'); } } - $RT::Principal::_ACL_CACHE->set( $cache_key => \%res ); + $RT::Principal::_ACL_CACHE->{ $cache_key } = \%res; return %res; } @@ -3346,7 +2757,7 @@ sub _DirectlyCanSeeIn { my $id = $self->CurrentUser->id; my $cache_key = 'User-'. $id .';:;ShowTicket;:;DirectlyCanSeeIn'; - if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) { + if ( my $cached = $RT::Principal::_ACL_CACHE->{ $cache_key } ) { return @$cached; } @@ -3374,7 +2785,7 @@ sub _DirectlyCanSeeIn { if ( $type eq 'RT::System' ) { # If user is direct member of a group that has the right # on the system then he can see any ticket - $RT::Principal::_ACL_CACHE->set( $cache_key => [-1] ); + $RT::Principal::_ACL_CACHE->{ $cache_key } = [-1]; return (-1); } elsif ( $type eq 'RT::Queue' ) { @@ -3384,7 +2795,7 @@ sub _DirectlyCanSeeIn { $RT::Logger->error('ShowTicket right is granted on unsupported object'); } } - $RT::Principal::_ACL_CACHE->set( $cache_key => \@res ); + $RT::Principal::_ACL_CACHE->{ $cache_key } = \@res; return @res; } @@ -3397,6 +2808,8 @@ sub CurrentUserCanSee { Right => 'SuperUser', Object => $RT::System ); + local $self->{using_restrictions}; + my $id = $self->CurrentUser->id; # directly can see in all queues then we have nothing to do @@ -3427,10 +2840,14 @@ sub CurrentUserCanSee { if ( my @tmp = grep $_ ne 'Owner' && !ref $roles{ $_ }, keys %roles ) { my $groups = RT::Groups->new( RT->SystemUser ); - $groups->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role' ); - foreach ( @tmp ) { - $groups->Limit( FIELD => 'Type', VALUE => $_ ); - } + $groups->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role', CASESENSITIVE => 0 ); + $groups->Limit( + FIELD => 'Name', + FUNCTION => 'LOWER(?)', + OPERATOR => 'IN', + VALUE => [ map {lc $_} @tmp ], + CASESENSITIVE => 1, + ); my $principal_alias = $groups->Join( ALIAS1 => 'main', FIELD1 => 'id', @@ -3452,7 +2869,7 @@ sub CurrentUserCanSee { } unless ( @direct_queues || keys %roles ) { - $self->SUPER::Limit( + $self->Limit( SUBCLAUSE => 'ACL', ALIAS => 'main', FIELD => 'id', @@ -3469,7 +2886,7 @@ sub CurrentUserCanSee { if ( $join_roles ) { $role_group_alias = $self->_RoleGroupsJoin( New => 1 ); $cgm_alias = $self->_GroupMembersJoin( GroupsAlias => $role_group_alias ); - $self->SUPER::Limit( + $self->Limit( LEFTJOIN => $cgm_alias, FIELD => 'MemberId', OPERATOR => '=', @@ -3481,28 +2898,14 @@ sub CurrentUserCanSee { my @queues = @_; return unless @queues; - if ( @queues == 1 ) { - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - ALIAS => 'main', - FIELD => 'Queue', - VALUE => $_[0], - ENTRYAGGREGATOR => $ea, - ); - } else { - $self->SUPER::_OpenParen('ACL'); - foreach my $q ( @queues ) { - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - ALIAS => 'main', - FIELD => 'Queue', - VALUE => $q, - ENTRYAGGREGATOR => $ea, - ); - $ea = 'OR'; - } - $self->SUPER::_CloseParen('ACL'); - } + $self->Limit( + SUBCLAUSE => 'ACL', + ALIAS => 'main', + FIELD => 'Queue', + OPERATOR => 'IN', + VALUE => [ @queues ], + ENTRYAGGREGATOR => $ea, + ); return 1; }; @@ -3512,7 +2915,7 @@ sub CurrentUserCanSee { while ( my ($role, $queues) = each %roles ) { $self->SUPER::_OpenParen('ACL'); if ( $role eq 'Owner' ) { - $self->SUPER::Limit( + $self->Limit( SUBCLAUSE => 'ACL', FIELD => 'Owner', VALUE => $id, @@ -3520,7 +2923,7 @@ sub CurrentUserCanSee { ); } else { - $self->SUPER::Limit( + $self->Limit( SUBCLAUSE => 'ACL', ALIAS => $cgm_alias, FIELD => 'MemberId', @@ -3529,12 +2932,13 @@ sub CurrentUserCanSee { QUOTEVALUE => 0, ENTRYAGGREGATOR => $ea, ); - $self->SUPER::Limit( + $self->Limit( SUBCLAUSE => 'ACL', ALIAS => $role_group_alias, - FIELD => 'Type', + FIELD => 'Name', VALUE => $role, ENTRYAGGREGATOR => 'AND', + CASESENSITIVE => 0, ); } $limit_queues->( 'AND', @$queues ) if ref $queues; @@ -3548,58 +2952,6 @@ sub CurrentUserCanSee { - - -=head2 LoadRestrictions - -LoadRestrictions takes a string which can fully populate the TicketRestrictons hash. -TODO It is not yet implemented - -=cut - - - -=head2 DescribeRestrictions - -takes nothing. -Returns a hash keyed by restriction id. -Each element of the hash is currently a one element hash that contains DESCRIPTION which -is a description of the purpose of that TicketRestriction - -=cut - -sub DescribeRestrictions { - my $self = shift; - - my %listing; - - foreach my $row ( keys %{ $self->{'TicketRestrictions'} } ) { - $listing{$row} = $self->{'TicketRestrictions'}{$row}{'DESCRIPTION'}; - } - return (%listing); -} - - - -=head2 RestrictionValues FIELD - -Takes a restriction field and returns a list of values this field is restricted -to. - -=cut - -sub RestrictionValues { - my $self = shift; - my $field = shift; - map $self->{'TicketRestrictions'}{$_}{'VALUE'}, grep { - $self->{'TicketRestrictions'}{$_}{'FIELD'} eq $field - && $self->{'TicketRestrictions'}{$_}{'OPERATOR'} eq "=" - } - keys %{ $self->{'TicketRestrictions'} }; -} - - - =head2 ClearRestrictions Removes all restrictions irretrievably @@ -3609,32 +2961,10 @@ Removes all restrictions irretrievably sub ClearRestrictions { my $self = shift; delete $self->{'TicketRestrictions'}; - $self->{'looking_at_effective_id'} = 0; - $self->{'looking_at_type'} = 0; + $self->{_sql_looking_at} = {}; $self->{'RecalcTicketLimits'} = 1; } - - -=head2 DeleteRestriction - -Takes the row Id of a restriction (From DescribeRestrictions' output, for example. -Removes that restriction from the session's limits. - -=cut - -sub DeleteRestriction { - my $self = shift; - my $row = shift; - delete $self->{'TicketRestrictions'}{$row}; - - $self->{'RecalcTicketLimits'} = 1; - - #make the underlying easysearch object forget all its preconceptions -} - - - # Convert a set of oldstyle SB Restrictions to Clauses for RQL sub _RestrictionsToClauses { @@ -3729,30 +3059,45 @@ sub _RestrictionsToClauses { return \%clause; } +=head2 ClausesToSQL +=cut -=head2 _ProcessRestrictions PARAMHASH +sub ClausesToSQL { + my $self = shift; + my $clauses = shift; + my @sql; -# The new _ProcessRestrictions is somewhat dependent on the SQL stuff, -# but isn't quite generic enough to move into Tickets_SQL. + for my $f (keys %{$clauses}) { + my $sql; + my $first = 1; -=cut + # Build SQL from the data hash + for my $data ( @{ $clauses->{$f} } ) { + $sql .= $data->[0] unless $first; $first=0; # ENTRYAGGREGATOR + $sql .= " '". $data->[2] . "' "; # FIELD + $sql .= $data->[3] . " "; # OPERATOR + $sql .= "'". $data->[4] . "' "; # VALUE + } + + push @sql, " ( " . $sql . " ) "; + } + + return join("AND",@sql); +} sub _ProcessRestrictions { my $self = shift; - #Blow away ticket aliases since we'll need to regenerate them for - #a new search - delete $self->{'TicketAliases'}; delete $self->{'items_array'}; delete $self->{'item_map'}; delete $self->{'raw_rows'}; - delete $self->{'rows'}; delete $self->{'count_all'}; - my $sql = $self->Query; # Violating the _SQL namespace + my $sql = $self->Query; if ( !$sql || $self->{'RecalcTicketLimits'} ) { + local $self->{using_restrictions}; # "Restrictions to Clauses Branch\n"; my $clauseRef = eval { $self->_RestrictionsToClauses; }; if ($@) { @@ -3852,7 +3197,6 @@ RT::Tickets supports several flags which alter search behavior: allow_deleted_search (Otherwise never show deleted tickets in search results) -looking_at_type (otherwise limit to type=ticket) These flags are set by calling @@ -3864,18 +3208,214 @@ BUG: There should be an API for this =cut +=head2 FromSQL + +Convert a RT-SQL string into a set of SearchBuilder restrictions. + +Returns (1, 'Status message') on success and (0, 'Error Message') on +failure. + +=cut + +sub _parser { + my ($self,$string) = @_; + my $ea = ''; + + # Bundling of joins is implemented by dynamically tracking a parallel query + # tree in %sub_tree as the TicketSQL is parsed. + # + # Only positive, OR'd watcher conditions are bundled currently. Each key + # in %sub_tree is a watcher type (Requestor, Cc, AdminCc) or the generic + # "Watcher" for any watcher type. Owner is not bundled because it is + # denormalized into a Tickets column and doesn't need a join. AND'd + # conditions are not bundled since a record may have multiple watchers + # which independently match the conditions, thus necessitating two joins. + # + # The values of %sub_tree are arrayrefs made up of: + # + # * Open parentheses "(" pushed on by the OpenParen callback + # * Arrayrefs of bundled join aliases pushed on by the Condition callback + # * Entry aggregators (AND/OR) pushed on by the EntryAggregator callback + # + # The CloseParen callback takes care of backing off the query trees until + # outside of the just-closed parenthetical, thus restoring the tree state + # an equivalent of before the parenthetical was entered. + # + # The Condition callback handles starting a new subtree or extending an + # existing one, determining if bundling the current condition with any + # subtree is possible, and pruning any dangling entry aggregators from + # trees. + # + + my %sub_tree; + my $depth = 0; + + my %callback; + $callback{'OpenParen'} = sub { + $self->_OpenParen; + $depth++; + push @$_, '(' foreach values %sub_tree; + }; + $callback{'CloseParen'} = sub { + $self->_CloseParen; + $depth--; + foreach my $list ( values %sub_tree ) { + if ( $list->[-1] eq '(' ) { + pop @$list; + pop @$list if $list->[-1] =~ /^(?:AND|OR)$/i; + } + else { + pop @$list while $list->[-2] ne '('; + $list->[-1] = pop @$list; + } + } + }; + $callback{'EntryAggregator'} = sub { + $ea = $_[0] || ''; + push @$_, $ea foreach grep @$_ && $_->[-1] ne '(', values %sub_tree; + }; + $callback{'Condition'} = sub { + my ($key, $op, $value) = @_; + + my $negative_op = ($op eq '!=' || $op =~ /\bNOT\b/i); + my $null_op = ( 'is not' eq lc($op) || 'is' eq lc($op) ); + # key has dot then it's compound variant and we have subkey + my $subkey = ''; + ($key, $subkey) = ($1, $2) if $key =~ /^([^\.]+)\.(.+)$/; + + # normalize key and get class (type) + my $class; + if (exists $LOWER_CASE_FIELDS{lc $key}) { + $key = $LOWER_CASE_FIELDS{lc $key}; + $class = $FIELD_METADATA{$key}->[0]; + } + die "Unknown field '$key' in '$string'" unless $class; + + # replace __CurrentUser__ with id + $value = $self->CurrentUser->id if $value eq '__CurrentUser__'; + + + unless( $dispatch{ $class } ) { + die "No dispatch method for class '$class'" + } + my $sub = $dispatch{ $class }; + + my @res; my $bundle_with; + if ( $class eq 'WATCHERFIELD' && $key ne 'Owner' && !$negative_op && (!$null_op || $subkey) ) { + if ( !$sub_tree{$key} ) { + $sub_tree{$key} = [ ('(')x$depth, \@res ]; + } else { + $bundle_with = $self->_check_bundling_possibility( $string, @{ $sub_tree{$key} } ); + if ( $sub_tree{$key}[-1] eq '(' ) { + push @{ $sub_tree{$key} }, \@res; + } + } + } + + # Remove our aggregator from subtrees where our condition didn't get added + pop @$_ foreach grep @$_ && $_->[-1] =~ /^(?:AND|OR)$/i, values %sub_tree; + + # A reference to @res may be pushed onto $sub_tree{$key} from + # above, and we fill it here. + @res = $sub->( $self, $key, $op, $value, + SUBCLAUSE => '', # don't need anymore + ENTRYAGGREGATOR => $ea, + SUBKEY => $subkey, + BUNDLE => $bundle_with, + ); + $ea = ''; + }; + RT::SQL::Parse($string, \%callback); +} + +sub FromSQL { + my ($self,$query) = @_; + { + # preserve first_row and show_rows across the CleanSlate + local ($self->{'first_row'}, $self->{'show_rows'}, $self->{_sql_looking_at}); + $self->CleanSlate; + $self->_InitSQL(); + } -=head2 NewItem + return (1, $self->loc("No Query")) unless $query; -Returns an empty new RT::Ticket item + $self->{_sql_query} = $query; + eval { + local $self->{parsing_ticketsql} = 1; + $self->_parser( $query ); + }; + if ( $@ ) { + my $error = "$@"; + $RT::Logger->error("Couldn't parse query: $error"); + return (0, $error); + } + + # We only want to look at EffectiveId's (mostly) for these searches. + unless ( $self->{_sql_looking_at}{effectiveid} ) { + # instead of EffectiveId = id we do IsMerged IS NULL + $self->Limit( + FIELD => 'IsMerged', + OPERATOR => 'IS', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'AND', + QUOTEVALUE => 0, + ); + } + unless ( $self->{_sql_looking_at}{type} ) { + $self->Limit( FIELD => 'Type', VALUE => 'ticket' ); + } + + # We don't want deleted tickets unless 'allow_deleted_search' is set + unless( $self->{'allow_deleted_search'} ) { + $self->Limit( + FIELD => 'Status', + OPERATOR => '!=', + VALUE => 'deleted', + ); + } + + # set SB's dirty flag + $self->{'must_redo_search'} = 1; + $self->{'RecalcTicketLimits'} = 0; + + return (1, $self->loc("Valid Query")); +} + +=head2 Query + +Returns the last string passed to L</FromSQL>. =cut -sub NewItem { +sub Query { + my $self = shift; + return $self->{_sql_query}; +} + +sub _check_bundling_possibility { my $self = shift; - return(RT::Ticket->new($self->CurrentUser)); + my $string = shift; + my @list = reverse @_; + while (my $e = shift @list) { + next if $e eq '('; + if ( lc($e) eq 'and' ) { + return undef; + } + elsif ( lc($e) eq 'or' ) { + return shift @list; + } + else { + # should not happen + $RT::Logger->error( + "Joins optimization failed when parsing '$string'. It's bug in RT, contact Best Practical" + ); + die "Internal error. Contact your system administrator."; + } + } + return undef; } + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Tickets_SQL.pm b/rt/lib/RT/Tickets_SQL.pm deleted file mode 100644 index 77313c3..0000000 --- a/rt/lib/RT/Tickets_SQL.pm +++ /dev/null @@ -1,512 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (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::Tickets; - -use strict; -use warnings; - - -use RT::SQL; - -# Import configuration data from the lexcial scope of __PACKAGE__ (or -# at least where those two Subroutines are defined.) - -our (%FIELD_METADATA, %LOWER_CASE_FIELDS, %dispatch, %can_bundle); - -sub _InitSQL { - my $self = shift; - - # Private Member Variables (which should get cleaned) - $self->{'_sql_transalias'} = undef; - $self->{'_sql_trattachalias'} = undef; - $self->{'_sql_cf_alias'} = undef; - $self->{'_sql_object_cfv_alias'} = undef; - $self->{'_sql_watcher_join_users_alias'} = undef; - $self->{'_sql_query'} = ''; - $self->{'_sql_looking_at'} = {}; -} - -sub _SQLLimit { - my $self = shift; - my %args = (FIELD => '', @_); - if ($args{'FIELD'} eq 'EffectiveId' && - (!$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) { - $self->{'looking_at_effective_id'} = 1; - } - - if ($args{'FIELD'} eq 'Type' && - (!$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) { - $self->{'looking_at_type'} = 1; - } - - # All SQL stuff goes into one SB subclause so we can deal with all - # the aggregation - $self->SUPER::Limit(%args, - SUBCLAUSE => 'ticketsql'); -} - -sub _SQLJoin { - # All SQL stuff goes into one SB subclause so we can deal with all - # the aggregation - my $this = shift; - - $this->SUPER::Join(@_, - SUBCLAUSE => 'ticketsql'); -} - -# Helpers -sub _OpenParen { - $_[0]->SUPER::_OpenParen( 'ticketsql' ); -} -sub _CloseParen { - $_[0]->SUPER::_CloseParen( 'ticketsql' ); -} - -=head1 SQL Functions - -=cut - -=head2 Robert's Simple SQL Parser - -Documentation In Progress - -The Parser/Tokenizer is a relatively simple state machine that scans through a SQL WHERE clause type string extracting a token at a time (where a token is: - - VALUE -> quoted string or number - AGGREGator -> AND or OR - KEYWORD -> quoted string or single word - OPerator -> =,!=,LIKE,etc.. - PARENthesis -> open or close. - -And that stream of tokens is passed through the "machine" in order to build up a structure that looks like: - - KEY OP VALUE - AND KEY OP VALUE - OR KEY OP VALUE - -That also deals with parenthesis for nesting. (The parentheses are -just handed off the SearchBuilder) - -=cut - -sub _close_bundle { - my ($self, @bundle) = @_; - return unless @bundle; - - if ( @bundle == 1 ) { - $bundle[0]->{'dispatch'}->( - $self, - $bundle[0]->{'key'}, - $bundle[0]->{'op'}, - $bundle[0]->{'val'}, - SUBCLAUSE => '', - ENTRYAGGREGATOR => $bundle[0]->{ea}, - SUBKEY => $bundle[0]->{subkey}, - ); - } - else { - my @args; - foreach my $chunk (@bundle) { - push @args, [ - $chunk->{key}, - $chunk->{op}, - $chunk->{val}, - SUBCLAUSE => '', - ENTRYAGGREGATOR => $chunk->{ea}, - SUBKEY => $chunk->{subkey}, - ]; - } - $bundle[0]->{dispatch}->( $self, \@args ); - } -} - -sub _parser { - my ($self,$string) = @_; - my @bundle; - my $ea = ''; - - # Bundling of joins is implemented by dynamically tracking a parallel query - # tree in %sub_tree as the TicketSQL is parsed. Don't be fooled by - # _close_bundle(), @bundle, and %can_bundle; they are completely unused for - # quite a long time and removed in RT 4.2. For now they stay, a useless - # relic. - # - # Only positive, OR'd watcher conditions are bundled currently. Each key - # in %sub_tree is a watcher type (Requestor, Cc, AdminCc) or the generic - # "Watcher" for any watcher type. Owner is not bundled because it is - # denormalized into a Tickets column and doesn't need a join. AND'd - # conditions are not bundled since a record may have multiple watchers - # which independently match the conditions, thus necessitating two joins. - # - # The values of %sub_tree are arrayrefs made up of: - # - # * Open parentheses "(" pushed on by the OpenParen callback - # * Arrayrefs of bundled join aliases pushed on by the Condition callback - # * Entry aggregators (AND/OR) pushed on by the EntryAggregator callback - # - # The CloseParen callback takes care of backing off the query trees until - # outside of the just-closed parenthetical, thus restoring the tree state - # an equivalent of before the parenthetical was entered. - # - # The Condition callback handles starting a new subtree or extending an - # existing one, determining if bundling the current condition with any - # subtree is possible, and pruning any dangling entry aggregators from - # trees. - # - - my %sub_tree; - my $depth = 0; - - my %callback; - $callback{'OpenParen'} = sub { - $self->_close_bundle(@bundle); @bundle = (); - $self->_OpenParen; - $depth++; - push @$_, '(' foreach values %sub_tree; - }; - $callback{'CloseParen'} = sub { - $self->_close_bundle(@bundle); @bundle = (); - $self->_CloseParen; - $depth--; - foreach my $list ( values %sub_tree ) { - if ( $list->[-1] eq '(' ) { - pop @$list; - pop @$list if $list->[-1] =~ /^(?:AND|OR)$/i; - } - else { - pop @$list while $list->[-2] ne '('; - $list->[-1] = pop @$list; - } - } - }; - $callback{'EntryAggregator'} = sub { - $ea = $_[0] || ''; - push @$_, $ea foreach grep @$_ && $_->[-1] ne '(', values %sub_tree; - }; - $callback{'Condition'} = sub { - my ($key, $op, $value) = @_; - - my ($negative_op, $null_op, $inv_op, $range_op) - = $self->ClassifySQLOperation( $op ); - # key has dot then it's compound variant and we have subkey - my $subkey = ''; - ($key, $subkey) = ($1, $2) if $key =~ /^([^\.]+)\.(.+)$/; - - # normalize key and get class (type) - my $class; - if (exists $LOWER_CASE_FIELDS{lc $key}) { - $key = $LOWER_CASE_FIELDS{lc $key}; - $class = $FIELD_METADATA{$key}->[0]; - } - die "Unknown field '$key' in '$string'" unless $class; - - # replace __CurrentUser__ with id - $value = $self->CurrentUser->id if $value eq '__CurrentUser__'; - - - unless( $dispatch{ $class } ) { - die "No dispatch method for class '$class'" - } - my $sub = $dispatch{ $class }; - - if ( $can_bundle{ $class } - && ( !@bundle - || ( $bundle[-1]->{dispatch} == $sub - && $bundle[-1]->{key} eq $key - && $bundle[-1]->{subkey} eq $subkey - ) - ) - ) - { - push @bundle, { - dispatch => $sub, - key => $key, - op => $op, - val => $value, - ea => $ea, - subkey => $subkey, - }; - } - else { - $self->_close_bundle(@bundle); @bundle = (); - my @res; my $bundle_with; - if ( $class eq 'WATCHERFIELD' && $key ne 'Owner' && !$negative_op && (!$null_op || $subkey) ) { - if ( !$sub_tree{$key} ) { - $sub_tree{$key} = [ ('(')x$depth, \@res ]; - } else { - $bundle_with = $self->_check_bundling_possibility( $string, @{ $sub_tree{$key} } ); - if ( $sub_tree{$key}[-1] eq '(' ) { - push @{ $sub_tree{$key} }, \@res; - } - } - } - - # Remove our aggregator from subtrees where our condition didn't get added - pop @$_ foreach grep @$_ && $_->[-1] =~ /^(?:AND|OR)$/i, values %sub_tree; - - # A reference to @res may be pushed onto $sub_tree{$key} from - # above, and we fill it here. - @res = $sub->( $self, $key, $op, $value, - SUBCLAUSE => '', # don't need anymore - ENTRYAGGREGATOR => $ea, - SUBKEY => $subkey, - BUNDLE => $bundle_with, - ); - } - $self->{_sql_looking_at}{lc $key} = 1; - $ea = ''; - }; - RT::SQL::Parse($string, \%callback); - $self->_close_bundle(@bundle); @bundle = (); -} - -sub _check_bundling_possibility { - my $self = shift; - my $string = shift; - my @list = reverse @_; - while (my $e = shift @list) { - next if $e eq '('; - if ( lc($e) eq 'and' ) { - return undef; - } - elsif ( lc($e) eq 'or' ) { - return shift @list; - } - else { - # should not happen - $RT::Logger->error( - "Joins optimization failed when parsing '$string'. It's bug in RT, contact Best Practical" - ); - die "Internal error. Contact your system administrator."; - } - } - return undef; -} - -=head2 ClausesToSQL - -=cut - -sub ClausesToSQL { - my $self = shift; - my $clauses = shift; - my @sql; - - for my $f (keys %{$clauses}) { - my $sql; - my $first = 1; - - # Build SQL from the data hash - for my $data ( @{ $clauses->{$f} } ) { - $sql .= $data->[0] unless $first; $first=0; # ENTRYAGGREGATOR - $sql .= " '". $data->[2] . "' "; # FIELD - $sql .= $data->[3] . " "; # OPERATOR - $sql .= "'". $data->[4] . "' "; # VALUE - } - - push @sql, " ( " . $sql . " ) "; - } - - return join("AND",@sql); -} - -=head2 FromSQL - -Convert a RT-SQL string into a set of SearchBuilder restrictions. - -Returns (1, 'Status message') on success and (0, 'Error Message') on -failure. - - - - -=cut - -sub FromSQL { - my ($self,$query) = @_; - - { - # preserve first_row and show_rows across the CleanSlate - local ($self->{'first_row'}, $self->{'show_rows'}); - $self->CleanSlate; - } - $self->_InitSQL(); - - return (1, $self->loc("No Query")) unless $query; - - $self->{_sql_query} = $query; - eval { $self->_parser( $query ); }; - if ( $@ ) { - my $error = "$@"; - $RT::Logger->error("Couldn't parse query: $error"); - return (0, $error); - } - - # We only want to look at EffectiveId's (mostly) for these searches. - unless ( exists $self->{_sql_looking_at}{'effectiveid'} ) { - #TODO, we shouldn't be hard #coding the tablename to main. - $self->SUPER::Limit( FIELD => 'EffectiveId', - VALUE => 'main.id', - ENTRYAGGREGATOR => 'AND', - QUOTEVALUE => 0, - ); - } - # FIXME: Need to bring this logic back in - - # if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) { - # $self->SUPER::Limit( FIELD => 'EffectiveId', - # OPERATOR => '=', - # QUOTEVALUE => 0, - # VALUE => 'main.id'); #TODO, we shouldn't be hard coding the tablename to main. - # } - # --- This is hardcoded above. This comment block can probably go. - # Or, we need to reimplement the looking_at_effective_id toggle. - - # Unless we've explicitly asked to look at a specific Type, we need - # to limit to it. - unless ( $self->{looking_at_type} ) { - $self->SUPER::Limit( FIELD => 'Type', VALUE => 'ticket' ); - } - - # We don't want deleted tickets unless 'allow_deleted_search' is set - unless( $self->{'allow_deleted_search'} ) { - $self->SUPER::Limit( FIELD => 'Status', - OPERATOR => '!=', - VALUE => 'deleted', - ); - } - - # set SB's dirty flag - $self->{'must_redo_search'} = 1; - $self->{'RecalcTicketLimits'} = 0; - - return (1, $self->loc("Valid Query")); -} - -=head2 Query - -Returns the query that this object was initialized with - -=cut - -sub Query { - return ($_[0]->{_sql_query}); -} - -{ -my %inv = ( - '=' => '!=', '!=' => '=', '<>' => '=', - '>' => '<=', '<' => '>=', '>=' => '<', '<=' => '>', - 'is' => 'IS NOT', 'is not' => 'IS', - 'like' => 'NOT LIKE', 'not like' => 'LIKE', - 'matches' => 'NOT MATCHES', 'not matches' => 'MATCHES', - 'startswith' => 'NOT STARTSWITH', 'not startswith' => 'STARTSWITH', - 'endswith' => 'NOT ENDSWITH', 'not endswith' => 'ENDSWITH', -); - -my %range = map { $_ => 1 } qw(> >= < <=); - -sub ClassifySQLOperation { - my $self = shift; - my $op = shift; - - my $is_negative = 0; - if ( $op eq '!=' || $op =~ /\bNOT\b/i ) { - $is_negative = 1; - } - - my $is_null = 0; - if ( 'is not' eq lc($op) || 'is' eq lc($op) ) { - $is_null = 1; - } - - return ($is_negative, $is_null, $inv{lc $op}, $range{lc $op}); -} } - -1; - -=pod - -=head2 Exceptions - -Most of the RT code does not use Exceptions (die/eval) but it is used -in the TicketSQL code for simplicity and historical reasons. Lest you -be worried that the dies will trigger user visible errors, all are -trapped via evals. - -99% of the dies fall in subroutines called via FromSQL and then parse. -(This includes all of the _FooLimit routines in Tickets_Overlay.pm.) -The other 1% or so are via _ProcessRestrictions. - -All dies are trapped by eval {}s, and will be logged at the 'error' -log level. The general failure mode is to not display any tickets. - -=head2 General Flow - -Legacy Layer: - - Legacy LimitFoo routines build up a RestrictionsHash - - _ProcessRestrictions converts the Restrictions to Clauses - ([key,op,val,rest]). - - Clauses are converted to RT-SQL (TicketSQL) - -New RT-SQL Layer: - - FromSQL calls the parser - - The parser calls the _FooLimit routines to do DBIx::SearchBuilder - limits. - -And then the normal SearchBuilder/Ticket routines are used for -display/navigation. - -=cut - diff --git a/rt/lib/RT/Topic.pm b/rt/lib/RT/Topic.pm index 474294f..ff1bb88 100644 --- a/rt/lib/RT/Topic.pm +++ b/rt/lib/RT/Topic.pm @@ -85,7 +85,7 @@ sub Create { $obj = $RT::System unless $obj->id; } - return ( 0, $self->loc("Permission denied")) + return ( 0, $self->loc("Permission Denied")) unless ( $self->CurrentUser->HasRight( Right => "AdminTopics", Object => $obj, @@ -212,46 +212,26 @@ sub _Set { # }}} -# {{{ CurrentUserHasRight +=head2 ACLEquivalenceObjects -=head2 CurrentUserHasRight - -Returns true if the current user has the right for this topic, for the -whole system or for whatever object this topic is associated with +Rights on the topic are inherited from the object it is a topic on. =cut -sub CurrentUserHasRight { +sub ACLEquivalenceObjects { my $self = shift; - my $right = shift; - - my $equiv = [ $RT::System ]; - if ($self->ObjectId) { - my $obj = $self->ObjectType->new($self->CurrentUser); - $obj->Load($self->ObjectId); - push @{$equiv}, $obj; - } - if ($self->Id) { - return ( $self->CurrentUser->HasRight( - Right => $right, - Object => $self, - EquivObjects => $equiv, - ) ); - } else { - # If we don't have an ID, we don't even know what object we're - # attached to -- so the only thing we can fall back on is the - # system object. - return ( $self->CurrentUser->HasRight( - Right => $right, - Object => $RT::System, - ) ); - } - + return unless $self->id and $self->ObjectId; + return $self->Object; } -# }}} +sub Object { + my $self = shift; + my $Object = $self->__Value('ObjectType')->new( $self->CurrentUser ); + $Object->Load( $self->__Value('ObjectId') ); + return $Object; +} =head2 id @@ -357,20 +337,30 @@ sub _CoreAccessible { { id => - {read => 1, type => 'int(11)', default => ''}, + {read => 1, type => 'int(11)', default => ''}, Parent => - {read => 1, write => 1, type => 'int(11)', default => ''}, + {read => 1, write => 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 => ''}, ObjectType => - {read => 1, write => 1, type => 'varchar(64)', default => ''}, + {read => 1, write => 1, type => 'varchar(64)', default => ''}, ObjectId => - {read => 1, write => 1, type => 'int(11)', default => '0'}, + {read => 1, write => 1, type => 'int(11)', default => '0'}, } }; +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + $deps->Add( out => $self->ParentObj ) if $self->ParentObj->Id; + $deps->Add( in => $self->Children ); + $deps->Add( out => $self->Object ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Topics.pm b/rt/lib/RT/Topics.pm index fd83f4a..630a4cb 100644 --- a/rt/lib/RT/Topics.pm +++ b/rt/lib/RT/Topics.pm @@ -103,18 +103,6 @@ sub LimitToKids { # }}} -=head2 NewItem - -Returns an empty new RT::Topic item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Topic->new($self->CurrentUser)); -} - - RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Transaction.pm b/rt/lib/RT/Transaction.pm index 14f670c..781c9e4 100755 --- a/rt/lib/RT/Transaction.pm +++ b/rt/lib/RT/Transaction.pm @@ -82,9 +82,12 @@ use RT::Attachments; use RT::Scrips; use RT::Ruleset; -use HTML::FormatText; -use HTML::TreeBuilder; +use HTML::FormatText::WithLinks::AndTables; +use HTML::Scrubber; +# For EscapeHTML() and decode_entities() +require RT::Interface::Web; +require HTML::Entities; sub Table {'Transactions'} @@ -141,11 +144,11 @@ sub Create { OldValue => $args{'OldValue'}, NewValue => $args{'NewValue'}, Created => $args{'Created'}, - ObjectType => $args{'ObjectType'}, - ObjectId => $args{'ObjectId'}, - ReferenceType => $args{'ReferenceType'}, - OldReference => $args{'OldReference'}, - NewReference => $args{'NewReference'}, + ObjectType => $args{'ObjectType'}, + ObjectId => $args{'ObjectId'}, + ReferenceType => $args{'ReferenceType'}, + OldReference => $args{'OldReference'}, + NewReference => $args{'NewReference'}, ); # Parameters passed in during an import that we probably don't want to touch, otherwise @@ -173,41 +176,47 @@ sub Create { Content => RT::User->CanonicalizeEmailAddress($_) ) for @{$args{'SquelchMailTo'} || []}; - #Provide a way to turn off scrips if we need to - $RT::Logger->debug('About to think about scrips for transaction #' .$self->Id); - if ( $args{'ActivateScrips'} and $args{'ObjectType'} eq 'RT::Ticket' ) { - $self->{'scrips'} = RT::Scrips->new(RT->SystemUser); + my @return = ( $id, $self->loc("Transaction Created") ); - $RT::Logger->debug('About to prepare scrips for transaction #' .$self->Id); + return @return unless $args{'ObjectType'} eq 'RT::Ticket'; - $self->{'scrips'}->Prepare( - Stage => 'TransactionCreate', - Type => $args{'Type'}, - Ticket => $args{'ObjectId'}, - Transaction => $self->id, - ); + # Provide a way to turn off scrips if we need to + unless ( $args{'ActivateScrips'} ) { + $RT::Logger->debug('Skipping scrips for transaction #' .$self->Id); + return @return; + } - # Entry point of the rule system - my $ticket = RT::Ticket->new(RT->SystemUser); - $ticket->Load($args{'ObjectId'}); - my $txn = RT::Transaction->new($RT::SystemUser); - $txn->Load($self->id); - - my $rules = $self->{rules} = RT::Ruleset->FindAllRules( - Stage => 'TransactionCreate', - Type => $args{'Type'}, - TicketObj => $ticket, - TransactionObj => $txn, - ); - - if ($args{'CommitScrips'} ) { - $RT::Logger->debug('About to commit scrips for transaction #' .$self->Id); - $self->{'scrips'}->Commit(); - RT::Ruleset->CommitRules($rules); - } + $self->{'scrips'} = RT::Scrips->new(RT->SystemUser); + + $RT::Logger->debug('About to prepare scrips for transaction #' .$self->Id); + + $self->{'scrips'}->Prepare( + Stage => 'TransactionCreate', + Type => $args{'Type'}, + Ticket => $args{'ObjectId'}, + Transaction => $self->id, + ); + + # Entry point of the rule system + my $ticket = RT::Ticket->new(RT->SystemUser); + $ticket->Load($args{'ObjectId'}); + my $txn = RT::Transaction->new($RT::SystemUser); + $txn->Load($self->id); + + my $rules = $self->{rules} = RT::Ruleset->FindAllRules( + Stage => 'TransactionCreate', + Type => $args{'Type'}, + TicketObj => $ticket, + TransactionObj => $txn, + ); + + if ($args{'CommitScrips'} ) { + $RT::Logger->debug('About to commit scrips for transaction #' .$self->Id); + $self->{'scrips'}->Commit(); + RT::Ruleset->CommitRules($rules); } - return ( $id, $self->loc("Transaction Created") ); + return @return; } @@ -339,15 +348,22 @@ sub Content { $content = $content_obj->Content ||''; if ( lc $content_obj->ContentType eq 'text/html' ) { - $content =~ s/<p>--\s+<br \/>.*?$//s if $args{'Quote'}; + $content =~ s/(?:(<\/div>)|<p>|<br\s*\/?>|<div(\s+class="[^"]+")?>)\s*--\s+<br\s*\/?>.*?$/$1/s if $args{'Quote'}; if ($args{Type} ne 'text/html') { - my $tree = HTML::TreeBuilder->new_from_content( $content ); - $content = HTML::FormatText->new( - leftmargin => 0, - rightmargin => 78, - )->format( $tree); - $tree->delete; + $content = RT::Interface::Email::ConvertHTMLToText($content); + } else { + # Scrub out <html>, <head>, <meta>, and <body>, and + # leave all else untouched. + my $scrubber = HTML::Scrubber->new(); + $scrubber->rules( + html => 0, + head => 0, + meta => 0, + body => 0, + ); + $scrubber->default( 1 => { '*' => 1 } ); + $content = $scrubber->scrub( $content ); } } else { @@ -357,7 +373,7 @@ sub Content { $content =~ s/&/&/g; $content =~ s/</</g; $content =~ s/>/>/g; - $content = "<pre>$content</pre>"; + $content = qq|<pre style="white-space: pre-wrap; font-family: monospace;">$content</pre>|; } } } @@ -368,10 +384,18 @@ sub Content { } if ( $args{'Quote'} ) { - $content = $self->ApplyQuoteWrap(content => $content, - cols => $args{'Wrap'} ); - - $content = $self->QuoteHeader . "\n$content\n\n"; + if ($args{Type} eq 'text/html') { + $content = '<div class="gmail_quote">' + . $self->QuoteHeader + . '<br /><blockquote class="gmail_quote" type="cite">' + . $content + . '</blockquote></div><br /><br />'; + } else { + $content = $self->ApplyQuoteWrap(content => $content, + cols => $args{'Wrap'} ); + + $content = $self->QuoteHeader . "\n$content\n\n"; + } } return ($content); @@ -476,14 +500,14 @@ Returns a hashref of addresses related to this transaction. See L<RT::Attachment =cut sub Addresses { - my $self = shift; + my $self = shift; - if (my $attach = $self->Attachments->First) { - return $attach->Addresses; - } - else { - return {}; - } + if (my $attach = $self->Attachments->First) { + return $attach->Addresses; + } + else { + return {}; + } } @@ -509,8 +533,36 @@ sub ContentObj { return undef unless ($Attachment); + my $Attachments = $self->Attachments; + while ( my $Attachment = $Attachments->Next ) { + if ( my $content = _FindPreferredContentObj( %args, Attachment => $Attachment ) ) { + return $content; + } + } + + # If that fails, return the first top-level textual part which has some content. + # We probably really want this to become "recurse, looking for the other type of + # displayable". For now, this maintains backcompat + my $all_parts = $self->Attachments; + while ( my $part = $all_parts->Next ) { + next unless _IsDisplayableTextualContentType($part->ContentType) + && $part->Content; + return $part; + } + + return; +} + + +sub _FindPreferredContentObj { + my %args = @_; + my $Attachment = $args{Attachment}; + + # If we don't have any content, return undef now. + return undef unless $Attachment; + # If it's a textual part, just return the body. - if ( RT::I18N::IsTextualContentType($Attachment->ContentType) ) { + if ( _IsDisplayableTextualContentType($Attachment->ContentType) ) { return ($Attachment); } @@ -520,7 +572,7 @@ sub ContentObj { elsif ( $Attachment->ContentType =~ m|^multipart/mixed|i ) { my $kids = $Attachment->Children; while (my $child = $kids->Next) { - my $ret = $self->ContentObj(%args, Attachment => $child); + my $ret = _FindPreferredContentObj(%args, Attachment => $child); return $ret if ($ret); } } @@ -534,14 +586,28 @@ sub ContentObj { if ( my $first = $plain_parts->First ) { return $first; } + } else { + my $parts = $Attachment->Children; + $parts->LimitNotEmpty; + + # If we actully found a part, return its content + while (my $part = $parts->Next) { + next unless _IsDisplayableTextualContentType($part->ContentType); + return $part; + } + } + } + + # If this is a message/rfc822 mail, we need to dig into it in order to find + # the actual textual content - # If that fails, return the first textual part which has some content. - my $all_parts = $self->Attachments; - while ( my $part = $all_parts->Next ) { - next unless RT::I18N::IsTextualContentType($part->ContentType) - && $part->Content; - return $part; + elsif ( $Attachment->ContentType =~ '^message/rfc822' ) { + my $children = $Attachment->Children; + while ( my $child = $children->Next ) { + if ( my $content = _FindPreferredContentObj( %args, Attachment => $child ) ) { + return $content; + } } } @@ -549,6 +615,18 @@ sub ContentObj { return (undef); } +=head2 _IsDisplayableTextualContentType + +We may need to pull this out to another module later, but for now, this +is better than RT::I18N::IsTextualContentType because that believes that +a message/rfc822 email is displayable, despite it having no content + +=cut + +sub _IsDisplayableTextualContentType { + my $type = shift; + ($type =~ m{^text/(?:plain|html)\b}i) ? 1 : 0; +} =head2 Subject @@ -684,105 +762,208 @@ Returns a text string which briefly describes this transaction =cut -sub BriefDescription { +{ + my $scrubber = HTML::Scrubber->new(default => 0); # deny everything + + sub BriefDescription { + my $self = shift; + my $desc = $self->BriefDescriptionAsHTML; + $desc = $scrubber->scrub($desc); + $desc = HTML::Entities::decode_entities($desc); + return $desc; + } +} + +=head2 BriefDescriptionAsHTML + +Returns an HTML string which briefly describes this transaction. + +=cut + +sub BriefDescriptionAsHTML { my $self = shift; unless ( $self->CurrentUserCanSee ) { return ( $self->loc("Permission Denied") ); } - my $type = $self->Type; #cache this, rather than calling it 30 times + my ($objecttype, $type, $field) = ($self->ObjectType, $self->Type, $self->Field); unless ( defined $type ) { return $self->loc("No transaction type specified"); } - my $obj_type = $self->FriendlyObjectType; + my ($template, @params); + + my @code = grep { ref eq 'CODE' } map { $_BriefDescriptions{$_} } + ( $field + ? ("$objecttype-$type-$field", "$type-$field") + : () ), + "$objecttype-$type", $type; - if ( $type eq 'Create' ) { - return ( $self->loc( "[_1] created", $obj_type ) ); + if (@code) { + ($template, @params) = $code[0]->($self); } - elsif ( $type eq 'Enabled' ) { - return ( $self->loc( "[_1] enabled", $obj_type ) ); + + unless ($template) { + ($template, @params) = ( + "Default: [_1]/[_2] changed from [_3] to [_4]", #loc + $type, + $field, + ( + $self->OldValue + ? "'" . $self->OldValue . "'" + : $self->loc("(no value)") + ), + ( + $self->NewValue + ? "'" . $self->NewValue . "'" + : $self->loc("(no value)") + ), + ); } - elsif ( $type eq 'Disabled' ) { - return ( $self->loc( "[_1] disabled", $obj_type ) ); + return $self->loc($template, $self->_ProcessReturnValues(@params)); +} + +sub _ProcessReturnValues { + my $self = shift; + my @values = @_; + return map { + if (ref eq 'ARRAY') { $_ = join "", $self->_ProcessReturnValues(@$_) } + elsif (ref eq 'SCALAR') { $_ = $$_ } + else { RT::Interface::Web::EscapeHTML(\$_) } + $_ + } @values; +} + +sub _FormatPrincipal { + my $self = shift; + my $principal = shift; + if ($principal->IsUser) { + return $self->_FormatUser( $principal->Object ); + } else { + return $self->loc("group [_1]", $principal->Object->Name); } - elsif ( $type =~ /Status/ ) { +} + +sub _FormatUser { + my $self = shift; + my $user = shift; + return [ + \'<span class="user" data-replace="user" data-user-id="', $user->id, \'">', + $user->Format, + \'</span>' + ]; +} + +%_BriefDescriptions = ( + Create => sub { + my $self = shift; + return ( "[_1] created", $self->FriendlyObjectType ); #loc() + }, + Enabled => sub { + my $self = shift; + return ( "[_1] enabled", $self->FriendlyObjectType ); #loc() + }, + Disabled => sub { + my $self = shift; + return ( "[_1] disabled", $self->FriendlyObjectType ); #loc() + }, + Status => sub { + my $self = shift; if ( $self->Field eq 'Status' ) { if ( $self->NewValue eq 'deleted' ) { - return ( $self->loc( "[_1] deleted", $obj_type ) ); + return ( "[_1] deleted", $self->FriendlyObjectType ); #loc() } else { - my $canon = $self->Object->can("QueueObj") - ? sub { $self->Object->QueueObj->Lifecycle->CanonicalCase(@_) } + my $canon = $self->Object->DOES("RT::Record::Role::Status") + ? sub { $self->Object->LifecycleObj->CanonicalCase(@_) } : sub { return $_[0] }; return ( - $self->loc( - "Status changed from [_1] to [_2]", - "'" . $self->loc( $canon->($self->OldValue) ) . "'", - "'" . $self->loc( $canon->($self->NewValue) ) . "'" - ) - ); - + "Status changed from [_1] to [_2]", + "'" . $self->loc( $canon->($self->OldValue) ) . "'", + "'" . $self->loc( $canon->($self->NewValue) ) . "'" + ); # loc() } } # Generic: my $no_value = $self->loc("(no value)"); return ( - $self->loc( - "[_1] changed from [_2] to [_3]", - $self->Field, - ( $self->OldValue ? "'" . $self->OldValue . "'" : $no_value ), - "'" . $self->NewValue . "'" - ) - ); - } - elsif ( $type =~ /SystemError/ ) { - return $self->loc("System error"); - } - elsif ( $type =~ /Forward Transaction/ ) { - return $self->loc( "Forwarded Transaction #[_1] to [_2]", - $self->Field, $self->Data ); - } - elsif ( $type =~ /Forward Ticket/ ) { - return $self->loc( "Forwarded Ticket to [_1]", $self->Data ); - } - - if ( my $code = $_BriefDescriptions{$type} ) { - return $code->($self); - } + "[_1] changed from [_2] to [_3]", + $self->Field, + ( $self->OldValue ? "'" . $self->OldValue . "'" : $no_value ), + "'" . $self->NewValue . "'" + ); #loc() + }, + SystemError => sub { + my $self = shift; + return $self->Data // ("System error"); #loc() + }, + AttachmentTruncate => sub { + my $self = shift; + if ( defined $self->Data ) { + return ( "File '[_1]' truncated because its size ([_2] bytes) exceeded configured maximum size setting ([_3] bytes).", + $self->Data, $self->OldValue, $self->NewValue ); #loc() + } + else { + return ( "Content truncated because its size ([_1] bytes) exceeded configured maximum size setting ([_2] bytes).", + $self->OldValue, $self->NewValue ); #loc() + } + }, + AttachmentDrop => sub { + my $self = shift; + if ( defined $self->Data ) { + return ( "File '[_1]' dropped because its size ([_2] bytes) exceeded configured maximum size setting ([_3] bytes).", + $self->Data, $self->OldValue, $self->NewValue ); #loc() + } + else { + return ( "Content dropped because its size ([_1] bytes) exceeded configured maximum size setting ([_2] bytes).", + $self->OldValue, $self->NewValue ); #loc() + } + }, + AttachmentError => sub { + my $self = shift; + if ( defined $self->Data ) { + return ( "File '[_1]' insert failed. See error log for details.", $self->Data ); #loc() + } + else { + return ( "Content insert failed. See error log for details." ); #loc() + } + }, + "Forward Transaction" => sub { + my $self = shift; + my $recipients = join ", ", map { + RT::User->Format( Address => $_, CurrentUser => $self->CurrentUser ) + } RT::EmailParser->ParseEmailAddress($self->Data); - return $self->loc( - "Default: [_1]/[_2] changed from [_3] to [_4]", - $type, - $self->Field, - ( - $self->OldValue - ? "'" . $self->OldValue . "'" - : $self->loc("(no value)") - ), - "'" . $self->NewValue . "'" - ); -} + return ( "Forwarded [_3]Transaction #[_1][_4] to [_2]", + $self->Field, $recipients, + [\'<a href="#txn-', $self->Field, \'">'], \'</a>'); #loc() + }, + "Forward Ticket" => sub { + my $self = shift; + my $recipients = join ", ", map { + RT::User->Format( Address => $_, CurrentUser => $self->CurrentUser ) + } RT::EmailParser->ParseEmailAddress($self->Data); -%_BriefDescriptions = ( + return ( "Forwarded Ticket to [_1]", $recipients ); #loc() + }, CommentEmailRecord => sub { my $self = shift; - return $self->loc("Outgoing email about a comment recorded"); + return ("Outgoing email about a comment recorded"); #loc() }, EmailRecord => sub { my $self = shift; - return $self->loc("Outgoing email recorded"); + return ("Outgoing email recorded"); #loc() }, Correspond => sub { my $self = shift; - return $self->loc("Correspondence added"); + return ("Correspondence added"); #loc() }, Comment => sub { my $self = shift; - return $self->loc("Comments added"); + return ("Comments added"); #loc() }, CustomField => sub { my $self = shift; @@ -839,22 +1020,22 @@ sub BriefDescription { } if ( !defined($old) || $old eq '' ) { - return $self->loc("[_1] [_2] added", $field, $new); + return ("[_1] [_2] added", $field, $new); #loc() } elsif ( !defined($new) || $new eq '' ) { - return $self->loc("[_1] [_2] deleted", $field, $old); + return ("[_1] [_2] deleted", $field, $old); #loc() } else { - return $self->loc("[_1] [_2] changed to [_3]", $field, $old, $new); + return ("[_1] [_2] changed to [_3]", $field, $old, $new); #loc() } }, Untake => sub { my $self = shift; - return $self->loc("Untaken"); + return ("Untaken"); #loc() }, Take => sub { my $self = shift; - return $self->loc("Taken"); + return ("Taken"); #loc() }, Force => sub { my $self = shift; @@ -863,35 +1044,42 @@ sub BriefDescription { my $New = RT::User->new( $self->CurrentUser ); $New->Load( $self->NewValue ); - return $self->loc("Owner forcibly changed from [_1] to [_2]" , $Old->Name , $New->Name); + return ("Owner forcibly changed from [_1] to [_2]", + map { $self->_FormatUser($_) } $Old, $New); #loc() }, Steal => sub { my $self = shift; my $Old = RT::User->new( $self->CurrentUser ); $Old->Load( $self->OldValue ); - return $self->loc("Stolen from [_1]", $Old->Name); + return ("Stolen from [_1]", $self->_FormatUser($Old)); #loc() }, Give => sub { my $self = shift; my $New = RT::User->new( $self->CurrentUser ); $New->Load( $self->NewValue ); - return $self->loc( "Given to [_1]", $New->Name ); + return ( "Given to [_1]", $self->_FormatUser($New)); #loc() }, AddWatcher => sub { my $self = shift; my $principal = RT::Principal->new($self->CurrentUser); $principal->Load($self->NewValue); - return $self->loc( "[_1] [_2] added", $self->Field, $principal->Object->Name); + return ( "[_1] [_2] added", $self->loc($self->Field), $self->_FormatPrincipal($principal)); #loc() }, DelWatcher => sub { my $self = shift; my $principal = RT::Principal->new($self->CurrentUser); $principal->Load($self->OldValue); - return $self->loc( "[_1] [_2] deleted", $self->Field, $principal->Object->Name); + return ( "[_1] [_2] deleted", $self->loc($self->Field), $self->_FormatPrincipal($principal)); #loc() + }, + SetWatcher => sub { + my $self = shift; + my $principal = RT::Principal->new($self->CurrentUser); + $principal->Load($self->NewValue); + return ( "[_1] set to [_2]", $self->loc($self->Field), $self->_FormatPrincipal($principal)); #loc() }, Subject => sub { my $self = shift; - return $self->loc( "Subject changed to [_1]", $self->Data ); + return ( "Subject changed to [_1]", $self->Data ); #loc() }, AddLink => sub { my $self = shift; @@ -899,36 +1087,40 @@ sub BriefDescription { if ( $self->NewValue ) { my $URI = RT::URI->new( $self->CurrentUser ); if ( $URI->FromURI( $self->NewValue ) ) { - $value = $URI->Resolver->AsString; + $value = [ + \'<a href="', $URI->AsHREF, \'">', + $URI->AsString, + \'</a>' + ]; } else { $value = $self->NewValue; } + if ( $self->Field eq 'DependsOn' ) { - return $self->loc( "Dependency on [_1] added", $value ); + return ( "Dependency on [_1] added", $value ); #loc() } elsif ( $self->Field eq 'DependedOnBy' ) { - return $self->loc( "Dependency by [_1] added", $value ); - + return ( "Dependency by [_1] added", $value ); #loc() } elsif ( $self->Field eq 'RefersTo' ) { - return $self->loc( "Reference to [_1] added", $value ); + return ( "Reference to [_1] added", $value ); #loc() } elsif ( $self->Field eq 'ReferredToBy' ) { - return $self->loc( "Reference by [_1] added", $value ); + return ( "Reference by [_1] added", $value ); #loc() } elsif ( $self->Field eq 'MemberOf' ) { - return $self->loc( "Membership in [_1] added", $value ); + return ( "Membership in [_1] added", $value ); #loc() } elsif ( $self->Field eq 'HasMember' ) { - return $self->loc( "Member [_1] added", $value ); + return ( "Member [_1] added", $value ); #loc() } elsif ( $self->Field eq 'MergedInto' ) { - return $self->loc( "Merged into [_1]", $value ); + return ( "Merged into [_1]", $value ); #loc() } } else { - return ( $self->Data ); + return ( "[_1]", $self->Data ); #loc() } }, DeleteLink => sub { @@ -936,35 +1128,38 @@ sub BriefDescription { my $value; if ( $self->OldValue ) { my $URI = RT::URI->new( $self->CurrentUser ); - if ( $URI->FromURI( $self->OldValue ) ){ - $value = $URI->Resolver->AsString; + if ( $URI->FromURI( $self->OldValue ) ) { + $value = [ + \'<a href="', $URI->AsHREF, \'">', + $URI->AsString, + \'</a>' + ]; } else { $value = $self->OldValue; } if ( $self->Field eq 'DependsOn' ) { - return $self->loc( "Dependency on [_1] deleted", $value ); + return ( "Dependency on [_1] deleted", $value ); #loc() } elsif ( $self->Field eq 'DependedOnBy' ) { - return $self->loc( "Dependency by [_1] deleted", $value ); - + return ( "Dependency by [_1] deleted", $value ); #loc() } elsif ( $self->Field eq 'RefersTo' ) { - return $self->loc( "Reference to [_1] deleted", $value ); + return ( "Reference to [_1] deleted", $value ); #loc() } elsif ( $self->Field eq 'ReferredToBy' ) { - return $self->loc( "Reference by [_1] deleted", $value ); + return ( "Reference by [_1] deleted", $value ); #loc() } elsif ( $self->Field eq 'MemberOf' ) { - return $self->loc( "Membership in [_1] deleted", $value ); + return ( "Membership in [_1] deleted", $value ); #loc() } elsif ( $self->Field eq 'HasMember' ) { - return $self->loc( "Member [_1] deleted", $value ); + return ( "Member [_1] deleted", $value ); #loc() } } else { - return ( $self->Data ); + return ( "[_1]", $self->Data ); #loc() } }, Told => sub { @@ -974,26 +1169,26 @@ sub BriefDescription { $t1->Set(Format => 'ISO', Value => $self->NewValue); my $t2 = RT::Date->new($self->CurrentUser); $t2->Set(Format => 'ISO', Value => $self->OldValue); - return $self->loc( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString ); + return ( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString ); #loc() } else { - return $self->loc( "[_1] changed from [_2] to [_3]", - $self->loc($self->Field), - ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")) , "'". $self->NewValue."'" ); + return ( "[_1] changed from [_2] to [_3]", + $self->loc($self->Field), + ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")) , "'". $self->NewValue."'" ); #loc() } }, Set => sub { my $self = shift; if ( $self->Field eq 'Password' ) { - return $self->loc('Password changed'); + return ('Password changed'); #loc() } elsif ( $self->Field eq 'Queue' ) { my $q1 = RT::Queue->new( $self->CurrentUser ); $q1->Load( $self->OldValue ); my $q2 = RT::Queue->new( $self->CurrentUser ); $q2->Load( $self->NewValue ); - return $self->loc("[_1] changed from [_2] to [_3]", - $self->loc($self->Field) , $q1->Name , $q2->Name); + return ("[_1] changed from [_2] to [_3]", + $self->loc($self->Field) , $q1->Name , $q2->Name); #loc() } # Write the date/time change at local time: @@ -1002,7 +1197,7 @@ sub BriefDescription { $t1->Set(Format => 'ISO', Value => $self->NewValue); my $t2 = RT::Date->new($self->CurrentUser); $t2->Set(Format => 'ISO', Value => $self->OldValue); - return $self->loc( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString ); + return ( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString ); #loc() } elsif ( $self->Field eq 'Owner' ) { my $Old = RT::User->new( $self->CurrentUser ); @@ -1012,62 +1207,89 @@ sub BriefDescription { if ( $Old->id == RT->Nobody->id ) { if ( $New->id == $self->Creator ) { - return $self->loc("Taken"); + return ("Taken"); #loc() } else { - return $self->loc( "Given to [_1]", $New->Name ); + return ( "Given to [_1]", $self->_FormatUser($New) ); #loc() } } else { if ( $New->id == $self->Creator ) { - return $self->loc("Stolen from [_1]", $Old->Name); + return ("Stolen from [_1]", $self->_FormatUser($Old) ); #loc() } elsif ( $Old->id == $self->Creator ) { if ( $New->id == RT->Nobody->id ) { - return $self->loc("Untaken"); + return ("Untaken"); #loc() } else { - return $self->loc( "Given to [_1]", $New->Name ); + return ( "Given to [_1]", $self->_FormatUser($New) ); #loc() } } else { - return $self->loc( + return ( "Owner forcibly changed from [_1] to [_2]", - $Old->Name, $New->Name ); + map { $self->_FormatUser($_) } $Old, $New + ); #loc() } } } else { - return $self->loc( "[_1] changed from [_2] to [_3]", - $self->loc($self->Field), - ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")), - ($self->NewValue? "'".$self->NewValue ."'" : $self->loc("(no value)"))); + return ( "[_1] changed from [_2] to [_3]", + $self->loc($self->Field), + ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")), + ($self->NewValue? "'".$self->NewValue ."'" : $self->loc("(no value)"))); #loc() + } + }, + "Set-TimeWorked" => sub { + my $self = shift; + my $old = $self->OldValue || 0; + my $new = $self->NewValue || 0; + my $duration = $new - $old; + if ($duration < 0) { + return ("Adjusted time worked by [quant,_1,minute,minutes]", $duration); # loc() + } + elsif ($duration < 60) { + return ("Worked [quant,_1,minute,minutes]", $duration); # loc() + } else { + return ("Worked [quant,_1,hour,hours] ([quant,_2,minute,minutes])", sprintf("%.1f", $duration / 60), $duration); # loc() } }, PurgeTransaction => sub { my $self = shift; - return $self->loc("Transaction [_1] purged", $self->Data); + return ("Transaction [_1] purged", $self->Data); #loc() }, AddReminder => sub { my $self = shift; my $ticket = RT::Ticket->new($self->CurrentUser); $ticket->Load($self->NewValue); - return $self->loc("Reminder '[_1]' added", $ticket->Subject); + my $subject = [ + \'<a href="', RT->Config->Get('WebPath'), + "/Ticket/Reminders.html?id=", $self->ObjectId, + "#reminder-", $ticket->id, \'">', $ticket->Subject, \'</a>' + ]; + return ("Reminder '[_1]' added", $subject); #loc() }, OpenReminder => sub { my $self = shift; my $ticket = RT::Ticket->new($self->CurrentUser); $ticket->Load($self->NewValue); - return $self->loc("Reminder '[_1]' reopened", $ticket->Subject); - + my $subject = [ + \'<a href="', RT->Config->Get('WebPath'), + "/Ticket/Reminders.html?id=", $self->ObjectId, + "#reminder-", $ticket->id, \'">', $ticket->Subject, \'</a>' + ]; + return ("Reminder '[_1]' reopened", $subject); #loc() }, ResolveReminder => sub { my $self = shift; my $ticket = RT::Ticket->new($self->CurrentUser); $ticket->Load($self->NewValue); - return $self->loc("Reminder '[_1]' completed", $ticket->Subject); - - + my $subject = [ + \'<a href="', RT->Config->Get('WebPath'), + "/Ticket/Reminders.html?id=", $self->ObjectId, + "#reminder-", $ticket->id, \'">', $ticket->Subject, \'</a>' + ]; + return ("Reminder '[_1]' completed", $subject); #loc() } ); @@ -1132,23 +1354,6 @@ sub _Value { } - -=head2 CurrentUserHasRight RIGHT - -Calls $self->CurrentUser->HasQueueRight for the right passed in here. -passed in here. - -=cut - -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - return $self->CurrentUser->HasRight( - Right => $right, - Object => $self->Object - ); -} - =head2 CurrentUserCanSee Returns true if current user has rights to see this particular transaction. @@ -1157,31 +1362,18 @@ This fact depends on type of the transaction, type of an object the transaction is attached to and may be other conditions, so this method is prefered over custom implementations. +It always returns true if current user is system user. + =cut sub CurrentUserCanSee { my $self = shift; - # If it's a comment, we need to be extra special careful - my $type = $self->__Value('Type'); - if ( $type eq 'Comment' ) { - unless ( $self->CurrentUserHasRight('ShowTicketComments') ) { - return 0; - } - } - elsif ( $type eq 'CommentEmailRecord' ) { - unless ( $self->CurrentUserHasRight('ShowTicketComments') - && $self->CurrentUserHasRight('ShowOutgoingEmail') ) { - return 0; - } - } - elsif ( $type eq 'EmailRecord' ) { - unless ( $self->CurrentUserHasRight('ShowOutgoingEmail') ) { - return 0; - } - } + return 1 if $self->CurrentUser->PrincipalObj->Id == RT->SystemUser->Id; + # Make sure the user can see the custom field before showing that it changed - elsif ( $type eq 'CustomField' and my $cf_id = $self->__Value('Field') ) { + my $type = $self->__Value('Type'); + if ( $type eq 'CustomField' and my $cf_id = $self->__Value('Field') ) { my $cf = RT::CustomField->new( $self->CurrentUser ); $cf->SetContextObject( $self->Object ); $cf->Load( $cf_id ); @@ -1193,7 +1385,7 @@ sub CurrentUserCanSee { return 1 if $self->{ _object_is_readable }; # Defer to the object in question - return $self->Object->CurrentUserCanSee("Transaction"); + return $self->Object->CurrentUserCanSee("Transaction", $self); } @@ -1209,11 +1401,7 @@ sub TicketObj { sub OldValue { my $self = shift; - if ( my $type = $self->__Value('ReferenceType') - and my $id = $self->__Value('OldReference') ) - { - my $Object = $type->new($self->CurrentUser); - $Object->Load( $id ); + if ( my $Object = $self->OldReferenceObject ) { return $Object->Content; } else { @@ -1223,11 +1411,7 @@ sub OldValue { sub NewValue { my $self = shift; - if ( my $type = $self->__Value('ReferenceType') - and my $id = $self->__Value('NewReference') ) - { - my $Object = $type->new($self->CurrentUser); - $Object->Load( $id ); + if ( my $Object = $self->NewReferenceObject ) { return $Object->Content; } else { @@ -1242,22 +1426,53 @@ sub Object { return $Object; } +=head2 NewReferenceObject + +=head2 OldReferenceObject + +Returns an object of the class specified by the column C<ReferenceType> and +loaded with the id specified by the column C<NewReference> or C<OldReference>. +C<ReferenceType> is assumed to be an L<RT::Record> subclass. + +The object may be unloaded (check C<< $object->id >>) if the reference is +corrupt (such as if the referenced record was improperly deleted). + +Returns undef if either C<ReferenceType> or C<NewReference>/C<OldReference> is +false. + +=cut + +sub NewReferenceObject { $_[0]->_ReferenceObject("New") } +sub OldReferenceObject { $_[0]->_ReferenceObject("Old") } + +sub _ReferenceObject { + my $self = shift; + my $which = shift; + my $type = $self->__Value("ReferenceType"); + my $id = $self->__Value("${which}Reference"); + return unless $type and $id; + + my $object = $type->new($self->CurrentUser); + $object->Load( $id ); + return $object; +} + sub FriendlyObjectType { my $self = shift; - my $type = $self->ObjectType or return undef; - $type =~ s/^RT:://; - return $self->loc($type); + return $self->loc( $self->Object->RecordType ); } =head2 UpdateCustomFields - - Takes a hash of - CustomField-<<Id>> => Value - or +Takes a hash of: + + CustomField-C<Id> => Value - Object-RT::Transaction-CustomField-<<Id>> => Value parameters to update - this transaction's custom fields +or: + + Object-RT::Transaction-CustomField-C<Id> => Value + +parameters to update this transaction's custom fields. =cut @@ -1269,12 +1484,9 @@ sub UpdateCustomFields { # value "ARGSRef", which was a reference to a hash of arguments. # This was insane. The next few lines of code preserve that API # while giving us something saner. - - # TODO: 3.6: DEPRECATE OLD API - - my $args; - - if ($args{'ARGSRef'}) { + my $args; + if ($args{'ARGSRef'}) { + RT->Deprecated( Arguments => "ARGSRef", Remove => "4.4" ); $args = $args{ARGSRef}; } else { $args = \%args; @@ -1288,6 +1500,8 @@ sub UpdateCustomFields { next if $arg =~ /-TimeUnits$/; my $cfid = $1; my $values = $args->{$arg}; + my $cf = $self->LoadCustomFieldByIdentifier($cfid); + next unless $cf->ObjectTypeFromLookupType($cf->__Value('LookupType'))->isa(ref $self); foreach my $value ( UNIVERSAL::isa( $values, 'ARRAY' ) ? @$values : $values ) { @@ -1321,7 +1535,7 @@ sub LoadCustomFieldByIdentifier { my $CFs = RT::CustomFields->new( $self->CurrentUser ); $CFs->SetContextObject( $self->Object ); - $CFs->Limit( FIELD => 'Name', VALUE => $field ); + $CFs->Limit( FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0 ); $CFs->LimitToLookupType($self->CustomFieldLookupType); $CFs->LimitToGlobalOrObjectId($self->Object->QueueObj->id); return $CFs->First || RT::CustomField->new( $self->CurrentUser ); @@ -1694,37 +1908,182 @@ 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 => ''}, 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 => '0'}, + {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, TimeTaken => - {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'}, Type => - {read => 1, write => 1, sql_type => 12, length => 20, is_blob => 0, is_numeric => 0, type => 'varchar(20)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 20, is_blob => 0, is_numeric => 0, type => 'varchar(20)', default => ''}, Field => - {read => 1, write => 1, sql_type => 12, length => 40, is_blob => 0, is_numeric => 0, type => 'varchar(40)', default => ''}, + {read => 1, write => 1, sql_type => 12, length => 40, is_blob => 0, is_numeric => 0, type => 'varchar(40)', default => ''}, OldValue => - {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 => ''}, NewValue => - {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 => ''}, ReferenceType => - {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 => ''}, OldReference => - {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 => ''}, NewReference => - {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 => ''}, Data => - {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 => ''}, 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->Object ); + $deps->Add( in => $self->Attachments ); + + my $type = $self->Type; + if ($type eq "CustomField") { + my $cf = RT::CustomField->new( RT->SystemUser ); + $cf->Load( $self->Field ); + $deps->Add( out => $cf ); + } elsif ($type =~ /^(Take|Untake|Force|Steal|Give)$/) { + for my $field (qw/OldValue NewValue/) { + my $user = RT::User->new( RT->SystemUser ); + $user->Load( $self->$field ); + $deps->Add( out => $user ); + } + } elsif ($type eq "DelWatcher") { + my $principal = RT::Principal->new( RT->SystemUser ); + $principal->Load( $self->OldValue ); + $deps->Add( out => $principal->Object ); + } elsif ($type eq "AddWatcher") { + my $principal = RT::Principal->new( RT->SystemUser ); + $principal->Load( $self->NewValue ); + $deps->Add( out => $principal->Object ); + } elsif ($type eq "DeleteLink") { + if ($self->OldValue) { + my $base = RT::URI->new( $self->CurrentUser ); + $base->FromURI( $self->OldValue ); + $deps->Add( out => $base->Object ) if $base->Resolver and $base->Object; + } + } elsif ($type eq "AddLink") { + if ($self->NewValue) { + my $base = RT::URI->new( $self->CurrentUser ); + $base->FromURI( $self->NewValue ); + $deps->Add( out => $base->Object ) if $base->Resolver and $base->Object; + } + } elsif ($type eq "Set" and $self->Field eq "Queue") { + for my $field (qw/OldValue NewValue/) { + my $queue = RT::Queue->new( RT->SystemUser ); + $queue->Load( $self->$field ); + $deps->Add( out => $queue ); + } + } elsif ($type =~ /^(Add|Open|Resolve)Reminder$/) { + my $ticket = RT::Ticket->new( RT->SystemUser ); + $ticket->Load( $self->NewValue ); + $deps->Add( out => $ticket ); + } +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $self->Attachments, + Shredder => $args{'Shredder'} + ); + + return $self->SUPER::__DependsOn( %args ); +} + +sub Serialize { + my $self = shift; + my %args = (@_); + my %store = $self->SUPER::Serialize(@_); + + my $type = $store{Type}; + if ($type eq "CustomField") { + my $cf = RT::CustomField->new( RT->SystemUser ); + $cf->Load( $store{Field} ); + $store{Field} = \($cf->UID); + } elsif ($type =~ /^(Take|Untake|Force|Steal|Give)$/) { + for my $field (qw/OldValue NewValue/) { + my $user = RT::User->new( RT->SystemUser ); + $user->Load( $store{$field} ); + $store{$field} = \($user->UID); + } + } elsif ($type eq "DelWatcher") { + my $principal = RT::Principal->new( RT->SystemUser ); + $principal->Load( $store{OldValue} ); + $store{OldValue} = \($principal->UID); + } elsif ($type eq "AddWatcher") { + my $principal = RT::Principal->new( RT->SystemUser ); + $principal->Load( $store{NewValue} ); + $store{NewValue} = \($principal->UID); + } elsif ($type eq "DeleteLink") { + if ($store{OldValue}) { + my $base = RT::URI->new( $self->CurrentUser ); + $base->FromURI( $store{OldValue} ); + $store{OldValue} = \($base->Object->UID) if $base->Resolver and $base->Object; + } + } elsif ($type eq "AddLink") { + if ($store{NewValue}) { + my $base = RT::URI->new( $self->CurrentUser ); + $base->FromURI( $store{NewValue} ); + $store{NewValue} = \($base->Object->UID) if $base->Resolver and $base->Object; + } + } elsif ($type eq "Set" and $store{Field} eq "Queue") { + for my $field (qw/OldValue NewValue/) { + my $queue = RT::Queue->new( RT->SystemUser ); + $queue->Load( $store{$field} ); + $store{$field} = \($queue->UID); + } + } elsif ($type =~ /^(Add|Open|Resolve)Reminder$/) { + my $ticket = RT::Ticket->new( RT->SystemUser ); + $ticket->Load( $store{NewValue} ); + $store{NewValue} = \($ticket->UID); + } + + return %store; +} + +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); + } + + if ($data->{Type} eq "DeleteLink" and ref $data->{OldValue}) { + my $uid = ${ $data->{OldValue} }; + my $obj = $importer->LookupObj( $uid ); + $data->{OldValue} = $obj->URI; + } elsif ($data->{Type} eq "AddLink" and ref $data->{NewValue}) { + my $uid = ${ $data->{NewValue} }; + my $obj = $importer->LookupObj( $uid ); + $data->{NewValue} = $obj->URI; + } + + return $class->SUPER::PreInflate( $importer, $uid, $data ); +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Transactions.pm b/rt/lib/RT/Transactions.pm index 9c359c0..6794e52 100755 --- a/rt/lib/RT/Transactions.pm +++ b/rt/lib/RT/Transactions.pm @@ -69,11 +69,10 @@ package RT::Transactions; use strict; use warnings; +use base 'RT::SearchBuilder'; use RT::Transaction; -use base 'RT::SearchBuilder'; - sub Table { 'Transactions'} # {{{ sub _Init @@ -85,9 +84,9 @@ sub _Init { # By default, order by the date of the transaction, rather than ID. $self->OrderByCols( { FIELD => 'Created', - ORDER => 'ASC' }, - { FIELD => 'id', - ORDER => 'ASC' } ); + ORDER => 'ASC' }, + { FIELD => 'id', + ORDER => 'ASC' } ); return ( $self->SUPER::_Init(@_)); } @@ -109,11 +108,10 @@ sub LimitToTicket { my $tid = shift; unless ( $self->{'tickets_table'} ) { - $self->{'tickets_table'} ||= $self->NewAlias('Tickets'); - $self->Join( + $self->{'tickets_table'} ||= $self->Join( ALIAS1 => 'main', FIELD1 => 'ObjectId', - ALIAS2 => $self->{'tickets_table'}, + TABLE2 => 'Tickets', FIELD2 => 'id' ); $self->Limit( @@ -140,20 +138,6 @@ sub AddRecord { return $self->SUPER::AddRecord($record); } - - - - -=head2 NewItem - -Returns an empty new RT::Transaction item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Transaction->new($self->CurrentUser)); -} RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/URI.pm b/rt/lib/RT/URI.pm index 03cb892..30a096d 100644 --- a/rt/lib/RT/URI.pm +++ b/rt/lib/RT/URI.pm @@ -141,33 +141,33 @@ Returns true if everything is ok, otherwise false sub FromURI { my $self = shift; - my $uri = shift; + my $uri = shift; return undef unless ($uri); my $scheme; # Special case: integers passed in as URIs must be ticket ids if ($uri =~ /^(\d+)$/) { - $scheme = "fsck.com-rt"; + $scheme = "fsck.com-rt"; } elsif ($uri =~ /^((?!javascript|data)(?:\w|\.|-)+?):/i) { - $scheme = $1; + $scheme = $1; } else { $self->{resolver} = RT::URI::base->new( $self->CurrentUser ); # clear resolver $RT::Logger->warning("Could not determine a URI scheme for $uri"); return (undef); } - - # load up a resolver object for this scheme + + # load up a resolver object for this scheme $self->_GetResolver($scheme); - + unless ($self->Resolver->ParseURI($uri)) { $RT::Logger->warning( "Resolver " . ref( $self->Resolver ) . " could not parse $uri, maybe Organization config was changed?" ); $self->{resolver} = RT::URI::base->new( $self->CurrentUser ); # clear resolver - return (undef); + return (undef); } return(1); @@ -287,6 +287,17 @@ sub Resolver { return ($self->{'resolver'}); } +=head2 AsString + +Returns a friendly display form of the object if Local, or the full URI + +=cut + +sub AsString { + my $self = shift; + return $self->Resolver->AsString; +} + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/URI/a.pm b/rt/lib/RT/URI/a.pm index eca253f..baab658 100644 --- a/rt/lib/RT/URI/a.pm +++ b/rt/lib/RT/URI/a.pm @@ -51,8 +51,8 @@ package RT::URI::a; use strict; use warnings; -use RT::Article; use base qw/RT::URI::fsck_com_article/; +use RT::Article; my $scheme = "a"; @@ -71,11 +71,11 @@ sub ParseURI { # articles after stripping off the a: prefix. if ($uri =~ /^$scheme:(\d+)/) { - my $value = $1; - return $self->SUPER::ParseURI($value); + my $value = $1; + return $self->SUPER::ParseURI($value); } else { - $self->{'uri'} = $uri; - return undef; + $self->{'uri'} = $uri; + return undef; } } diff --git a/rt/lib/RT/URI/fsck_com_article.pm b/rt/lib/RT/URI/fsck_com_article.pm index 580bccd..7132770 100644 --- a/rt/lib/RT/URI/fsck_com_article.pm +++ b/rt/lib/RT/URI/fsck_com_article.pm @@ -52,8 +52,8 @@ use strict; use warnings; no warnings 'redefine'; -use RT::Article; use base qw/RT::URI::base/; +use RT::Article; =head2 LocalURIPrefix @@ -63,8 +63,7 @@ Returns the prefix for a local article URI sub LocalURIPrefix { my $self = shift; - my $prefix = $self->Scheme. "://". RT->Config->Get('Organization') - . "/article/"; + my $prefix = $self->Scheme. "://". RT->Config->Get('Organization'); return ($prefix); } @@ -79,7 +78,7 @@ sub URIForObject { my $self = shift; my $obj = shift; - return ($self->LocalURIPrefix. $obj->Id); + return ($self->LocalURIPrefix . "/article/" . $obj->Id); } @@ -100,39 +99,45 @@ sub ParseURI { my $self = shift; my $uri = shift; - my $article; - - if ($uri =~ /^(\d+)$/) { - $article = RT::Article->new($self->CurrentUser); - $article->Load($uri); - $self->{'uri'} = $article->URI; - } - else { - $self->{'uri'} = $uri; - } - + my $article; + + if ($uri =~ /^(\d+)$/) { + $article = RT::Article->new($self->CurrentUser); + $article->Load($uri); + $self->{'uri'} = $article->URI; + } + else { + $self->{'uri'} = $uri; + } + #If it's a local URI, load the article object and return its URI if ( $self->IsLocal) { - my $local_uri_prefix = $self->LocalURIPrefix; - if ($self->{'uri'} =~ /^$local_uri_prefix(\d+)$/) { - my $id = $1; - - - $article = RT::Article->new( $self->CurrentUser ); - $article->Load($id); - - #If we couldn't find a article, return undef. - unless ( defined $article->Id ) { - return undef; - } - } else { - return undef; - } + if ($self->{'uri'} =~ /^$local_uri_prefix\/article\/(\d+)$/) { + my $id = $1; + $article = RT::Article->new( $self->CurrentUser ); + my ($ret, $msg) = $article->Load($id); + + #If we couldn't find a article, return undef. + unless ( $article and $article->Id ) { + # We got an id, but couldn't load it, so warn that it may + # have been deleted. + RT::Logger->warning("Unable to load article for id $id. It may" + . " have been deleted: $msg"); + return undef; + } + } else { + return undef; + } + } + + #If we couldn't find a article, return undef. + unless ( $article and $article->Id ) { + return undef; } - - $self->{'object'} = $article; - return ($article->Id); + + $self->{'object'} = $article; + return ($article->Id); } =head2 IsLocal @@ -143,14 +148,14 @@ Returns undef otherwise. =cut sub IsLocal { - my $self = shift; - my $local_uri_prefix = $self->LocalURIPrefix; - if ($self->{'uri'} =~ /^$local_uri_prefix/) { - return 1; + my $self = shift; + my $local_uri_prefix = $self->LocalURIPrefix; + if ($self->{'uri'} =~ /^$local_uri_prefix/) { + return 1; + } + else { + return undef; } - else { - return undef; - } } @@ -175,7 +180,7 @@ Return the URI scheme for RT articles sub Scheme { my $self = shift; - return "fsck.com-article"; + return "fsck.com-article"; } =head2 HREF @@ -203,9 +208,12 @@ Return "Article 23" sub AsString { my $self = shift; - if ($self->IsLocal && $self->Object) { - return $self->loc('Article [_1]', $self->Object->id); - + if ($self->IsLocal && ( my $object = $self->Object )) { + if ( $object->Name ) { + return $self->loc('Article #[_1]: [_2]', $object->id, $object->Name); + } else { + return $self->loc('Article #[_1]', $object->id); + } } else { return $self->SUPER::AsString(@_); } diff --git a/rt/lib/RT/URI/fsck_com_rt.pm b/rt/lib/RT/URI/fsck_com_rt.pm index 0a9001e..053268f 100644 --- a/rt/lib/RT/URI/fsck_com_rt.pm +++ b/rt/lib/RT/URI/fsck_com_rt.pm @@ -209,14 +209,26 @@ sub HREF { =head2 AsString -Returns either a localized string 'ticket #23' or the full URI if the object is not local +Returns either a localized string C<#23: Subject> for tickets, C<ObjectType #13: +Name> for other object types (not really used), or the full URI if the object +is not local. =cut sub AsString { my $self = shift; - if ($self->IsLocal && $self->Object) { - return $self->loc("[_1] #[_2]", $self->ObjectType, $self->Object->Id); + if ($self->IsLocal && ( my $object = $self->Object )) { + if ($object->isa('RT::Ticket')) { + return $self->loc("#[_1]: [_2]", $object->Id, $object->Subject || ''); + } else { + my $name = $object->_Accessible('Name', 'read') ? $object->Name : undef; + + if ( defined $name and length $name ) { + return $self->loc("[_1] #[_2]: [_3]", $self->ObjectType, $object->Id, $name); + } else { + return $self->loc("[_1] #[_2]", $self->ObjectType, $object->Id); + } + } } else { return $self->URI; diff --git a/rt/lib/RT/User.pm b/rt/lib/RT/User.pm index 1859d3f..b8a51f0 100755 --- a/rt/lib/RT/User.pm +++ b/rt/lib/RT/User.pm @@ -66,6 +66,7 @@ package RT::User; use strict; use warnings; +use Scalar::Util qw(blessed); use base 'RT::Record'; @@ -78,6 +79,7 @@ sub Table {'Users'} use Digest::SHA; use Digest::MD5; +use Crypt::Eksblowfish::Bcrypt qw(); use RT::Principals; use RT::ACE; use RT::Interface::Email; @@ -86,22 +88,25 @@ use Text::Password::Pronounceable; sub _OverlayAccessible { { - Name => { public => 1, admin => 1 }, + Name => { public => 1, admin => 1 }, # loc_left_pair Password => { read => 0 }, - EmailAddress => { public => 1 }, - Organization => { public => 1, admin => 1 }, - RealName => { public => 1 }, - NickName => { public => 1 }, - Lang => { public => 1 }, + EmailAddress => { public => 1 }, # loc_left_pair + Organization => { public => 1, admin => 1 }, # loc_left_pair + RealName => { public => 1 }, # loc_left_pair + NickName => { public => 1 }, # loc_left_pair + Lang => { public => 1 }, # loc_left_pair EmailEncoding => { public => 1 }, WebEncoding => { public => 1 }, ExternalContactInfoId => { public => 1, admin => 1 }, ContactInfoSystem => { public => 1, admin => 1 }, ExternalAuthId => { public => 1, admin => 1 }, AuthSystem => { public => 1, admin => 1 }, - Gecos => { public => 1, admin => 1 }, - PGPKey => { public => 1, admin => 1 }, - + Gecos => { public => 1, admin => 1 }, # loc_left_pair + PGPKey => { public => 1, admin => 1 }, # loc_left_pair + SMIMECertificate => { public => 1, admin => 1 }, # loc_left_pair + City => { public => 1 }, # loc_left_pair + Country => { public => 1 }, # loc_left_pair + Timezone => { public => 1 }, # loc_left_pair } } @@ -296,7 +301,7 @@ sub ValidatePassword { my $password = shift; if ( length($password) < RT->Config->Get('MinimumPasswordLength') ) { - return ( 0, $self->loc("Password needs to be at least [_1] characters long", RT->Config->Get('MinimumPasswordLength')) ); + return ( 0, $self->loc("Password needs to be at least [quant,_1,character,characters] long", RT->Config->Get('MinimumPasswordLength')) ); } return 1; @@ -549,8 +554,8 @@ sub LoadOrCreateByEmail { } } } - return (0, $message) unless $self->id; - return ($self->Id, $message); + return wantarray ? (0, $message) : 0 unless $self->id; + return wantarray ? ($self->Id, $message) : $self->Id; } =head2 ValidateEmailAddress ADDRESS @@ -628,25 +633,13 @@ sub SetEmailAddress { =head2 EmailFrequency -Takes optional Ticket argument in paramhash. Returns 'no email', -'squelched', 'daily', 'weekly' or empty string depending on -user preferences. - -=over 4 - -=item 'no email' - user has no email, so can not recieve notifications. - -=item 'squelched' - returned only when Ticket argument is provided and -notifications to the user has been supressed for this ticket. - -=item 'daily' - retruned when user recieve daily messages digest instead -of immediate delivery. - -=item 'weekly' - previous, but weekly. +Takes optional Ticket argument in paramhash. Returns a string, suitable +for localization, describing any notable properties about email delivery +to the user. This includes lack of email address, ticket-level +squelching (if C<Ticket> is provided in the paramhash), or user email +delivery preferences. -=item empty string returned otherwise. - -=back +Returns the empty string if there are no notable properties. =cut @@ -658,12 +651,18 @@ sub EmailFrequency { ); return '' unless $self->id && $self->id != RT->Nobody->id && $self->id != RT->SystemUser->id; - return 'no email address' unless my $email = $self->EmailAddress; - return 'email disabled for ticket' if $args{'Ticket'} && - grep lc $email eq lc $_->Content, $args{'Ticket'}->SquelchMailTo; + return 'no email address set' # loc + unless my $email = $self->EmailAddress; + return 'email disabled for ticket' # loc + if $args{'Ticket'} && + grep lc $email eq lc $_->Content, $args{'Ticket'}->SquelchMailTo; my $frequency = RT->Config->Get( 'EmailFrequency', $self ) || ''; - return 'daily' if $frequency =~ /daily/i; - return 'weekly' if $frequency =~ /weekly/i; + return 'receives daily digests' # loc + if $frequency =~ /daily/i; + return 'receives weekly digests' # loc + if $frequency =~ /weekly/i; + return 'email delivery suspended' # loc + if $frequency =~ /suspend/i; return ''; } @@ -865,6 +864,39 @@ sub SetPassword { } +sub _GeneratePassword_bcrypt { + my $self = shift; + my ($password, @rest) = @_; + + my $salt; + my $rounds; + if (@rest) { + # The first split is the number of rounds + $rounds = $rest[0]; + + # The salt is the first 22 characters, b64 encoded usign the + # special bcrypt base64. + $salt = Crypt::Eksblowfish::Bcrypt::de_base64( substr($rest[1], 0, 22) ); + } else { + $rounds = RT->Config->Get('BcryptCost'); + + # Generate a random 16-octet base64 salt + $salt = ""; + $salt .= pack("C", int rand(256)) for 1..16; + } + + my $hash = Crypt::Eksblowfish::Bcrypt::bcrypt_hash({ + key_nul => 1, + cost => $rounds, + salt => $salt, + }, Digest::SHA::sha512( Encode::encode( 'UTF-8', $password) ) ); + + return join("!", "", "bcrypt", sprintf("%02d", $rounds), + Crypt::Eksblowfish::Bcrypt::en_base64( $salt ). + Crypt::Eksblowfish::Bcrypt::en_base64( $hash ) + ); +} + sub _GeneratePassword_sha512 { my $self = shift; my ($password, $salt) = @_; @@ -888,13 +920,13 @@ Returns a string to store in the database. This string takes the form: !method!salt!hash -By default, the method is currently C<sha512>. +By default, the method is currently C<bcrypt>. =cut sub _GeneratePassword { my $self = shift; - return $self->_GeneratePassword_sha512(@_); + return $self->_GeneratePassword_bcrypt(@_); } =head3 HasPassword @@ -943,9 +975,13 @@ sub IsPassword { my $stored = $self->__Value('Password'); if ($stored =~ /^!/) { # If it's a new-style (>= RT 4.0) password, it starts with a '!' - my (undef, $method, $salt, undef) = split /!/, $stored; - if ($method eq "sha512") { - return $self->_GeneratePassword_sha512($value, $salt) eq $stored; + my (undef, $method, @rest) = split /!/, $stored; + if ($method eq "bcrypt") { + return 0 unless $self->_GeneratePassword_bcrypt($value, @rest) eq $stored; + # Upgrade to a larger number of rounds if necessary + return 1 unless $rest[0] < RT->Config->Get('BcryptCost'); + } elsif ($method eq "sha512") { + return 0 unless $self->_GeneratePassword_sha512($value, @rest) eq $stored; } else { $RT::Logger->warn("Unknown hash method $method"); return 0; @@ -986,8 +1022,8 @@ sub CurrentUserRequireToSetPassword { RequireCurrent => 1, ); - if ( RT->Config->Get('WebExternalAuth') - && !RT->Config->Get('WebFallbackToInternalAuth') + if ( RT->Config->Get('WebRemoteUserAuth') + && !RT->Config->Get('WebFallbackToRTLogin') ) { $res{'CanSet'} = 0; $res{'Reason'} = $self->loc("External authentication enabled."); @@ -1092,11 +1128,11 @@ sub SetDisabled { } $RT::Handle->BeginTransaction(); - my $set_err = $self->PrincipalObj->SetDisabled($val); - unless ($set_err) { + my ($status, $msg) = $self->PrincipalObj->SetDisabled($val); + unless ($status) { $RT::Handle->Rollback(); $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id)); - return (undef); + return ($status, $msg); } $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" ); @@ -1247,26 +1283,29 @@ public, ourself, or we have AdminUsers sub CurrentUserCanSee { my $self = shift; - my ($what) = @_; + my ($what, $txn) = @_; - # If it's public, fine. Note that $what may be "transaction", which - # doesn't have an Accessible value, and thus falls through below. - if ( $self->_Accessible( $what, 'public' ) ) { - return 1; - } + # If it's a public property, fine + return 1 if $self->_Accessible( $what, 'public' ); - # Users can see their own properties - elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) { - return 1; - } + # Users can see all of their own properties + return 1 if defined($self->Id) and $self->CurrentUser->Id == $self->Id; # If the user has the admin users right, that's also enough - elsif ( $self->CurrentUser->HasRight( Right => 'AdminUsers', Object => $RT::System) ) { - return 1; - } - else { - return 0; + return 1 if $self->CurrentUserHasRight( 'AdminUsers' ); + + # Transactions of public properties are visible to users with ShowUserHistory + if ($what eq "Transaction" and $self->CurrentUserHasRight( 'ShowUserHistory' )) { + my $type = $txn->__Value('Type'); + my $field = $txn->__Value('Field'); + return 1 if $type eq "Set" and $self->CurrentUserCanSee($field, $txn); + + # RT::Transaction->CurrentUserCanSee deals with ensuring we meet + # the ACLs on CFs, so allow them here + return 1 if $type eq "CustomField"; } + + return 0; } =head2 CurrentUserCanModify RIGHT @@ -1326,7 +1365,7 @@ sub _PrefName { $name = ref($name).'-'.$name->Id; } - return 'Pref-'.$name; + return 'Pref-'. $name; } =head2 Preferences NAME/OBJ DEFAULT @@ -1339,7 +1378,7 @@ override the entries with user preferences. sub Preferences { my $self = shift; - my $name = _PrefName (shift); + my $name = _PrefName(shift); my $default = shift; my ($attr) = $self->Attributes->Named( $name ); @@ -1353,7 +1392,7 @@ sub Preferences { exists $content->{$_} or $content->{$_} = $default->{$_}; } } elsif (defined $default) { - $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not"); + $RT::Logger->error("Preferences $name for user #".$self->Id." is hash but default is not"); } return $content; } @@ -1415,10 +1454,8 @@ sub Stylesheet { my $style = RT->Config->Get('WebDefaultStylesheet', $self->CurrentUser); if (RT::Interface::Web->ComponentPathIsSafe($style)) { - my @css_paths = map { $_ . '/NoAuth/css' } RT::Interface::Web->ComponentRoots; - - for my $css_path (@css_paths) { - if (-d "$css_path/$style") { + for my $root (RT::Interface::Web->StaticRoots) { + if (-d "$root/css/$style") { return $style } } @@ -1459,12 +1496,13 @@ sub WatchedQueues { FIELD => 'Domain', VALUE => 'RT::Queue-Role', ENTRYAGGREGATOR => 'AND', + CASESENSITIVE => 0, ); if (grep { $_ eq 'Cc' } @roles) { $watched_queues->Limit( SUBCLAUSE => 'LimitToWatchers', ALIAS => $group_alias, - FIELD => 'Type', + FIELD => 'Name', VALUE => 'Cc', ENTRYAGGREGATOR => 'OR', ); @@ -1473,7 +1511,7 @@ sub WatchedQueues { $watched_queues->Limit( SUBCLAUSE => 'LimitToWatchers', ALIAS => $group_alias, - FIELD => 'Type', + FIELD => 'Name', VALUE => 'AdminCc', ENTRYAGGREGATOR => 'OR', ); @@ -1575,9 +1613,134 @@ Return the friendly name sub FriendlyName { my $self = shift; - return $self->RealName if defined($self->RealName); - return $self->Name if defined($self->Name); - return ""; + return $self->RealName if defined $self->RealName and length $self->RealName; + return $self->Name; +} + +=head2 Format + +Class or object method. + +Returns a string describing a user in the current user's preferred format. + +May be invoked in three ways: + + $UserObj->Format; + RT::User->Format( User => $UserObj ); # same as above + RT::User->Format( Address => $AddressObj, CurrentUser => $CurrentUserObj ); + +Possible arguments are: + +=over + +=item User + +An L<RT::User> object representing the user to format. Preferred to Address. + +=item Address + +An L<Email::Address> object representing the user address to format. Address +will be used to lookup an L<RT::User> if possible. + +=item CurrentUser + +Required when Format is called as a class method with an Address argument. +Otherwise, this argument is ignored in preference to the CurrentUser of the +involved L<RT::User> object. + +=item Format + +Specifies the format to use, overriding any set from the config or current +user's preferences. + +=back + +=cut + +sub Format { + my $self = shift; + my %args = ( + User => undef, + Address => undef, + CurrentUser => undef, + Format => undef, + @_ + ); + + if (blessed($self) and $self->id) { + @args{"User", "CurrentUser"} = ($self, $self->CurrentUser); + } + elsif ($args{User} and $args{User}->id) { + $args{CurrentUser} = $args{User}->CurrentUser; + } + elsif ($args{Address} and $args{CurrentUser}) { + $args{User} = RT::User->new( $args{CurrentUser} ); + $args{User}->LoadByEmail( $args{Address}->address ); + if ($args{User}->id) { + delete $args{Address}; + } else { + delete $args{User}; + } + } + else { + RT->Logger->warning("Invalid arguments to RT::User->Format at @{[join '/', caller]}"); + return ""; + } + + $args{Format} ||= RT->Config->Get("UsernameFormat", $args{CurrentUser}); + $args{Format} =~ s/[^A-Za-z0-9_]+//g; + + my $method = "_FormatUser" . ucfirst lc $args{Format}; + my $formatter = $self->can($method); + + unless ($formatter) { + RT->Logger->error( + "Either system config or user #" . $args{CurrentUser}->id . + " picked UsernameFormat $args{Format}, but RT::User->$method doesn't exist" + ); + $formatter = $self->can("_FormatUserRole"); + } + return $formatter->( $self, map { $_ => $args{$_} } qw(User Address) ); +} + +sub _FormatUserRole { + my $self = shift; + my %args = @_; + + my $user = $args{User}; + return $self->_FormatUserVerbose(@_) + unless $user and $user->Privileged; + + my $name = $user->Name; + $name .= " (".$user->RealName.")" + if $user->RealName and lc $user->RealName ne lc $user->Name; + return $name; +} + +sub _FormatUserConcise { + my $self = shift; + my %args = @_; + return $args{User} ? $args{User}->FriendlyName : $args{Address}->address; +} + +sub _FormatUserVerbose { + my $self = shift; + my %args = @_; + my ($user, $address) = @args{"User", "Address"}; + + my $email = ''; + my $phrase = ''; + my $comment = ''; + + if ($user) { + $email = $user->EmailAddress || ''; + $phrase = $user->RealName if $user->RealName and lc $user->RealName ne lc $email; + $comment = $user->Name if lc $user->Name ne lc $email; + } else { + ($email, $phrase, $comment) = (map { $address->$_ } "address", "phrase", "comment"); + } + + return join " ", grep { $_ } ($phrase || $comment || ''), ($email ? "<$email>" : ""); } =head2 PreferredKey @@ -1604,8 +1767,7 @@ sub PreferredKey return $prefkey->Content if $prefkey; # we don't have a preferred key for this user, so now we must query GPG - require RT::Crypt::GnuPG; - my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress); + my %res = RT::Crypt->GetKeysForEncryption($self->EmailAddress); return undef unless defined $res{'info'}; my @keys = @{ $res{'info'} }; return undef if @keys == 0; @@ -1659,7 +1821,7 @@ sub SetPrivateKey { # check that it's really private key { - my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key ); + my %tmp = RT::Crypt->GetKeysForSigning( Signer => $key, Protocol => 'GnuPG' ); return (0, $self->loc("No such key or it's not suitable for signing")) if $tmp{'exit_code'} || !$tmp{'info'}; } @@ -1673,6 +1835,21 @@ sub SetPrivateKey { return ($status, $self->loc("Set private key")); } +sub SetLang { + my $self = shift; + my ($lang) = @_; + + unless ($self->CurrentUserCanModify('Lang')) { + return (0, $self->loc("Permission Denied")); + } + + # Local hack to cause the result message to be in the _new_ language + # if we're updating ourselves + $self->CurrentUser->{LangHandle} = RT::I18N->get_handle( $lang ) + if $self->CurrentUser->id == $self->id; + return $self->_Set( Field => 'Lang', Value => $lang ); +} + sub BasicColumns { ( [ Name => 'Username' ], @@ -1682,6 +1859,79 @@ sub BasicColumns { ); } +=head2 Bookmarks + +Returns an unordered list of IDs representing the user's bookmarked tickets. + +=cut + +sub Bookmarks { + my $self = shift; + my $bookmarks = $self->FirstAttribute('Bookmarks'); + return if !$bookmarks; + + $bookmarks = $bookmarks->Content; + return if !$bookmarks; + + return keys %$bookmarks; +} + +=head2 HasBookmark TICKET + +Returns whether the provided ticket is bookmarked by the user. + +=cut + +sub HasBookmark { + my $self = shift; + my $ticket = shift; + my $id = $ticket->id; + + # maintain bookmarks across merges + my @ids = ($id, $ticket->Merged); + + my $bookmarks = $self->FirstAttribute('Bookmarks'); + $bookmarks = $bookmarks ? $bookmarks->Content : {}; + + my @bookmarked = grep { $bookmarks->{ $_ } } @ids; + return @bookmarked ? 1 : 0; +} + +=head2 ToggleBookmark TICKET + +Toggles whether the provided ticket is bookmarked by the user. + +=cut + +sub ToggleBookmark { + my $self = shift; + my $ticket = shift; + my $id = $ticket->id; + + # maintain bookmarks across merges + my @ids = ($id, $ticket->Merged); + + my $bookmarks = $self->FirstAttribute('Bookmarks'); + $bookmarks = $bookmarks ? $bookmarks->Content : {}; + + my $is_bookmarked; + + if ( grep { $bookmarks->{ $_ } } @ids ) { + delete $bookmarks->{ $_ } foreach @ids; + $is_bookmarked = 0; + } else { + $bookmarks->{ $id } = 1; + $is_bookmarked = 1; + } + + $self->SetAttribute( + Name => 'Bookmarks', + Content => $bookmarks, + ); + + return $is_bookmarked; +} + =head2 Create PARAMHASH Create takes a hash of values and creates a row in the database: @@ -2271,6 +2521,24 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure. =cut +=head2 SMIMECertificate + +Returns the current value of SMIMECertificate. +(In the database, SMIMECertificate is stored as text.) + + + +=head2 SetSMIMECertificate VALUE + + +Set SMIMECertificate to VALUE. +Returns (1, 'Status message') on success and (0, 'Error Message') on failure. +(In the database, SMIMECertificate will be stored as a text.) + + +=cut + + =head2 Creator Returns the current value of Creator. @@ -2569,6 +2837,8 @@ sub _CoreAccessible { {read => 1, write => 1, sql_type => 12, length => 50, is_blob => 0, is_numeric => 0, type => 'varchar(50)', default => ''}, PGPKey => {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, + SMIMECertificate => + {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, Creator => {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, Created => @@ -2581,6 +2851,213 @@ sub _CoreAccessible { } }; +sub UID { + my $self = shift; + return undef unless defined $self->Name; + return "@{[ref $self]}-@{[$self->Name]}"; +} + +sub FindDependencies { + my $self = shift; + my ($walker, $deps) = @_; + + $self->SUPER::FindDependencies($walker, $deps); + + # ACL equivalence group + my $objs = RT::Groups->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Domain', VALUE => 'ACLEquivalence', CASESENSITIVE => 0 ); + $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); + $deps->Add( in => $objs ); + + # Memberships in SystemInternal groups + $objs = RT::GroupMembers->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'MemberId', VALUE => $self->Id ); + my $principals = $objs->Join( + ALIAS1 => 'main', + FIELD1 => 'GroupId', + TABLE2 => 'Principals', + FIELD2 => 'id', + ); + my $groups = $objs->Join( + ALIAS1 => $principals, + FIELD1 => 'ObjectId', + TABLE2 => 'Groups', + FIELD2 => 'Id', + ); + $objs->Limit( + ALIAS => $groups, + FIELD => 'Domain', + VALUE => 'SystemInternal', + CASESENSITIVE => 0 + ); + $deps->Add( in => $objs ); + + # XXX: This ignores the myriad of "in" references from the Creator + # and LastUpdatedBy columns. +} + +sub __DependsOn { + my $self = shift; + my %args = ( + Shredder => undef, + Dependencies => undef, + @_, + ); + my $deps = $args{'Dependencies'}; + my $list = []; + +# Principal + $deps->_PushDependency( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::WIPE_AFTER, + TargetObject => $self->PrincipalObj, + Shredder => $args{'Shredder'} + ); + +# ACL equivalence group +# don't use LoadACLEquivalenceGroup cause it may not exists any more + my $objs = RT::Groups->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'Domain', VALUE => 'ACLEquivalence', CASESENSITIVE => 0 ); + $objs->Limit( FIELD => 'Instance', VALUE => $self->Id ); + push( @$list, $objs ); + +# Cleanup user's membership + $objs = RT::GroupMembers->new( $self->CurrentUser ); + $objs->Limit( FIELD => 'MemberId', VALUE => $self->Id ); + push( @$list, $objs ); + + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON, + TargetObjects => $list, + Shredder => $args{'Shredder'} + ); + +# TODO: Almost all objects has Creator, LastUpdatedBy and etc. fields +# which are references on users(Principal actualy) + my @OBJECTS = qw( + ACL + Articles + Attachments + Attributes + CachedGroupMembers + Classes + CustomFieldValues + CustomFields + GroupMembers + Groups + Links + ObjectClasses + ObjectCustomFieldValues + ObjectCustomFields + ObjectScrips + Principals + Queues + ScripActions + ScripConditions + Scrips + Templates + Tickets + Transactions + Users + ); + my @var_objs; + foreach( @OBJECTS ) { + my $class = "RT::$_"; + foreach my $method ( qw(Creator LastUpdatedBy) ) { + my $objs = $class->new( $self->CurrentUser ); + next unless $objs->RecordClass->_Accessible( $method => 'read' ); + $objs->Limit( FIELD => $method, VALUE => $self->id ); + push @var_objs, $objs; + } + } + $deps->_PushDependencies( + BaseObject => $self, + Flags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::VARIABLE, + TargetObjects => \@var_objs, + Shredder => $args{'Shredder'} + ); + + return $self->SUPER::__DependsOn( %args ); +} + +sub BeforeWipeout { + my $self = shift; + if( $self->Name =~ /^(RT_System|Nobody)$/ ) { + RT::Shredder::Exception::Info->throw('SystemObject'); + } + return $self->SUPER::BeforeWipeout( @_ ); +} + +sub Serialize { + my $self = shift; + return ( + Disabled => $self->PrincipalObj->Disabled, + Principal => $self->PrincipalObj->UID, + PrincipalId => $self->PrincipalObj->Id, + $self->SUPER::Serialize(@_), + ); +} + +sub PreInflate { + my $class = shift; + my ($importer, $uid, $data) = @_; + + my $principal_uid = delete $data->{Principal}; + my $principal_id = delete $data->{PrincipalId}; + my $disabled = delete $data->{Disabled}; + + my $obj = RT::User->new( RT->SystemUser ); + $obj->LoadByCols( Name => $data->{Name} ); + $obj->LoadByEmail( $data->{EmailAddress} ) unless $obj->Id; + if ($obj->Id) { + # User already exists -- merge + + # XXX: We might be merging a privileged user into an unpriv one, + # in which case we should probably promote the unpriv user to + # being privileged. Of course, we don't know if the user being + # imported is privileged yet, as its group memberships show up + # later in the stream... + $importer->MergeValues($obj, $data); + $importer->SkipTransactions( $uid ); + + # Mark both the principal and the user object as resolved + $importer->Resolve( + $principal_uid, + ref($obj->PrincipalObj), + $obj->PrincipalObj->Id + ); + $importer->Resolve( $uid => ref($obj) => $obj->Id ); + return; + } + + # Create a principal first, so we know what ID to use + my $principal = RT::Principal->new( RT->SystemUser ); + my ($id) = $principal->Create( + PrincipalType => 'User', + Disabled => $disabled, + ObjectId => 0, + ); + + # Now we have a principal id, set the id for the user record + $data->{id} = $id; + + $importer->Resolve( $principal_uid => ref($principal), $id ); + + $importer->Postpone( + for => $uid, + uid => $principal_uid, + column => "ObjectId", + ); + + return $class->SUPER::PreInflate( $importer, $uid, $data ); +} + +sub PostInflate { + my $self = shift; + RT->InitSystemObjects if $self->Name eq "RT_System"; +} + RT::Base->_ImportOverlays(); diff --git a/rt/lib/RT/Users.pm b/rt/lib/RT/Users.pm index 34d4371..4fe1455 100755 --- a/rt/lib/RT/Users.pm +++ b/rt/lib/RT/Users.pm @@ -69,10 +69,10 @@ package RT::Users; use strict; use warnings; -use RT::User; - use base 'RT::SearchBuilder'; +use RT::User; + sub Table { 'Users'} @@ -86,12 +86,11 @@ sub _Init { FIELD => 'Name', ORDER => 'ASC' ); - $self->{'princalias'} = $self->NewAlias('Principals'); - # XXX: should be generalized - $self->Join( ALIAS1 => 'main', + $self->{'princalias'} = $self->Join( + ALIAS1 => 'main', FIELD1 => 'id', - ALIAS2 => $self->{'princalias'}, + TABLE2 => 'Principals', FIELD2 => 'id' ); $self->Limit( ALIAS => $self->{'princalias'}, FIELD => 'PrincipalType', @@ -163,7 +162,7 @@ that email address sub LimitToEmail { my $self = shift; my $addr = shift; - $self->Limit( FIELD => 'EmailAddress', VALUE => "$addr" ); + $self->Limit( FIELD => 'EmailAddress', VALUE => $addr, CASESENSITIVE => 0 ); } @@ -226,7 +225,7 @@ sub LimitToUnprivileged { sub Limit { my $self = shift; my %args = @_; - $args{'CASESENSITIVE'} = 0 unless exists $args{'CASESENSITIVE'}; + $args{'CASESENSITIVE'} = 0 unless exists $args{'CASESENSITIVE'} or $args{'ALIAS'}; return $self->SUPER::Limit( %args ); } @@ -363,7 +362,7 @@ sub _GetEquivObjects } if( $args{'IncludeSystemRights'} ) { - push @objects, 'RT::System'; + push @objects, $RT::System; } push @objects, @{ $args{'EquivObjects'} }; return grep $_, @objects; @@ -441,7 +440,9 @@ sub WhoHaveRoleRight VALUE => RT->SystemUser->id ); - $self->_AddSubClause( "WhichRole", "(". join( ' OR ', map "$groups.Type = '$_'", @roles ) .")" ); + $self->_AddSubClause( "WhichRole", "(". join( ' OR ', + map $RT::Handle->__MakeClauseCaseInsensitive("$groups.Name", '=', "'$_'"), @roles + ) .")" ); my @groups_clauses = $self->_RoleClauses( $groups, @objects ); $self->_AddSubClause( "WhichObject", "(". join( ' OR ', @groups_clauses ) .")" ) @@ -458,14 +459,12 @@ sub _RoleClauses { my @groups_clauses; foreach my $obj ( @objects ) { my $type = ref($obj)? ref($obj): $obj; - my $id; - $id = $obj->id if ref($obj) && UNIVERSAL::can($obj, 'id') && $obj->id; - - my $role_clause = "$groups.Domain = '$type-Role'"; - # XXX: Groups.Instance is VARCHAR in DB, we should quote value - # if we want mysql 4.0 use indexes here. we MUST convert that - # field to integer and drop this quotes. - $role_clause .= " AND $groups.Instance = '$id'" if $id; + + my $role_clause = $RT::Handle->__MakeClauseCaseInsensitive("$groups.Domain", '=', "'$type-Role'"); + + if ( my $id = eval { $obj->id } ) { + $role_clause .= " AND $groups.Instance = $id"; + } push @groups_clauses, "($role_clause)"; } return @groups_clauses; @@ -506,12 +505,14 @@ sub WhoHaveGroupRight my ($check_objects) = (''); my @objects = $self->_GetEquivObjects( %args ); + my %seen; if ( @objects ) { my @object_clauses; foreach my $obj ( @objects ) { my $type = ref($obj)? ref($obj): $obj; - my $id; + my $id = 0; $id = $obj->id if ref($obj) && UNIVERSAL::can($obj, 'id') && $obj->id; + next if $seen{"$type-$id"}++; my $object_clause = "$acl.ObjectType = '$type'"; $object_clause .= " AND $acl.ObjectId = $id" if $id; @@ -570,27 +571,108 @@ sub WhoBelongToGroups { } my $group_members = $self->_JoinGroupMembers( %args ); - foreach my $groupid (@{$args{'Groups'}}) { - $self->Limit( ALIAS => $group_members, - FIELD => 'GroupId', - VALUE => $groupid, - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'OR', - ); - } + $self->Limit( + ALIAS => $group_members, + FIELD => 'GroupId', + OPERATOR => 'IN', + VALUE => [ 0, @{$args{'Groups'}} ], + ); } +=head2 SimpleSearch + +Does a 'simple' search of Users against a specified Term. + +This Term is compared to a number of fields using various types of SQL +comparison operators. -=head2 NewItem +Ensures that the returned collection of Users will have a value for Return. -Returns an empty new RT::User item +This method is passed the following. You must specify a Term and a Return. + + Privileged - Whether or not to limit to Privileged Users (0 or 1) + Fields - Hashref of data - defaults to C<$UserSearchFields> emulate that if you want to override + Term - String that is in the fields specified by Fields + Return - What field on the User you want to be sure isn't empty + Exclude - Array reference of ids to exclude + Max - What to limit this collection to =cut -sub NewItem { +sub SimpleSearch { my $self = shift; - return(RT::User->new($self->CurrentUser)); + my %args = ( + Privileged => 0, + Fields => RT->Config->Get('UserSearchFields'), + Term => undef, + Exclude => [], + Return => undef, + Max => 10, + @_ + ); + + return $self unless defined $args{Return} + and defined $args{Term} + and length $args{Term}; + + $self->RowsPerPage( $args{Max} ); + + $self->LimitToPrivileged() if $args{Privileged}; + + while (my ($name, $op) = each %{$args{Fields}}) { + $op = 'STARTSWITH' + unless $op =~ /^(?:LIKE|(?:START|END)SWITH|=|!=)$/i; + + if ($name =~ /^CF\.(?:\{(.*)}|(.*))$/) { + my $cfname = $1 || $2; + my $cf = RT::CustomField->new(RT->SystemUser); + my ($ok, $msg) = $cf->LoadByName( Name => $cfname, LookupType => 'RT::User'); + if ( $ok ) { + $self->LimitCustomField( + CUSTOMFIELD => $cf->Id, + OPERATOR => $op, + VALUE => $args{Term}, + ENTRYAGGREGATOR => 'OR', + SUBCLAUSE => 'autocomplete', + ); + } else { + RT->Logger->warning("Asked to search custom field $name but unable to load a User CF with the name $cfname: $msg"); + } + } else { + $self->Limit( + FIELD => $name, + OPERATOR => $op, + VALUE => $args{Term}, + ENTRYAGGREGATOR => 'OR', + SUBCLAUSE => 'autocomplete', + ); + } + } + + # Exclude users we don't want + $self->Limit(FIELD => 'id', OPERATOR => 'NOT IN', VALUE => $args{Exclude} ) + if @{$args{Exclude}}; + + if ( RT->Config->Get('DatabaseType') eq 'Oracle' ) { + $self->Limit( + FIELD => $args{Return}, + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + } + else { + $self->Limit( FIELD => $args{Return}, OPERATOR => '!=', VALUE => '' ); + $self->Limit( + FIELD => $args{Return}, + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ENTRYAGGREGATOR => 'AND' + ); + } + + return $self; } + RT::Base->_ImportOverlays(); 1; diff --git a/rt/lib/RT/Util.pm b/rt/lib/RT/Util.pm index bd3a228..aa02b04 100644 --- a/rt/lib/RT/Util.pm +++ b/rt/lib/RT/Util.pm @@ -66,11 +66,11 @@ sub safe_run_child (&) { # on failure and reset values only in our original # process my ($oldv_dbh, $oldv_rth); - my $dbh = $RT::Handle->dbh; + my $dbh = $RT::Handle ? $RT::Handle->dbh : undef; $oldv_dbh = $dbh->{'InactiveDestroy'} if $dbh; $dbh->{'InactiveDestroy'} = 1 if $dbh; - $oldv_rth = $RT::Handle->{'DisconnectHandleOnDestroy'}; - $RT::Handle->{'DisconnectHandleOnDestroy'} = 0; + $oldv_rth = $RT::Handle->{'DisconnectHandleOnDestroy'} if $RT::Handle; + $RT::Handle->{'DisconnectHandleOnDestroy'} = 0 if $RT::Handle; my ($reader, $writer); pipe( $reader, $writer ); @@ -94,7 +94,7 @@ sub safe_run_child (&) { $err =~ s/^Stack:.*$//ms; if ( $our_pid == $$ ) { $dbh->{'InactiveDestroy'} = $oldv_dbh if $dbh; - $RT::Handle->{'DisconnectHandleOnDestroy'} = $oldv_rth; + $RT::Handle->{'DisconnectHandleOnDestroy'} = $oldv_rth if $RT::Handle; die "System Error: $err"; } else { print $writer "System Error: $err"; @@ -108,7 +108,7 @@ sub safe_run_child (&) { warn $response if $response; $dbh->{'InactiveDestroy'} = $oldv_dbh if $dbh; - $RT::Handle->{'DisconnectHandleOnDestroy'} = $oldv_rth; + $RT::Handle->{'DisconnectHandleOnDestroy'} = $oldv_rth if $RT::Handle; return $want? (@res) : $res[0]; } |