The keyAlias feature replaces the previous 'group_ feature.
SectionConfig.pm \
Network.pm \
ProcFSTools.pm \
- PodParser.pm \
CLIHandler.pm \
RESTHandler.pm \
JSONSchema.pm \
use PVE::SafeSyslog;
use PVE::Exception qw(raise raise_param_exc);
use PVE::RESTHandler;
-use PVE::PodParser;
use PVE::INotify;
use base qw(PVE::RESTHandler);
return $synopsis;
}
-sub print_simple_pod_manpage {
- my ($podfn, $class, $name, $arg_param, $uri_param) = @_;
-
- die "not initialized" if !$cli_handler_class;
-
- my $pwcallback = $cli_handler_class->can('read_password');
- my $stringfilemap = $cli_handler_class->can('string_param_file_mapping');
-
- my $synopsis = " $name help\n\n";
- my $str = $class->usage_str($name, $name, $arg_param, $uri_param, 'long', $pwcallback, $stringfilemap);
- $str =~ s/^USAGE://;
- $str =~ s/\n/\n /g;
- $synopsis .= $str;
-
- my $parser = PVE::PodParser->new();
- $parser->{include}->{synopsis} = $synopsis;
- $parser->parse_from_file($podfn);
-}
-
-sub print_pod_manpage {
- my ($podfn) = @_;
-
- die "not initialized" if !($cmddef && $exename && $cli_handler_class);
- die "no pod file specified" if !$podfn;
-
- my $pwcallback = $cli_handler_class->can('read_password');
- my $stringfilemap = $cli_handler_class->can('string_param_file_mapping');
-
- my $synopsis = "";
-
- $synopsis .= " $exename <COMMAND> [ARGS] [OPTIONS]\n\n";
-
- my $style = 'full'; # or should we use 'short'?
- my $oldclass;
- foreach my $cmd (sorted_commands()) {
- my ($class, $name, $arg_param, $uri_param) = @{$cmddef->{$cmd}};
- my $str = $class->usage_str($name, "$exename $cmd", $arg_param,
- $uri_param, $style, $pwcallback,
- $stringfilemap);
- $str =~ s/^USAGE: //;
-
- $synopsis .= "\n" if $oldclass && $oldclass ne $class;
- $str =~ s/\n/\n /g;
- $synopsis .= " $str\n\n";
- $oldclass = $class;
- }
-
- $synopsis .= "\n";
-
- my $parser = PVE::PodParser->new();
- $parser->{include}->{synopsis} = $synopsis;
- $parser->parse_from_file($podfn);
-}
-
sub print_usage_verbose {
die "not initialized" if !($cmddef && $exename && $cli_handler_class);
return $filename;
}
-sub generate_pod_manpage {
- my ($class, $podfn) = @_;
-
- $cli_handler_class = $class;
-
- $exename = &$get_exe_name($class);
-
- $podfn = find_cli_class_source($exename) if !defined($podfn);
-
- die "unable to find source for class '$class'" if !$podfn;
-
- no strict 'refs';
- my $def = ${"${class}::cmddef"};
-
- if (ref($def) eq 'ARRAY') {
- print_simple_pod_manpage($podfn, @$def);
- } else {
- $cmddef = $def;
-
- $cmddef->{help} = [ __PACKAGE__, 'help', ['cmd'] ];
-
- print_pod_manpage($podfn);
- }
-}
-
sub generate_asciidoc_synopsys {
my ($class) = @_;
}
my $handle_cmd = sub {
- my ($def, $cmdname, $cmd, $args, $pwcallback, $podfn, $preparefunc, $stringfilemap) = @_;
+ my ($def, $cmdname, $cmd, $args, $pwcallback, $preparefunc, $stringfilemap) = @_;
$cmddef = $def;
$exename = $cmdname;
} elsif ($cmd eq 'verifyapi') {
PVE::RESTHandler::validate_method_schemas();
return;
- } elsif ($cmd eq 'printmanpod') {
- $podfn = find_cli_class_source($exename) if !defined($podfn);
- print_pod_manpage($podfn);
- return;
} elsif ($cmd eq 'bashcomplete') {
&$print_bash_completion($cmddef, 0, @$args);
return;
};
my $handle_simple_cmd = sub {
- my ($def, $args, $pwcallback, $podfn, $preparefunc, $stringfilemap) = @_;
+ my ($def, $args, $pwcallback, $preparefunc, $stringfilemap) = @_;
my ($class, $name, $arg_param, $uri_param, $outsub) = @{$def};
die "no class specified" if !$class;
} elsif ($args->[0] eq 'verifyapi') {
PVE::RESTHandler::validate_method_schemas();
return;
- } elsif ($args->[0] eq 'printmanpod') {
- $podfn = find_cli_class_source($name) if !defined($podfn);
- print_simple_pod_manpage($podfn, @$def);
- return;
}
}
sub run_cli {
my ($class, $pwcallback, $podfn, $preparefunc) = @_;
- # Note: "depreciated function run_cli - use run_cli_handler instead";
-
- die "password callback is no longer supported" if $pwcallback;
-
- run_cli_handler($class, podfn => $podfn, prepare => $preparefunc);
+ die "depreciated function run_cli - use run_cli_handler instead";
}
sub run_cli_handler {
$ENV{'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin';
foreach my $key (keys %params) {
- next if $key eq 'podfn';
next if $key eq 'prepare';
next if $key eq 'no_init'; # used by lxc hooks
die "unknown parameter '$key'";
}
- my $podfn = $params{podfn};
my $preparefunc = $params{prepare};
my $no_init = $params{no_init};
my $def = ${"${class}::cmddef"};
if (ref($def) eq 'ARRAY') {
- &$handle_simple_cmd($def, \@ARGV, $pwcallback, $podfn, $preparefunc, $stringfilemap);
+ &$handle_simple_cmd($def, \@ARGV, $pwcallback, $preparefunc, $stringfilemap);
} else {
$cmddef = $def;
my $cmd = shift @ARGV;
- &$handle_cmd($cmddef, $exename, $cmd, \@ARGV, $pwcallback, $podfn, $preparefunc, $stringfilemap);
+ &$handle_cmd($cmddef, $exename, $cmd, \@ARGV, $pwcallback, $preparefunc, $stringfilemap);
}
exit 0;
use PVE::Exception qw(raise);
use HTTP::Status qw(:constants);
use Net::IP qw(:PROC);
+use Data::Dumper;
use base 'Exporter';
my ($k, $v) = ($1, $2);
die "duplicate key in comma-separated list property: $k\n" if defined($res->{$k});
my $schema = $format->{$k};
- if (my $group = $schema->{group}) {
- die "keys $res->{$group} and $k are part of the same group and cannot be used together\n"
- if defined($res->{$group});
- $res->{$group} = $k;
- $schema = $format->{$group};
- }
if (my $alias = $schema->{alias}) {
+ if (my $key_alias = $schema->{keyAlias}) {
+ die "key alias '$key_alias' is already defined\n" if defined($res->{$key_alias});
+ $res->{$key_alias} = $k;
+ }
$k = $alias;
$schema = $format->{$k};
}
+
die "invalid key in comma-separated list property: $k\n" if !$schema;
if ($schema->{type} && $schema->{type} eq 'boolean') {
$v = 1 if $v =~ m/^(1|on|yes|true)$/i;
return $res;
}
-sub print_property_string {
- my ($data, $format, $skip, $path) = @_;
-
- if (ref($format) ne 'HASH') {
- my $schema = $format_list->{$format};
- die "not a valid format: $format\n" if !$schema;
- $format = $schema;
- }
-
- my $errors = {};
- check_object($path, $format, $data, undef, $errors);
- if (scalar(%$errors)) {
- raise "format error", errors => $errors;
- }
-
- my $default_key;
- my %skipped = map { $_ => 1 } @$skip;
- my %allowed;
- my %required; # this is a set, all present keys are required regardless of value
- my %group_for_key;
- foreach my $key (keys %$format) {
- $allowed{$key} = 1;
- my $keyfmt = $format->{$key};
- my $group = $keyfmt->{group};
- if (defined($group)) {
- $skipped{$group} = 1;
- if (defined(my $grpalias = $format->{$group}->{alias})) {
- $group_for_key{$grpalias} = $group;
- } else {
- $group_for_key{$key} = $group;
- }
- }
- if (!$keyfmt->{optional} && !$keyfmt->{alias} && !defined($group) && !$skipped{$key}) {
- $required{$key} = 1;
- }
-
- # Skip default keys
- if ($keyfmt->{default_key}) {
- if ($default_key) {
- warn "multiple default keys in schema ($default_key, $key)\n";
- } else {
- $default_key = $key;
- $skipped{$key} = 1;
- }
- }
- }
-
- my ($text, $comma);
- if ($default_key && !defined($format->{$default_key}->{alias})) {
- $text = "$data->{$default_key}";
- $comma = ',';
- } else {
- $text = '';
- $comma = '';
- }
-
- foreach my $key (sort keys %$data) {
- delete $required{$key};
- next if $skipped{$key};
- die "invalid key: $key\n" if !$allowed{$key};
-
- my $keyfmt = $format->{$key};
- my $typeformat = $keyfmt->{format};
- my $value = $data->{$key};
- next if !defined($value);
- if (my $group = $group_for_key{$key}) {
- $key = $data->{$group};
- }
- $text .= $comma;
- $comma = ',';
- if ($typeformat && $typeformat eq 'disk-size') {
- $text .= "$key=" . format_size($value);
- } else {
- die "illegal value with commas for $key\n" if $value =~ /,/;
- $text .= "$key=$value";
- }
- }
-
- if (my $missing = join(',', keys %required)) {
- die "missing properties: $missing\n";
- }
-
- return $text;
-}
-
sub add_error {
my ($errors, $path, $msg) = @_;
return;
}
- my %groups;
- foreach my $k (keys %$schema) {
- if (defined(my $group = $schema->{$k}->{group})) {
- # When a group is aliased then the key/value pair will match the
- # schema, but if it's not then the group key contains the key-name
- # which will not match the group key's defined schema and we have
- # to match it against that...
- if (!defined($schema->{$group}->{alias})) {
- $groups{$group} = 1;
- }
- }
- }
foreach my $k (keys %$schema) {
- my $orig_key = $k;
- my $v;
- if ($groups{$k}) {
- if (defined($orig_key = $value->{$k})) {
- $v = $value->{$orig_key};
- } else {
- $orig_key = $k; # now only used for the 'path' parameter
- }
- } else {
- $v = $value->{$k};
- }
- check_prop($v, $schema->{$k}, $path ? "$path.$orig_key" : $orig_key, $errors);
+ check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors);
}
foreach my $k (keys %$value) {
optional => 1,
description => "When a key represents the same property as another it can be an alias to it, causing the parsed datastructure to use the other key to store the current value under.",
},
- group => {
+ keyAlias => {
type => 'string',
optional => 1,
- description => "If a key is part of a group then setting it will additionally set the group name in the resulting data structure to the key used to fill the group. Only one key of a group can be assigned.",
+ description => "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'.",
+ requires => 'alias',
},
default => {
type => "any",
return $data;
}
+# helpers used to generate our manual pages
+
+my $find_schema_default_key = sub {
+ my ($format) = @_;
+
+ my $default_key;
+ my $keyAliasProps = {};
+
+ foreach my $key (keys %$format) {
+ my $phash = $format->{$key};
+ if ($phash->{default_key}) {
+ die "multiple default keys in schema ($default_key, $key)\n"
+ if defined($default_key);
+ die "default key '$key' is an alias - this is not allowed\n"
+ if defined($phash->{alias});
+ die "default key '$key' with keyAlias attribute is not allowed\n"
+ if $phash->{keyAlias};
+
+ $default_key = $key;
+ }
+ my $key_alias = $phash->{keyAlias};
+ if ($phash->{alias} && $key_alias) {
+ die "inconsistent keyAlias '$key_alias' definition"
+ if defined($keyAliasProps->{$key_alias}) &&
+ $keyAliasProps->{$key_alias} ne $phash->{alias};
+ $keyAliasProps->{$key_alias} = $phash->{alias};
+ }
+ }
+
+ return wantarray ? ($default_key, $keyAliasProps) : $default_key;
+};
+
+sub generate_typetext {
+ my ($format) = @_;
+
+ my $default_key = &$find_schema_default_key($format);
+
+ my $res = '';
+ my $add_sep = 0;
+
+ my $add_option_string = sub {
+ my ($text, $optional) = @_;
+
+ if ($add_sep) {
+ $text = ",$text";
+ $res .= ' ';
+ }
+ $text = "[$text]" if $optional;
+ $res .= $text;
+ $add_sep = 1;
+ };
+
+ my $format_key_value = sub {
+ my ($key, $phash) = @_;
+
+ die "internal error" if defined($phash->{alias});
+
+ my $keytext = $key;
+
+ my $typetext = '';
+
+ if (my $desc = $phash->{format_description}) {
+ $typetext .= "<$desc>";
+ } elsif (my $text = $phash->{typetext}) {
+ $typetext .= $text;
+ } elsif (my $enum = $phash->{enum}) {
+ $typetext .= '<' . join('|', @$enum) . '>';
+ } elsif ($phash->{type} eq 'boolean') {
+ $typetext .= '<1|0>';
+ } elsif ($phash->{type} eq 'integer') {
+ $typetext .= '<integer>';
+ } elsif ($phash->{type} eq 'number') {
+ $typetext .= '<number>';
+ } else {
+ die "internal error: neither format_description nor typetext found for option '$key'";
+ }
+
+ if (defined($default_key) && ($default_key eq $key)) {
+ &$add_option_string("[$keytext=]$typetext", $phash->{optional});
+ } else {
+ &$add_option_string("$keytext=$typetext", $phash->{optional});
+ }
+ };
+
+ if (defined($default_key)) {
+ my $phash = $format->{$default_key};
+ &$format_key_value($default_key, $phash);
+ }
+
+ foreach my $key (sort keys %$format) {
+ next if defined($default_key) && ($key eq $default_key);
+
+ my $phash = $format->{$key};
+
+ next if $phash->{alias};
+ next if $phash->{group};
+
+ &$format_key_value($key, $phash);
+
+ if (my $keyAlias = $phash->{keyAlias}) {
+ &$add_option_string("<$keyAlias>=<$key>", 1);
+ }
+ }
+
+ return $res;
+}
+
+sub print_property_string {
+ my ($data, $format, $skip, $path) = @_;
+
+ if (ref($format) ne 'HASH') {
+ my $schema = get_format($format);
+ die "not a valid format: $format\n" if !$schema;
+ $format = $schema;
+ }
+
+ my $errors = {};
+ check_object($path, $format, $data, undef, $errors);
+ if (scalar(%$errors)) {
+ raise "format error", errors => $errors;
+ }
+
+ my ($default_key, $keyAliasProps) = &$find_schema_default_key($format);
+
+ my $res = '';
+ my $add_sep = 0;
+
+ my $add_option_string = sub {
+ my ($text) = @_;
+
+ $res .= ',' if $add_sep;
+ $res .= $text;
+ $add_sep = 1;
+ };
+
+ my $format_value = sub {
+ my ($key, $value, $format) = @_;
+
+ if (defined($format) && ($format eq 'disk-size')) {
+ return format_size($value);
+ } else {
+ die "illegal value with commas for $key\n" if $value =~ /,/;
+ return $value;
+ }
+ };
+
+ my $done = {};
+
+ my $cond_add_key = sub {
+ my ($key) = @_;
+
+ return if $done->{$key}; # avoid duplicates
+
+ $done->{$key} = 1;
+
+ my $value = $data->{$key};
+
+ return if !defined($value);
+
+ my $phash = $format->{$key};
+
+ # try to combine values if we have key aliases
+ if (my $combine = $keyAliasProps->{$key}) {
+ if (defined(my $combine_value = $data->{$combine})) {
+ my $combine_format = $format->{$combine}->{format};
+ my $value_str = &$format_value($key, $value, $phash->{format});
+ my $combine_str = &$format_value($combine, $combine_value, $combine_format);
+ &$add_option_string("${value_str}=${combine_str}");
+ $done->{$combine} = 1;
+ return;
+ }
+ }
+
+ if ($phash && $phash->{alias}) {
+ $phash = $format->{$phash->{alias}};
+ }
+
+ die "invalid key '$key'\n" if !$phash;
+ die "internal error" if defined($phash->{alias});
+
+ my $value_str = &$format_value($key, $value, $phash->{format});
+ &$add_option_string("$key=${value_str}");
+ };
+
+ # add default key first
+ &$cond_add_key($default_key) if defined($default_key);
+
+ foreach my $key (sort keys %$data) {
+ &$cond_add_key($key);
+ }
+
+ return $res;
+}
+
+sub schema_get_type_text {
+ my ($phash) = @_;
+
+ if ($phash->{typetext}) {
+ return $phash->{typetext};
+ } elsif ($phash->{format_description}) {
+ return "<$phash->{format_description}>";
+ } elsif ($phash->{enum}) {
+ return "(" . join(' | ', sort @{$phash->{enum}}) . ")";
+ } elsif ($phash->{pattern}) {
+ return $phash->{pattern};
+ } elsif ($phash->{type} eq 'integer' || $phash->{type} eq 'number') {
+ if (defined($phash->{minimum}) && defined($phash->{maximum})) {
+ return "$phash->{type} ($phash->{minimum} - $phash->{maximum})";
+ } elsif (defined($phash->{minimum})) {
+ return "$phash->{type} ($phash->{minimum} - N)";
+ } elsif (defined($phash->{maximum})) {
+ return "$phash->{type} (-N - $phash->{maximum})";
+ }
+ } elsif ($phash->{type} eq 'string') {
+ if (my $format = $phash->{format}) {
+ $format = get_format($format) if ref($format) ne 'HASH';
+ if (ref($format) eq 'HASH') {
+ return generate_typetext($format);
+ }
+ }
+ }
+
+ my $type = $phash->{type} || 'string';
+
+ return $type;
+}
+
1;
+++ /dev/null
-package PVE::PodParser;
-
-use strict;
-use warnings;
-use Pod::Parser;
-use base qw(Pod::Parser);
-
-my $currentYear = (localtime(time))[5] + 1900;
-
-my $stdinclude = {
- pve_copyright => <<EODATA,
-\=head1 COPYRIGHT AND DISCLAIMER
-
-Copyright (C) 2007-$currentYear Proxmox Server Solutions GmbH
-
-This program is free software: you can redistribute it and\/or modify
-it under the terms of the GNU Affero General Public License as
-published by the Free Software Foundation, either version 3 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU Affero General Public License for more details.
-
-You should have received a copy of the GNU Affero General Public License
-along with this program. If not, see L<http://www.gnu.org/licenses/>.
-EODATA
-};
-
-sub command {
- my ($self, $cmd, $text, $line_num, $pod_para) = @_;
-
- if (($cmd eq 'include' && $text =~ m/^\s*(\S+)\s/)) {
- my $incl = $1;
- my $data = $stdinclude->{$incl} ? $stdinclude->{$incl} :
- $self->{include}->{$incl};
- chomp $data;
- $self->textblock("$data\n\n", $line_num, $pod_para);
- } else {
- $self->textblock($pod_para->raw_text(), $line_num, $pod_para);
- }
-}
-
-# helpers used to generate our manual pages
-
-sub generate_typetext {
- my ($schema) = @_;
- my $typetext = '';
- my (@optional, @required);
- foreach my $key (sort keys %$schema) {
- my $entry = $schema->{$key};
- next if $entry->{alias};
- next if !$entry->{format_description} &&
- !$entry->{typetext} &&
- !$entry->{enum} &&
- $entry->{type} ne 'boolean';
- if ($schema->{$key}->{optional}) {
- push @optional, $key;
- } else {
- push @required, $key;
- }
- }
- my ($pre, $post) = ('', '');
- my $add = sub {
- my ($key) = @_;
- $typetext .= $pre;
- my $entry = $schema->{$key};
- if (my $alias = $entry->{alias}) {
- $key = $alias;
- $entry = $schema->{$key};
- }
- if (!defined($entry->{typetext})) {
- $typetext .= $entry->{default_key} ? "[$key=]" : "$key=";
- }
- if (my $desc = $entry->{format_description}) {
- $typetext .= "<$desc>";
- } elsif (my $text = $entry->{typetext}) {
- $typetext .= $text;
- } elsif (my $enum = $entry->{enum}) {
- $typetext .= '<' . join('|', @$enum) . '>';
- } elsif ($entry->{type} eq 'boolean') {
- $typetext .= '<1|0>';
- } else {
- die "internal error: neither format_description nor typetext found";
- }
- $typetext .= $post;
- };
- foreach my $key (@required) {
- &$add($key);
- $pre = ', ';
- }
- $pre = $pre ? ' [,' : '[';
- $post = ']';
- foreach my $key (@optional) {
- &$add($key);
- $pre = ' [,';
- }
- return $typetext;
-}
-
-sub schema_get_type_text {
- my ($phash) = @_;
-
- if ($phash->{typetext}) {
- return $phash->{typetext};
- } elsif ($phash->{format_description}) {
- return "<$phash->{format_description}>";
- } elsif ($phash->{enum}) {
- return "(" . join(' | ', sort @{$phash->{enum}}) . ")";
- } elsif ($phash->{pattern}) {
- return $phash->{pattern};
- } elsif ($phash->{type} eq 'integer' || $phash->{type} eq 'number') {
- if (defined($phash->{minimum}) && defined($phash->{maximum})) {
- return "$phash->{type} ($phash->{minimum} - $phash->{maximum})";
- } elsif (defined($phash->{minimum})) {
- return "$phash->{type} ($phash->{minimum} - N)";
- } elsif (defined($phash->{maximum})) {
- return "$phash->{type} (-N - $phash->{maximum})";
- }
- } elsif ($phash->{type} eq 'string') {
- if (my $format = $phash->{format}) {
- $format = PVE::JSONSchema::get_format($format) if ref($format) ne 'HASH';
- if (ref($format) eq 'HASH') {
- return generate_typetext($format);
- }
- }
- }
-
- my $type = $phash->{type} || 'string';
-
- return $type;
-}
-
-sub generate_property_text {
- my ($schema) = @_;
- my $data = '';
- foreach my $key (sort keys %$schema) {
- my $d = $schema->{$key};
- next if $d->{alias};
- my $desc = $d->{description};
- my $typetext = schema_get_type_text($d);
- $desc = 'No description available' if !$desc;
- $data .= "=item $key: $typetext\n\n$desc\n\n";
- }
- return $data;
-}
-
-# generate pod from JSON schema properties
-sub dump_properties {
- my ($properties) = @_;
-
- my $data = "=over 1\n\n";
-
- my $idx_param = {}; # -vlan\d+ -scsi\d+
-
- foreach my $key (sort keys %$properties) {
- my $d = $properties->{$key};
- my $base = $key;
- if ($key =~ m/^([a-z]+)(\d+)$/) {
- my $name = $1;
- next if $idx_param->{$name};
- $idx_param->{$name} = 1;
- $base = "${name}[n]";
- }
-
- my $descr = $d->{description} || 'No description avalable.';
- chomp $descr;
-
- if (defined(my $dv = $d->{default})) {
- my $multi = $descr =~ m/\n\n/; # multi paragraph ?
- $descr .= $multi ? "\n\n" : " ";
- $descr .= "Default value is '$dv'.";
- }
-
- my $typetext = schema_get_type_text($d);
- $data .= "=item $base: $typetext\n\n";
- $data .= "$descr\n\n";
-
- if ($d->{type} eq 'string') {
- my $format = $d->{format};
- if ($format && ref($format) eq 'HASH') {
- $data .= "=over 1.1\n\n";
- $data .= generate_property_text($format);
- $data .= "=back\n\n";
- }
- }
- }
-
- $data .= "=back";
-
- return $data;
-}
-
-1;
use PVE::SafeSyslog;
use PVE::Exception qw(raise raise_param_exc);
use PVE::JSONSchema;
-use PVE::PodParser;
use HTTP::Status qw(:constants :is status_message);
use Text::Wrap;
use Clone qw(clone);
chomp $descr;
- my $type = PVE::PodParser::schema_get_type_text($phash);
+ my $type = PVE::JSONSchema::schema_get_type_text($phash);
if ($hidepw && $name eq 'password') {
$type = '';
projects / pve-common.git / commitdiff