]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
320f0092 | 5 | # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC |
84fb5b46 MKG |
6 | # <sales@bestpractical.com> |
7 | # | |
8 | # (Except where explicitly superseded by other copyright notices) | |
9 | # | |
10 | # | |
11 | # LICENSE: | |
12 | # | |
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 | |
16 | # from www.gnu.org. | |
17 | # | |
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. | |
22 | # | |
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. | |
28 | # | |
29 | # | |
30 | # CONTRIBUTION SUBMISSION POLICY: | |
31 | # | |
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.) | |
37 | # | |
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. | |
46 | # | |
47 | # END BPS TAGGED BLOCK }}} | |
48 | ||
49 | package RT::Shredder; | |
50 | ||
51 | use strict; | |
52 | use warnings; | |
53 | ||
54 | ||
55 | ||
56 | =head1 NAME | |
57 | ||
58 | RT::Shredder - Permanently wipeout data from RT | |
59 | ||
60 | ||
61 | =head1 SYNOPSIS | |
62 | ||
63 | =head2 CLI | |
64 | ||
65 | rt-shredder --force --plugin 'Tickets=query,Queue="General" and Status="deleted"' | |
66 | ||
67 | =head1 DESCRIPTION | |
68 | ||
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...). | |
72 | ||
73 | ||
74 | =head2 "Delete" vs "Wipeout" | |
75 | ||
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"). | |
79 | ||
80 | ||
81 | =head2 Why do you want this? | |
82 | ||
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. | |
87 | ||
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. | |
92 | ||
93 | An additional use of Shredder is to obliterate sensitive information | |
94 | (passwords, credit card numbers, ...) which might have made their way | |
95 | into RT. | |
96 | ||
97 | ||
98 | =head2 Command line tools (CLI) | |
99 | ||
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'. | |
103 | ||
104 | ||
105 | =head2 Web based interface (WebUI) | |
106 | ||
107 | Shredder's WebUI integrates into RT's WebUI. You can find it in the | |
af59614d | 108 | Admin->Tools->Shredder tab. The interface is similar to the |
84fb5b46 MKG |
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. | |
112 | ||
113 | ||
114 | =head1 DATA STORAGE AND BACKUPS | |
115 | ||
116 | Shredder allows you to store data you wiped in files as scripts with SQL | |
117 | commands. | |
118 | ||
119 | =head3 Restoring from backup | |
120 | ||
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. | |
124 | ||
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>. | |
129 | ||
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... | |
133 | ||
134 | mysql -u your_rt_user -p your_rt_database < /path/to/rt/var/data/shredder/dump.sql | |
135 | ||
136 | That's it.i This will restore everything you'd deleted during a | |
137 | shredding session when the file had been created. | |
138 | ||
139 | =head1 CONFIGURATION | |
140 | ||
141 | =head2 $DependenciesLimit | |
142 | ||
143 | Shredder stops with an error if the object has more than | |
144 | C<$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. | |
148 | ||
149 | Defaults to 1000. To change this (for example, to 10000) add the | |
150 | following to your F<RT_SiteConfig.pm>: | |
151 | ||
152 | Set( $DependenciesLimit, 10_000 );> | |
153 | ||
154 | ||
155 | =head2 $ShredderStoragePath | |
156 | ||
157 | Directory containing Shredder backup dumps; defaults to | |
158 | F</opt/rt4/var/data/RT-Shredder> (assuming an /opt/rt4 installation). | |
159 | ||
160 | To change this (for example, to /some/backup/path) add the following to | |
161 | your F<RT_SiteConfig.pm>: | |
162 | ||
163 | Set( $ShredderStoragePath, "/some/backup/path" );> | |
164 | ||
165 | Be sure to specify an absolute path. | |
166 | ||
320f0092 MKG |
167 | =head1 Database Indexes |
168 | ||
169 | We have found that the following indexes significantly speed up | |
170 | shredding on most databases. | |
171 | ||
172 | CREATE INDEX SHREDDER_CGM1 ON CachedGroupMembers(MemberId, GroupId, Disabled); | |
173 | CREATE INDEX SHREDDER_CGM2 ON CachedGroupMembers(ImmediateParentId,MemberId); | |
174 | CREATE INDEX SHREDDER_CGM3 on CachedGroupMembers (Via, Id); | |
175 | ||
176 | CREATE UNIQUE INDEX SHREDDER_GM1 ON GroupMembers(MemberId, GroupId); | |
177 | ||
178 | CREATE INDEX SHREDDER_TXN1 ON Transactions(ReferenceType, OldReference); | |
179 | CREATE INDEX SHREDDER_TXN2 ON Transactions(ReferenceType, NewReference); | |
180 | CREATE INDEX SHREDDER_TXN3 ON Transactions(Type, OldValue); | |
181 | CREATE INDEX SHREDDER_TXN4 ON Transactions(Type, NewValue) | |
84fb5b46 MKG |
182 | |
183 | =head1 INFORMATION FOR DEVELOPERS | |
184 | ||
185 | =head2 General API | |
186 | ||
187 | L<RT::Shredder> is an extension to RT which adds shredder methods to | |
188 | RT objects and classes. The API is not well documented yet, but you | |
189 | can find usage examples in L<rt-shredder> and the | |
190 | F<lib/t/regression/shredder/*.t> test files. | |
191 | ||
192 | However, here is a small example that do the same action as in CLI | |
193 | example from L</SYNOPSIS>: | |
194 | ||
195 | use RT::Shredder; | |
196 | RT::Shredder::Init( force => 1 ); | |
197 | my $deleted = RT::Tickets->new( RT->SystemUser ); | |
198 | $deleted->{'allow_deleted_search'} = 1; | |
199 | $deleted->LimitQueue( VALUE => 'general' ); | |
200 | $deleted->LimitStatus( VALUE => 'deleted' ); | |
201 | while( my $t = $deleted->Next ) { | |
202 | $t->Wipeout; | |
203 | } | |
204 | ||
205 | ||
206 | =head2 RT::Shredder class' API | |
207 | ||
208 | L<RT::Shredder> implements interfaces to objects cache, actions on the | |
209 | objects in the cache and backups storage. | |
210 | ||
211 | =cut | |
212 | ||
84fb5b46 MKG |
213 | use File::Spec (); |
214 | ||
215 | ||
216 | BEGIN { | |
217 | # I can't use 'use lib' here since it breakes tests | |
218 | # because test suite uses old RT::Shredder setup from | |
219 | # RT lib path | |
220 | ||
221 | ### after: push @INC, qw(@RT_LIB_PATH@); | |
222 | use RT::Shredder::Constants; | |
223 | use RT::Shredder::Exceptions; | |
224 | ||
225 | require RT; | |
226 | ||
227 | require RT::Shredder::Record; | |
228 | ||
229 | require RT::Shredder::ACE; | |
230 | require RT::Shredder::Attachment; | |
231 | require RT::Shredder::CachedGroupMember; | |
232 | require RT::Shredder::CustomField; | |
233 | require RT::Shredder::CustomFieldValue; | |
234 | require RT::Shredder::GroupMember; | |
235 | require RT::Shredder::Group; | |
236 | require RT::Shredder::Link; | |
237 | require RT::Shredder::Principal; | |
238 | require RT::Shredder::Queue; | |
239 | require RT::Shredder::Scrip; | |
240 | require RT::Shredder::ScripAction; | |
241 | require RT::Shredder::ScripCondition; | |
242 | require RT::Shredder::Template; | |
243 | require RT::Shredder::ObjectCustomFieldValue; | |
244 | require RT::Shredder::Ticket; | |
245 | require RT::Shredder::Transaction; | |
246 | require RT::Shredder::User; | |
247 | } | |
248 | ||
249 | our @SUPPORTED_OBJECTS = qw( | |
250 | ACE | |
251 | Attachment | |
252 | CachedGroupMember | |
253 | CustomField | |
254 | CustomFieldValue | |
255 | GroupMember | |
256 | Group | |
257 | Link | |
258 | Principal | |
259 | Queue | |
260 | Scrip | |
261 | ScripAction | |
262 | ScripCondition | |
263 | Template | |
264 | ObjectCustomFieldValue | |
265 | Ticket | |
266 | Transaction | |
267 | User | |
268 | ); | |
269 | ||
270 | =head3 GENERIC | |
271 | ||
272 | =head4 Init | |
273 | ||
274 | RT::Shredder::Init( %default_options ); | |
275 | ||
276 | C<RT::Shredder::Init()> should be called before creating an | |
277 | RT::Shredder object. It iniitalizes RT and loads the RT | |
278 | configuration. | |
279 | ||
280 | %default_options are passed to every C<<RT::Shredder->new>> call. | |
281 | ||
282 | =cut | |
283 | ||
284 | our %opt = (); | |
285 | ||
286 | sub Init | |
287 | { | |
288 | %opt = @_; | |
289 | RT::LoadConfig(); | |
290 | RT::Init(); | |
291 | } | |
292 | ||
293 | =head4 new | |
294 | ||
295 | my $shredder = RT::Shredder->new(%options); | |
296 | ||
297 | Construct a new RT::Shredder object. | |
298 | ||
299 | There currently are no %options. | |
300 | ||
301 | =cut | |
302 | ||
303 | sub new | |
304 | { | |
305 | my $proto = shift; | |
306 | my $self = bless( {}, ref $proto || $proto ); | |
307 | $self->_Init( @_ ); | |
308 | return $self; | |
309 | } | |
310 | ||
311 | sub _Init | |
312 | { | |
313 | my $self = shift; | |
314 | $self->{'opt'} = { %opt, @_ }; | |
315 | $self->{'cache'} = {}; | |
316 | $self->{'resolver'} = {}; | |
317 | $self->{'dump_plugins'} = []; | |
318 | } | |
319 | ||
320 | =head4 CastObjectsToRecords( Objects => undef ) | |
321 | ||
322 | Cast objects to the C<RT::Record> objects or its ancesstors. | |
323 | Objects can be passed as SCALAR (format C<< <class>-<id> >>), | |
324 | ARRAY, C<RT::Record> ancesstors or C<RT::SearchBuilder> ancesstor. | |
325 | ||
326 | Most methods that takes C<Objects> argument use this method to | |
327 | cast argument value to list of records. | |
328 | ||
329 | Returns an array of records. | |
330 | ||
331 | For example: | |
332 | ||
333 | my @objs = $shredder->CastObjectsToRecords( | |
334 | Objects => [ # ARRAY reference | |
335 | 'RT::Attachment-10', # SCALAR or SCALAR reference | |
336 | $tickets, # RT::Tickets object (isa RT::SearchBuilder) | |
337 | $user, # RT::User object (isa RT::Record) | |
338 | ], | |
339 | ); | |
340 | ||
341 | =cut | |
342 | ||
343 | sub CastObjectsToRecords | |
344 | { | |
345 | my $self = shift; | |
346 | my %args = ( Objects => undef, @_ ); | |
347 | ||
348 | my @res; | |
349 | my $targets = delete $args{'Objects'}; | |
350 | unless( $targets ) { | |
351 | RT::Shredder::Exception->throw( "Undefined Objects argument" ); | |
352 | } | |
353 | ||
354 | if( UNIVERSAL::isa( $targets, 'RT::SearchBuilder' ) ) { | |
355 | #XXX: try to use ->_DoSearch + ->ItemsArrayRef in feature | |
356 | # like we do in Record with links, but change only when | |
357 | # more tests would be available | |
358 | while( my $tmp = $targets->Next ) { push @res, $tmp }; | |
359 | } elsif ( UNIVERSAL::isa( $targets, 'RT::Record' ) ) { | |
360 | push @res, $targets; | |
361 | } elsif ( UNIVERSAL::isa( $targets, 'ARRAY' ) ) { | |
362 | foreach( @$targets ) { | |
363 | push @res, $self->CastObjectsToRecords( Objects => $_ ); | |
364 | } | |
365 | } elsif ( UNIVERSAL::isa( $targets, 'SCALAR' ) || !ref $targets ) { | |
366 | $targets = $$targets if ref $targets; | |
367 | my ($class, $id) = split /-/, $targets; | |
368 | RT::Shredder::Exception->throw( "Unsupported class $class" ) | |
369 | unless $class =~ /^\w+(::\w+)*$/; | |
370 | $class = 'RT::'. $class unless $class =~ /^RTx?::/i; | |
371 | eval "require $class"; | |
372 | die "Couldn't load '$class' module" if $@; | |
373 | my $obj = $class->new( RT->SystemUser ); | |
374 | die "Couldn't construct new '$class' object" unless $obj; | |
375 | $obj->Load( $id ); | |
376 | unless ( $obj->id ) { | |
377 | $RT::Logger->error( "Couldn't load '$class' object with id '$id'" ); | |
378 | RT::Shredder::Exception::Info->throw( 'CouldntLoadObject' ); | |
379 | } | |
380 | die "Loaded object has different id" unless( $id eq $obj->id ); | |
381 | push @res, $obj; | |
382 | } else { | |
383 | RT::Shredder::Exception->throw( "Unsupported type ". ref $targets ); | |
384 | } | |
385 | return @res; | |
386 | } | |
387 | ||
388 | =head3 OBJECTS CACHE | |
389 | ||
390 | =head4 PutObjects( Objects => undef ) | |
391 | ||
392 | Puts objects into cache. | |
393 | ||
394 | Returns array of the cache entries. | |
395 | ||
396 | See C<CastObjectsToRecords> method for supported types of the C<Objects> | |
397 | argument. | |
398 | ||
399 | =cut | |
400 | ||
401 | sub PutObjects | |
402 | { | |
403 | my $self = shift; | |
404 | my %args = ( Objects => undef, @_ ); | |
405 | ||
406 | my @res; | |
407 | for( $self->CastObjectsToRecords( Objects => delete $args{'Objects'} ) ) { | |
408 | push @res, $self->PutObject( %args, Object => $_ ) | |
409 | } | |
410 | ||
411 | return @res; | |
412 | } | |
413 | ||
414 | =head4 PutObject( Object => undef ) | |
415 | ||
416 | Puts record object into cache and returns its cache entry. | |
417 | ||
418 | B<NOTE> that this method support B<only C<RT::Record> object or its ancesstor | |
419 | objects>, if you want put mutliple objects or objects represented by different | |
420 | classes then use C<PutObjects> method instead. | |
421 | ||
422 | =cut | |
423 | ||
424 | sub PutObject | |
425 | { | |
426 | my $self = shift; | |
427 | my %args = ( Object => undef, @_ ); | |
428 | ||
429 | my $obj = $args{'Object'}; | |
430 | unless( UNIVERSAL::isa( $obj, 'RT::Record' ) ) { | |
431 | RT::Shredder::Exception->throw( "Unsupported type '". (ref $obj || $obj || '(undef)')."'" ); | |
432 | } | |
433 | ||
434 | my $str = $obj->_AsString; | |
435 | return ($self->{'cache'}->{ $str } ||= { State => ON_STACK, Object => $obj } ); | |
436 | } | |
437 | ||
438 | =head4 GetObject, GetState, GetRecord( String => ''| Object => '' ) | |
439 | ||
440 | Returns record object from cache, cache entry state or cache entry accordingly. | |
441 | ||
442 | All three methods takes C<String> (format C<< <class>-<id> >>) or C<Object> argument. | |
443 | C<String> argument has more priority than C<Object> so if it's not empty then methods | |
444 | leave C<Object> argument unchecked. | |
445 | ||
446 | You can read about possible states and their meanings in L<RT::Shredder::Constants> docs. | |
447 | ||
448 | =cut | |
449 | ||
450 | sub _ParseRefStrArgs | |
451 | { | |
452 | my $self = shift; | |
453 | my %args = ( | |
454 | String => '', | |
455 | Object => undef, | |
456 | @_ | |
457 | ); | |
458 | if( $args{'String'} && $args{'Object'} ) { | |
459 | require Carp; | |
460 | Carp::croak( "both String and Object args passed" ); | |
461 | } | |
462 | return $args{'String'} if $args{'String'}; | |
463 | return $args{'Object'}->_AsString if UNIVERSAL::can($args{'Object'}, '_AsString' ); | |
464 | return ''; | |
465 | } | |
466 | ||
467 | sub GetObject { return (shift)->GetRecord( @_ )->{'Object'} } | |
468 | sub GetState { return (shift)->GetRecord( @_ )->{'State'} } | |
469 | sub GetRecord | |
470 | { | |
471 | my $self = shift; | |
472 | my $str = $self->_ParseRefStrArgs( @_ ); | |
473 | return $self->{'cache'}->{ $str }; | |
474 | } | |
475 | ||
476 | =head3 Dependencies resolvers | |
477 | ||
478 | =head4 PutResolver, GetResolvers and ApplyResolvers | |
479 | ||
480 | TODO: These methods have no documentation. | |
481 | ||
482 | =cut | |
483 | ||
484 | sub PutResolver | |
485 | { | |
486 | my $self = shift; | |
487 | my %args = ( | |
488 | BaseClass => '', | |
489 | TargetClass => '', | |
490 | Code => undef, | |
491 | @_, | |
492 | ); | |
493 | unless( UNIVERSAL::isa( $args{'Code'} => 'CODE' ) ) { | |
494 | die "Resolver '$args{Code}' is not code reference"; | |
495 | } | |
496 | ||
497 | my $resolvers = ( | |
498 | ( | |
499 | $self->{'resolver'}->{ $args{'BaseClass'} } ||= {} | |
500 | )->{ $args{'TargetClass'} || '' } ||= [] | |
501 | ); | |
502 | unshift @$resolvers, $args{'Code'}; | |
503 | return; | |
504 | } | |
505 | ||
506 | sub GetResolvers | |
507 | { | |
508 | my $self = shift; | |
509 | my %args = ( | |
510 | BaseClass => '', | |
511 | TargetClass => '', | |
512 | @_, | |
513 | ); | |
514 | ||
515 | my @res; | |
516 | if( $args{'TargetClass'} && exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} } ) { | |
517 | push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} || '' } }; | |
518 | } | |
519 | if( exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ '' } ) { | |
520 | push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{''} }; | |
521 | } | |
522 | ||
523 | return @res; | |
524 | } | |
525 | ||
526 | sub ApplyResolvers | |
527 | { | |
528 | my $self = shift; | |
529 | my %args = ( Dependency => undef, @_ ); | |
530 | my $dep = $args{'Dependency'}; | |
531 | ||
532 | my @resolvers = $self->GetResolvers( | |
533 | BaseClass => $dep->BaseClass, | |
534 | TargetClass => $dep->TargetClass, | |
535 | ); | |
536 | ||
537 | unless( @resolvers ) { | |
538 | RT::Shredder::Exception::Info->throw( | |
539 | tag => 'NoResolver', | |
540 | error => "Couldn't find resolver for dependency '". $dep->AsString ."'", | |
541 | ); | |
542 | } | |
543 | $_->( | |
544 | Shredder => $self, | |
545 | BaseObject => $dep->BaseObject, | |
546 | TargetObject => $dep->TargetObject, | |
547 | ) foreach @resolvers; | |
548 | ||
549 | return; | |
550 | } | |
551 | ||
552 | sub WipeoutAll | |
553 | { | |
554 | my $self = $_[0]; | |
555 | ||
dab09ea8 MKG |
556 | foreach my $cache_val ( values %{ $self->{'cache'} } ) { |
557 | next if $cache_val->{'State'} & (WIPED | IN_WIPING); | |
558 | $self->Wipeout( Object => $cache_val->{'Object'} ); | |
84fb5b46 MKG |
559 | } |
560 | } | |
561 | ||
562 | sub Wipeout | |
563 | { | |
564 | my $self = shift; | |
565 | my $mark; | |
566 | eval { | |
567 | die "Couldn't begin transaction" unless $RT::Handle->BeginTransaction; | |
568 | $mark = $self->PushDumpMark or die "Couldn't get dump mark"; | |
569 | $self->_Wipeout( @_ ); | |
570 | $self->PopDumpMark( Mark => $mark ); | |
571 | die "Couldn't commit transaction" unless $RT::Handle->Commit; | |
572 | }; | |
573 | if( $@ ) { | |
574 | my $error = $@; | |
575 | $RT::Handle->Rollback('force'); | |
576 | $self->RollbackDumpTo( Mark => $mark ) if $mark; | |
577 | die $error if RT::Shredder::Exception::Info->caught; | |
578 | die "Couldn't wipeout object: $error"; | |
579 | } | |
580 | } | |
581 | ||
582 | sub _Wipeout | |
583 | { | |
584 | my $self = shift; | |
585 | my %args = ( CacheRecord => undef, Object => undef, @_ ); | |
586 | ||
587 | my $record = $args{'CacheRecord'}; | |
588 | $record = $self->PutObject( Object => $args{'Object'} ) unless $record; | |
589 | return if $record->{'State'} & (WIPED | IN_WIPING); | |
590 | ||
591 | $record->{'State'} |= IN_WIPING; | |
592 | my $object = $record->{'Object'}; | |
593 | ||
594 | $self->DumpObject( Object => $object, State => 'before any action' ); | |
595 | ||
596 | unless( $object->BeforeWipeout ) { | |
597 | RT::Shredder::Exception->throw( "BeforeWipeout check returned error" ); | |
598 | } | |
599 | ||
600 | my $deps = $object->Dependencies( Shredder => $self ); | |
601 | $deps->List( | |
602 | WithFlags => DEPENDS_ON | VARIABLE, | |
603 | Callback => sub { $self->ApplyResolvers( Dependency => $_[0] ) }, | |
604 | ); | |
605 | $self->DumpObject( Object => $object, State => 'after resolvers' ); | |
606 | ||
607 | $deps->List( | |
608 | WithFlags => DEPENDS_ON, | |
609 | WithoutFlags => WIPE_AFTER | VARIABLE, | |
610 | Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) }, | |
611 | ); | |
612 | $self->DumpObject( Object => $object, State => 'after wiping dependencies' ); | |
613 | ||
614 | $object->__Wipeout; | |
615 | $record->{'State'} |= WIPED; delete $record->{'Object'}; | |
616 | $self->DumpObject( Object => $object, State => 'after wipeout' ); | |
617 | ||
618 | $deps->List( | |
619 | WithFlags => DEPENDS_ON | WIPE_AFTER, | |
620 | WithoutFlags => VARIABLE, | |
621 | Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) }, | |
622 | ); | |
623 | $self->DumpObject( Object => $object, State => 'after late dependencies' ); | |
624 | ||
625 | return; | |
626 | } | |
627 | ||
84fb5b46 MKG |
628 | =head3 Data storage and backups |
629 | ||
630 | =head4 GetFileName( FileName => '<ISO DATETIME>-XXXX.sql', FromStorage => 1 ) | |
631 | ||
632 | Takes desired C<FileName> and flag C<FromStorage> then translate file name to absolute | |
633 | path by next rules: | |
634 | ||
635 | * Default value of the C<FileName> option is C<< <ISO DATETIME>-XXXX.sql >>; | |
636 | ||
637 | * 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; | |
638 | ||
639 | * 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. | |
640 | ||
641 | * if C<FromStorage> argument is true (default behaviour) then result path would always be relative to C<StoragePath>; | |
642 | ||
643 | * if C<FromStorage> argument is false then result would be relative to the current dir unless it's already absolute path. | |
644 | ||
645 | Returns an absolute path of the file. | |
646 | ||
647 | Examples: | |
648 | # file from storage with default name format | |
649 | my $fname = $shredder->GetFileName; | |
650 | ||
651 | # file from storage with custom name format | |
652 | my $fname = $shredder->GetFileName( FileName => 'shredder-XXXX.backup' ); | |
653 | ||
654 | # file with path relative to the current dir | |
655 | my $fname = $shredder->GetFileName( | |
656 | FromStorage => 0, | |
657 | FileName => 'backups/shredder.sql', | |
658 | ); | |
659 | ||
660 | # file with absolute path | |
661 | my $fname = $shredder->GetFileName( | |
662 | FromStorage => 0, | |
663 | FileName => '/var/backups/shredder-XXXX.sql' | |
664 | ); | |
665 | ||
666 | =cut | |
667 | ||
668 | sub GetFileName | |
669 | { | |
670 | my $self = shift; | |
671 | my %args = ( FileName => '', FromStorage => 1, @_ ); | |
672 | ||
673 | # default value | |
674 | my $file = $args{'FileName'} || '%t-XXXX.sql'; | |
675 | if( $file =~ /\%t/i ) { | |
676 | require POSIX; | |
677 | my $date_time = POSIX::strftime( "%Y%m%dT%H%M%S", gmtime ); | |
678 | $file =~ s/\%t/$date_time/gi; | |
679 | } | |
680 | ||
681 | # convert to absolute path | |
682 | if( $args{'FromStorage'} ) { | |
683 | $file = File::Spec->catfile( $self->StoragePath, $file ); | |
684 | } elsif( !File::Spec->file_name_is_absolute( $file ) ) { | |
685 | $file = File::Spec->rel2abs( $file ); | |
686 | } | |
687 | ||
688 | # check mask | |
689 | if( $file =~ /XXXX[^\/\\]*$/ ) { | |
690 | my( $tmp, $i ) = ( $file, 0 ); | |
691 | do { | |
692 | $i++; | |
693 | $tmp = $file; | |
694 | $tmp =~ s/XXXX([^\/\\]*)$/sprintf("%04d", $i).$1/e; | |
695 | } while( -e $tmp && $i < 9999 ); | |
696 | $file = $tmp; | |
697 | } | |
698 | ||
699 | if( -f $file ) { | |
700 | unless( -w _ ) { | |
701 | die "File '$file' exists, but is read-only"; | |
702 | } | |
703 | } elsif( !-e _ ) { | |
704 | unless( File::Spec->file_name_is_absolute( $file ) ) { | |
705 | $file = File::Spec->rel2abs( $file ); | |
706 | } | |
707 | ||
708 | # check base dir | |
709 | my $dir = File::Spec->join( (File::Spec->splitpath( $file ))[0,1] ); | |
710 | unless( -e $dir && -d _) { | |
711 | die "Base directory '$dir' for file '$file' doesn't exist"; | |
712 | } | |
713 | unless( -w $dir ) { | |
714 | die "Base directory '$dir' is not writable"; | |
715 | } | |
716 | } else { | |
717 | die "'$file' is not regular file"; | |
718 | } | |
719 | ||
720 | return $file; | |
721 | } | |
722 | ||
723 | =head4 StoragePath | |
724 | ||
725 | Returns an absolute path to the storage dir. See | |
c36a7e1d | 726 | L</$ShredderStoragePath>. |
84fb5b46 MKG |
727 | |
728 | See also description of the L</GetFileName> method. | |
729 | ||
730 | =cut | |
731 | ||
732 | sub StoragePath | |
733 | { | |
734 | return scalar( RT->Config->Get('ShredderStoragePath') ) | |
735 | || File::Spec->catdir( $RT::VarPath, qw(data RT-Shredder) ); | |
736 | } | |
737 | ||
738 | my %active_dump_state = (); | |
739 | sub AddDumpPlugin { | |
740 | my $self = shift; | |
741 | my %args = ( Object => undef, Name => 'SQLDump', Arguments => undef, @_ ); | |
742 | ||
743 | my $plugin = $args{'Object'}; | |
744 | unless ( $plugin ) { | |
745 | require RT::Shredder::Plugin; | |
746 | $plugin = RT::Shredder::Plugin->new; | |
747 | my( $status, $msg ) = $plugin->LoadByName( $args{'Name'} ); | |
748 | die "Couldn't load dump plugin: $msg\n" unless $status; | |
749 | } | |
750 | die "Plugin is not of correct type" unless lc $plugin->Type eq 'dump'; | |
751 | ||
752 | if ( my $pargs = $args{'Arguments'} ) { | |
753 | my ($status, $msg) = $plugin->TestArgs( %$pargs ); | |
754 | die "Couldn't set plugin args: $msg\n" unless $status; | |
755 | } | |
756 | ||
757 | my @applies_to = $plugin->AppliesToStates; | |
758 | die "Plugin doesn't apply to any state" unless @applies_to; | |
759 | $active_dump_state{ lc $_ } = 1 foreach @applies_to; | |
760 | ||
761 | push @{ $self->{'dump_plugins'} }, $plugin; | |
762 | ||
763 | return $plugin; | |
764 | } | |
765 | ||
766 | sub DumpObject { | |
767 | my $self = shift; | |
768 | my %args = (Object => undef, State => undef, @_); | |
769 | die "No state passed" unless $args{'State'}; | |
770 | return unless $active_dump_state{ lc $args{'State'} }; | |
771 | ||
772 | foreach (@{ $self->{'dump_plugins'} }) { | |
773 | next unless grep lc $args{'State'} eq lc $_, $_->AppliesToStates; | |
774 | my ($state, $msg) = $_->Run( %args ); | |
775 | die "Couldn't run plugin: $msg" unless $state; | |
776 | } | |
777 | } | |
778 | ||
779 | { my $mark = 1; # XXX: integer overflows? | |
780 | sub PushDumpMark { | |
781 | my $self = shift; | |
782 | $mark++; | |
783 | foreach (@{ $self->{'dump_plugins'} }) { | |
784 | my ($state, $msg) = $_->PushMark( Mark => $mark ); | |
785 | die "Couldn't push mark: $msg" unless $state; | |
786 | } | |
787 | return $mark; | |
788 | } | |
789 | sub PopDumpMark { | |
790 | my $self = shift; | |
791 | foreach (@{ $self->{'dump_plugins'} }) { | |
792 | my ($state, $msg) = $_->PushMark( @_ ); | |
793 | die "Couldn't pop mark: $msg" unless $state; | |
794 | } | |
795 | } | |
796 | sub RollbackDumpTo { | |
797 | my $self = shift; | |
798 | foreach (@{ $self->{'dump_plugins'} }) { | |
799 | my ($state, $msg) = $_->RollbackTo( @_ ); | |
800 | die "Couldn't rollback to mark: $msg" unless $state; | |
801 | } | |
802 | } | |
803 | } | |
804 | ||
805 | 1; | |
806 | __END__ | |
807 | ||
808 | =head1 NOTES | |
809 | ||
810 | =head2 Database transactions support | |
811 | ||
812 | Since 0.03_01 RT::Shredder uses database transactions and should be | |
813 | much safer to run on production servers. | |
814 | ||
815 | =head2 Foreign keys | |
816 | ||
817 | Mainstream RT doesn't use FKs, but at least I posted DDL script that creates them | |
818 | in mysql DB, note that if you use FKs then this two valid keys don't allow delete | |
819 | Tickets because of bug in MySQL: | |
820 | ||
821 | ALTER TABLE Tickets ADD FOREIGN KEY (EffectiveId) REFERENCES Tickets(id); | |
822 | ALTER TABLE CachedGroupMembers ADD FOREIGN KEY (Via) REFERENCES CachedGroupMembers(id); | |
823 | ||
824 | L<http://bugs.mysql.com/bug.php?id=4042> | |
825 | ||
826 | =head1 BUGS AND HOW TO CONTRIBUTE | |
827 | ||
828 | We need your feedback in all cases: if you use it or not, | |
829 | is it works for you or not. | |
830 | ||
831 | =head2 Testing | |
832 | ||
833 | Don't skip C<make test> step while install and send me reports if it's fails. | |
834 | Add your own tests, it's easy enough if you've writen at list one perl script | |
835 | that works with RT. Read more about testing in F<t/utils.pl>. | |
836 | ||
837 | =head2 Reporting | |
838 | ||
839 | Send reports to L</AUTHOR> or to the RT mailing lists. | |
840 | ||
841 | =head2 Documentation | |
842 | ||
843 | Many bugs in the docs: insanity, spelling, gramar and so on. | |
844 | Patches are wellcome. | |
845 | ||
846 | =head2 Todo | |
847 | ||
848 | Please, see Todo file, it has some technical notes | |
849 | about what I plan to do, when I'll do it, also it | |
850 | describes some problems code has. | |
851 | ||
852 | =head2 Repository | |
853 | ||
854 | Since RT-3.7 shredder is a part of the RT distribution. | |
855 | Versions of the RTx::Shredder extension could | |
856 | be downloaded from the CPAN. Those work with older | |
857 | RT versions or you can find repository at | |
858 | L<https://opensvn.csie.org/rtx_shredder> | |
859 | ||
860 | =head1 AUTHOR | |
861 | ||
862 | Ruslan U. Zakirov <Ruslan.Zakirov@gmail.com> | |
863 | ||
864 | =head1 COPYRIGHT | |
865 | ||
866 | This program is free software; you can redistribute | |
867 | it and/or modify it under the same terms as Perl itself. | |
868 | ||
869 | The full text of the license can be found in the | |
870 | Perl distribution. | |
871 | ||
872 | =head1 SEE ALSO | |
873 | ||
874 | L<rt-shredder>, L<rt-validator> | |
875 | ||
876 | =cut |