first commit

This commit is contained in:
Ondrej Bima 2017-05-19 12:15:42 +02:00
commit d91ec2d0b8
5 changed files with 1045 additions and 0 deletions

11
README Normal file
View File

@ -0,0 +1,11 @@
patch files:
/usr/share/pve-manager/js/pvemanagerlib.js
/usr/share/perl5/PVE/Storage/ZFSPlugin.pm
copy
/usr/share/perl5/REST
/usr/share/perl5/PVE/Storage/LunCmd/FreeNAS.pm
UPDATE FreeNAS username and password in FreeNAS.pm
systemctl restart pvedaemon

View File

@ -0,0 +1,435 @@
package PVE::Storage::LunCmd::FreeNAS;
use strict;
use warnings;
use Data::Dumper;
use PVE::SafeSyslog;
use REST::Client;
use MIME::Base64;
use JSON;
my $MAX_LUNS = 255;
sub get_base { return '/dev/zvol'; }
sub run_lun_command {
my ($scfg, $timeout, $method, @params) = @_;
# TODO : Move configuration of the storage
if( ! defined( $scfg->{'freenas_user'} ) ) {
$scfg->{'freenas_user'} = 'root';
$scfg->{'freenas_password'} = '*** password ***';
}
syslog("info","FreeNAS::lun_command : $method(@params)");
if( $method eq "create_lu" ) { return run_create_lu($scfg,$timeout,$method,@params); }
if( $method eq "delete_lu" ) { return run_delete_lu($scfg,$timeout,$method,@params); }
if( $method eq "import_lu" ) { return run_create_lu($scfg,$timeout,$method,@params); }
if( $method eq "modify_lu" ) { return run_modify_lu($scfg,$timeout,$method,@params); }
if( $method eq "add_view" ) { return run_add_view($scfg,$timeout,$method,@params); }
if( $method eq "list_view" ) { return run_list_view($scfg,$timeout,$method, @params); }
if( $method eq "list_lu" ) { return run_list_lu($scfg,$timeout,$method,"name", @params); }
syslog("error","FreeNAS::lun_command : unknown method $method");
return undef;
}
sub run_add_view { return ''; }
# a modify_lu occur by example on a zvol resize. we just need to destroy and recreate the lun with the same zvol.
# Be careful, the first param is the new size of the zvol, we must shift params
sub run_modify_lu {
my ($scfg, $timeout, $method, @params) = @_;
shift(@params);
run_delete_lu($scfg,$timeout,$method,@params);
return run_create_lu($scfg,$timeout,$method,@params);
}
sub run_list_view {
my ($scfg, $timeout, $method, @params) = @_;
return run_list_lu($scfg,$timeout,$method,"lun-id", @params);
}
sub run_list_lu {
my ($scfg, $timeout, $method, $result_value_type ,@params) = @_;
my $object = $params[0];
my $result = undef;
my $luns = freenas_list_lu($scfg);
foreach my $lun ( @$luns ) {
if ($lun->{'iscsi_target_extent_path'} =~ /^$object$/) {
$result = $result_value_type eq "lun-id" ? $lun->{'iscsi_lunid'} : $lun->{'iscsi_target_extent_path'};
syslog("info","FreeNAS::list_lu($object):$result_value_type : lun found $result");
last;
}
}
if( !defined($result) ) {
syslog("info","FreeNAS::list_lu($object):$result_value_type : lun not found");
}
return $result;
}
sub run_create_lu {
my ($scfg, $timeout, $method, @params) = @_;
my $lun_path = $params[0];
my $lun_id = freenas_get_first_available_lunid($scfg);
die "Maximum number of LUNs per target is $MAX_LUNS" if scalar $lun_id >= $MAX_LUNS;
die "$params[0]: LUN $lun_path exists" if defined(run_list_lu($scfg,$timeout,$method,"name", @params));
my $target_id = freenas_get_targetid($scfg);
die "Unable to find the target id for $scfg->{target}" if !defined($target_id);
my $bs=$scfg->{blocksize};
if (index($bs, "k") >= 0 ) {
chop($bs); $bs = $bs * 1024;
syslog("info","FreeNAS::create_lu(lun_path=$lun_path, lun_id=$lun_id) : blocksize convert $scfg->{blocksize} = $bs");
} else {
syslog("info","FreeNAS::create_lu(lun_path=$lun_path, lun_id=$lun_id) : blocksize $bs");
}
# Create the extent
my $extent = freenas_iscsi_create_extent($scfg, $lun_path, $bs);
# Associate the new extent to the target
my $link = freenas_iscsi_create_target_to_extent($scfg , $target_id , $extent->{'id'} , $lun_id );
if (defined($link) ) {
syslog("info","FreeNAS::create_lu(lun_path=$lun_path, lun_id=$lun_id) : sucessfull");
} else {
die "Unable to create lun $lun_path";
}
return "";
}
sub run_delete_lu {
my ($scfg, $timeout, $method, @params) = @_;
my $lun_path = $params[0];
my $luns = freenas_list_lu($scfg);
my $lun = undef;
my $link = undef;
foreach my $item ( @$luns ) {
if( $item->{'iscsi_target_extent_path'} =~ /^$lun_path$/ ) {
$lun = $item;
last;
}
}
die "Unable to find the lun $lun_path for $scfg->{target}" if !defined($lun);
my $target_id = freenas_get_targetid($scfg);
die "Unable to find the target id for $scfg->{target}" if !defined($target_id);
# find the target to extent
my $target2extents = freenas_iscsi_get_target_to_extent($scfg);
foreach my $item ( @$target2extents ) {
if( $item->{'iscsi_target'} == $target_id &&
$item->{'iscsi_lunid'} == $lun->{'iscsi_lunid'} &&
$item->{'iscsi_extent'} == $lun->{'id'} ) {
$link = $item;
last;
}
}
die "Unable to find the link for the lun $lun_path for $scfg->{target}" if !defined($link);
# Remove the link
my $remove_link = freenas_iscsi_remove_target_to_extent($scfg,$link->{'id'});
# Remove the extent
my $remove_extent = freenas_iscsi_remove_extent($scfg,$lun->{'id'});
if( $remove_link == 1 && $remove_extent == 1 ) {
syslog("info","FreeNAS::delete_lu(lun_path=$lun_path) : sucessfull");
} else {
die "Unable to delete lun $lun_path";
}
return "";
}
### FREENAS API CALLING ###
sub freenas_api_call {
my ($scfg, $method, $path, $data) = @_;
my $client = undef;
$client = REST::Client->new();
$client->setHost('http://'. $scfg->{portal} );
$client->addHeader('Content-Type' , 'application/json' );
$client->addHeader('Authorization' , 'Basic ' . encode_base64( $scfg->{freenas_user} . ':' . $scfg->{freenas_password} ) );
if ($method eq 'GET') { $client->GET($path); }
if ($method eq 'DELETE') { $client->DELETE($path); }
if ($method eq 'POST') { $client->POST($path, encode_json($data) ); }
return $client
}
sub freenas_api_log_error {
my ($client, $method) = @_;
syslog("info","[ERROR]FreeNAS::API::" . $method . " : Response code: ".$client->responseCode());
syslog("info","[ERROR]FreeNAS::API::" . $method . " : Response content: ".$client->responseContent());
return 1;
}
sub freenas_iscsi_get_globalconfiguration {
my ($scfg) = @_;
my $client = freenas_api_call($scfg,'GET',"/api/v1.0/services/iscsi/globalconfiguration/",undef);
my $code = $client->responseCode();
if ($code == 200) {
my $result = decode_json($client->responseContent());
syslog("info","FreeNAS::API::get_globalconfig : target_basename=". $result->{'iscsi_basename'});
return $result;
} else {
freenas_api_log_error($client, "get_globalconfig");
return undef;
}
}
# Returns a list of all extents.
# http://api.freenas.org/resources/iscsi/index.html#get--api-v1.0-services-iscsi-extent-
sub freenas_iscsi_get_extent {
my ($scfg) = @_;
my $client = freenas_api_call($scfg,'GET',"/api/v1.0/services/iscsi/extent/",undef);
my $code = $client->responseCode();
if ($code == 200) {
my $result = decode_json($client->responseContent());
syslog("info","FreeNAS::API::get_extent : sucessfull");
return $result;
} else {
freenas_api_log_error($client, "get_extent");
return undef;
}
}
# Create an extent on FreeNas
# http://api.freenas.org/resources/iscsi/index.html#create-resource
# Parameters:
# - target config (scfg)
# - lun_path
# - lun_bs
sub freenas_iscsi_create_extent {
my ($scfg, $lun_path, $lun_bs) = @_;
my $name = $lun_path;
$name =~ s/^.*\///; # all from last /
$name = $scfg->{'pool'} . '/' . $name;
my $device = $lun_path;
$device =~ s/^\/dev\///; # strip /dev/
my $request = {
"iscsi_target_extent_type" => "Disk",
"iscsi_target_extent_name" => $name,
"iscsi_target_extent_blocksize" => $lun_bs,
"iscsi_target_extent_disk" => $device,
};
my $client = freenas_api_call($scfg, 'POST', "/api/v1.0/services/iscsi/extent/", $request);
my $code = $client->responseCode();
if ($code == 201) {
my $result = decode_json($client->responseContent());
syslog("info","FreeNAS::API::create_extent(lun_path=". $result->{'iscsi_target_extent_path'} . ", lun_bs=$lun_bs) : sucessfull");
return $result;
} else {
freenas_api_log_error($client, "create_extent");
return undef;
}
}
# Remove an extent by it's id
# http://api.freenas.org/resources/iscsi/index.html#delete-resource
# Parameters:
# - scfg
# - extent_id
sub freenas_iscsi_remove_extent {
my ($scfg,$extent_id) = @_;
my $client = freenas_api_call($scfg, 'DELETE', "/api/v1.0/services/iscsi/extent/$extent_id/", undef);
my $code = $client->responseCode();
if ($code == 204) {
syslog("info","FreeNAS::API::remove_extent(extent_id=$extent_id) : sucessfull");
return 1;
} else {
freenas_api_log_error($client, "remove_extent");
return 0;
}
}
# Returns a list of all targets
# http://api.freenas.org/resources/iscsi/index.html#get--api-v1.0-services-iscsi-target-
sub freenas_iscsi_get_target {
my ($scfg) = @_;
my $client = freenas_api_call($scfg,'GET',"/api/v1.0/services/iscsi/target/",undef);
my $code = $client->responseCode();
if ($code == 200) {
my $result = decode_json($client->responseContent());
syslog("info","FreeNAS::API::get_target() : sucessfull");
return $result;
} else {
freenas_api_log_error($client, "get_target");
return undef;
}
}
# Returns a list of associated extents to targets
# http://api.freenas.org/resources/iscsi/index.html#get--api-v1.0-services-iscsi-targettoextent-
sub freenas_iscsi_get_target_to_extent {
my ($scfg) = @_;
my $client = freenas_api_call($scfg,'GET',"/api/v1.0/services/iscsi/targettoextent/",undef);
my $code = $client->responseCode();
if ($code == 200) {
my $result = decode_json($client->responseContent());
syslog("info","FreeNAS::API::get_target_to_extent() : sucessfull");
return $result;
} else {
freenas_api_log_error($client, "get_target_to_extent");
return undef;
}
}
# Associate a FreeNas extent to a FreeNas Target
# http://api.freenas.org/resources/iscsi/index.html#post--api-v1.0-services-iscsi-targettoextent-
# Parameters:
# - target config (scfg)
# - FreeNas Target ID
# - FreeNas Extent ID
# - Lun ID
sub freenas_iscsi_create_target_to_extent {
my ($scfg,$target_id,$extent_id,$lun_id) = @_;
my $request = {
"iscsi_target" => $target_id,
"iscsi_extent" => $extent_id,
"iscsi_lunid" => $lun_id
};
my $client = freenas_api_call($scfg, 'POST', "/api/v1.0/services/iscsi/targettoextent/", $request);
my $code = $client->responseCode();
if ($code == 201) {
my $result = decode_json($client->responseContent());
syslog("info","FreeNAS::API::create_target_to_extent(target_id=$target_id, extent_id=$extent_id, lun_id=$lun_id) : sucessfull");
return $result;
} else {
freenas_api_log_error($client, "create_target_to_extent");
return undef;
}
}
# Remove a Target to extent by it's id
# http://api.freenas.org/resources/iscsi/index.html#delete--api-v1.0-services-iscsi-targettoextent-(int-id)-
# Parameters:
# - scfg
# - link_id
sub freenas_iscsi_remove_target_to_extent {
my ($scfg,$link_id) = @_;
my $client = freenas_api_call($scfg, 'DELETE', "/api/v1.0/services/iscsi/targettoextent/$link_id/", undef);
my $code = $client->responseCode();
if ($code == 204) {
syslog("info","FreeNAS::API::remove_target_to_extent(link_id=$link_id) : sucessfull");
return 1;
} else {
freenas_api_log_error($client, "remove_target_to_extent");
return 0;
}
}
# Returns all luns associated to the current target defined by $scfg->{target}
# This method returns an array reference like "freenas_iscsi_get_extent" do
# but with an additionnal hash entry "iscsi_lunid" retrieved from "freenas_iscsi_get_target_to_extent"
#
sub freenas_list_lu {
my ($scfg) = @_;
my $targets = freenas_iscsi_get_target($scfg);
my $target_id = freenas_get_targetid($scfg);
my @luns = ();
if( defined($target_id) ) {
my $target2extents = freenas_iscsi_get_target_to_extent($scfg);
my $extents = freenas_iscsi_get_extent($scfg);
foreach my $item ( @$target2extents ) {
if( $item->{'iscsi_target'} == $target_id ) {
foreach my $node ( @$extents ) {
if( $node->{'id'} == $item->{'iscsi_extent'} ) {
$node->{'iscsi_lunid'} .= $item->{'iscsi_lunid'};
push( @luns , $node );
}
}
}
}
}
syslog("info","FreeNAS::API::freenas_list_lu : sucessfull");
return \@luns;
}
# Returns the first available "lunid" (in all targets namespaces)
#
sub freenas_get_first_available_lunid {
my ($scfg) = @_;
my $target_id = freenas_get_targetid($scfg);
my $target2extents = freenas_iscsi_get_target_to_extent($scfg);
my @luns = ();
foreach my $item ( @$target2extents ) {
push(@luns, $item->{'iscsi_lunid'}) if ($item->{'iscsi_target'} == $target_id);
}
my @sorted_luns = sort(@luns);
my $lun_id = 0;
# find the first hole, if not, give the +1 of the last lun
foreach my $lun ( @sorted_luns ) {
last if $lun != $lun_id;
$lun_id = $lun_id + 1;
}
syslog("info","FreeNAS::API::freenas_get_first_available_lunid : return $lun_id");
return $lun_id;
}
#
# Returns the target id on FreeNas of the currently configured target of this PVE storage
#
sub freenas_get_targetid {
my ($scfg) = @_;
my $global = freenas_iscsi_get_globalconfiguration($scfg);
my $targets = freenas_iscsi_get_target($scfg);
my $target_id = undef;
foreach my $target ( @$targets ) {
my $iqn = $global->{'iscsi_basename'} . ':' . $target->{'iscsi_target_name'};
if( $iqn eq $scfg->{target} ) { $target_id = $target->{'id'}; last }
}
return $target_id;
}
1;

View File

@ -0,0 +1,37 @@
--- mountpoint/PVE/Storage/ZFSPlugin.pm 2017-05-17 15:19:32.000000000 +0200
+++ mountpoint/PVE/Storage/ZFSPlugin.pm 2017-05-17 15:24:07.000000000 +0200
@@ -12,6 +12,7 @@
use PVE::Storage::LunCmd::Comstar;
use PVE::Storage::LunCmd::Istgt;
use PVE::Storage::LunCmd::Iet;
+use PVE::Storage::LunCmd::FreeNAS;
my @ssh_opts = ('-o', 'BatchMode=yes');
@@ -31,7 +32,7 @@
my $zfs_unknown_scsi_provider = sub {
my ($provider) = @_;
- die "$provider: unknown iscsi provider. Available [comstar, istgt, iet]";
+ die "$provider: unknown iscsi provider. Available [comstar, istgt, iet, freenas]";
};
my $zfs_get_base = sub {
@@ -43,6 +44,8 @@
return PVE::Storage::LunCmd::Istgt::get_base;
} elsif ($scfg->{iscsiprovider} eq 'iet') {
return PVE::Storage::LunCmd::Iet::get_base;
+ } elsif ($scfg->{iscsiprovider} eq 'freenas') {
+ return PVE::Storage::LunCmd::FreeNAS::get_base;
} else {
$zfs_unknown_scsi_provider->($scfg->{iscsiprovider});
}
@@ -63,6 +66,8 @@
$msg = PVE::Storage::LunCmd::Istgt::run_lun_command($scfg, $timeout, $method, @params);
} elsif ($scfg->{iscsiprovider} eq 'iet') {
$msg = PVE::Storage::LunCmd::Iet::run_lun_command($scfg, $timeout, $method, @params);
+ } elsif ($scfg->{iscsiprovider} eq 'freenas') {
+ $msg = PVE::Storage::LunCmd::FreeNAS::run_lun_command($scfg, $timeout, $method, @params);
} else {
$zfs_unknown_scsi_provider->($scfg->{iscsiprovider});
}

553
perl5/REST/Client.pm Executable file
View File

@ -0,0 +1,553 @@
package REST::Client;
=head1 NAME
REST::Client - A simple client for interacting with RESTful http/https resources
=head1 SYNOPSIS
use REST::Client;
#The basic use case
my $client = REST::Client->new();
$client->GET('http://example.com/dir/file.xml');
print $client->responseContent();
#A host can be set for convienience
$client->setHost('http://example.com');
$client->PUT('/dir/file.xml', '<example>new content</example>');
if( $client->responseCode() eq '200' ){
print "Updated\n";
}
#custom request headers may be added
$client->addHeader('CustomHeader', 'Value');
#response headers may be gathered
print $client->responseHeader('ResponseHeader');
#X509 client authentication
$client->setCert('/path/to/ssl.crt');
$client->setKey('/path/to/ssl.key');
#add a CA to verify server certificates
$client->setCa('/path/to/ca.file');
#you may set a timeout on requests, in seconds
$client->setTimeout(10);
#options may be passed as well as set
$client = REST::Client->new({
host => 'https://example.com',
cert => '/path/to/ssl.crt',
key => '/path/to/ssl.key',
ca => '/path/to/ca.file',
timeout => 10,
});
$client->GET('/dir/file', {CustomHeader => 'Value'});
# Requests can be specificed directly as well
$client->request('GET', '/dir/file', 'request body content', {CustomHeader => 'Value'});
# Requests can optionally automatically follow redirects and auth, defaults to
# false
$client->setFollow(1);
#It is possible to access the L<LWP::UserAgent> object REST::Client is using to
#make requests, and set advanced options on it, for instance:
$client->getUseragent()->proxy(['http'], 'http://proxy.example.com/');
# request responses can be written directly to a file
$client->setContentFile( "FileName" );
# or call back method
$client->setContentFile( \&callback_method );
# see LWP::UserAgent for how to define callback methods
=head1 DESCRIPTION
REST::Client provides a simple way to interact with HTTP RESTful resources.
=cut
=head1 METHODS
=cut
use strict;
use warnings;
use 5.008_000;
use constant TRUE => 1;
use constant FALSE => 0;
our ($VERSION) = ('$Rev: 273 $' =~ /(\d+)/);
use URI;
use LWP::UserAgent;
use Carp qw(croak carp);
=head2 Construction and setup
=head3 new ( [%$config] )
Construct a new REST::Client. Takes an optional hash or hash reference or
config flags. Each config flag also has get/set accessors of the form
getHost/setHost, getUseragent/setUseragent, etc. These can be called on the
instantiated object to change or check values.
The config flags are:
=over 4
=item host
A default host that will be prepended to all requests. Allows you to just
specify the path when making requests.
The default is undef - you must include the host in your requests.
=item timeout
A timeout in seconds for requests made with the client. After the timeout the
client will return a 500.
The default is 5 minutes.
=item cert
The path to a X509 certificate file to be used for client authentication.
The default is to not use a certificate/key pair.
=item key
The path to a X509 key file to be used for client authentication.
The default is to not use a certificate/key pair.
=item ca
The path to a certificate authority file to be used to verify host
certificates.
The default is to not use a certificates authority.
=item pkcs12
The path to a PKCS12 certificate to be used for client authentication.
=item pkcs12password
The password for the PKCS12 certificate specified with 'pkcs12'.
=item follow
Boolean that determins whether REST::Client attempts to automatically follow
redirects/authentication.
The default is false.
=item useragent
An L<LWP::UserAgent> object, ready to make http requests.
REST::Client will provide a default for you if you do not set this.
=back
=cut
sub new {
my $class = shift;
my $config;
$class->_buildAccessors();
if(ref $_[0] eq 'HASH'){
$config = shift;
}elsif(scalar @_ && scalar @_ % 2 == 0){
$config = {@_};
}else{
$config = {};
}
my $self = bless({}, $class);
$self->{'_config'} = $config;
$self->_buildUseragent();
return $self;
}
=head3 addHeader ( $header_name, $value )
Add a custom header to any requests made by this client.
=cut
sub addHeader {
my $self = shift;
my $header = shift;
my $value = shift;
my $headers = $self->{'_headers'} || {};
$headers->{$header} = $value;
$self->{'_headers'} = $headers;
return;
}
=head3 buildQuery ( [...] )
A convienience wrapper around URI::query_form for building query strings from a
variety of data structures. See L<URI>
Returns a scalar query string for use in URLs.
=cut
sub buildQuery {
my $self = shift;
my $uri = URI->new();
$uri->query_form(@_);
return $uri->as_string();
}
=head2 Request Methods
Each of these methods makes an HTTP request, sets the internal state of the
object, and returns the object.
They can be combined with the response methods, such as:
print $client->GET('/search/?q=foobar')->responseContent();
=head3 GET ( $url, [%$headers] )
Preform an HTTP GET to the resource specified. Takes an optional hashref of custom request headers.
=cut
sub GET {
my $self = shift;
my $url = shift;
my $headers = shift;
return $self->request('GET', $url, undef, $headers);
}
=head3 PUT ($url, [$body_content, %$headers] )
Preform an HTTP PUT to the resource specified. Takes an optional body content and hashref of custom request headers.
=cut
sub PUT {
my $self = shift;
return $self->request('PUT', @_);
}
=head3 PATCH ( $url, [$body_content, %$headers] )
Preform an HTTP PATCH to the resource specified. Takes an optional body content and hashref of custom request headers.
=cut
sub PATCH {
my $self = shift;
return $self->request('PATCH', @_);
}
=head3 POST ( $url, [$body_content, %$headers] )
Preform an HTTP POST to the resource specified. Takes an optional body content and hashref of custom request headers.
=cut
sub POST {
my $self = shift;
return $self->request('POST', @_);
}
=head3 DELETE ( $url, [%$headers] )
Preform an HTTP DELETE to the resource specified. Takes an optional hashref of custom request headers.
=cut
sub DELETE {
my $self = shift;
my $url = shift;
my $headers = shift;
return $self->request('DELETE', $url, undef, $headers);
}
=head3 OPTIONS ( $url, [%$headers] )
Preform an HTTP OPTIONS to the resource specified. Takes an optional hashref of custom request headers.
=cut
sub OPTIONS {
my $self = shift;
my $url = shift;
my $headers = shift;
return $self->request('OPTIONS', $url, undef, $headers);
}
=head3 HEAD ( $url, [%$headers] )
Preform an HTTP HEAD to the resource specified. Takes an optional hashref of custom request headers.
=cut
sub HEAD {
my $self = shift;
my $url = shift;
my $headers = shift;
return $self->request('HEAD', $url, undef, $headers);
}
=head3 request ( $method, $url, [$body_content, %$headers] )
Issue a custom request, providing all possible values.
=cut
sub request {
my $self = shift;
my $method = shift;
my $url = shift;
my $content = shift;
my $headers = shift;
$self->{'_res'} = undef;
$self->_buildUseragent();
#error check
croak "REST::Client exception: First argument to request must be one of GET, PATCH, PUT, POST, DELETE, OPTIONS, HEAD" unless $method =~ /^(get|patch|put|post|delete|options|head)$/i;
croak "REST::Client exception: Must provide a url to $method" unless $url;
croak "REST::Client exception: headers must be presented as a hashref" if $headers && ref $headers ne 'HASH';
$url = $self->_prepareURL($url);
my $ua = $self->getUseragent();
if(defined $self->getTimeout()){
$ua->timeout($self->getTimeout);
}else{
$ua->timeout(300);
}
my $req = HTTP::Request->new( $method => $url );
#build headers
if(defined $content && length($content)){
$req->content($content);
$req->header('Content-Length', length($content));
}else{
$req->header('Content-Length', 0);
}
my $custom_headers = $self->{'_headers'} || {};
for my $header (keys %$custom_headers){
$req->header($header, $custom_headers->{$header});
}
for my $header (keys %$headers){
$req->header($header, $headers->{$header});
}
#prime LWP with ssl certfile if we have values
if($self->getCert){
carp "REST::Client exception: Certs defined but not using https" unless $url =~ /^https/;
croak "REST::Client exception: Cannot read cert and key file" unless -f $self->getCert && -f $self->getKey;
$ua->ssl_opts(SSL_cert_file => $self->getCert);
$ua->ssl_opts(SSL_key_file => $self->getKey);
}
#prime LWP with CA file if we have one
if(my $ca = $self->getCa){
croak "REST::Client exception: Cannot read CA file" unless -f $ca;
$ua->ssl_opts(SSL_ca_file => $ca);
}
#prime LWP with PKCS12 certificate if we have one
if($self->getPkcs12){
carp "REST::Client exception: PKCS12 cert defined but not using https" unless $url =~ /^https/;
croak "REST::Client exception: Cannot read PKCS12 cert" unless -f $self->getPkcs12;
$ENV{HTTPS_PKCS12_FILE} = $self->getPkcs12;
if($self->getPkcs12password){
$ENV{HTTPS_PKCS12_PASSWORD} = $self->getPkcs12password;
}
}
my $res = $self->getFollow ?
$ua->request( $req, $self->getContentFile ) :
$ua->simple_request( $req, $self->getContentFile );
$self->{_res} = $res;
return $self;
}
=head2 Response Methods
Use these methods to gather information about the last requset
performed.
=head3 responseCode ()
Return the HTTP response code of the last request
=cut
sub responseCode {
my $self = shift;
return $self->{_res}->code;
}
=head3 responseContent ()
Return the response body content of the last request
=cut
sub responseContent {
my $self = shift;
return $self->{_res}->content;
}
=head3 responseHeaders()
Returns a list of HTTP header names from the last response
=cut
sub responseHeaders {
my $self = shift;
return $self->{_res}->headers()->header_field_names();
}
=head3 responseHeader ( $header )
Return a HTTP header from the last response
=cut
sub responseHeader {
my $self = shift;
my $header = shift;
croak "REST::Client exception: no header provided to responseHeader" unless $header;
return $self->{_res}->header($header);
}
=head3 responseXpath ()
A convienience wrapper that returns a L<XML::LibXML> xpath context for the body content. Assumes the content is XML.
=cut
sub responseXpath {
my $self = shift;
require XML::LibXML;
my $xml= XML::LibXML->new();
$xml->load_ext_dtd(0);
if($self->responseHeader('Content-type') =~ /html/){
return XML::LibXML::XPathContext->new($xml->parse_html_string( $self->responseContent() ));
}else{
return XML::LibXML::XPathContext->new($xml->parse_string( $self->responseContent() ));
}
}
# Private methods
sub _prepareURL {
my $self = shift;
my $url = shift;
my $host = $self->getHost;
if($host){
$url = '/'.$url unless $url =~ /^\//;
$url = $host . $url;
}
unless($url =~ /^\w+:\/\//){
$url = ($self->getCert ? 'https://' : 'http://') . $url;
}
return $url;
}
sub _buildUseragent {
my $self = shift;
return if $self->getUseragent();
my $ua = LWP::UserAgent->new;
$ua->agent("REST::Client/$VERSION");
$self->setUseragent($ua);
return;
}
sub _buildAccessors {
my $self = shift;
return if $self->can('setHost');
my @attributes = qw(Host Key Cert Ca Timeout Follow Useragent Pkcs12 Pkcs12password ContentFile);
for my $attribute (@attributes){
my $set_method = "
sub {
my \$self = shift;
\$self->{'_config'}{lc('$attribute')} = shift;
return \$self->{'_config'}{lc('$attribute')};
}";
my $get_method = "
sub {
my \$self = shift;
return \$self->{'_config'}{lc('$attribute')};
}";
{
no strict 'refs';
*{'REST::Client::set'.$attribute} = eval $set_method ;
*{'REST::Client::get'.$attribute} = eval $get_method ;
}
}
return;
}
1;
=head1 TODO
Caching, content-type negotiation, readable handles for body content.
=head1 AUTHOR
Miles Crawford, E<lt>mcrawfor@cpan.orgE<gt>
=head1 COPYRIGHT
Copyright 2008 - 2010 by Miles Crawford
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut

View File

@ -0,0 +1,9 @@
--- pvemanagerlib.js 2017-05-17 14:40:41.495308664 +0200
+++ pvemanagerlib.js 2017-05-17 14:41:17.439945082 +0200
@@ -7258,7 +7258,8 @@
comboItems: [
['comstar', 'Comstar'],
[ 'istgt', 'istgt'],
- [ 'iet', 'IET']
+ [ 'iet', 'IET'],
+ [ 'freenas', 'FreeNAS']