bin/imager.save
branchtesting
changeset 37 cb50d6c57439
parent 35 bbdb8ea3079a
child 38 fac6d76d06e8
equal deleted inserted replaced
36:f361d688365c 37:cb50d6c57439
    18 use constant KiB      => 1024;
    18 use constant KiB      => 1024;
    19 use constant MiB      => 1024 * KiB;
    19 use constant MiB      => 1024 * KiB;
    20 use constant GiB      => 1024 * MiB;
    20 use constant GiB      => 1024 * MiB;
    21 use constant NOW      => time();
    21 use constant NOW      => time();
    22 use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW));
    22 use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW));
       
    23 use constant CIPHER   => "aes-128-cbc";
    23 
    24 
    24 sub get_devsize;
    25 sub get_devsize;
    25 sub get_devname;
    26 sub get_devname;
    26 sub save;
    27 sub save;
    27 
    28 
    29 
    30 
    30 my %o = (
    31 my %o = (
    31     compress  => undef,
    32     compress  => undef,
    32     verbose   => undef,
    33     verbose   => undef,
    33     blocksize => 4 * MiB,
    34     blocksize => 4 * MiB,
       
    35     pass      => undef,
    34 );
    36 );
    35 lock_keys(%o);
    37 lock_keys(%o);
    36 
    38 
    37 my $NOW = time();
    39 my $NOW = time();
    38 
    40 
    45                 exit       => 0,
    47                 exit       => 0,
    46                 -noperldoc => system("perldoc -V >/dev/null 2>&1")
    48                 -noperldoc => system("perldoc -V >/dev/null 2>&1")
    47             );
    49             );
    48         },
    50         },
    49         "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },
    51         "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },
       
    52 	"p|pass=s"  => \$o{pass},
    50         "b|blocksize=s" => sub {
    53         "b|blocksize=s" => sub {
    51             given ($_[1]) {
    54             given ($_[1]) {
    52                 when (/(\d+)G/i) { $o{blocksize} = $1 * GiB };
    55                 when (/(\d+)G/i) { $o{blocksize} = $1 * GiB };
    53                 when (/(\d+)M/i) { $o{blocksize} = $1 * MiB };
    56                 when (/(\d+)M/i) { $o{blocksize} = $1 * MiB };
    54                 when (/(\d+)K/i) { $o{blocksize} = $1 * KiB };
    57                 when (/(\d+)K/i) { $o{blocksize} = $1 * KiB };
   135 
   138 
   136     while (my $buffer = <$in>) {
   139     while (my $buffer = <$in>) {
   137         my ($file, $ext, $cs);
   140         my ($file, $ext, $cs);
   138         $file = $cs = md5_hex($buffer);
   141         $file = $cs = md5_hex($buffer);
   139         $file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
   142         $file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
   140         $ext = $o{compress} ? ".gz" : "";
   143 	$ext = "";
       
   144         $ext .= $o{compress} ? ".gz" : "";
       
   145 	$ext .= $o{pass} ? ".x" : "";
   141 
   146 
   142         # the extension we do not put into the index
   147         # the extension we do not put into the index
   143         my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file;
   148         my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file;
   144 
   149 
   145         if (not(-e "$data/$file" or -e "$data/$file.gz")) {
   150         if (not(-e "$data/$file" 
   146             mkpath dirname("$data/$file.gz");
   151 	    or -e "$data/$file.gz"
   147             my $out = File::Temp->new(
   152 	    or -e "$data/$file.x"
       
   153 	    or -e "$data/$file.gz.x"
       
   154 	    or -e "$data/$file.x.gz")) {
       
   155             mkpath dirname("$data/$file");
       
   156 	    my $out = File::Temp->new(
   148                 TEMPLATE => ".XXXXXXX",
   157                 TEMPLATE => ".XXXXXXX",
   149                 DIR      => dirname("$data/$file")
   158                 DIR      => dirname("$data/$file")
   150             );
   159             );
       
   160 
       
   161 	    if ($o{pass}) {
       
   162 		open($out, "|openssl @{[CIPHER]} -pass $o{pass} -out $out");
       
   163 	    }
   151             binmode($out);
   164             binmode($out);
   152             if ($o{compress}) {
   165             if ($o{compress}) {
   153                 gzip(
   166                 gzip(
   154                     \$buffer  => $out,
   167                     \$buffer  => $out,
   155                     -Minimal  => 1,
   168                     -Minimal  => 1,
   225 
   238 
   226 =head1 OPTIONS
   239 =head1 OPTIONS
   227 
   240 
   228 =over
   241 =over
   229 
   242 
       
   243 =item B<-b> I<blocksize>|B<--blocksize>=I<blocksize>
       
   244 
       
   245 The blocksize used. (may be suffixed with K, M, G). (default: 4 MiB)
       
   246 
       
   247 =item B<-p> I<pass> | B<--pass>=I<pass>
       
   248 
       
   249 Use symmetric encryption for writing the data blocks.
       
   250 
   230 =item B<-z> [I<level>]|B<--compress>[=I<level>]
   251 =item B<-z> [I<level>]|B<--compress>[=I<level>]
   231 
   252 
   232 Use compression when writing the blocks to disk. (default: off)
   253 Use compression when writing the blocks to disk. (default: off)
   233 
   254 
   234 =item B<-b> I<blocksize>|B<--blocksize>=I<blocksize>
       
   235 
       
   236 The blocksize used. (may be suffixed with K, M, G). (default: 4 MiB)
       
   237 
       
   238 =item B<-h>|B<--help>
   255 =item B<-h>|B<--help>
   239 
   256 
   240 =item B<-m>|B<--man>
   257 =item B<-m>|B<--man>
   241 
   258 
   242 The short and longer help. 
   259 The short and longer help. 
   243 
   260 
   244 =back
   261 =back
   245 
   262 
       
   263 =head1 PERFORMANCE
       
   264 
       
   265 Some experiments have shown that if compression and encryption is used,
       
   266 about 1/3 of the time is consumed by the encryption, and 2/3 are used
       
   267 for compression. The compression is done before(!) encrypting the file,
       
   268 since otherwise there is almost no benefit in compressing an encrypted
       
   269 file!
       
   270 
   246 =cut
   271 =cut