On Tue, Jun 20, 2017 at 10:39:54PM +0200, m...@datanom.net wrote:
> 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 {
high level question #1: how do you guarantee that inbetween pagination
requests, the underlying lists/.. on the freenas side don't change
because of concurrent actions?
getting outdated information altogether is probably fine (as in, you
can't expect not to sometimes get it). but since the result is
potentially a list, it might contain duplicates unless there is some
mechanism on the freenas side preventing the following:
- request for first page, with last element "foo" returned
- concurrent request adding element "bar", which is sorted before
element "foo" according to whatever criteria is used to generate the
pagination
- request for second page, with first element "foo" returned
end result: we don't know about "bar", but we get "foo" twice
high level question #2: does the FreeNAS API return non-JSON apart from
error cases? I am not sure whether the mix and match between lists and
strings below is really necessary..
high level question #3: why not introduce wrappers for get, post, put and
delete? e.g.,
$api_get->($scfg, 'some/api/path');
is a lot shorter than
$freenas_request($scfg, 'GET', 'some/api/path');
bonus points: you can drop the $data parameter from _get and _delete, and move
the encode_json into the _put and _post wrappers.
> + 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) {
I think we can get rid of this / replace it with "while (1)", see below
> + my $rows = 0;
> + my $uri = "$url?offset=$offset&limit=$rows_per_request";
> + $req->uri($uri);
$uri is only used once, why not inline it ('my $uri = "' is as long as
'$req->uri($', so the line length is not an issue ;))?
> + $res = $ua->request($req);
> + do {
> + $keep_going = 0;
> + last;
> + } unless $res->is_success || $res->content ne "";
style!
do { foo } unless bar
should be
if (!bar) { foo };
also, why set $keep_going if you exit the outer while with last anyway?
last if !$res->is_success || $res->content eq '';
should do the same in 1 line instead of 4.
> + 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 $@;
style, see above!
keep_going vs last, same as above.
also, if you add
$content = '' if !defined($content);
before the if, you can drop the elsif branch and the defined from the if
condition.
> + # 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;
> + }
keep_going / last again
but - is this really correct? either you only allow one request if the
result is not an array, but then you don't need the elsif above, or this
last in else and elsif is wrong?
maybe the following is simpler (depending on the answers to the question
above):
if (!defined($content)) {
$content = $tmp;
} else {
if (ref($tmp) eq 'ARRAY') {
push(@$content, @$tmp);
} else {
# should not happen? exits below!
push(@$content, [$tmp]);
}
}
last if ref($tmp) ne 'ARRAY'; # no iteration needed!
> + }
> + $rows = @$tmp;
> + $keep_going = 0 unless $rows >= $rows_per_request;
last if $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;
this deviates from v5 - now you die with the HTTP error code, and not
with the full status message (except for in freenas_create_target_group
and freenas_create_target) - is this intentional?
also, unless instead of if ;)
> +
> + return wantarray ? ($res->code, $content) : $content;
> +};
> +
> +my $freenas_get_version = sub {
> + my ($scfg) = @_;
> +
> + my $response = $freenas_request->($scfg, 'GET', "system/version/");
maybe add a "return $version if $version;" before this (to avoid having
to make too many version requests), and call it more often to catch the
90200 for sure?
> + my $fullversion = $response->{fullversion};
> + if ($fullversion =~ /^\w+-(\d+)\.(\d*)\.(\d*)/) {
> + my $minor = $2;
> + my $micro = $3;
> +
> + if ($minor) {
> + $minor = "0$minor" unless $minor > 9;
unless
> + } else {
> + $minor = '00';
> + }
> +
> + if ($micro) {
> + $micro = "0$micro" unless $micro > 9;
unless
> + } 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+$/;
custom volume names still missing here? but maybe you'll include that
when switching to parse_volname..
also, unless
> + $vmid = $2;
> + $parent = undef;
> + foreach my $snap (@$snapshots) {
> + next unless $snap->{name} eq "__base__$vmid";
unless
> + $parent = $snap->{filesystem} =~ /^$scfg->{pool}\/(.+)$/ ? $1 :
> undef;
> + }
this should probably be refactored:
- move the snapshot foreach loop outside of the zvol foreach loop
- fill a hash with zvol->parent that is then used in the zvol foreach loop
otherwise, this can easily explode (think, hundreds of zvols with lots of
snapshots each!)
the hack with encoding the linked clone origin relationship in a snapshot name
still seems really really bad, but I guess there is no other way given the
current FreeNAS API limitations. I do wonder whether it would not be better to
skip linked clones until the API exposes this information? otherwise we have to
keep this workaround supported forever..
> + $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};
unless
> + 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;
unless
> + } else {
> + next if defined ($vmid) && ($owner ne $vmid);
> + }
> + push @$res, $info;
> + }
> + }
> +
> + return $res;
> +}
> +
I am not quite sure why most of the stuff below is in this patch, but I'll
ignore the stubs and just comment on the implemented stuff.
> +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) =
my (undef, undef, undef, undef, undef, $isBase) =
$class->parse_volname($volname);
> + $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
_______________________________________________
pve-devel mailing list
pve-devel@pve.proxmox.com
https://pve.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
