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