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