1 #! /usr/bin/perl |
1 #! /usr/bin/perl |
|
2 # (c) 2013 Heiko Schlittermann <hs@schlittermann.de> |
|
3 # source: hg clone https://ssl.schlittermann.de/amanda-plugin-dumpext |
|
4 # |
|
5 # This script should be a plugin to use ext2/3/4 dump/restore via the |
|
6 # APPLICATION interface of Amanda. The rationale behind is, that I'd like to use |
|
7 # dump(8) with different dumpdates files for the different backup types |
|
8 # (daily, weekly, …) |
|
9 # |
|
10 # The commands we need to support are required by the |
|
11 # API: http://wiki.zmanda.com/index.php/Application_API/Operations |
|
12 # |
|
13 # This script tries do be as standalone as possible. |
|
14 # Though we need the tools dump/restore as they exists for the ext2/3/4 |
|
15 # filesystems. |
|
16 |
2 use 5.010; |
17 use 5.010; |
3 use strict; |
18 use strict; |
4 use warnings; |
19 use warnings; |
5 use Pod::Usage; |
20 use Pod::Usage; |
6 use Getopt::Long; |
21 use Getopt::Long; |
7 use Readonly; |
22 use File::Basename; |
8 use DDP; |
23 use POSIX; |
|
24 |
|
25 #use Readonly; |
9 |
26 |
10 our $VERSION = '0.01'; |
27 our $VERSION = '0.01'; |
|
28 my $ME = basename $0; |
|
29 |
|
30 # to avoid stupid "not found" |
|
31 $ENV{PATH} .= ':/usr/local/sbin:/usr/sbin:/sbin'; |
11 |
32 |
12 use constant YES => 'YES'; |
33 use constant YES => 'YES'; |
13 use constant NO => 'NO'; |
34 use constant NO => 'NO'; |
14 use constant DUMPDATES => '/var/lib/dumpdates'; |
35 use constant DUMPDATES => '/var/lib/dumpdates'; |
15 use constant FD3 => 3; |
36 use constant FD3 => 3; |
16 use constant FD4 => 4; |
37 use constant FD4 => 4; |
17 |
38 |
18 Readonly my %SUPPORT => ( |
39 $SIG{__DIE__} = sub { die "$ME: ", @_ }; |
19 CONFIG => YES, # --config … (ignored?) |
40 |
20 HOST => YES, # --host … (ignored?) |
41 my %SUPPORT = ( |
21 DISK => YES, # --disk … (ignored?) |
42 CONFIG => YES, # --config … (default) |
22 MAX_LEVEL => 9, |
43 DISK => NO, # --disk … |
|
44 HOST => NO, # --host … |
|
45 MAX_LEVEL => 9, # --level … |
|
46 INDEX_LINE => YES, # --index line |
|
47 MESSAGE_LINE => YES, # --message line |
|
48 # |
23 CLIENT_ESTIMATE => YES, # estimate |
49 CLIENT_ESTIMATE => YES, # estimate |
24 MULTI_ESTIMATE => YES, # estimate for multiple levels |
50 MULTI_ESTIMATE => YES, # estimate for multiple levels |
25 CALCSIZE => YES, # estimate --calcsize |
51 CALCSIZE => NO, # estimate --calcsize |
26 MESSAGE_LINE => YES, # --message line |
52 # |
27 INDEX_LINE => NO, # --index line |
|
28 RECORD => YES, # --record |
53 RECORD => YES, # --record |
29 ); |
54 ); |
30 |
|
31 # the commands we need to support as required by the |
|
32 # API: http://wiki.zmanda.com/index.php/Application_API/Operations |
|
33 |
55 |
34 sub exec_support; |
56 sub exec_support; |
35 sub exec_selfcheck; |
57 sub exec_selfcheck; |
36 sub exec_estimate; |
58 sub exec_estimate; |
37 sub exec_backup; |
59 sub exec_backup; |
42 sub OK; |
64 sub OK; |
43 sub ERROR; |
65 sub ERROR; |
44 |
66 |
45 # bad but common style - the global options |
67 # bad but common style - the global options |
46 |
68 |
47 my $opt_config; # $config |
69 my $opt_config; # $config |
48 my $opt_host; # $host |
70 my $opt_device; # $device DLE[2] |
49 my $opt_disk; # $disk DLE[1] |
71 my $opt_message; # line / <> |
50 my $opt_device; # $device DLE[2] |
72 my $opt_index; # line / <> |
51 my $opt_message; # line / <> |
73 my $opt_record; # true / <> |
52 my $opt_index; # line / <> |
74 my @opt_level; # 0…99 |
53 my $opt_record; # true / <> |
|
54 my $opt_level; # 0…99 |
|
55 my $opt_calcsize; # true / <> |
|
56 |
75 |
57 my $opt_dumpdates; |
76 my $opt_dumpdates; |
58 |
77 |
59 MAIN: { |
78 MAIN: { |
60 my @argv = @ARGV; |
79 my @argv = @ARGV; |
61 my $command = shift // pod2usage; |
80 my $command = shift // pod2usage; |
62 GetOptions( |
81 GetOptions( |
63 |
82 'config=s' => \$opt_config, |
64 'config=s' => \$opt_config, |
83 'device=s' => \$opt_device, # --device $device |
65 'host=s' => \$opt_host, # --host $host |
84 'message=s' => \$opt_message, # --message line|xml |
66 'disk=s' => \$opt_disk, # --disk $disk |
85 'index=s' => \$opt_index, # --index line |
67 'device=s' => \$opt_device, # --device $device |
86 'record!' => \$opt_record, # --record |
68 'message=s' => \$opt_message, # --message line|xml |
87 'level=i@' => \@opt_level, # --level n |
69 'index=s' => \$opt_index, # --index line |
|
70 'record!' => \$opt_record, # --record |
|
71 'level=i@' => \$opt_level, # --level n |
|
72 'calcsize!' => \$opt_calcsize, |
|
73 |
|
74 'dumpdates=s' => \$opt_dumpdates, # --dumpdates <file> |
88 'dumpdates=s' => \$opt_dumpdates, # --dumpdates <file> |
|
89 'host=s' => sub { }, # ignore |
|
90 'disk=s' => sub { }, # ignore |
75 ) or pod2usage; |
91 ) or pod2usage; |
76 |
92 |
77 given ($command) { |
93 given ($command) { |
78 when ("support") { exec_support } |
94 when ("support") { exec_support } |
79 when ("selfcheck") { |
95 when ("selfcheck") { |
80 pod2usage if not defined $opt_device; |
96 pod2usage if undef ~~ $opt_device; |
81 exec_selfcheck |
97 exec_selfcheck |
82 } |
98 } |
83 when ("estimate") { |
99 when ("estimate") { |
84 pod2usage |
100 pod2usage if undef ~~ [$opt_device, $opt_level[0]]; |
85 if not defined $opt_device |
|
86 or not defined $opt_level; |
|
87 exec_estimate |
101 exec_estimate |
88 } |
102 } |
89 when ("backup") { exec_backup } |
103 when ("backup") { |
90 default { pod2usage } |
104 pod2usage if undef ~~ [$opt_device, $opt_level[0]]; |
|
105 exec_backup |
|
106 } |
|
107 default { pod2usage } |
91 } |
108 } |
92 } |
109 } |
93 |
110 |
94 # output a list of supported options |
111 # output a list of supported options |
95 sub exec_support { |
112 sub exec_support { |
96 print map { "$_ $SUPPORT{$_}\n" =~ s/_/-/gr } keys %SUPPORT; |
113 print map { "$_ $SUPPORT{$_}\n" =~ s/_/-/gr } sort keys %SUPPORT; |
97 exit 0; |
114 exit 0; |
98 } |
115 } |
99 |
116 |
100 sub exec_selfcheck { |
117 sub exec_selfcheck { |
|
118 |
101 # must: $opt_device |
119 # must: $opt_device |
102 # may: $opt_level |
120 # may: $opt_level |
103 if ($opt_level and ref $opt_level) { $opt_level = $opt_level->[0] } |
121 |
|
122 OK "$ME version $VERSION"; |
|
123 OK "euid=$> (" . getpwuid($>) . ')'; |
|
124 OK "egid=$) (" . join(', ' => map { '' . getgrgid $_ } split ' ' => $)) . ')'; |
104 |
125 |
105 if ($_ = (grep { -x ($_ .= "/dump") } split /:/ => $ENV{PATH})[0]) { |
126 if ($_ = (grep { -x ($_ .= "/dump") } split /:/ => $ENV{PATH})[0]) { |
106 OK "dump is \"$_\""; |
127 chomp(my $version = (`$_ 2>&1`)[0]); |
107 } |
128 OK "dump is $version"; |
108 else { say "ERROR dump not found in $ENV{PATH}\n" } |
129 } |
|
130 else { |
|
131 ERROR "dump not found in $ENV{PATH}"; |
|
132 } |
109 |
133 |
110 # check the device |
134 # check the device |
111 # the opt_disk is just a label, the device is in opt_device! |
135 # the opt_disk is just a label, the device is in opt_device! |
112 my $device = device($opt_device); |
136 my $device = device($opt_device); |
113 |
137 |
131 |
155 |
132 # must: $opt_level, $opt_device |
156 # must: $opt_level, $opt_device |
133 # may: $opt_record, $opt_dumpdates |
157 # may: $opt_record, $opt_dumpdates |
134 my (@errors, @results); |
158 my (@errors, @results); |
135 |
159 |
136 foreach my $level (@$opt_level) { |
160 foreach my $level (@opt_level) { |
137 my @cmd = ( |
161 my @cmd = ( |
138 dump => "-$level", |
162 dump => "-$level", |
139 '-S', |
163 '-S', # estimate |
140 $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), |
164 $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), |
141 device($opt_device), |
165 device($opt_device), |
142 ); |
166 ); |
143 |
167 |
144 chomp(my @output = `@cmd 2>&1`); |
168 my @output = `@cmd 2>&1`; |
145 |
169 |
146 if ($?) { |
170 given ($?) { |
147 say "unexpected output:\n", |
171 when (-1) { say "command not found: $cmd[0]" } |
148 join "\n" => @output; |
172 when ($_ > 0) { |
149 exit 1; |
173 my $rc = ($? & 0xffff) >> 8; |
150 } |
174 my $sig = ($? & 0xff); |
151 |
175 say |
152 # the last line should be the number of 1K blocks |
176 "unexpected return code (exit: $rc, signal: $sig) from `@cmd':\n", |
153 my $blocks = do { |
177 join "\n" => @output; |
154 my $_ = pop @output; |
178 exit 1; |
155 /^(\d+)/ or do { |
179 } |
156 say "can't get estimate"; |
180 } |
157 exit 1; |
181 chomp @output; |
158 }; |
182 |
159 $1 / 1024; |
183 # the last line should be the number of 1K blocks |
160 }; |
184 my $blocks = do { |
|
185 my $_ = pop @output; |
|
186 /^(\d+)/ or do { |
|
187 say "can't get estimate"; |
|
188 exit 1; |
|
189 }; |
|
190 $1 / 1024; |
|
191 }; |
161 |
192 |
162 # level blocks blocksize |
193 # level blocks blocksize |
163 # --> the blocksize unit is K |
194 say join "\n" => @output if @output; |
164 push @errors, @output, "---" if @output; |
195 say "$level $blocks 1"; |
165 push @results, "$level $blocks 1"; |
196 } |
166 } |
197 |
167 |
|
168 say join "\n", @errors if @errors; |
|
169 say join "\n", @results; |
|
170 exit 0; |
198 exit 0; |
171 } |
199 } |
172 |
200 |
173 sub exec_backup { |
201 sub exec_backup { |
174 |
202 |
175 # fd1: data channel |
203 # fd1: data channel |
176 # fd3: message channel |
204 # fd3: message channel |
177 # fd4: index channel |
205 # fd4: index channel |
178 |
206 |
179 my @dump = ( |
207 my @dump = ( |
180 dump => "-$opt_level", |
208 dump => "-$opt_level[0]", |
181 -f => "-", |
209 #'-v', # verbose |
182 $opt_record ? "-u" : (), |
210 -f => '-', |
|
211 $opt_record ? '-u' : (), |
183 $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), |
212 $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), |
184 device($opt_device) |
213 device($opt_device) |
185 ); |
214 ); |
186 |
215 |
187 # messages ----------, |
216 # ,---------> fd3 ----> (messages) |
188 # ,---------> fd2 ----> fd3 |
217 # dump --o----> fd1 ----> (data) |
189 # dump --o----> fd1 (data) |
|
190 # `---> restore -t --> fd4 (index) |
218 # `---> restore -t --> fd4 (index) |
191 |
219 |
192 open(my $msg, ">&=", FD3) or die "Can't open fd3: $!\n"; |
220 open(my $msg, '>&=', FD3) or die "Can't open fd3: $!\n"; |
193 open(my $idx, ">&=", FD4) or die "Can't open fd4: $!\n" if $opt_index; |
221 open(my $idx, '>&=', FD4) or die "Can't open fd4: $!\n" if $opt_index; |
194 |
222 |
195 if ($opt_index) { |
223 if ($opt_index) { |
196 my $pid = fork // die "Can't fork: $!\n"; |
224 my $pid = fork // die "Can't fork: $!\n"; |
197 if (not $pid) { |
225 if (not $pid) { |
198 open(STDOUT, "|-") or do { |
226 $0 = "$ME [about to exec dump]"; |
199 open(my $restore, "|-") or do { |
227 |
200 open(STDOUT, "|-") or do { |
228 # dump will be execed soon, first we've to establish |
201 select($idx); |
229 # the channels - one for STDOUT, and one for STDIN |
202 postprocess_toc(); |
230 open(STDOUT, '|-') or do { |
|
231 # this is the child that will read |
|
232 # the STDOUT from dump |
|
233 $0 = "$ME [stdout < dump]"; |
|
234 |
|
235 my $pid = open(my $restore, '|-') or do { |
|
236 $0 = "$ME [toc]"; |
|
237 open(STDOUT, '|-') or do { |
|
238 postprocess_toc($idx); |
203 exit 0; |
239 exit 0; |
204 }; |
240 }; |
205 exec "restore", "-tvf" => "-"; |
241 exec 'restore', -tvf => '-'; |
206 die "Can't exec `restore -tvf -`: $!"; |
242 die "Can't exec `restore -tvf -`: $!"; |
207 }; |
243 }; |
208 local $/ = 2**16; |
244 |
|
245 local $/ = \(my $x = 64 * 1024); |
209 while (<STDIN>) { |
246 while (<STDIN>) { |
210 print $_; |
247 print $_; |
211 print $restore $_; |
248 print $restore $_; |
212 } |
249 } |
|
250 close($restore); |
213 exit 0; |
251 exit 0; |
214 }; |
252 }; |
215 |
253 |
216 open(STDERR, "|-") or do { |
254 open(STDERR, '|-') or do { |
217 select($msg); |
255 $0 = "$ME [stderr < dump]"; |
218 postprocess_dump_messages(); |
256 postprocess_dump_messages($msg); |
219 exit 0; |
257 exit 0; |
220 }; |
258 }; |
221 |
259 |
222 exec @dump; |
260 # we need to fork again, otherwise dump sees |
223 die "Can't exec `@dump`: $!\n"; |
261 # the end of the above children and complains |
|
262 my $pid = fork // die "Can't fork: $!\n"; |
|
263 if (not $pid) { |
|
264 exec @dump; |
|
265 die "Can't exec `@dump': $!\n"; |
|
266 } |
|
267 |
|
268 waitpid($pid, 0); |
224 } |
269 } |
225 |
270 |
226 waitpid($pid, 0); |
271 waitpid($pid, 0); |
227 exit $?; |
272 exit $?; |
228 } |
273 } |
229 |
274 |
230 # no need to send an index |
275 # no need to send an index |
|
276 # dump [2] --- (postprocess_dump_messages) --> [fd3] |
|
277 # [1] ----------------------------------> [fd1] |
|
278 |
231 my $pid = fork // die "Can't fork: $!\n"; |
279 my $pid = fork // die "Can't fork: $!\n"; |
|
280 |
|
281 # child does all the work |
232 if (not $pid) { |
282 if (not $pid) { |
233 open(STDERR, "|-") or do { |
283 |
234 select($msg); |
284 # create the subprocess that will read the |
235 postprocess_dump_messages(); |
285 # stderr output from dump, convert it and send it |
|
286 # to the message channel |
|
287 open(STDERR, '|-') or do { |
|
288 postprocess_dump_messages($msg); |
236 exit 0; |
289 exit 0; |
237 }; |
290 }; |
238 exec @dump; |
291 exec @dump; |
239 die "Can't exec `@dump`: $!\n"; |
292 die "Can't exec `@dump`: $!\n"; |
240 } |
293 } |
241 waitpid($pid, 0); |
294 waitpid($pid, 0); |
242 exit $?; |
295 exit $?; |
243 |
296 |
244 } |
297 } |
245 |
298 |
246 sub postprocess_dump_messages() { |
299 sub postprocess_dump_messages { |
|
300 |
|
301 select +shift; # send output to the message channel |
|
302 |
247 while (<STDIN>) { |
303 while (<STDIN>) { |
248 print "| $_"; |
304 print "| $_"; |
249 |
|
250 if (/^\s+DUMP: (\d+) blocks?/) { |
305 if (/^\s+DUMP: (\d+) blocks?/) { |
251 |
|
252 # we assume a block size of 1K |
306 # we assume a block size of 1K |
253 say "sendbackup: size $1"; |
307 say "sendbackup: size $1"; |
254 } |
308 } |
255 elsif (/^\s+DUMP: DUMP IS DONE/) { |
309 elsif (/^\s+DUMP: DUMP IS DONE/) { |
256 say "sendbackup: end"; |
310 say 'sendbackup: end'; |
257 } |
311 } |
258 } |
312 } |
259 } |
313 } |
260 |
314 |
261 sub postprocess_toc { |
315 sub postprocess_toc { |
262 |
316 |
263 # dir 4711 ./aaa |
317 # the output of restore -tv looks |
264 # leaf 4712 ./bbb/xxx |
318 # about like this: |
265 # leaf 4713 ./bbb/a |
319 # |
|
320 # dir 4711 ./aaa |
|
321 # leaf 4712 ./bbb/xxx |
|
322 # leaf 4713 ./bbb/a |
266 # b |
323 # b |
267 # leaf 8819 ./bbb/x |
324 # leaf 8819 ./bbb/x |
268 |
325 # |
269 my $name; |
326 # it may break if there is a lf/cr |
270 |
327 # embedded in the filename |
271 while (<STDIN>) { |
328 # |
272 chomp; |
329 # the more generic solution would be to force |
273 if (/^(dir|leaf)\s+\d+\s+(\.\/.*)/) { |
330 # restore to use a \0 separated output format |
274 say $name if defined $name; |
331 |
275 $name = $2 . ($1 eq "dir" ? "/" : ""); |
332 select +shift; |
|
333 local $/ = "\n"; # make sure to have it line separated! |
|
334 |
|
335 my $buffer = undef; |
|
336 my $type = undef; |
|
337 |
|
338 while (1) { |
|
339 |
|
340 $_ = <STDIN>; |
|
341 |
|
342 # skip the header lines |
|
343 if (1 .. defined && /\Adir\s+\d+\s+(.*)\Z/) { |
|
344 $buffer = ''; |
|
345 $type = 'dir'; |
|
346 die "Unexpected end of input\n" if not defined; |
276 next; |
347 next; |
277 } |
348 } |
278 |
349 |
279 if ($name) { |
350 # if we match really good the buffer may be output |
280 $name .= $_; |
351 if (not defined |
|
352 or chomp and /\A(?'type' dir|leaf)\s+\d+\s+\.(?'name' \/.*)\Z/x) |
|
353 { |
|
354 |
|
355 # output |
|
356 say $buffer . ($type eq 'dir' ? '/' : ''); |
|
357 |
|
358 # we're done if this was the last line of output |
|
359 last if not defined; |
|
360 |
|
361 # order matters, do not exchange the next two lines! The %+ |
|
362 # will break |
|
363 $type = $+{type}; |
|
364 $buffer = $+{name} =~ s/\\/\\\\/gr; |
|
365 |
281 next; |
366 next; |
282 } |
367 } |
283 |
368 |
284 } |
369 $buffer .= "\\n$_"; |
285 |
370 |
286 say $name if defined $name; |
371 } |
287 |
372 |
288 } |
373 } |
289 |
374 |
290 sub device { |
375 sub device { |
291 my $_ = shift; |
376 my $_ = shift; |