3 # Garbage collect segments in LBS snapshot directories.
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.
8 # Takes no command-line arguments, and expects to be invoked from the directory
9 # containing the snapshots.
11 # Copyright (C) 2007 Michael Vrable
16 = '[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}';
18 # Set of all segments which are used by current snapshots. Value is ignored.
19 my %segments_used = ();
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 $_: $!";
27 # Parse the backup descriptor file. We might not need the full parser, but
30 my ($line, $last_key);
31 while (defined($line = <DESCRIPTOR>)) {
34 if ($line =~ m/^([-\w]+):\s*(.*)$/) {
37 } elsif ($line =~/^\s/ && defined $last_key) {
38 $descriptor{$last_key} .= $line;
41 print STDERR "Ignoring line in backup descriptor: $line\n";
45 # Extract the list of segments from the parsed descriptor file.
46 foreach (split /\s+/, $descriptor{Segments}) {
48 if (m/^$SEGMENT_PATTERN$/) {
49 $segments_used{$_} = 1;
51 warn "Invalid segment name: '$_'\n";
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
61 my %segments_found = ();
64 if (m/^($SEGMENT_PATTERN)(\.\S+)?$/) {
65 $segments_found{$1} = 1;
66 if (!exists $segments_used{$1}) {
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";