btrbk/contrib/migration/raw_suffix2sidecar

#!/usr/bin/perl
#
# raw_suffix2sidecar - migrate to btrbk raw target sidecar files
#
# Copyright (C) 2017 Axel Burri
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# ---------------------------------------------------------------------
# The official btrbk website is located at:
# https://digint.ch/btrbk/
#
# Author:
# Axel Burri <axel@tty0.ch>
# ---------------------------------------------------------------------

# Create raw sidecar ".info" files from uuid-suffixed raw backup files
# generated by btrbk < v0.26.0.

use strict;
use warnings FATAL => qw( all );
use Getopt::Long qw(GetOptions);

our $VERSION      = '0.26.0-dev'; # match btrbk version
our $AUTHOR       = 'Axel Burri <axel@tty0.ch>';
our $PROJECT_HOME = '<https://digint.ch/btrbk/>';

my  $VERSION_INFO = "raw_suffix2sidecar (btrbk migration script), version $VERSION";

my $compress_format_alt = 'gz|bz2|xz|lzo|lz4';
my $file_match = qr/[0-9a-zA-Z_@\+\-\.\/]+/;  # note: ubuntu uses '@' in the subvolume layout: <https://help.ubuntu.com/community/btrfs>
my $uuid_match = qr/[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}/;
my $timestamp_postfix_match = qr/\.(?<YYYY>[0-9]{4})(?<MM>[0-9]{2})(?<DD>[0-9]{2})(T(?<hh>[0-9]{2})(?<mm>[0-9]{2})((?<ss>[0-9]{2})(?<zz>(Z|[+-][0-9]{4})))?)?(_(?<NN>[0-9]+))?/;  # matches "YYYYMMDD[Thhmm[ss+0000]][_NN]"
my $raw_postfix_match = qr/--(?<received_uuid>$uuid_match)(\@(?<parent_uuid>$uuid_match))?\.btrfs?(\.(?<compress>($compress_format_alt)))?(\.(?<encrypt>gpg))?(\.(?<split>split_aa))?(\.(?<incomplete>part))?/;  # matches ".btrfs_<received_uuid>[@<parent_uuid>][.gz|bz2|xz][.gpg][.split_aa][.part]"

my $dryrun;

my %raw_info_sort = (
  TYPE                 => 1,
  FILE                 => 2,
  RECEIVED_UUID        => 3,
  RECEIVED_PARENT_UUID => 4,
  INCOMPLETE           => 5,
  compress             => 9,
  split                => 10,
  encrypt              => 11,
 );

sub VERSION_MESSAGE
{
  print STDERR $VERSION_INFO . "\n\n";
}

sub HELP_MESSAGE
{
  print STDERR "usage: raw_suffix2sidecar <dir>...\n";
  print STDERR "\n";
  print STDERR "options:\n";
  #            "--------------------------------------------------------------------------------"; # 80
  print STDERR "   -h, --help                display this help message\n";
  print STDERR "       --version             display version information\n";
  print STDERR "   -n, --dry-run             perform a trial run with no changes made\n";
  print STDERR "\n";
  print STDERR "For additional information, see $PROJECT_HOME\n";
}

sub write_raw_info($$)
{
  my $file = shift // die;
  my $raw_info = shift // die;

  my $info_file = $file . '.info';
  my @line;
  push @line, "#raw_suffix2sidecar-v$VERSION";
  push @line, "# Do not edit this file";

  # sort by %raw_info_sort, then by key
  foreach(sort { (($raw_info_sort{$a} || 99) <=> ($raw_info_sort{$b} || 99)) || ($a cmp $b) } keys %$raw_info) {
    push @line, ($_ . '=' . $raw_info->{$_}) if($raw_info->{$_});
  }

  print "Creating info file: $info_file\n";

  unless($dryrun) {
    open (INFOFILE, ">> $info_file") || die "Failed to open $info_file";
    print INFOFILE join("\n", @line) . "\n";
    close(INFOFILE);
  }

  return $info_file;
}


MAIN:
{
  Getopt::Long::Configure qw(gnu_getopt);
  unless(GetOptions(
    'help|h'             => sub { VERSION_MESSAGE(); HELP_MESSAGE(0); exit 0; },
    'version'            => sub { VERSION_MESSAGE(); exit 0; },
    'dry-run|n'          => \$dryrun,
   ))
  {
    VERSION_MESSAGE();
    HELP_MESSAGE(0);
    exit 2;
  }
  unless(@ARGV) {
    VERSION_MESSAGE();
    HELP_MESSAGE();
    exit 1;
  }

  foreach my $target_dir (@ARGV) {
    $target_dir =~ s/\/+$//;
    print "Processing directory: $target_dir/\n";
    opendir(my($dh), $target_dir) || die "Failed to open directory '$target_dir': $!";
    my @files = readdir($dh);
    closedir $dh;

    my @splitfiles = @files;
    foreach my $file (@files) {
      if($file =~ /^(?<basename>$file_match$timestamp_postfix_match)$raw_postfix_match$/) {
        print "\nProcessing raw backup: $file\n";

        my $newname = $+{basename} || die;
        my %raw_info = (
          TYPE => 'raw',
          RECEIVED_UUID => $+{received_uuid},
          RECEIVED_PARENT_UUID => $+{parent_uuid},
          INCOMPLETE    => $+{incomplete} ? 1 : 0,
          compress      => $+{compress},
          split         => ($+{split} ? (-s $file) : undef), # file size
          encrypt       => $+{encrypt},
         );
        die "Missing received uuid in file: $file" unless $raw_info{RECEIVED_UUID};
        $newname .= '.btrfs';
        $newname .= '.' . $raw_info{compress} if($raw_info{compress});
        $newname .= '.' . $raw_info{encrypt} if($raw_info{encrypt});
        $raw_info{FILE} = $newname;
        write_raw_info("$target_dir/$newname", \%raw_info);

        if($raw_info{split}) {
          my $sfile = $file;
          $sfile =~ s/_aa$//; # we match on ".split_aa" above
          foreach my $splitfile (@splitfiles) {
            if($splitfile =~ /^${sfile}(_[a-z]+)$/) {
              my $suffix = $1 // die;
              print "Renaming file: $target_dir/$splitfile -> $target_dir/$newname.split$suffix\n";
              unless($dryrun) {
                rename("$target_dir/$splitfile", "$target_dir/$newname.split$suffix") || die "Failed to rename file: $target_dir/$splitfile -> $target_dir/${newname}.split$suffix: $!";
              }
            }
          }
        }
        else {
          print "Renaming file: $target_dir/$file -> $target_dir/$newname\n";
          unless($dryrun) {
            rename("$target_dir/$file", "$target_dir/$newname") || die "Failed to rename file: $target_dir/$file -> $target_dir/$newname";
          }
        }
      }
    }
  }

  if($dryrun) {
    print "\nNOTE: Dryrun was active, none of the operations above were actually executed!\n";
  }
}

1;