backup-tar: Make restore script work with multiple backups per machine

backup-tar/restore.pl

@@ -31,14 +31,19 @@ my $date;
 if ( (shift @ARGV) =~ /([0-9]+-[0-9]+-[0-9]+)/ ) {
     $date = $1;
 } else {
-    print STDERR "Date must be in YEAR-MOONTH-DAY format\n";
+    print STDERR "Date must be in YEAR-MONTH-DAY format\n";
     usage;
     exit 2;
 }
 my @paths = ();
 for my $p ( @ARGV ) {
+	if ( $p =~ m,/[.]{2}(/|$), ) {
+		print STDERR "Paths must not contain backward (/../) elements";
+		usage;
+		exit 2;
+	}
 	# strip the leading / to match paths in the tar
-    if ( $p =~ m|^/(.*)$| ) {
+    if ( $p =~ m,^/(.*)$, ) {
         push( @paths, $1 );
     } else {
         print STDERR "Expected absolute path but got $p\n";
@@ -49,38 +54,74 @@ for my $p ( @ARGV ) {
 
 print "$machine $date @paths\n";
 
-my $full;
-my @weekly = ();
-my @daily = ();
-
 my $namematch = qr/^([0-9]+-[0-9]+-[0-9]+)[.](daily|weekly|full)[.](.*)$/;
 
-opendir( my $dir, catdir("/backup-tar", $machine ) ) or die $!;
-my @backups = sort( grep { /$namematch/ } readdir( $dir ) );
-for my $backup ( @backups ) {
-    $backup =~ /$namematch/;
-    $backup = "$1.$2.$3";
-    my $path = catfile( "/backup-tar", $machine, $backup );
-    my $from = $1;
-    my $type = $2;
-    last if $from gt $date;
-
-    if ( $type eq "full" ) {
-        $full = $path;
-        @weekly = ();
-    } elsif ( $type eq "weekly" ) {
-        push( @weekly, $path );
-        @daily = ();
-    } else {
-        push( @daily, $path );
-    }
+sub getDirContents {
+	my ( $dirname ) = @_;
+	opendir( my $dir, $dirname ) or die $!;
+	my @contents = readdir( $dir );
+	my @backups = sort( grep { /$namematch/ } @contents );
+	my @subdirs = sort( grep { !/^(stamps|[.]{1,2})$/ && !/$namematch/ } @contents );
+	return ( [ @backups ], [ @subdirs ] );
 }
 
-my @to_restore = ( $full, @weekly, @daily );
+sub restore {
+	my ( $restore_path, @backups ) = @_;
+	say "restore( $restore_path, " . join( ", ", @backups ) . " );";
+
+	my $full;
+	my @weekly = ();
+	my @daily = ();
+
+	for my $backup_path ( @backups ) {
+		my $backup = basename( $backup_path );
+		$backup =~ /$namematch/;
+		my $from = $1;
+		my $type = $2;
+		last if $from gt $date;
+
+		if ( $type eq "full" ) {
+			$full = $backup_path;
+			@weekly = ();
+		} elsif ( $type eq "weekly" ) {
+			push( @weekly, $backup_path );
+			@daily = ();
+		} else {
+			push( @daily, $backup_path );
+		}
+	}
+
+	my @to_restore = ( $full, @weekly, @daily );
+
+	for my $backup ( @to_restore ) {
+		print "$backup…\n";
+		my @args = ( "tar", "--extract", "--auto-compress", "--incremental", "--xattrs",
+					 "--acls", "-vv", "-f$backup", "--", $restore_path );
+		system( @args ) == 0 or die "extract of $backup failed with $?, @args\n";
+	}
+}
+
+sub find_and_restore {
+	my ( $anchor, $path, $fullpath ) = @_;
+	$fullpath = $path unless defined $fullpath;
+
+	say "find_and_restore( $anchor, $path, $fullpath );";
+
+	my ( $backups, $subdirs ) = getDirContents( $anchor );
+	if ( @{$backups} ) {
+		return restore( $fullpath, map { catdir( $anchor, $_ ) } @{$backups} );
+	}
+	$path =~ m,([^/]*)(?:/|$)(.*), or die "Could not parse path $path";
+	my $first_segment = $1;
+	my $path_rest = $2;
+	my @next = grep { $_ eq $first_segment } @{$subdirs};
+	if ( @next ) {
+		return find_and_restore( catdir( $anchor, $first_segment ), $path_rest, $fullpath );
+	}
+	say STDERR "No match for $first_segment in $anchor";
+	exit 3;
+}
 
-for my $backup ( @to_restore ) {
-    print "$backup…\n";
-    my @args = ( "tar", "--extract", "--auto-compress", "--incremental", "--xattrs",
-				 "--acls", "-vv", "-f$backup", "--", @paths );
-	system( @args ) == 0 or die "extract of $backup failed with $?, @args\n";
+for my $p ( @paths ) {
+	find_and_restore( catdir( "/backup-tar", $machine ), $p );
 }