[PATCH v3 storage 39/76] api: disks: recheck local users and retain wipe device references

[Thomas Lamprecht <t.lamprecht@proxmox.com>]

Checking mounts and holders before queueing a wipe misses raw device
users and changes while the task waits. Recheck local users under the
disk lock in the worker, refusing the wipe if a probe fails.

Recheck device instance and partition topology before destructive
commands. Retain open device references so reused kernel names cannot
redirect writes. Local wipes remain independent of quorum.

Share reference retention with SAN volume-group creation: keep its
descriptor through completion, clear sectors through it, and verify the
device instance after probes and before each LVM write.

Signed-off-by: Thomas Lamprecht <t.lamprecht@proxmox.com>
---
 src/PVE/API2/Disks.pm                |   9 +-
 src/PVE/API2/Disks/LVM.pm            |   5 +
 src/PVE/Diskmanage.pm                | 185 +++++++++++++++++++++++++--
 src/PVE/Storage/LVMPlugin.pm         |  17 ++-
 src/test/Makefile                    |   5 +-
 src/test/disk_api_test.pm            |   3 +-
 src/test/run_san_lvm_create_tests.pl |  34 ++++-
 src/test/run_wipe_partition_tests.pl | 122 ++++++++++++++++++
 src/test/run_wipe_reference_tests.pl | 123 ++++++++++++++++++
 src/test/run_wipedisk_tests.pl       |  64 +++++++++
 10 files changed, 545 insertions(+), 22 deletions(-)
 create mode 100755 src/test/run_wipe_partition_tests.pl
 create mode 100755 src/test/run_wipe_reference_tests.pl
 create mode 100755 src/test/run_wipedisk_tests.pl

diff --git a/src/PVE/API2/Disks.pm b/src/PVE/API2/Disks.pm
index 58a89c67..ebc73103 100644
--- a/src/PVE/API2/Disks.pm
+++ b/src/PVE/API2/Disks.pm
@@ -329,7 +329,9 @@ __PACKAGE__->register_method({
     code => sub {
         my ($param) = @_;
 
-        my $disk = PVE::Diskmanage::verify_blockdev_path($param->{disk});
+        my $reference = $param->{disk};
+        my $expected = PVE::Diskmanage::block_device_reference($reference);
+        my $disk = $expected->{device};
 
         my $mounted = PVE::Diskmanage::is_mounted($disk);
         die "disk/partition '${mounted}' is mounted\n" if $mounted;
@@ -341,8 +343,9 @@ __PACKAGE__->register_method({
         my $authuser = $rpcenv->get_user();
 
         my $worker = sub {
-            PVE::Diskmanage::wipe_blockdev($disk);
-            PVE::Diskmanage::udevadm_trigger($disk);
+            PVE::Diskmanage::locked_disk_action(sub {
+                PVE::Diskmanage::wipe_blockdev_checked($reference, $expected);
+            });
         };
 
         my $basename = basename($disk); # avoid '/' in the ID
diff --git a/src/PVE/API2/Disks/LVM.pm b/src/PVE/API2/Disks/LVM.pm
index feab0a3b..e2cc8118 100644
--- a/src/PVE/API2/Disks/LVM.pm
+++ b/src/PVE/API2/Disks/LVM.pm
@@ -160,6 +160,8 @@ __PACKAGE__->register_method({
                 || PVE::Diskmanage::is_san_device($device);
         };
         my $san = $is_san->($dev);
+        my $expected = $san ? PVE::Diskmanage::block_device_reference($reference) : undef;
+        $dev = $expected->{device} if $san;
 
         PVE::Diskmanage::assert_disk_unused($dev, 1);
 
@@ -187,6 +189,8 @@ __PACKAGE__->register_method({
                 my $create = sub {
                     if ($san) {
                         $dev = PVE::Diskmanage::verify_blockdev_path($reference);
+                        $dev = PVE::Diskmanage::block_device_reference($reference, $expected)
+                            ->{device};
                     }
                     die "cannot use '$dev' - device topology changed\n"
                         if !$san && $is_san->($dev);
@@ -202,6 +206,7 @@ __PACKAGE__->register_method({
                     my $guard = {
                         reference => $san ? $reference : $dev,
                         san => $san,
+                        expected => $expected,
                     };
                     PVE::Storage::LVMPlugin::lvm_create_volume_group(
                         $guard->{reference},
diff --git a/src/PVE/Diskmanage.pm b/src/PVE/Diskmanage.pm
index 58a627a7..d0e1dd0d 100644
--- a/src/PVE/Diskmanage.pm
+++ b/src/PVE/Diskmanage.pm
@@ -7,7 +7,7 @@ use PVE::ProcFSTools;
 use Data::Dumper;
 use Cwd qw(abs_path);
 use Errno qw(ENOENT ESRCH);
-use Fcntl ':mode';
+use Fcntl qw(:mode O_RDWR O_NONBLOCK);
 use File::Basename;
 use File::stat;
 use JSON;
@@ -70,6 +70,92 @@ sub block_device_number {
     return PVE::Tools::dev_t_major($st[6]) . ':' . PVE::Tools::dev_t_minor($st[6]);
 }
 
+# The sysfs inode distinguishes device instances even when the kernel reuses a name and dev_t.
+sub block_device_stamp {
+    my ($device, $sys) = @_;
+    $sys //= '/sys';
+    my $dir = "$sys/class/block/" . basename($device);
+    my $ino = (CORE::stat($dir))[1] // die "cannot inspect '$device' - missing sysfs device\n";
+    my $number = file_read_firstline("$dir/dev");
+    die "cannot inspect '$device' - invalid device number\n"
+        if !defined($number) || $number !~ m/^\d+:\d+$/;
+    return "$ino:$number";
+}
+
+# Retain the device instance before queueing a worker; kernel names can be reused while it waits.
+sub block_device_reference {
+    my ($reference, $expected, $sys) = @_;
+    $sys //= '/sys';
+    my $device = verify_blockdev_path($reference);
+    my $stamp = block_device_stamp($device, $sys);
+    die "cannot use '$reference' - device identity changed\n"
+        if $expected && $expected->{stamp} ne $stamp;
+    return { device => $device, stamp => $stamp };
+}
+
+sub assert_block_device_instance {
+    my ($reference, $current) = @_;
+
+    my $now = block_device_reference($reference, $current);
+    die "cannot use '$current->{device}' - device topology changed\n"
+        if $now->{device} ne $current->{device} || $now->{stamp} ne $current->{stamp};
+    return;
+}
+
+# Retain the checked device instance even if its kernel name or udev alias is reused.
+sub open_block_device {
+    my ($device, $stamp) = @_;
+    sysopen(my $fh, $device, O_RDWR | O_NONBLOCK)
+        or die "cannot open '$device' - $!\n";
+    my $number = block_device_number($fh) // '';
+    die "cannot use '$device' - device changed while opening it\n"
+        if block_device_stamp($device) ne $stamp || $stamp !~ m/:\Q$number\E$/;
+    return $fh;
+}
+
+# Untaint sysfs names before passing them to commands in taint-mode daemons.
+my sub block_entries {
+    my ($dir) = @_;
+    opendir(my $dh, $dir) or die "unable to list '$dir' - $!\n";
+    my @names = sort grep { $_ ne '.' && $_ ne '..' } readdir($dh);
+    closedir($dh) or die "unable to close '$dir' - $!\n";
+    return [map { m/^([\w.:+-]+)$/ ? $1 : die "unexpected entry '$_' in '$dir'\n" } @names];
+}
+
+sub block_device_partitions {
+    my ($name, $sys) = @_;
+    $sys //= '/sys';
+    my $dir = "$sys/class/block/$name";
+    my @parts;
+    for my $part (block_entries($dir)->@*) {
+        next if !-e "$dir/$part/partition";
+        my $number = file_read_firstline("$dir/$part/partition");
+        die "invalid partition number for '$part'\n"
+            if !defined($number) || $number !~ m/^[1-9]\d*$/;
+        push @parts, $part;
+    }
+    return \@parts;
+}
+
+# Postorder keeps child partitions accessible until their signatures have been erased.
+sub wipe_partitions {
+    my ($device, $sys) = @_;
+    $sys //= '/sys';
+    my (@parts, %seen);
+    my $visit;
+    $visit = sub {
+        my ($name) = @_;
+        die "cannot inspect '$device' - cyclic partition topology\n" if $seen{$name}++;
+        for my $part (block_device_partitions($name, $sys)->@*) {
+            $visit->($part);
+            push @parts, $part;
+        }
+    };
+    $visit->(basename($device));
+    undef $visit;
+    return \@parts;
+}
+
 # Never read device data. Probe failures are not evidence of non-use. Excluding a holder must not
 # exclude direct users; multipathd can be exempted because its checkers keep member paths open.
 sub block_device_users {
@@ -1378,11 +1464,75 @@ sub change_parttype {
     run_command(['sgdisk', "-t${partnum}:${parttype}", $blockdev], errmsg => $err);
 }
 
+# Caller holds the disk lock through verification, wiping and the device trigger.
+sub wipe_blockdev_checked {
+    my ($reference, $expected) = @_;
+
+    my $current = block_device_reference($reference, $expected);
+    my $disk = $current->{device};
+    my $partitions = wipe_partitions($disk);
+    my $children = { map { $_ => block_device_reference("/dev/$_") } $partitions->@* };
+    my $verify = sub {
+        my ($removed) = @_;
+        $removed //= {};
+        assert_block_device_instance($reference, $current);
+        my @remaining = grep { !$removed->{$_} } $partitions->@*;
+        my $parts = wipe_partitions($disk);
+        die "cannot wipe '$reference' - partition topology changed\n"
+            if join(',', @remaining) ne join(',', $parts->@*);
+        for my $part (@remaining) {
+            my $now = block_device_reference(
+                "/dev/$part", $children->{$part},
+            );
+            die "cannot wipe '$reference' - partition '$part' changed\n"
+                if $now->{stamp} ne $children->{$part}->{stamp};
+        }
+    };
+    $verify->();
+    my $handle = open_block_device($disk, $current->{stamp});
+    my $users = block_device_users(
+        [basename($disk)], {},
+    );
+    die "cannot wipe '$disk' - " . join(', ', $users->@*) . "\n" if $users->@*;
+    $verify->();
+    wipe_blockdev(
+        $disk,
+        $partitions,
+        { handle => $handle, verify => $verify, children => $children },
+    );
+    udevadm_trigger(
+        $disk, map { "/dev/$_" } grep { -e "/sys/class/block/$_" } $partitions->@*,
+    );
+}
+
 # Wipes all labels and the first 200 MiB of a disk/partition (or the whole if it is smaller).
 # If called with a partition, also sets the partition type to 0x83 'Linux filesystem'.
 # Expected to be called with a result of verify_blockdev_path().
 sub wipe_blockdev {
-    my ($devpath) = @_;
+    my ($devpath, $partitions, $options) = @_;
+    $options //= {};
+    my $removed = {};
+    my $verify = sub { $options->{verify}->($removed) if $options->{verify} };
+    my $target = $options->{handle} ? "/proc/$$/fd/" . fileno($options->{handle}) : $devpath;
+
+    if ($partitions) {
+        my $current = wipe_partitions($devpath);
+        die "cannot wipe '$devpath' - partition topology changed\n"
+            if join(',', $current->@*) ne join(',', $partitions->@*);
+        my $users = block_device_users([basename($devpath)], {});
+        die "cannot wipe '$devpath' - " . join(', ', $users->@*) . "\n" if $users->@*;
+        for my $part ($partitions->@*) {
+            $verify->();
+            my $child = $options->{children}->{$part};
+            my $handle = $child ? open_block_device("/dev/$part", $child->{stamp}) : undef;
+            my $path = $handle ? "/proc/$$/fd/" . fileno($handle) : "/dev/$part";
+            run_command(['wipefs', '--all', $path], errmsg => "error wiping '/dev/$part'");
+            close($handle) or die "error closing '/dev/$part' - $!\n" if $handle;
+        }
+        # New holders make the parent unsafe even after its child signatures have been erased.
+        $users = block_device_users([basename($devpath)], {});
+        die "cannot wipe '$devpath' - " . join(', ', $users->@*) . "\n" if $users->@*;
+    }
 
     my $devname = basename($devpath);
     my $dev_size = PVE::Tools::file_get_contents("/sys/class/block/$devname/size");
@@ -1394,29 +1544,40 @@ sub wipe_blockdev {
     my $count = ($size < 200) ? $size : 200;
 
     my $to_wipe = [];
-    dir_glob_foreach(
-        "/sys/class/block/${devname}",
-        "${devname}.+",
-        sub {
-            my ($part) = @_;
-            push $to_wipe->@*, "/dev/${part}" if -b "/dev/${part}";
-        },
-    );
+    if (!$partitions) {
+        dir_glob_foreach(
+            "/sys/class/block/${devname}",
+            "${devname}.+",
+            sub {
+                my ($part) = @_;
+                push $to_wipe->@*, "/dev/${part}" if -b "/dev/${part}";
+            },
+        );
+    }
 
     if (scalar($to_wipe->@*) > 0) {
         print "found child partitions to wipe: " . join(', ', $to_wipe->@*) . "\n";
     }
-    push $to_wipe->@*, $devpath; # put actual device last
+    push $to_wipe->@*, $target; # put actual device last
 
     print "wiping block device ${devpath}\n";
 
+    $verify->();
     run_command(['wipefs', '--all', $to_wipe->@*], errmsg => "error wiping '${devpath}'");
+    if ($partitions) {
+        # Erasing the partition table can remove kernel partitions through BLKRRPART, as expected
+        # here; changed or newly appearing devices still fail verification.
+        my %remaining = map { $_ => 1 } wipe_partitions($devpath)->@*;
+        $removed->{$_} = 1 for grep { !/^dm-\d+$/ && !$remaining{$_} } $partitions->@*;
+    }
 
+    $verify->();
     run_command(
-        ['dd', 'if=/dev/zero', "of=${devpath}", 'bs=1M', 'conv=fdatasync', "count=${count}"],
+        ['dd', 'if=/dev/zero', "of=${target}", 'bs=1M', 'conv=fdatasync', "count=${count}"],
         errmsg => "error wiping '${devpath}'",
     );
 
+    $verify->();
     if (is_partition($devpath)) {
         eval { change_parttype($devpath, '8300'); };
         warn $@ if $@;
diff --git a/src/PVE/Storage/LVMPlugin.pm b/src/PVE/Storage/LVMPlugin.pm
index ed7cdb8c..5ba56519 100644
--- a/src/PVE/Storage/LVMPlugin.pm
+++ b/src/PVE/Storage/LVMPlugin.pm
@@ -154,7 +154,18 @@ sub lvm_create_volume_group {
     $device = PVE::Diskmanage::verify_blockdev_path($requested_device);
     my $san = $guard && $guard->{san};
     if ($guard) {
-        if (!$san) {
+        if ($san) {
+            my $current = $guard->{current} = PVE::Diskmanage::block_device_reference(
+                $requested_device, $guard->{expected},
+            );
+            $device = $current->{device};
+            $guard->{handle} = PVE::Diskmanage::open_block_device($device, $current->{stamp});
+            $guard->{verify} = sub {
+                PVE::Diskmanage::assert_block_device_instance($requested_device, $current);
+                PVE::Diskmanage::assert_block_device_instance($_, $current)
+                    for grep { defined } @_;
+            };
+        } else {
             $guard->{verify} = sub {
                 die "cannot use '$device' - device topology changed\n"
                     if PVE::Diskmanage::is_multipath_device($device)
@@ -163,7 +174,7 @@ sub lvm_create_volume_group {
             $guard->{verify}->();
         }
     }
-    my $check_instance = sub { $guard->{verify}->() if $guard && $guard->{verify} };
+    my $check_instance = sub { $guard->{verify}->() if $guard };
     my $check_safe = sub {
         $check_instance->();
         if ($san) {
@@ -248,7 +259,7 @@ sub lvm_create_volume_group {
     $refuse_data->(keys %signatures) if %signatures;
 
     $check_safe->();
-    clear_first_sector($device);
+    clear_first_sector($san ? '/proc/' . $$ . '/fd/' . fileno($guard->{handle}) : $device);
 
     # we use --metadatasize 250k, which reseults in "pe_start = 512"
     # so pe_start is aligned on a 128k boundary (advantage for SSDs)
diff --git a/src/test/Makefile b/src/test/Makefile
index 91c685e7..3ae2639f 100644
--- a/src/test/Makefile
+++ b/src/test/Makefile
@@ -37,8 +37,11 @@ test_disklist: run_disk_tests.pl run_block_device_users_tests.pl
 	./run_disk_tests.pl
 	./run_block_device_users_tests.pl
 
-test_disk_api: run_disk_api_tests.pl
+test_disk_api: run_disk_api_tests.pl run_wipedisk_tests.pl run_wipe_reference_tests.pl run_wipe_partition_tests.pl
 	./run_disk_api_tests.pl
+	./run_wipedisk_tests.pl
+	./run_wipe_reference_tests.pl
+	./run_wipe_partition_tests.pl
 
 test_bwlimit: run_bwlimit_tests.pl
 	./run_bwlimit_tests.pl
diff --git a/src/test/disk_api_test.pm b/src/test/disk_api_test.pm
index d1fc6465..2371a953 100644
--- a/src/test/disk_api_test.pm
+++ b/src/test/disk_api_test.pm
@@ -131,6 +131,7 @@ subtest 'a volume group on a map is created under the storage configuration lock
     $storage->mock(lock_storage_config => sub { $lock->('storage.cfg', $_[0]) });
     $disk->mock(locked_disk_action => sub { $lock->('disk', $_[0]) });
     $disk->mock(verify_blockdev_path => sub { $_[0] });
+    $disk->mock(block_device_reference => sub { { device => $_[0] } });
     $disk->mock(assert_disk_unused => sub { });
     $disk->mock(is_partition => sub { 0 });
     $disk->mock(udevadm_trigger => sub { });
@@ -164,7 +165,7 @@ subtest 'a volume group on a map is created under the storage configuration lock
     );
     $disk->unmock($_)
         for qw(
-        locked_disk_action verify_blockdev_path assert_disk_unused is_partition
+        locked_disk_action verify_blockdev_path block_device_reference assert_disk_unused is_partition
         udevadm_trigger is_multipath_device is_san_device
         );
 };
diff --git a/src/test/run_san_lvm_create_tests.pl b/src/test/run_san_lvm_create_tests.pl
index 200fd7cb..8d6bbfdc 100755
--- a/src/test/run_san_lvm_create_tests.pl
+++ b/src/test/run_san_lvm_create_tests.pl
@@ -7,6 +7,7 @@ use File::Basename qw(basename);
 use File::Path qw(make_path);
 use File::Temp qw(tempdir);
 use JSON qw(encode_json);
+use Scalar::Util qw(weaken);
 use Storable qw(dclone);
 use Test::MockModule;
 use Test::More;
@@ -22,8 +23,10 @@ my $rpc = Test::MockModule->new('PVE::RPCEnvironment');
 my $inotify = Test::MockModule->new('PVE::INotify');
 my $tools = Test::MockModule->new('PVE::Tools');
 my $glob = \&PVE::Tools::dir_glob_foreach;
+my $reference = \&PVE::Diskmanage::block_device_reference;
+my $stamp = \&PVE::Diskmanage::block_device_stamp;
 my $users = \&PVE::Diskmanage::block_device_users;
-my ($root, $resolved, $worker, $cfg, $local, $pv, $during_probe, $inventory_used);
+my ($root, $resolved, $worker, $cfg, $handle, $local, $pv, $during_probe, $inventory_used);
 my (@locks, @writes);
 my $uuid = 'aaaaaa-bbbb-cccc-dddd-eeee-ffff-gggggg';
 my $canonical = '/dev/mapper/lun';
@@ -46,6 +49,8 @@ my sub locked {
 }
 my sub written {
     my ($tool, $path) = @_;
+    ok($handle && defined(fileno($handle)), 'production retains SAN handle through write')
+        if !$local;
     push @writes, [$tool, $path];
 }
 {
@@ -70,6 +75,14 @@ $disk->mock(
         return PVE::Tools::file_read_firstline(
             "$root/sys/class/block/" . basename($path) . '/dev');
     },
+    block_device_reference => sub { $reference->($_[0], $_[1], "$root/sys") },
+    block_device_stamp => sub { $stamp->($_[0], "$root/sys") },
+    open_block_device => sub {
+        open(my $opened, '+<', "$root/handle") or die $!;
+        $handle = $opened;
+        weaken($handle);
+        return $opened;
+    },
     is_mounted => sub { undef },
     has_holder => sub { undef },
     assert_disk_unused => sub { die "device '$_[0]' is already in use\n" if $inventory_used },
@@ -140,8 +153,9 @@ my sub reset_case {
     put('sys/class/block/dm-900/slaves/sda/device/state', 'running');
     put('proc/self/mountinfo', '1 0 0:1 / / rw - rootfs rootfs rw');
     put('proc/swaps', "Filename\tType\tSize\tUsed\tPriority");
+    put('handle', 'retained descriptor fixture');
     ($resolved, $local, $pv) = ('/dev/dm-900', 0, 'blank');
-    ($during_probe, $worker) = (undef, undef);
+    ($during_probe, $worker, $handle) = (undef, undef, undef);
     $cfg =
         { ids => { base => { type => 'iscsi', target => 'iqn.test', content => { none => 1 } } } };
     @writes = ();
@@ -227,4 +241,20 @@ eval { $worker->() };
 like($@, qr/cannot use.*device topology changed/, 'queued local-to-SAN transition refuses');
 is_deeply(\@writes, [], 'transition does not bypass storage lock');
 
+for my $route ('disk', 'base') {
+    reset_case();
+    $during_probe = sub { put('sys/class/block/dm-900/dev', '253:999') };
+    like(run_route($route), qr/device identity changed/, "$route changed instance refuses");
+    is_deeply(\@writes, [], 'replacement after probing receives no destructive command');
+    reset_case();
+    is(run_route($route), '', "$route initializes unchanged instance");
+    like($writes[0]->[1], qr{^/proc/\d+/fd/\d+$}, 'sector clear uses retained descriptor');
+    ok(!defined($handle), 'production releases the retained handle after completion');
+}
+reset_case();
+queue();
+put('sys/class/block/dm-900/dev', '253:999');
+eval { $worker->() };
+like($@, qr/device identity changed/, 'queued replacement refuses');
+is_deeply(\@writes, [], 'queued replacement receives no destructive command');
 done_testing();
diff --git a/src/test/run_wipe_partition_tests.pl b/src/test/run_wipe_partition_tests.pl
new file mode 100755
index 00000000..29ba74a2
--- /dev/null
+++ b/src/test/run_wipe_partition_tests.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Path qw(make_path remove_tree);
+use File::Temp qw(tempdir);
+use Test::MockModule;
+use Test::More;
+
+use lib ('.', '..');
+use PVE::Diskmanage;
+
+my $root = tempdir(CLEANUP => 1);
+my $disk = Test::MockModule->new('PVE::Diskmanage');
+my $tools = Test::MockModule->new('PVE::Tools');
+my $users = \&PVE::Diskmanage::block_device_users;
+my $parts = \&PVE::Diskmanage::wipe_partitions;
+my (@commands, $drop_kernel);
+my sub put {
+    my ($path, $value) = @_;
+    my ($dir) = "$root/$path" =~ m{^(.*)/[^/]+$};
+    make_path($dir);
+    open(my $fh, '>', "$root/$path") or die $!;
+    print $fh "$value\n";
+    close($fh) or die $!;
+}
+my sub device {
+    my ($name, $number, $uuid) = @_;
+    put("sys/class/block/$name/dev", $number);
+    put("sys/class/block/$name/dm/uuid", $uuid);
+    make_path("$root/sys/class/block/$name/holders");
+}
+my sub reset_case {
+    remove_tree("$root/sys", "$root/proc");
+    device('sda', '8:0', '');
+    device('sda1', '8:1', '');
+    put('sys/class/block/sda1/partition', '1');
+    symlink('../sda1', "$root/sys/class/block/sda/sda1") or die $!;
+    put('proc/self/mountinfo', '1 0 0:1 / / rw - rootfs rootfs rw');
+    put('proc/swaps', "Filename\tType\tSize\tUsed\tPriority");
+    @commands = ();
+    $drop_kernel = 0;
+}
+$disk->mock(
+    wipe_partitions => sub { $parts->($_[0], "$root/sys") },
+    block_device_users => sub {
+        $users->($_[0], { %{ $_[1] // {} }, sysfs => "$root/sys", procfs => "$root/proc" });
+    },
+    block_device_number => sub { '8:1' },
+    is_partition => sub { 0 },
+    dir_glob_foreach => sub { },
+    run_command => sub {
+        my ($cmd) = @_;
+        push @commands, $cmd;
+        if ($drop_kernel && $cmd->[0] eq 'wipefs' && $cmd->[-1] eq '/dev/sda') {
+            unlink("$root/sys/class/block/sda/sda1") or die $!;
+        }
+    },
+);
+$tools->mock(file_get_contents => sub { "8192\n" });
+reset_case();
+$drop_kernel = 1;
+my $removed_kernel;
+eval {
+    PVE::Diskmanage::wipe_blockdev(
+        '/dev/sda',
+        ['sda1'],
+        {
+            verify => sub {
+                $removed_kernel = $_[0]->{sda1};
+                my $expected = $removed_kernel ? [] : ['sda1'];
+                is_deeply(
+                    PVE::Diskmanage::wipe_partitions('/dev/sda'),
+                    $expected,
+                    'kernel partition topology matches deliberate removals',
+                );
+            },
+        },
+    );
+};
+is($@, '', 'BLKRRPART removal does not abort the parent wipe');
+ok($removed_kernel, 'kernel partition disappearance recorded after parent signature wipe');
+is($commands[-1]->[0], 'dd', 'zeroing still follows partition table erasure');
+
+reset_case();
+put('handle', 'not a device');
+open(my $parent, '<', "$root/handle") or die $!;
+my $parent_fd = fileno($parent);
+my $child_fd;
+$disk->mock(
+    open_block_device => sub {
+        open(my $fh, '<', "$root/handle") or die $!;
+        $child_fd = fileno($fh);
+        return $fh;
+    },
+);
+my @verified;
+PVE::Diskmanage::wipe_blockdev(
+    '/dev/sda',
+    ['sda1'],
+    {
+        handle => $parent,
+        children => { 'sda1' => { stamp => 'test', dm_uuid => 'part1-mpath-test' } },
+        verify => sub { push @verified, { %{ $_[0] } } },
+    },
+);
+is_deeply(
+    $commands[0],
+    ['wipefs', '--all', "/proc/$$/fd/$child_fd"],
+    'child write uses retained descriptor',
+);
+is_deeply(
+    $commands[1],
+    ['wipefs', '--all', "/proc/$$/fd/$parent_fd"],
+    'parent signatures use retained descriptor',
+);
+like($commands[2]->[2], qr{^of=/proc/$$/fd/$parent_fd$}, 'zeroing uses retained descriptor');
+ok(@verified >= 4, 'topology verified between destructive commands');
+is_deeply($verified[-1], {}, 'unchanged kernel partitions remain verified');
+
+done_testing();
diff --git a/src/test/run_wipe_reference_tests.pl b/src/test/run_wipe_reference_tests.pl
new file mode 100755
index 00000000..610cb691
--- /dev/null
+++ b/src/test/run_wipe_reference_tests.pl
@@ -0,0 +1,123 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Path qw(make_path);
+use File::Temp qw(tempdir);
+use Test::MockModule;
+use Test::More;
+
+use lib ('.', '..');
+use PVE::API2::Disks;
+
+my $root = tempdir(CLEANUP => 1);
+my $disk = Test::MockModule->new('PVE::Diskmanage');
+my $rpc = Test::MockModule->new('PVE::RPCEnvironment');
+my $reference = \&PVE::Diskmanage::block_device_reference;
+my ($resolved, $worker, $locked, $written);
+my sub put {
+    my ($path, $value) = @_;
+    my ($dir) = "$root/$path" =~ m{^(.*)/[^/]+$};
+    make_path($dir);
+    open(my $fh, '>', "$root/$path") or die $!;
+    print $fh "$value\n";
+    close($fh) or die $!;
+}
+put('class/block/sda/dev', '8:0');
+put('class/block/sdb/dev', '8:16');
+{
+
+    package ReferenceTestRPC;
+    sub get_user { 'root@pam' }
+    sub fork_worker { $worker = $_[4]; 'test-upid' }
+}
+$rpc->mock(get => sub { bless {}, 'ReferenceTestRPC' });
+$disk->mock(
+    verify_blockdev_path => sub { $resolved },
+    is_partition => sub { 0 },
+    block_device_reference => sub {
+        ok($locked, 're-resolution occurs after locks') if $_[1];
+        $reference->($_[0], $_[1], $root);
+    },
+    locked_disk_action => sub {
+        $locked = 1;
+        eval { $_[0]->() };
+        my $err = $@;
+        $locked = 0;
+        die $err if $err;
+    },
+    block_device_users => sub { [] },
+    is_mounted => sub { undef },
+    has_holder => sub { undef },
+    wipe_partitions => sub { [] },
+    open_block_device => sub { \*STDOUT },
+    wipe_blockdev => sub {
+        $_[2]->{verify}->();
+        ok($_[2]->{handle}, 'verified handle is retained through wiping');
+        $written = $_[0];
+    },
+    udevadm_trigger => sub { },
+);
+my $method = PVE::API2::Disks->map_method_by_name('wipe_disk')->{code};
+my sub queue {
+    my ($path) = @_;
+    $written = undef;
+    $resolved = '/dev/sda';
+    $method->({ node => 'test', disk => $path });
+}
+queue('/dev/sda');
+eval { $worker->() };
+is($@, '', 'delayed worker accepts the same device instance');
+is($written, '/dev/sda', 'worker uses the verified device');
+queue('/dev/sda');
+$resolved = '/dev/sdb';
+eval { $worker->() };
+like($@, qr/identity changed/, 'rebound reference refuses');
+ok(!defined($written), 'rebound reference does not write');
+
+$disk->unmock('open_block_device');
+put('handle', 'not a device');
+$disk->mock(block_device_stamp => sub { '1:8:0' }, block_device_number => sub { '8:16' });
+eval { PVE::Diskmanage::open_block_device("$root/handle", '1:8:0') };
+like($@, qr/device changed while opening/, 'opened device number must match verified snapshot');
+$disk->mock(block_device_number => sub { '8:0' });
+my $handle = PVE::Diskmanage::open_block_device("$root/handle", '1:8:0');
+ok(defined(fileno($handle)), 'matching opened reference retained');
+close($handle) or die $!;
+
+subtest 'checked wipe keeps verification order and retained handle' => sub {
+    my @events;
+    my $handle;
+    $disk->mock(
+        block_device_reference =>
+            sub { push @events, 'reference'; { device => '/dev/sda', stamp => 's' } },
+        wipe_partitions => sub { push @events, 'partitions'; [] },
+        assert_block_device_ready => sub { push @events, 'ready' },
+        open_block_device => sub {
+            push @events, 'open';
+            open($handle, '<', "$root/handle") or die $!;
+            return $handle;
+        },
+        block_device_users => sub { push @events, 'users'; [] },
+        wipe_blockdev => sub {
+            push @events, 'wipe';
+            is($_[2]->{handle}, $handle, 'wipe receives retained parent handle');
+            $_[2]->{verify}->();
+        },
+        udevadm_trigger => sub {
+            push @events, 'trigger';
+            ok(defined(fileno($handle)), 'parent handle stays open through trigger');
+        },
+    );
+    PVE::Diskmanage::wipe_blockdev_checked('/dev/sda', {});
+    is_deeply(
+        \@events,
+        [qw(reference partitions reference partitions open users
+            reference partitions wipe reference partitions trigger)],
+        'retained open, users, verification, wipe and trigger order',
+    );
+    close($handle);
+};
+
+done_testing();
diff --git a/src/test/run_wipedisk_tests.pl b/src/test/run_wipedisk_tests.pl
new file mode 100755
index 00000000..f110a2f4
--- /dev/null
+++ b/src/test/run_wipedisk_tests.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::MockModule;
+use Test::More;
+
+use lib ('.', '..');
+use PVE::API2::Disks;
+
+my $disk = Test::MockModule->new('PVE::Diskmanage');
+my $rpc = Test::MockModule->new('PVE::RPCEnvironment');
+my ($worker, $users, $probe_error, $wiped);
+my $inside_worker = 0;
+{
+
+    package WipeTestRPC;
+    sub get_user { 'root@pam' }
+    sub fork_worker { $worker = $_[4]; return 'test-upid' }
+}
+$rpc->mock(get => sub { bless {}, 'WipeTestRPC' });
+$disk->mock(
+    verify_blockdev_path => sub { '/dev/sda' },
+    block_device_reference => sub {
+        return {
+            device => '/dev/sda',
+            stamp => '1:8:0',
+            key => 'scsi:test',
+            partition => '',
+        };
+    },
+    open_block_device => sub { \*STDOUT },
+    locked_disk_action => sub { $_[0]->() },
+    is_mounted => sub { undef },
+    has_holder => sub { undef },
+    wipe_partitions => sub { [] },
+    block_device_users => sub {
+        ok($inside_worker, 'users checked in the worker');
+        is_deeply($_[0], ['sda'], 'resolved name checked, including partitions');
+        die $probe_error if $probe_error;
+        return $users;
+    },
+    wipe_blockdev => sub { $wiped++ },
+    udevadm_trigger => sub { },
+);
+my $method = PVE::API2::Disks->map_method_by_name('wipe_disk');
+for my $case (
+    [[], undef, 1, qr/^$/],
+    [['qemu (PID 7) has sda open'], undef, 0, qr/cannot wipe.*qemu/],
+    [[], "probe failed\n", 0, qr/probe failed/],
+) {
+    ($users, $probe_error, my $expected, my $error) = @$case;
+    $wiped = 0;
+    $inside_worker = 0;
+    $method->{code}->({ node => 'test', disk => '/dev/sda' });
+    is($wiped, 0, 'request does not wipe before worker');
+    $inside_worker = 1;
+    eval { $worker->() };
+    like($@, $error, 'worker outcome');
+    is($wiped, $expected, 'only unused devices wiped');
+}
+
+done_testing();
-- 
2.47.3