# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1313575851 -7200 # Node ID 0315e75a049d958e50b6ebd7e5d1c47c2addcf4a # Parent 2a7ab8422dd6b7bb70cb7ab93b698ebde2caf65b# Parent 5dbf5c4f425e4879c5c3457d9cc949f896adf161 [merged] diff -r 5dbf5c4f425e -r 0315e75a049d bin/imager.check --- a/bin/imager.check Wed Aug 17 11:35:47 2011 +0200 +++ b/bin/imager.check Wed Aug 17 12:10:51 2011 +0200 @@ -11,8 +11,7 @@ use File::Basename; use autodie qw(:all); use Cwd qw(abs_path); -use IO::Compress::Gzip qw(&gzip $GzipError Z_BEST_SPEED); -use IO::Uncompress::Gunzip qw(&gunzip $GunzipError); +use Imager; use Getopt::Long; use constant CIPHER => "aes-128-cbc"; @@ -20,7 +19,7 @@ sub purge_unused; sub check_images; -my %o = ( +our %o = ( yes => undef, verbose => 1, checksum => undef, @@ -226,26 +225,7 @@ next if not $o{checksum}; # checking the checksum - my $buffer; - given ($file) { - when (/\.gz\.x$/) { - open( - my $fh => - "openssl @{[CIPHER]} -d -pass $o{pass} -in $file|"); - local $/ = undef; - 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|"); - local $/ = undef; - $buffer = <$fh>; - } - default { open(my $fh => $file); local $/ = undef; $buffer = <$fh> } - } - + Imager::get_block($file => \my $buffer); next if md5_hex($buffer) eq basename($file, qw(.gz .x .gz.x)); say "wrong checksum for $file\n"; @invalid{@$i} = (); diff -r 5dbf5c4f425e -r 0315e75a049d bin/imager.fuse --- a/bin/imager.fuse Wed Aug 17 11:35:47 2011 +0200 +++ b/bin/imager.fuse Wed Aug 17 12:10:51 2011 +0200 @@ -13,6 +13,7 @@ use File::Temp; use DB_File; use File::Basename; +use Imager; my %o = ( debug => undef, @@ -217,54 +218,25 @@ if (not defined $cache{fn} or ($cache{fn} ne $fn)) { - if (-e $fn) { - open(my $fh => $fn); - binmode($fh); - local $/ = undef; - $cache{data} = <$fh>; + Imager::get_block($fn => \$cache{data}); } elsif (-e "$fn.gz") { - open(my $fh => "$fn.gz"); - binmode($fh); - gunzip($fh => \$cache{data}) - or die $GunzipError; + Imager::get_block("$fn.gz" => \$cache{data}); } 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); + Imager::get_block("$fn.x" => \$cache{data}); } 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); + Imager::get_block("$fn.gz.x" => \$cache{data}); } - 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); - } + else { + die "Can't get file for $fn"; + } $cache{fn} = $fn; } return substr($cache{data}, $blockoffset, $length); - die "$fn: $!\n"; } diff -r 5dbf5c4f425e -r 0315e75a049d bin/imager.restore --- a/bin/imager.restore Wed Aug 17 11:35:47 2011 +0200 +++ b/bin/imager.restore Wed Aug 17 12:10:51 2011 +0200 @@ -17,7 +17,7 @@ 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,48 +67,19 @@ 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>; - } + my $buffer; + if (-f "$data/$path") { Imager::get_block("$data/$path" => \$buffer) } elsif (-f "$data/$path.gz") { - open($in => "$data/$path.gz"); - binmode($in); - gunzip($in => \$buffer) - or die $GunzipError; + Imager::get_block("$data/$path.gz" => \$buffer); } elsif (-f "$data/$path.x") { - open($in, - "openssl @{[CIPHER]} -d -pass $o{pass} -in '$data/$path.x'|"); - binmode($in); - local $/ = undef; - $buffer = <$in>; + Imager::get_block("$data/$path.x" => \$buffer); } 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; + Imager::get_block("$data/$path.gz.x" => \$buffer); } - 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"; - } + else { die ME . ": Can't open $data/$path: $!\n" } print {$out} $buffer; - close($in); } close($out); close($fh); diff -r 5dbf5c4f425e -r 0315e75a049d bin/imager.save --- a/bin/imager.save Wed Aug 17 11:35:47 2011 +0200 +++ b/bin/imager.save Wed Aug 17 12:10:51 2011 +0200 @@ -134,7 +134,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}, diff -r 5dbf5c4f425e -r 0315e75a049d lib/.perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/.perltidyrc Wed Aug 17 12:10:51 2011 +0200 @@ -0,0 +1,2 @@ +--paren-tightness=2 +--square-bracket-tightness=2 diff -r 5dbf5c4f425e -r 0315e75a049d lib/Imager.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Imager.pm Wed Aug 17 12:10:51 2011 +0200 @@ -0,0 +1,29 @@ +package Imager; +use 5.010; +use strict; +use warnings; +use IO::Uncompress::Gunzip qw(gunzip $GunzipError); +use autodie qw(:all); + +use constant CIPHER => "aes-128-cbc"; + +sub get_block { + my ($file, $buffer) = @_; + + given ($file) { + when (/\.gz\.x$/) { + open(my $fh => "openssl @{[CIPHER]} -d -pass $::o{pass} -in $file|"); + local $/ = undef; + 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|"); + local $/ = undef; + $$buffer = <$fh>; + } + default { open(my $fh => $file); local $/ = undef; $$buffer = <$fh> } + } +} + +1; diff -r 5dbf5c4f425e -r 0315e75a049d scratch/y.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scratch/y.pl Wed Aug 17 12:10:51 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 5dbf5c4f425e -r 0315e75a049d t/000-syntax.t --- a/t/000-syntax.t Wed Aug 17 11:35:47 2011 +0200 +++ b/t/000-syntax.t Wed Aug 17 12:10:51 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; }