1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use POSIX qw(strftime);

     7 use autodie qw(:all);

     8 use Digest::MD5 qw(md5_hex);

     9 use File::Path qw(mkpath);

    10 use File::Basename;

    11 use File::Temp;

    12 use Sys::Hostname;

    13 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy);

    14 use Hash::Util qw(lock_keys);

    15 use Getopt::Long;

    16 use Pod::Usage;

    17 

    18 use constant KiB      => 1024;

    19 use constant MiB      => 1024 * KiB;

    20 use constant GiB      => 1024 * MiB;

    21 use constant NOW      => time();

    22 use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW));

    23 

    24 sub get_devsize;

    25 sub get_devname;

    26 

    27 $SIG{INT} = sub { die "Got INT\n" };

    28 

    29 my %o = (

    30     compress  => undef,

    31     verbose   => undef,

    32     blocksize => 2 * MiB,

    33 );

    34 lock_keys(%o);

    35 

    36 my $NOW = time();

    37 

    38 MAIN: {

    39     my ($src, $dst);

    40 

    41     my $idx  = "{DIR}/idx/{HOSTNAME}/{DEVICE}/";

    42     my $data = "{DIR}/data";

    43     my $size;

    44 

    45     GetOptions(

    46         "h|help" => sub { pod2usage(-verbose => 1, exit => 0) },

    47         "m|man"  => sub {

    48             pod2usage(

    49                 -verbose   => 2,

    50                 exit       => 0,

    51                 -noperldoc => system("perldoc -V >/dev/null 2>&1")

    52             );

    53         },

    54         "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },

    55         "b|blocksize=s" => sub {

    56             given ($_[1]) {

    57                 when (/(\d+)G/i) { $o{blocksize} = $1 * GiB };

    58                 when (/(\d+)M/i) { $o{blocksize} = $1 * MiB };

    59                 when (/(\d+)K/i) { $o{blocksize} = $1 * KiB };

    60                 when (/^(\d+)$/) { $o{blocksize} = $1 };

    61                 default {

    62                     die "Blocksize $_[1] is incorrect!\n"

    63                 };

    64             }

    65         },

    66       )

    67       and @ARGV == 2

    68       or pod2usage;

    69     ($src, $dst) = @ARGV;

    70 

    71     foreach ($idx, $data) {

    72         s/{DIR}/$dst/g;

    73         s/{HOSTNAME}/hostname/eg;

    74         s/{DEVICE}/get_devname($src)/eg;

    75     }

    76     $size = get_devsize($src);

    77 

    78     -d $dst or die "$0: $dst: $!\n";

    79     mkpath([$data, $idx]);

    80 

    81     my $index = File::Temp->new(DIR => $idx);

    82     print {$index} <<__EOT;

    83 # imager

    84 format: 1

    85 host: @{[hostname]}

    86 filesystem: $src

    87 blocksize: $o{blocksize}

    88 devsize: $size

    89 timestamp: @{[NOW]}

    90 datetime: @{[DATETIME]}

    91 

    92 __EOT

    93 

    94     open(my $in => $src);

    95     binmode($in);

    96     local $/ = \(my $bs = $o{blocksize});

    97     local $| = 1;

    98 

    99     my %stats = (

   100         written => 0,

   101         skipped => 0,

   102         todo    => 1 + int($size / $o{blocksize}),

   103     );

   104 

   105     local $SIG{ALRM} = sub {

   106         my $speed = ($stats{written} + $stats{skipped}) / (time - $^T + 1);

   107         say sprintf

   108 "# done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)",

   109           100 * (($stats{written} + $stats{skipped}) / $stats{todo}),

   110           ($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""),

   111           length($stats{todo}) => $stats{written} + $stats{skipped},

   112           length($stats{todo}) => $stats{written},

   113           length($stats{todo}) => $stats{skipped};

   114         alarm(5);

   115     };

   116     $SIG{ALRM}->();

   117 

   118     while (my $buffer = <$in>) {

   119 	my ($file, $ext, $cs);

   120 	$file = $cs = md5_hex($buffer);

   121 	$file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;

   122 	$ext = $o{compress} ? ".gz" : "";

   123 

   124         # the extension we do not put into the index

   125         my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file;

   126 

   127         if (not(-e "$data/$file" or -e "$data/$file.gz")) {

   128             mkpath dirname("$data/$file.gz");

   129             my $out = File::Temp->new(

   130                 TEMPLATE => ".XXXXXXX",

   131                 DIR      => dirname("$data/$file")

   132             );

   133             binmode($out);

   134             if ($o{compress}) {

   135                 gzip(

   136                     \$buffer  => $out,

   137                     -Minimal  => 1,

   138                     -Level    => Z_BEST_SPEED,

   139                     -Strategy => Z_FILTERED

   140                 ) or die $GzipError;

   141             }

   142             else { print {$out} $buffer }

   143             close($out);

   144             rename($out => "$data/$file$ext");

   145             $log .= " *";

   146             $stats{written}++;

   147         }

   148         else {

   149             $log .= "  ";

   150             $stats{skipped}++;

   151         }

   152 

   153         say {$index} $log;

   154     }

   155     $SIG{ALRM}->();

   156     alarm 0;

   157 

   158     say {$index} "# DONE (runtime " . (time() - $^T) . "s)";

   159 

   160     say "# DONE (runtime " . (time() - $^T) . "s)";

   161     say "# WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks";

   162     say "# SAVINGS "

   163       . sprintf "%3d%%" => 100 *

   164       ($stats{skipped} / ($stats{written} + $stats{skipped}));

   165 

   166     rename $index->filename => "$idx/" . DATETIME;

   167     close $index;

   168 

   169 }

   170 

   171 sub get_devsize {

   172     my ($devname) = @_;

   173     open(my $fh => $devname);

   174     seek($fh, 0, 2);

   175     return tell($fh);

   176 }

   177 

   178 sub get_devname {

   179     my $_ = shift;

   180     s/^\/dev\///;

   181     s/_/__/g;

   182     s/\//_/g;

   183     return $_;

   184 }

   185 

   186 __END__

   187 

   188 =head1 NAME

   189 

   190     imager.save - create a block device snapshot

   191 

   192 =head1 SYNOPSIS

   193 

   194     imager.save [options] {device} {destination}

   195 

   196 =head1 DESCRIPTION

   197 

   198 This tool creates a snapshot of a blockdevice.

   199 Just call it like

   200 

   201     imager.save /dev/sda1 /media/backup

   202 

   203 This will create F</media/backup/{data,idx}>, if not already existing.

   204 The index (blocklist) goes to

   205 I<destination>F</idx/>I<hostname>F</>I<devicename>.  The data goes to

   206 I<destination>/F<data/>.

   207 

   208 =head1 OPTIONS

   209 

   210 =over

   211 

   212 =item B<-z> [I<level>]|B<--compress>[=I<level>]

   213 

   214 Use compression when writing the blocks to disk. (default: off)

   215 

   216 =item B<-b> I<blocksize>|B<--blocksize>=I<blocksize>

   217 

   218 The blocksize used. (may be suffixed with K, M, G). (default: 2MiB)

   219 

   220 =item B<-h>|B<--help>

   221 

   222 =item B<-m>|B<--man>

   223 

   224 The short and longer help. 

   225 

   226 =back

   227 

   228 =cut