]> git.proxmox.com Git - qemu-server.git/blobdiff - PVE/QemuServer.pm
migrate: keep VM paused after migration if it was before
[qemu-server.git] / PVE / QemuServer.pm
index afe4878a4a7ce6f2211685678cf21909865d73a1..0be6be909ae21336252cdcdae6839a5147f6e638 100644 (file)
@@ -119,25 +119,10 @@ PVE::JSONSchema::register_standard_option('pve-qemu-machine', {
        optional => 1,
 });
 
-
-sub map_storage {
-    my ($map, $source) = @_;
-
-    return $source if !defined($map);
-
-    return $map->{entries}->{$source}
-       if $map->{entries} && defined($map->{entries}->{$source});
-
-    return $map->{default} if $map->{default};
-
-    # identity (fallback)
-    return $source;
-}
-
 PVE::JSONSchema::register_standard_option('pve-targetstorage', {
     description => "Mapping from source to target storages. Providing only a single storage ID maps all source storages to that storage. Providing the special value '1' will map each source storage to itself.",
     type => 'string',
-    format => 'storagepair-list',
+    format => 'storage-pair-list',
     optional => 1,
 });
 
@@ -286,6 +271,21 @@ my $rng_fmt = {
     },
 };
 
+my $meta_info_fmt = {
+    'ctime' => {
+       type => 'integer',
+       description => "The guest creation timestamp as UNIX epoch time",
+       minimum => 0,
+       optional => 1,
+    },
+    'creation-qemu' => {
+       type => 'string',
+       description => "The QEMU (machine) version from the time this VM was created.",
+       pattern => '\d+(\.\d+)+',
+       optional => 1,
+    },
+};
+
 my $confdesc = {
     onboot => {
        optional => 1,
@@ -336,7 +336,7 @@ my $confdesc = {
        verbose_description => "CPU weight for a VM. Argument is used in the kernel fair scheduler."
            ." The larger the number is, the more CPU time this VM gets. Number is relative to"
            ." weights of all the other running VMs.",
-       minimum => 2,
+       minimum => 1,
        maximum => 262144,
        default => 'cgroup v1: 1024, cgroup v2: 100',
     },
@@ -707,6 +707,12 @@ EODESCR
        description => "Configure a VirtIO-based Random Number Generator.",
        optional => 1,
     },
+    meta => {
+       type => 'string',
+       format => $meta_info_fmt,
+       description => "Some (read-only) meta-information about this guest.",
+       optional => 1,
+    },
 };
 
 my $cicustom_fmt = {
@@ -734,6 +740,14 @@ my $cicustom_fmt = {
        format => 'pve-volume-id',
        format_description => 'volume',
     },
+    vendor => {
+    type => 'string',
+    optional => 1,
+    description => 'Specify a custom file containing all vendor data passed to the VM via'
+     .' cloud-init.',
+    format => 'pve-volume-id',
+    format_description => 'volume',
+    },
 };
 PVE::JSONSchema::register_format('pve-qm-cicustom', $cicustom_fmt);
 
@@ -900,13 +914,10 @@ my $net_fmt = {
         default_key => 1,
     },
     (map { $_ => { keyAlias => 'model', alias => 'macaddr' }} @$nic_model_list),
-    bridge => {
-       type => 'string',
+    bridge => get_standard_option('pve-bridge-id', {
        description => $net_fmt_bridge_descr,
-       format_description => 'bridge',
-       pattern => '[-_.\w\d]+',
        optional => 1,
-    },
+    }),
     queues => {
        type => 'integer',
        minimum => 0, maximum => 16,
@@ -1025,11 +1036,17 @@ PVE::JSONSchema::register_format('pve-volume-id-or-qm-path', \&verify_volume_id_
 sub verify_volume_id_or_qm_path {
     my ($volid, $noerr) = @_;
 
-    if ($volid eq 'none' || $volid eq 'cdrom' || $volid =~ m|^/|) {
-       return $volid;
-    }
+    return $volid if $volid eq 'none' || $volid eq 'cdrom';
+
+    return verify_volume_id_or_absolute_path($volid, $noerr);
+}
+
+PVE::JSONSchema::register_format('pve-volume-id-or-absolute-path', \&verify_volume_id_or_absolute_path);
+sub verify_volume_id_or_absolute_path {
+    my ($volid, $noerr) = @_;
+
+    return $volid if $volid =~ m|^/|;
 
-    # if its neither 'none' nor 'cdrom' nor a path, check if its a volume-id
     $volid = eval { PVE::JSONSchema::check_format('pve-volume-id', $volid, '') };
     if ($@) {
        return if $noerr;
@@ -1384,9 +1401,9 @@ sub scsi_inquiry {
     # see /usr/include/scsi/sg.h
     my $sg_io_hdr_t = "i i C C s I P P P I I i P C C C C S S i I I";
 
-    my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
-                     length($sensebuf), 0, length($buf), $buf,
-                     $cmd, $sensebuf, 6000);
+    my $packet = pack(
+       $sg_io_hdr_t, ord('S'), -3, length($cmd), length($sensebuf), 0, length($buf), $buf, $cmd, $sensebuf, 6000
+    );
 
     $ret = ioctl($fh, $SG_IO, $packet);
     if (!$ret) {
@@ -1401,11 +1418,10 @@ sub scsi_inquiry {
     }
 
     my $res = {};
-    (my $byte0, my $byte1, $res->{vendor},
-     $res->{product}, $res->{revision}) = unpack("C C x6 A8 A16 A4", $buf);
+    $res->@{qw(type removable vendor product revision)} = unpack("C C x6 A8 A16 A4", $buf);
 
-    $res->{removable} = $byte1 & 128 ? 1 : 0;
-    $res->{type} = $byte0 & 31;
+    $res->{removable} = $res->{removable} & 128 ? 1 : 0;
+    $res->{type} &= 0x1F;
 
     return $res;
 }
@@ -1437,7 +1453,7 @@ sub print_tabletdevice_full {
 }
 
 sub print_keyboarddevice_full {
-    my ($conf, $arch, $machine) = @_;
+    my ($conf, $arch) = @_;
 
     return if $arch ne 'aarch64';
 
@@ -2108,6 +2124,53 @@ sub parse_rng {
     return $res;
 }
 
+sub parse_meta_info {
+    my ($value) = @_;
+
+    return if !$value;
+
+    my $res = eval { parse_property_string($meta_info_fmt, $value) };
+    warn $@ if $@;
+    return $res;
+}
+
+sub new_meta_info_string {
+    my () = @_; # for now do not allow to override any value
+
+    return PVE::JSONSchema::print_property_string(
+       {
+           'creation-qemu' => kvm_user_version(),
+           ctime => "". int(time()),
+       },
+       $meta_info_fmt
+    );
+}
+
+sub qemu_created_version_fixups {
+    my ($conf, $forcemachine, $kvmver) = @_;
+
+    my $meta = parse_meta_info($conf->{meta}) // {};
+    my $forced_vers = PVE::QemuServer::Machine::extract_version($forcemachine);
+
+    # check if we need to apply some handling for VMs that always use the latest machine version but
+    # had a machine version transition happen that affected HW such that, e.g., an OS config change
+    # would be required (we do not want to pin machine version for non-windows OS type)
+    if (
+       (!defined($conf->{machine}) || $conf->{machine} =~ m/^(?:pc|q35|virt)$/) # non-versioned machine
+       && (!defined($meta->{'creation-qemu'}) || !min_version($meta->{'creation-qemu'}, 6, 1)) # created before 6.1
+       && (!$forced_vers || min_version($forced_vers, 6, 1)) # handle snapshot-rollback/migrations
+       && min_version($kvmver, 6, 1) # only need to apply the change since 6.1
+    ) {
+       my $q35 = PVE::QemuServer::Machine::machine_type_is_q35($conf);
+       if ($q35 && $conf->{ostype} && $conf->{ostype} eq 'l26') {
+           # this changed to default-on in Q 6.1 for q35 machines, it will mess with PCI slot view
+           # and thus with the predictable interface naming of systemd
+           return ['-global', 'ICH9-LPC.acpi-pci-hotplug-with-bridge-support=off'];
+       }
+    }
+    return;
+}
+
 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
 sub verify_usb_device {
     my ($value, $noerr) = @_;
@@ -2121,7 +2184,7 @@ sub verify_usb_device {
 
 # add JSON properties for create and set function
 sub json_config_properties {
-    my $prop = shift;
+    my ($prop, $with_disk_alloc) = @_;
 
     my $skip_json_config_opts = {
        parent => 1,
@@ -2129,16 +2192,54 @@ sub json_config_properties {
        vmstate => 1,
        runningmachine => 1,
        runningcpu => 1,
+       meta => 1,
     };
 
     foreach my $opt (keys %$confdesc) {
        next if $skip_json_config_opts->{$opt};
-       $prop->{$opt} = $confdesc->{$opt};
+
+       if ($with_disk_alloc && is_valid_drivename($opt)) {
+           $prop->{$opt} = $PVE::QemuServer::Drive::drivedesc_hash_with_alloc->{$opt};
+       } else {
+           $prop->{$opt} = $confdesc->{$opt};
+       }
     }
 
     return $prop;
 }
 
+# Properties that we can read from an OVF file
+sub json_ovf_properties {
+    my $prop = {};
+
+    for my $device (PVE::QemuServer::Drive::valid_drive_names()) {
+       $prop->{$device} = {
+           type => 'string',
+           format => 'pve-volume-id-or-absolute-path',
+           description => "Disk image that gets imported to $device",
+           optional => 1,
+       };
+    }
+
+    $prop->{cores} = {
+       type => 'integer',
+       description => "The number of CPU cores.",
+       optional => 1,
+    };
+    $prop->{memory} = {
+       type => 'integer',
+       description => "Amount of RAM for the VM in MB.",
+       optional => 1,
+    };
+    $prop->{name} = {
+       type => 'string',
+       description => "Name of the VM.",
+       optional => 1,
+    };
+
+    return $prop;
+}
+
 # return copy of $confdesc_cloudinit to generate documentation
 sub cloudinit_config_properties {
 
@@ -2254,7 +2355,7 @@ sub destroy_vm {
 }
 
 sub parse_vm_config {
-    my ($filename, $raw) = @_;
+    my ($filename, $raw, $strict) = @_;
 
     return if !defined($raw);
 
@@ -2264,6 +2365,16 @@ sub parse_vm_config {
        pending => {},
     };
 
+    my $handle_error = sub {
+       my ($msg) = @_;
+
+       if ($strict) {
+           die $msg;
+       } else {
+           warn $msg;
+       }
+    };
+
     $filename =~ m|/qemu-server/(\d+)\.conf$|
        || die "got strange filename '$filename'";
 
@@ -2318,14 +2429,14 @@ sub parse_vm_config {
            if ($section eq 'pending') {
                $conf->{delete} = $value; # we parse this later
            } else {
-               warn "vm $vmid - propertry 'delete' is only allowed in [PENDING]\n";
+               $handle_error->("vm $vmid - property 'delete' is only allowed in [PENDING]\n");
            }
        } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(.+?)\s*$/) {
            my $key = $1;
            my $value = $2;
            eval { $value = check_type($key, $value); };
            if ($@) {
-               warn "vm $vmid - unable to parse value of '$key' - $@";
+               $handle_error->("vm $vmid - unable to parse value of '$key' - $@");
            } else {
                $key = 'ide2' if $key eq 'cdrom';
                my $fmt = $confdesc->{$key}->{format};
@@ -2335,7 +2446,7 @@ sub parse_vm_config {
                        $v->{file} = $volid;
                        $value = print_drive($v);
                    } else {
-                       warn "vm $vmid - unable to parse value of '$key'\n";
+                       $handle_error->("vm $vmid - unable to parse value of '$key'\n");
                        next;
                    }
                }
@@ -2343,7 +2454,7 @@ sub parse_vm_config {
                $conf->{$key} = $value;
            }
        } else {
-           warn "vm $vmid - unable to parse config: $line\n";
+           $handle_error->("vm $vmid - unable to parse config: $line\n");
        }
     }
 
@@ -3325,8 +3436,28 @@ sub query_understood_cpu_flags {
 
 my sub get_cpuunits {
     my ($conf) = @_;
-    return $conf->{cpuunits} // (PVE::CGroup::cgroup_mode() == 2 ? 100 : 1024);
+    my $is_cgroupv2 = PVE::CGroup::cgroup_mode() == 2;
+
+    my $cpuunits = $conf->{cpuunits};
+    return $is_cgroupv2 ? 100 : 1024 if !defined($cpuunits);
+
+    if ($is_cgroupv2) {
+       $cpuunits = 10000 if $cpuunits >= 10000; # v1 can be higher, so clamp v2 there
+    } else {
+       $cpuunits = 2 if $cpuunits < 2; # v2 can be lower, so clamp v1 there
+    }
+    return $cpuunits;
 }
+
+# Since commit 277d33454f77ec1d1e0bc04e37621e4dd2424b67 in pve-qemu, smm is not off by default
+# anymore. But smm=off seems to be required when using SeaBIOS and serial display.
+my sub should_disable_smm {
+    my ($conf, $vga) = @_;
+
+    return (!defined($conf->{bios}) || $conf->{bios} eq 'seabios') &&
+       $vga->{type} && $vga->{type} =~ m/^(serial\d+|none)$/;
+}
+
 sub config_to_command {
     my ($storecfg, $vmid, $conf, $defaults, $forcemachine, $forcecpu,
         $pbs_backing) = @_;
@@ -3393,8 +3524,6 @@ sub config_to_command {
     my $use_old_bios_files = undef;
     ($use_old_bios_files, $machine_type) = qemu_use_old_bios_files($machine_type);
 
-    my $cpuunits = get_cpuunits($conf);
-
     push @$cmd, $kvm_binary;
 
     push @$cmd, '-id', $vmid;
@@ -3503,6 +3632,10 @@ sub config_to_command {
        }
     }
 
+    if (defined(my $fixups = qemu_created_version_fixups($conf, $forcemachine, $kvmver))) {
+       push @$cmd, $fixups->@*;
+    }
+
     if ($conf->{vmgenid}) {
        push @$devices, '-device', 'vmgenid,guid='.$conf->{vmgenid};
     }
@@ -3922,6 +4055,8 @@ sub config_to_command {
        push @$machineFlags, 'accel=tcg';
     }
 
+    push @$machineFlags, 'smm=off' if should_disable_smm($conf, $vga);
+
     my $machine_type_min = $machine_type;
     if ($add_pve_version) {
        $machine_type_min =~ s/\+pve\d+$//;
@@ -4157,6 +4292,7 @@ sub vm_deviceunplug {
        my $device = parse_drive($deviceid, $conf->{$deviceid});
 
        qemu_devicedel($vmid, $deviceid);
+       qemu_devicedelverify($vmid, $deviceid);
        qemu_drivedel($vmid, $deviceid);
        qemu_deletescsihw($conf, $vmid, $deviceid);
 
@@ -4841,10 +4977,13 @@ sub vmconfig_hotplug_pending {
                die "skip\n" if !$hotplug_features->{memory};
                $value = PVE::QemuServer::Memory::qemu_memory_hotplug($vmid, $conf, $defaults, $opt, $value);
            } elsif ($opt eq 'cpuunits') {
-               $cgroup->change_cpu_shares($conf->{pending}->{$opt}, 1024);
+               my $new_cpuunits = get_cpuunits({ $opt => $conf->{pending}->{$opt} }); # to clamp
+               $cgroup->change_cpu_shares($new_cpuunits, 1024);
            } elsif ($opt eq 'cpulimit') {
                my $cpulimit = $conf->{pending}->{$opt} == 0 ? -1 : int($conf->{pending}->{$opt} * 100000);
                $cgroup->change_cpu_quota($cpulimit, 100000);
+           } elsif ($opt eq 'agent') {
+               vmconfig_update_agent($conf, $opt, $value);
            } else {
                die "skip\n";  # skip non-hot-pluggable options
            }
@@ -4904,6 +5043,8 @@ sub vmconfig_delete_or_detach_drive {
 sub vmconfig_apply_pending {
     my ($vmid, $conf, $storecfg, $errors) = @_;
 
+    return if !scalar(keys %{$conf->{pending}});
+
     my $add_apply_error = sub {
        my ($opt, $msg) = @_;
        my $err_msg = "unable to apply pending change $opt : $msg";
@@ -5004,6 +5145,29 @@ sub vmconfig_update_net {
     }
 }
 
+sub vmconfig_update_agent {
+    my ($conf, $opt, $value) = @_;
+
+    die "skip\n" if !$conf->{$opt};
+
+    my $hotplug_options = { fstrim_cloned_disks => 1 };
+
+    my $old_agent = parse_guest_agent($conf);
+    my $agent = parse_guest_agent({$opt => $value});
+
+    for my $option (keys %$agent) { # added/changed options
+       next if defined($hotplug_options->{$option});
+       die "skip\n" if safe_string_ne($agent->{$option}, $old_agent->{$option});
+    }
+
+    for my $option (keys %$old_agent) { # removed options
+       next if defined($hotplug_options->{$option});
+       die "skip\n" if safe_string_ne($old_agent->{$option}, $agent->{$option});
+    }
+
+    return; # either no actual change (e.g., format string reordered) or just hotpluggable changes
+}
+
 sub vmconfig_update_disk {
     my ($storecfg, $conf, $hotplug, $vmid, $opt, $value, $arch, $machine_type) = @_;
 
@@ -5121,6 +5285,7 @@ sub vm_migrate_get_nbd_disks {
        my ($ds, $drive) = @_;
 
        return if drive_is_cdrom($drive);
+       return if $ds eq 'tpmstate0';
 
        my $volid = $drive->{file};
 
@@ -5142,11 +5307,9 @@ sub vm_migrate_get_nbd_disks {
 sub vm_migrate_alloc_nbd_disks {
     my ($storecfg, $vmid, $source_volumes, $storagemap) = @_;
 
-    my $format = undef;
-
     my $nbd = {};
     foreach my $opt (sort keys %$source_volumes) {
-       my ($volid, $storeid, $volname, $drive, $use_existing) = @{$source_volumes->{$opt}};
+       my ($volid, $storeid, $volname, $drive, $use_existing, $format) = @{$source_volumes->{$opt}};
 
        if ($use_existing) {
            $nbd->{$opt}->{drivestr} = print_drive($drive);
@@ -5155,16 +5318,26 @@ sub vm_migrate_alloc_nbd_disks {
            next;
        }
 
-       # If a remote storage is specified and the format of the original
-       # volume is not available there, fall back to the default format.
-       # Otherwise use the same format as the original.
+       # storage mapping + volname = regular migration
+       # storage mapping + format = remote migration
+       # order of precedence, filtered by whether storage supports it:
+       # 1. explicit requested format
+       # 2. format of current volume
+       # 3. default format of storage
        if (!$storagemap->{identity}) {
-           $storeid = map_storage($storagemap, $storeid);
+           $storeid = PVE::JSONSchema::map_id($storagemap, $storeid);
            my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
-           my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
-           my $fileFormat = qemu_img_format($scfg, $volname);
-           $format = (grep {$fileFormat eq $_} @{$validFormats}) ? $fileFormat : $defFormat;
+           if (!$format || !grep { $format eq $_ } @$validFormats) {
+               if ($volname) {
+                   my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
+                   my $fileFormat = qemu_img_format($scfg, $volname);
+                   $format = $fileFormat
+                       if grep { $fileFormat eq $_ } @$validFormats;
+               }
+               $format //= $defFormat;
+           }
        } else {
+           # can't happen for remote migration, so $volname is always defined
            my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
            $format = qemu_img_format($scfg, $volname);
        }
@@ -5252,7 +5425,8 @@ sub vm_start {
 #   network => CIDR of migration network
 #   type => secure/insecure - tunnel over encrypted connection or plain-text
 #   nbd_proto_version => int, 0 for TCP, 1 for UNIX
-#   replicated_volumes = which volids should be re-used with bitmaps for nbd migration
+#   replicated_volumes => which volids should be re-used with bitmaps for nbd migration
+#   tpmstate_vol => new volid of tpmstate0, not yet contained in config
 sub vm_start_nolock {
     my ($storecfg, $vmid, $conf, $params, $migrate_opts) = @_;
 
@@ -5277,6 +5451,13 @@ sub vm_start_nolock {
     # this way we can reuse the old ISO with the correct config
     PVE::QemuServer::Cloudinit::generate_cloudinitconfig($conf, $vmid) if !$migratedfrom;
 
+    # override TPM state vol if migrated, conf is out of date still
+    if (my $tpmvol = $migrate_opts->{tpmstate_vol}) {
+        my $parsed = parse_drive("tpmstate0", $conf->{tpmstate0});
+        $parsed->{file} = $tpmvol;
+        $conf->{tpmstate0} = print_drive($parsed);
+    }
+
     my $defaults = load_defaults();
 
     # set environment variable useful inside network script
@@ -5384,7 +5565,12 @@ sub vm_start_nolock {
        $pci_devices->{$i} = parse_hostpci($dev);
     }
 
-    my $pci_id_list = [ map { $_->{id} } map { $_->{pciid}->@* } values $pci_devices->%* ];
+    # do not reserve pciid for mediated devices, sysfs will error out for duplicate assignment
+    my $real_pci_devices = [ grep { !(defined($_->{mdev}) && scalar($_->{pciid}->@*) == 1) } values $pci_devices->%* ];
+
+    # map to a flat list of pci ids
+    my $pci_id_list = [ map { $_->{id} } map { $_->{pciid}->@* } $real_pci_devices->@* ];
+
     # reserve all PCI IDs before actually doing anything with them
     PVE::QemuServer::PCI::reserve_pci_usage($pci_id_list, $vmid, $start_timeout);
 
@@ -5409,7 +5595,7 @@ sub vm_start_nolock {
     };
     # Issues with the above 'stop' not being fully completed are extremely rare, a very low
     # timeout should be more than enough here...
-    PVE::Systemd::wait_for_unit_removed("$vmid.scope", 5);
+    PVE::Systemd::wait_for_unit_removed("$vmid.scope", 20);
 
     my $cpuunits = get_cpuunits($conf);
 
@@ -5434,7 +5620,6 @@ sub vm_start_nolock {
     );
 
     if (PVE::CGroup::cgroup_mode() == 2) {
-       $cpuunits = 10000 if $cpuunits >= 10000; # else we get an error
        $systemd_properties{CPUWeight} = $cpuunits;
     } else {
        $systemd_properties{CPUShares} = $cpuunits;
@@ -5606,9 +5791,8 @@ sub vm_commandline {
     my ($storecfg, $vmid, $snapname) = @_;
 
     my $conf = PVE::QemuConfig->load_config($vmid);
-    my $forcemachine;
-    my $forcecpu;
 
+    my ($forcemachine, $forcecpu);
     if ($snapname) {
        my $snapshot = $conf->{snapshots}->{$snapname};
        die "snapshot '$snapname' does not exist\n" if !defined($snapshot);
@@ -5624,8 +5808,7 @@ sub vm_commandline {
 
     my $defaults = load_defaults();
 
-    my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults,
-       $forcemachine, $forcecpu);
+    my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine, $forcecpu);
 
     return PVE::Tools::cmd2string($cmd);
 }
@@ -6091,8 +6274,15 @@ my $restore_cleanup_oldconf = sub {
 my $parse_backup_hints = sub {
     my ($rpcenv, $user, $storecfg, $fh, $devinfo, $options) = @_;
 
-    my $virtdev_hash = {};
+    my $check_storage = sub { # assert if an image can be allocate
+       my ($storeid, $scfg) = @_;
+       die "Content type 'images' is not available on storage '$storeid'\n"
+           if !$scfg->{content}->{images};
+       $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace'])
+           if $user ne 'root@pam';
+    };
 
+    my $virtdev_hash = {};
     while (defined(my $line = <$fh>)) {
        if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
            my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
@@ -6110,22 +6300,22 @@ my $parse_backup_hints = sub {
            $devinfo->{$devname}->{format} = $format;
            $devinfo->{$devname}->{storeid} = $storeid;
 
-           # check permission on storage
-           my $pool = $options->{pool}; # todo: do we need that?
-           if ($user ne 'root@pam') {
-               $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
-           }
+           my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
+           $check_storage->($storeid, $scfg); # permission and content type check
 
            $virtdev_hash->{$virtdev} = $devinfo->{$devname};
        } elsif ($line =~ m/^((?:ide|sata|scsi)\d+):\s*(.*)\s*$/) {
            my $virtdev = $1;
            my $drive = parse_drive($virtdev, $2);
+
            if (drive_is_cloudinit($drive)) {
                my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
                $storeid = $options->{storage} if defined ($options->{storage});
                my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
                my $format = qemu_img_format($scfg, $volname); # has 'raw' fallback
 
+               $check_storage->($storeid, $scfg); # permission and content type check
+
                $virtdev_hash->{$virtdev} = {
                    format => $format,
                    storeid => $storeid,
@@ -6480,7 +6670,6 @@ sub restore_proxmox_backup_archive {
        my $index = PVE::Tools::file_get_contents($index_fn);
        $index = decode_json($index);
 
-       # print Dumper($index);
        foreach my $info (@{$index->{files}}) {
            if ($info->{filename} =~ m/^(drive-\S+).img.fidx$/) {
                my $devname = $1;
@@ -6684,7 +6873,7 @@ sub pbs_live_restore {
     my $err = $@;
 
     if ($err) {
-       warn "An error occured during live-restore: $err\n";
+       warn "An error occurred during live-restore: $err\n";
        _do_vm_stop($storecfg, $vmid, 1, 1, 10, 0, 1);
        die "live-restore failed\n";
     }
@@ -7127,7 +7316,7 @@ sub qemu_img_convert {
        $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
        $src_is_iscsi = ($src_path =~ m|^iscsi://|);
        $cachemode = 'none' if $src_scfg->{type} eq 'zfspool';
-    } elsif (-f $src_volid) {
+    } elsif (-f $src_volid || -b $src_volid) {
        $src_path = $src_volid;
        if ($src_path =~ m/\.($PVE::QemuServer::Drive::QEMU_FORMAT_RE)$/) {
            $src_format = $1;
@@ -7335,9 +7524,11 @@ sub qemu_drive_mirror_monitor {
                    if ($agent_running) {
                        print "freeze filesystem\n";
                        eval { mon_cmd($vmid, "guest-fsfreeze-freeze"); };
+                       warn $@ if $@;
                    } else {
                        print "suspend vm\n";
                        eval { PVE::QemuServer::vm_suspend($vmid, 1); };
+                       warn $@ if $@;
                    }
 
                    # if we clone a disk for a new target vm, we don't switch the disk
@@ -7346,9 +7537,11 @@ sub qemu_drive_mirror_monitor {
                    if ($agent_running) {
                        print "unfreeze filesystem\n";
                        eval { mon_cmd($vmid, "guest-fsfreeze-thaw"); };
+                       warn $@ if $@;
                    } else {
                        print "resume vm\n";
-                       eval {  PVE::QemuServer::vm_resume($vmid, 1, 1); };
+                       eval { PVE::QemuServer::vm_resume($vmid, 1, 1); };
+                       warn $@ if $@;
                    }
 
                    last;
@@ -7420,13 +7613,37 @@ sub qemu_blockjobs_cancel {
 }
 
 sub clone_disk {
-    my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
-       $newvmid, $storage, $format, $full, $newvollist, $jobs, $completion, $qga, $bwlimit, $conf) = @_;
+    my ($storecfg, $source, $dest, $full, $newvollist, $jobs, $completion, $qga, $bwlimit) = @_;
+
+    my ($vmid, $running) = $source->@{qw(vmid running)};
+    my ($src_drivename, $drive, $snapname) = $source->@{qw(drivename drive snapname)};
+
+    my ($newvmid, $dst_drivename, $efisize) = $dest->@{qw(vmid drivename efisize)};
+    my ($storage, $format) = $dest->@{qw(storage format)};
+
+    my $use_drive_mirror = $full && $running && $src_drivename && !$snapname;
+
+    if ($src_drivename && $dst_drivename && $src_drivename ne $dst_drivename) {
+       die "cloning from/to EFI disk requires EFI disk\n"
+           if $src_drivename eq 'efidisk0' || $dst_drivename eq 'efidisk0';
+       die "cloning from/to TPM state requires TPM state\n"
+           if $src_drivename eq 'tpmstate0' || $dst_drivename eq 'tpmstate0';
+
+       # This would lead to two device nodes in QEMU pointing to the same backing image!
+       die "cannot change drive name when cloning disk from/to the same VM\n"
+           if $use_drive_mirror && $vmid == $newvmid;
+    }
+
+    die "cannot move TPM state while VM is running\n"
+       if $use_drive_mirror && $src_drivename eq 'tpmstate0';
 
     my $newvolid;
 
+    print "create " . ($full ? 'full' : 'linked') . " clone of drive ";
+    print "$src_drivename " if $src_drivename;
+    print "($drive->{file})\n";
+
     if (!$full) {
-       print "create linked clone of drive $drivename ($drive->{file})\n";
        $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
        push @$newvollist, $newvolid;
     } else {
@@ -7436,7 +7653,6 @@ sub clone_disk {
 
        my $dst_format = resolve_dst_disk_format($storecfg, $storeid, $volname, $format);
 
-       print "create full clone of drive $drivename ($drive->{file})\n";
        my $name = undef;
        my $size = undef;
        if (drive_is_cloudinit($drive)) {
@@ -7447,9 +7663,10 @@ sub clone_disk {
            }
            $snapname = undef;
            $size = PVE::QemuServer::Cloudinit::CLOUDINIT_DISK_SIZE;
-       } elsif ($drivename eq 'efidisk0') {
-           $size = get_efivars_size($conf);
-       } elsif ($drivename eq 'tpmstate0') {
+       } elsif ($dst_drivename eq 'efidisk0') {
+           $size = $efisize or die "internal error - need to specify EFI disk size\n";
+       } elsif ($dst_drivename eq 'tpmstate0') {
+           $dst_format = 'raw';
            $size = PVE::QemuServer::Drive::TPMSTATE_DISK_SIZE;
        } else {
            ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 10);
@@ -7472,43 +7689,43 @@ sub clone_disk {
        }
 
        my $sparseinit = PVE::Storage::volume_has_feature($storecfg, 'sparseinit', $newvolid);
-       if (!$running || $snapname) {
+       if ($use_drive_mirror) {
+           qemu_drive_mirror($vmid, $src_drivename, $newvolid, $newvmid, $sparseinit, $jobs,
+               $completion, $qga, $bwlimit);
+       } else {
            # TODO: handle bwlimits
-           if ($drivename eq 'efidisk0') {
+           if ($dst_drivename eq 'efidisk0') {
                # the relevant data on the efidisk may be smaller than the source
                # e.g. on RBD/ZFS, so we use dd to copy only the amount
                # that is given by the OVMF_VARS.fd
-               my $src_path = PVE::Storage::path($storecfg, $drive->{file});
+               my $src_path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
                my $dst_path = PVE::Storage::path($storecfg, $newvolid);
 
+               my $src_format = (PVE::Storage::parse_volname($storecfg, $drive->{file}))[6];
+
                # better for Ceph if block size is not too small, see bug #3324
                my $bs = 1024*1024;
 
-               run_command(['qemu-img', 'dd', '-n', '-O', $dst_format, "bs=$bs", "osize=$size",
-                   "if=$src_path", "of=$dst_path"]);
+               my $cmd = ['qemu-img', 'dd', '-n', '-O', $dst_format];
+
+               if ($src_format eq 'qcow2' && $snapname) {
+                   die "cannot clone qcow2 EFI disk snapshot - requires QEMU >= 6.2\n"
+                       if !min_version(kvm_user_version(), 6, 2);
+                   push $cmd->@*, '-l', $snapname;
+               }
+               push $cmd->@*, "bs=$bs", "osize=$size", "if=$src_path", "of=$dst_path";
+               run_command($cmd);
            } else {
                qemu_img_convert($drive->{file}, $newvolid, $size, $snapname, $sparseinit);
            }
-       } else {
-
-           die "cannot move TPM state while VM is running\n" if $drivename eq 'tpmstate0';
-
-           my $kvmver = get_running_qemu_version ($vmid);
-           if (!min_version($kvmver, 2, 7)) {
-               die "drive-mirror with iothread requires qemu version 2.7 or higher\n"
-                   if $drive->{iothread};
-           }
-
-           qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid, $sparseinit, $jobs,
-               $completion, $qga, $bwlimit);
        }
     }
 
 no_data_clone:
     my ($size) = eval { PVE::Storage::volume_size_info($storecfg, $newvolid, 10) };
 
-    my $disk = $drive;
-    $disk->{format} = undef;
+    my $disk = dclone($drive);
+    delete $disk->{format};
     $disk->{file} = $newvolid;
     $disk->{size} = $size if defined($size);
 
@@ -7544,9 +7761,10 @@ sub qemu_use_old_bios_files {
 }
 
 sub get_efivars_size {
-    my ($conf) = @_;
+    my ($conf, $efidisk) = @_;
+
     my $arch = get_vm_arch($conf);
-    my $efidisk = $conf->{efidisk0} ? parse_drive('efidisk0', $conf->{efidisk0}) : undef;
+    $efidisk //= $conf->{efidisk0} ? parse_drive('efidisk0', $conf->{efidisk0}) : undef;
     my $smm = PVE::QemuServer::Machine::machine_type_is_q35($conf);
     my (undef, $ovmf_vars) = get_ovmf_files($arch, $efidisk, $smm);
     die "uefi vars image '$ovmf_vars' not found\n" if ! -f $ovmf_vars;