From: Michael Rasmussen <m...@datanom.net>
Signed-off-by: Michael Rasmussen <m...@datanom.net>
---
PVE/Storage/FreeNASPlugin.pm | 415 +++++++++++++++++++++++++++++++++++++++++++
1 file changed, 415 insertions(+)
diff --git a/PVE/Storage/FreeNASPlugin.pm b/PVE/Storage/FreeNASPlugin.pm
index cf33e68..a50a2f6 100644
--- a/PVE/Storage/FreeNASPlugin.pm
+++ b/PVE/Storage/FreeNASPlugin.pm
@@ -15,6 +15,14 @@ use Data::Dumper;
use base qw(PVE::Storage::Plugin);
+my $api = '/api/v1.0';
+my $api_timeout = 20; # seconds
+my $rows_per_request = 50; # limit for get requests
+ # be aware. Setting limit very low (default setting
+ # in FreeNAS API is 20) can cause race conditions
+ # on the FreeNAS host (seems like an unstable
+ # pagination algorithm implemented in FreeNAS)
+
# Configuration
sub type {
@@ -62,5 +70,412 @@ sub options {
};
}
+# private methods
+
+my $freenas_request = sub {
+ my ($scfg, $request, $section, $data) = @_;
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("ProxmoxUA/0.1");
+ $ua->ssl_opts( verify_hostname => 0 );
+ $ua->timeout($api_timeout);
+ push @{ $ua->requests_redirectable }, 'POST';
+ push @{ $ua->requests_redirectable }, 'PUT';
+ push @{ $ua->requests_redirectable }, 'DELETE';
+ my ($req, $res, $content) = (undef, undef, undef);
+
+ my $url = "https://$scfg->{portal}$api/$section";
+
+ if ($request eq 'GET') {
+ $req = HTTP::Request->new;
+ } elsif ($request eq 'POST') {
+ $req = HTTP::Request->new(POST => $url);
+ $req->content($data);
+ } elsif ($request eq 'PUT') {
+ $req = HTTP::Request->new(PUT => $url);
+ $req->content($data);
+ } elsif ($request eq 'DELETE') {
+ $req = HTTP::Request->new(DELETE => $url);
+ } else {
+ die "$request: Unknown request\n";
+ }
+
+ $req->content_type('application/json');
+ $req->authorization_basic($scfg->{username}, $scfg->{password});
+
+ if ($request eq 'GET') {
+ my $offset = 0;
+ my $keep_going = 1;
+ my $tmp;
+ $req->method('GET');
+ while ($keep_going) {
+ my $rows = 0;
+ my $uri = "$url?offset=$offset&limit=$rows_per_request";
+ $req->uri($uri);
+ $res = $ua->request($req);
+ do {
+ $keep_going = 0;
+ last;
+ } unless $res->is_success || $res->content ne "";
+ eval {
+ $tmp = decode_json($res->content);
+ };
+ do {
+ # Not JSON or invalid JSON payload
+ $tmp = $res->content;
+ if (defined $content && ref($content) eq 'ARRAY') {
+ # error
+ push(@$content, [$tmp]);
+ } elsif (defined $content) {
+ $content .= $res->content;
+ } else {
+ $content = $res->content;
+ }
+ $keep_going = 0;
+ last;
+ } if $@;
+ # We got valid JSON payload
+ if (defined $content && ref($content) eq 'ARRAY') {
+ if (ref($tmp) eq 'ARRAY') {
+ push(@$content, @$tmp);
+ } else {
+ # error
+ push(@$content, [$tmp]);
+ $keep_going = 0;
+ last;
+ }
+ } elsif (defined $content) {
+ if (ref($tmp) eq 'ARRAY') {
+ # error
+ $content .= "@$tmp";
+ } else {
+ $content .= $tmp;
+ }
+ $keep_going = 0;
+ last;
+ } else {
+ $content = $tmp;
+ if (ref($tmp) ne 'ARRAY') {
+ $keep_going = 0;
+ last;
+ }
+ }
+ $rows = @$tmp;
+ $keep_going = 0 unless $rows >= $rows_per_request;
+ $offset += $rows;
+ }
+ } else {
+ $res = $ua->request($req);
+ eval {
+ $content = decode_json($res->content);
+ };
+ $content = $res->content if $@;
+ }
+
+ die $res->code."\n" unless $res->is_success;
+
+ return wantarray ? ($res->code, $content) : $content;
+};
+
+my $freenas_get_version = sub {
+ my ($scfg) = @_;
+
+ my $response = $freenas_request->($scfg, 'GET', "system/version/");
+ my $fullversion = $response->{fullversion};
+ if ($fullversion =~ /^\w+-(\d+)\.(\d*)\.(\d*)/) {
+ my $minor = $2;
+ my $micro = $3;
+
+ if ($minor) {
+ $minor = "0$minor" unless $minor > 9;
+ } else {
+ $minor = '00';
+ }
+
+ if ($micro) {
+ $micro = "0$micro" unless $micro > 9;
+ } else {
+ $micro = '00';
+ }
+
+ $version = "$1$minor$micro";
+ } else {
+ die "$fullversion: Cannot parse\n";
+ }
+
+ die "$fullversion: Unsupported version\n" if $version < 90200;
+};
+
+my $freenas_list_zvol = sub {
+ my ($scfg) = @_;
+
+ $freenas_get_version->($scfg);
+
+ my $zvols = $freenas_request->($scfg, 'GET',
"storage/volume/$scfg->{pool}/zvols/");
+ my $snapshots = $freenas_request->($scfg, 'GET', "storage/snapshot/");
+
+ my $list = ();
+ my $hide = {};
+ my $vmid;
+ my $parent;
+ foreach my $zvol (@$zvols) {
+ next unless $zvol->{name} =~ /^(base|vm)-(\d+)-disk-\d+$/;
+ $vmid = $2;
+ $parent = undef;
+ foreach my $snap (@$snapshots) {
+ next unless $snap->{name} eq "__base__$vmid";
+ $parent = $snap->{filesystem} =~ /^$scfg->{pool}\/(.+)$/ ? $1 :
undef;
+ }
+ $list->{$scfg->{pool}}->{$zvol->{name}} = {
+ name => $zvol->{name},
+ size => $zvol->{volsize},
+ parent => $parent,
+ vmid => $vmid,
+ format => 'raw',
+ };
+ if ($zvol->{name} =~ /^base-(.*)/) {
+ $hide->{"vm-$1"} = 1;
+ }
+ }
+
+ delete @{$list->{$scfg->{pool}}}{keys %$hide};
+
+ return $list;
+};
+
+# Storage implementation
+
+sub volume_size_info {
+ my ($class, $scfg, $storeid, $volname, $timeout) = @_;
+
+ my (undef, $vname) = $class->parse_volname($volname);
+
+ my $zvol = $freenas_request->($scfg, 'GET',
"storage/volume/$scfg->{pool}/zvols/$vname/");
+
+ return $zvol->{volsize} if $zvol && $zvol->{volsize};
+
+ die "Could not get zfs volume size\n";
+}
+
+sub parse_volname {
+ my ($class, $volname) = @_;
+
+ if ($volname =~ m/^(((base)-(\d+)-\S+)\/)?((base|vm)-(\d+)-\S+)$/) {
+ my $format = 'raw';
+ my $isBase = ($6 eq 'base');
+ return ('images', $5, $7, $2, $4, $isBase, $format);
+ }
+
+ die "unable to parse freenas volume name '$volname'\n";
+}
+
+sub status {
+ my ($class, $storeid, $scfg, $cache) = @_;
+
+ my $total = 0;
+ my $free = 0;
+ my $used = 0;
+ my $active = 0;
+
+ eval {
+ my $vol = $freenas_request->($scfg, 'GET',
"storage/volume/$scfg->{pool}/");
+ my $children = $vol->{children};
+ if (@$children) {
+ $used = $children->[0]{used};
+ $total = $children->[0]{avail};
+ } else {
+ $used = $vol->{used};
+ $total = $vol->{avail};
+ }
+ $free = $total - $used;
+ $active = 1;
+ };
+ warn $@ if $@;
+
+ return ($total, $free, $used, $active);
+}
+
+sub list_images {
+ my ($class, $storeid, $scfg, $vmid, $vollist, $cache) = @_;
+
+ $cache->{freenas} = $freenas_list_zvol->($scfg) unless $cache->{freenas};
+ my $zfspool = $scfg->{pool};
+ my $res = [];
+
+ if (my $dat = $cache->{freenas}->{$zfspool}) {
+
+ foreach my $image (keys %$dat) {
+
+ my $info = $dat->{$image};
+ my $volname = $info->{name};
+ my $parent = $info->{parent};
+ my $owner = $info->{vmid};
+
+ if ($parent) {
+ $info->{volid} = "$storeid:$parent/$volname";
+ } else {
+ $info->{volid} = "$storeid:$volname";
+ }
+
+ if ($vollist) {
+ my $found = grep { $_ eq $info->{volid} } @$vollist;
+ next unless $found;
+ } else {
+ next if defined ($vmid) && ($owner ne $vmid);
+ }
+ push @$res, $info;
+ }
+ }
+
+ return $res;
+}
+
+sub path {
+ my ($class, $scfg, $volname, $storeid, $snapname) = @_;
+
+ my ($vtype, $vname, $vmid) = $class->parse_volname($volname);
+
+}
+
+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;
+
+}
+
+sub clone_image {
+ my ($class, $scfg, $storeid, $volname, $vmid, $snap) = @_;
+
+}
+
+sub alloc_image {
+ my ($class, $storeid, $scfg, $vmid, $fmt, $name, $size) = @_;
+ die "unsupported format '$fmt'\n" if $fmt ne 'raw';
+
+}
+
+sub free_image {
+ my ($class, $storeid, $scfg, $volname, $isBase) = @_;
+
+ my ($vtype, $name, $vmid, $basename) = $class->parse_volname($volname);
+
+}
+
+sub volume_resize {
+ my ($class, $scfg, $storeid, $volname, $size, $running) = @_;
+
+ my ($vtype, $name, $vmid) = $class->parse_volname($volname);
+
+}
+
+sub volume_snapshot {
+ my ($class, $scfg, $storeid, $volname, $snap) = @_;
+
+ my (undef, $vname) = $class->parse_volname($volname);
+
+ my $data = {
+ dataset => "$scfg->{pool}/$vname",
+ name => $snap,
+ };
+ $freenas_request->($scfg, 'POST', "storage/snapshot/",
encode_json($data));
+}
+
+sub volume_snapshot_delete {
+ my ($class, $scfg, $storeid, $volname, $snap, $running) = @_;
+
+ my (undef, $vname, $vmid) = $class->parse_volname($volname);
+
+}
+
+sub volume_snapshot_rollback {
+ my ($class, $scfg, $storeid, $volname, $snap) = @_;
+
+ my ($vtype, $name, $vmid) = $class->parse_volname($volname);
+}
+
+sub volume_rollback_is_possible {
+ my ($class, $scfg, $storeid, $volname, $snap) = @_;
+
+ my (undef, $name) = $class->parse_volname($volname);
+
+}
+
+sub volume_snapshot_list {
+ my ($class, $scfg, $storeid, $volname, $prefix) = @_;
+ # return an empty array if dataset does not exist.
+ die "Volume_snapshot_list is not implemented for FreeNAS.\n";
+}
+
+sub volume_has_feature {
+ my ($class, $scfg, $feature, $storeid, $volname, $snapname, $running) = @_;
+
+ my $features = {
+ snapshot => { current => 1, snap => 1},
+ clone => { base => 1},
+ template => { current => 1},
+ copy => { base => 1, current => 1},
+ };
+
+ my ($vtype, $name, $vmid, $basename, $basevmid, $isBase) =
+ $class->parse_volname($volname);
+
+ my $key = undef;
+
+ if ($snapname) {
+ $key = 'snap';
+ } else {
+ $key = $isBase ? 'base' : 'current';
+ }
+
+ return 1 if $features->{$feature}->{$key};
+
+ return undef;
+}
+
+sub activate_storage {
+ my ($class, $storeid, $scfg, $cache) = @_;
+
+ return 1;
+}
+
+sub deactivate_storage {
+ my ($class, $storeid, $scfg, $cache) = @_;
+
+ return 1;
+}
+
+# Procedure for activating a LUN:
+#
+# if session does not exist
+# login to target
+# deactivate all luns in session
+# get list of active luns
+# get lun number to activate
+# make list of our luns (active + new lun)
+# rescan session
+# deactivate all luns except our luns
+sub activate_volume {
+ my ($class, $storeid, $scfg, $volname, $snapname, $cache) = @_;
+
+ return 1;
+}
+
+# Procedure for deactivating a LUN:
+#
+# if session exists
+# get lun number to deactivate
+# deactivate lun
+sub deactivate_volume {
+ my ($class, $storeid, $scfg, $volname, $snapname, $cache) = @_;
+
+ my (undef, $name) = $class->parse_volname($volname);
+
+ return 1;
+}
+
1;
--
2.11.0
----
This mail was virus scanned and spam checked before delivery.
This mail is also DKIM signed. See header dkim-signature.
_______________________________________________
pve-devel mailing list
pve-devel@pve.proxmox.com
https://pve.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
