[pve-common.git] / src / PVE / RESTHandler.pm

package PVE::RESTHandler;

use strict;
use warnings;

use Clone qw(clone);
use HTTP::Status qw(:constants :is status_message);
use Text::Wrap;

use PVE::Exception qw(raise raise_param_exc);
use PVE::JSONSchema;
use PVE::SafeSyslog;
use PVE::Tools;

my $method_registry = {};
my $method_by_name = {};
my $method_path_lookup = {};

our $AUTOLOAD;  # it's a package global

our $standard_output_options = {
    'output-format' => PVE::JSONSchema::get_standard_option('pve-output-format'),
    noheader => {
	description => "Do not show column headers (for 'text' format).",
	type => 'boolean',
	optional => 1,
	default => 0,
    },
    noborder => {
	description => "Do not draw borders (for 'text' format).",
	type => 'boolean',
	optional => 1,
	default => 0,
    },
    quiet => {
        description => "Suppress printing results.",
        type => 'boolean',
        optional => 1,
    },
    'human-readable' => {
        description => "Call output rendering functions to produce human readable text.",
        type => 'boolean',
        optional => 1,
	default => 1,
    }
};

sub api_clone_schema {
    my ($schema, $no_typetext) = @_;

    my $res = {};
    my $ref = ref($schema);
    die "not a HASH reference" if !($ref && $ref eq 'HASH');

    foreach my $k (keys %$schema) {
	my $d = $schema->{$k};
	if ($k ne 'properties') {
	    $res->{$k} = ref($d) ? clone($d) : $d;
	    next;
	}
	# convert indexed parameters like -net\d+ to -net[n]
	foreach my $p (keys %$d) {
	    my $pd = $d->{$p};
	    if ($p =~ m/^([a-z]+)(\d+)$/) {
		my ($name, $idx) = ($1, $2);
		if ($idx == 0 && defined($d->{"${name}1"})) {
		    $p = "${name}[n]";
		} elsif ($idx > 0 && defined($d->{"${name}0"})) {
		    next; # only handle once for -xx0, but only if -xx0 exists
		}
	    }
	    my $tmp = ref($pd) ? clone($pd) : $pd;
	    # NOTE: add typetext property for complexer types, to make the web api-viewer code simpler
	    if (!$no_typetext && !(defined($tmp->{enum}) || defined($tmp->{pattern}))) {
		my $typetext = PVE::JSONSchema::schema_get_type_text($tmp);
		if ($tmp->{type} && ($tmp->{type} ne $typetext)) {
		    $tmp->{typetext} = $typetext;
		}
	    }
	    $res->{$k}->{$p} = $tmp;
	}
    }

    return $res;
}

sub api_dump_full {
    my ($tree, $index, $class, $prefix, $raw_dump) = @_;

    $prefix = '' if !$prefix;

    my $ma = $method_registry->{$class};

    foreach my $info (@$ma) {

	my $path = "$prefix/$info->{path}";
	$path =~ s/\/+$//;

	if ($info->{subclass}) {
	    api_dump_full($tree, $index, $info->{subclass}, $path, $raw_dump);
	} else {
	    next if !$path;

	    # check if method is unique
	    my $realpath = $path;
	    $realpath =~ s/\{[^\}]+\}/\{\}/g;
	    my $fullpath = "$info->{method} $realpath";
	    die "duplicate path '$realpath'" if $index->{$fullpath};
	    $index->{$fullpath} = $info;

	    # insert into tree
	    my $treedir = $tree;
	    my $res;
	    my $sp = '';
	    foreach my $dir (split('/', $path)) {
		next if !$dir;
		$sp .= "/$dir";
		$res = (grep { $_->{text} eq $dir } @$treedir)[0];
		if ($res) {
		    $res->{children} = [] if !$res->{children};
		    $treedir = $res->{children};
		} else {
		    $res = {
			path => $sp,
			text => $dir,
			children => [],
		    };
		    push @$treedir, $res;
		    $treedir = $res->{children};
		}
	    }

	    if ($res) {
		my $data = {};
		foreach my $k (keys %$info) {
		    next if $k eq 'code' || $k eq "match_name" || $k eq "match_re" ||
			$k eq "path";

		    my $d = $info->{$k};

		    if ($raw_dump) {
			$data->{$k} = $d;
		    } else {
			if ($k eq 'parameters') {
			    $data->{$k} = api_clone_schema($d);
			} elsif ($k eq 'returns') {
			    $data->{$k} = api_clone_schema($d, 1);
			} else {
			    $data->{$k} = ref($d) ? clone($d) : $d;
			}
		    }
		}
		$res->{info}->{$info->{method}} = $data;
	    };
	}
    }
};

sub api_dump_cleanup_tree {
    my ($tree) = @_;

    foreach my $rec (@$tree) {
	delete $rec->{children} if $rec->{children} && !scalar(@{$rec->{children}});
	if ($rec->{children}) {
	    $rec->{leaf} = 0;
	    api_dump_cleanup_tree($rec->{children});
	} else {
	    $rec->{leaf} = 1;
	}
    }

}

# api_dump_remove_refs: prepare API tree for use with to_json($tree)
sub api_dump_remove_refs {
    my ($tree) = @_;

    my $class = ref($tree);
    return $tree if !$class;

    if ($class eq 'ARRAY') {
	my $res = [];
	foreach my $el (@$tree) {
	    push @$res, api_dump_remove_refs($el);
	}
	return $res;
    } elsif ($class eq 'HASH') {
	my $res = {};
	foreach my $k (keys %$tree) {
	    if (my $itemclass = ref($tree->{$k})) {
		if ($itemclass eq 'CODE') {
		    next if $k eq 'completion' || $k eq 'proxyto_callback';
		}
		$res->{$k} = api_dump_remove_refs($tree->{$k});
	    } else {
		$res->{$k} = $tree->{$k};
	    }
	}
	return $res;
    } elsif ($class eq 'Regexp') {
	return "$tree"; # return string representation
    } else {
	die "unknown class '$class'\n";
    }
}

sub api_dump {
    my ($class, $prefix, $raw_dump) = @_;

    my $tree = [];

    my $index = {};
    api_dump_full($tree, $index, $class, $prefix, $raw_dump);
    api_dump_cleanup_tree($tree);
    return $tree;
};

sub validate_method_schemas {

    foreach my $class (keys %$method_registry) {
	my $ma = $method_registry->{$class};

	foreach my $info (@$ma) {
	    PVE::JSONSchema::validate_method_info($info);
	}
    }
}

sub register_method {
    my ($self, $info) = @_;

    my $match_re = [];
    my $match_name = [];

    my $errprefix;

    my $method;
    if ($info->{subclass}) {
	$errprefix = "register subclass $info->{subclass} at ${self}/$info->{path} -";
	$method = 'SUBCLASS';
    } else {
	$errprefix = "register method ${self}/$info->{path} -";
	$info->{method} = 'GET' if !$info->{method};
	$method = $info->{method};

	# apply default value
	$info->{allowtoken} = 1 if !defined($info->{allowtoken});
    }

    $method_path_lookup->{$self} = {} if !defined($method_path_lookup->{$self});
    my $path_lookup = $method_path_lookup->{$self};

    die "$errprefix no path" if !defined($info->{path});

    foreach my $comp (split(/\/+/, $info->{path})) {
	die "$errprefix path compoment has zero length\n" if $comp eq '';
	my ($name, $regex);
	if ($comp =~ m/^\{([\w-]+)(?::(.*))?\}$/) {
	    $name = $1;
	    $regex = $2 ? $2 : '\S+';
	    push @$match_re, $regex;
	    push @$match_name, $name;
	} else {
	    $name = $comp;
	    push @$match_re, $name;
	    push @$match_name, undef;
	}

	if ($regex) {
	    $path_lookup->{regex} = {} if !defined($path_lookup->{regex});

	    my $old_name = $path_lookup->{regex}->{match_name};
	    die "$errprefix found changed regex match name\n"
		if defined($old_name) && ($old_name ne $name);
	    my $old_re = $path_lookup->{regex}->{match_re};
	    die "$errprefix found changed regex\n"
		if defined($old_re) && ($old_re ne $regex);
	    $path_lookup->{regex}->{match_name} = $name;
	    $path_lookup->{regex}->{match_re} = $regex;

	    die "$errprefix path match error - regex and fixed items\n"
		if defined($path_lookup->{folders});

	    $path_lookup = $path_lookup->{regex};

	} else {
	    $path_lookup->{folders}->{$name} = {} if !defined($path_lookup->{folders}->{$name});

	    die "$errprefix path match error - regex and fixed items\n"
		if defined($path_lookup->{regex});

	    $path_lookup = $path_lookup->{folders}->{$name};
	}
    }

    die "$errprefix duplicate method definition\n"
	if defined($path_lookup->{$method});

    if ($method eq 'SUBCLASS') {
	foreach my $m (qw(GET PUT POST DELETE)) {
	    die "$errprefix duplicate method definition SUBCLASS and $m\n" if $path_lookup->{$m};
	}
    }
    $path_lookup->{$method} = $info;

    $info->{match_re} = $match_re;
    $info->{match_name} = $match_name;

    $method_by_name->{$self} = {} if !defined($method_by_name->{$self});

    if ($info->{name}) {
	die "$errprefix method name already defined\n"
	    if defined($method_by_name->{$self}->{$info->{name}});

	$method_by_name->{$self}->{$info->{name}} = $info;
    }

    push @{$method_registry->{$self}}, $info;
}

sub DESTROY {}; # avoid problems with autoload

sub AUTOLOAD {
    my ($this) = @_;

    # also see "man perldiag"

    my $sub = $AUTOLOAD;
    (my $method = $sub) =~ s/.*:://;

    my $info = $this->map_method_by_name($method);

    {
	no strict 'refs'; ## no critic (ProhibitNoStrict)
	*{$sub} = sub {
	    my $self = shift;
	    return $self->handle($info, @_);
	};
    }
    goto &$AUTOLOAD;
}

sub method_attributes {
    my ($self) = @_;

    return $method_registry->{$self};
}

sub map_method_by_name {
    my ($self, $name) = @_;

    my $info = $method_by_name->{$self}->{$name};
    die "no such method '${self}::$name'\n" if !$info;

    return $info;
}

sub map_path_to_methods {
    my ($class, $stack, $uri_param, $pathmatchref) = @_;

    my $path_lookup = $method_path_lookup->{$class};

    # Note: $pathmatchref can be used to obtain path including
    # uri patterns like '/cluster/firewall/groups/{group}'.
    # Used by pvesh to display help
    if (defined($pathmatchref)) {
	$$pathmatchref = '' if !$$pathmatchref;
    }

    while (defined(my $comp = shift @$stack)) {
	return undef if !$path_lookup; # not registerd?
	if ($path_lookup->{regex}) {
	    my $name = $path_lookup->{regex}->{match_name};
	    my $regex = $path_lookup->{regex}->{match_re};

	    return undef if $comp !~ m/^($regex)$/;
	    $uri_param->{$name} = $1;
	    $path_lookup = $path_lookup->{regex};
	    $$pathmatchref .= '/{' . $name . '}' if defined($pathmatchref);
	} elsif ($path_lookup->{folders}) {
	    $path_lookup = $path_lookup->{folders}->{$comp};
	    $$pathmatchref .= '/' . $comp if defined($pathmatchref);
	} else {
	    die "internal error";
	}

	return undef if !$path_lookup;

	if (my $info = $path_lookup->{SUBCLASS}) {
	    $class = $info->{subclass};

	    my $fd = $info->{fragmentDelimiter};

	    if (defined($fd)) {
		# we only support the empty string '' (match whole URI)
		die "unsupported fragmentDelimiter '$fd'"
		    if $fd ne '';

		$stack = [ join ('/', @$stack) ] if scalar(@$stack) > 1;
	    }
	    $path_lookup = $method_path_lookup->{$class};
	}
    }

    return undef if !$path_lookup;

    return ($class, $path_lookup);
}

sub find_handler {
    my ($class, $method, $path, $uri_param, $pathmatchref) = @_;

    my $stack = [ grep { length($_) > 0 }  split('\/+' , $path)]; # skip empty fragments

    my ($handler_class, $path_info);
    eval {
	($handler_class, $path_info) = $class->map_path_to_methods($stack, $uri_param, $pathmatchref);
    };
    my $err = $@;
    syslog('err', $err) if $err;

    return undef if !($handler_class && $path_info);

    my $method_info = $path_info->{$method};

    return undef if !$method_info;

    return ($handler_class, $method_info);
}

my sub untaint_recursive : prototype($) {
    use feature 'current_sub';

    my ($param) = @_;

    my $ref = ref($param);
    if ($ref eq 'HASH') {
	$param->{$_} = __SUB__->($param->{$_}) for keys $param->%*;
    } elsif ($ref eq 'ARRAY') {
	for (my $i = 0; $i < scalar($param->@*); $i++) {
	    $param->[$i] = __SUB__->($param->[$i]);
	}
    } else {
	if (defined($param)) {
	    my ($newval) = $param =~ /^(.*)$/s;
	    $param = $newval;
	}
    }

    return $param;
};

# convert arrays to strings where we expect a '-list' format and convert scalar
# values to arrays when we expect an array (because of www-form-urlencoded)
#
# only on the top level, since www-form-urlencoded cannot be nested anyway
#
# FIXME: change gui/api calls to not rely on this during 8.x, mark the
# behaviour deprecated with 9.x, and remove it with 10.x
my $normalize_legacy_param_formats = sub {
    my ($param, $schema) = @_;

    return $param if !$schema->{properties};
    return $param if (ref($param) // '') ne 'HASH';

    for my $key (keys $schema->{properties}->%*) {
	if (my $value = $param->{$key}) {
	    my $type = $schema->{properties}->{$key}->{type} // '';
	    my $format = $schema->{properties}->{$key}->{format} // '';
	    my $ref = ref($value);
	    if ($ref && $ref eq 'ARRAY' && $type eq 'string' && $format =~ m/-list$/) {
		$param->{$key} = join(',', $value->@*);
	    } elsif (!$ref && $type eq 'array') {
		$param->{$key} = [$value];
	    }
	}
    }

    return $param;
};

sub handle {
    my ($self, $info, $param, $result_verification) = @_;

    my $func = $info->{code};

    if (!($info->{name} && $func)) {
	raise("Method lookup failed ('$info->{name}')\n", code => HTTP_INTERNAL_SERVER_ERROR);
    }

    if (my $schema = $info->{parameters}) {
	# warn "validate ". Dumper($param}) . "\n" . Dumper($schema);
	$param = $normalize_legacy_param_formats->($param, $schema);
	PVE::JSONSchema::validate($param, $schema);
	# untaint data (already validated)
	$param = untaint_recursive($param);
    }

    my $result = $func->($param); # the actual API code execution call

    if ($result_verification && (my $schema = $info->{returns})) {
	# return validation is rather lose-lose, as it can require quite a bit of time and lead to
	# false-positive errors, any HTTP API handler should avoid enabling it by default.
	PVE::JSONSchema::validate($result, $schema, "Result verification failed\n");
    }
    return $result;
}

# format option, display type and description
# $name: option name
# $display_name: for example "-$name" of "<$name>", pass undef to use "$name:"
# $phash: json schema property hash
# $format: 'asciidoc', 'short', 'long' or 'full'
# $style: 'config', 'config-sub', 'arg' or 'fixed'
# $mapdef: parameter mapping ({ desc => XXX, func => sub {...} })
my $get_property_description = sub {
    my ($name, $style, $phash, $format, $mapdef) = @_;

    my $res = '';

    $format = 'asciidoc' if !defined($format);

    my $descr = $phash->{description} || "no description available";

    if ($phash->{verbose_description} &&
	($style eq 'config' || $style eq 'config-sub')) {
	$descr = $phash->{verbose_description};
    }

    chomp $descr;

    my $type_text = PVE::JSONSchema::schema_get_type_text($phash, $style);

    if ($mapdef && $phash->{type} eq 'string') {
	$type_text = $mapdef->{desc};
    }

    if ($format eq 'asciidoc') {

	if ($style eq 'config') {
	    $res .= "`$name`: ";
	} elsif ($style eq 'config-sub') {
	    $res .= "`$name`=";
	} elsif ($style eq 'arg') {
	    $res .= "`--$name` ";
	} elsif ($style eq 'fixed') {
	    $res .= "`<$name>`: ";
	} else {
	    die "unknown style '$style'";
	}

	$res .= "`$type_text` " if $type_text;

	if (defined(my $dv = $phash->{default})) {
	    $res .= "('default =' `$dv`)";
	}

	if ($style eq 'config-sub') {
	    $res .= ";;\n\n";
	} else {
	    $res .= "::\n\n";
	}

	my $wdescr = $descr;
	chomp $wdescr;
	$wdescr =~ s/^$/+/mg;

	$wdescr =~ s/{/\\{/g;
	$wdescr =~ s/}/\\}/g;

	$res .= $wdescr . "\n";

	if (my $req = $phash->{requires}) {
	    my $tmp .= ref($req) ? join(', ', @$req) : $req;
	    $res .= "+\nNOTE: Requires option(s): `$tmp`\n";
	}
	$res .= "\n";

    } elsif ($format eq 'short' || $format eq 'long' || $format eq 'full') {

	my $defaulttxt = '';
	if (defined(my $dv = $phash->{default})) {
	    $defaulttxt = "   (default=$dv)";
	}

	my $display_name;
	if ($style eq 'config') {
	    $display_name = "$name:";
	} elsif ($style eq 'arg') {
	    $display_name = "-$name";
	} elsif ($style eq 'fixed') {
	    $display_name = "<$name>";
	} else {
	    die "unknown style '$style'";
	}

	my $tmp = sprintf "  %-10s %s%s\n", $display_name, "$type_text", "$defaulttxt";
	my $indend = "             ";

	$res .= Text::Wrap::wrap('', $indend, ($tmp));
	$res .= Text::Wrap::wrap($indend, $indend, ($descr)) . "\n\n";

	if (my $req = $phash->{requires}) {
	    my $tmp = "Requires option(s): ";
	    $tmp .= ref($req) ? join(', ', @$req) : $req;
	    $res .= Text::Wrap::wrap($indend, $indend, ($tmp)). "\n\n";
	}

    } else {
	die "unknown format '$format'";
    }

    return $res;
};

# translate parameter mapping definition
# $mapping_array is a array which can contain:
#   strings ... in that case we assume it is a parameter name, and
#      we want to load that parameter from a file
#   [ param_name, func, desc] ... allows you to specify a arbitrary
#      mapping func for any param
#
# Returns: a hash indexed by parameter_name,
# i.e.  { param_name => { func => .., desc => ... } }
my $compute_param_mapping_hash = sub {
    my ($mapping_array) = @_;

    my $res = {};

    return $res if !defined($mapping_array);

    foreach my $item (@$mapping_array) {
	my ($name, $func, $desc, $interactive);
	if (ref($item) eq 'ARRAY') {
	    ($name, $func, $desc, $interactive) = @$item;
	} elsif (ref($item) eq 'HASH') {
	    # just use the hash
	    $res->{$item->{name}} = $item;
	    next;
	} else {
	    $name = $item;
	    $func = sub { return PVE::Tools::file_get_contents($_[0]) };
	}
	$desc //= '<filepath>';
	$res->{$name} = { desc => $desc, func => $func, interactive => $interactive };
    }

    return $res;
};

# generate usage information for command line tools
#
# $info        ... method info
# $prefix      ... usually something like "$exename $cmd" ('pvesm add')
# $arg_param   ... list of parameters we want to get as ordered arguments
#                  on the command line (or single parameter name for lists)
# $fixed_param ... do not generate and info about those parameters
# $format:
#   'long'     ... default (text, list all options)
#   'short'    ... command line only (text, one line)
#   'full'     ... text, include description
#   'asciidoc' ... generate asciidoc for man pages (like 'full')
# $param_cb    ... mapping for string parameters to file path parameters
# $formatter_properties  ... additional property definitions (passed to output formatter)
sub getopt_usage {
    my ($info, $prefix, $arg_param, $fixed_param, $format, $param_cb, $formatter_properties) = @_;

    $format = 'long' if !$format;

    my $schema = $info->{parameters};
    my $name = $info->{name};
    my $prop =  {};
    if ($schema->{properties}) {
	$prop = { %{$schema->{properties}} }; # copy
    }

    my $has_output_format_option = $formatter_properties->{'output-format'} ? 1 : 0;

    if ($formatter_properties) {
	foreach my $key (keys %$formatter_properties) {
	    if (!$standard_output_options->{$key}) {
		$prop->{$key} = $formatter_properties->{$key};
	    }
	}
    }

    # also remove $standard_output_options from $prop (pvesh, pveclient)
    if ($prop->{'output-format'}) {
	$has_output_format_option = 1;
	foreach my $key (keys %$prop) {
	    if ($standard_output_options->{$key}) {
		delete $prop->{$key};
	    }
	}
    }

    my $out = '';

    my $arg_hash = {};

    my $args = '';

    $arg_param = [ $arg_param ] if $arg_param && !ref($arg_param);

    foreach my $p (@$arg_param) {
	next if !$prop->{$p}; # just to be sure
	my $pd = $prop->{$p};

	$arg_hash->{$p} = 1;
	$args .= " " if $args;
	if ($pd->{format} && $pd->{format} =~ m/-list/) {
	    $args .= "{<$p>}";
	} else {
	    $args .= $pd->{optional} ? "[<$p>]" : "<$p>";
	}
    }

    my $argdescr = '';
    foreach my $k (@$arg_param) {
	next if defined($fixed_param->{$k}); # just to be sure
	next if !$prop->{$k}; # just to be sure
	$argdescr .= $get_property_description->($k, 'fixed', $prop->{$k}, $format);
    }

    my $idx_param = {}; # -vlan\d+ -scsi\d+

    my $opts = '';

    my $type_specific_opts = {};

    foreach my $k (sort keys %$prop) {
	next if $arg_hash->{$k};
	next if defined($fixed_param->{$k});

	my $type_text = $prop->{$k}->{type} || 'string';

	if ($prop->{$k}->{oneOf}) {
	    $type_text = 'multiple';
	}

	my $param_map = {};

	if (defined($param_cb)) {
	    my $mapping = $param_cb->($name);
	    $param_map = $compute_param_mapping_hash->($mapping);
	    next if $k eq 'password' && $param_map->{$k} && !$prop->{$k}->{optional};
	}

	my $base = $k;
	if ($k =~ m/^([a-z]+)(\d+)$/) {
	    my ($name, $idx) = ($1, $2);
	    next if $idx_param->{$name};
	    if ($idx == 0 && defined($prop->{"${name}1"})) {
		$idx_param->{$name} = 1;
		$base = "${name}[n]";
	    }
	}

	my $is_optional = $prop->{$k}->{optional} // 0;

	if (my $type_property = $prop->{$k}->{'type-property'}) {
	    # save type specific descriptions for later
	    my $type_schema = $prop->{$type_property};
	    if ($prop->{$k}->{oneOf}) {
		# it's optional if there are less options than types
		$is_optional = 1 if scalar($type_schema->{enum}->@*) > scalar($prop->{$k}->{oneOf}->@*);
		for my $alternative ($prop->{$k}->{oneOf}->@*) {
		    # it's optional if at least one variant is optional
		    $is_optional = 1 if $alternative->{optional};
		    for my $type ($alternative->{'instance-types'}->@*) {
			my $key = "${type_property}=${type}";
			$type_specific_opts->{$key} //= "";
			$type_specific_opts->{$key}
			    .= $get_property_description->($base, 'arg', $alternative, $format, $param_map->{$k});
		    }
		}
	    } elsif (my $types = $prop->{$k}->{'instance-types'}) {
		# it's optional if not all types has that option
		$is_optional = 1 if scalar($type_schema->{enum}->@*) > scalar($types->@*);
		for my $type ($types->@*) {
		    my $key = "${type_property}=${type}";
		    $type_specific_opts->{$key} //= "";
		    $type_specific_opts->{$key}
			.= $get_property_description->($base, 'arg', $prop->{$k}, $format, $param_map->{$k});
		}
	    }
	} elsif ($prop->{$k}->{oneOf}) {
	    my $res = [];
	    for my $alternative ($prop->{$k}->{oneOf}->@*) {
		# it's optional if at least one variant is optional
		$is_optional = 1 if $alternative->{optional};
		push $res->@*, $get_property_description->($base, 'arg', $alternative, $format, $param_map->{$k});
	    }
	    if ($format eq 'asciidoc') {
		$opts .= join("\n\nor\n\n", $res->@*);
	    } else {
		$opts .= join("  or\n\n", $res->@*);
	    }
	} else {
	    $opts .= $get_property_description->($base, 'arg', $prop->{$k}, $format, $param_map->{$k});
	}

	if (!$is_optional) {
	    $args .= " " if $args;
	    $args .= "--$base <$type_text>"
	}
    }

    if ($format eq 'asciidoc') {
	$out .= "*${prefix}*";
	$out .= " `$args`" if $args;
	$out .= " `[OPTIONS]`" if $opts;
	$out .= " `[FORMAT_OPTIONS]`" if $has_output_format_option;
	$out .= "\n";
    } else {
	$out .= "USAGE: " if $format ne 'short';
	$out .= "$prefix $args";
	$out .= " [OPTIONS]" if $opts;
	$out .= " [FORMAT_OPTIONS]" if $has_output_format_option;
	$out .= "\n";
    }

    return $out if $format eq 'short';

    if ($info->{description}) {
	if ($format eq 'asciidoc') {
	    my $desc = Text::Wrap::wrap('', '', ($info->{description}));
	    $out .= "\n$desc\n\n";
	} elsif ($format eq 'full') {
	    my $desc = Text::Wrap::wrap('  ', '  ', ($info->{description}));
	    $out .= "\n$desc\n\n";
	}
    }

    $out .= $argdescr if $argdescr;

    $out .= $opts if $opts;

    if (scalar(keys $type_specific_opts->%*)) {
	if ($format eq 'asciidoc') {
	    $out .= "\n\n\n`Conditional options:`\n\n";
	} else {
	    $out .= " Conditional options:\n\n";
	}
    }

    for my $type_opts (sort keys $type_specific_opts->%*) {
	if ($format eq 'asciidoc') {
	    $out .= "`[$type_opts]` ;;\n\n";
	} else {
	    $out .= " [$type_opts]\n\n";
	}
	$out .= $type_specific_opts->{$type_opts};
    }

    return $out;
}

sub usage_str {
    my ($self, $name, $prefix, $arg_param, $fixed_param, $format, $param_cb, $formatter_properties) = @_;

    my $info = $self->map_method_by_name($name);

    return getopt_usage($info, $prefix, $arg_param, $fixed_param, $format, $param_cb, $formatter_properties);
}

# generate docs from JSON schema properties
sub dump_properties {
    my ($prop, $format, $style, $filterFn) = @_;

    my $raw = '';

    $style //= 'config';

    my $idx_param = {}; # -vlan\d+ -scsi\d+

    foreach my $k (sort keys %$prop) {
	my $phash = $prop->{$k};

	next if defined($filterFn) && &$filterFn($k, $phash);
	next if $phash->{alias};

	my $base = $k;
	if ($k =~ m/^([a-z]+)(\d+)$/) {
	    my ($name, $idx) = ($1, $2);
	    next if $idx_param->{$name};
	    if ($idx == 0 && defined($prop->{"${name}1"})) {
		$idx_param->{$name} = 1;
		$base = "${name}[n]";
	    }
	}

	if ($phash->{oneOf}) {
	    for my $alternative ($phash->{oneOf}->@*) {
		$raw .= $get_property_description->($base, $style, $alternative, $format);
	    }
	} else {
	    $raw .= $get_property_description->($base, $style, $phash, $format);
	}


	next if $style ne 'config';

	my $prop_fmt = $phash->{format};
	next if !$prop_fmt;

	if (ref($prop_fmt) ne 'HASH') {
	    $prop_fmt = PVE::JSONSchema::get_format($prop_fmt);
	}

	next if !(ref($prop_fmt) && (ref($prop_fmt) eq 'HASH'));

	$raw .= dump_properties($prop_fmt, $format, 'config-sub')

    }

    return $raw;
}

my $replace_file_names_with_contents = sub {
    my ($param, $param_map) = @_;

    while (my ($k, $d) = each %$param_map) {
	next if $d->{interactive}; # handled by the JSONSchema's get_options code
	$param->{$k} = $d->{func}->($param->{$k})
	    if defined($param->{$k});
    }

    return $param;
};

sub add_standard_output_properties {
    my ($propdef, $list) = @_;

    $propdef //= {};

    $list //= [ keys %$standard_output_options ];

    my $res = { %$propdef }; # copy

    foreach my $opt (@$list) {
	die "no such standard output option '$opt'\n" if !defined($standard_output_options->{$opt});
	die "detected overwriten standard CLI parameter '$opt'\n" if defined($res->{$opt});
	$res->{$opt} = $standard_output_options->{$opt};
    }

    return $res;
}

sub extract_standard_output_properties {
    my ($data) = @_;

    my $options = {};
    foreach my $opt (keys %$standard_output_options) {
	$options->{$opt} = delete $data->{$opt} if defined($data->{$opt});
    }

    return $options;
}

sub cli_handler {
    my ($self, $prefix, $name, $args, $arg_param, $fixed_param, $param_cb, $formatter_properties) = @_;

    my $info = $self->map_method_by_name($name);
    my $res;
    my $fmt_param = {};

    eval {
	my $param_map = {};
	$param_map = $compute_param_mapping_hash->($param_cb->($name)) if $param_cb;
	my $schema = { %{$info->{parameters}} }; # copy
	$schema->{properties} = { %{$schema->{properties}}, %$formatter_properties } if $formatter_properties;
	my $param = PVE::JSONSchema::get_options($schema, $args, $arg_param, $fixed_param, $param_map);

	if ($formatter_properties) {
	    foreach my $opt (keys %$formatter_properties) {
		$fmt_param->{$opt} = delete $param->{$opt} if defined($param->{$opt});
	    }
	}

	if (defined($param_map)) {
	    $replace_file_names_with_contents->($param, $param_map);
	}

	$res = $self->handle($info, $param, 1);
    };
    if (my $err = $@) {
	my $ec = ref($err);

	die $err if !$ec || $ec ne "PVE::Exception" || !$err->is_param_exc();

	$err->{usage} = $self->usage_str($name, $prefix, $arg_param, $fixed_param, 'short', $param_cb, $formatter_properties);

	die $err;
    }

    return wantarray ? ($res, $fmt_param) : $res;
}

# utility methods
# note: this modifies the original hash by adding the id property
sub hash_to_array {
    my ($hash, $idprop) = @_;

    my $res = [];
    return $res if !$hash;

    foreach my $k (keys %$hash) {
	$hash->{$k}->{$idprop} = $k;
	push @$res, $hash->{$k};
    }

    return $res;
}

1;