first commit
This commit is contained in:
commit
d91ec2d0b8
|
|
@ -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
|
||||
|
|
@ -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;
|
||||
|
|
@ -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});
|
||||
}
|
||||
|
|
@ -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
|
||||
|
|
@ -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']
|
||||
Loading…
Reference in New Issue