+my $find_free_diskname = sub {
+ my ($storeid, $scfg, $vmid) = @_;
+
+ my $rbd = rbd_ls($scfg, $storeid);
+ my $pool = $scfg->{pool} ? $scfg->{pool} : 'rbd';
+ my $disk_ids = {};
+ my $dat = $rbd->{$pool};
+
+ foreach my $image (keys %$dat) {
+ my $volname = $dat->{$image}->{name};
+ if ($volname =~ m/(vm|base)-$vmid-disk-(\d+)/){
+ $disk_ids->{$2} = 1;
+ }
+ }
+ #fix: can we search in $rbd hash key with a regex to find (vm|base) ?
+ for (my $i = 1; $i < 100; $i++) {
+ if (!$disk_ids->{$i}) {
+ return "vm-$vmid-disk-$i";
+ }
+ }
+
+ die "unable to allocate an image name for VM $vmid in storage '$storeid'\n";
+};
+
+sub create_base {
+ my ($class, $storeid, $scfg, $volname) = @_;
+
+ my $snap = '__base__';
+
+ my ($vtype, $name, $vmid, $basename, $basevmid, $isBase) =
+ $class->parse_volname($volname);
+
+ die "create_base not possible with base image\n" if $isBase;
+
+ my ($size, $parent, $format, undef) = rbd_volume_info($scfg, $storeid, $name);
+ die "rbd volume info on '$name' failed\n" if !($size);
+
+ die "rbd image must be at format V2" if $format ne "2";
+
+ die "volname '$volname' contains wrong information about parent $parent $basename\n"
+ if $basename && (!$parent || $parent ne $basename."@".$snap);
+
+ my $newname = $name;
+ $newname =~ s/^vm-/base-/;
+
+ my $newvolname = $basename ? "$basename/$newname" : "$newname";
+
+ my $cmd = &$rbd_cmd($scfg, $storeid, 'rename', &$add_pool_to_disk($scfg, $name), &$add_pool_to_disk($scfg, $newname));
+ run_command($cmd, errmsg => "rbd rename '$name' error");
+
+ my $running = undef; #fixme : is create_base always offline ?
+
+ $class->volume_snapshot($scfg, $storeid, $newname, $snap, $running);
+
+ my (undef, undef, undef, $protected) = rbd_volume_info($scfg, $storeid, $newname, $snap);
+
+ if (!$protected){
+ my $cmd = &$rbd_cmd($scfg, $storeid, 'snap', 'protect', $newname, '--snap', $snap);
+ run_command($cmd, errmsg => "rbd protect $newname snap $snap' error");
+ }
+
+ return $newvolname;
+
+}
+
+sub clone_image {
+ my ($class, $scfg, $storeid, $volname, $vmid) = @_;
+
+ my $snap = '__base__';
+
+ my ($vtype, $basename, $basevmid, undef, undef, $isBase) =
+ $class->parse_volname($volname);
+
+ die "clone_image onyl works on base images\n" if !$isBase;
+
+ my $name = &$find_free_diskname($storeid, $scfg, $vmid);
+
+ warn "clone $volname: $basename to $name\n";
+
+ my $newvol = "$basename/$name";
+
+ my $cmd = &$rbd_cmd($scfg, $storeid, 'clone', &$add_pool_to_disk($scfg, $basename), '--snap', $snap, &$add_pool_to_disk($scfg, $name));
+ run_command($cmd, errmsg => "rbd clone $basename' error");
+
+ return $newvol;
+}
+