--- a/imager Mon Jul 18 22:56:50 2011 +0200
+++ b/imager Thu Jul 21 00:20:10 2011 +0200
@@ -11,10 +11,13 @@
use File::Temp;
use Sys::Hostname;
use IO::Compress::Gzip qw(gzip $GzipError);
+use Getopt::Long;
+use Pod::Usage;
use constant KiB => 1024;
use constant MiB => 1024 * KiB;
use constant GiB => 1024 * MiB;
+use constant BLOCKSIZE => 8 * MiB;
sub get_devsize;
sub get_devname;
@@ -23,85 +26,94 @@
my $compress = 0;
-my $DEV = shift // die "Need device name\n";
-my $DIR = shift // die "Need destination (root) directory\n";
-my $BS = 8 * MiB; # should be multiple of 4k (file system block size)
my $NOW = time();
my $DATETIME = strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime($NOW));
-my $SIZE = get_devsize($DEV);
+
+MAIN: {
+ my ($dev, $dir);
+
+ my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/";
+ my $data = "{DIR}/data";
+ my $size;
-my $DATA = "$DIR/data";
-my $IDX = "$DIR/idx/{HOSTNAME}/{DEVICE}/";
-$IDX =~ s/{HOSTNAME}/hostname/e;
-$IDX =~ s/{DEVICE}/get_devname($DEV)/e;
-
+ 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"))
+ }
+ ) and @ARGV == 2 or pod2usage;
+ ($dev, $dir) = @ARGV;
--d $DIR or die "$0: $DIR: $!\n";
-mkpath($DATA, $IDX);
-
-
-my $index = File::Temp->new(DIR => $IDX);
+ foreach ($idx, $data) {
+ s/{DIR}/$dir/g;
+ s/{HOSTNAME}/hostname/eg;
+ s/{DEVICE}/get_devname($dev)/eg;
+ }
+ $size = get_devsize($dev);
-print {$index} <<__EOT;
+ -d $dir or die "$0: $dir: $!\n";
+ mkpath($data, $idx);
+
+ my $index = File::Temp->new(DIR => $idx);
+ print {$index} <<__EOT;
+# imager
format: 1
-filesystem: $DEV
-blocksize: $BS
-devsize: $SIZE
+filesystem: $dev
+blocksize: @{[BLOCKSIZE]}
+devsize: $size
timestamp: $NOW
datetime: $DATETIME
__EOT
-
-open(my $dev => $DEV);
-local $/ = \$BS;
-local $| = 1;
+ open(my $in => $dev);
+ binmode($in);
+ local $/ = \(my $bs = BLOCKSIZE);
+ local $| = 1;
-my %stats = (
- written => 0,
- skipped => 0
-);
+ my %stats = (
+ written => 0,
+ skipped => 0
+ );
+
+ while (my $buffer = <$in>) {
+ my $cs = md5_hex($buffer);
+ (my $file = $cs) =~ s/(..)(..)(.*)/$1\/$2\/$3/g;
+ $file .= ".gz" if $compress;
+
+ my $log = sprintf "%6d %s %s" => ($.-1), $cs, $file;
-while (my $data = <$dev>) {
- my $cs = md5_hex($data);
- #(my $file = $cs) =~ s/(........)(?=.)/$1\//g;
- #(my $file = $cs) =~ s/(.)(..)(....)(........)(.*)/$1\/$2\/$3\/$4\/$5/g;
- (my $file = $cs) =~ s/(..)(..)(.*)/$1\/$2\/$3/g;
- #$file = dirname($file) . "/$cs";
- $file .= ".gz" if $compress;
-
- my $log = sprintf "%6d %s %s" => ($.-1), $cs, $file;
+ if (!-e "$data/$file") {
+ mkpath dirname("$data/$file");
+ open(my $out, ">$data/$file");
+ binmode($out);
+ if ($compress) { gzip \$buffer => $out or die $GzipError }
+ else { print {$out} $buffer }
+ close($out);
+ $log .= " *";
+ $stats{written}++;
+ }
+ else {
+ $log .= " ";
+ $stats{skipped}++;
+ }
- if (!-e "$DATA/$file") {
- mkpath dirname("$DATA/$file");
- open(my $out, ">$DATA/$file");
- if ($compress) { gzip \$data => $out or die $GzipError }
- else { print {$out} $data }
- close($out);
- $log .= " *";
- $stats{written}++;
- }
- else {
- $log .= " ";
- $stats{skipped}++;
+ say $log . sprintf "%3d%%" => 100 * ($. * BLOCKSIZE)/$size;
+ say {$index} $log;
}
- say $log . sprintf "%3d%%" => 100 * ($. * $BS)/$SIZE;
- say {$index} $log;
+ say {$index} "# DONE (runtime " . (time() - $^T) . "s)";
+
+ say "# DONE (runtime " . (time() - $^T) . "s)";
+ say "# WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks";
+ say "# SAVINGS "
+ . sprintf "%3d%%" => 100 * ($stats{skipped}/($stats{written}+$stats{skipped}));
+
+ rename $index->filename => "$idx/$DATETIME";
+ close $index;
+
}
-say {$index} "# DONE (runtime " . (time() - $^T) . "s)";
-
-say "# DONE (runtime " . (time() - $^T) . "s)";
-say "# WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks";
-say "# SAVINGS "
- . sprintf "%3d%%" => 100 * ($stats{skipped}/($stats{written}+$stats{skipped}));
-
-rename $index->filename => "$IDX/$DATETIME";
-close $index;
-
-#---
-#
sub get_devsize {
my ($devname) = @_;
open(my $fh => $devname);
@@ -116,3 +128,23 @@
s/\//_/g;
return $_;
}
+
+__END__
+
+=head1 NAME
+
+ imager - create a block device snapshot
+
+=head1 SYNOPSIS
+
+ imager [options] {device} {destination}
+
+=head1 DESCRIPTION
+
+This tool creates a snapshot of a blockdevice.
+
+=head1 OPTIONS
+
+Currently there are no useful options.
+
+=cut