src/PVE/RESTHandler.pm

   1 package PVE::RESTHandler;
   2
   3 use strict;
   4 use warnings;
   5 use PVE::SafeSyslog;
   6 use PVE::Exception qw(raise raise_param_exc);
   7 use PVE::JSONSchema;
   8 use PVE::Tools;
   9 use HTTP::Status qw(:constants :is status_message);
  10 use Text::Wrap;
  11 use Clone qw(clone);
  12
  13 my $method_registry = {};
  14 my $method_by_name = {};
  15 my $method_path_lookup = {};
  16
  17 our $AUTOLOAD;  # it's a package global
  18
  19 our $standard_output_options = {
  20     'output-format' => PVE::JSONSchema::get_standard_option('pve-output-format'),
  21     noheader => {
  22         description => "Do not show column headers (for 'text' format).",
  23         type => 'boolean',
  24         optional => 1,
  25         default => 0,
  26     },
  27     noborder => {
  28         description => "Do not draw borders (for 'text' format).",
  29         type => 'boolean',
  30         optional => 1,
  31         default => 0,
  32     },
  33     quiet => {
  34         description => "Suppress printing results.",
  35         type => 'boolean',
  36         optional => 1,
  37     },
  38     'human-readable' => {
  39         description => "Call output rendering functions to produce human readable text.",
  40         type => 'boolean',
  41         optional => 1,
  42         default => 1,
  43     }
  44 };
  45
  46 sub api_clone_schema {
  47     my ($schema, $no_typetext) = @_;
  48
  49     my $res = {};
  50     my $ref = ref($schema);
  51     die "not a HASH reference" if !($ref && $ref eq 'HASH');
  52
  53     foreach my $k (keys %$schema) {
  54         my $d = $schema->{$k};
  55         if ($k ne 'properties') {
  56             $res->{$k} = ref($d) ? clone($d) : $d;
  57             next;
  58         }
  59         # convert indexed parameters like -net\d+ to -net[n]
  60         foreach my $p (keys %$d) {
  61             my $pd = $d->{$p};
  62             if ($p =~ m/^([a-z]+)(\d+)$/) {
  63                 my ($name, $idx) = ($1, $2);
  64                 if ($idx == 0 && defined($d->{"${name}1"})) {
  65                     $p = "${name}[n]";
  66                 } elsif ($idx > 0 && defined($d->{"${name}0"})) {
  67                     next; # only handle once for -xx0, but only if -xx0 exists
  68                 }
  69             }
  70             my $tmp = ref($pd) ? clone($pd) : $pd;
  71             # NOTE: add typetext property for complexer types, to make the web api-viewer code simpler
  72             if (!$no_typetext && !(defined($tmp->{enum}) || defined($tmp->{pattern}))) {
  73                 my $typetext = PVE::JSONSchema::schema_get_type_text($tmp);
  74                 if ($tmp->{type} && ($tmp->{type} ne $typetext)) {
  75                     $tmp->{typetext} = $typetext;
  76                 }
  77             }
  78             $res->{$k}->{$p} = $tmp;
  79         }
  80     }
  81
  82     return $res;
  83 }
  84
  85 sub api_dump_full {
  86     my ($tree, $index, $class, $prefix, $raw_dump) = @_;
  87
  88     $prefix = '' if !$prefix;
  89
  90     my $ma = $method_registry->{$class};
  91
  92     foreach my $info (@$ma) {
  93
  94         my $path = "$prefix/$info->{path}";
  95         $path =~ s/\/+$//;
  96
  97         if ($info->{subclass}) {
  98             api_dump_full($tree, $index, $info->{subclass}, $path, $raw_dump);
  99         } else {
 100             next if !$path;
 101
 102             # check if method is unique
 103             my $realpath = $path;
 104             $realpath =~ s/\{[^\}]+\}/\{\}/g;
 105             my $fullpath = "$info->{method} $realpath";
 106             die "duplicate path '$realpath'" if $index->{$fullpath};
 107             $index->{$fullpath} = $info;
 108
 109             # insert into tree
 110             my $treedir = $tree;
 111             my $res;
 112             my $sp = '';
 113             foreach my $dir (split('/', $path)) {
 114                 next if !$dir;
 115                 $sp .= "/$dir";
 116                 $res = (grep { $_->{text} eq $dir } @$treedir)[0];
 117                 if ($res) {
 118                     $res->{children} = [] if !$res->{children};
 119                     $treedir = $res->{children};
 120                 } else {
 121                     $res = {
 122                         path => $sp,
 123                         text => $dir,
 124                         children => [],
 125                     };
 126                     push @$treedir, $res;
 127                     $treedir = $res->{children};
 128                 }
 129             }
 130
 131             if ($res) {
 132                 my $data = {};
 133                 foreach my $k (keys %$info) {
 134                     next if $k eq 'code' || $k eq "match_name" || $k eq "match_re" ||
 135                         $k eq "path";
 136
 137                     my $d = $info->{$k};
 138
 139                     if ($raw_dump) {
 140                         $data->{$k} = $d;
 141                     } else {
 142                         if ($k eq 'parameters') {
 143                             $data->{$k} = api_clone_schema($d);
 144                         } elsif ($k eq 'returns') {
 145                             $data->{$k} = api_clone_schema($d, 1);
 146                         } else {
 147                             $data->{$k} = ref($d) ? clone($d) : $d;
 148                         }
 149                     }
 150                 }
 151                 $res->{info}->{$info->{method}} = $data;
 152             };
 153         }
 154     }
 155 };
 156
 157 sub api_dump_cleanup_tree {
 158     my ($tree) = @_;
 159
 160     foreach my $rec (@$tree) {
 161         delete $rec->{children} if $rec->{children} && !scalar(@{$rec->{children}});
 162         if ($rec->{children}) {
 163             $rec->{leaf} = 0;
 164             api_dump_cleanup_tree($rec->{children});
 165         } else {
 166             $rec->{leaf} = 1;
 167         }
 168     }
 169
 170 }
 171
 172 # api_dump_remove_refs: prepare API tree for use with to_json($tree)
 173 sub api_dump_remove_refs {
 174     my ($tree) = @_;
 175
 176     my $class = ref($tree);
 177     return $tree if !$class;
 178
 179     if ($class eq 'ARRAY') {
 180         my $res = [];
 181         foreach my $el (@$tree) {
 182             push @$res, api_dump_remove_refs($el);
 183         }
 184         return $res;
 185     } elsif ($class eq 'HASH') {
 186         my $res = {};
 187         foreach my $k (keys %$tree) {
 188             if (my $itemclass = ref($tree->{$k})) {
 189                 if ($itemclass eq 'CODE') {
 190                     next if $k eq 'completion';
 191                 }
 192                 $res->{$k} = api_dump_remove_refs($tree->{$k});
 193             } else {
 194                 $res->{$k} = $tree->{$k};
 195             }
 196         }
 197         return $res;
 198     } elsif ($class eq 'Regexp') {
 199         return "$tree"; # return string representation
 200     } else {
 201         die "unknown class '$class'\n";
 202     }
 203 }
 204
 205 sub api_dump {
 206     my ($class, $prefix, $raw_dump) = @_;
 207
 208     my $tree = [];
 209
 210     my $index = {};
 211     api_dump_full($tree, $index, $class, $prefix, $raw_dump);
 212     api_dump_cleanup_tree($tree);
 213     return $tree;
 214 };
 215
 216 sub validate_method_schemas {
 217
 218     foreach my $class (keys %$method_registry) {
 219         my $ma = $method_registry->{$class};
 220
 221         foreach my $info (@$ma) {
 222             PVE::JSONSchema::validate_method_info($info);
 223         }
 224     }
 225 }
 226
 227 sub register_method {
 228     my ($self, $info) = @_;
 229
 230     my $match_re = [];
 231     my $match_name = [];
 232
 233     my $errprefix;
 234
 235     my $method;
 236     if ($info->{subclass}) {
 237         $errprefix = "register subclass $info->{subclass} at ${self}/$info->{path} -";
 238         $method = 'SUBCLASS';
 239     } else {
 240         $errprefix = "register method ${self}/$info->{path} -";
 241         $info->{method} = 'GET' if !$info->{method};
 242         $method = $info->{method};
 243
 244         # apply default value
 245         $info->{allowtoken} = 1 if !defined($info->{allowtoken});
 246     }
 247
 248     $method_path_lookup->{$self} = {} if !defined($method_path_lookup->{$self});
 249     my $path_lookup = $method_path_lookup->{$self};
 250
 251     die "$errprefix no path" if !defined($info->{path});
 252
 253     foreach my $comp (split(/\/+/, $info->{path})) {
 254         die "$errprefix path compoment has zero length\n" if $comp eq '';
 255         my ($name, $regex);
 256         if ($comp =~ m/^\{([\w-]+)(?::(.*))?\}$/) {
 257             $name = $1;
 258             $regex = $2 ? $2 : '\S+';
 259             push @$match_re, $regex;
 260             push @$match_name, $name;
 261         } else {
 262             $name = $comp;
 263             push @$match_re, $name;
 264             push @$match_name, undef;
 265         }
 266
 267         if ($regex) {
 268             $path_lookup->{regex} = {} if !defined($path_lookup->{regex});
 269
 270             my $old_name = $path_lookup->{regex}->{match_name};
 271             die "$errprefix found changed regex match name\n"
 272                 if defined($old_name) && ($old_name ne $name);
 273             my $old_re = $path_lookup->{regex}->{match_re};
 274             die "$errprefix found changed regex\n"
 275                 if defined($old_re) && ($old_re ne $regex);
 276             $path_lookup->{regex}->{match_name} = $name;
 277             $path_lookup->{regex}->{match_re} = $regex;
 278
 279             die "$errprefix path match error - regex and fixed items\n"
 280                 if defined($path_lookup->{folders});
 281
 282             $path_lookup = $path_lookup->{regex};
 283
 284         } else {
 285             $path_lookup->{folders}->{$name} = {} if !defined($path_lookup->{folders}->{$name});
 286
 287             die "$errprefix path match error - regex and fixed items\n"
 288                 if defined($path_lookup->{regex});
 289
 290             $path_lookup = $path_lookup->{folders}->{$name};
 291         }
 292     }
 293
 294     die "$errprefix duplicate method definition\n"
 295         if defined($path_lookup->{$method});
 296
 297     if ($method eq 'SUBCLASS') {
 298         foreach my $m (qw(GET PUT POST DELETE)) {
 299             die "$errprefix duplicate method definition SUBCLASS and $m\n" if $path_lookup->{$m};
 300         }
 301     }
 302     $path_lookup->{$method} = $info;
 303
 304     $info->{match_re} = $match_re;
 305     $info->{match_name} = $match_name;
 306
 307     $method_by_name->{$self} = {} if !defined($method_by_name->{$self});
 308
 309     if ($info->{name}) {
 310         die "$errprefix method name already defined\n"
 311             if defined($method_by_name->{$self}->{$info->{name}});
 312
 313         $method_by_name->{$self}->{$info->{name}} = $info;
 314     }
 315
 316     push @{$method_registry->{$self}}, $info;
 317 }
 318
 319 sub DESTROY {}; # avoid problems with autoload
 320
 321 sub AUTOLOAD {
 322     my ($this) = @_;
 323
 324     # also see "man perldiag"
 325
 326     my $sub = $AUTOLOAD;
 327     (my $method = $sub) =~ s/.*:://;
 328
 329     my $info = $this->map_method_by_name($method);
 330
 331     {
 332         no strict 'refs'; ## no critic (ProhibitNoStrict)
 333         *{$sub} = sub {
 334             my $self = shift;
 335             return $self->handle($info, @_);
 336         };
 337     }
 338     goto &$AUTOLOAD;
 339 }
 340
 341 sub method_attributes {
 342     my ($self) = @_;
 343
 344     return $method_registry->{$self};
 345 }
 346
 347 sub map_method_by_name {
 348     my ($self, $name) = @_;
 349
 350     my $info = $method_by_name->{$self}->{$name};
 351     die "no such method '${self}::$name'\n" if !$info;
 352
 353     return $info;
 354 }
 355
 356 sub map_path_to_methods {
 357     my ($class, $stack, $uri_param, $pathmatchref) = @_;
 358
 359     my $path_lookup = $method_path_lookup->{$class};
 360
 361     # Note: $pathmatchref can be used to obtain path including
 362     # uri patterns like '/cluster/firewall/groups/{group}'.
 363     # Used by pvesh to display help
 364     if (defined($pathmatchref)) {
 365         $$pathmatchref = '' if !$$pathmatchref;
 366     }
 367
 368     while (defined(my $comp = shift @$stack)) {
 369         return undef if !$path_lookup; # not registerd?
 370         if ($path_lookup->{regex}) {
 371             my $name = $path_lookup->{regex}->{match_name};
 372             my $regex = $path_lookup->{regex}->{match_re};
 373
 374             return undef if $comp !~ m/^($regex)$/;
 375             $uri_param->{$name} = $1;
 376             $path_lookup = $path_lookup->{regex};
 377             $$pathmatchref .= '/{' . $name . '}' if defined($pathmatchref);
 378         } elsif ($path_lookup->{folders}) {
 379             $path_lookup = $path_lookup->{folders}->{$comp};
 380             $$pathmatchref .= '/' . $comp if defined($pathmatchref);
 381         } else {
 382             die "internal error";
 383         }
 384
 385         return undef if !$path_lookup;
 386
 387         if (my $info = $path_lookup->{SUBCLASS}) {
 388             $class = $info->{subclass};
 389
 390             my $fd = $info->{fragmentDelimiter};
 391
 392             if (defined($fd)) {
 393                 # we only support the empty string '' (match whole URI)
 394                 die "unsupported fragmentDelimiter '$fd'"
 395                     if $fd ne '';
 396
 397                 $stack = [ join ('/', @$stack) ] if scalar(@$stack) > 1;
 398             }
 399             $path_lookup = $method_path_lookup->{$class};
 400         }
 401     }
 402
 403     return undef if !$path_lookup;
 404
 405     return ($class, $path_lookup);
 406 }
 407
 408 sub find_handler {
 409     my ($class, $method, $path, $uri_param, $pathmatchref) = @_;
 410
 411     my $stack = [ grep { length($_) > 0 }  split('\/+' , $path)]; # skip empty fragments
 412
 413     my ($handler_class, $path_info);
 414     eval {
 415         ($handler_class, $path_info) = $class->map_path_to_methods($stack, $uri_param, $pathmatchref);
 416     };
 417     my $err = $@;
 418     syslog('err', $err) if $err;
 419
 420     return undef if !($handler_class && $path_info);
 421
 422     my $method_info = $path_info->{$method};
 423
 424     return undef if !$method_info;
 425
 426     return ($handler_class, $method_info);
 427 }
 428
 429 my sub untaint_recursive : prototype($) {
 430     use feature 'current_sub';
 431
 432     my ($param) = @_;
 433
 434     my $ref = ref($param);
 435     if ($ref eq 'HASH') {
 436         $param->{$_} = __SUB__->($param->{$_}) for keys $param->%*;
 437     } elsif ($ref eq 'ARRAY') {
 438         for (my $i = 0; $i < scalar($param->@*); $i++) {
 439             $param->[$i] = __SUB__->($param->[$i]);
 440         }
 441     } else {
 442         if (defined($param)) {
 443             my ($newval) = $param =~ /^(.*)$/s;
 444             $param = $newval;
 445         }
 446     }
 447
 448     return $param;
 449 };
 450
 451 # convert arrays to strings where we expect a '-list' format and convert scalar
 452 # values to arrays when we expect an array (because of www-form-urlencoded)
 453 #
 454 # only on the top level, since www-form-urlencoded cannot be nested anyway
 455 #
 456 # FIXME: change gui/api calls to not rely on this during 8.x, mark the
 457 # behaviour deprecated with 9.x, and remove it with 10.x
 458 my $normalize_legacy_param_formats = sub {
 459     my ($param, $schema) = @_;
 460
 461     return $param if !$schema->{properties};
 462     return $param if (ref($param) // '') ne 'HASH';
 463
 464     for my $key (keys $schema->{properties}->%*) {
 465         if (my $value = $param->{$key}) {
 466             my $type = $schema->{properties}->{$key}->{type} // '';
 467             my $format = $schema->{properties}->{$key}->{format} // '';
 468             my $ref = ref($value);
 469             if ($ref && $ref eq 'ARRAY' && $type eq 'string' && $format =~ m/-list$/) {
 470                 $param->{$key} = join(',', $value->@*);
 471             } elsif (!$ref && $type eq 'array') {
 472                 $param->{$key} = [$value];
 473             }
 474         }
 475     }
 476
 477     return $param;
 478 };
 479
 480 sub handle {
 481     my ($self, $info, $param, $result_verification) = @_;
 482
 483     my $func = $info->{code};
 484
 485     if (!($info->{name} && $func)) {
 486         raise("Method lookup failed ('$info->{name}')\n", code => HTTP_INTERNAL_SERVER_ERROR);
 487     }
 488
 489     if (my $schema = $info->{parameters}) {
 490         # warn "validate ". Dumper($param}) . "\n" . Dumper($schema);
 491         $param = $normalize_legacy_param_formats->($param, $schema);
 492         PVE::JSONSchema::validate($param, $schema);
 493         # untaint data (already validated)
 494         $param = untaint_recursive($param);
 495     }
 496
 497     my $result = $func->($param); # the actual API code execution call
 498
 499     if ($result_verification && (my $schema = $info->{returns})) {
 500         # return validation is rather lose-lose, as it can require quite a bit of time and lead to
 501         # false-positive errors, any HTTP API handler should avoid enabling it by default.
 502         PVE::JSONSchema::validate($result, $schema, "Result verification failed\n");
 503     }
 504     return $result;
 505 }
 506
 507 # format option, display type and description
 508 # $name: option name
 509 # $display_name: for example "-$name" of "<$name>", pass undef to use "$name:"
 510 # $phash: json schema property hash
 511 # $format: 'asciidoc', 'short', 'long' or 'full'
 512 # $style: 'config', 'config-sub', 'arg' or 'fixed'
 513 # $mapdef: parameter mapping ({ desc => XXX, func => sub {...} })
 514 my $get_property_description = sub {
 515     my ($name, $style, $phash, $format, $mapdef) = @_;
 516
 517     my $res = '';
 518
 519     $format = 'asciidoc' if !defined($format);
 520
 521     my $descr = $phash->{description} || "no description available";
 522
 523     if ($phash->{verbose_description} &&
 524         ($style eq 'config' || $style eq 'config-sub')) {
 525         $descr = $phash->{verbose_description};
 526     }
 527
 528     chomp $descr;
 529
 530     my $type_text = PVE::JSONSchema::schema_get_type_text($phash, $style);
 531
 532     if ($mapdef && $phash->{type} eq 'string') {
 533         $type_text = $mapdef->{desc};
 534     }
 535
 536     if ($format eq 'asciidoc') {
 537
 538         if ($style eq 'config') {
 539             $res .= "`$name`: ";
 540         } elsif ($style eq 'config-sub') {
 541             $res .= "`$name`=";
 542         } elsif ($style eq 'arg') {
 543             $res .= "`--$name` ";
 544         } elsif ($style eq 'fixed') {
 545             $res .= "`<$name>`: ";
 546         } else {
 547             die "unknown style '$style'";
 548         }
 549
 550         $res .= "`$type_text` " if $type_text;
 551
 552         if (defined(my $dv = $phash->{default})) {
 553             $res .= "('default =' `$dv`)";
 554         }
 555
 556         if ($style eq 'config-sub') {
 557             $res .= ";;\n\n";
 558         } else {
 559             $res .= "::\n\n";
 560         }
 561
 562         my $wdescr = $descr;
 563         chomp $wdescr;
 564         $wdescr =~ s/^$/+/mg;
 565
 566         $wdescr =~ s/{/\\{/g;
 567         $wdescr =~ s/}/\\}/g;
 568
 569         $res .= $wdescr . "\n";
 570
 571         if (my $req = $phash->{requires}) {
 572             my $tmp .= ref($req) ? join(', ', @$req) : $req;
 573             $res .= "+\nNOTE: Requires option(s): `$tmp`\n";
 574         }
 575         $res .= "\n";
 576
 577     } elsif ($format eq 'short' || $format eq 'long' || $format eq 'full') {
 578
 579         my $defaulttxt = '';
 580         if (defined(my $dv = $phash->{default})) {
 581             $defaulttxt = "   (default=$dv)";
 582         }
 583
 584         my $display_name;
 585         if ($style eq 'config') {
 586             $display_name = "$name:";
 587         } elsif ($style eq 'arg') {
 588             $display_name = "-$name";
 589         } elsif ($style eq 'fixed') {
 590             $display_name = "<$name>";
 591         } else {
 592             die "unknown style '$style'";
 593         }
 594
 595         my $tmp = sprintf "  %-10s %s%s\n", $display_name, "$type_text", "$defaulttxt";
 596         my $indend = "             ";
 597
 598         $res .= Text::Wrap::wrap('', $indend, ($tmp));
 599         $res .= Text::Wrap::wrap($indend, $indend, ($descr)) . "\n\n";
 600
 601         if (my $req = $phash->{requires}) {
 602             my $tmp = "Requires option(s): ";
 603             $tmp .= ref($req) ? join(', ', @$req) : $req;
 604             $res .= Text::Wrap::wrap($indend, $indend, ($tmp)). "\n\n";
 605         }
 606
 607     } else {
 608         die "unknown format '$format'";
 609     }
 610
 611     return $res;
 612 };
 613
 614 # translate parameter mapping definition
 615 # $mapping_array is a array which can contain:
 616 #   strings ... in that case we assume it is a parameter name, and
 617 #      we want to load that parameter from a file
 618 #   [ param_name, func, desc] ... allows you to specify a arbitrary
 619 #      mapping func for any param
 620 #
 621 # Returns: a hash indexed by parameter_name,
 622 # i.e.  { param_name => { func => .., desc => ... } }
 623 my $compute_param_mapping_hash = sub {
 624     my ($mapping_array) = @_;
 625
 626     my $res = {};
 627
 628     return $res if !defined($mapping_array);
 629
 630     foreach my $item (@$mapping_array) {
 631         my ($name, $func, $desc, $interactive);
 632         if (ref($item) eq 'ARRAY') {
 633             ($name, $func, $desc, $interactive) = @$item;
 634         } elsif (ref($item) eq 'HASH') {
 635             # just use the hash
 636             $res->{$item->{name}} = $item;
 637             next;
 638         } else {
 639             $name = $item;
 640             $func = sub { return PVE::Tools::file_get_contents($_[0]) };
 641         }
 642         $desc //= '<filepath>';
 643         $res->{$name} = { desc => $desc, func => $func, interactive => $interactive };
 644     }
 645
 646     return $res;
 647 };
 648
 649 # generate usage information for command line tools
 650 #
 651 # $info        ... method info
 652 # $prefix      ... usually something like "$exename $cmd" ('pvesm add')
 653 # $arg_param   ... list of parameters we want to get as ordered arguments
 654 #                  on the command line (or single parameter name for lists)
 655 # $fixed_param ... do not generate and info about those parameters
 656 # $format:
 657 #   'long'     ... default (text, list all options)
 658 #   'short'    ... command line only (text, one line)
 659 #   'full'     ... text, include description
 660 #   'asciidoc' ... generate asciidoc for man pages (like 'full')
 661 # $param_cb    ... mapping for string parameters to file path parameters
 662 # $formatter_properties  ... additional property definitions (passed to output formatter)
 663 sub getopt_usage {
 664     my ($info, $prefix, $arg_param, $fixed_param, $format, $param_cb, $formatter_properties) = @_;
 665
 666     $format = 'long' if !$format;
 667
 668     my $schema = $info->{parameters};
 669     my $name = $info->{name};
 670     my $prop =  {};
 671     if ($schema->{properties}) {
 672         $prop = { %{$schema->{properties}} }; # copy
 673     }
 674
 675     my $has_output_format_option = $formatter_properties->{'output-format'} ? 1 : 0;
 676
 677     if ($formatter_properties) {
 678         foreach my $key (keys %$formatter_properties) {
 679             if (!$standard_output_options->{$key}) {
 680                 $prop->{$key} = $formatter_properties->{$key};
 681             }
 682         }
 683     }
 684
 685     # also remove $standard_output_options from $prop (pvesh, pveclient)
 686     if ($prop->{'output-format'}) {
 687         $has_output_format_option = 1;
 688         foreach my $key (keys %$prop) {
 689             if ($standard_output_options->{$key}) {
 690                 delete $prop->{$key};
 691             }
 692         }
 693     }
 694
 695     my $out = '';
 696
 697     my $arg_hash = {};
 698
 699     my $args = '';
 700
 701     $arg_param = [ $arg_param ] if $arg_param && !ref($arg_param);
 702
 703     foreach my $p (@$arg_param) {
 704         next if !$prop->{$p}; # just to be sure
 705         my $pd = $prop->{$p};
 706
 707         $arg_hash->{$p} = 1;
 708         $args .= " " if $args;
 709         if ($pd->{format} && $pd->{format} =~ m/-list/) {
 710             $args .= "{<$p>}";
 711         } else {
 712             $args .= $pd->{optional} ? "[<$p>]" : "<$p>";
 713         }
 714     }
 715
 716     my $argdescr = '';
 717     foreach my $k (@$arg_param) {
 718         next if defined($fixed_param->{$k}); # just to be sure
 719         next if !$prop->{$k}; # just to be sure
 720         $argdescr .= $get_property_description->($k, 'fixed', $prop->{$k}, $format);
 721     }
 722
 723     my $idx_param = {}; # -vlan\d+ -scsi\d+
 724
 725     my $opts = '';
 726     foreach my $k (sort keys %$prop) {
 727         next if $arg_hash->{$k};
 728         next if defined($fixed_param->{$k});
 729
 730         my $type_text = $prop->{$k}->{type} || 'string';
 731
 732         my $param_map = {};
 733
 734         if (defined($param_cb)) {
 735             my $mapping = $param_cb->($name);
 736             $param_map = $compute_param_mapping_hash->($mapping);
 737             next if $k eq 'password' && $param_map->{$k} && !$prop->{$k}->{optional};
 738         }
 739
 740         my $base = $k;
 741         if ($k =~ m/^([a-z]+)(\d+)$/) {
 742             my ($name, $idx) = ($1, $2);
 743             next if $idx_param->{$name};
 744             if ($idx == 0 && defined($prop->{"${name}1"})) {
 745                 $idx_param->{$name} = 1;
 746                 $base = "${name}[n]";
 747             }
 748         }
 749
 750
 751         $opts .= $get_property_description->($base, 'arg', $prop->{$k}, $format, $param_map->{$k});
 752
 753         if (!$prop->{$k}->{optional}) {
 754             $args .= " " if $args;
 755             $args .= "--$base <$type_text>"
 756         }
 757     }
 758
 759     if ($format eq 'asciidoc') {
 760         $out .= "*${prefix}*";
 761         $out .= " `$args`" if $args;
 762         $out .= " `[OPTIONS]`" if $opts;
 763         $out .= " `[FORMAT_OPTIONS]`" if $has_output_format_option;
 764         $out .= "\n";
 765     } else {
 766         $out .= "USAGE: " if $format ne 'short';
 767         $out .= "$prefix $args";
 768         $out .= " [OPTIONS]" if $opts;
 769         $out .= " [FORMAT_OPTIONS]" if $has_output_format_option;
 770         $out .= "\n";
 771     }
 772
 773     return $out if $format eq 'short';
 774
 775     if ($info->{description}) {
 776         if ($format eq 'asciidoc') {
 777             my $desc = Text::Wrap::wrap('', '', ($info->{description}));
 778             $out .= "\n$desc\n\n";
 779         } elsif ($format eq 'full') {
 780             my $desc = Text::Wrap::wrap('  ', '  ', ($info->{description}));
 781             $out .= "\n$desc\n";
 782         }
 783     }
 784
 785     $out .= $argdescr if $argdescr;
 786
 787     $out .= $opts if $opts;
 788
 789     return $out;
 790 }
 791
 792 sub usage_str {
 793     my ($self, $name, $prefix, $arg_param, $fixed_param, $format, $param_cb, $formatter_properties) = @_;
 794
 795     my $info = $self->map_method_by_name($name);
 796
 797     return getopt_usage($info, $prefix, $arg_param, $fixed_param, $format, $param_cb, $formatter_properties);
 798 }
 799
 800 # generate docs from JSON schema properties
 801 sub dump_properties {
 802     my ($prop, $format, $style, $filterFn) = @_;
 803
 804     my $raw = '';
 805
 806     $style //= 'config';
 807
 808     my $idx_param = {}; # -vlan\d+ -scsi\d+
 809
 810     foreach my $k (sort keys %$prop) {
 811         my $phash = $prop->{$k};
 812
 813         next if defined($filterFn) && &$filterFn($k, $phash);
 814         next if $phash->{alias};
 815
 816         my $base = $k;
 817         if ($k =~ m/^([a-z]+)(\d+)$/) {
 818             my ($name, $idx) = ($1, $2);
 819             next if $idx_param->{$name};
 820             if ($idx == 0 && defined($prop->{"${name}1"})) {
 821                 $idx_param->{$name} = 1;
 822                 $base = "${name}[n]";
 823             }
 824         }
 825
 826         $raw .= $get_property_description->($base, $style, $phash, $format);
 827
 828         next if $style ne 'config';
 829
 830         my $prop_fmt = $phash->{format};
 831         next if !$prop_fmt;
 832
 833         if (ref($prop_fmt) ne 'HASH') {
 834             $prop_fmt = PVE::JSONSchema::get_format($prop_fmt);
 835         }
 836
 837         next if !(ref($prop_fmt) && (ref($prop_fmt) eq 'HASH'));
 838
 839         $raw .= dump_properties($prop_fmt, $format, 'config-sub')
 840
 841     }
 842
 843     return $raw;
 844 }
 845
 846 my $replace_file_names_with_contents = sub {
 847     my ($param, $param_map) = @_;
 848
 849     while (my ($k, $d) = each %$param_map) {
 850         next if $d->{interactive}; # handled by the JSONSchema's get_options code
 851         $param->{$k} = $d->{func}->($param->{$k})
 852             if defined($param->{$k});
 853     }
 854
 855     return $param;
 856 };
 857
 858 sub add_standard_output_properties {
 859     my ($propdef, $list) = @_;
 860
 861     $propdef //= {};
 862
 863     $list //= [ keys %$standard_output_options ];
 864
 865     my $res = { %$propdef }; # copy
 866
 867     foreach my $opt (@$list) {
 868         die "no such standard output option '$opt'\n" if !defined($standard_output_options->{$opt});
 869         die "detected overwriten standard CLI parameter '$opt'\n" if defined($res->{$opt});
 870         $res->{$opt} = $standard_output_options->{$opt};
 871     }
 872
 873     return $res;
 874 }
 875
 876 sub extract_standard_output_properties {
 877     my ($data) = @_;
 878
 879     my $options = {};
 880     foreach my $opt (keys %$standard_output_options) {
 881         $options->{$opt} = delete $data->{$opt} if defined($data->{$opt});
 882     }
 883
 884     return $options;
 885 }
 886
 887 sub cli_handler {
 888     my ($self, $prefix, $name, $args, $arg_param, $fixed_param, $param_cb, $formatter_properties) = @_;
 889
 890     my $info = $self->map_method_by_name($name);
 891     my $res;
 892     my $fmt_param = {};
 893
 894     eval {
 895         my $param_map = {};
 896         $param_map = $compute_param_mapping_hash->($param_cb->($name)) if $param_cb;
 897         my $schema = { %{$info->{parameters}} }; # copy
 898         $schema->{properties} = { %{$schema->{properties}}, %$formatter_properties } if $formatter_properties;
 899         my $param = PVE::JSONSchema::get_options($schema, $args, $arg_param, $fixed_param, $param_map);
 900
 901         if ($formatter_properties) {
 902             foreach my $opt (keys %$formatter_properties) {
 903                 $fmt_param->{$opt} = delete $param->{$opt} if defined($param->{$opt});
 904             }
 905         }
 906
 907         if (defined($param_map)) {
 908             $replace_file_names_with_contents->($param, $param_map);
 909         }
 910
 911         $res = $self->handle($info, $param, 1);
 912     };
 913     if (my $err = $@) {
 914         my $ec = ref($err);
 915
 916         die $err if !$ec || $ec ne "PVE::Exception" || !$err->is_param_exc();
 917
 918         $err->{usage} = $self->usage_str($name, $prefix, $arg_param, $fixed_param, 'short', $param_cb, $formatter_properties);
 919
 920         die $err;
 921     }
 922
 923     return wantarray ? ($res, $fmt_param) : $res;
 924 }
 925
 926 # utility methods
 927 # note: this modifies the original hash by adding the id property
 928 sub hash_to_array {
 929     my ($hash, $idprop) = @_;
 930
 931     my $res = [];
 932     return $res if !$hash;
 933
 934     foreach my $k (keys %$hash) {
 935         $hash->{$k}->{$idprop} = $k;
 936         push @$res, $hash->{$k};
 937     }
 938
 939     return $res;
 940 }
 941
 942 1;