--- 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 <file>
- ) 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 (<STDIN>) {
- 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 (<STDIN>) {
- 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 (<STDIN>) {
- 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<support>
-
-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<config>
-
-The configuration to be used (the backup set).
-
-=item B<--host> I<host>
-
-The host from the DLE.
-
-=item B<--disk> I<disk>
-
-The disk to be saved. It's some "label" for the device to be backed up.
-
-=item B<--device> I<device>
-
-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<dumpdates>
-
-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:
--- /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
--- /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 <file>
+ ) 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 (<STDIN>) {
+ 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 (<STDIN>) {
+ 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 (<STDIN>) {
+ 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 <level>] --device <device>
+ amdumpext estimate [options] [--level <level>]... --device <device>
+
+=head1 COMMANDS
+
+=over
+
+=item B<support>
+
+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<config>
+
+The configuration to be used (the backup set).
+
+=item B<--host> I<host>
+
+The host from the DLE.
+
+=item B<--disk> I<disk>
+
+The disk to be saved. It's some "label" for the device to be backed up.
+
+=item B<--device> I<device>
+
+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<dumpdates>
+
+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:
--- /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;