root/trunk/omnipitr/lib/OmniPITR/Program/Backup.pm

Revision 210, 10.8 kB (checked in by brian, 3 years ago)

tid14898 - localize signal handler use

Line 
1 package OmniPITR::Program::Backup;
2 use strict;
3 use warnings;
4
5 use base qw( OmniPITR::Program );
6
7 use File::Spec;
8 use File::Path qw( mkpath rmtree );
9 use English qw( -no_match_vars );
10 use OmniPITR::Tools qw( ext_for_compression run_command );
11 use Cwd;
12
13 =head1 run()
14
15 Main function wrapping all work.
16
17 Starts with getting list of compressions that have to be done, then it
18 chooses where to compress to (important if we have remote-only destination),
19 then it makes actual backup, and delivers to all destinations.
20
21 =cut
22
23 sub run {
24     my $self = shift;
25     $self->get_list_of_all_necessary_compressions();
26     $self->choose_base_local_destinations();
27
28     $self->log->time_start( 'Making data archive' ) if $self->verbose;
29     $self->make_data_archive();
30     $self->log->time_finish( 'Making data archive' ) if $self->verbose;
31
32     $self->log->time_start( 'Making xlog archive' ) if $self->verbose;
33     $self->make_xlog_archive();
34     $self->log->time_finish( 'Making xlog archive' ) if $self->verbose;
35
36     $self->deliver_to_all_destinations();
37
38     $self->log->log( 'All done.' );
39     return;
40 }
41
42 =head1 make_xlog_archive()
43
44 Just a stub method, that has to be overriden in subclasses.
45
46 =cut
47
48 sub make_xlog_archive {
49     my $self = shift;
50     croak( "make_xlog_archive() method in OmniPITR::Program::Backup was not overridden!" );
51 }
52
53 =head1 choose_base_local_destinations()
54
55 Chooses single local destination for every compression schema required by
56 destinations specifications.
57
58 In case some compression schema exists only for remote destination, local
59 temp directory is created in --temp-dir location.
60
61 =cut
62
63 sub choose_base_local_destinations {
64     my $self = shift;
65
66     my $base = { map { ( $_ => undef ) } @{ $self->{ 'compressions' } } };
67     $self->{ 'base' } = $base;
68
69     for my $dst ( @{ $self->{ 'destination' }->{ 'local' } } ) {
70         my $type = $dst->{ 'compression' };
71         next if defined $base->{ $type };
72         $base->{ $type } = $dst->{ 'path' };
73     }
74
75     my @unfilled = grep { !defined $base->{ $_ } } keys %{ $base };
76
77     return if 0 == scalar @unfilled;
78     $self->log->log( 'These compression(s) were given only for remote destinations. Usually this is not desired: %s', join( ', ', @unfilled ) );
79
80     $self->prepare_temp_directory();
81     for my $type ( @unfilled ) {
82         my $tmp_dir = File::Spec->catfile( $self->{ 'temp-dir' }, $type );
83         mkpath( $tmp_dir );
84         $base->{ $type } = $tmp_dir;
85     }
86
87     return;
88 }
89
90 =head1 start_writers()
91
92 Starts set of filehandles, which write to file, or to compression program,
93 to create final archives.
94
95 Each compression schema gets its own filehandle, and printing data to it,
96 will pass it to file directly or through compression program that has been
97 chosen based on command line arguments.
98
99 =cut
100
101 sub start_writers {
102     my $self      = shift;
103     my $data_type = shift;
104
105     my %writers = ();
106
107     COMPRESSION:
108     while ( my ( $type, $dst_path ) = each %{ $self->{ 'base' } } ) {
109         my $filename = $self->get_archive_filename( $data_type, $type );
110
111         my $full_file_path = File::Spec->catfile( $dst_path, $filename );
112
113         if ( $type eq 'none' ) {
114             if ( open my $fh, '>', $full_file_path ) {
115                 $writers{ $type } = $fh;
116                 $self->log->log( "Starting \"none\" writer to $full_file_path" ) if $self->verbose;
117                 next COMPRESSION;
118             }
119             $self->log->fatal( 'Cannot write to %s : %s', $full_file_path, $OS_ERROR );
120         }
121
122         my @command = map { quotemeta $_ } ( $self->{ $type . '-path' }, '--stdout', '-' );
123         unshift @command, quotemeta( $self->{ 'nice-path' } ) unless $self->{ 'not-nice' };
124         push @command, ( '>', quotemeta( $full_file_path ) );
125
126         $self->log->log( "Starting \"%s\" writer to %s", $type, $full_file_path ) if $self->verbose;
127         if ( open my $fh, '|-', join( ' ', @command ) ) {
128             $writers{ $type } = $fh;
129             next COMPRESSION;
130         }
131         $self->log->fatal( 'Cannot open command. Error: %s, Command: %s', $OS_ERROR, \@command );
132     }
133     $self->{ 'writers' } = \%writers;
134     return;
135 }
136
137 =head1 get_archive_filename()
138
139 Helper function, which takes filetype and compression schema to use, and
140 returns generated filename (based on filename-template command line option).
141
142 =cut
143
144 sub get_archive_filename {
145     my $self = shift;
146     my ( $type, $compression ) = @_;
147
148     $compression = 'none' unless defined $compression;
149
150     my $ext = $compression eq 'none' ? '' : ext_for_compression( $compression );
151
152     my $filename = $self->{ 'filename-template' };
153     $filename =~ s/__FILETYPE__/$type/g;
154     $filename =~ s/__CEXT__/$ext/g;
155
156     return $filename;
157 }
158
159 =head1 tar_and_compress()
160
161 Worker function which does all of the actual tar, and sending data to
162 compression filehandles (should be opened before).
163
164 Takes hash (not hashref) as argument, and uses following keys from it:
165
166 =over
167
168 =item * tar_dir - arrayref with list of directories to compress
169
170 =item * work_dir - what should be current working directory when executing
171 tar
172
173 =item * excludes - optional key, that (if exists) is treated as arrayref of
174 shell globs (tar dir) of items to exclude from backup
175
176 =item * transform - optional key, that (if exists) is treated as value for
177 --transform option for tar
178
179 =back
180
181 If tar will print anything to STDERR it will be logged. Error status code is
182 ignored, as it is expected that tar will generate errors (due to files
183 modified while archiving).
184
185 Requires following keys in $self:
186
187 =over
188
189 =item * nice-path
190
191 =item * tar-path
192
193 =back
194
195 =cut
196
197 sub tar_and_compress {
198     my $self = shift;
199     my %ARGS = @_;
200
201     local $SIG{ 'PIPE' } = sub { $self->log->fatal( 'Got SIGPIPE while tarring %s for %s', $ARGS{ 'tar_dir' }, $self->{ 'sigpipeinfo' } ); };
202
203     my @compression_command = ( $self->{ 'tar-path' }, 'cf', '-' );
204     unshift @compression_command, $self->{ 'nice-path' } unless $self->{ 'not-nice' };
205
206     if ( $ARGS{ 'excludes' } ) {
207         push @compression_command, map { '--exclude=' . $_ } @{ $ARGS{ 'excludes' } };
208     }
209
210     if ( $ARGS{ 'transform' } ) {
211         push @compression_command, '--transform=' . $ARGS{ 'transform' };
212     }
213
214     push @compression_command, @{ $ARGS{ 'tar_dir' } };
215
216     my $compression_str = join ' ', map { quotemeta $_ } @compression_command;
217
218     $self->prepare_temp_directory();
219
220     my $tar_stderr_filename = File::Spec->catfile( $self->{ 'temp-dir' }, 'tar.stderr' );
221     $compression_str .= ' 2> ' . quotemeta( $tar_stderr_filename );
222
223     my $previous_dir = getcwd;
224     chdir $ARGS{ 'work_dir' } if $ARGS{ 'work_dir' };
225
226     my $tar;
227     unless ( open $tar, '-|', $compression_str ) {
228         $self->log->fatal( 'Cannot start tar (%s) : %s', $compression_str, $OS_ERROR );
229     }
230
231     chdir $previous_dir if $ARGS{ 'work_dir' };
232
233     my $buffer;
234     while ( my $len = sysread( $tar, $buffer, 8192 ) ) {
235         while ( my ( $type, $fh ) = each %{ $self->{ 'writers' } } ) {
236             $self->{ 'sigpipeinfo' } = $type;
237             my $written = syswrite( $fh, $buffer, $len );
238             next if $written == $len;
239             $self->log->fatal( "Writting %u bytes to filehandle for <%s> compression wrote only %u bytes ?!", $len, $type, $written );
240         }
241     }
242     close $tar;
243
244     for my $fh ( values %{ $self->{ 'writers' } } ) {
245         close $fh;
246     }
247
248     delete $self->{ 'writers' };
249
250     my $stderr_output;
251     my $stderr;
252     unless ( open $stderr, '<', $tar_stderr_filename ) {
253         $self->log->log( 'Cannot open tar stderr file (%s) for reading: %s', $tar_stderr_filename );
254         return;
255     }
256     {
257         local $/;
258         $stderr_output = <$stderr>;
259     };
260     close $stderr;
261     return unless $stderr_output;
262     $self->log->log( 'Tar (%s) generated these output on stderr:', $compression_str );
263     $self->log->log( '==============================================' );
264     $self->log->log( '%s', $stderr_output );
265     $self->log->log( '==============================================' );
266     unlink $tar_stderr_filename;
267     return;
268 }
269
270 =head1 deliver_to_all_destinations()
271
272 Simple wrapper to have single point to call to deliver backups to all
273 requested backups.
274
275 =cut
276
277 sub deliver_to_all_destinations {
278     my $self = shift;
279
280     $self->deliver_to_all_local_destinations();
281
282     $self->deliver_to_all_remote_destinations();
283
284     return;
285 }
286
287 =head1 deliver_to_all_local_destinations()
288
289 Copies backups to all local destinations which are not also base
290 destinations for their respective compressions.
291
292 =cut
293
294 sub deliver_to_all_local_destinations {
295     my $self = shift;
296     return unless $self->{ 'destination' }->{ 'local' };
297     for my $dst ( @{ $self->{ 'destination' }->{ 'local' } } ) {
298         next if $dst->{ 'path' } eq $self->{ 'base' }->{ $dst->{ 'compression' } };
299
300         my $B = $self->{ 'base' }->{ $dst->{ 'compression' } };
301
302         for my $type ( qw( data xlog ) ) {
303
304             my $filename = $self->get_archive_filename( $type, $dst->{ 'compression' } );
305             my $source_filename = File::Spec->catfile( $B, $filename );
306             my $destination_filename = File::Spec->catfile( $dst->{ 'path' }, $filename );
307
308             my $time_msg = sprintf 'Copying %s to %s', $source_filename, $destination_filename;
309             $self->log->time_start( $time_msg ) if $self->verbose;
310
311             my $rc = copy( $source_filename, $destination_filename );
312
313             $self->log->time_finish( $time_msg ) if $self->verbose;
314
315             unless ( $rc ) {
316                 $self->log->error( 'Cannot copy %s to %s : %s', $source_filename, $destination_filename, $OS_ERROR );
317                 $self->{ 'had_errors' } = 1;
318             }
319
320         }
321     }
322     return;
323 }
324
325 =head1 deliver_to_all_remote_destinations()
326
327 Delivers backups to remote destinations using rsync program.
328
329 =cut
330
331 sub deliver_to_all_remote_destinations {
332     my $self = shift;
333     return unless $self->{ 'destination' }->{ 'remote' };
334     for my $dst ( @{ $self->{ 'destination' }->{ 'remote' } } ) {
335
336         my $B = $self->{ 'base' }->{ $dst->{ 'compression' } };
337
338         for my $type ( qw( data xlog ) ) {
339
340             my $filename = $self->get_archive_filename( $type, $dst->{ 'compression' } );
341             my $source_filename = File::Spec->catfile( $B, $filename );
342             my $destination_filename = $dst->{ 'path' };
343             $destination_filename =~ s{/*\z}{/};
344             $destination_filename .= $filename;
345
346             my $time_msg = sprintf 'Copying %s to %s', $source_filename, $destination_filename;
347             $self->log->time_start( $time_msg ) if $self->verbose;
348
349             my $response = run_command( $self->{ 'temp-dir' }, $self->{ 'rsync-path' }, $source_filename, $destination_filename );
350
351             $self->log->time_finish( $time_msg ) if $self->verbose;
352
353             if ( $response->{ 'error_code' } ) {
354                 $self->log->error( 'Cannot send archive %s to %s: %s', $source_filename, $destination_filename, $response );
355                 $self->{ 'had_errors' } = 1;
356             }
357         }
358     }
359     return;
360 }
361
362 1;
Note: See TracBrowser for help on using the browser.