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