PVE/APIClient/Helpers.pm

   1 package PVE::APIClient::Helpers;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Data::Dumper;
   7 use JSON;
   8 use PVE::APIClient::Exception qw(raise);
   9 use Getopt::Long;
  10 use Encode::Locale;
  11 use Encode;
  12 use HTTP::Status qw(:constants);
  13
  14 my $pve_api_definition;
  15 my $pve_api_path_hash;
  16
  17 my $pve_api_definition_fn = "/usr/share/pve-client/pve-api-definition.js";
  18
  19 my $build_pve_api_path_hash;
  20 $build_pve_api_path_hash = sub {
  21     my ($tree) = @_;
  22
  23     my $class = ref($tree);
  24     return $tree if !$class;
  25
  26     if ($class eq 'ARRAY') {
  27         foreach my $el (@$tree) {
  28             $build_pve_api_path_hash->($el);
  29         }
  30     } elsif ($class eq 'HASH') {
  31         if (defined($tree->{leaf}) && defined(my $path = $tree->{path})) {
  32             $pve_api_path_hash->{$path} = $tree;
  33         }
  34         foreach my $k (keys %$tree) {
  35             $build_pve_api_path_hash->($tree->{$k});
  36         }
  37     }
  38 };
  39
  40 sub get_api_definition {
  41
  42     if (!defined($pve_api_definition)) {
  43         local $/;
  44         open(my $fh, '<',  $pve_api_definition_fn) ||
  45             die "unable to open '$pve_api_definition_fn' - $!\n";
  46         my $json_text = <$fh>;
  47         $pve_api_definition = decode_json($json_text);
  48
  49         $build_pve_api_path_hash->($pve_api_definition);
  50     }
  51
  52
  53     return $pve_api_definition;
  54 }
  55
  56 sub lookup_api_method {
  57     my ($path, $method) = @_;
  58
  59     get_api_definition(); # make sure API data is loaded
  60
  61     my $info = $pve_api_path_hash->{$path} ||
  62         die "unable to find API info for path '$path'\n";
  63
  64     my $data = $info->{info}->{$method} ||
  65         die "unable to find API method '$method' for path '$path'\n";
  66
  67     return $data;
  68 }
  69
  70 # Getopt wrapper - copied from PVE::JSONSchema::get_options
  71 # a way to parse command line parameters, using a
  72 # schema to configure Getopt::Long
  73 sub get_options {
  74     my ($schema, $args, $arg_param, $fixed_param, $pwcallback, $param_mapping_hash) = @_;
  75
  76     if (!$schema || !$schema->{properties}) {
  77         raise("too many arguments\n", code => HTTP_BAD_REQUEST)
  78             if scalar(@$args) != 0;
  79         return {};
  80     }
  81
  82     my $list_param;
  83     if ($arg_param && !ref($arg_param)) {
  84         my $pd = $schema->{properties}->{$arg_param};
  85         die "expected list format $pd->{format}"
  86             if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
  87         $list_param = $arg_param;
  88     }
  89
  90     my @interactive = ();
  91     my @getopt = ();
  92     foreach my $prop (keys %{$schema->{properties}}) {
  93         my $pd = $schema->{properties}->{$prop};
  94         next if $list_param && $prop eq $list_param;
  95         next if defined($fixed_param->{$prop});
  96
  97         my $mapping = $param_mapping_hash->{$prop};
  98         if ($mapping && $mapping->{interactive}) {
  99             # interactive parameters such as passwords: make the argument
 100             # optional and call the mapping function afterwards.
 101             push @getopt, "$prop:s";
 102             push @interactive, [$prop, $mapping->{func}];
 103         } elsif ($prop eq 'password' && $pwcallback) {
 104             # we do not accept plain password on input line, instead
 105             # we turn this into a boolean option and ask for password below
 106             # using $pwcallback() (for security reasons).
 107             push @getopt, "$prop";
 108         } elsif ($pd->{type} eq 'boolean') {
 109             push @getopt, "$prop:s";
 110         } else {
 111             if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
 112                 push @getopt, "$prop=s@";
 113             } else {
 114                 push @getopt, "$prop=s";
 115             }
 116         }
 117     }
 118
 119     Getopt::Long::Configure('prefix_pattern=(--|-)');
 120
 121     my $opts = {};
 122     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
 123         if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
 124
 125     if (@$args) {
 126         if ($list_param) {
 127             $opts->{$list_param} = $args;
 128             $args = [];
 129         } elsif (ref($arg_param)) {
 130             foreach my $arg_name (@$arg_param) {
 131                 if ($opts->{'extra-args'}) {
 132                     raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
 133                 }
 134                 if ($arg_name eq 'extra-args') {
 135                     $opts->{'extra-args'} = $args;
 136                     $args = [];
 137                     next;
 138                 }
 139                 raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
 140                 $opts->{$arg_name} = shift @$args;
 141             }
 142             raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
 143         } else {
 144             raise("too many arguments\n", code => HTTP_BAD_REQUEST)
 145                 if scalar(@$args) != 0;
 146         }
 147     }
 148
 149     if (my $pd = $schema->{properties}->{password}) {
 150         if ($pd->{type} ne 'boolean' && $pwcallback) {
 151             if ($opts->{password} || !$pd->{optional}) {
 152                 $opts->{password} = &$pwcallback();
 153             }
 154         }
 155     }
 156
 157     foreach my $entry (@interactive) {
 158         my ($opt, $func) = @$entry;
 159         my $pd = $schema->{properties}->{$opt};
 160         my $value = $opts->{$opt};
 161         if (defined($value) || !$pd->{optional}) {
 162             $opts->{$opt} = $func->($value);
 163         }
 164     }
 165
 166     # decode after Getopt as we are not sure how well it handles unicode
 167     foreach my $p (keys %$opts) {
 168         if (!ref($opts->{$p})) {
 169             $opts->{$p} = decode('locale', $opts->{$p});
 170         } elsif (ref($opts->{$p}) eq 'ARRAY') {
 171             my $tmp = [];
 172             foreach my $v (@{$opts->{$p}}) {
 173                 push @$tmp, decode('locale', $v);
 174             }
 175             $opts->{$p} = $tmp;
 176         } elsif (ref($opts->{$p}) eq 'SCALAR') {
 177             $opts->{$p} = decode('locale', $$opts->{$p});
 178         } else {
 179             raise("decoding options failed, unknown reference\n", code => HTTP_BAD_REQUEST);
 180         }
 181     }
 182
 183     foreach my $p (keys %$opts) {
 184         if (my $pd = $schema->{properties}->{$p}) {
 185             if ($pd->{type} eq 'boolean') {
 186                 if ($opts->{$p} eq '') {
 187                     $opts->{$p} = 1;
 188                 } elsif (defined(my $bool = parse_boolean($opts->{$p}))) {
 189                     $opts->{$p} = $bool;
 190                 } else {
 191                     raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
 192                 }
 193             } elsif ($pd->{format}) {
 194
 195                 if ($pd->{format} =~ m/-list/) {
 196                     # allow --vmid 100 --vmid 101 and --vmid 100,101
 197                     # allow --dow mon --dow fri and --dow mon,fri
 198                     $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
 199                 } elsif ($pd->{format} =~ m/-alist/) {
 200                     # we encode array as \0 separated strings
 201                     # Note: CGI.pm also use this encoding
 202                     if (scalar(@{$opts->{$p}}) != 1) {
 203                         $opts->{$p} = join("\0", @{$opts->{$p}});
 204                     } else {
 205                         # st that split_list knows it is \0 terminated
 206                         my $v = $opts->{$p}->[0];
 207                         $opts->{$p} = "$v\0";
 208                     }
 209                 }
 210             }
 211         }
 212     }
 213
 214     foreach my $p (keys %$fixed_param) {
 215         $opts->{$p} = $fixed_param->{$p};
 216     }
 217
 218     return $opts;
 219 }
 220
 221
 222 1;