--- a/Build.PL Tue Aug 02 16:08:55 2011 +0200
+++ b/Build.PL Fri Sep 09 23:31:35 2011 +0200
@@ -3,6 +3,7 @@
use Module::Build;
Module::Build->new(
+ module_name => "imager",
dist_name => "imager",
dist_version => "0.0",
dist_author => "Heiko Schlittermann <hs\@schlittermann.de>",
@@ -13,5 +14,10 @@
"Fuse" => "0.09",
"IO::Uncompress::Gunzip" => 0,
"IO::Compress::Gzip" => 0,
- }
+ },
+ build_requires => {
+ "Test::More" => "0.92",
+ "File::Temp" => "0.22",
+ },
+ script_files => [glob "bin/*"],
)->create_build_script;
--- a/bin/imager Tue Aug 02 16:08:55 2011 +0200
+++ b/bin/imager Fri Sep 09 23:31:35 2011 +0200
@@ -16,7 +16,7 @@
);
},
)
- and $ARGV[0] ~~ [qw(save restore fuse check)]
+ and $ARGV[0] ~~ [qw(save restore fuse check compress list)]
or pod2usage;
exec "$0." . shift() => @ARGV;
@@ -70,6 +70,15 @@
Check the saved images. See C<imager check --help> for more information.
+=item compress
+
+Check the compression and decompress or compress. See C<imager
+compress --help> for more information.
+
+=item list
+
+List the backups/images available. See C<imager list --help> for more information.
+
=back
--- a/bin/imager.check Tue Aug 02 16:08:55 2011 +0200
+++ b/bin/imager.check Fri Sep 09 23:31:35 2011 +0200
@@ -7,20 +7,23 @@
use Hash::Util qw(lock_keys);
use File::Find;
use File::Temp;
-use DB_File;
+use Digest::MD5 qw(md5_hex);
use File::Basename;
use autodie qw(:all);
use Cwd qw(abs_path);
+use Imager;
use Getopt::Long;
+use constant CIPHER => "aes-128-cbc";
sub get_block_list;
sub purge_unused;
sub check_images;
-my %o = (
- yes => undef,
- verbose => 1,
- check => undef,
+our %o = (
+ yes => undef,
+ verbose => 1,
+ checksum => undef,
+ pass => undef,
);
lock_keys(%o);
@@ -29,7 +32,8 @@
GetOptions(
"y|yes!" => \$o{yes},
"v|verbose!" => \$o{verbose},
- "c|check" => \$o{check},
+ "c|checksum" => \$o{checksum},
+ "p|pass" => \$o{pass},
"h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
"m|man" => sub {
pod2usage(
@@ -45,22 +49,22 @@
and @ARGV
or pod2usage;
my $dir = shift;
- my $tmp = File::Temp->new;
-
- # load the index files, remember the latest
- # timestamp we see
- #tie %idx, "DB_File" => $tmp->filename;
- verbose("# reading index files");
- my %block = get_block_list($dir);
- verbose("# indexed: "
- . scalar(@{ $block{""} // [] })
- . " images with "
- . (grep !/^\.idx$/ => keys(%block))
- . " blocks");
+ for (my $pass = 1 ; 1 ; ++$pass) {
+ verbose("# reading index files");
+ my %block = get_block_list($dir);
+ verbose("# indexed: "
+ . scalar(@{ $block{""} // [] })
+ . " images with "
+ . (grep !/^\.idx$/ => keys(%block))
+ . " blocks");
- purge_unused($dir => %block);
- check_images($dir => %block);
+ my $subpass = 0;
+ purge_unused($pass => ++$subpass, $dir => %block);
+ check_images($pass => ++$subpass, $dir => %block) and last;
+
+ verbose("# STARTING OVER!");
+ }
}
sub verbose { say @_ if $o{verbose} }
@@ -93,10 +97,10 @@
}
sub purge_unused {
- my ($dir, %block) = @_;
+ my ($pass, $subpass, $dir, %block) = @_;
+ my ($total, $done, $t0);
- my ($total, $done);
- verbose("# pass 1 - checking for unused blocks");
+ verbose("# pass $pass.$subpass - checking for unused blocks");
verbose("# estimating file count");
# calculate the number of files we expect
@@ -106,19 +110,22 @@
opendir(my $dh => $_);
map { $total++ if not $_ ~~ [qw<. ..>] and length > 8 } readdir $dh;
closedir($dh);
+ $File::Find::prune =
+ $_ =~ /^[\d[a-f]{3}$/; # FIXME should be configurable
},
"$dir/data"
);
verbose("# got $total blocks/files");
# progress
+ $t0 = time;
local $SIG{ALRM} = sub {
return alarm 1 if not $done;
- my $speed = $done / (time - $^T + 1);
- verbose sprintf "# pass 1 done %5.1f%% | %25s (%*d of %d blocks)",
+ my $speed = $done / (time - $t0 + 1);
+ verbose sprintf
+ "# pass $pass.$subpass done %5.1f%% | %25s (%*d of %d blocks)",
100 * ($done / $total),
- scalar(localtime($^T + $speed * ($total - $done))),
- length($total) => $done,
+ scalar(localtime $t0 + $total / $speed), length($total) => $done,
$total;
alarm 5;
};
@@ -178,21 +185,22 @@
}
sub check_images {
- my ($dir, %block) = @_;
+ my ($pass, $subpass, $dir, %block) = @_;
my $total = grep { $_ ne "" } keys(%block);
- my $done = 0;
+ my $done = 0;
+ my $t0 = time;
- verbose("# pass 2 - checking image completeness");
+ verbose("# pass $pass.$subpass - checking image completeness");
# progress
local $SIG{ALRM} = sub {
return alarm 1 if not $done;
- my $speed = $done / (time - $^T + 1);
- verbose sprintf "# pass 2 done %5.1f%% | %25s (%*d of %d blocks)",
+ my $speed = $done / (time - $t0 + 1);
+ verbose sprintf
+ "# pass $pass.$subpass done %5.1f%% | %25s (%*d of %d blocks)",
100 * $done / $total,
- scalar(localtime($^T + ($total - $done) * $speed)),
- length($total) => $done,
+ scalar(localtime $t0 + $total / $speed), length($total) => $done,
$total;
alarm 5;
};
@@ -200,18 +208,34 @@
my %invalid;
foreach my $k (keys %block) {
+ state %checked;
my $i = $block{$k};
next if $k eq "";
++$done;
- next
- if -f "$dir/data/$k"
- or -f "$dir/data/$k.gz"
- or -f "$dir/data/$k.x"
- or -f "$dir/data/$k.x.gz"
- or -f "$dir/data/$k.gz.x";
- say "missing $k @$i";
- @invalid{@$i} = ();
+ my ($file) =
+ grep { -f }
+ map { "$dir/data/$_" } ($k, "$k.gz", "$k.x", "$k.x.gz", "$k.gz.x");
+
+ if (not $file) {
+ say "missing $k @$i";
+ @invalid{@$i} = ();
+ next;
+ }
+
+ next if not $o{checksum};
+ next if $checked{$file};
+
+ # checking the checksum
+ Imager::get_block($file => \my $buffer);
+
+ if (md5_hex($buffer) ne basename($file, qw(.gz .x .gz.x))) {
+ say "wrong checksum for $file $k @$i\n";
+ @invalid{@$i} = ();
+ next;
+ }
+
+ $checked{$file} = 1;
}
$SIG{ALRM}->();
alarm 0;
@@ -220,7 +244,7 @@
# invalid
my @invalid = sort @{ $block{""} }[keys %invalid];
- return if not @invalid;
+ return 1 if not @invalid;
say sprintf "found %d (%.1f%%) invalid images:",
0 + @invalid,
@@ -228,17 +252,19 @@
if ($o{yes}) {
unlink @invalid;
- return;
+ return undef;
}
while (-t) {
print "delete? [y/N/v] ";
given (<STDIN>) {
- when (/^y(?:es)?$/i) { unlink @invalid; last }
+ when (/^y(?:es)?$/i) { unlink @invalid; return undef }
when (/^v/i) { say join "\n" => @invalid; next }
default { last }
}
}
+
+ return 1;
}
__END__
@@ -260,6 +286,15 @@
=over
+=item B<-c>|B<--checksum>
+
+Read all block files and check their checksum. (default: off)
+
+=item B<-p>|B<--pass> I<pass>
+
+In case you're using encrypted blocks, the param is passed to
+C<openssl>s C<-pass> option. (default: unset)
+
=item B<-v>|B<-->[no]B<verbose>
Generate more output about what's going on. (default: on)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/imager.compress Fri Sep 09 23:31:35 2011 +0200
@@ -0,0 +1,111 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use POSIX qw(strftime);
+use autodie qw(:all);
+use File::Basename;
+use File::Temp;
+use IO::Compress::Gzip qw(gzip $GzipError :level :strategy);
+use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+use Getopt::Long;
+use Pod::Usage;
+use File::Find;
+
+use constant THRESHOLD => 0.90;
+use constant LEVEL => Z_BEST_SPEED;
+
+MAIN: {
+
+ GetOptions(
+ "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
+ "m|man" => sub {
+ pod2usage(
+ -verbose => 2,
+ -exit => 0,
+ -noperldoc => system("perldoc -V 1>/dev/null 2>&1")
+ );
+ },
+ )
+ and @ARGV
+ or pod2usage;
+
+ find(
+ sub {
+ say "dir $File::Find::name" and return if -d;
+ return if not (-f and /^[\da-f]{32}(?:\.x\.gz|\.gz)?$/);
+ #print STDERR ".";
+
+ open(my $fh, $_);
+ my ($buffer, $zbuffer);
+ my ($tmp);
+
+ if (/\.gz$/) {
+ sysread $fh => $zbuffer, -s $fh;
+ gunzip(\$zbuffer => \$buffer)
+ or die $GunzipError;
+
+ if (!length($buffer)) {
+ warn "?? zero length after decompression: $_\n";
+ return;
+ }
+ return if length($zbuffer) / length($buffer) < THRESHOLD;
+
+ $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
+ syswrite $tmp => $buffer;
+ rename $tmp->filename => basename($_, ".gz");
+ say "uncompressed $_";
+ #print "+";
+
+ }
+ else {
+ sysread $fh => $buffer, -s $fh;
+ gzip(
+ \$buffer => \$zbuffer,
+ -Minimal => 1,
+ -Level => Z_BEST_SPEED,
+ -Strategy => Z_FILTERED
+ ) or die $GzipError;
+ return if length($zbuffer) / length($buffer) >= THRESHOLD;
+
+ $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
+ syswrite $tmp => $zbuffer;
+ rename $tmp->filename => "$_.gz";
+ say " compressed $_";
+ #print STDERR "-";
+ }
+
+ close $tmp;
+ unlink $tmp, $_;
+
+ return;
+
+ },
+ @ARGV
+ );
+
+}
+
+__END__
+
+=head1 NAME
+
+ imager.compress - compress or decompress the blocks
+
+=head1 SYNOPSIS
+
+ imager.compress {dir}
+
+=head1 DESCRIPTION
+
+B<imager.compress> checks all files below the I<dir[s]>.
+
+If compression saves more then 10% it will save the compressed block,
+otherwise the uncompressed.
+
+=cut
+
+
+
+
--- a/bin/imager.fuse Tue Aug 02 16:08:55 2011 +0200
+++ b/bin/imager.fuse Fri Sep 09 23:31:35 2011 +0200
@@ -13,6 +13,7 @@
use File::Temp;
use DB_File;
use File::Basename;
+use Imager;
my %o = (
debug => undef,
@@ -217,54 +218,11 @@
if (not defined $cache{fn}
or ($cache{fn} ne $fn))
{
-
- if (-e $fn) {
- open(my $fh => $fn);
- binmode($fh);
- local $/ = undef;
- $cache{data} = <$fh>;
- }
- elsif (-e "$fn.gz") {
- open(my $fh => "$fn.gz");
- binmode($fh);
- gunzip($fh => \$cache{data})
- or die $GunzipError;
- }
- elsif (-e "$fn.x") {
- open(
- my $fh =>
- "openssl @{[CIPHER]} -d -pass '$o{pass}' -in '$fn.x'|");
- binmode($fh);
- local $/ = undef;
- $cache{data} = <$fh>;
- close($fh);
- }
- elsif (-e "$fn.gz.x") {
- open(
- my $fh =>
- "openssl @{[CIPHER]} -d -pass '$o{pass}' -in '$fn.gz.x'|"
- );
- binmode($fh);
- gunzip($fh => \$cache{data})
- or die $GunzipError;
- close($fh);
- }
- elsif (-e "$fn.x.gz") {
- warn "$fn.x.gz is depreciated!\n";
- open(
- my $fh =>
- "zcat $fn.x.gz | openssl @{[CIPHER]} -d -pass '$o{pass}'|"
- );
- binmode($fh);
- local $/ = undef;
- $cache{data} = <$fh>;
- close($fh);
- }
+ Imager::get_block("$fn*" => \$cache{data});
$cache{fn} = $fn;
}
return substr($cache{data}, $blockoffset, $length);
- die "$fn: $!\n";
}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/imager.list Fri Sep 09 23:31:35 2011 +0200
@@ -0,0 +1,94 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use Pod::Usage;
+use Hash::Util qw(lock_keys);
+use File::Find;
+use Digest::MD5 qw(md5_hex);
+use File::Basename;
+use autodie qw(:all);
+use Imager;
+
+use Getopt::Long;
+
+our %o = (
+ latest => undef,
+);
+lock_keys(%o);
+
+MAIN: {
+ my $dir;
+
+ Getopt::Long::Configure qw(Bundling);
+ GetOptions(
+ "latest" => \$o{latest},
+ "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
+ "m|man" => sub {
+ pod2usage(
+ -verbose => 2,
+ -exit => 0,
+ -noperldoc => system(
+ "perldoc -V 1>/dev/null
+ 2>&1"
+ )
+ );
+ },
+ )
+ and defined ($dir = shift)
+ or pod2usage;
+
+ my (%by_day, %by_dev);
+ find(sub{
+ return if not (-f and /^\d{4}-\d\d-\d\dT\d\d:\d\d:\d\dZ$/);
+ my ($host, $dev) = dirname($File::Find::name) =~ /^\Q$dir\/idx\E\/(.+?)(\/.*)/;
+ push @{$by_day{$_}}, "$host\::$dev";
+ push @{$by_dev{"$host\::$dev"}}, $_;
+ }, "$dir/idx");
+
+ # by dev
+ my $l = (sort { $b <=> $a } map { length } keys %by_dev)[0];
+ foreach (sort keys %by_dev) {
+ my $prefix = $_;
+ foreach ((reverse sort @{$by_dev{$_}})) {
+ printf "%-*s: %s\n", $l => $prefix, $_;
+ last if $o{latest};
+ $prefix = " ";
+ }
+ }
+
+}
+
+__END__
+
+=head1 NAME
+
+ imager.list - list the images created by imager
+
+=head1 SYNOPSIS
+
+ imager.list [options] {directory}
+
+=head1 DESCRIPTION
+
+B<imager.list> lists the index files (images) the imager created.
+
+
+=head1 OPTIONS
+
+=over
+
+=item B<--latest>
+
+List only the latest backups. (default: list all)
+
+=item B<-h>|B<--help>
+
+=item B<-m>|B<--man>
+
+The short and longer help.
+
+=back
+
+=cut
--- a/bin/imager.restore Tue Aug 02 16:08:55 2011 +0200
+++ b/bin/imager.restore Fri Sep 09 23:31:35 2011 +0200
@@ -13,12 +13,11 @@
use strict;
use warnings;
use File::Basename;
-use Cwd qw(abs_path);
use autodie qw(:all);
use Pod::Usage;
use Getopt::Long;
use Hash::Util qw(lock_keys);
-use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+use Imager;
use constant KiB => 1024;
use constant MiB => 1024 * KiB;
@@ -67,56 +66,17 @@
while (<$fh>) {
next if /^#/;
- my ($blk, $hash, $path) = split;
- my ($in, $buffer);
-
- if (-f "$data/$path") {
- open($in => "$data/$path");
- binmode($in);
- local $/ = undef;
- $buffer = <$in>;
- }
- elsif (-f "$data/$path.gz") {
- open($in => "$data/$path.gz");
- binmode($in);
- gunzip($in => \$buffer)
- or die $GunzipError;
- }
- elsif (-f "$data/$path.x") {
- open($in,
- "openssl @{[CIPHER]} -d -pass $o{pass} -in '$data/$path.x'|");
- binmode($in);
- local $/ = undef;
- $buffer = <$in>;
- }
- elsif (-f "$data/$path.gz.x") {
- open($in,
- "openssl @{[CIPHER]} -d -pass $o{pass} -in $data/$path.gz.x|");
- binmode($in);
- gunzip($in => \$buffer)
- or die $GunzipError;
- }
- elsif (-f "$data/$path.x.gz") {
- warn "$data/$path.x.gz: depreciated!\n";
- open($in,
-"gzip -d -c $data/$path.x.gz | openssl @{[CIPHER]} -d -pass $o{pass}|"
- );
- binmode($in);
- local $/ = undef;
- $buffer = <$in>;
- }
- else {
- die ME . ": Can't open $data/$path: $!\n";
- }
+ my ($blk, undef, $path) = split;
+ my $buffer;
+ Imager::get_block("$data/$path*" => \$buffer);
print {$out} $buffer;
- close($in);
}
close($out);
close($fh);
}
sub find_data_dir {
- for (my $dir = shift ; $dir ne "/" ; $dir = abs_path("$dir/..")) {
+ for (my $dir = shift ; $dir ne "/" ; $dir = dirname $dir) {
return "$dir/data" if -d "$dir/data" and -d "$dir/idx";
}
die ME . ": no data directory found!\n";
--- a/bin/imager.save Tue Aug 02 16:08:55 2011 +0200
+++ b/bin/imager.save Fri Sep 09 23:31:35 2011 +0200
@@ -14,19 +14,20 @@
use Hash::Util qw(lock_keys);
use Getopt::Long;
use Pod::Usage;
+use Imager 0.1;
use constant KiB => 1024;
use constant MiB => 1024 * KiB;
use constant GiB => 1024 * MiB;
-use constant NOW => time();
use constant BS => 4 * MiB;
-use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW));
+use constant DATEFMT => "%Y-%m-%dT%H:%M:%SZ";
use constant CIPHER => "aes-128-cbc";
sub get_devsize;
sub get_devname;
sub save;
+
$SIG{INT} = sub { die "Got INT\n" };
my %o = (
@@ -35,11 +36,10 @@
blocksize => BS,
pass => undef,
comment => undef,
+ now => time(),
);
lock_keys(%o);
-my $NOW = time();
-
MAIN: {
GetOptions(
"h|help" => sub { pod2usage(-verbose => 1, exit => 0) },
@@ -50,9 +50,10 @@
-noperldoc => system("perldoc -V >/dev/null 2>&1")
);
},
- "c|comment=s" => \$o{comment},
- "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },
+ "c|comment=s" => \$o{comment},
+ "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },
"p|pass=s" => \$o{pass},
+ "now=i" => \$o{now},
"b|blocksize=s" => sub {
given ($_[1]) {
when (/(\d+)G/i) { $o{blocksize} = $1 * GiB };
@@ -80,7 +81,11 @@
exit;
}
- do 1 while wait != -1;
+ my $rc = 0;
+ while (wait != -1) {
+ $rc = ($? >> 8) if ($? >> 8) > $rc;
+ }
+ exit $rc;
}
@@ -89,12 +94,18 @@
my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/";
my $data = "{DIR}/data";
my $info = "{DIR}/data/info";
- my $size;
+ my ($size, $name);
+
+ if ($src =~ /(?<dev>.+?):(?<name>.+)/) {
+ $src = $+{dev};
+ $name = $+{name};
+ }
+ else { $name = $src }
foreach ($idx, $data, $info) {
s/{DIR}/$dst/g;
s/{HOSTNAME}/hostname/eg;
- s/{DEVICE}/get_devname($src)/eg;
+ s/{DEVICE}/$name/g;
}
$size = get_devsize($src);
@@ -108,15 +119,14 @@
filesystem => $src,
blocksize => $o{blocksize},
devsize => $size,
- timestamp => NOW,
- datetime => DATETIME,
+ timestamp => $o{now},
+ datetime => strftime(DATEFMT, gmtime $o{now}),
(defined $o{comment} ? (comment => $o{comment}) : ()),
encryption => $o{pass} ? CIPHER : "none",
};
open(my $in => $src);
binmode($in);
- local $/ = \$o{blocksize};
local $| = 1;
my %stats = (
@@ -130,7 +140,7 @@
say sprintf
"# %*s done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)",
(sort { $a <=> $b } map { length basename $_ } @ARGV)[-1] =>
- basename($src),
+ basename($name),
100 * (($stats{written} + $stats{skipped}) / $stats{todo}),
($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""),
length($stats{todo}) => $stats{written} + $stats{skipped},
@@ -140,26 +150,23 @@
};
$SIG{ALRM}->();
- while (my $buffer = <$in>) {
+ for (
+ my $blknr = 0 ;
+ sysread($in => my $buffer, $o{blocksize}) > 0 ;
+ ++$blknr
+ )
+ {
+
my ($file, $ext, $cs);
$file = $cs = md5_hex($buffer);
$file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
- $ext = "";
- $ext .= $o{compress} ? ".gz" : "";
- $ext .= $o{pass} ? ".x" : "";
+ $ext .= $o{pass} ? ".x" : "";
# the extension we do not put into the index
- push @{ $index{BLOCKS} }, sprintf "%12d %s %s" => ($. - 1),
+ push @{ $index{BLOCKS} }, sprintf "%12d %s %s" => $blknr,
$cs, $file;
- if (
- not( -e "$data/$file"
- or -e "$data/$file.gz"
- or -e "$data/$file.x"
- or -e "$data/$file.gz.x"
- or -e "$data/$file.x.gz")
- )
- {
+ if (not Imager::get_file("$data/$file")) {
mkpath dirname("$data/$file");
my $out = File::Temp->new(
TEMPLATE => "tmp-XXXXXXX",
@@ -170,18 +177,32 @@
open($out, "|openssl @{[CIPHER]} -pass $o{pass} -out $out");
}
binmode($out);
- if ($o{compress}) {
- gzip(
- \$buffer => $out,
- -Minimal => 1,
- -Level => Z_BEST_SPEED,
- -Strategy => Z_FILTERED
- ) or die $GzipError;
- }
- else { print {$out} $buffer }
- close($out);
+
+
+ my $bufref = \$buffer;
+ if ($o{compress}) {
+ my $zbuffer;
+ gzip(
+ \$buffer => \$zbuffer,
+ -Minimal => 1,
+ -Level => Z_BEST_SPEED,
+ -Strategy => Z_FILTERED
+ ) or die $GzipError;
+ if (length($zbuffer) / length($buffer) < 0.9) {
+ $bufref = \$zbuffer;
+ $ext = ".gz$ext";
+ }
+ }
+
+ #for(my $todo = length $$bufref;
+ # $todo -= syswrite $out => $$bufref, $todo, -$todo; 1)
+ #{
+ #}
+ syswrite $out => $$bufref;
+
+ close($out) or die $!;
rename($out => "$data/$file$ext");
- $index{BLOCKS}[$. - 1] .= " *";
+ $index{BLOCKS}[$blknr] .= " *";
$stats{written}++;
}
else {
@@ -200,7 +221,7 @@
"",
@{ $index{BLOCKS} };
close($index);
- rename $index->filename => "$idx/" . DATETIME;
+ rename $index->filename => "$idx/" . strftime(DATEFMT, gmtime $o{now});
say "# $src DONE (runtime " . (time() - $^T) . "s)";
say "# $src WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks";
@@ -260,6 +281,10 @@
Comment to be included in the header of the index file. (default: none)
+=item B<--now> I<timestamp>
+
+Set the timestamp used for naming the idx files. (default: now)
+
=item B<-p>|B<--pass> I<pass>
Use symmetric encryption for writing the data blocks. This option
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/.perltidyrc Fri Sep 09 23:31:35 2011 +0200
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Imager.pm Fri Sep 09 23:31:35 2011 +0200
@@ -0,0 +1,38 @@
+package Imager;
+use 5.010;
+use strict;
+use warnings;
+use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+use autodie qw(:all);
+
+our $VERSION = "0.1";
+
+use constant CIPHER => "aes-128-cbc";
+
+sub get_file {
+ my ($base) = @_;
+ foreach (map { "$base$_" } "", qw/.gz .x .gz.x/) {
+ return $_ if -f;
+ }
+}
+
+sub get_block {
+ my ($file, $buffer) = @_;
+
+ $file = get_file($1) if $file =~ /(.*)\*$/;
+
+ given ($file) {
+ when (/\.gz\.x$/) {
+ open(my $fh => "openssl @{[CIPHER]} -d -pass $::o{pass} -in $file|");
+ gunzip($fh => $buffer) or die $GunzipError;
+ }
+ when (/\.gz$/) { gunzip($file => $buffer) or die $GunzipError }
+ when (/\.x$/) {
+ open(my $fh => "openssl @{[CIPHER]} -d -pass $::o{pass} -in $file|");
+ $$buffer = <$fh>;
+ }
+ default { open(my $fh => $file); sysread $fh => $$buffer, -s $fh }
+ }
+}
+
+1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch/y.pl Fri Sep 09 23:31:35 2011 +0200
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+use 5.010;
+use strict;
+use warnings;
+use Crypt::CBC;
+use autodie qw(:all);
+use Benchmark qw(:all);
+use File::Temp;
+
+my $tmp = File::Temp->new();
+
+{
+ open(my $fh, "/dev/urandom");
+ local $/ = \(my $x = 1024 * 1024); # 1 MiB
+ for (1 .. 4) {
+ print {$tmp} scalar <$fh>;
+ }
+}
+
+sub getbyref {
+ my $ref = shift;
+ local $/ = undef;
+ seek($tmp, 0, 0);
+ $$ref = <$tmp>;
+}
+
+sub getbyval {
+ seek($tmp, 0, 0);
+ local $/ = undef;
+ return <$tmp>;
+}
+
+cmpthese(900 => {
+ byref => sub { my $x; getbyref(\$x); $_ = length($x) },
+ byval => sub { my $x = getbyval(); $_ = length($x) },
+ }
+);
+
+
+
+__END__
+
+
+
+cmpthese(30 => {
+ 'openssl' => sub { openssl($text) },
+ 'perlssl' => sub { perlssl($text) },
+ }
+);
+
+cmpthese(30 => {
+ 'gzip' => sub { bingzip($text) },
+ 'perlzip' => sub { perlzip($text) },
+ }
+);
+
+sub openssl {
+ open(my $out, "|openssl bf -pass env:X -out $tmp") or die;
+ print $out $_[0];
+ close $out;
+ die $? if $?;
+}
+
+sub perlssl {
+ open(my $out, ">$tmp");
+ print $out $cipher0->encrypt($_[0]);
+ close $out;
+}
+
+sub perlzip {
+ open(my $out, ">$tmp");
+ gzip($_[0] => $out);
+}
+
+sub bingzip {
+ open(my $out, "|gzip -1 >$tmp");
+ print $out $_[0];
+ close $out;
+ die $? if $?
+}
--- a/t/000-syntax.t Tue Aug 02 16:08:55 2011 +0200
+++ b/t/000-syntax.t Fri Sep 09 23:31:35 2011 +0200
@@ -6,11 +6,12 @@
use File::Find;
my @scripts;
-find(sub { /^\./ and return; push @scripts, $File::Find::name if -f and -x }, "blib");
+find(sub { /^\./ and return;
+ push @scripts, $File::Find::name if -f and (-x or /\.pm$/)}, "blib");
plan tests => scalar @scripts;
foreach (@scripts) {
- my $e = `perl -c $_ 2>&1`;
- ok(!$?, "syntax ok") or diag $e;
+ my $e = `perl -Mblib -c $_ 2>&1`;
+ ok(!$?, "syntax $_ ok") or diag $e;
}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/001-save-restore.t Fri Sep 09 23:31:35 2011 +0200
@@ -0,0 +1,53 @@
+use 5.010;
+use strict;
+use warnings;
+use autodie qw(:all);
+use Test::More;
+use Sys::Hostname;
+
+use constant SIZE => 27 * 1024 * 1024;
+
+use File::Temp;
+
+my $err = File::Temp->new;
+my $dir = File::Temp->newdir;
+
+note("preparing the source");
+open(my $out, "+>$dir/source");
+print $out rand while -s $out < SIZE;
+
+note("preparing the images dir");
+mkdir "$dir/images";
+mkdir "$dir/mnt";
+
+system("sudo mount -ttmpfs -osize=10M,uid=$> tmpfs $dir/mnt 2>/dev/null");
+END { system("sudo umount $dir/mnt 2>/dev/null") };
+
+
+system("perl -Mblib blib/script/imager.save $dir/source:source $dir/images");
+is($? => 0, "saved");
+
+system("perl -Mblib blib/script/imager.restore $dir/images/idx/@{[hostname]}/source/* $dir/source.restored");
+is($? => 0, "restored");
+
+# just as it is
+seek($out, 0, 0);
+open(my $restored, "$dir/source.restored");
+ok(<$out> ~~ <$restored>, "source === restored");
+
+# now compress and check again
+system("perl -Mblib blib/script/imager.compress $dir/images 2>$err");
+system("perl -Mblib blib/script/imager.restore $dir/images/idx/@{[hostname]}/source/* $dir/source.restored");
+is($? => 0, "restored") or do { seek $err => 0, 0; diag <$err> };
+seek($out, 0, 0);
+open($restored, "$dir/source.restored");
+ok(<$out> ~~ <$restored>, "compressed source === restored");
+
+# now check on overflow of destination
+
+note("overflow condition");
+eval { system("perl -Mblib blib/script/imager.save $dir/source:source $dir/mnt 2>$err") };
+ok($?, "failure is expected");
+
+
+done_testing;