# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1315603895 -7200 # Node ID 3c3305dcb038d7ca39e3ba03ba975b8f922e7f04 # Parent 00a538dd7908f1e85d9293f1e13fb863b059969e# Parent e7938f859e2f2e34c79c44f8a8fb9ef546a01a0f [merged] diff -r e7938f859e2f -r 3c3305dcb038 Build.PL --- 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 ", @@ -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; diff -r e7938f859e2f -r 3c3305dcb038 bin/imager --- 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 for more information. +=item compress + +Check the compression and decompress or compress. See C for more information. + +=item list + +List the backups/images available. See C for more information. + =back diff -r e7938f859e2f -r 3c3305dcb038 bin/imager.check --- 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 () { - 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 + +In case you're using encrypted blocks, the param is passed to +Cs C<-pass> option. (default: unset) + =item B<-v>|B<-->[no]B Generate more output about what's going on. (default: on) diff -r e7938f859e2f -r 3c3305dcb038 bin/imager.compress --- /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 checks all files below the I. + +If compression saves more then 10% it will save the compressed block, +otherwise the uncompressed. + +=cut + + + + diff -r e7938f859e2f -r 3c3305dcb038 bin/imager.fuse --- 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"; } diff -r e7938f859e2f -r 3c3305dcb038 bin/imager.list --- /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 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 diff -r e7938f859e2f -r 3c3305dcb038 bin/imager.restore --- 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"; diff -r e7938f859e2f -r 3c3305dcb038 bin/imager.save --- 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 =~ /(?.+?):(?.+)/) { + $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/(?(?...).*)/$+{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 + +Set the timestamp used for naming the idx files. (default: now) + =item B<-p>|B<--pass> I Use symmetric encryption for writing the data blocks. This option diff -r e7938f859e2f -r 3c3305dcb038 lib/.perltidyrc --- /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 diff -r e7938f859e2f -r 3c3305dcb038 lib/Imager.pm --- /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; diff -r e7938f859e2f -r 3c3305dcb038 scratch/y.pl --- /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 $? +} diff -r e7938f859e2f -r 3c3305dcb038 t/000-syntax.t --- 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; } diff -r e7938f859e2f -r 3c3305dcb038 t/001-save-restore.t --- /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;