contrib/restore.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Proof-of-concept/reference decoder for LBS-format backup snapshots.
   4 #
   5 # This decoder aims to decompress an LBS snapshot.  It is not meant to be
   6 # particularly efficient, but should be a small and portable tool for doing so
   7 # (important for recovering from data loss).  It is also meant to serve as a
   8 # check on the snapshot tool and data format itself, and serve as documentation
   9 # for the format.
  10 #
  11 # This decoder does not understand TAR archives; it assumes that all segments
  12 # in the snapshot have already been decompressed, and that objects are
  13 # available simply as files in the filesystem.  This simplifies the design.
  14 #
  15 # Limitations: Since this code is probably using 32-bit arithmetic, files
  16 # larger than 2-4 GB may not be properly handled.
  17 #
  18 # Copyright (C) 2007  Michael Vrable
  19
  20 use strict;
  21 use Digest::SHA1;
  22 use File::Basename;
  23
  24 my $OBJECT_DIR;                 # Where are the unpacked objects available?
  25 my $DEST_DIR = ".";             # Where should restored files should be placed?
  26 my $RECURSION_LIMIT = 3;        # Bound on recursive object references
  27
  28 my $VERBOSE = 0;                # Set to 1 to enable debugging messages
  29
  30 ############################ CHECKSUM VERIFICATION ############################
  31 # A very simple layer for verifying checksums.  Checksums may be used on object
  32 # references directly, and can also be used to verify entire reconstructed
  33 # files.
  34 #
  35 # A checksum to verify is given in the form "algorithm=hexdigest".  Given such
  36 # a string, we can construct a "verifier" object.  Bytes can be incrementally
  37 # added to the verifier, and at the end a test can be made to see if the
  38 # checksum matches.  The caller need not know what algorithm is used.  However,
  39 # at the moment we only support SHA-1 for computing digest (algorith name
  40 # "sha1").
  41 sub verifier_create {
  42     my $checksum = shift;
  43
  44     if ($checksum !~ m/^(\w+)=([0-9a-f]+)$/) {
  45         die "Malformed checksum: $checksum";
  46     }
  47     my ($algorithm, $hash) = ($1, $2);
  48     if ($algorithm ne 'sha1') {
  49         die "Unsupported checksum algorithm: $algorithm";
  50     }
  51
  52     my %verifier = (
  53         ALGORITHM => $algorithm,
  54         HASH => $hash,
  55         DIGESTER => new Digest::SHA1
  56     );
  57
  58     return \%verifier;
  59 }
  60
  61 sub verifier_add_bytes {
  62     my $verifier = shift;
  63     my $digester = $verifier->{DIGESTER};
  64     my $data = shift;
  65
  66     $digester->add($data);
  67 }
  68
  69 sub verifier_check {
  70     my $verifier = shift;
  71     my $digester = $verifier->{DIGESTER};
  72
  73     my $newhash = $digester->hexdigest();
  74     if ($VERBOSE && $verifier->{HASH} ne $newhash) {
  75         print STDERR "Verification failure: ",
  76             $newhash, " != ", $verifier->{HASH}, "\n";
  77     }
  78     return ($verifier->{HASH} eq $newhash);
  79 }
  80
  81 ################################ OBJECT ACCESS ################################
  82 # The base of the decompressor is the object reference layer.  See ref.h for a
  83 # description of the format for object references.  These functions will parse
  84 # an object reference, locate the object data from the filesystem, perform any
  85 # necessary integrity checks (if a checksum is included), and return the object
  86 # data.
  87 sub load_ref {
  88     my $ref_str = shift;
  89
  90     # Check for special objects before attempting general parsing.
  91     if ($ref_str =~ m/^zero\[((\d+)\+)?(\d+)\]$/) {
  92         return "\0" x ($3 + 0);
  93     }
  94
  95     # Try to parse the object reference string into constituent pieces.  The
  96     # format is segment/object(checksum)[range].  Both the checksum and range
  97     # are optional.
  98     if ($ref_str !~ m/^([-0-9a-f]+)\/([0-9a-f]+)(\(\S+\))?(\[\S+\])?$/) {
  99         die "Malformed object reference: $ref_str";
 100     }
 101
 102     my ($segment, $object, $checksum, $range) = ($1, $2, $3, $4);
 103
 104     # Next, use the segment/object components to locate and read the object
 105     # contents from disk.
 106     open OBJECT, "<", "$OBJECT_DIR/$segment/$object"
 107         or die "Unable to open object $OBJECT_DIR/$segment/$object: $!";
 108     my $contents = join '', <OBJECT>;
 109     close OBJECT;
 110
 111     # If a checksum was specified in the object reference, verify the object
 112     # integrity by computing a checksum of the read data and comparing.
 113     if ($checksum) {
 114         $checksum =~ m/^\((\S+)\)$/;
 115         my $verifier = verifier_create($1);
 116         verifier_add_bytes($verifier, $contents);
 117         if (!verifier_check($verifier)) {
 118             die "Integrity check for object $ref_str failed";
 119         }
 120     }
 121
 122     # If a range was specified, then only a subset of the bytes of the object
 123     # are desired.  Extract just the desired bytes.
 124     if ($range) {
 125         if ($range !~ m/^\[((\d+)\+)?(\d+)\]$/) {
 126             die "Malformed object range: $range";
 127         }
 128
 129         my $object_size = length $contents;
 130         my ($start, $length);
 131         if ($1 ne "") {
 132             ($start, $length) = ($2 + 0, $3 + 0);
 133         } else {
 134             ($start, $length) = (0, $3 + 0);
 135         }
 136         if ($start >= $object_size || $start + $length > $object_size) {
 137             die "Object range $range falls outside object bounds "
 138                 . "(actual size $object_size)";
 139         }
 140
 141         $contents = substr $contents, $start, $length;
 142     }
 143
 144     return $contents;
 145 }
 146
 147 ############################### FILE PROCESSING ###############################
 148 # Process the metadata for a single file.  process_file is the main entry
 149 # point; it should be given a list of file metadata key/value pairs.
 150 # iterate_objects is a helper function used to iterate over the set of object
 151 # references that contain the file data for a regular file.
 152
 153 sub parse_int {
 154     my $str = shift;
 155     if ($str =~ /^0/) {
 156         return oct($str);
 157     } else {
 158         return $str + 0;
 159     }
 160 }
 161
 162 sub uri_decode {
 163     my $str = shift;
 164     $str =~ s/%([0-9a-f]{2})/chr(hex($1))/ge;
 165     return $str;
 166 }
 167
 168 sub iterate_objects {
 169     my $callback = shift;       # Function to be called for each reference
 170     my $arg = shift;            # Argument passed to callback
 171     my $text = shift;           # Whitespace-separate list of object references
 172
 173     # Simple limit to guard against cycles in the object references
 174     my $recursion_level = shift || 0;
 175     if ($recursion_level >= $RECURSION_LIMIT) {
 176         die "Recursion limit reached";
 177     }
 178
 179     # Split the provided text at whitespace boundaries to produce the list of
 180     # object references.  If any of these start with "@", then we have an
 181     # indirect reference, and must look up that object and call iterate_objects
 182     # with the contents.
 183     my $obj;
 184     foreach $obj (split /\s+/, $text) {
 185         next if $obj eq "";
 186         if ($obj =~ /^@(\S+)$/) {
 187             my $indirect = load_ref($1);
 188             iterate_objects($callback, $arg, $indirect, $recursion_level + 1);
 189         } else {
 190             &$callback($arg, $obj);
 191         }
 192     }
 193 }
 194
 195 sub obj_callback {
 196     my $state = shift;
 197     my $obj = shift;
 198     my $data = load_ref($obj);
 199     print FILE $data
 200         or die "Error writing file data: $!";
 201     verifier_add_bytes($state->{VERIFIER}, $data);
 202     $state->{BYTES} += length($data);
 203 }
 204
 205 # Extract the contents of a regular file by concatenating all the objects that
 206 # comprise it.
 207 sub unpack_file {
 208     my $name = shift;
 209     my %info = @_;
 210     my %state = ();
 211
 212     if (!defined $info{data}) {
 213         die "File contents not specified for $name";
 214     }
 215     if (!defined $info{checksum} || !defined $info{size}) {
 216         die "File $name is missing checksum or size";
 217     }
 218
 219     $info{size} = parse_int($info{size});
 220
 221     # Open the file to be recreated.  The data will be written out by the call
 222     # to iterate_objects.
 223     open FILE, ">", "$DEST_DIR/$name"
 224         or die "Cannot write file $name: $!";
 225
 226     # Set up state so that we can incrementally compute the checksum and length
 227     # of the reconstructed data.  Then iterate over all objects in the file.
 228     $state{VERIFIER} = verifier_create($info{checksum});
 229     $state{BYTES} = 0;
 230     iterate_objects(\&obj_callback, \%state, $info{data});
 231
 232     close FILE;
 233
 234     # Verify that the reconstructed object matches the size/checksum we were
 235     # given.
 236     if (!verifier_check($state{VERIFIER}) || $state{BYTES} != $info{size}) {
 237         die "File reconstruction failed for $name: size or checksum differs";
 238     }
 239 }
 240
 241 sub process_file {
 242     my %info = @_;
 243
 244     if (!defined($info{name})) {
 245         die "Filename not specified in metadata block";
 246     }
 247
 248     my $type = $info{type};
 249
 250     my $filename = uri_decode($info{name});
 251     print "$filename\n" if $VERBOSE;
 252
 253     # Restore the specified file.  How to do so depends upon the file type, so
 254     # dispatch based on that.
 255     my $dest = "$DEST_DIR/$filename";
 256     if ($type eq '-' || $type eq 'f') {
 257         # Regular file
 258         unpack_file($filename, %info);
 259     } elsif ($type eq 'd') {
 260         # Directory
 261         if ($filename ne '.') {
 262             mkdir $dest or die "Cannot create directory $filename: $!";
 263         }
 264     } elsif ($type eq 'l') {
 265         # Symlink
 266         my $target = $info{target} || $info{contents};
 267         if (!defined($target)) {
 268             die "Symlink $filename has no value specified";
 269         }
 270         $target = uri_decode($target);
 271         symlink $target, $dest
 272             or die "Cannot create symlink $filename: $!";
 273
 274         # TODO: We can't properly restore all metadata for symbolic links
 275         # (attempts to do so below will change metadata for the pointed-to
 276         # file).  This should be later fixed, but for now we simply return
 277         # before getting to the restore metadata step below.
 278         return;
 279     } elsif ($type eq 'p' || $type eq 's' || $type eq 'c' || $type eq 'b') {
 280         # Pipe, socket, character device, block device.
 281         # TODO: Handle these cases.
 282         print STDERR "Ignoring special file $filename of type $type\n";
 283         return;
 284     } else {
 285         die "Unknown file type '$type' for file $filename";
 286     }
 287
 288     # Restore mode, ownership, and any other metadata for the file.  This is
 289     # split out from the code above since the code is the same regardless of
 290     # file type.
 291     my $mtime = $info{mtime} || time();
 292     utime time(), $mtime, $dest
 293         or warn "Unable to update mtime for $dest";
 294
 295     my $uid = -1;
 296     my $gid = -1;
 297     if (defined $info{user}) {
 298         my @items = split /\s/, $info{user};
 299         $uid = parse_int($items[0]) if exists $items[0];
 300     }
 301     if (defined $info{group}) {
 302         my @items = split /\s/, $info{group};
 303         $gid = parse_int($items[0]) if exists $items[0];
 304     }
 305     chown $uid, $gid, $dest
 306         or warn "Unable to change ownership for $dest";
 307
 308     if (defined $info{mode}) {
 309         my $mode = parse_int($info{mode});
 310         chmod $mode, $dest
 311             or warn "Unable to change permissions for $dest";
 312     }
 313 }
 314
 315 ########################### METADATA LIST PROCESSING ##########################
 316 # Process the file metadata listing provided, and as information for each file
 317 # is extracted, pass it to process_file.  This will recursively follow indirect
 318 # references to other metadata objects.
 319 sub process_metadata {
 320     my ($metadata, $recursion_level) = @_;
 321
 322     # Check recursion; this will prevent us from infinitely recursing on an
 323     # indirect reference which loops back to itself.
 324     $recursion_level ||= 0;
 325     if ($recursion_level >= $RECURSION_LIMIT) {
 326         die "Recursion limit reached";
 327     }
 328
 329     # Split the metadata into lines, then start processing each line.  There
 330     # are two primary cases:
 331     #   - Lines starting with "@" are indirect references to other metadata
 332     #     objects.  Recursively process that object before continuing.
 333     #   - Other lines should come in groups separated by a blank line; these
 334     #     contain metadata for a single file that should be passed to
 335     #     process_file.
 336     # Note that blocks of metadata about a file cannot span a boundary between
 337     # metadata objects.
 338     my %info = ();
 339     my $line;
 340     my $last_key;
 341     foreach $line (split /\n/, $metadata) {
 342         # If we find a blank line or a reference to another block, process any
 343         # data for the previous file first.
 344         if ($line eq '' || $line =~ m/^@/) {
 345             process_file(%info) if %info;
 346             %info = ();
 347             undef $last_key;
 348             next if $line eq '';
 349         }
 350
 351         # Recursively handle indirect metadata blocks.
 352         if ($line =~ m/^@(\S+)$/) {
 353             print "Indirect: $1\n" if $VERBOSE;
 354             my $indirect = load_ref($1);
 355             process_metadata($indirect, $recursion_level + 1);
 356             next;
 357         }
 358
 359         # Try to parse the data as "key: value" pairs of file metadata.  Also
 360         # handle continuation lines, which start with whitespace and continue
 361         # the previous "key: value" pair.
 362         if ($line =~ m/^(\w+):\s*(.*)$/) {
 363             $info{$1} = $2;
 364             $last_key = $1;
 365         } elsif ($line =~/^\s/ && defined $last_key) {
 366             $info{$last_key} .= $line;
 367         } else {
 368             print STDERR "Junk in file metadata section: $line\n";
 369         }
 370     }
 371
 372     # Process any last file metadata which has not already been processed.
 373     process_file(%info) if %info;
 374 }
 375
 376 ############################### MAIN ENTRY POINT ##############################
 377 # Program start.  We expect to be called with a single argument, which is the
 378 # name of the backup descriptor file written by a backup pass.  This will name
 379 # the root object in the snapshot, from which we can reach all other data we
 380 # need.
 381
 382 # Parse command-line arguments.  The first (required) is the name of the
 383 # snapshot descriptor file.  The backup objects are assumed to be stored in the
 384 # same directory as the descriptor.  The second (optional) argument is the
 385 # directory where the restored files should be written; it defaults to ".";
 386 my $descriptor = $ARGV[0];
 387 unless (defined($descriptor) && -r $descriptor) {
 388     print STDERR "Usage: $0 <snapshot file>\n";
 389     exit 1;
 390 }
 391
 392 if (defined($ARGV[1])) {
 393     $DEST_DIR = $ARGV[1];
 394 }
 395
 396 $OBJECT_DIR = dirname($descriptor);
 397 print "Source directory: $OBJECT_DIR\n" if $VERBOSE;
 398
 399 # Read the snapshot descriptor to find the root object.  Parse it to get a set
 400 # of key/value pairs.
 401 open DESCRIPTOR, "<", $descriptor
 402     or die "Cannot open backup descriptor file $descriptor: $!";
 403 my %descriptor = ();
 404 my ($line, $last_key);
 405 while (defined($line = <DESCRIPTOR>)) {
 406     # Any lines of the form "key: value" should be inserted into the
 407     # %descriptor dictionary.  Any continuation line (a line starting with
 408     # whitespace) will append text to the previous key's value.  Ignore other
 409     # lines.
 410     chomp $line;
 411
 412     if ($line =~ m/^(\w+):\s*(.*)$/) {
 413         $descriptor{$1} = $2;
 414         $last_key = $1;
 415     } elsif ($line =~/^\s/ && defined $last_key) {
 416         $descriptor{$last_key} .= $line;
 417     } else {
 418         undef $last_key;
 419         print STDERR "Ignoring line in backup descriptor: $line\n";
 420     }
 421 }
 422
 423 # A valid backup descriptor should at the very least specify the root metadata
 424 # object.
 425 if (!exists $descriptor{Root}) {
 426     die "Expected 'Root:' specification in backup descriptor file";
 427 }
 428 my $root = $descriptor{Root};
 429 close DESCRIPTOR;
 430
 431 # Set the umask to something restrictive.  As we unpack files, we'll originally
 432 # write the files/directories without setting the permissions, so be
 433 # conservative and ensure that they can't be read.  Afterwards, we'll properly
 434 # fix up permissions.
 435 umask 077;
 436
 437 # Start processing metadata stored in the root to recreate the files.
 438 print "Root object: $root\n" if $VERBOSE;
 439 my $contents = load_ref($root);
 440 process_metadata($contents);