--- Begin Message ---
Signed-off-by: Alexandre Derumier <alexandre.derum...@groupe-cyllene.com>
---
src/PVE/Storage/DirPlugin.pm | 1 +
src/PVE/Storage/Plugin.pm | 207 +++++++++++++++++++++++++++++------
2 files changed, 176 insertions(+), 32 deletions(-)
diff --git a/src/PVE/Storage/DirPlugin.pm b/src/PVE/Storage/DirPlugin.pm
index fb23e0a..1cd7ac3 100644
--- a/src/PVE/Storage/DirPlugin.pm
+++ b/src/PVE/Storage/DirPlugin.pm
@@ -81,6 +81,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 fececa1..aeba8d3 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,
+ },
},
};
@@ -710,11 +715,15 @@ 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);
- $dir .= "/$vmid" if $vtype eq 'images';
+ if ($scfg->{snapext} && $snapname) {
+ $name = $class->get_snap_volname($volname, $snapname);
+ } else {
+ $dir .= "/$vmid" if $vtype eq 'images';
+ }
my $path = "$dir/$name";
@@ -953,6 +962,31 @@ sub free_image {
# TODO taken from PVE/QemuServer/Drive.pm, avoiding duplication would be nice
my @checked_qemu_img_formats = qw(raw cow qcow qcow2 qed vmdk cloop);
+sub qemu_img_info {
+ my ($filename, $file_format, $timeout, $follow_backing_files) = @_;
+
+ my $cmd = ['/usr/bin/qemu-img', 'info', '--output=json', $filename];
+ push $cmd->@*, '-f', $file_format if $file_format;
+ push $cmd->@*, '--backing-chain' if $follow_backing_files;
+
+ my $json = '';
+ my $err_output = '';
+ eval {
+ run_command($cmd,
+ timeout => $timeout,
+ outfunc => sub { $json .= shift },
+ errfunc => sub { $err_output .= shift . "\n"},
+ );
+ };
+ warn $@ if $@;
+ if ($err_output) {
+ # if qemu did not output anything to stdout we die with stderr as an
error
+ die $err_output if !$json;
+ # otherwise we warn about it and try to parse the json
+ warn $err_output;
+ }
+ return $json;
+}
# set $untrusted if the file in question might be malicious since it isn't
# created by our stack
# this makes certain checks fatal, and adds extra checks for known problems
like
@@ -1016,25 +1050,9 @@ sub file_size_info {
warn "file_size_info: '$filename': falling back to 'raw' from unknown
format '$file_format'\n";
$file_format = 'raw';
}
- my $cmd = ['/usr/bin/qemu-img', 'info', '--output=json', $filename];
- push $cmd->@*, '-f', $file_format if $file_format;
- my $json = '';
- my $err_output = '';
- eval {
- run_command($cmd,
- timeout => $timeout,
- outfunc => sub { $json .= shift },
- errfunc => sub { $err_output .= shift . "\n"},
- );
- };
- warn $@ if $@;
- if ($err_output) {
- # if qemu did not output anything to stdout we die with stderr as an
error
- die $err_output if !$json;
- # otherwise we warn about it and try to parse the json
- warn $err_output;
- }
+ my $json = qemu_img_info($filename, $file_format, $timeout);
+
if (!$json) {
die "failed to query file information with qemu-img\n" if $untrusted;
# skip decoding if there was no output, e.g. if there was a timeout.
@@ -1162,11 +1180,28 @@ sub volume_snapshot {
die "can't snapshot this image format\n" if $volname !~ m/\.(qcow2|qed)$/;
- my $path = $class->filesystem_path($scfg, $volname);
+ if($scfg->{snapext}) {
- my $cmd = ['/usr/bin/qemu-img', 'snapshot','-c', $snap, $path];
+ my $path = $class->path($scfg, $volname, $storeid);
+ my $snappath = $class->path($scfg, $volname, $storeid, $snap);
+ my $format = ($class->parse_volname($volname))[6];
+ #rename current volume to snap volume
+ rename($path, $snappath) if -e $path && !-e $snappath;
+
+ my $cmd = ['/usr/bin/qemu-img', 'create', '-b', $snappath,
+ '-F', $format, '-f', 'qcow2', $path];
+
+ my $options = "extended_l2=on,cluster_size=128k,";
+ $options .= preallocation_cmd_option($scfg, 'qcow2');
+ push @$cmd, '-o', $options;
+ run_command($cmd);
- 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;
}
@@ -1177,6 +1212,21 @@ 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
+ #we need to implemente block-stream from deleted snapshot to all others
child branchs
+ #when online, we need to do a transaction for multiple disk when delete
the last snapshot
+ #and need to merge in current running file
+
+ my $snappath = $class->path($scfg, $volname, $storeid, $snap);
+ my $snapshots = $class->volume_snapshot_info($scfg, $storeid, $volname);
+ my $parentsnap = $snapshots->{current}->{parent};
+
+ return 1 if !-e $snappath || $snapshots->{$parentsnap}->{file} eq
$snappath;
+
+ die "can't rollback, '$snap' is not most recent snapshot on
'$volname'\n";
+ }
+
return 1;
}
@@ -1187,9 +1237,15 @@ sub volume_snapshot_rollback {
my $path = $class->filesystem_path($scfg, $volname);
- my $cmd = ['/usr/bin/qemu-img', 'snapshot','-a', $snap, $path];
-
- run_command($cmd);
+ if ($scfg->{snapext}) {
+ #simply delete the current snapshot and recreate it
+ my $path = $class->filesystem_path($scfg, $volname);
+ unlink($path);
+ $class->volume_snapshot($scfg, $storeid, $volname, $snap);
+ } else {
+ my $cmd = ['/usr/bin/qemu-img', 'snapshot','-a', $snap, $path];
+ run_command($cmd);
+ }
return undef;
}
@@ -1201,13 +1257,52 @@ sub volume_snapshot_delete {
return 1 if $running;
+ my $cmd = "";
my $path = $class->filesystem_path($scfg, $volname);
- $class->deactivate_volume($storeid, $scfg, $volname, $snap, {});
+ if ($scfg->{snapext}) {
- my $cmd = ['/usr/bin/qemu-img', 'snapshot','-d', $snap, $path];
+ 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};
+
+ my $parentpath = $snapshots->{$parentsnap}->{file} if $parentsnap;
+ my $childpath = $snapshots->{$childsnap}->{file} if $childsnap;
+
+
+ #if first snapshot, we merge child, and rename the snapshot to child
+ if(!$parentsnap) {
+ #we use commit here, as it's faster than rebase
+
#https://lists.gnu.org/archive/html/qemu-discuss/2019-08/msg00041.html
+ print"commit $childpath\n";
+ $cmd = ['/usr/bin/qemu-img', 'commit', $childpath];
+ run_command($cmd);
+ print"delete $childpath\n";
+
+ unlink($childpath);
+ print"rename $snappath to $childpath\n";
+ rename($snappath, $childpath);
+ } else {
+ print"commit $snappath\n";
+ $cmd = ['/usr/bin/qemu-img', 'commit', $snappath];
+ #if we delete an intermediate snapshot, we need to link upper
snapshot to base snapshot
+ 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', 'qcow2', '-f', 'qcow2', $childpath];
+ run_command($cmd);
+ #delete the snapshot
+ unlink($snappath);
+ }
+
+ } else {
+ $class->deactivate_volume($storeid, $scfg, $volname, $snap, {});
- run_command($cmd);
+ $cmd = ['/usr/bin/qemu-img', 'snapshot','-d', $snap, $path];
+ run_command($cmd);
+ }
return undef;
}
@@ -1246,8 +1341,8 @@ sub volume_has_feature {
current => { qcow2 => 1, raw => 1, vmdk => 1 },
},
rename => {
- current => {qcow2 => 1, raw => 1, vmdk => 1},
- },
+ current => { qcow2 => 1, raw => 1, vmdk => 1},
+ }
};
if ($feature eq 'clone') {
@@ -1481,7 +1576,37 @@ sub status {
sub volume_snapshot_info {
my ($class, $scfg, $storeid, $volname) = @_;
- die "volume_snapshot_info is not implemented for $class";
+ my $path = $class->filesystem_path($scfg, $volname);
+
+ my $backing_chain = 1;
+ my $json = qemu_img_info($path, undef, 10, $backing_chain);
+ die "failed to query file information with qemu-img\n" if !$json;
+ my $snapshots = eval { decode_json($json) };
+
+ my $info = {};
+ my $order = 0;
+ for my $snap (@$snapshots) {
+
+ my $snapfile = $snap->{filename};
+ my $snapname = parse_snapname($snapfile);
+ $snapname = 'current' if !$snapname;
+ my $snapvolname = $class->get_snap_volname($volname, $snapname);
+
+ $info->{$snapname}->{order} = $order;
+ $info->{$snapname}->{file}= $snapfile;
+ $info->{$snapname}->{volname} = $snapvolname;
+ $info->{$snapname}->{volid} = "$storeid:$snapvolname";
+ $info->{$snapname}->{ext} = 1;
+
+ my $parentfile = $snap->{'backing-filename'};
+ if ($parentfile) {
+ my $parentname = parse_snapname($parentfile);
+ $info->{$snapname}->{parent} = $parentname;
+ $info->{$parentname}->{child} = $snapname;
+ }
+ $order++;
+ }
+ return $info;
}
sub activate_storage {
@@ -1867,4 +1992,22 @@ sub config_aware_base_mkdir {
}
}
+sub get_snap_volname {
+ my ($class, $volname, $snapname) = @_;
+
+ my ($vtype, $name, $vmid, $basename, $basevmid, $isBase, $format) =
$class->parse_volname($volname);
+ $name = !$snapname || $snapname eq 'current' ? $volname :
"$vmid/snap-$snapname-$name";
+ return $name;
+}
+
+sub parse_snapname {
+ my ($name) = @_;
+
+ my $basename = basename($name);
+ if ($basename =~ m/^snap-(.*)-vm(.*)$/) {
+ return $1;
+ }
+ return undef;
+}
+
1;
--
2.39.5
--- End Message ---
