--- Begin Message ---
Signed-off-by: Alexandre Derumier <alexandre.derum...@groupe-cyllene.com>
---
src/PVE/Storage.pm | 4 +-
src/PVE/Storage/DirPlugin.pm | 1 +
src/PVE/Storage/Plugin.pm | 232 +++++++++++++++++++++++++++++------
3 files changed, 196 insertions(+), 41 deletions(-)
diff --git a/src/PVE/Storage.pm b/src/PVE/Storage.pm
index 3b4f041..79e5c3a 100755
--- a/src/PVE/Storage.pm
+++ b/src/PVE/Storage.pm
@@ -1002,7 +1002,7 @@ sub unmap_volume {
}
sub vdisk_alloc {
- my ($cfg, $storeid, $vmid, $fmt, $name, $size) = @_;
+ my ($cfg, $storeid, $vmid, $fmt, $name, $size, $backing) = @_;
die "no storage ID specified\n" if !$storeid;
@@ -1025,7 +1025,7 @@ sub vdisk_alloc {
# lock shared storage
return $plugin->cluster_lock_storage($storeid, $scfg->{shared}, undef, sub
{
my $old_umask = umask(umask|0037);
- my $volname = eval { $plugin->alloc_image($storeid, $scfg, $vmid, $fmt,
$name, $size) };
+ my $volname = eval { $plugin->alloc_image($storeid, $scfg, $vmid, $fmt,
$name, $size, $backing) };
my $err = $@;
umask $old_umask;
die $err if $err;
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 65cf43f..d7f485f 100644
--- a/src/PVE/Storage/Plugin.pm
+++ b/src/PVE/Storage/Plugin.pm
@@ -216,6 +216,11 @@ my $defaultData = {
maximum => 65535,
optional => 1,
},
+ 'snapext' => {
+ type => 'boolean',
+ description => 'enable external snapshot.',
+ optional => 1,
+ },
},
};
@@ -716,7 +721,11 @@ sub filesystem_path {
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";
@@ -873,7 +882,7 @@ sub clone_image {
}
sub alloc_image {
- my ($class, $storeid, $scfg, $vmid, $fmt, $name, $size) = @_;
+ my ($class, $storeid, $scfg, $vmid, $fmt, $name, $size, $backing) = @_;
my $imagedir = $class->get_subdir($scfg, 'images');
$imagedir .= "/$vmid";
@@ -901,17 +910,11 @@ sub alloc_image {
umask $old_umask;
die $err if $err;
} else {
- my $cmd = ['/usr/bin/qemu-img', 'create'];
-
- my $prealloc_opt = preallocation_cmd_option($scfg, $fmt);
- push @$cmd, '-o', $prealloc_opt if defined($prealloc_opt);
- push @$cmd, '-f', $fmt, $path, "${size}K";
-
- eval { run_command($cmd, errmsg => "unable to create image"); };
+ eval { qemu_img_create($scfg, $fmt, $size, $path, $backing) };
if ($@) {
unlink $path;
- rmdir $imagedir;
+ rmdir $imagedir if !$backing;
die "$@";
}
}
@@ -955,6 +958,50 @@ 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_create {
+ my ($scfg, $fmt, $size, $path, $backing) = @_;
+
+ my $cmd = ['/usr/bin/qemu-img', 'create'];
+
+ my $options = [];
+
+ if($backing) {
+ push @$cmd, '-b', $backing, '-F', 'qcow2';
+ push @$options, 'extended_l2=on','cluster_size=128k';
+ };
+ push @$options, preallocation_cmd_option($scfg, $fmt);
+ push @$cmd, '-o', join(',', @$options) if @$options > 0;
+ push @$cmd, '-f', $fmt, $path;
+ push @$cmd, "${size}K" if !$backing;
+
+ run_command($cmd, errmsg => "unable to create image");
+}
+
+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
@@ -1018,25 +1065,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 +1193,29 @@ 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 $path = $class->path($scfg, $volname, $storeid);
+ my $snappath = $class->path($scfg, $volname, $storeid, $snap);
+ #rename current volume to snap volume
+ die "snapshot volume $snappath already exist\n" if -e $snappath;
+ rename($path, $snappath) if -e $path;
+
+ my ($vtype, $name, $vmid, undef, undef, $isBase, $format) =
+ $class->parse_volname($volname);
+
+ $class->alloc_image($storeid, $scfg, $vmid, 'qcow2', $name, undef,
$snappath);
+ if ($@) {
+ eval { $class->free_image($storeid, $scfg, $volname, 0) };
+ warn $@ if $@;
+ }
- my $cmd = ['/usr/bin/qemu-img', 'snapshot','-c', $snap, $path];
+ } else {
- run_command($cmd);
+ my $path = $class->filesystem_path($scfg, $volname);
+ my $cmd = ['/usr/bin/qemu-img', 'snapshot','-c', $snap, $path];
+ run_command($cmd);
+ }
return undef;
}
@@ -1177,6 +1226,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 $snapshots->{$parentsnap}->{file} eq $snappath;
+
+ die "can't rollback, '$snap' is not most recent snapshot on
'$volname'\n";
+ }
+
return 1;
}
@@ -1187,9 +1251,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 +1271,49 @@ 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 $snapshots = $class->volume_snapshot_info($scfg, $storeid, $volname);
+ my $snappath = $snapshots->{$snap}->{file};
+ die "volume $snappath is missing" if !-e $snappath;
- my $cmd = ['/usr/bin/qemu-img', 'snapshot','-d', $snap, $path];
+ my $parentsnap = $snapshots->{$snap}->{parent};
+ my $childsnap = $snapshots->{$snap}->{child};
- run_command($cmd);
+ my $parentpath = $snapshots->{$parentsnap}->{file} if $parentsnap;
+ my $childpath = $snapshots->{$childsnap}->{file} if $childsnap;
+
+ #if first snapshot,as it should be bigger, we merge child, and rename
the snapshot to child
+ if(!$parentsnap) {
+ print"commit $childpath\n";
+ $cmd = ['/usr/bin/qemu-img', 'commit', $childpath];
+ eval { run_command($cmd) };
+ if ($@) {
+ die "error commiting $childpath to $parentpath; $@\n";
+ }
+ print"rename $snappath to $childpath\n";
+ rename($snappath, $childpath);
+ } else {
+ #we rebase the child image on the parent as new backing image
+ die "missing parentsnap snapshot to rebase child $childpath\n" if
!$parentpath;
+ $cmd = ['/usr/bin/qemu-img', 'rebase', '-b', $parentpath, '-F',
'qcow2', '-f', 'qcow2', $childpath];
+ eval { run_command($cmd) };
+ if ($@) {
+ die "error rebase $childpath from $parentpath; $@\n";
+ }
+ #delete the snapshot
+ unlink($snappath);
+ }
+
+ } else {
+ $class->deactivate_volume($storeid, $scfg, $volname, $snap, {});
+
+ $cmd = ['/usr/bin/qemu-img', 'snapshot','-d', $snap, $path];
+ run_command($cmd);
+ }
return undef;
}
@@ -1246,7 +1352,7 @@ 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},
},
};
@@ -1481,7 +1587,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 +2003,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 ---
