contrib/clean-segments.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Garbage collect segments in LBS snapshot directories.
   4 #
   5 # Find all segments which are not referenced by any current snapshots and print
   6 # out a listing of them so that they can be deleted.
   7 #
   8 # Takes no command-line arguments, and expects to be invoked from the directory
   9 # containing the snapshots.
  10 #
  11 # Copyright (C) 2007  Michael Vrable
  12
  13 use strict;
  14
  15 my $SEGMENT_PATTERN
  16     = '[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}';
  17
  18 # Set of all segments which are used by current snapshots.  Value is ignored.
  19 my %segments_used = ();
  20
  21 # Iterate through all snapshots.  Snapshot descriptors should end with a ".lbs"
  22 # extension.  Find all segments which are used.
  23 foreach (glob "*.lbs") {
  24     open DESCRIPTOR, "<", $_
  25         or die "Cannot open backup descriptor file $_: $!";
  26
  27     # Parse the backup descriptor file.  We might not need the full parser, but
  28     # it shouldn't hurt.
  29     my %descriptor = ();
  30     my ($line, $last_key);
  31     while (defined($line = <DESCRIPTOR>)) {
  32         chomp $line;
  33
  34         if ($line =~ m/^([-\w]+):\s*(.*)$/) {
  35             $descriptor{$1} = $2;
  36             $last_key = $1;
  37         } elsif ($line =~/^\s/ && defined $last_key) {
  38             $descriptor{$last_key} .= $line;
  39         } else {
  40             undef $last_key;
  41             print STDERR "Ignoring line in backup descriptor: $line\n";
  42         }
  43     }
  44
  45     # Extract the list of segments from the parsed descriptor file.
  46     foreach (split /\s+/, $descriptor{Segments}) {
  47         next unless $_;
  48         if (m/^$SEGMENT_PATTERN$/) {
  49             $segments_used{$_} = 1;
  50         } else {
  51             warn "Invalid segment name: '$_'\n";
  52         }
  53     }
  54
  55     close DESCRIPTOR;
  56 }
  57
  58 # Look for all segments in this directory, and match them against the list
  59 # generated above of segments which are used.  Pring out any segments which are
  60 # not used.
  61 my %segments_found = ();
  62
  63 foreach (glob "*") {
  64     if (m/^($SEGMENT_PATTERN)(\.\S+)?$/) {
  65         $segments_found{$1} = 1;
  66         if (!exists $segments_used{$1}) {
  67             print $_, "\n";
  68         }
  69     }
  70 }
  71
  72 # Perform a consistency check: were any segments referenced by snapshot but not
  73 # found in the directory?
  74 foreach (sort keys %segments_used) {
  75     if (!exists $segments_found{$_}) {
  76         print STDERR "Warning: Segment $_ not found\n";
  77     }
  78 }
  79