PVE/Storage/BTRFSPlugin.pm

   1 package PVE::Storage::BTRFSPlugin;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw(PVE::Storage::Plugin);
   7
   8 use Fcntl qw(S_ISDIR O_WRONLY O_CREAT O_EXCL);
   9 use File::Basename qw(basename dirname);
  10 use File::Path qw(mkpath);
  11 use IO::Dir;
  12 use POSIX qw(EEXIST);
  13
  14 use PVE::Tools qw(run_command dir_glob_foreach);
  15
  16 use PVE::Storage::DirPlugin;
  17
  18 use constant {
  19     BTRFS_FIRST_FREE_OBJECTID => 256,
  20     FS_NOCOW_FL => 0x00800000,
  21     FS_IOC_GETFLAGS => 0x40086602,
  22     FS_IOC_SETFLAGS => 0x80086601,
  23     BTRFS_MAGIC => 0x9123683e,
  24 };
  25
  26 # Configuration (similar to DirPlugin)
  27
  28 sub type {
  29     return 'btrfs';
  30 }
  31
  32 sub plugindata {
  33     return {
  34         content => [
  35             {
  36                 images => 1,
  37                 rootdir => 1,
  38                 vztmpl => 1,
  39                 iso => 1,
  40                 backup => 1,
  41                 snippets => 1,
  42                 none => 1,
  43             },
  44             { images => 1, rootdir => 1 },
  45         ],
  46         format => [ { raw => 1, subvol => 1 }, 'raw', ],
  47     };
  48 }
  49
  50 sub properties {
  51     return {
  52         nocow => {
  53             description => "Set the NOCOW flag on files."
  54                 . " Disables data checksumming and causes data errors to be unrecoverable from"
  55                 . " while allowing direct I/O. Only use this if data does not need to be any more"
  56                 . " safe than on a single ext4 formatted disk with no underlying raid system.",
  57             type => 'boolean',
  58             default => 0,
  59         },
  60     };
  61 }
  62
  63 sub options {
  64     return {
  65         path => { fixed => 1 },
  66         nodes => { optional => 1 },
  67         shared => { optional => 1 },
  68         disable => { optional => 1 },
  69         maxfiles => { optional => 1 },
  70         'prune-backups' => { optional => 1 },
  71         'max-protected-backups' => { optional => 1 },
  72         content => { optional => 1 },
  73         format => { optional => 1 },
  74         is_mountpoint => { optional => 1 },
  75         nocow => { optional => 1 },
  76         mkdir => { optional => 1 },
  77         preallocation => { optional => 1 },
  78         # TODO: The new variant of mkdir with  `populate` vs `create`...
  79     };
  80 }
  81
  82 # Storage implementation
  83 #
  84 # We use the same volume names are directory plugins, but map *raw* disk image file names into a
  85 # subdirectory.
  86 #
  87 # `vm-VMID-disk-ID.raw`
  88 #   -> `images/VMID/vm-VMID-disk-ID/disk.raw`
  89 #   where the `vm-VMID-disk-ID/` subdirectory is a btrfs subvolume
  90
  91 # Reuse `DirPlugin`'s `check_config`. This simply checks for invalid paths.
  92 sub check_config {
  93     my ($self, $sectionId, $config, $create, $skipSchemaCheck) = @_;
  94     return PVE::Storage::DirPlugin::check_config($self, $sectionId, $config, $create, $skipSchemaCheck);
  95 }
  96
  97 my sub getfsmagic($) {
  98     my ($path) = @_;
  99     # The field type sizes in `struct statfs` are defined in a rather annoying way, and we only
 100     # need the first field, which is a `long` for our supported platforms.
 101     # Should be moved to pve-rs, so this can be the problem of the `libc` crate ;-)
 102     # Just round up and extract what we need:
 103     my $buf = pack('x160');
 104     if (0 != syscall(&PVE::Syscall::SYS_statfs, $path, $buf)) {
 105         die "statfs on '$path' failed - $!\n";
 106     }
 107
 108     return unpack('L!', $buf);
 109 }
 110
 111 my sub assert_btrfs($) {
 112     my ($path) = @_;
 113     die "'$path' is not a btrfs file system\n"
 114         if getfsmagic($path) != BTRFS_MAGIC;
 115 }
 116
 117 sub activate_storage {
 118     my ($class, $storeid, $scfg, $cache) = @_;
 119
 120     my $path = $scfg->{path};
 121     if (!defined($scfg->{mkdir}) || $scfg->{mkdir}) {
 122         mkpath $path;
 123     }
 124
 125     my $mp = PVE::Storage::DirPlugin::parse_is_mountpoint($scfg);
 126     if (defined($mp) && !PVE::Storage::DirPlugin::path_is_mounted($mp, $cache->{mountdata})) {
 127         die "unable to activate storage '$storeid' - directory is expected to be a mount point but"
 128         ." is not mounted: '$mp'\n";
 129     }
 130
 131     assert_btrfs($path); # only assert this stuff now, ensures $path is there and better UX
 132
 133     $class->SUPER::activate_storage($storeid, $scfg, $cache);
 134 }
 135
 136 sub status {
 137     my ($class, $storeid, $scfg, $cache) = @_;
 138     return PVE::Storage::DirPlugin::status($class, $storeid, $scfg, $cache);
 139 }
 140
 141 sub get_volume_attribute {
 142     my ($class, $scfg, $storeid, $volname, $attribute) = @_;
 143     return PVE::Storage::DirPlugin::get_volume_attribute($class, $scfg, $storeid, $volname, $attribute);
 144 }
 145
 146 sub update_volume_attribute {
 147     my ($class, $scfg, $storeid, $volname, $attribute, $value) = @_;
 148     return PVE::Storage::DirPlugin::update_volume_attribute(
 149         $class,
 150         $scfg,
 151         $storeid,
 152         $volname,
 153         $attribute,
 154         $value,
 155     );
 156 }
 157
 158 # croak would not include the caller from within this module
 159 sub __error {
 160     my ($msg) = @_;
 161     my (undef, $f, $n) = caller(1);
 162     die "$msg at $f: $n\n";
 163 }
 164
 165 # Given a name (eg. `vm-VMID-disk-ID.raw`), take the part up to the format suffix as the name of
 166 # the subdirectory (subvolume).
 167 sub raw_name_to_dir($) {
 168     my ($raw) = @_;
 169
 170     # For the subvolume directory Strip the `.<format>` suffix:
 171     if ($raw =~ /^(.*)\.raw$/) {
 172         return $1;
 173     }
 174
 175     __error "internal error: bad disk name: $raw";
 176 }
 177
 178 sub raw_file_to_subvol($) {
 179     my ($file) = @_;
 180
 181     if ($file =~ m|^(.*)/disk\.raw$|) {
 182         return "$1";
 183     }
 184
 185     __error "internal error: bad raw path: $file";
 186 }
 187
 188 sub filesystem_path {
 189     my ($class, $scfg, $volname, $snapname) = @_;
 190
 191     my ($vtype, $name, $vmid, undef, undef, $isBase, $format) =
 192         $class->parse_volname($volname);
 193
 194     my $path = $class->get_subdir($scfg, $vtype);
 195
 196     $path .= "/$vmid" if $vtype eq 'images';
 197
 198     if (defined($format) && $format eq 'raw') {
 199         my $dir = raw_name_to_dir($name);
 200         if ($snapname) {
 201             $dir .= "\@$snapname";
 202         }
 203         $path .= "/$dir/disk.raw";
 204     } elsif (defined($format) && $format eq 'subvol') {
 205         $path .= "/$name";
 206         if ($snapname) {
 207             $path .= "\@$snapname";
 208         }
 209     } else {
 210         $path .= "/$name";
 211     }
 212
 213     return wantarray ? ($path, $vmid, $vtype) : $path;
 214 }
 215
 216 sub btrfs_cmd {
 217     my ($class, $cmd, $outfunc) = @_;
 218
 219     my $msg = '';
 220     my $func;
 221     if (defined($outfunc)) {
 222         $func = sub {
 223             my $part = &$outfunc(@_);
 224             $msg .= $part if defined($part);
 225         };
 226     } else {
 227         $func = sub { $msg .= "$_[0]\n" };
 228     }
 229     run_command(['btrfs', '-q', @$cmd], errmsg => 'btrfs error', outfunc => $func);
 230
 231     return $msg;
 232 }
 233
 234 sub btrfs_get_subvol_id {
 235     my ($class, $path) = @_;
 236     my $info = $class->btrfs_cmd(['subvolume', 'show', '--', $path]);
 237     if ($info !~ /^\s*(?:Object|Subvolume) ID:\s*(\d+)$/m) {
 238         die "failed to get btrfs subvolume ID from: $info\n";
 239     }
 240     return $1;
 241 }
 242
 243 my sub chattr : prototype($$$) {
 244     my ($fh, $mask, $xor) = @_;
 245
 246     my $flags = pack('L!', 0);
 247     ioctl($fh, FS_IOC_GETFLAGS, $flags) or die "FS_IOC_GETFLAGS failed - $!\n";
 248     $flags = pack('L!', (unpack('L!', $flags) & $mask) ^ $xor);
 249     ioctl($fh, FS_IOC_SETFLAGS, $flags) or die "FS_IOC_SETFLAGS failed - $!\n";
 250     return 1;
 251 }
 252
 253 sub create_base {
 254     my ($class, $storeid, $scfg, $volname) = @_;
 255
 256     my ($vtype, $name, $vmid, $basename, $basevmid, $isBase, $format) =
 257         $class->parse_volname($volname);
 258
 259     my $newname = $name;
 260     $newname =~ s/^vm-/base-/;
 261
 262     # If we're not working with a 'raw' file, which is the only thing that's "different" for btrfs,
 263     # or a subvolume, we forward to the DirPlugin
 264     if ($format ne 'raw' && $format ne 'subvol') {
 265         return PVE::Storage::DirPlugin::create_base(@_);
 266     }
 267
 268     my $path = $class->filesystem_path($scfg, $volname);
 269     my $newvolname = $basename ? "$basevmid/$basename/$vmid/$newname" : "$vmid/$newname";
 270     my $newpath = $class->filesystem_path($scfg, $newvolname);
 271
 272     my $subvol = $path;
 273     my $newsubvol = $newpath;
 274     if ($format eq 'raw') {
 275         $subvol = raw_file_to_subvol($subvol);
 276         $newsubvol = raw_file_to_subvol($newsubvol);
 277     }
 278
 279     rename($subvol, $newsubvol)
 280         || die "rename '$subvol' to '$newsubvol' failed - $!\n";
 281     eval { $class->btrfs_cmd(['property', 'set', $newsubvol, 'ro', 'true']) };
 282     warn $@ if $@;
 283
 284     return $newvolname;
 285 }
 286
 287 sub clone_image {
 288     my ($class, $scfg, $storeid, $volname, $vmid, $snap) = @_;
 289
 290     my ($vtype, $basename, $basevmid, undef, undef, $isBase, $format) =
 291         $class->parse_volname($volname);
 292
 293     # If we're not working with a 'raw' file, which is the only thing that's "different" for btrfs,
 294     # or a subvolume, we forward to the DirPlugin
 295     if ($format ne 'raw' && $format ne 'subvol') {
 296         return PVE::Storage::DirPlugin::clone_image(@_);
 297     }
 298
 299     my $imagedir = $class->get_subdir($scfg, 'images');
 300     $imagedir .= "/$vmid";
 301     mkpath $imagedir;
 302
 303     my $path = $class->filesystem_path($scfg, $volname);
 304     my $newname = $class->find_free_diskname($storeid, $scfg, $vmid, $format, 1);
 305
 306     # For btrfs subvolumes we don't actually need the "link":
 307     #my $newvolname = "$basevmid/$basename/$vmid/$newname";
 308     my $newvolname = "$vmid/$newname";
 309     my $newpath = $class->filesystem_path($scfg, $newvolname);
 310
 311     my $subvol = $path;
 312     my $newsubvol = $newpath;
 313     if ($format eq 'raw') {
 314         $subvol = raw_file_to_subvol($subvol);
 315         $newsubvol = raw_file_to_subvol($newsubvol);
 316     }
 317
 318     $class->btrfs_cmd(['subvolume', 'snapshot', '--', $subvol, $newsubvol]);
 319
 320     return $newvolname;
 321 }
 322
 323 sub alloc_image {
 324     my ($class, $storeid, $scfg, $vmid, $fmt, $name, $size) = @_;
 325
 326     if ($fmt ne 'raw' && $fmt ne 'subvol') {
 327         return $class->SUPER::alloc_image($storeid, $scfg, $vmid, $fmt, $name, $size);
 328     }
 329
 330     # From Plugin.pm:
 331
 332     my $imagedir = $class->get_subdir($scfg, 'images') . "/$vmid";
 333
 334     mkpath $imagedir;
 335
 336     $name = $class->find_free_diskname($storeid, $scfg, $vmid, $fmt, 1) if !$name;
 337
 338     my (undef, $tmpfmt) = PVE::Storage::Plugin::parse_name_dir($name);
 339
 340     die "illegal name '$name' - wrong extension for format ('$tmpfmt != '$fmt')\n"
 341         if $tmpfmt ne $fmt;
 342
 343     # End copy from Plugin.pm
 344
 345     my $subvol = "$imagedir/$name";
 346     # .raw is not part of the directory name
 347     $subvol =~ s/\.raw$//;
 348
 349     die "disk image '$subvol' already exists\n" if -e $subvol;
 350
 351     my $path;
 352     if ($fmt eq 'raw') {
 353         $path = "$subvol/disk.raw";
 354     }
 355
 356     if ($fmt eq 'subvol' && !!$size) {
 357         # NOTE: `btrfs send/recv` actually drops quota information so supporting subvolumes with
 358         # quotas doesn't play nice with send/recv.
 359         die "btrfs quotas are currently not supported, use an unsized subvolume or a raw file\n";
 360     }
 361
 362     $class->btrfs_cmd(['subvolume', 'create', '--', $subvol]);
 363
 364     eval {
 365         if ($fmt eq 'subvol') {
 366             # Nothing to do for now...
 367
 368             # This is how we *would* do it:
 369             # # Use the subvol's default 0/$id qgroup
 370             # eval {
 371             #     # This call should happen at storage creation instead and therefore governed by a
 372             #     # configuration option!
 373             #     # $class->btrfs_cmd(['quota', 'enable', $subvol]);
 374             #     my $id = $class->btrfs_get_subvol_id($subvol);
 375             #     $class->btrfs_cmd(['qgroup', 'limit', "${size}k", "0/$id", $subvol]);
 376             # };
 377         } elsif ($fmt eq 'raw') {
 378             sysopen my $fh, $path, O_WRONLY | O_CREAT | O_EXCL
 379                 or die "failed to create raw file '$path' - $!\n";
 380             chattr($fh, ~FS_NOCOW_FL, FS_NOCOW_FL) if $scfg->{nocow};
 381             truncate($fh, $size * 1024)
 382                 or die "failed to set file size for '$path' - $!\n";
 383             close($fh);
 384         } else {
 385             die "internal format error (format = $fmt)\n";
 386         }
 387     };
 388
 389     if (my $err = $@) {
 390         eval { $class->btrfs_cmd(['subvolume', 'delete', '--', $subvol]); };
 391         warn $@ if $@;
 392         die $err;
 393     }
 394
 395     return "$vmid/$name";
 396 }
 397
 398 # Same as btrfsprogs does:
 399 my sub path_is_subvolume : prototype($) {
 400     my ($path) = @_;
 401     my @stat = stat($path)
 402         or die "stat failed on '$path' - $!\n";
 403     my ($ino, $mode) = @stat[1, 2];
 404     return S_ISDIR($mode) && $ino == BTRFS_FIRST_FREE_OBJECTID;
 405 }
 406
 407 my $BTRFS_VOL_REGEX = qr/((?:vm|base|subvol)-\d+-disk-\d+(?:\.subvol)?)(?:\@(\S+))$/;
 408
 409 # Calls `$code->($volume, $name, $snapshot)` for each subvol in a directory matching our volume
 410 # regex.
 411 my sub foreach_subvol : prototype($$) {
 412     my ($dir, $code) = @_;
 413
 414     dir_glob_foreach($dir, $BTRFS_VOL_REGEX, sub {
 415         my ($volume, $name, $snapshot) = ($1, $2, $3);
 416         return if !path_is_subvolume("$dir/$volume");
 417         $code->($volume, $name, $snapshot);
 418     })
 419 }
 420
 421 sub free_image {
 422     my ($class, $storeid, $scfg, $volname, $isBase, $_format) = @_;
 423
 424     my (undef, undef, $vmid, undef, undef, undef, $format) =
 425         $class->parse_volname($volname);
 426
 427     if (!defined($format) || ($format ne 'subvol' && $format ne 'raw')) {
 428         return $class->SUPER::free_image($storeid, $scfg, $volname, $isBase, $_format);
 429     }
 430
 431     my $path = $class->filesystem_path($scfg, $volname);
 432
 433     my $subvol = $path;
 434     if ($format eq 'raw') {
 435         $subvol = raw_file_to_subvol($path);
 436     }
 437
 438     my $dir = dirname($subvol);
 439     my $basename = basename($subvol);
 440     my @snapshot_vols;
 441     foreach_subvol($dir, sub {
 442         my ($volume, $name, $snapshot) = @_;
 443         return if $name ne $basename;
 444         return if !defined $snapshot;
 445         push @snapshot_vols, "$dir/$volume";
 446     });
 447
 448     $class->btrfs_cmd(['subvolume', 'delete', '--', @snapshot_vols, $subvol]);
 449     # try to cleanup directory to not clutter storage with empty $vmid dirs if
 450     # all images from a guest got deleted
 451     rmdir($dir);
 452
 453     return undef;
 454 }
 455
 456 # Currently not used because quotas clash with send/recv.
 457 # my sub btrfs_subvol_quota {
 458 #     my ($class, $path) = @_;
 459 #     my $id = '0/' . $class->btrfs_get_subvol_id($path);
 460 #     my $search = qr/^\Q$id\E\s+(\d)+\s+\d+\s+(\d+)\s*$/;
 461 #     my ($used, $size);
 462 #     $class->btrfs_cmd(['qgroup', 'show', '--raw', '-rf', '--', $path], sub {
 463 #       return if defined($size);
 464 #       if ($_[0] =~ $search) {
 465 #           ($used, $size) = ($1, $2);
 466 #       }
 467 #     });
 468 #     if (!defined($size)) {
 469 #       # syslog should include more information:
 470 #       syslog('err', "failed to get subvolume size for: $path (id $id)");
 471 #       # UI should only see the last path component:
 472 #       $path =~ s|^.*/||;
 473 #       die "failed to get subvolume size for $path\n";
 474 #     }
 475 #     return wantarray ? ($used, $size) : $size;
 476 # }
 477
 478 sub volume_size_info {
 479     my ($class, $scfg, $storeid, $volname, $timeout) = @_;
 480
 481     my $path = $class->filesystem_path($scfg, $volname);
 482
 483     my $format = ($class->parse_volname($volname))[6];
 484
 485     if (defined($format) && $format eq 'subvol') {
 486         my $ctime = (stat($path))[10];
 487         my ($used, $size) = (0, 0);
 488         #my ($used, $size) = btrfs_subvol_quota($class, $path); # uses wantarray
 489         return wantarray ? ($size, 'subvol', $used, undef, $ctime) : 1;
 490     }
 491
 492     return PVE::Storage::Plugin::file_size_info($path, $timeout);
 493 }
 494
 495 sub volume_resize {
 496     my ($class, $scfg, $storeid, $volname, $size, $running) = @_;
 497
 498     my $format = ($class->parse_volname($volname))[6];
 499     if ($format eq 'subvol') {
 500         my $path = $class->filesystem_path($scfg, $volname);
 501         my $id = '0/' . $class->btrfs_get_subvol_id($path);
 502         $class->btrfs_cmd(['qgroup', 'limit', '--', "${size}k", "0/$id", $path]);
 503         return undef;
 504     }
 505
 506     return PVE::Storage::Plugin::volume_resize(@_);
 507 }
 508
 509 sub volume_snapshot {
 510     my ($class, $scfg, $storeid, $volname, $snap) = @_;
 511
 512     my ($name, $vmid, $format) = ($class->parse_volname($volname))[1,2,6];
 513     if ($format ne 'subvol' && $format ne 'raw') {
 514         return PVE::Storage::Plugin::volume_snapshot(@_);
 515     }
 516
 517     my $path = $class->filesystem_path($scfg, $volname);
 518     my $snap_path = $class->filesystem_path($scfg, $volname, $snap);
 519
 520     if ($format eq 'raw') {
 521         $path = raw_file_to_subvol($path);
 522         $snap_path = raw_file_to_subvol($snap_path);
 523     }
 524
 525     my $snapshot_dir = $class->get_subdir($scfg, 'images') . "/$vmid";
 526     mkpath $snapshot_dir;
 527
 528     $class->btrfs_cmd(['subvolume', 'snapshot', '-r', '--', $path, $snap_path]);
 529     return undef;
 530 }
 531
 532 sub volume_rollback_is_possible {
 533     my ($class, $scfg, $storeid, $volname, $snap, $blockers) = @_;
 534
 535     return 1;
 536 }
 537
 538 sub volume_snapshot_rollback {
 539     my ($class, $scfg, $storeid, $volname, $snap) = @_;
 540
 541     my ($name, $format) = ($class->parse_volname($volname))[1,6];
 542
 543     if ($format ne 'subvol' && $format ne 'raw') {
 544         return PVE::Storage::Plugin::volume_snapshot_rollback(@_);
 545     }
 546
 547     my $path = $class->filesystem_path($scfg, $volname);
 548     my $snap_path = $class->filesystem_path($scfg, $volname, $snap);
 549
 550     if ($format eq 'raw') {
 551         $path = raw_file_to_subvol($path);
 552         $snap_path = raw_file_to_subvol($snap_path);
 553     }
 554
 555     # Simple version would be:
 556     #   rename old to temp
 557     #   create new
 558     #   on error rename temp back
 559     # But for atomicity in case the rename after create-failure *also* fails, we create the new
 560     # subvol first, then use RENAME_EXCHANGE,
 561     my $tmp_path = "$path.tmp.$$";
 562     $class->btrfs_cmd(['subvolume', 'snapshot', '--', $snap_path, $tmp_path]);
 563     # The paths are absolute, so pass -1 as file descriptors.
 564     my $ok = PVE::Tools::renameat2(-1, $tmp_path, -1, $path, &PVE::Tools::RENAME_EXCHANGE);
 565
 566     eval { $class->btrfs_cmd(['subvolume', 'delete', '--', $tmp_path]) };
 567     warn "failed to remove '$tmp_path' subvolume: $@" if $@;
 568
 569     if (!$ok) {
 570         die "failed to rotate '$tmp_path' into place at '$path' - $!\n";
 571     }
 572
 573     return undef;
 574 }
 575
 576 sub volume_snapshot_delete {
 577     my ($class, $scfg, $storeid, $volname, $snap, $running) = @_;
 578
 579     my ($name, $vmid, $format) = ($class->parse_volname($volname))[1,2,6];
 580
 581     if ($format ne 'subvol' && $format ne 'raw') {
 582         return PVE::Storage::Plugin::volume_snapshot_delete(@_);
 583     }
 584
 585     my $path = $class->filesystem_path($scfg, $volname, $snap);
 586
 587     if ($format eq 'raw') {
 588         $path = raw_file_to_subvol($path);
 589     }
 590
 591     $class->btrfs_cmd(['subvolume', 'delete', '--', $path]);
 592
 593     return undef;
 594 }
 595
 596 sub volume_has_feature {
 597     my ($class, $scfg, $feature, $storeid, $volname, $snapname, $running) = @_;
 598
 599     my $features = {
 600         snapshot => {
 601             current => { qcow2 => 1, raw => 1, subvol => 1 },
 602             snap => { qcow2 => 1, raw => 1, subvol => 1 }
 603         },
 604         clone => {
 605             base => { qcow2 => 1, raw => 1, subvol => 1, vmdk => 1 },
 606             current => { raw => 1 },
 607             snap => { raw => 1 },
 608         },
 609         template => {
 610             current => { qcow2 => 1, raw => 1, vmdk => 1, subvol => 1 },
 611         },
 612         copy => {
 613             base => { qcow2 => 1, raw => 1, subvol => 1, vmdk => 1 },
 614             current => { qcow2 => 1, raw => 1, subvol => 1, vmdk => 1 },
 615             snap => { qcow2 => 1, raw => 1, subvol => 1 },
 616         },
 617         sparseinit => {
 618             base => { qcow2 => 1, raw => 1, vmdk => 1 },
 619             current => { qcow2 => 1, raw => 1, vmdk => 1 },
 620         },
 621     };
 622
 623     my ($vtype, $name, $vmid, $basename, $basevmid, $isBase, $format) = $class->parse_volname($volname);
 624
 625     my $key = undef;
 626     if ($snapname) {
 627         $key = 'snap';
 628     } else {
 629         $key =  $isBase ? 'base' : 'current';
 630     }
 631
 632     return 1 if defined($features->{$feature}->{$key}->{$format});
 633
 634     return undef;
 635 }
 636
 637 sub list_images {
 638     my ($class, $storeid, $scfg, $vmid, $vollist, $cache) = @_;
 639     my $imagedir = $class->get_subdir($scfg, 'images');
 640
 641     my $res = [];
 642
 643     # Copied from Plugin.pm, with file_size_info calls adapted:
 644     foreach my $fn (<$imagedir/[0-9][0-9]*/*>) {
 645         # different to in Plugin.pm the regex below also excludes '@' as valid file name
 646         next if $fn !~ m@^(/.+/(\d+)/([^/\@.]+(?:\.(qcow2|vmdk|subvol))?))$@;
 647         $fn = $1; # untaint
 648
 649         my $owner = $2;
 650         my $name = $3;
 651         my $ext = $4;
 652
 653         next if !$vollist && defined($vmid) && ($owner ne $vmid);
 654
 655         my $volid = "$storeid:$owner/$name";
 656         my ($size, $format, $used, $parent, $ctime);
 657
 658         if (!$ext) { # raw
 659             $volid .= '.raw';
 660             ($size, $format, $used, $parent, $ctime) = PVE::Storage::Plugin::file_size_info("$fn/disk.raw");
 661         } elsif ($ext eq 'subvol') {
 662             ($used, $size) = (0, 0);
 663             #($used, $size) = btrfs_subvol_quota($class, $fn);
 664             $format = 'subvol';
 665         } else {
 666             ($size, $format, $used, $parent, $ctime) = PVE::Storage::Plugin::file_size_info($fn);
 667         }
 668         next if !($format && defined($size));
 669
 670         if ($vollist) {
 671             next if ! grep { $_ eq $volid } @$vollist;
 672         }
 673
 674         my $info = {
 675             volid => $volid, format => $format,
 676             size => $size, vmid => $owner, used => $used, parent => $parent,
 677         };
 678
 679         $info->{ctime} = $ctime if $ctime;
 680
 681         push @$res, $info;
 682     }
 683
 684     return $res;
 685 }
 686
 687 sub volume_export_formats {
 688     my ($class, $scfg, $storeid, $volname, $snapshot, $base_snapshot, $with_snapshots) = @_;
 689
 690     # We can do whatever `DirPlugin` can do.
 691     my @result = PVE::Storage::Plugin::volume_export_formats(@_);
 692
 693     # `btrfs send` only works on snapshots:
 694     return @result if !defined $snapshot;
 695
 696     # Incremental stream with snapshots is only supported if the snapshots are listed (new api):
 697     return @result if defined($base_snapshot) && $with_snapshots && ref($with_snapshots) ne 'ARRAY';
 698
 699     # Otherwise we do also support `with_snapshots`.
 700
 701     # Finally, `btrfs send` only works on formats where we actually use btrfs subvolumes:
 702     my $format = ($class->parse_volname($volname))[6];
 703     return @result if $format ne 'raw' && $format ne 'subvol';
 704
 705     return ('btrfs', @result);
 706 }
 707
 708 sub volume_import_formats {
 709     my ($class, $scfg, $storeid, $volname, $snapshot, $base_snapshot, $with_snapshots) = @_;
 710
 711     # Same as export-formats, beware the parameter order:
 712     return volume_export_formats(
 713         $class,
 714         $scfg,
 715         $storeid,
 716         $volname,
 717         $snapshot,
 718         $base_snapshot,
 719         $with_snapshots,
 720     );
 721 }
 722
 723 sub volume_export {
 724     my (
 725         $class,
 726         $scfg,
 727         $storeid,
 728         $fh,
 729         $volname,
 730         $format,
 731         $snapshot,
 732         $base_snapshot,
 733         $with_snapshots,
 734     ) = @_;
 735
 736     if ($format ne 'btrfs') {
 737         return PVE::Storage::Plugin::volume_export(@_);
 738     }
 739
 740     die "format 'btrfs' only works on snapshots\n"
 741         if !defined $snapshot;
 742
 743     die "'btrfs' format in incremental mode requires snapshots to be listed explicitly\n"
 744         if defined($base_snapshot) && $with_snapshots && ref($with_snapshots) ne 'ARRAY';
 745
 746     my $volume_format = ($class->parse_volname($volname))[6];
 747
 748     die "btrfs-sending volumes of type $volume_format ('$volname') is not supported\n"
 749         if $volume_format ne 'raw' && $volume_format ne 'subvol';
 750
 751     my $path = $class->path($scfg, $volname, $storeid);
 752
 753     if ($volume_format eq 'raw') {
 754         $path = raw_file_to_subvol($path);
 755     }
 756
 757     my $cmd = ['btrfs', '-q', 'send', '-e'];
 758     if ($base_snapshot) {
 759         my $base = $class->path($scfg, $volname, $storeid, $base_snapshot);
 760         if ($volume_format eq 'raw') {
 761             $base = raw_file_to_subvol($base);
 762         }
 763         push @$cmd, '-p', $base;
 764     }
 765     push @$cmd, '--';
 766     if (ref($with_snapshots) eq 'ARRAY') {
 767         push @$cmd, (map { "$path\@$_" } ($with_snapshots // [])->@*), $path;
 768     } else {
 769         dir_glob_foreach(dirname($path), $BTRFS_VOL_REGEX, sub {
 770             push @$cmd, "$path\@$_[2]" if !(defined($snapshot) && $_[2] eq $snapshot);
 771         });
 772     }
 773     $path .= "\@$snapshot" if defined($snapshot);
 774     push @$cmd, $path;
 775
 776     run_command($cmd, output => '>&'.fileno($fh));
 777     return;
 778 }
 779
 780 sub volume_import {
 781     my (
 782         $class,
 783         $scfg,
 784         $storeid,
 785         $fh,
 786         $volname,
 787         $format,
 788         $snapshot,
 789         $base_snapshot,
 790         $with_snapshots,
 791         $allow_rename,
 792     ) = @_;
 793
 794     if ($format ne 'btrfs') {
 795         return PVE::Storage::Plugin::volume_import(@_);
 796     }
 797
 798     die "format 'btrfs' only works on snapshots\n"
 799         if !defined $snapshot;
 800
 801     my ($vtype, $name, $vmid, $basename, $basevmid, $isBase, $volume_format) =
 802         $class->parse_volname($volname);
 803
 804     die "btrfs-receiving volumes of type $volume_format ('$volname') is not supported\n"
 805         if $volume_format ne 'raw' && $volume_format ne 'subvol';
 806
 807     if (defined($base_snapshot)) {
 808         my $path = $class->path($scfg, $volname, $storeid, $base_snapshot);
 809         die "base snapshot '$base_snapshot' not found - no such directory '$path'\n"
 810             if !path_is_subvolume($path);
 811     }
 812
 813     my $destination = $class->filesystem_path($scfg, $volname);
 814     if ($volume_format eq 'raw') {
 815         $destination = raw_file_to_subvol($destination);
 816     }
 817
 818     if (!defined($base_snapshot) && -e $destination) {
 819         die "volume $volname already exists\n" if !$allow_rename;
 820         $volname = $class->find_free_diskname($storeid, $scfg, $vmid, $volume_format, 1);
 821     }
 822
 823     my $imagedir = $class->get_subdir($scfg, $vtype);
 824     $imagedir .= "/$vmid" if $vtype eq 'images';
 825
 826     my $tmppath = "$imagedir/recv.$vmid.tmp";
 827     mkdir($imagedir); # FIXME: if $scfg->{mkdir};
 828     if (!mkdir($tmppath)) {
 829         die "temp receive directory already exists at '$tmppath', incomplete concurrent import?\n"
 830             if $! == EEXIST;
 831         die "failed to create temporary receive directory at '$tmppath' - $!\n";
 832     }
 833
 834     my $dh = IO::Dir->new($tmppath)
 835         or die "failed to open temporary receive directory '$tmppath' - $!\n";
 836     eval {
 837         run_command(['btrfs', '-q', 'receive', '-e', '--', $tmppath], input => '<&'.fileno($fh));
 838
 839         # Analyze the received subvolumes;
 840         my ($diskname, $found_snapshot, @snapshots);
 841         $dh->rewind;
 842         while (defined(my $entry = $dh->read)) {
 843             next if $entry eq '.' || $entry eq '..';
 844             next if $entry !~ /^$BTRFS_VOL_REGEX$/;
 845             my ($cur_diskname, $cur_snapshot) = ($1, $2);
 846
 847             die "send stream included a non-snapshot subvolume\n"
 848                 if !defined($cur_snapshot);
 849
 850             if (!defined($diskname)) {
 851                 $diskname = $cur_diskname;
 852             } else {
 853                 die "multiple disks contained in stream ('$diskname' vs '$cur_diskname')\n"
 854                     if $diskname ne $cur_diskname;
 855             }
 856
 857             if ($cur_snapshot eq $snapshot) {
 858                 $found_snapshot = 1;
 859             } else {
 860                 push @snapshots, $cur_snapshot;
 861             }
 862         }
 863
 864         die "send stream did not contain the expected current snapshot '$snapshot'\n"
 865             if !$found_snapshot;
 866
 867         # Rotate the disk into place, first the current state:
 868         # Note that read-only subvolumes cannot be moved into different directories, but for the
 869         # "current" state we also want a writable copy, so start with that:
 870         $class->btrfs_cmd(['property', 'set', "$tmppath/$diskname\@$snapshot", 'ro', 'false']);
 871         PVE::Tools::renameat2(
 872             -1,
 873             "$tmppath/$diskname\@$snapshot",
 874             -1,
 875             $destination,
 876             &PVE::Tools::RENAME_NOREPLACE,
 877         ) or die "failed to move received snapshot '$tmppath/$diskname\@$snapshot'"
 878             . " into place at '$destination' - $!\n";
 879
 880         # Now recreate the actual snapshot:
 881         $class->btrfs_cmd([
 882             'subvolume',
 883             'snapshot',
 884             '-r',
 885             '--',
 886             $destination,
 887             "$destination\@$snapshot",
 888         ]);
 889
 890         # Now go through the remaining snapshots (if any)
 891         foreach my $snap (@snapshots) {
 892             $class->btrfs_cmd(['property', 'set', "$tmppath/$diskname\@$snap", 'ro', 'false']);
 893             PVE::Tools::renameat2(
 894                 -1,
 895                 "$tmppath/$diskname\@$snap",
 896                 -1,
 897                 "$destination\@$snap",
 898                 &PVE::Tools::RENAME_NOREPLACE,
 899             ) or die "failed to move received snapshot '$tmppath/$diskname\@$snap'"
 900                 . " into place at '$destination\@$snap' - $!\n";
 901             eval { $class->btrfs_cmd(['property', 'set', "$destination\@$snap", 'ro', 'true']) };
 902             warn "failed to make $destination\@$snap read-only - $!\n" if $@;
 903         }
 904     };
 905     my $err = $@;
 906
 907     eval {
 908         # Cleanup all the received snapshots we did not move into place, so we can remove the temp
 909         # directory.
 910         if ($dh) {
 911             $dh->rewind;
 912             while (defined(my $entry = $dh->read)) {
 913                 next if $entry eq '.' || $entry eq '..';
 914                 eval { $class->btrfs_cmd(['subvolume', 'delete', '--', "$tmppath/$entry"]) };
 915                 warn $@ if $@;
 916             }
 917             $dh->close; undef $dh;
 918         }
 919         if (!rmdir($tmppath)) {
 920             warn "failed to remove temporary directory '$tmppath' - $!\n"
 921         }
 922     };
 923     warn $@ if $@;
 924     if ($err) {
 925         # clean up if the directory ended up being empty after an error
 926         rmdir($tmppath);
 927         die $err;
 928     }
 929
 930     return "$storeid:$volname";
 931 }
 932
 933 1