--- a/bin/imager.save Sat Jul 25 17:16:13 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,319 +0,0 @@
-#! /usr/bin/perl
-
-use 5.010;
-use strict;
-use warnings;
-use POSIX qw(strftime);
-use autodie qw(:all);
-use Digest::MD5 qw(md5_hex);
-use File::Path qw(mkpath);
-use File::Basename;
-use File::Temp;
-use Sys::Hostname;
-use IO::Compress::Gzip qw(gzip $GzipError :level :strategy);
-use Hash::Util qw(lock_keys);
-use Getopt::Long;
-use Pod::Usage;
-use Imager 0.1;
-use if $^V >= v5.18 => (experimental => qw'lexical_topic smartmatch');
-
-use constant KiB => 1024;
-use constant MiB => 1024 * KiB;
-use constant GiB => 1024 * MiB;
-use constant BS => 4 * MiB;
-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 = (
- compress => undef,
- verbose => undef,
- blocksize => BS,
- pass => undef,
- comment => undef,
- now => time(),
-);
-lock_keys(%o);
-
-MAIN: {
- GetOptions(
- "h|help" => sub { pod2usage(-verbose => 1, exit => 0) },
- "m|man" => sub {
- pod2usage(
- -verbose => 2,
- exit => 0,
- -noperldoc => system("perldoc -V >/dev/null 2>&1")
- );
- },
- "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 };
- when (/(\d+)M/i) { $o{blocksize} = $1 * MiB };
- when (/(\d+)K/i) { $o{blocksize} = $1 * KiB };
- when (/^(\d+)$/) { $o{blocksize} = $1 };
- default {
- die "Blocksize $_[1] is incorrect!\n"
- };
- }
- },
- )
- and @ARGV >= 2
- or pod2usage;
-
- my $dst = pop @ARGV;
- foreach my $src (@ARGV) {
- if (my $pid = fork()) {
- next;
- }
- elsif (not defined $pid) {
- die "Can't fork: $!\n";
- }
- save($src, $dst);
- exit;
- }
-
- my $rc = 0;
- while (wait != -1) {
- $rc = ($? >> 8) if ($? >> 8) > $rc;
- }
- exit $rc;
-
-}
-
-sub save {
- my ($src, $dst) = @_;
- my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/";
- my $data = "{DIR}/data";
- my $info = "{DIR}/data/info";
- 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}/$name/g;
- }
- $size = get_devsize($src);
-
- -d $dst or die "$0: $dst: $!\n";
- mkpath([$data, $idx, $info]);
-
- my %index;
- $index{META} = {
- format => 1,
- host => hostname,
- filesystem => $src,
- blocksize => $o{blocksize},
- devsize => $size,
- 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 $| = 1;
-
- my %stats = (
- written => 0,
- skipped => 0,
- todo => 1 + int($size / $o{blocksize}),
- );
-
- local $SIG{ALRM} = sub {
- my $speed = ($stats{written} + $stats{skipped}) / (time - $^T + 1);
- say sprintf
-"# %*s done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)",
- (sort { $a <=> $b } map { length basename $_ } @ARGV)[-1] =>
- basename($name),
- 100 * (($stats{written} + $stats{skipped}) / $stats{todo}),
- ($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""),
- length($stats{todo}) => $stats{written} + $stats{skipped},
- length($stats{todo}) => $stats{written},
- length($stats{todo}) => $stats{skipped};
- alarm(5);
- };
- $SIG{ALRM}->();
-
- 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 .= $o{pass} ? ".x" : "";
-
- # the extension we do not put into the index
- push @{ $index{BLOCKS} }, sprintf "%12d %s %s" => $blknr,
- $cs, $file;
-
- if (not Imager::get_file("$data/$file")) {
- mkpath dirname("$data/$file");
- my $out = File::Temp->new(
- TEMPLATE => "tmp-XXXXXXX",
- DIR => dirname("$data/$file")
- );
-
- if ($o{pass}) {
- open($out, "|openssl @{[CIPHER]} -pass $o{pass} -out $out");
- }
- binmode($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 or die "$0: write: $!\n";
- close($out) or die "$0: close output file: $!";
-
- rename($out => "$data/$file$ext");
- $index{BLOCKS}[$blknr] .= " *";
- $stats{written}++;
- }
- else {
- $stats{skipped}++;
- }
- }
- $SIG{ALRM}->();
- alarm 0;
-
- $index{META}{blocks} = @{ $index{BLOCKS} };
- $index{META}{runtime} = time() - $^T . "s";
-
- my $index = File::Temp->new(DIR => $idx);
- say $index join "\n" => "# imager",
- (map { "$_: $index{META}{$_}" } sort(keys %{ $index{META} })),
- "",
- @{ $index{BLOCKS} };
- close($index);
- 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";
- say "# $src SAVINGS "
- . sprintf "%3d%%" => 100 *
- ($stats{skipped} / ($stats{written} + $stats{skipped}));
-
-}
-
-sub get_devsize {
- my ($devname) = @_;
- open(my $fh => $devname);
- seek($fh, 0, 2);
- return tell($fh);
-}
-
-sub get_devname {
- my $_ = shift;
- s/^\/dev\///;
- s/_/__/g;
- s/\//_/g;
- return $_;
-}
-
-__END__
-
-=head1 NAME
-
- imager.save - create a block device snapshot
-
-=head1 SYNOPSIS
-
- imager.save [options] {device}[:name] {destination}
-
-=head1 DESCRIPTION
-
-This tool creates a snapshot of a blockdevice.
-Just call it like
-
- imager.save /dev/sda1 /media/backup
-
-This will create F</media/backup/{data,idx}>, if not already existing.
-The index (blocklist) goes to
-I<destination>F</idx/>I<hostname>F</>I<devicename>. The data goes to
-I<destination>/F<data/>.
-
-If :I<name> is appended on to the device name, the blocklist file and
-the data directory are named acording to this I<name>, not the original
-device name. You may welcome this extension if you save LVM snapshots
-or simiar stuff.
-
-=head1 OPTIONS
-
-=over
-
-=item B<-b>|B<--blocksize> I<blocksize>
-
-The blocksize used. (may be suffixed with K, M, G). (default: 4 MiB,
-or taken from F<data/info/blocksize>)
-
-=item B<-c>|B<--comment> I<comment>
-
-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
-is passed to L<openssl(1)>.
-
-=item B<-z>|B<--compress> [I<level>]
-
-Use compression when writing the blocks to disk. B<NOTE:> There may
-remain uncompressed files, since we only save compressed data if we
-can save more then 10% of the size. (default: off)
-
-=item B<-h>|B<--help>
-
-=item B<-m>|B<--man>
-
-The short and longer help.
-
-=back
-
-=head1 PERFORMANCE
-
-Some experiments have shown that if compression and encryption is used,
-about 1/3 of the time is consumed by the encryption, and 2/3 are used
-for compression. The compression is done before(!) encrypting the file,
-since otherwise there is almost no benefit in compressing an encrypted
-file!
-
-=cut