From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from firstgate.proxmox.com (firstgate.proxmox.com [IPv6:2a01:7e0:0:424::9]) by lore.proxmox.com (Postfix) with ESMTPS id CE09B1FF141 for ; Fri, 13 Feb 2026 17:53:19 +0100 (CET) Received: from firstgate.proxmox.com (localhost [127.0.0.1]) by firstgate.proxmox.com (Proxmox) with ESMTP id 917F5C463; Fri, 13 Feb 2026 17:54:07 +0100 (CET) From: Fiona Ebner To: pve-devel@lists.proxmox.com Subject: [PATCH qemu-server v3 4/4] introduce dedicated module for snaphsot as volume chain handling Date: Fri, 13 Feb 2026 17:52:56 +0100 Message-ID: <20260213165307.177055-5-f.ebner@proxmox.com> X-Mailer: git-send-email 2.47.3 In-Reply-To: <20260213165307.177055-1-f.ebner@proxmox.com> References: <20260213165307.177055-1-f.ebner@proxmox.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Bm-Milter-Handled: 55990f41-d878-4baa-be0a-ee34c49e34d2 X-Bm-Transport-Timestamp: 1771001587380 X-SPAM-LEVEL: Spam detection results: 0 AWL -0.015 Adjusted score from AWL reputation of From: address BAYES_00 -1.9 Bayes spam probability is 0 to 1% DMARC_MISSING 0.1 Missing DMARC policy KAM_DMARC_STATUS 0.01 Test Rule for DKIM or SPF Failure with Strict Alignment SPF_HELO_NONE 0.001 SPF: HELO does not publish an SPF Record SPF_PASS -0.001 SPF: sender matches SPF record Message-ID-Hash: UC65F2RUXUJNV6MCUBQ7JCBNZ3E4TGXQ X-Message-ID-Hash: UC65F2RUXUJNV6MCUBQ7JCBNZ3E4TGXQ X-MailFrom: f.ebner@proxmox.com X-Mailman-Rule-Misses: dmarc-mitigation; no-senders; approved; loop; banned-address; emergency; member-moderation; nonmember-moderation; administrivia; implicit-dest; max-recipients; max-size; news-moderation; no-subject; digests; suspicious-header X-Mailman-Version: 3.3.10 Precedence: list List-Id: Proxmox VE development discussion List-Help: List-Owner: List-Post: List-Subscribe: List-Unsubscribe: Get rid of the cyclic dependency between the Blockdev and BlockJob modules. Signed-off-by: Fiona Ebner --- New in v3. src/PVE/QemuServer.pm | 9 +- src/PVE/QemuServer/Blockdev.pm | 329 +---------------------------- src/PVE/QemuServer/Makefile | 3 +- src/PVE/QemuServer/VolumeChain.pm | 337 ++++++++++++++++++++++++++++++ 4 files changed, 354 insertions(+), 324 deletions(-) create mode 100644 src/PVE/QemuServer/VolumeChain.pm diff --git a/src/PVE/QemuServer.pm b/src/PVE/QemuServer.pm index 39723c82..239b4a8c 100644 --- a/src/PVE/QemuServer.pm +++ b/src/PVE/QemuServer.pm @@ -95,6 +95,7 @@ use PVE::QemuServer::RunState; use PVE::QemuServer::StateFile; use PVE::QemuServer::USB; use PVE::QemuServer::Virtiofs qw(max_virtiofs start_all_virtiofsd); +use PVE::QemuServer::VolumeChain; use PVE::QemuServer::DBusVMState; my $have_ha_config; @@ -4356,7 +4357,7 @@ sub qemu_volume_snapshot { print "external qemu snapshot\n"; my $snapshots = PVE::Storage::volume_snapshot_info($storecfg, $volid); my $parent_snap = $snapshots->{'current'}->{parent}; - PVE::QemuServer::Blockdev::blockdev_external_snapshot( + PVE::QemuServer::VolumeChain::blockdev_external_snapshot( $storecfg, $vmid, $machine_version, $deviceid, $drive, $snap, $parent_snap, ); } elsif ($do_snapshots_type eq 'storage') { @@ -4414,7 +4415,7 @@ sub qemu_volume_snapshot_delete { # improve-me: if firstsnap > child : commit, if firstsnap < child do a stream. if (!$parentsnap) { print "delete first snapshot $snap\n"; - PVE::QemuServer::Blockdev::blockdev_commit( + PVE::QemuServer::VolumeChain::blockdev_commit( $storecfg, $vmid, $machine_version, @@ -4426,7 +4427,7 @@ sub qemu_volume_snapshot_delete { PVE::Storage::rename_snapshot($storecfg, $volid, $snap, $childsnap); - PVE::QemuServer::Blockdev::blockdev_replace( + PVE::QemuServer::VolumeChain::blockdev_replace( $storecfg, $vmid, $machine_version, @@ -4439,7 +4440,7 @@ sub qemu_volume_snapshot_delete { } else { #intermediate snapshot, we always stream the snapshot to child snapshot print "stream intermediate snapshot $snap to $childsnap\n"; - PVE::QemuServer::Blockdev::blockdev_stream( + PVE::QemuServer::VolumeChain::blockdev_stream( $storecfg, $vmid, $machine_version, diff --git a/src/PVE/QemuServer/Blockdev.pm b/src/PVE/QemuServer/Blockdev.pm index 5846ac69..be907be8 100644 --- a/src/PVE/QemuServer/Blockdev.pm +++ b/src/PVE/QemuServer/Blockdev.pm @@ -5,19 +5,24 @@ use warnings; use Digest::SHA; use Fcntl qw(S_ISBLK S_ISCHR); -use File::Basename qw(basename dirname); use File::stat; use JSON; use PVE::JSONSchema qw(json_bool); use PVE::Storage; -use PVE::QemuServer::BlockJob; use PVE::QemuServer::Drive qw(drive_is_cdrom); use PVE::QemuServer::Helpers; use PVE::QemuServer::Machine; use PVE::QemuServer::Monitor qw(mon_cmd qmp_cmd); +use base qw(Exporter); + +our @EXPORT_OK = qw( + generate_file_blockdev + generate_format_blockdev +); + # gives ($host, $port, $export) my $NBD_TCP_PATH_RE_3 = qr/nbd:(\S+):(\d+):exportname=(\S+)/; my $NBD_UNIX_PATH_RE_2 = qr/nbd:unix:(\S+):exportname=(\S+)/; @@ -113,7 +118,7 @@ sub get_block_info { return $block_info; } -my sub get_node_name { +sub get_node_name { my ($type, $drive_id, $volid, $options) = @_; return fleecing_node_name($type, $drive_id, $options) if $options->{fleecing}; @@ -254,7 +259,7 @@ my sub generate_blockdev_drive_cache { }; } -my sub generate_file_blockdev { +sub generate_file_blockdev { my ($storecfg, $drive, $machine_version, $options) = @_; my $blockdev = {}; @@ -335,7 +340,7 @@ my sub generate_file_blockdev { return $blockdev; } -my sub generate_format_blockdev { +sub generate_format_blockdev { my ($storecfg, $drive, $child, $options) = @_; die "generate_format_blockdev called without volid/path\n" if !$drive->{file}; @@ -850,318 +855,4 @@ sub set_io_throttle { } } -sub blockdev_external_snapshot { - my ($storecfg, $vmid, $machine_version, $deviceid, $drive, $snap, $parent_snap) = @_; - - print "Creating a new current volume with $snap as backing snap\n"; - - my $volid = $drive->{file}; - - #rename current to snap && preallocate add a new current file with reference to snap1 backing-file - PVE::Storage::volume_snapshot($storecfg, $volid, $snap); - - #reopen current to snap - blockdev_replace( - $storecfg, - $vmid, - $machine_version, - $deviceid, - $drive, - 'current', - $snap, - $parent_snap, - ); - - #be sure to add drive in write mode - delete($drive->{ro}); - - my $new_file_blockdev = generate_file_blockdev($storecfg, $drive); - my $new_fmt_blockdev = generate_format_blockdev($storecfg, $drive, $new_file_blockdev); - - my $snap_file_blockdev = - generate_file_blockdev($storecfg, $drive, $machine_version, { 'snapshot-name' => $snap }); - my $snap_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $snap_file_blockdev, - { 'snapshot-name' => $snap }, - ); - - #backing need to be forced to undef in blockdev, to avoid reopen of backing-file on blockdev-add - $new_fmt_blockdev->{backing} = undef; - - mon_cmd($vmid, 'blockdev-add', %$new_fmt_blockdev); - - print "blockdev-snapshot: reopen current with $snap backing image\n"; - mon_cmd( - $vmid, 'blockdev-snapshot', - node => $snap_fmt_blockdev->{'node-name'}, - overlay => $new_fmt_blockdev->{'node-name'}, - ); -} - -sub blockdev_delete { - my ($storecfg, $vmid, $drive, $file_blockdev, $fmt_blockdev, $snap) = @_; - - eval { detach($vmid, $fmt_blockdev->{'node-name'}); }; - warn "detaching block node for $file_blockdev->{filename} failed - $@" if $@; - - #delete the file (don't use vdisk_free as we don't want to delete all snapshot chain) - print "delete old $file_blockdev->{filename}\n"; - - my $storage_name = PVE::Storage::parse_volume_id($drive->{file}); - - my $volid = $drive->{file}; - PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, 1); -} - -my sub blockdev_relative_backing_file { - my ($backing, $backed) = @_; - - my $backing_file = $backing->{filename}; - my $backed_file = $backed->{filename}; - - if (dirname($backing_file) eq dirname($backed_file)) { - # make backing file relative if in same directory - return basename($backing_file); - } - - return $backing_file; -} - -sub blockdev_replace { - my ( - $storecfg, - $vmid, - $machine_version, - $deviceid, - $drive, - $src_snap, - $target_snap, - $parent_snap, - ) = @_; - - print "blockdev replace $src_snap by $target_snap\n"; - - my $volid = $drive->{file}; - my $drive_id = PVE::QemuServer::Drive::get_drive_id($drive); - - my $src_name_options = {}; - my $src_blockdev_name; - if ($src_snap eq 'current') { - # there might be other nodes on top like zeroinit, look up the current node below throttle - $src_blockdev_name = get_node_name_below_throttle($vmid, $deviceid, 1); - } else { - $src_name_options = { 'snapshot-name' => $src_snap }; - $src_blockdev_name = get_node_name('fmt', $drive_id, $volid, $src_name_options); - } - - my $target_file_blockdev = generate_file_blockdev( - $storecfg, - $drive, - $machine_version, - { 'snapshot-name' => $target_snap }, - ); - my $target_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $target_file_blockdev, - { 'snapshot-name' => $target_snap }, - ); - - if ($target_snap eq 'current' || $src_snap eq 'current') { - #rename from|to current - - #add backing to target - if ($parent_snap) { - my $parent_fmt_nodename = - get_node_name('fmt', $drive_id, $volid, { 'snapshot-name' => $parent_snap }); - $target_fmt_blockdev->{backing} = $parent_fmt_nodename; - } - mon_cmd($vmid, 'blockdev-add', %$target_fmt_blockdev); - - #reopen the current throttlefilter nodename with the target fmt nodename - my $throttle_blockdev = - generate_throttle_blockdev($drive, $target_fmt_blockdev->{'node-name'}, {}); - mon_cmd($vmid, 'blockdev-reopen', options => [$throttle_blockdev]); - } else { - #intermediate snapshot - mon_cmd($vmid, 'blockdev-add', %$target_fmt_blockdev); - - #reopen the parent node with the new target fmt backing node - my $parent_file_blockdev = generate_file_blockdev( - $storecfg, - $drive, - $machine_version, - { 'snapshot-name' => $parent_snap }, - ); - my $parent_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $parent_file_blockdev, - { 'snapshot-name' => $parent_snap }, - ); - $parent_fmt_blockdev->{backing} = $target_fmt_blockdev->{'node-name'}; - mon_cmd($vmid, 'blockdev-reopen', options => [$parent_fmt_blockdev]); - - my $backing_file = - blockdev_relative_backing_file($target_file_blockdev, $parent_file_blockdev); - - #change backing-file in qcow2 metadatas - mon_cmd( - $vmid, 'change-backing-file', - device => $deviceid, - 'image-node-name' => $parent_fmt_blockdev->{'node-name'}, - 'backing-file' => $backing_file, - ); - } - - # delete old file|fmt nodes - eval { detach($vmid, $src_blockdev_name); }; - warn "detaching block node for $src_snap failed - $@" if $@; -} - -sub blockdev_commit { - my ($storecfg, $vmid, $machine_version, $deviceid, $drive, $src_snap, $target_snap) = @_; - - my $volid = $drive->{file}; - my $target_was_read_only; - - print "block-commit $src_snap to base:$target_snap\n"; - - my $target_file_blockdev = generate_file_blockdev( - $storecfg, - $drive, - $machine_version, - { 'snapshot-name' => $target_snap }, - ); - my $target_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $target_file_blockdev, - { 'snapshot-name' => $target_snap }, - ); - - my $src_file_blockdev = generate_file_blockdev( - $storecfg, - $drive, - $machine_version, - { 'snapshot-name' => $src_snap }, - ); - my $src_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $src_file_blockdev, - { 'snapshot-name' => $src_snap }, - ); - - if ($target_was_read_only = $target_fmt_blockdev->{'read-only'}) { - print "reopening internal read-only block node for '$target_snap' as writable\n"; - $target_fmt_blockdev->{'read-only'} = JSON::false; - $target_file_blockdev->{'read-only'} = JSON::false; - mon_cmd($vmid, 'blockdev-reopen', options => [$target_fmt_blockdev]); - # For the guest, the drive is still read-only, because the top throttle node is. - } - - eval { - my $job_id = "commit-$deviceid"; - my $jobs = {}; - my $opts = { 'job-id' => $job_id, device => $deviceid }; - - $opts->{'base-node'} = $target_fmt_blockdev->{'node-name'}; - $opts->{'top-node'} = $src_fmt_blockdev->{'node-name'}; - - mon_cmd($vmid, "block-commit", %$opts); - $jobs->{$job_id} = {}; - - # If the 'current' state is committed to its backing snapshot, the job will not complete - # automatically, because there is a writer, i.e. the guest. It is necessary to use the - # 'complete' completion mode, so that the 'current' block node is replaced with the backing - # node upon completion. Like that, IO after the commit operation will already land in the - # backing node, which will be renamed since it will be the new top of the chain (done by the - # caller). - # - # For other snapshots in the chain, it can be assumed that they have no writer, so - # 'block-commit' will complete automatically. - my $complete = $src_snap && $src_snap ne 'current' ? 'auto' : 'complete'; - - PVE::QemuServer::BlockJob::monitor($vmid, undef, $jobs, $complete, 0, 'commit'); - - blockdev_delete( - $storecfg, $vmid, $drive, $src_file_blockdev, $src_fmt_blockdev, $src_snap, - ); - }; - my $err = $@; - - if ($target_was_read_only) { - # Even when restoring the read-only flag on the format and file nodes fails, the top - # throttle node still has it, ensuring it is read-only for the guest. - print "re-applying read-only flag for internal block node for '$target_snap'\n"; - $target_fmt_blockdev->{'read-only'} = JSON::true; - $target_file_blockdev->{'read-only'} = JSON::true; - eval { mon_cmd($vmid, 'blockdev-reopen', options => [$target_fmt_blockdev]); }; - print "failed to re-apply read-only flag - $@\n" if $@; - } - - die $err if $err; -} - -sub blockdev_stream { - my ($storecfg, $vmid, $machine_version, $deviceid, $drive, $snap, $parent_snap, $target_snap) = - @_; - - my $volid = $drive->{file}; - $target_snap = undef if $target_snap eq 'current'; - - my $parent_file_blockdev = generate_file_blockdev( - $storecfg, - $drive, - $machine_version, - { 'snapshot-name' => $parent_snap }, - ); - my $parent_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $parent_file_blockdev, - { 'snapshot-name' => $parent_snap }, - ); - - my $target_file_blockdev = generate_file_blockdev( - $storecfg, - $drive, - $machine_version, - { 'snapshot-name' => $target_snap }, - ); - my $target_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $target_file_blockdev, - { 'snapshot-name' => $target_snap }, - ); - - my $snap_file_blockdev = - generate_file_blockdev($storecfg, $drive, $machine_version, { 'snapshot-name' => $snap }); - my $snap_fmt_blockdev = generate_format_blockdev( - $storecfg, - $drive, - $snap_file_blockdev, - { 'snapshot-name' => $snap }, - ); - - my $backing_file = blockdev_relative_backing_file($parent_file_blockdev, $target_file_blockdev); - - my $job_id = "stream-$deviceid"; - my $jobs = {}; - my $options = { 'job-id' => $job_id, device => $target_fmt_blockdev->{'node-name'} }; - $options->{'base-node'} = $parent_fmt_blockdev->{'node-name'}; - $options->{'backing-file'} = $backing_file; - - mon_cmd($vmid, 'block-stream', %$options); - $jobs->{$job_id} = {}; - - PVE::QemuServer::BlockJob::monitor($vmid, undef, $jobs, 'auto', 0, 'stream'); - - blockdev_delete($storecfg, $vmid, $drive, $snap_file_blockdev, $snap_fmt_blockdev, $snap); -} - 1; diff --git a/src/PVE/QemuServer/Makefile b/src/PVE/QemuServer/Makefile index d599ca91..7e48c388 100644 --- a/src/PVE/QemuServer/Makefile +++ b/src/PVE/QemuServer/Makefile @@ -28,7 +28,8 @@ SOURCES=Agent.pm \ RunState.pm \ StateFile.pm \ USB.pm \ - Virtiofs.pm + Virtiofs.pm \ + VolumeChain.pm .PHONY: install install: $(SOURCES) diff --git a/src/PVE/QemuServer/VolumeChain.pm b/src/PVE/QemuServer/VolumeChain.pm new file mode 100644 index 00000000..e3790683 --- /dev/null +++ b/src/PVE/QemuServer/VolumeChain.pm @@ -0,0 +1,337 @@ +package PVE::QemuServer::VolumeChain; + +use strict; +use warnings; + +use File::Basename qw(basename dirname); +use JSON; + +use PVE::Storage; + +use PVE::QemuServer::Blockdev qw(generate_file_blockdev generate_format_blockdev); +use PVE::QemuServer::BlockJob; +use PVE::QemuServer::Drive; +use PVE::QemuServer::Monitor qw(mon_cmd); + +sub blockdev_external_snapshot { + my ($storecfg, $vmid, $machine_version, $deviceid, $drive, $snap, $parent_snap) = @_; + + print "Creating a new current volume with $snap as backing snap\n"; + + my $volid = $drive->{file}; + + #rename current to snap && preallocate add a new current file with reference to snap1 backing-file + PVE::Storage::volume_snapshot($storecfg, $volid, $snap); + + #reopen current to snap + blockdev_replace( + $storecfg, + $vmid, + $machine_version, + $deviceid, + $drive, + 'current', + $snap, + $parent_snap, + ); + + #be sure to add drive in write mode + delete($drive->{ro}); + + my $new_file_blockdev = generate_file_blockdev($storecfg, $drive); + my $new_fmt_blockdev = generate_format_blockdev($storecfg, $drive, $new_file_blockdev); + + my $snap_file_blockdev = + generate_file_blockdev($storecfg, $drive, $machine_version, { 'snapshot-name' => $snap }); + my $snap_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $snap_file_blockdev, + { 'snapshot-name' => $snap }, + ); + + #backing need to be forced to undef in blockdev, to avoid reopen of backing-file on blockdev-add + $new_fmt_blockdev->{backing} = undef; + + mon_cmd($vmid, 'blockdev-add', %$new_fmt_blockdev); + + print "blockdev-snapshot: reopen current with $snap backing image\n"; + mon_cmd( + $vmid, 'blockdev-snapshot', + node => $snap_fmt_blockdev->{'node-name'}, + overlay => $new_fmt_blockdev->{'node-name'}, + ); +} + +sub blockdev_delete { + my ($storecfg, $vmid, $drive, $file_blockdev, $fmt_blockdev, $snap) = @_; + + eval { PVE::QemuServer::Blockdev::detach($vmid, $fmt_blockdev->{'node-name'}); }; + warn "detaching block node for $file_blockdev->{filename} failed - $@" if $@; + + #delete the file (don't use vdisk_free as we don't want to delete all snapshot chain) + print "delete old $file_blockdev->{filename}\n"; + + my $storage_name = PVE::Storage::parse_volume_id($drive->{file}); + + my $volid = $drive->{file}; + PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, 1); +} + +my sub blockdev_relative_backing_file { + my ($backing, $backed) = @_; + + my $backing_file = $backing->{filename}; + my $backed_file = $backed->{filename}; + + if (dirname($backing_file) eq dirname($backed_file)) { + # make backing file relative if in same directory + return basename($backing_file); + } + + return $backing_file; +} + +sub blockdev_replace { + my ( + $storecfg, + $vmid, + $machine_version, + $deviceid, + $drive, + $src_snap, + $target_snap, + $parent_snap, + ) = @_; + + print "blockdev replace $src_snap by $target_snap\n"; + + my $volid = $drive->{file}; + my $drive_id = PVE::QemuServer::Drive::get_drive_id($drive); + + my $src_name_options = {}; + my $src_blockdev_name; + if ($src_snap eq 'current') { + # there might be other nodes on top like zeroinit, look up the current node below throttle + $src_blockdev_name = + PVE::QemuServer::Blockdev::get_node_name_below_throttle($vmid, $deviceid, 1); + } else { + $src_name_options = { 'snapshot-name' => $src_snap }; + $src_blockdev_name = + PVE::QemuServer::Blockdev::get_node_name('fmt', $drive_id, $volid, $src_name_options); + } + + my $target_file_blockdev = generate_file_blockdev( + $storecfg, + $drive, + $machine_version, + { 'snapshot-name' => $target_snap }, + ); + my $target_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $target_file_blockdev, + { 'snapshot-name' => $target_snap }, + ); + + if ($target_snap eq 'current' || $src_snap eq 'current') { + #rename from|to current + + #add backing to target + if ($parent_snap) { + my $parent_fmt_nodename = PVE::QemuServer::Blockdev::get_node_name( + 'fmt', + $drive_id, + $volid, + { 'snapshot-name' => $parent_snap }, + ); + $target_fmt_blockdev->{backing} = $parent_fmt_nodename; + } + mon_cmd($vmid, 'blockdev-add', %$target_fmt_blockdev); + + #reopen the current throttlefilter nodename with the target fmt nodename + my $throttle_blockdev = PVE::QemuServer::Blockdev::generate_throttle_blockdev( + $drive, $target_fmt_blockdev->{'node-name'}, {}, + ); + mon_cmd($vmid, 'blockdev-reopen', options => [$throttle_blockdev]); + } else { + #intermediate snapshot + mon_cmd($vmid, 'blockdev-add', %$target_fmt_blockdev); + + #reopen the parent node with the new target fmt backing node + my $parent_file_blockdev = generate_file_blockdev( + $storecfg, + $drive, + $machine_version, + { 'snapshot-name' => $parent_snap }, + ); + my $parent_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $parent_file_blockdev, + { 'snapshot-name' => $parent_snap }, + ); + $parent_fmt_blockdev->{backing} = $target_fmt_blockdev->{'node-name'}; + mon_cmd($vmid, 'blockdev-reopen', options => [$parent_fmt_blockdev]); + + my $backing_file = + blockdev_relative_backing_file($target_file_blockdev, $parent_file_blockdev); + + #change backing-file in qcow2 metadatas + mon_cmd( + $vmid, 'change-backing-file', + device => $deviceid, + 'image-node-name' => $parent_fmt_blockdev->{'node-name'}, + 'backing-file' => $backing_file, + ); + } + + # delete old file|fmt nodes + eval { PVE::QemuServer::Blockdev::detach($vmid, $src_blockdev_name); }; + warn "detaching block node for $src_snap failed - $@" if $@; +} + +sub blockdev_commit { + my ($storecfg, $vmid, $machine_version, $deviceid, $drive, $src_snap, $target_snap) = @_; + + my $volid = $drive->{file}; + my $target_was_read_only; + + print "block-commit $src_snap to base:$target_snap\n"; + + my $target_file_blockdev = generate_file_blockdev( + $storecfg, + $drive, + $machine_version, + { 'snapshot-name' => $target_snap }, + ); + my $target_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $target_file_blockdev, + { 'snapshot-name' => $target_snap }, + ); + + my $src_file_blockdev = generate_file_blockdev( + $storecfg, + $drive, + $machine_version, + { 'snapshot-name' => $src_snap }, + ); + my $src_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $src_file_blockdev, + { 'snapshot-name' => $src_snap }, + ); + + if ($target_was_read_only = $target_fmt_blockdev->{'read-only'}) { + print "reopening internal read-only block node for '$target_snap' as writable\n"; + $target_fmt_blockdev->{'read-only'} = JSON::false; + $target_file_blockdev->{'read-only'} = JSON::false; + mon_cmd($vmid, 'blockdev-reopen', options => [$target_fmt_blockdev]); + # For the guest, the drive is still read-only, because the top throttle node is. + } + + eval { + my $job_id = "commit-$deviceid"; + my $jobs = {}; + my $opts = { 'job-id' => $job_id, device => $deviceid }; + + $opts->{'base-node'} = $target_fmt_blockdev->{'node-name'}; + $opts->{'top-node'} = $src_fmt_blockdev->{'node-name'}; + + mon_cmd($vmid, "block-commit", %$opts); + $jobs->{$job_id} = {}; + + # If the 'current' state is committed to its backing snapshot, the job will not complete + # automatically, because there is a writer, i.e. the guest. It is necessary to use the + # 'complete' completion mode, so that the 'current' block node is replaced with the backing + # node upon completion. Like that, IO after the commit operation will already land in the + # backing node, which will be renamed since it will be the new top of the chain (done by the + # caller). + # + # For other snapshots in the chain, it can be assumed that they have no writer, so + # 'block-commit' will complete automatically. + my $complete = $src_snap && $src_snap ne 'current' ? 'auto' : 'complete'; + + PVE::QemuServer::BlockJob::monitor($vmid, undef, $jobs, $complete, 0, 'commit'); + + blockdev_delete( + $storecfg, $vmid, $drive, $src_file_blockdev, $src_fmt_blockdev, $src_snap, + ); + }; + my $err = $@; + + if ($target_was_read_only) { + # Even when restoring the read-only flag on the format and file nodes fails, the top + # throttle node still has it, ensuring it is read-only for the guest. + print "re-applying read-only flag for internal block node for '$target_snap'\n"; + $target_fmt_blockdev->{'read-only'} = JSON::true; + $target_file_blockdev->{'read-only'} = JSON::true; + eval { mon_cmd($vmid, 'blockdev-reopen', options => [$target_fmt_blockdev]); }; + print "failed to re-apply read-only flag - $@\n" if $@; + } + + die $err if $err; +} + +sub blockdev_stream { + my ($storecfg, $vmid, $machine_version, $deviceid, $drive, $snap, $parent_snap, $target_snap) = + @_; + + my $volid = $drive->{file}; + $target_snap = undef if $target_snap eq 'current'; + + my $parent_file_blockdev = generate_file_blockdev( + $storecfg, + $drive, + $machine_version, + { 'snapshot-name' => $parent_snap }, + ); + my $parent_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $parent_file_blockdev, + { 'snapshot-name' => $parent_snap }, + ); + + my $target_file_blockdev = generate_file_blockdev( + $storecfg, + $drive, + $machine_version, + { 'snapshot-name' => $target_snap }, + ); + my $target_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $target_file_blockdev, + { 'snapshot-name' => $target_snap }, + ); + + my $snap_file_blockdev = + generate_file_blockdev($storecfg, $drive, $machine_version, { 'snapshot-name' => $snap }); + my $snap_fmt_blockdev = generate_format_blockdev( + $storecfg, + $drive, + $snap_file_blockdev, + { 'snapshot-name' => $snap }, + ); + + my $backing_file = blockdev_relative_backing_file($parent_file_blockdev, $target_file_blockdev); + + my $job_id = "stream-$deviceid"; + my $jobs = {}; + my $options = { 'job-id' => $job_id, device => $target_fmt_blockdev->{'node-name'} }; + $options->{'base-node'} = $parent_fmt_blockdev->{'node-name'}; + $options->{'backing-file'} = $backing_file; + + mon_cmd($vmid, 'block-stream', %$options); + $jobs->{$job_id} = {}; + + PVE::QemuServer::BlockJob::monitor($vmid, undef, $jobs, 'auto', 0, 'stream'); + + blockdev_delete($storecfg, $vmid, $drive, $snap_file_blockdev, $snap_fmt_blockdev, $snap); +} + +1; -- 2.47.3