diff -r a5d087334439 -r dd11d1262b6c bin/imager.save --- 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 =~ /(?.+?):(?.+)/) { - $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/(?(?...).*)/$+{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, if not already existing. -The index (blocklist) goes to -IFIFI. The data goes to -I/F. - -If :I is appended on to the device name, the blocklist file and -the data directory are named acording to this I, 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 - -The blocksize used. (may be suffixed with K, M, G). (default: 4 MiB, -or taken from F) - -=item B<-c>|B<--comment> I - -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 -is passed to L. - -=item B<-z>|B<--compress> [I] - -Use compression when writing the blocks to disk. B 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