# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1386801669 -3600 # Node ID bdf6e224ffe62858e97e6a8ea3a21de5d0dcf89d # Parent 75bddaf5ed89e3bf55167c7e3dd23998952b7b5b estimate, multi-level diff -r 75bddaf5ed89 -r bdf6e224ffe6 amdumpext --- a/amdumpext Wed Dec 11 22:37:00 2013 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,351 +0,0 @@ -#! /usr/bin/perl -use 5.010; -use strict; -use warnings; -use Pod::Usage; -use Getopt::Long; -use Readonly; - -our $VERSION = '0.01'; - -use constant YES => 'YES'; -use constant NO => 'NO'; -use constant DUMPDATES => '/var/lib/dumpdates'; -use constant FD3 => 3; -use constant FD4 => 4; - -Readonly my %SUPPORT => ( - CONFIG => YES, # --config … (ignored?) - HOST => YES, # --host … (ignored?) - DISK => YES, # --disk … (ignored?) - MAX_LEVEL => 9, - CLIENT_ESTIMATE => YES, # estimate - CALCSIZE => YES, # estimate --calcsize - MESSAGE_LINE => YES, # --message line - INDEX_LINE => NO, # --index line - RECORD => YES, # --record -); - -# the commands we need to support as required by the -# API: http://wiki.zmanda.com/index.php/Application_API/Operations - -sub exec_support; -sub exec_selfcheck; -sub exec_estimate; -sub exec_backup; - -# some helper functions - -sub device; -sub OK; -sub ERROR; - -# bad but common style - the global options - -my $opt_config; # $config -my $opt_host; # $host -my $opt_disk; # $disk DLE[1] -my $opt_device; # $device DLE[2] -my $opt_message; # line / <> -my $opt_index; # line / <> -my $opt_record; # true / <> -my $opt_level; # 0…99 -my $opt_calcsize; # true / <> - -my $opt_dumpdates; - -MAIN: { - say "$0 @ARGV" if -t STDOUT; - - my @argv = @ARGV; - my $command = shift // pod2usage; - GetOptions( - - 'config=s' => \$opt_config, - 'host=s' => \$opt_host, # --host $host - 'disk=s' => \$opt_disk, # --disk $disk - 'device=s' => \$opt_device, # --device $device - - 'message=s' => \$opt_message, # --message line - 'index=s' => \$opt_index, # --index line - 'record!' => \$opt_record, # --record - 'level=i' => \$opt_level, # --level n - 'calcsize!' => \$opt_calcsize, - - 'dumpdates=s' => \$opt_dumpdates, # --dumpdates - ) or pod2usage(-message => "$0 @argv"); - - given ($command) { - when ("support") { exec_support } - when ("selfcheck") { exec_selfcheck } - when ("estimate") { exec_estimate } - when ("backup") { exec_backup } - } - pod2usage(-message => "$0 @argv"); -} - -# output a list of supported options -sub exec_support { - print map { "$_ $SUPPORT{$_}\n" =~ s/_/-/gr } keys %SUPPORT; - exit 0; -} - -sub exec_selfcheck { - - if ($_ = (grep { -x ($_ .= "/dump") } split /:/ => $ENV{PATH})[0]) { - OK "dump is \"$_\""; - } - else { say "ERROR dump not found in $ENV{PATH}\n" } - - # check the device - # the opt_disk is just a label, the device is in opt_device! - my $device = device($opt_device); - - if (-b $device) { OK "$opt_device ($device is block special)" } - elsif (-d $device) { OK "$opt_device ($device is directory)" } - else { ERROR "$opt_device not recognized" } - - # check the dumpdates file - if ($opt_record) { - my $dumpdates = $opt_dumpdates ? expand($opt_dumpdates) : DUMPDATES; - - eval { open(my $x, "+>>", $dumpdates) or die "$!\n" }; - if (chomp $@) { ERROR "dumpdates file \"$dumpdates\": $@" } - else { OK "dumpdates file: \"$dumpdates\"" } - } - - exit 0; -} - -sub exec_estimate { - - # $opt_level, $opt_device - my @cmd = ( - dump => "-$opt_level", - "-S", - $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), - device($opt_device), - ); - - chomp(my $output = `@cmd 2>&1`); - - if ($? or $output !~ /^\d+/) { - say "unexpected output \"$output\""; - exit 1; - } - - $output /= 1024; # to get 1K blocks - - # level blocks blocksize - # --> the blocksize unit is K - say "$opt_level $output 1"; - exit 0; -} - -sub exec_backup { - - # fd1: data channel - # fd3: message channel - # fd4: index channel - - my @dump = ( - dump => "-$opt_level", - -f => "-", - $opt_record ? "-u" : (), - $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), - device($opt_device) - ); - - # messages ----------, - # ,---------> fd2 ----> fd3 - # dump --o----> fd1 (data) - # `---> restore -t --> fd4 (index) - - open(my $msg, ">&=", FD3) or die "Can't open fd3: $!\n"; - open(my $idx, ">&=", FD4) or die "Can't open fd4: $!\n" if $opt_index; - - if ($opt_index) { - my $pid = fork // die "Can't fork: $!\n"; - if (not $pid) { - open(STDOUT, "|-") or do { - open(my $restore, "|-") or do { - open(STDOUT, "|-") or do { - select($idx); - postprocess_toc(); - exit 0; - }; - exec "restore", "-tvf" => "-"; - die "Can't exec `restore -tvf -`: $!"; - }; - local $/ = 2**16; - while () { - print $_; - print $restore $_; - }; - exit 0; - }; - - open(STDERR, "|-") or do { - select($msg); - postprocess_dump_messages(); - exit 0; - }; - - - exec @dump; - die "Can't exec `@dump`: $!\n"; - } - - waitpid($pid, 0); - exit $?; - } - - # no need to send an index - my $pid = fork // die "Can't fork: $!\n"; - if (not $pid) { - open(STDERR, "|-") or do { - select($msg); - postprocess_dump_messages(); - exit 0; - }; - exec @dump; - die "Can't exec `@dump`: $!\n"; - } - waitpid($pid, 0); - exit $?; - -} - -sub postprocess_dump_messages() { - while () { - print "| $_"; - - if (/^\s+DUMP: (\d+) blocks?/) { - - # we assume a block size of 1K - say "sendbackup: size $1"; - } - elsif (/^\s+DUMP: DUMP IS DONE/) { - say "sendbackup: end"; - } - } -} - -sub postprocess_toc { - # dir 4711 ./aaa - # leaf 4712 ./bbb/xxx - # leaf 4713 ./bbb/a - # b - # leaf 8819 ./bbb/x - - my $name; - - while () { - chomp; - if (/^(dir|leaf)\s+\d+\s+(\.\/.*)/) { - say $name if defined $name; - $name = $2 . ($1 eq "dir" ? "/" : ""); - next; - } - - if ($name) { - $name .= $_; - next; - } - - } - - say $name if defined $name; - -} - -sub device { - my $_ = shift; - return $_ if /^\//; - return "/dev/$_"; -} - -sub expand { - my $_ = shift; - s/\${c}/$opt_config/g; - return $_; -} - -sub OK { say "OK ", @_ } -sub ERROR { say "ERROR ", @_ } - -=head1 NAME - - amdumpext - the amanda dump application - -=head1 SYNOPSIS - - amdumpext support|selfcheck [options] - -=head1 COMMANDS - -=over - -=item B - -Send a list of supported features. - -=back - -=head1 OPTIONS - -=head2 Common Options - -The following options have to be supported by the application. - -=over 4 - -=item B<--config> I - -The configuration to be used (the backup set). - -=item B<--host> I - -The host from the DLE. - -=item B<--disk> I - -The disk to be saved. It's some "label" for the device to be backed up. - -=item B<--device> I - -The device to be backed up (may be a device name, a mountpoint). - -=back - -=head2 Optional options - -The following options need to be supported if indicated by the "support" -command. - -=over - -=item B<--message> "line" - -Send messages line by line. - -=item B<--index> "line" - -Send the index line by line. - -=back - -=cut - -=head2 Properties - -=over 4 - -=item B<--dumpdates> I - -The location of the dumpdates file. Placeholder "${c}" is allowed and -replaced by the name of the current config. - -=back - -# vim:sts=4 sw=4 aw ai sm: diff -r 75bddaf5ed89 -r bdf6e224ffe6 bin/.perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bin/.perltidyrc Wed Dec 11 23:41:09 2013 +0100 @@ -0,0 +1,3 @@ +--paren-tightness=2 +--square-bracket-tightness=2 +--nospace-for-semicolon diff -r 75bddaf5ed89 -r bdf6e224ffe6 bin/amdumpext --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bin/amdumpext Wed Dec 11 23:41:09 2013 +0100 @@ -0,0 +1,381 @@ +#! /usr/bin/perl +use 5.010; +use strict; +use warnings; +use Pod::Usage; +use Getopt::Long; +use Readonly; +use DDP; + +our $VERSION = '0.01'; + +use constant YES => 'YES'; +use constant NO => 'NO'; +use constant DUMPDATES => '/var/lib/dumpdates'; +use constant FD3 => 3; +use constant FD4 => 4; + +Readonly my %SUPPORT => ( + CONFIG => YES, # --config … (ignored?) + HOST => YES, # --host … (ignored?) + DISK => YES, # --disk … (ignored?) + MAX_LEVEL => 9, + CLIENT_ESTIMATE => YES, # estimate + MULTI_ESTIMATE => YES, # estimate for multiple levels + CALCSIZE => YES, # estimate --calcsize + MESSAGE_LINE => YES, # --message line + INDEX_LINE => NO, # --index line + RECORD => YES, # --record +); + +# the commands we need to support as required by the +# API: http://wiki.zmanda.com/index.php/Application_API/Operations + +sub exec_support; +sub exec_selfcheck; +sub exec_estimate; +sub exec_backup; + +# some helper functions + +sub device; +sub OK; +sub ERROR; + +# bad but common style - the global options + +my $opt_config; # $config +my $opt_host; # $host +my $opt_disk; # $disk DLE[1] +my $opt_device; # $device DLE[2] +my $opt_message; # line / <> +my $opt_index; # line / <> +my $opt_record; # true / <> +my $opt_level; # 0…99 +my $opt_calcsize; # true / <> + +my $opt_dumpdates; + +MAIN: { + my @argv = @ARGV; + my $command = shift // pod2usage; + GetOptions( + + 'config=s' => \$opt_config, + 'host=s' => \$opt_host, # --host $host + 'disk=s' => \$opt_disk, # --disk $disk + 'device=s' => \$opt_device, # --device $device + 'message=s' => \$opt_message, # --message line|xml + 'index=s' => \$opt_index, # --index line + 'record!' => \$opt_record, # --record + 'level=i@' => \$opt_level, # --level n + 'calcsize!' => \$opt_calcsize, + + 'dumpdates=s' => \$opt_dumpdates, # --dumpdates + ) or pod2usage; + + given ($command) { + when ("support") { exec_support } + when ("selfcheck") { + pod2usage if not defined $opt_device; + exec_selfcheck + } + when ("estimate") { + pod2usage + if not defined $opt_device + or not defined $opt_level; + exec_estimate + } + when ("backup") { exec_backup } + default { pod2usage } + } +} + +# output a list of supported options +sub exec_support { + print map { "$_ $SUPPORT{$_}\n" =~ s/_/-/gr } keys %SUPPORT; + exit 0; +} + +sub exec_selfcheck { + # must: $opt_device + # may: $opt_level + if ($opt_level and ref $opt_level) { $opt_level = $opt_level->[0] } + + if ($_ = (grep { -x ($_ .= "/dump") } split /:/ => $ENV{PATH})[0]) { + OK "dump is \"$_\""; + } + else { say "ERROR dump not found in $ENV{PATH}\n" } + + # check the device + # the opt_disk is just a label, the device is in opt_device! + my $device = device($opt_device); + + if (-b $device) { OK "$opt_device ($device is block special)" } + elsif (-d $device) { OK "$opt_device ($device is directory)" } + else { ERROR "$opt_device not recognized" } + + # check the dumpdates file + if ($opt_record) { + my $dumpdates = $opt_dumpdates ? expand($opt_dumpdates) : DUMPDATES; + + eval { open(my $x, "+>>", $dumpdates) or die "$!\n" }; + if (chomp $@) { ERROR "dumpdates file \"$dumpdates\": $@" } + else { OK "dumpdates file: \"$dumpdates\"" } + } + + exit 0; +} + +sub exec_estimate { + + # must: $opt_level, $opt_device + # may: $opt_record, $opt_dumpdates + my (@errors, @results); + + foreach my $level (@$opt_level) { + my @cmd = ( + dump => "-$level", + '-S', + $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), + device($opt_device), + ); + + chomp(my @output = `@cmd 2>&1`); + + if ($?) { + say "unexpected output:\n", + join "\n" => @output; + exit 1; + } + + # the last line should be the number of 1K blocks + my $blocks = do { + my $_ = pop @output; + /^(\d+)/ or do { + say "can't get estimate"; + exit 1; + }; + $1 / 1024; + }; + + # level blocks blocksize + # --> the blocksize unit is K + push @errors, @output, "---" if @output; + push @results, "$level $blocks 1"; + } + + say join "\n", @errors if @errors; + say join "\n", @results; + exit 0; +} + +sub exec_backup { + + # fd1: data channel + # fd3: message channel + # fd4: index channel + + my @dump = ( + dump => "-$opt_level", + -f => "-", + $opt_record ? "-u" : (), + $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (), + device($opt_device) + ); + + # messages ----------, + # ,---------> fd2 ----> fd3 + # dump --o----> fd1 (data) + # `---> restore -t --> fd4 (index) + + open(my $msg, ">&=", FD3) or die "Can't open fd3: $!\n"; + open(my $idx, ">&=", FD4) or die "Can't open fd4: $!\n" if $opt_index; + + if ($opt_index) { + my $pid = fork // die "Can't fork: $!\n"; + if (not $pid) { + open(STDOUT, "|-") or do { + open(my $restore, "|-") or do { + open(STDOUT, "|-") or do { + select($idx); + postprocess_toc(); + exit 0; + }; + exec "restore", "-tvf" => "-"; + die "Can't exec `restore -tvf -`: $!"; + }; + local $/ = 2**16; + while () { + print $_; + print $restore $_; + } + exit 0; + }; + + open(STDERR, "|-") or do { + select($msg); + postprocess_dump_messages(); + exit 0; + }; + + exec @dump; + die "Can't exec `@dump`: $!\n"; + } + + waitpid($pid, 0); + exit $?; + } + + # no need to send an index + my $pid = fork // die "Can't fork: $!\n"; + if (not $pid) { + open(STDERR, "|-") or do { + select($msg); + postprocess_dump_messages(); + exit 0; + }; + exec @dump; + die "Can't exec `@dump`: $!\n"; + } + waitpid($pid, 0); + exit $?; + +} + +sub postprocess_dump_messages() { + while () { + print "| $_"; + + if (/^\s+DUMP: (\d+) blocks?/) { + + # we assume a block size of 1K + say "sendbackup: size $1"; + } + elsif (/^\s+DUMP: DUMP IS DONE/) { + say "sendbackup: end"; + } + } +} + +sub postprocess_toc { + + # dir 4711 ./aaa + # leaf 4712 ./bbb/xxx + # leaf 4713 ./bbb/a + # b + # leaf 8819 ./bbb/x + + my $name; + + while () { + chomp; + if (/^(dir|leaf)\s+\d+\s+(\.\/.*)/) { + say $name if defined $name; + $name = $2 . ($1 eq "dir" ? "/" : ""); + next; + } + + if ($name) { + $name .= $_; + next; + } + + } + + say $name if defined $name; + +} + +sub device { + my $_ = shift; + return $_ if /^\//; + return "/dev/$_"; +} + +sub expand { + my $_ = shift; + s/\${c}/$opt_config/g; + return $_; +} + +sub OK { say "OK ", @_ } +sub ERROR { say "ERROR ", @_ } + +=head1 NAME + + amdumpext - the amanda dump application + +=head1 SYNOPSIS + + amdumpext support + amdumpext selfcheck [options] [--level ] --device + amdumpext estimate [options] [--level ]... --device + +=head1 COMMANDS + +=over + +=item B + +Send a list of supported features. + +=back + +=head1 OPTIONS + +=head2 Common Options + +The following options have to be supported by the application. + +=over 4 + +=item B<--config> I + +The configuration to be used (the backup set). + +=item B<--host> I + +The host from the DLE. + +=item B<--disk> I + +The disk to be saved. It's some "label" for the device to be backed up. + +=item B<--device> I + +The device to be backed up (may be a device name, a mountpoint). + +=back + +=head2 Optional options + +The following options need to be supported if indicated by the "support" +command. + +=over + +=item B<--message> "line" + +Send messages line by line. + +=item B<--index> "line" + +Send the index line by line. + +=back + +=cut + +=head2 Properties + +=over 4 + +=item B<--dumpdates> I + +The location of the dumpdates file. Placeholder "${c}" is allowed and +replaced by the name of the current config. + +=back + +# vim:sts=4 sw=4 aw ai sm: diff -r 75bddaf5ed89 -r bdf6e224ffe6 t/10-basic.t --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/t/10-basic.t Wed Dec 11 23:41:09 2013 +0100 @@ -0,0 +1,10 @@ +#!perl + +use Test::More; + +my $binary = 'bin/amdumpext'; + +ok -f $binary => 'binary exists'; + + +done_testing;