[pve-devel] [PATCH pve-storage 1/1] add external snasphot support

[Alexandre Derumier via pve-devel <pve-devel@lists.proxmox.com>]

[-- Attachment #1: Type: message/rfc822, Size: 14039 bytes --]

From: Alexandre Derumier <alexandre.derumier@groupe-cyllene.com>
To: pve-devel@lists.proxmox.com
Subject: [PATCH pve-storage 1/1] add external snasphot support
Date: Thu, 19 Sep 2024 15:19:14 +0200
Message-ID: <20240919131915.2624831-2-alexandre.derumier@groupe-cyllene.com>

Signed-off-by: Alexandre Derumier <alexandre.derumier@groupe-cyllene.com>
---
 src/PVE/Storage/DirPlugin.pm |   1 +
 src/PVE/Storage/Plugin.pm    | 220 +++++++++++++++++++++++++++++++----
 2 files changed, 196 insertions(+), 25 deletions(-)

diff --git a/src/PVE/Storage/DirPlugin.pm b/src/PVE/Storage/DirPlugin.pm
index 2efa8d5..2bef673 100644
--- a/src/PVE/Storage/DirPlugin.pm
+++ b/src/PVE/Storage/DirPlugin.pm
@@ -80,6 +80,7 @@ sub options {
 	is_mountpoint => { optional => 1 },
 	bwlimit => { optional => 1 },
 	preallocation => { optional => 1 },
+	snapext => { optional => 1 },
    };
 }
 
diff --git a/src/PVE/Storage/Plugin.pm b/src/PVE/Storage/Plugin.pm
index 6444390..09cfcf7 100644
--- a/src/PVE/Storage/Plugin.pm
+++ b/src/PVE/Storage/Plugin.pm
@@ -214,6 +214,11 @@ my $defaultData = {
 	    maximum => 65535,
 	    optional => 1,
 	},
+        'snapext' => {
+	    type => 'boolean',
+	    description => 'enable external snapshot.',
+	    optional => 1,
+        },
     },
 };
 
@@ -695,7 +700,7 @@ sub get_subdir {
 }
 
 sub filesystem_path {
-    my ($class, $scfg, $volname, $snapname) = @_;
+    my ($class, $scfg, $volname, $snapname, $current_snap) = @_;
 
     my ($vtype, $name, $vmid, undef, undef, $isBase, $format) =
 	$class->parse_volname($volname);
@@ -703,7 +708,7 @@ sub filesystem_path {
     # Note: qcow2/qed has internal snapshot, so path is always
     # the same (with or without snapshot => same file).
     die "can't snapshot this image format\n"
-	if defined($snapname) && $format !~ m/^(qcow2|qed)$/;
+	if defined($snapname) && !$scfg->{snapext} && $format !~ m/^(qcow2|qed)$/;
 
     my $dir = $class->get_subdir($scfg, $vtype);
 
@@ -711,13 +716,27 @@ sub filesystem_path {
 
     my $path = "$dir/$name";
 
+    if($scfg->{snapext}) {
+	my $snappath = get_snap_path($path, $snapname);
+	if($snapname) {
+	    $path = $snappath;
+	} elsif ($current_snap) {
+	    $path = $current_snap->{file};
+	}
+    }
     return wantarray ? ($path, $vmid, $vtype) : $path;
 }
 
 sub path {
     my ($class, $scfg, $volname, $storeid, $snapname) = @_;
 
-    return $class->filesystem_path($scfg, $volname, $snapname);
+    #IMPROVE ME: faster way to find current snapshot? (search the most recent created snapshot file ? need to works with lvm volume too)
+    my $snapshots = undef;
+    if($scfg->{snapext}) {
+	$snapshots = $class->volume_snapshot_info($scfg, $storeid, $volname);
+    }
+
+    return $class->filesystem_path($scfg, $volname, $snapname, $snapshots->{current});
 }
 
 sub create_base {
@@ -1074,13 +1093,31 @@ sub volume_resize {
 sub volume_snapshot {
     my ($class, $scfg, $storeid, $volname, $snap) = @_;
 
-    die "can't snapshot this image format\n" if $volname !~ m/\.(qcow2|qed)$/;
+    die "can't snapshot this image format\n" if $volname !~ m/\.(raw|qcow2|qed)$/;
 
-    my $path = $class->filesystem_path($scfg, $volname);
+    die "external snapshot need to be enabled to snapshot .raw volumes\n" if !$scfg->{snapext};
+
+    if($scfg->{snapext}) {
+
+	my $path = $class->path($scfg, $volname, $storeid);
 
-    my $cmd = ['/usr/bin/qemu-img', 'snapshot','-c', $snap, $path];
+	my $snappath = get_snap_path($path, $snap);
+	my $format = ($class->parse_volname($volname))[6];
+
+	my $cmd = ['/usr/bin/qemu-img', 'create', '-b', $path,
+		   '-F', $format, '-f', 'qcow2', $snappath];
 
-    run_command($cmd);
+	my $options = "extended_l2=on,";
+	$options .= preallocation_cmd_option($scfg, 'qcow2');
+	push @$cmd, '-o', $options;
+	run_command($cmd);
+
+    } else {
+
+	my $path = $class->filesystem_path($scfg, $volname);
+	my $cmd = ['/usr/bin/qemu-img', 'snapshot','-c', $snap, $path];
+	run_command($cmd);
+    }
 
     return undef;
 }
@@ -1091,19 +1128,39 @@ sub volume_snapshot {
 sub volume_rollback_is_possible {
     my ($class, $scfg, $storeid, $volname, $snap, $blockers) = @_;
 
+    if ($scfg->{snapext}) {
+	#technically, we could manage multibranch, we it need lot more work for snapshot delete
+	my $path = $class->filesystem_path($scfg, $volname);
+	my $snappath = get_snap_path($path, $snap);
+
+	my $snapshots = $class->volume_snapshot_info($scfg, $storeid, $volname);
+	my $currentpath = $snapshots->{current}->{file};
+	return 1 if !-e $snappath || $currentpath eq $snappath;
+
+	die "can't rollback, '$snap' is not most recent snapshot on '$volname'\n";
+    }
+
     return 1;
 }
 
 sub volume_snapshot_rollback {
     my ($class, $scfg, $storeid, $volname, $snap) = @_;
 
-    die "can't rollback snapshot this image format\n" if $volname !~ m/\.(qcow2|qed)$/;
+    die "can't rollback snapshot this image format\n" if $volname !~ m/\.(raw|qcow2|qed)$/;
 
-    my $path = $class->filesystem_path($scfg, $volname);
+    die "external snapshot need to be enabled to rollback snapshot .raw volumes\n" if $volname =~ m/\.(raw)$/ && !$scfg->{snapext};
 
-    my $cmd = ['/usr/bin/qemu-img', 'snapshot','-a', $snap, $path];
+    my $path = $class->filesystem_path($scfg, $volname);
 
-    run_command($cmd);
+    if ($scfg->{snapext}) {
+	#simply delete the current snapshot and recreate it
+	my $snappath = get_snap_path($path, $snap);
+	unlink($snappath);
+	$class->volume_snapshot($scfg, $storeid, $volname, $snap);
+    } else {
+	my $cmd = ['/usr/bin/qemu-img', 'snapshot','-a', $snap, $path];
+	run_command($cmd);
+    }
 
     return undef;
 }
@@ -1111,17 +1168,50 @@ sub volume_snapshot_rollback {
 sub volume_snapshot_delete {
     my ($class, $scfg, $storeid, $volname, $snap, $running) = @_;
 
-    die "can't delete snapshot for this image format\n" if $volname !~ m/\.(qcow2|qed)$/;
+    die "can't delete snapshot for this image format\n" if $volname !~ m/\.(raw|qcow2|qed)$/;
+
+    die "external snapshot need to be enabled to delete snapshot of .raw volumes\n" if !$scfg->{snapext};
 
     return 1 if $running;
 
-    my $path = $class->filesystem_path($scfg, $volname);
+    my $cmd = "";
+    if ($scfg->{snapext}) {
+
+	my $snapshots = $class->volume_snapshot_info($scfg, $storeid, $volname);
+	my $snappath = $snapshots->{$snap}->{file};
+	return if !-e $snappath;  #already deleted ?
+
+	my $parentsnap = $snapshots->{$snap}->{parent};
+	my $childsnap = $snapshots->{$snap}->{child};
+        die "error: can't find a parent for this snapshot" if !$parentsnap;
 
-    $class->deactivate_volume($storeid, $scfg, $volname, $snap, {});
+	my $parentpath = $snapshots->{$parentsnap}->{file};
+	my $parentformat = $snapshots->{$parentsnap}->{'format'} if $parentsnap;
+	my $childpath = $snapshots->{$childsnap}->{file} if $childsnap;
+	my $childformat = $snapshots->{$childsnap}->{'format'} if $childsnap;
+
+	print "merge snapshot $snap to $parentsnap\n";
+	$cmd = ['/usr/bin/qemu-img', 'commit', $snappath];
+	run_command($cmd);
+
+	#if we delete an intermediate snapshot, we need to link upper snapshot to base snapshot
+	if($childpath && -e $childpath) {
+	    die "missing parentsnap snapshot to rebase child $childpath\n" if !$parentpath;
+	    print "link $childsnap to $parentsnap\n";
+	    $cmd = ['/usr/bin/qemu-img', 'rebase', '-u', '-b', $parentpath, '-F', $parentformat, '-f', $childformat, $childpath];
+	    run_command($cmd);
+	}
+
+	#delete the snapshot
+	unlink($snappath);
+    } else {
+	my $path = $class->filesystem_path($scfg, $volname);
 
-    my $cmd = ['/usr/bin/qemu-img', 'snapshot','-d', $snap, $path];
+	$class->deactivate_volume($storeid, $scfg, $volname, $snap, {});
 
-    run_command($cmd);
+	$cmd = ['/usr/bin/qemu-img', 'snapshot','-d', $snap, $path];
+	run_command($cmd);
+    }
 
     return undef;
 }
@@ -1140,10 +1230,6 @@ sub volume_has_feature {
     my ($class, $scfg, $feature, $storeid, $volname, $snapname, $running, $opts) = @_;
 
     my $features = {
-	snapshot => {
-	    current => { qcow2 => 1 },
-	    snap => { qcow2 => 1 },
-	},
 	clone => {
 	    base => { qcow2 => 1, raw => 1, vmdk => 1 },
 	},
@@ -1159,11 +1245,23 @@ sub volume_has_feature {
 	    base => { qcow2 => 1, raw => 1, vmdk => 1 },
 	    current => { qcow2 => 1, raw => 1, vmdk => 1 },
 	},
-	rename => {
-	    current => {qcow2 => 1, raw => 1, vmdk => 1},
-	},
+	'rename' => {
+	    current => { qcow2 => 1, raw => 1, vmdk => 1},
+	}
     };
 
+    if ($scfg->{snapext}) {
+	$features->{snapshot} = {
+		current => { raw => 1, qcow2 => 1 },
+		snap => { raw => 1, qcow2 => 1 },
+	}
+    } else {
+	$features->{snapshot} = {
+		current => { qcow2 => 1 },
+		snap => { qcow2 => 1 },
+	};
+    }
+
     if ($feature eq 'clone') {
 	if (
 	    defined($opts->{valid_target_formats})
@@ -1222,7 +1320,9 @@ sub list_images {
 	}
 
 	if ($vollist) {
-	    my $found = grep { $_ eq $volid } @$vollist;
+	    my $search_volid = $volid;
+	    $search_volid =~ s/-snap-.*\./\./;
+	    my $found = grep { $_ eq $search_volid } @$vollist;
 	    next if !$found;
 	}
 
@@ -1380,7 +1480,52 @@ sub status {
 sub volume_snapshot_info {
     my ($class, $scfg, $storeid, $volname) = @_;
 
-    die "volume_snapshot_info is not implemented for $class";
+    die "volume_snapshot_info is not implemented for $class" if !$scfg->{snapext};
+
+    my $path = $class->filesystem_path($scfg, $volname);
+
+    my ($vtype, $name, $vmid, $basename, $basevmid, $isBase, $format) = $class->parse_volname($volname);
+
+    my $basevolname = $volname;
+    $basevolname =~ s/\.(raw|qcow2)$//;
+
+    my $snapshots = $class->list_images($storeid, $scfg, $vmid);
+    my $info = {};
+    for my $snap (@$snapshots) {
+
+	my $volid = $snap->{volid};
+	next if ($volid !~ m/$basevolname/);
+
+	my (undef, $snapvolname) = parse_volume_id($volid);
+	my $snapname = get_snapname_from_path($volid);
+	my $snapfile = $class->filesystem_path($scfg, $snapvolname, $snapname);
+	$snapname = 'base' if !$snapname;
+
+	my $format = $snap->{'format'};
+	my $parentfile = $snap->{parent};
+	my $parentname = get_snapname_from_path($parentfile) if $parentfile;
+	$parentname = 'base' if !$parentname && $parentfile;
+
+	$info->{$snapname}->{file} = $snapfile;
+	$info->{$snapname}->{'format'} = $format;
+	$info->{$snapname}->{parent} = $parentname if $parentname;
+	$info->{$parentname}->{child} = $snapname if $parentname;
+    }
+
+    my $current = undef;
+    for my $id (keys %$info) {
+	my $snap = $info->{$id};
+	die "error: snap $id: you can't have multiple current snapshot:  current:$current\n" if !$snap->{child} && $current;
+	$current = $id if !$snap->{child};
+    }
+
+    if ($current) {
+	$info->{current}->{file} = $info->{$current}->{file};
+	$info->{current}->{'format'} = $info->{$current}->{'format'};
+	$info->{current}->{parent} = $info->{$current}->{parent};
+    }
+
+    return $info;
 }
 
 sub activate_storage {
@@ -1764,4 +1909,29 @@ sub config_aware_base_mkdir {
     }
 }
 
+sub get_snap_path {
+    my ($path, $snap) = @_;
+
+    my $basepath = "";
+    my $baseformat = "";
+    if ($path =~ m/^((.*)(vm-(\d+)-disk-(\d+)))(-snap-(.*))?\.(raw|qcow2)/) {
+	$basepath = $1;
+	$baseformat = $8;
+    }
+    my $format = $snap ? 'qcow2' : $baseformat;
+    my $snappath = $snap ? $basepath."-snap-$snap.$format" : undef;
+
+    return $snappath;
+}
+
+sub get_snapname_from_path {
+    my ($path) = @_;
+
+    if ($path =~ m/^((.*)(vm-(\d+)-disk-(\d+)))(-snap-(.*))?\.(raw|qcow2)/) {
+	my $snapname = $7;
+	return $snapname;
+    }
+    die "can't parse snapname from path";
+}
+
 1;
-- 
2.39.2



[-- Attachment #2: Type: text/plain, Size: 160 bytes --]

_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel