1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
57 RT::Shredder - Permanently wipeout data from RT
64 rt-shredder --force --plugin 'Tickets=queue,general;status,deleted'
69 RT::Shredder is extension to RT which allows you to permanently wipeout
70 data from the RT database. Shredder supports the wiping of almost
71 all RT objects (Tickets, Transactions, Attachments, Users...).
74 =head2 "Delete" vs "Wipeout"
76 RT uses the term "delete" to mean "deactivate". To avoid confusion,
77 RT::Shredder uses the term "Wipeout" to mean "permanently erase" (or
78 what most people would think of as "delete").
81 =head2 Why do you want this?
83 Normally in RT, "deleting" an item simply deactivates it and makes it
84 invisible from view. This is done to retain full history and
85 auditability of your tickets. For most RT users this is fine and they
86 have no need of RT::Shredder.
88 But in some large and heavily used RT instances the database can get
89 clogged up with junk, particularly spam. This can slow down searches
90 and bloat the size of the database. For these users, RT::Shredder
91 allows them to completely clear the database of this unwanted junk.
93 An additional use of Shredder is to obliterate sensitive information
94 (passwords, credit card numbers, ...) which might have made their way
98 =head2 Command line tools (CLI)
100 L<rt-shredder> is a program which allows you to wipe objects from
101 command line or with system tasks scheduler (cron, for example).
102 See also 'rt-shredder --help'.
105 =head2 Web based interface (WebUI)
107 Shredder's WebUI integrates into RT's WebUI. You can find it in the
108 Configuration->Tools->Shredder tab. The interface is similar to the
109 CLI and gives you the same functionality. You can find 'Shredder' link
110 at the bottom of tickets search results, so you could wipeout tickets
111 in the way similar to the bulk update.
114 =head1 DATA STORAGE AND BACKUPS
116 Shredder allows you to store data you wiped in files as scripts with SQL
119 =head3 Restoring from backup
121 Should you wipeout something you did not intend to the objects can be
122 restored by using the storage files. These files are a simple set of
123 SQL commands to re-insert your objects into the RT database.
125 1) Locate the appropriate shredder SQL dump file. In the WebUI, when
126 you use shredder, the path to the dump file is displayed. It also
127 gives the option to download the dump file after each wipeout. Or
128 it can be found in your C<$ShredderStoragePath>.
130 2) Load the shredder SQL dump into your RT database. The details will
131 be different for each database and RT configuration, consult your
132 database manual and RT config. For example, in MySQL...
134 mysql -u your_rt_user -p your_rt_database < /path/to/rt/var/data/shredder/dump.sql
136 That's it.i This will restore everything you'd deleted during a
137 shredding session when the file had been created.
141 =head2 $RT::DependenciesLimit
143 Shredder stops with an error if the object has more than
144 C<$RT::DependenciesLimit> dependencies. For example: a ticket has 1000
145 transactions or a transaction has 1000 attachments. This is protection
146 from bugs in shredder from wiping out your whole database, but
147 sometimes when you have big mail loops you may hit it.
151 You can change the default value, in F<RT_SiteConfig.pm> add C<Set(
152 $DependenciesLimit, new_limit );>
155 =head2 $ShredderStoragePath
157 Directory containing Shredder backup dumps.
159 Defaults to F</path-to-RT-var-dir/data/RT-Shredder>.
161 You can change the default value, in F<RT_SiteConfig.pm> add C<Set(
162 $ShredderStoragePath, new_path );> Be sure to use an absolute path.
165 =head1 INFORMATION FOR DEVELOPERS
169 L<RT::Shredder> is an extension to RT which adds shredder methods to
170 RT objects and classes. The API is not well documented yet, but you
171 can find usage examples in L<rt-shredder> and the
172 F<lib/t/regression/shredder/*.t> test files.
174 However, here is a small example that do the same action as in CLI
175 example from L</SYNOPSIS>:
178 RT::Shredder::Init( force => 1 );
179 my $deleted = RT::Tickets->new( $RT::SystemUser );
180 $deleted->{'allow_deleted_search'} = 1;
181 $deleted->LimitQueue( VALUE => 'general' );
182 $deleted->LimitStatus( VALUE => 'deleted' );
183 while( my $t = $deleted->Next ) {
188 =head2 RT::Shredder class' API
190 L<RT::Shredder> implements interfaces to objects cache, actions on the
191 objects in the cache and backups storage.
195 our $VERSION = '0.04';
200 # I can't use 'use lib' here since it breakes tests
201 # because test suite uses old RT::Shredder setup from
204 ### after: push @INC, qw(@RT_LIB_PATH@);
205 push @INC, qw(/opt/rt3/local/lib /opt/rt3/lib);
206 use RT::Shredder::Constants;
207 use RT::Shredder::Exceptions;
211 require RT::Shredder::Record;
213 require RT::Shredder::ACE;
214 require RT::Shredder::Attachment;
215 require RT::Shredder::CachedGroupMember;
216 require RT::Shredder::CustomField;
217 require RT::Shredder::CustomFieldValue;
218 require RT::Shredder::GroupMember;
219 require RT::Shredder::Group;
220 require RT::Shredder::Link;
221 require RT::Shredder::Principal;
222 require RT::Shredder::Queue;
223 require RT::Shredder::Scrip;
224 require RT::Shredder::ScripAction;
225 require RT::Shredder::ScripCondition;
226 require RT::Shredder::Template;
227 require RT::Shredder::ObjectCustomFieldValue;
228 require RT::Shredder::Ticket;
229 require RT::Shredder::Transaction;
230 require RT::Shredder::User;
233 our @SUPPORTED_OBJECTS = qw(
248 ObjectCustomFieldValue
258 RT::Shredder::Init( %default_options );
260 C<RT::Shredder::Init()> should be called before creating an
261 RT::Shredder object. It iniitalizes RT and loads the RT
264 %default_options are passed to every C<<RT::Shredder->new>> call.
279 my $shredder = RT::Shredder->new(%options);
281 Construct a new RT::Shredder object.
283 There currently are no %options.
290 my $self = bless( {}, ref $proto || $proto );
298 $self->{'opt'} = { %opt, @_ };
299 $self->{'cache'} = {};
300 $self->{'resolver'} = {};
301 $self->{'dump_plugins'} = [];
304 =head4 CastObjectsToRecords( Objects => undef )
306 Cast objects to the C<RT::Record> objects or its ancesstors.
307 Objects can be passed as SCALAR (format C<< <class>-<id> >>),
308 ARRAY, C<RT::Record> ancesstors or C<RT::SearchBuilder> ancesstor.
310 Most methods that takes C<Objects> argument use this method to
311 cast argument value to list of records.
313 Returns an array of records.
317 my @objs = $shredder->CastObjectsToRecords(
318 Objects => [ # ARRAY reference
319 'RT::Attachment-10', # SCALAR or SCALAR reference
320 $tickets, # RT::Tickets object (isa RT::SearchBuilder)
321 $user, # RT::User object (isa RT::Record)
327 sub CastObjectsToRecords
330 my %args = ( Objects => undef, @_ );
333 my $targets = delete $args{'Objects'};
335 RT::Shredder::Exception->throw( "Undefined Objects argument" );
338 if( UNIVERSAL::isa( $targets, 'RT::SearchBuilder' ) ) {
339 #XXX: try to use ->_DoSearch + ->ItemsArrayRef in feature
340 # like we do in Record with links, but change only when
341 # more tests would be available
342 while( my $tmp = $targets->Next ) { push @res, $tmp };
343 } elsif ( UNIVERSAL::isa( $targets, 'RT::Record' ) ) {
345 } elsif ( UNIVERSAL::isa( $targets, 'ARRAY' ) ) {
346 foreach( @$targets ) {
347 push @res, $self->CastObjectsToRecords( Objects => $_ );
349 } elsif ( UNIVERSAL::isa( $targets, 'SCALAR' ) || !ref $targets ) {
350 $targets = $$targets if ref $targets;
351 my ($class, $id) = split /-/, $targets;
352 RT::Shredder::Exception->throw( "Unsupported class $class" )
353 unless $class =~ /^\w+(::\w+)*$/;
354 $class = 'RT::'. $class unless $class =~ /^RTx?::/i;
355 eval "require $class";
356 die "Couldn't load '$class' module" if $@;
357 my $obj = $class->new( $RT::SystemUser );
358 die "Couldn't construct new '$class' object" unless $obj;
360 unless ( $obj->id ) {
361 $RT::Logger->error( "Couldn't load '$class' object with id '$id'" );
362 RT::Shredder::Exception::Info->throw( 'CouldntLoadObject' );
364 die "Loaded object has different id" unless( $id eq $obj->id );
367 RT::Shredder::Exception->throw( "Unsupported type ". ref $targets );
374 =head4 PutObjects( Objects => undef )
376 Puts objects into cache.
378 Returns array of the cache entries.
380 See C<CastObjectsToRecords> method for supported types of the C<Objects>
388 my %args = ( Objects => undef, @_ );
391 for( $self->CastObjectsToRecords( Objects => delete $args{'Objects'} ) ) {
392 push @res, $self->PutObject( %args, Object => $_ )
398 =head4 PutObject( Object => undef )
400 Puts record object into cache and returns its cache entry.
402 B<NOTE> that this method support B<only C<RT::Record> object or its ancesstor
403 objects>, if you want put mutliple objects or objects represented by different
404 classes then use C<PutObjects> method instead.
411 my %args = ( Object => undef, @_ );
413 my $obj = $args{'Object'};
414 unless( UNIVERSAL::isa( $obj, 'RT::Record' ) ) {
415 RT::Shredder::Exception->throw( "Unsupported type '". (ref $obj || $obj || '(undef)')."'" );
418 my $str = $obj->_AsString;
419 return ($self->{'cache'}->{ $str } ||= { State => ON_STACK, Object => $obj } );
422 =head4 GetObject, GetState, GetRecord( String => ''| Object => '' )
424 Returns record object from cache, cache entry state or cache entry accordingly.
426 All three methods takes C<String> (format C<< <class>-<id> >>) or C<Object> argument.
427 C<String> argument has more priority than C<Object> so if it's not empty then methods
428 leave C<Object> argument unchecked.
430 You can read about possible states and their meanings in L<RT::Shredder::Constants> docs.
442 if( $args{'String'} && $args{'Object'} ) {
444 Carp::croak( "both String and Object args passed" );
446 return $args{'String'} if $args{'String'};
447 return $args{'Object'}->_AsString if UNIVERSAL::can($args{'Object'}, '_AsString' );
451 sub GetObject { return (shift)->GetRecord( @_ )->{'Object'} }
452 sub GetState { return (shift)->GetRecord( @_ )->{'State'} }
456 my $str = $self->_ParseRefStrArgs( @_ );
457 return $self->{'cache'}->{ $str };
460 =head3 Dependencies resolvers
462 =head4 PutResolver, GetResolvers and ApplyResolvers
464 TODO: These methods have no documentation.
477 unless( UNIVERSAL::isa( $args{'Code'} => 'CODE' ) ) {
478 die "Resolver '$args{Code}' is not code reference";
483 $self->{'resolver'}->{ $args{'BaseClass'} } ||= {}
484 )->{ $args{'TargetClass'} || '' } ||= []
486 unshift @$resolvers, $args{'Code'};
500 if( $args{'TargetClass'} && exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} } ) {
501 push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} || '' } };
503 if( exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ '' } ) {
504 push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{''} };
513 my %args = ( Dependency => undef, @_ );
514 my $dep = $args{'Dependency'};
516 my @resolvers = $self->GetResolvers(
517 BaseClass => $dep->BaseClass,
518 TargetClass => $dep->TargetClass,
521 unless( @resolvers ) {
522 RT::Shredder::Exception::Info->throw(
524 error => "Couldn't find resolver for dependency '". $dep->AsString ."'",
529 BaseObject => $dep->BaseObject,
530 TargetObject => $dep->TargetObject,
531 ) foreach @resolvers;
540 while ( my ($k, $v) = each %{ $self->{'cache'} } ) {
541 next if $v->{'State'} & (WIPED | IN_WIPING);
542 $self->Wipeout( Object => $v->{'Object'} );
551 die "Couldn't begin transaction" unless $RT::Handle->BeginTransaction;
552 $mark = $self->PushDumpMark or die "Couldn't get dump mark";
553 $self->_Wipeout( @_ );
554 $self->PopDumpMark( Mark => $mark );
555 die "Couldn't commit transaction" unless $RT::Handle->Commit;
558 $RT::Handle->Rollback('force');
559 $self->RollbackDumpTo( Mark => $mark ) if $mark;
560 die $@ if RT::Shredder::Exception::Info->caught;
561 die "Couldn't wipeout object: $@";
568 my %args = ( CacheRecord => undef, Object => undef, @_ );
570 my $record = $args{'CacheRecord'};
571 $record = $self->PutObject( Object => $args{'Object'} ) unless $record;
572 return if $record->{'State'} & (WIPED | IN_WIPING);
574 $record->{'State'} |= IN_WIPING;
575 my $object = $record->{'Object'};
577 $self->DumpObject( Object => $object, State => 'before any action' );
579 unless( $object->BeforeWipeout ) {
580 RT::Shredder::Exception->throw( "BeforeWipeout check returned error" );
583 my $deps = $object->Dependencies( Shredder => $self );
585 WithFlags => DEPENDS_ON | VARIABLE,
586 Callback => sub { $self->ApplyResolvers( Dependency => $_[0] ) },
588 $self->DumpObject( Object => $object, State => 'after resolvers' );
591 WithFlags => DEPENDS_ON,
592 WithoutFlags => WIPE_AFTER | VARIABLE,
593 Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
595 $self->DumpObject( Object => $object, State => 'after wiping dependencies' );
598 $record->{'State'} |= WIPED; delete $record->{'Object'};
599 $self->DumpObject( Object => $object, State => 'after wipeout' );
602 WithFlags => DEPENDS_ON | WIPE_AFTER,
603 WithoutFlags => VARIABLE,
604 Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
606 $self->DumpObject( Object => $object, State => 'after late dependencies' );
611 sub ValidateRelations
616 foreach my $record( values %{ $self->{'cache'} } ) {
617 next if( $record->{'State'} & VALID );
618 $record->{'Object'}->ValidateRelations( Shredder => $self );
622 =head3 Data storage and backups
624 =head4 GetFileName( FileName => '<ISO DATETIME>-XXXX.sql', FromStorage => 1 )
626 Takes desired C<FileName> and flag C<FromStorage> then translate file name to absolute
629 * Default value of the C<FileName> option is C<< <ISO DATETIME>-XXXX.sql >>;
631 * if C<FileName> has C<XXXX> (exactly four uppercase C<X> letters) then it would be changed with digits from 0000 to 9999 range, with first one free value;
633 * if C<FileName> has C<%T> then it would be replaced with the current date and time in the C<YYYY-MM-DDTHH:MM:SS> format. Note that using C<%t> may still generate not unique names, using C<XXXX> recomended.
635 * if C<FromStorage> argument is true (default behaviour) then result path would always be relative to C<StoragePath>;
637 * if C<FromStorage> argument is false then result would be relative to the current dir unless it's already absolute path.
639 Returns an absolute path of the file.
642 # file from storage with default name format
643 my $fname = $shredder->GetFileName;
645 # file from storage with custom name format
646 my $fname = $shredder->GetFileName( FileName => 'shredder-XXXX.backup' );
648 # file with path relative to the current dir
649 my $fname = $shredder->GetFileName(
651 FileName => 'backups/shredder.sql',
654 # file with absolute path
655 my $fname = $shredder->GetFileName(
657 FileName => '/var/backups/shredder-XXXX.sql'
665 my %args = ( FileName => '', FromStorage => 1, @_ );
668 my $file = $args{'FileName'} || '%t-XXXX.sql';
669 if( $file =~ /\%t/i ) {
671 my $date_time = POSIX::strftime( "%Y%m%dT%H%M%S", gmtime );
672 $file =~ s/\%t/$date_time/gi;
675 # convert to absolute path
676 if( $args{'FromStorage'} ) {
677 $file = File::Spec->catfile( $self->StoragePath, $file );
678 } elsif( !File::Spec->file_name_is_absolute( $file ) ) {
679 $file = File::Spec->rel2abs( $file );
683 if( $file =~ /XXXX[^\/\\]*$/ ) {
684 my( $tmp, $i ) = ( $file, 0 );
688 $tmp =~ s/XXXX([^\/\\]*)$/sprintf("%04d", $i).$1/e;
689 } while( -e $tmp && $i < 9999 );
695 die "File '$file' exists, but is read-only";
698 unless( File::Spec->file_name_is_absolute( $file ) ) {
699 $file = File::Spec->rel2abs( $file );
703 my $dir = File::Spec->join( (File::Spec->splitpath( $file ))[0,1] );
704 unless( -e $dir && -d _) {
705 die "Base directory '$dir' for file '$file' doesn't exist";
708 die "Base directory '$dir' is not writable";
711 die "'$file' is not regular file";
719 Returns an absolute path to the storage dir. See
720 L<CONFIGURATION/$ShredderStoragePath>.
722 See also description of the L</GetFileName> method.
728 return scalar( RT->Config->Get('ShredderStoragePath') )
729 || File::Spec->catdir( $RT::VarPath, qw(data RT-Shredder) );
732 my %active_dump_state = ();
735 my %args = ( Object => undef, Name => 'SQLDump', Arguments => undef, @_ );
737 my $plugin = $args{'Object'};
739 require RT::Shredder::Plugin;
740 $plugin = RT::Shredder::Plugin->new;
741 my( $status, $msg ) = $plugin->LoadByName( $args{'Name'} );
742 die "Couldn't load dump plugin: $msg\n" unless $status;
744 die "Plugin is not of correct type" unless lc $plugin->Type eq 'dump';
746 if ( my $pargs = $args{'Arguments'} ) {
747 my ($status, $msg) = $plugin->TestArgs( %$pargs );
748 die "Couldn't set plugin args: $msg\n" unless $status;
751 my @applies_to = $plugin->AppliesToStates;
752 die "Plugin doesn't apply to any state" unless @applies_to;
753 $active_dump_state{ lc $_ } = 1 foreach @applies_to;
755 push @{ $self->{'dump_plugins'} }, $plugin;
762 my %args = (Object => undef, State => undef, @_);
763 die "No state passed" unless $args{'State'};
764 return unless $active_dump_state{ lc $args{'State'} };
766 foreach (@{ $self->{'dump_plugins'} }) {
767 next unless grep lc $args{'State'} eq lc $_, $_->AppliesToStates;
768 my ($state, $msg) = $_->Run( %args );
769 die "Couldn't run plugin: $msg" unless $state;
773 { my $mark = 1; # XXX: integer overflows?
777 foreach (@{ $self->{'dump_plugins'} }) {
778 my ($state, $msg) = $_->PushMark( Mark => $mark );
779 die "Couldn't push mark: $msg" unless $state;
785 foreach (@{ $self->{'dump_plugins'} }) {
786 my ($state, $msg) = $_->PushMark( @_ );
787 die "Couldn't pop mark: $msg" unless $state;
792 foreach (@{ $self->{'dump_plugins'} }) {
793 my ($state, $msg) = $_->RollbackTo( @_ );
794 die "Couldn't rollback to mark: $msg" unless $state;
804 =head2 Database transactions support
806 Since 0.03_01 RT::Shredder uses database transactions and should be
807 much safer to run on production servers.
811 Mainstream RT doesn't use FKs, but at least I posted DDL script that creates them
812 in mysql DB, note that if you use FKs then this two valid keys don't allow delete
813 Tickets because of bug in MySQL:
815 ALTER TABLE Tickets ADD FOREIGN KEY (EffectiveId) REFERENCES Tickets(id);
816 ALTER TABLE CachedGroupMembers ADD FOREIGN KEY (Via) REFERENCES CachedGroupMembers(id);
818 L<http://bugs.mysql.com/bug.php?id=4042>
820 =head1 BUGS AND HOW TO CONTRIBUTE
822 We need your feedback in all cases: if you use it or not,
823 is it works for you or not.
827 Don't skip C<make test> step while install and send me reports if it's fails.
828 Add your own tests, it's easy enough if you've writen at list one perl script
829 that works with RT. Read more about testing in F<t/utils.pl>.
833 Send reports to L</AUTHOR> or to the RT mailing lists.
837 Many bugs in the docs: insanity, spelling, gramar and so on.
838 Patches are wellcome.
842 Please, see Todo file, it has some technical notes
843 about what I plan to do, when I'll do it, also it
844 describes some problems code has.
848 Since RT-3.7 shredder is a part of the RT distribution.
849 Versions of the RTx::Shredder extension could
850 be downloaded from the CPAN. Those work with older
851 RT versions or you can find repository at
852 L<https://opensvn.csie.org/rtx_shredder>
856 Ruslan U. Zakirov <Ruslan.Zakirov@gmail.com>
860 This program is free software; you can redistribute
861 it and/or modify it under the same terms as Perl itself.
863 The full text of the license can be found in the
868 L<rt-shredder>, L<rt-validator>