btrbk/btrbk

#!/usr/bin/perl

=head1 NAME

btrbk - backup btrfs volumes at file-system level

=head1 SYNOPSIS

    btrbk --help

=head1 DESCRIPTION

Backup tool for btrfs (sub-)volumes, taking advantage of btrfs
specific send-receive mechanism, allowing incremental backups at
file-system level.

The full btrbk documentation is available at L<http://www.digint.ch/btrbk>.

=head1 AUTHOR

Axel Burri <axel@tty0.ch>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2014 Axel Burri. All rights reserved.

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/>.

=cut

use strict;
use warnings FATAL => qw( all );

use POSIX qw(strftime);
use File::Path qw(make_path);
use Getopt::Std;
use Data::Dumper;

our $VERSION = "0.01";
our $PROJECT_HOME = '<http://www.digint.ch/btrbk>';

my $version_info = "btrbk command line client, version $VERSION";
my $time_format = "%Y%m%d_%H%M%S";

my $default_config  = "/etc/btrbk.conf";
my $default_snapdir = "_btrbk_snap";

my %vol_info;
my %uuid_info;

my $dryrun;
my $loglevel = 1;


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

sub HELP_MESSAGE
{
  print STDERR "usage: $0 [options] <command>\n";
  print STDERR "\n";
  print STDERR "options:\n";
  print STDERR "   --help      display this help message\n";
  print STDERR "   --version   display version information\n";
  print STDERR "   -s DIR      make source snapshots in subfolder <DIR> (defaults to \"$default_snapdir\")\n";
  print STDERR "   -c          config file\n";
  print STDERR "   -v          be verbose (set loglevel=info)\n";
  print STDERR "   -l LEVEL    set loglevel (1=warn, 2=info, 3=debug, 4=trace)\n";
  print STDERR "\n";
  print STDERR "commands:\n";
  print STDERR "   info        shows information\n";
  print STDERR "   execute     perform all backups\n";
  print STDERR "   dryrun      don't run btrfs commands, just show what would be executed\n";
  print STDERR "\n";
  print STDERR "For additional information, see $PROJECT_HOME\n";
}

sub TRACE { my $t = shift; print STDOUT "... $t\n" if($loglevel >= 4);  }
sub DEBUG { my $t = shift; print STDOUT "$t\n" if($loglevel >= 3);  }
sub INFO  { my $t = shift; print STDOUT "$t\n" if($loglevel >= 2);  }
sub WARN  { my $t = shift; print STDOUT "WARNING: $t\n" if($loglevel >= 1);  }
sub ERROR { my $t = shift; print STDOUT "ERROR: $t\n";  }


sub run_cmd($;$)
{
  my $cmd = shift;
  my $non_destructive = shift;
  my $ret = "";
  DEBUG "### $cmd" unless($non_destructive);
  if($non_destructive || (not $dryrun)) {
    TRACE "### $cmd";
    $ret = `$cmd`;
    chomp($ret);
    TRACE "command output:\n$ret";
    die("command execution failed: \"$cmd\"") if($?);
  }
  return $ret;
}


sub check_vol($$)
{
  my $root = shift;
  my $vol = shift;
  die("subvolume info not present: $root") unless(exists($vol_info{$root}));
  foreach (values %{$vol_info{$root}}) {
    return 1 if($_->{FS_PATH} eq "$root/$vol");
  }
  return 0;
}


sub create_snapdir($$$)
{
  my $root = shift;
  my $vol = shift;
  my $snapdir = shift;
  if($snapdir && (not $dryrun))
  {
    my $dir = "$root/$snapdir";
    unless(-d $dir) {
      INFO "Creating snapshot directory: $dir\n";
      make_path($dir);
    }
  }
}


sub btr_subvolume_detail($)
{
  my $vol = shift;
  my $ret = run_cmd("/sbin/btrfs subvolume show $vol 2>/dev/null", 1);
  if($ret eq "$vol is btrfs root") {
    TRACE "btr_detail: found btrfs root: $vol";
    return { ID => 5, is_root => 1 };
  }
  elsif($ret =~ /^$vol/) {
    TRACE "btr_detail: found btrfs subvolume: $vol";
    my %trans = (
      name          => "Name",
      uuid          => "uuid",
      parent_uuid   => "Parent uuid",
      creation_time => "Creation time",
      ID            => "Object ID",
      gen           => "Generation \\(Gen\\)",
      cgen          => "Gen at creation",
      parent_id     => "Parent",
      top_level     => "Top Level",
      flags         => "Flags",
     );
    my %detail;
    foreach (keys %trans) {
      if($ret =~ /^\s+$trans{$_}:\s+(.*)$/m) {
        $detail{$_} = $1;
      } else {
        WARN "Failed to parse subvolume detail \"$trans{$_}\": $ret";
      }
    }
    TRACE "btr_detail for $vol: " . Dumper \%detail;
    return \%detail;
  }
  ERROR "Failed to fetch subvolume detail for: $vol";
  return undef;
}


sub parse_config($)
{
  my $file = shift;
  my @jobs;
  unless(-r "$file") {
    WARN "Configuration file not found: $file";
    return undef;
  }

  TRACE "parsing config file: $file";
  open(FILE, '<', $file) or die $!;
  while (<FILE>) {
    chomp;
    next if /^\s*#/; # ignore comments
    next if /^\s*$/; # ignore empty lines
    TRACE "parse_config: parsing line: $_";
    if(/^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/)
    {
      my %job = ( type  => "subvol_backup",
                  sroot => $1,
                  svol  => $2,
                  droot => $3,
                 );
      my @options = split(/,/, $4);

      $job{sroot} =~ s/\/+$//;   # remove trailing slash
      $job{sroot} =~ s/^\/+/\//; # sanitize leading slash
      $job{svol} =~ s/\/+$//;    # remove trailing slash
      $job{svol} =~ s/^\/+//;    # remove leading slash
      if($job{svol} =~ /\//) {
        ERROR "src_subvol contains slashes: $job{svol}";
        return undef;
      }

      $job{droot} =~ s/\/+$//;   # remove trailing slash
      $job{droot} =~ s/^\/+/\//; # sanitize leading slash

      $job{mountpoint} = $job{sroot}; # TODO: honor this, automount

      foreach(@options) {
        if   ($_ eq "incremental") { $job{options}->{incremental} = 1; }
        elsif($_ eq "init")        { $job{options}->{init} = 1;        }
        elsif($_ eq "create")      { $job{options}->{create} = 1;      }
        elsif($_ eq "log")         { $job{options}->{log} = 1;         }
        elsif($_ =~ /^log=(\S+)$/) { $job{options}->{log} = 1; $job{options}->{logfile} = $1; }
        else {
          ERROR "Ambiguous option=\"$_\": $file line $.";
          return undef; # be very strict here
        }
      }

      TRACE "parse_config: adding job \"$job{type}\": $job{sroot}/$job{svol} -> $job{droot}/";
      push @jobs, \%job;
    }
    else
    {
      ERROR "Ambiguous configuration: $file line $.";
      return undef; # be very strict here
    }
  }
  close FILE;
  TRACE "jobs: " . Dumper(\@jobs);
  return \@jobs;
}


sub btr_subvolume_list($;@)
{
  my $vol = shift;
  my %opts = @_;
  my $filter_option = "-a";
  $filter_option = "-o" if($opts{subvol_only});
  my $ret = run_cmd("/sbin/btrfs subvolume list $filter_option -c -u -q -R $vol", 1);
  my @nodes;
  foreach (split(/\n/, $ret))
  {
    # ID <ID> top level <ID> path <path> where path is the relative path
    # of the subvolume to the top level subvolume. The subvolume?s ID may
    # be used by the subvolume set-default command, or at mount time via
    # the subvolid= option. If -p is given, then parent <ID> is added to
    # the output between ID and top level. The parent?s ID may be used at
    # mount time via the subvolrootid= option.
    die("Failed to parse line: \"$_\"") unless(/^ID ([0-9]+) gen ([0-9]+) cgen ([0-9]+) top level ([0-9]+) parent_uuid ([0-9a-z-]+) received_uuid ([0-9a-z-]+) uuid ([0-9a-z-]+) path (.+)$/);
    push @nodes, { id            => $1,
                   gen           => $2,
                   cgen          => $3,
                   top_level     => $4,
                   parent_uuid   => $5, # note: parent_uuid="-" if no parent
                   received_uuid => $6,
                   uuid          => $7,
                   path          => $8
                  };
    # $node{parent_uuid} = undef if($node{parent_uuid} eq '-');
  }
  return @nodes;
}


sub btr_tree($)
{
  my $vol = shift;
  my $detail = btr_subvolume_detail($vol);
  unless($detail && $detail->{is_root}) {
    ERROR "\"$vol\" is not btrfs root!";
    return undef;
  }
  my %tree;
  my %id;
  foreach my $node (btr_subvolume_list($vol, subvol_only => 0))
  {
    TRACE "btr_tree: processing subvolid=$node->{id}";

    # set FS_PATH
    #
    # NOTE: these substitutions are only valid if $root is a
    # absolute path to a btrfs root volume (mounted with
    # subvolumeid=0)
    TRACE "btr_tree: original path: $node->{path}";
    $node->{FS_PATH} =  $node->{path};
    if($node->{FS_PATH} =~ s/^<FS_TREE>\///) {
      TRACE "btr_tree: removed <FS_TREE> portion subvolume path: $node->{FS_PATH}";
    }

    $node->{SUBVOL_PATH} = $node->{FS_PATH};
    TRACE "btr_tree: set SUBVOL_PATH: $node->{FS_PATH}";

    $node->{FS_PATH} =  $vol . "/" . $node->{FS_PATH};
    TRACE "btr_tree: set FS_PATH: $node->{FS_PATH}";

    $id{$node->{id}} = $node;
    $tree{$node->{SUBVOL_PATH}} = $node;
    $uuid_info{$node->{uuid}} = $node;

    if($node->{top_level} != 5)
    {
      # man btrfs-subvolume:
      #   Also every btrfs filesystem has a default subvolume as its initially
      #   top-level subvolume, whose subvolume id is 5(FS_TREE).

      # set child/parent node
      die unless exists($id{$node->{top_level}});
      die if exists($id{$node->{top_level}}->{SUBVOLUME}->{$node->{SUBVOL_PATH}});
      $id{$node->{top_level}}->{SUBVOLUME}->{$node->{SUBVOL_PATH}} = $node;
      $node->{TOP_LEVEL_NODE} = $id{$node->{top_level}};
    }
  }
  return \%tree;
}


sub btr_subtree($)
{
  my $vol = shift;
  my $detail = btr_subvolume_detail($vol);
  my $volname = $detail->{name} || "";
  my %tree;
  foreach my $node (btr_subvolume_list($vol, subvol_only => 1))
  {
    TRACE "btr_subtree: processing subvolid=$node->{id}";

    # set FS_PATH
    TRACE "btr_subtree: original path: $node->{path}";
    my $path =  $node->{path};
    if($volname) {
      # strip leading volume name
      unless($path =~ s/^$volname\///) {
        # if $vol is a sub-subvolume, strip whole prefix
        unless($path =~ s/.+\/$volname\///) {
          die("ambiguous btrfs subvolume info line");
        }
      }
      TRACE "btr_subtree: removed \"$&\" prefix of subvolume path: $path";
    }
    $node->{SUBVOL_PATH} = $path;
    TRACE "btr_subtree: set SUBVOL_PATH: $node->{SUBVOL_PATH}";

    $node->{FS_PATH} =  $vol . "/" . $path;
    TRACE "btr_subtree: set FS_PATH: $node->{FS_PATH}";

    $tree{$node->{SUBVOL_PATH}} = $node;
    $uuid_info{$node->{uuid}} = $node;
  }
  return \%tree;
}


sub btrfs_snapshot($$)
{
  my $src = shift;
  my $dst = shift;
  DEBUG "[btrfs] snapshot (ro):";
  DEBUG "[btrfs]   source: $src";
  DEBUG "[btrfs]   dest  : $dst";
  INFO ">>> $dst";
  run_cmd("/sbin/btrfs subvolume snapshot -r $src $dst");
}


sub btrfs_send_receive($$;$$)
{
  my $src = shift;
  my $dst = shift;
  my $parent = shift // "";
  my $changelog = shift // "";
  my $now = localtime;

  my $src_name = $src;
  $src_name =~ s/^.*\///;
  INFO ">>> $dst/$src_name";

  my @info;
  push @info, "[btrfs] send/receive" . ($parent ? " (incremental)" : " (complete)") . ":";
  push @info, "[btrfs]   source: $src";
  push @info, "[btrfs]   parent: $parent" if($parent);
  push @info, "[btrfs]   dest  : $dst";
  push @info, "[btrfs]   log   : $changelog" if($changelog);
  DEBUG $_ foreach(@info);

  my $parent_option = $parent ? "-p $parent" : "";
  my $receive_option = "";
  $receive_option = "-v" if($changelog || ($loglevel >= 2));
  $receive_option = "-v -v" if($parent && $changelog);
  my $cmd = "/sbin/btrfs send $parent_option $src | /sbin/btrfs receive $receive_option $dst/ 2>&1";
  my $ret = run_cmd($cmd);
  # run_cmd("/bin/sync");
  if($changelog && (not $dryrun))
  {
    INFO "Writing btrfs-diff changelog: $changelog";
    if(open(LOGFILE, '>>', $changelog)) {
      print LOGFILE "<<< START btrfs_send_receive: $now >>>\n";
      print LOGFILE "$_\n" foreach(@info);
      print LOGFILE "[btrfs]   cmd   : $cmd\n";
      print LOGFILE "[btrfs]   cmd output:\n" . $ret;
      print LOGFILE "\n<<< END btrfs_send_receive: $now >>>\n";
      close(LOGFILE);
    }
    else {
      WARN "Failed to open changelog file: $!";
    }
  }
}


sub get_children($$)
{
  my $sroot = shift;
  my $svol = shift;
  die("root subvolume info not present: $sroot") unless(exists($vol_info{$sroot}));
  die("subvolume info not present: $sroot/$svol") unless(exists($vol_info{$sroot}->{$svol}));
  my $uuid = $vol_info{$sroot}->{$svol}->{uuid};
  DEBUG "Getting snapshot children of: $sroot/$svol";
  my @ret;
  foreach (values %{$vol_info{$sroot}}) {
    next unless($_->{parent_uuid} eq $uuid);
    DEBUG "Found snapshot child: $_->{SUBVOL_PATH}";
    push(@ret, $_);
  }
  #  DEBUG "Found " . scalar(@ret) . " snapshot children of: $sroot/$svol";
  return @ret;
}


sub get_receive_targets_by_uuid($$)
{
  my $droot = shift;
  my $uuid = shift;
  die("root subvolume info not present: $droot") unless(exists($vol_info{$droot}));
  die("subvolume info not present: $uuid") unless(exists($uuid_info{$uuid}));
  DEBUG "Getting receive targets in \"$droot/\" for: $uuid_info{$uuid}->{FS_PATH}";
  my @ret;
#  foreach (values %{$vol_info{$droot}->{SUBVOLUME}}) {  # this is for btr_tree, not btr_subtree!
  foreach (values %{$vol_info{$droot}}) {
    next unless($_->{received_uuid} eq $uuid);
    DEBUG "Found receive target: $_->{SUBVOL_PATH}";
    push(@ret, $_);
  }
  #  DEBUG "Found " . scalar(@ret) . " receive targets of: $uuid_info{$uuid}->{FS_PATH}";
  return @ret;
}


sub get_latest_common($$$)
{
  my $sroot = shift;
  my $svol = shift;
  my $droot = shift;

  die("source subvolume info not present: $sroot") unless(exists($vol_info{$sroot}));
  die("target subvolume info not present: $droot") unless(exists($vol_info{$droot}));

  # sort children of svol descending by generation
  foreach my $child (sort { $b->{gen} <=> $a->{gen} } get_children($sroot, $svol)) {
    TRACE "get_latest_common: checking source snapshot: $child->{SUBVOL_PATH}";
    foreach (get_receive_targets_by_uuid($droot, $child->{uuid})) {
      TRACE "get_latest_common: found receive target: $_->{FS_PATH}";
      DEBUG("Latest common snapshots for: $sroot/$svol: src=$child->{FS_PATH}  dst=$_->{FS_PATH}");
      return ($child, $_);
    }
    TRACE "get_latest_common: no matching targets found for: $child->{FS_PATH}";
  }
  DEBUG("No common snapshots for \"$sroot/$svol\" found in src=$sroot/  dst=$droot/");
  return (undef, undef);
}


MAIN:
{
  $ENV{PATH} = '';
  $Getopt::Std::STANDARD_HELP_VERSION = 1;
  $Data::Dumper::Sortkeys = 1;

  my %opts;
  getopts('s:c:vl:p', \%opts);
  my $command = shift @ARGV;

  # assign command line options
  $loglevel = $opts{l} || 0;
  if   (lc($loglevel) eq "warn")  { $loglevel = 1; }
  elsif(lc($loglevel) eq "info")  { $loglevel = 2; }
  elsif(lc($loglevel) eq "debug") { $loglevel = 3; }
  elsif(lc($loglevel) eq "trace") { $loglevel = 4; }
  elsif($loglevel =~ /^[0-9]+$/) { ; }
  else {
    $loglevel = $opts{v} ? 2 : 0;
  }
  my $config = $opts{c} || $default_config;
  my $snapdir = $opts{s} || $default_snapdir;
  $snapdir =~ s/\/+$//;   # remove trailing slash
  $snapdir =~ s/^\/+//;   # remove leading slash
  $snapdir .= '/';        # add trailing slash

  # check command line options
  if($opts{h} || (not $command)) {
    VERSION_MESSAGE();
    HELP_MESSAGE(0);
    exit 0;
  }

  my $action_execute;
  my $action_info;
  if(($command eq "execute") || ($command eq "dryrun")) {
    $action_execute = 1;
    $dryrun = 1 if($command eq "dryrun");
  }
  elsif($command eq "info") {
    $action_info = 1;
  }
  else {
    ERROR "Unrecognized command: $command";
    HELP_MESSAGE(0);
    exit 1;
  }

  #
  # check jobs, fill vol_info hash
  #
  my $jobs = parse_config($config);
  unless($jobs) {
    ERROR "Failed to parse configuration file";
    exit 1;
  }
  foreach my $job (@$jobs)
  {
    my $sroot = $job->{sroot} || die;
    my $droot = $job->{droot} || die;
    $vol_info{$sroot} //= btr_subtree($sroot);
    $vol_info{$droot} //= btr_subtree($droot);
    unless($vol_info{$sroot} && $vol_info{$droot}) {
      ERROR "Failed to read btrfs subvolume information, aborting job";
      $job->{ABORTED} = 1;
      next;
    }
    get_children($sroot, $job->{svol});
  }
  TRACE(Data::Dumper->Dump([\%vol_info], ["vol_info"]));

  if($action_info)
  {
    #
    # print snapshot tree
    #
    my %info;
    foreach my $job (@$jobs)
    {
      $info{$job->{sroot}}->{$job->{svol}} = $job;
    }
    foreach my $root (sort keys %info)
    {
      print "$root\n";
      foreach my $job (sort { $a->{svol} cmp $b->{svol} } (values %{$info{$root}}))
      {
        my $sroot = $job->{sroot} || die;
        my $svol  = $job->{svol}  || die;
        next unless $vol_info{$job->{sroot}};
        print "|-- $svol\n";
        my $sroot_uuid;
        foreach (values $vol_info{$sroot}) {
          if($_->{FS_PATH} eq "$sroot/$svol") {
            die if $sroot_uuid;
            $sroot_uuid = $_->{uuid};
          }
        }
        die unless $sroot_uuid;
        foreach (sort { $a->{SUBVOL_PATH} cmp $b->{SUBVOL_PATH} } (values $vol_info{$sroot})) {
          next unless($_->{parent_uuid} eq $sroot_uuid);
          # next unless($_->{SUBVOL_PATH} =~ /^$snapdir/);  # don't print non-btrbk snapshots
          print "|   ^-- $_->{SUBVOL_PATH}\n";
          my $snapshot = $_->{FS_PATH};
          $snapshot =~ s/^.*\///;
          foreach (sort { $a->{droot} cmp $b->{droot} } @$jobs) {
            next unless $vol_info{$_->{droot}};
            next unless(($_->{sroot} eq $sroot) && ($_->{svol} eq $svol));
            my $match = "$_->{droot}/$snapshot";
            foreach (sort { $a->{FS_PATH} cmp $b->{FS_PATH} } (values $vol_info{$_->{droot}})) {
              print "|   |   # $_->{FS_PATH}\n" if($_->{FS_PATH} eq $match);
            }
          }
        }
      }
      print "\n";
    }
  }

  if($action_execute)
  {
    my $postfix = '.' . strftime($time_format, localtime);
    #
    # create snapshots
    #
    my %snapshots;
    foreach my $job (@$jobs)
    {
      my $sroot    = $job->{sroot}      || die;
      my $svol     = $job->{svol}       || die;
      my $droot    = $job->{droot}      || die;
      my $type     = $job->{type}       || die;
      my $ssnap = "$snapdir$svol$postfix";  # NOTE: $snapdir always has trailing slash!

      # perform checks
      if(check_vol($sroot, $ssnap)) {
        # TODO: consider using numbered snapshot name instead of timestamp
        ERROR "Snapshot already exists, aborting job: $sroot/$ssnap";
        $job->{ABORTED} = 1;
        next;
      }
      if(check_vol($droot, "$svol$postfix")) {
        WARN "Snapshot already exists at destination, aborting job: $droot/$svol$postfix";
        $job->{ABORTED} = 1;
        next;
      }
      unless(check_vol($sroot, $svol)) {
        WARN "Source subvolume not found, aborting job: $sroot/$svol";
        $job->{ABORTED} = 1;
        next;
      }
      create_snapdir($sroot, $svol, $snapdir);

      # make snapshot of svol, if not already created by another job
      unless($snapshots{"$sroot/$svol"})
      {
        DEBUG "***";
        DEBUG "*** snapshot";
        DEBUG "***   source: $sroot/$svol";
        DEBUG "***   dest  : $sroot/$ssnap";
        DEBUG "***";
        INFO "Creating subvolume snapshot for: $sroot/$svol";

        btrfs_snapshot("$sroot/$svol", "$sroot/$ssnap");
        $snapshots{"$sroot/$svol"} = "$sroot/$ssnap";
      }
      $job->{snapshot} = $snapshots{"$sroot/$svol"};
    }

    #
    # create backups
    #
    foreach my $job (@$jobs)
    {
      next if($job->{ABORTED});

      my $sroot    = $job->{sroot}      || die;
      my $svol     = $job->{svol}       || die;
      my $droot    = $job->{droot}      || die;
      my $type     = $job->{type}       || die;
      my $snapshot = $job->{snapshot}   || die;
      my $job_opts = $job->{options}    || die;

      DEBUG "***";
      DEBUG "*** $type\[" . join(',', map { "$_=$job_opts->{$_}" } keys(%$job_opts)) . "]";
      DEBUG "***   source: $sroot/$svol";
      DEBUG "***   dest  : $droot/";
      DEBUG "***";
      INFO "Creating subvolume backup for: $sroot/$svol";

      my $changelog = "";
      if($job_opts->{log})
      {
        # log defaults to sidecar of destination snapshot
        $changelog = $job_opts->{logfile} || "$droot/$svol$postfix.btrbk.log";
      }
      if($job_opts->{incremental})
      {
        INFO "Using previously created snapshot: $snapshot";
        # INFO "Attempting incremantal backup (option=incremental)";
        my ($latest_common_src, $latest_common_dst) = get_latest_common($sroot, $svol, $droot);
        if($latest_common_src && $latest_common_dst)
        {
          my $parent_snap = $latest_common_src->{FS_PATH};
          INFO "Using parent snapshot: $parent_snap";
          btrfs_send_receive($snapshot, $droot, $parent_snap, $changelog);
        }
        elsif($job_opts->{init}) {
#          if(check_vol($droot, $dvol)) {  # TODO: perform checks
            INFO "No common parent snapshots found, creating initial backup (option=init)";
            btrfs_send_receive($snapshot, $droot, undef, $changelog);
#          }
        }
        else {
          WARN "Backup to $droot failed: no common parent subvolume found, and job option \"create\" is not set";
        }
      }
      elsif($job_opts->{create})
      {
        INFO "Creating new snapshot copy (option=create))";
        btrfs_send_receive($snapshot, $droot, undef, $changelog);
      }
    }
  }
}
1;