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     # First, try to parse the object reference string into constituent pieces.
  89     # The format is segment/object(checksum)[range].  Both the checksum and
  90     # range are optional.
  91     my $ref_str = shift;
  92
  93     if ($ref_str !~ m/^([-0-9a-f]+)\/([0-9a-f]+)(\(\S+\))?(\[\S+\])?$/) {
  94         die "Malformed object reference: $ref_str";
  95     }
  96
  97     my ($segment, $object, $checksum, $range) = ($1, $2, $3, $4);
  98
  99     # Next, use the segment/object components to locate and read the object
 100     # contents from disk.
 101     open OBJECT, "<", "$OBJECT_DIR/$segment/$object"
 102         or die "Unable to open object $OBJECT_DIR/$segment/$object: $!";
 103     my $contents = join '', <OBJECT>;
 104     close OBJECT;
 105
 106     # If a checksum was specified in the object reference, verify the object
 107     # integrity by computing a checksum of the read data and comparing.
 108     if ($checksum) {
 109         $checksum =~ m/^\((\S+)\)$/;
 110         my $verifier = verifier_create($1);
 111         verifier_add_bytes($verifier, $contents);
 112         if (!verifier_check($verifier)) {
 113             die "Integrity check for object $ref_str failed";
 114         }
 115     }
 116
 117     # If a range was specified, then only a subset of the bytes of the object
 118     # are desired.  Extract just the desired bytes.
 119     if ($range) {
 120         if ($range !~ m/^\[(\d+)\+(\d+)\]$/) {
 121             die "Malformed object range: $range";
 122         }
 123
 124         my $object_size = length $contents;
 125         my ($start, $length) = ($1 + 0, $2 + 0);
 126         if ($start >= $object_size || $start + $length > $object_size) {
 127             die "Object range $range falls outside object bounds "
 128                 . "(actual size $object_size)";
 129         }
 130
 131         $contents = substr $contents, $start, $length;
 132     }
 133
 134     return $contents;
 135 }
 136
 137 ############################### FILE PROCESSING ###############################
 138 # Process the metadata for a single file.  process_file is the main entry
 139 # point; it should be given a list of file metadata key/value pairs.
 140 # iterate_objects is a helper function used to iterate over the set of object
 141 # references that contain the file data for a regular file.
 142
 143 sub parse_int {
 144     my $str = shift;
 145     if ($str =~ /^0/) {
 146         return oct($str);
 147     } else {
 148         return $str + 0;
 149     }
 150 }
 151
 152 sub uri_decode {
 153     my $str = shift;
 154     $str =~ s/%([0-9a-f]{2})/chr(hex($1))/ge;
 155     return $str;
 156 }
 157
 158 sub iterate_objects {
 159     my $callback = shift;       # Function to be called for each reference
 160     my $arg = shift;            # Argument passed to callback
 161     my $text = shift;           # Whitespace-separate list of object references
 162
 163     # Simple limit to guard against cycles in the object references
 164     my $recursion_level = shift || 0;
 165     if ($recursion_level >= $RECURSION_LIMIT) {
 166         die "Recursion limit reached";
 167     }
 168
 169     # Split the provided text at whitespace boundaries to produce the list of
 170     # object references.  If any of these start with "@", then we have an
 171     # indirect reference, and must look up that object and call iterate_objects
 172     # with the contents.
 173     my $obj;
 174     foreach $obj (split /\s+/, $text) {
 175         next if $obj eq "";
 176         if ($obj =~ /^@(\S+)$/) {
 177             my $indirect = load_ref($1);
 178             iterate_objects($callback, $arg, $indirect, $recursion_level + 1);
 179         } else {
 180             &$callback($arg, $obj);
 181         }
 182     }
 183 }
 184
 185 sub obj_callback {
 186     my $state = shift;
 187     my $obj = shift;
 188     my $data = load_ref($obj);
 189     print FILE $data
 190         or die "Error writing file data: $!";
 191     verifier_add_bytes($state->{VERIFIER}, $data);
 192     $state->{BYTES} += length($data);
 193 }
 194
 195 # Extract the contents of a regular file by concatenating all the objects that
 196 # comprise it.
 197 sub unpack_file {
 198     my $name = shift;
 199     my %info = @_;
 200     my %state = ();
 201
 202     if (!defined $info{data}) {
 203         die "File contents not specified for $name";
 204     }
 205     if (!defined $info{checksum} || !defined $info{size}) {
 206         die "File $name is missing checksum or size";
 207     }
 208
 209     $info{size} = parse_int($info{size});
 210
 211     # Open the file to be recreated.  The data will be written out by the call
 212     # to iterate_objects.
 213     open FILE, ">", "$DEST_DIR/$name"
 214         or die "Cannot write file $name: $!";
 215
 216     # Set up state so that we can incrementally compute the checksum and length
 217     # of the reconstructed data.  Then iterate over all objects in the file.
 218     $state{VERIFIER} = verifier_create($info{checksum});
 219     $state{BYTES} = 0;
 220     iterate_objects(\&obj_callback, \%state, $info{data});
 221
 222     close FILE;
 223
 224     # Verify that the reconstructed object matches the size/checksum we were
 225     # given.
 226     if (!verifier_check($state{VERIFIER}) || $state{BYTES} != $info{size}) {
 227         die "File reconstruction failed for $name: size or checksum differs";
 228     }
 229 }
 230
 231 sub process_file {
 232     my %info = @_;
 233
 234     if (!defined($info{name})) {
 235         die "Filename not specified in metadata block";
 236     }
 237
 238     my $type = $info{type};
 239
 240     my $filename = uri_decode($info{name});
 241     print "$filename\n" if $VERBOSE;
 242
 243     # Restore the specified file.  How to do so depends upon the file type, so
 244     # dispatch based on that.
 245     my $dest = "$DEST_DIR/$filename";
 246     if ($type eq '-' || $type eq 'f') {
 247         # Regular file
 248         unpack_file($filename, %info);
 249     } elsif ($type eq 'd') {
 250         # Directory
 251         if ($filename ne '.') {
 252             mkdir $dest or die "Cannot create directory $filename: $!";
 253         }
 254     } elsif ($type eq 'l') {
 255         # Symlink
 256         my $target = $info{target} || $info{contents};
 257         if (!defined($target)) {
 258             die "Symlink $filename has no value specified";
 259         }
 260         $target = uri_decode($target);
 261         symlink $target, $dest
 262             or die "Cannot create symlink $filename: $!";
 263
 264         # TODO: We can't properly restore all metadata for symbolic links
 265         # (attempts to do so below will change metadata for the pointed-to
 266         # file).  This should be later fixed, but for now we simply return
 267         # before getting to the restore metadata step below.
 268         return;
 269     } elsif ($type eq 'p' || $type eq 's' || $type eq 'c' || $type eq 'b') {
 270         # Pipe, socket, character device, block device.
 271         # TODO: Handle these cases.
 272         print STDERR "Ignoring special file $filename of type $type\n";
 273         return;
 274     } else {
 275         die "Unknown file type '$type' for file $filename";
 276     }
 277
 278     # Restore mode, ownership, and any other metadata for the file.  This is
 279     # split out from the code above since the code is the same regardless of
 280     # file type.
 281     my $mtime = $info{mtime} || time();
 282     utime time(), $mtime, $dest
 283         or warn "Unable to update mtime for $dest";
 284
 285     my $uid = -1;
 286     my $gid = -1;
 287     if (defined $info{user}) {
 288         my @items = split /\s/, $info{user};
 289         $uid = parse_int($items[0]) if exists $items[0];
 290     }
 291     if (defined $info{group}) {
 292         my @items = split /\s/, $info{group};
 293         $gid = parse_int($items[0]) if exists $items[0];
 294     }
 295     chown $uid, $gid, $dest
 296         or warn "Unable to change ownership for $dest";
 297
 298     if (defined $info{mode}) {
 299         my $mode = parse_int($info{mode});
 300         chmod $mode, $dest
 301             or warn "Unable to change permissions for $dest";
 302     }
 303 }
 304
 305 ########################### METADATA LIST PROCESSING ##########################
 306 # Process the file metadata listing provided, and as information for each file
 307 # is extracted, pass it to process_file.  This will recursively follow indirect
 308 # references to other metadata objects.
 309 sub process_metadata {
 310     my ($metadata, $recursion_level) = @_;
 311
 312     # Check recursion; this will prevent us from infinitely recursing on an
 313     # indirect reference which loops back to itself.
 314     $recursion_level ||= 0;
 315     if ($recursion_level >= $RECURSION_LIMIT) {
 316         die "Recursion limit reached";
 317     }
 318
 319     # Split the metadata into lines, then start processing each line.  There
 320     # are two primary cases:
 321     #   - Lines starting with "@" are indirect references to other metadata
 322     #     objects.  Recursively process that object before continuing.
 323     #   - Other lines should come in groups separated by a blank line; these
 324     #     contain metadata for a single file that should be passed to
 325     #     process_file.
 326     # Note that blocks of metadata about a file cannot span a boundary between
 327     # metadata objects.
 328     my %info = ();
 329     my $line;
 330     my $last_key;
 331     foreach $line (split /\n/, $metadata) {
 332         # If we find a blank line or a reference to another block, process any
 333         # data for the previous file first.
 334         if ($line eq '' || $line =~ m/^@/) {
 335             process_file(%info) if %info;
 336             %info = ();
 337             undef $last_key;
 338             next if $line eq '';
 339         }
 340
 341         # Recursively handle indirect metadata blocks.
 342         if ($line =~ m/^@(\S+)$/) {
 343             print "Indirect: $1\n" if $VERBOSE;
 344             my $indirect = load_ref($1);
 345             process_metadata($indirect, $recursion_level + 1);
 346             next;
 347         }
 348
 349         # Try to parse the data as "key: value" pairs of file metadata.  Also
 350         # handle continuation lines, which start with whitespace and continue
 351         # the previous "key: value" pair.
 352         if ($line =~ m/^(\w+):\s*(.*)$/) {
 353             $info{$1} = $2;
 354             $last_key = $1;
 355         } elsif ($line =~/^\s/ && defined $last_key) {
 356             $info{$last_key} .= $line;
 357         } else {
 358             print STDERR "Junk in file metadata section: $line\n";
 359         }
 360     }
 361
 362     # Process any last file metadata which has not already been processed.
 363     process_file(%info) if %info;
 364 }
 365
 366 ############################### MAIN ENTRY POINT ##############################
 367 # Program start.  We expect to be called with a single argument, which is the
 368 # name of the backup descriptor file written by a backup pass.  This will name
 369 # the root object in the snapshot, from which we can reach all other data we
 370 # need.
 371
 372 # Parse command-line arguments.  The first (required) is the name of the
 373 # snapshot descriptor file.  The backup objects are assumed to be stored in the
 374 # same directory as the descriptor.  The second (optional) argument is the
 375 # directory where the restored files should be written; it defaults to ".";
 376 my $descriptor = $ARGV[0];
 377 unless (defined($descriptor) && -r $descriptor) {
 378     print STDERR "Usage: $0 <snapshot file>\n";
 379     exit 1;
 380 }
 381
 382 if (defined($ARGV[1])) {
 383     $DEST_DIR = $ARGV[1];
 384 }
 385
 386 $OBJECT_DIR = dirname($descriptor);
 387 print "Source directory: $OBJECT_DIR\n" if $VERBOSE;
 388
 389 # Read the snapshot descriptor to find the root object.  Parse it to get a set
 390 # of key/value pairs.
 391 open DESCRIPTOR, "<", $descriptor
 392     or die "Cannot open backup descriptor file $descriptor: $!";
 393 my %descriptor = ();
 394 my ($line, $last_key);
 395 while (defined($line = <DESCRIPTOR>)) {
 396     # Any lines of the form "key: value" should be inserted into the
 397     # %descriptor dictionary.  Any continuation line (a line starting with
 398     # whitespace) will append text to the previous key's value.  Ignore other
 399     # lines.
 400     chomp $line;
 401
 402     if ($line =~ m/^(\w+):\s*(.*)$/) {
 403         $descriptor{$1} = $2;
 404         $last_key = $1;
 405     } elsif ($line =~/^\s/ && defined $last_key) {
 406         $descriptor{$last_key} .= $line;
 407     } else {
 408         undef $last_key;
 409         print STDERR "Ignoring line in backup descriptor: $line\n";
 410     }
 411 }
 412
 413 # A valid backup descriptor should at the very least specify the root metadata
 414 # object.
 415 if (!exists $descriptor{Root}) {
 416     die "Expected 'Root:' specification in backup descriptor file";
 417 }
 418 my $root = $descriptor{Root};
 419 close DESCRIPTOR;
 420
 421 # Set the umask to something restrictive.  As we unpack files, we'll originally
 422 # write the files/directories without setting the permissions, so be
 423 # conservative and ensure that they can't be read.  Afterwards, we'll properly
 424 # fix up permissions.
 425 umask 077;
 426
 427 # Start processing metadata stored in the root to recreate the files.
 428 print "Root object: $root\n" if $VERBOSE;
 429 my $contents = load_ref($root);
 430 process_metadata($contents);