use warnings;
use Storable; # for dclone
use Getopt::Long;
+use Encode::Locale;
+use Encode;
use Devel::Cycle -quiet; # todo: remove?
use PVE::Tools qw(split_list $IPV6RE $IPV4RE);
use PVE::Exception qw(raise);
use HTTP::Status qw(:constants);
use Net::IP qw(:PROC);
+use Data::Dumper;
use base 'Exporter';
my $res = $base || {};
foreach my $opt (keys %$std) {
- next if $res->{$opt};
+ next if defined($res->{$opt});
$res->{$opt} = $std->{$opt};
}
minLength => 2, maxLength => 20,
});
-PVE::JSONSchema::register_standard_option('pve-storage-id', {
+register_standard_option('pve-storage-id', {
description => "The storage identifier.",
type => 'string', format => 'pve-storage-id',
});
-PVE::JSONSchema::register_standard_option('pve-config-digest', {
+register_standard_option('pve-config-digest', {
description => 'Prevent changes if current configuration file has different SHA1 digest. This can be used to prevent concurrent modifications.',
type => 'string',
optional => 1,
maxLength => 40, # sha1 hex digest lenght is 40
});
+register_standard_option('skiplock', {
+ description => "Ignore locks - only root is allowed to use this option.",
+ type => 'boolean',
+ optional => 1,
+});
+
+register_standard_option('extra-args', {
+ description => "Extra arguments as array",
+ type => 'array',
+ items => { type => 'string' },
+ optional => 1
+});
+
+register_standard_option('fingerprint-sha256', {
+ description => "Certificate SHA 256 fingerprint.",
+ type => 'string',
+ pattern => '([A-Fa-f0-9]{2}:){31}[A-Fa-f0-9]{2}',
+});
+
my $format_list = {};
sub register_format {
$format_list->{$format} = $code;
}
+sub get_format {
+ my ($format) = @_;
+ return $format_list->{$format};
+}
+
# register some common type for pve
register_format('string', sub {}); # allow format => 'string-list'
+register_format('urlencoded', \&pve_verify_urlencoded);
+sub pve_verify_urlencoded {
+ my ($text, $noerr) = @_;
+ if ($text !~ /^[-%a-zA-Z0-9_.!~*'()]*$/) {
+ return undef if $noerr;
+ die "invalid urlencoded string: $text\n";
+ }
+ return $text;
+}
+
register_format('pve-configid', \&pve_verify_configid);
sub pve_verify_configid {
my ($id, $noerr) = @_;
sub pve_verify_vmid {
my ($vmid, $noerr) = @_;
- if ($vmid !~ m/^[1-9][0-9]+$/) {
+ if ($vmid !~ m/^[1-9][0-9]{2,8}$/) {
return undef if $noerr;
die "value does not look like a valid VM ID\n";
}
}
register_format('ipv6', \&pve_verify_ipv6);
-sub pve_verify_ipv4 {
+sub pve_verify_ipv6 {
my ($ipv6, $noerr) = @_;
if ($ipv6 !~ m/^(?:$IPV6RE)$/) {
'255.255.255.224' => 27,
'255.255.255.240' => 28,
'255.255.255.248' => 29,
- '255.255.255.252' => 30
+ '255.255.255.252' => 30,
+ '255.255.255.254' => 31,
+ '255.255.255.255' => 32,
};
register_format('ipv4mask', \&pve_verify_ipv4mask);
return $mask;
}
-register_format('CIDR', \&pve_verify_cidr);
-sub pve_verify_cidr {
+register_format('CIDRv6', \&pve_verify_cidrv6);
+sub pve_verify_cidrv6 {
my ($cidr, $noerr) = @_;
- if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) && ($1 < 32)) {
+ if ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) && ($1 <= 128)) {
return $cidr;
- } elsif ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) && ($1 <= 120)) {
+ }
+
+ return undef if $noerr;
+ die "value does not look like a valid IPv6 CIDR network\n";
+}
+
+register_format('CIDRv4', \&pve_verify_cidrv4);
+sub pve_verify_cidrv4 {
+ my ($cidr, $noerr) = @_;
+
+ if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) && ($1 <= 32)) {
return $cidr;
}
return undef if $noerr;
- die "value does not look like a valid CIDR network\n";
+ die "value does not look like a valid IPv4 CIDR network\n";
+}
+
+register_format('CIDR', \&pve_verify_cidr);
+sub pve_verify_cidr {
+ my ($cidr, $noerr) = @_;
+
+ if (!(pve_verify_cidrv4($cidr, 1) ||
+ pve_verify_cidrv6($cidr, 1)))
+ {
+ return undef if $noerr;
+ die "value does not look like a valid CIDR network\n";
+ }
+
+ return $cidr;
+}
+
+register_format('pve-ipv4-config', \&pve_verify_ipv4_config);
+sub pve_verify_ipv4_config {
+ my ($config, $noerr) = @_;
+
+ return $config if $config =~ /^(?:dhcp|manual)$/ ||
+ pve_verify_cidrv4($config, 1);
+ return undef if $noerr;
+ die "value does not look like a valid ipv4 network configuration\n";
+}
+
+register_format('pve-ipv6-config', \&pve_verify_ipv6_config);
+sub pve_verify_ipv6_config {
+ my ($config, $noerr) = @_;
+
+ return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
+ pve_verify_cidrv6($config, 1);
+ return undef if $noerr;
+ die "value does not look like a valid ipv6 network configuration\n";
}
register_format('email', \&pve_verify_email);
sub pve_verify_email {
my ($email, $noerr) = @_;
- # we use same regex as extjs Ext.form.VTypes.email
- if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,6}$/) {
+ # we use same regex as in Utils.js
+ if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/) {
return undef if $noerr;
die "value does not look like a valid email address\n";
}
return $id;
}
+# general addresses by name or IP
+register_format('address', \&pve_verify_address);
+sub pve_verify_address {
+ my ($addr, $noerr) = @_;
+
+ if (!(pve_verify_ip($addr, 1) ||
+ pve_verify_dns_name($addr, 1)))
+ {
+ return undef if $noerr;
+ die "value does not look like a valid address: $addr\n";
+ }
+ return $addr;
+}
+
+register_format('disk-size', \&pve_verify_disk_size);
+sub pve_verify_disk_size {
+ my ($size, $noerr) = @_;
+ if (!defined(parse_size($size))) {
+ return undef if $noerr;
+ die "value does not look like a valid disk size: $size\n";
+ }
+ return $size;
+}
+
register_standard_option('spice-proxy', {
description => "SPICE proxy server. This can be used by the client to specify the proxy server. All nodes in a cluster runs 'spiceproxy', so it is up to the client to choose one. By default, we return the node where the VM is currently running. As resonable setting is to use same node you use to connect to the API (This is window.location.hostname for the JS GUI).",
- type => 'string', format => 'dns-name',
+ type => 'string', format => 'address',
});
register_standard_option('remote-viewer-config', {
die "unable to parse startup options\n";
}
+my %bwlimit_opt = (
+ optional => 1,
+ type => 'number', minimum => '0',
+ format_description => 'LIMIT',
+);
+
+my $bwlimit_format = {
+ default => {
+ %bwlimit_opt,
+ description => 'default bandwidth limit in MiB/s',
+ },
+ restore => {
+ %bwlimit_opt,
+ description => 'bandwidth limit in MiB/s for restoring guests from backups',
+ },
+ migration => {
+ %bwlimit_opt,
+ description => 'bandwidth limit in MiB/s for migrating guests',
+ },
+ clone => {
+ %bwlimit_opt,
+ description => 'bandwidth limit in MiB/s for cloning disks',
+ },
+ move => {
+ %bwlimit_opt,
+ description => 'bandwidth limit in MiB/s for moving disks',
+ },
+};
+register_format('bwlimit', $bwlimit_format);
+register_standard_option('bwlimit', {
+ description => "Set bandwidth/io limits various operations.",
+ optional => 1,
+ type => 'string',
+ format => $bwlimit_format,
+});
+
sub pve_parse_startup_order {
my ($value) = @_;
});
sub check_format {
- my ($format, $value) = @_;
+ my ($format, $value, $path) = @_;
+ return parse_property_string($format, $value, $path) if ref($format) eq 'HASH';
return if $format eq 'regex';
if ($format =~ m/^(.*)-a?list$/) {
die "undefined format '$format'\n" if !$code;
+ return parse_property_string($code, $value, $path) if ref($code) eq 'HASH';
&$code($value);
}
}
+sub parse_size {
+ my ($value) = @_;
+
+ return undef if $value !~ m/^(\d+(\.\d+)?)([KMGT])?$/;
+ my ($size, $unit) = ($1, $3);
+ if ($unit) {
+ if ($unit eq 'K') {
+ $size = $size * 1024;
+ } elsif ($unit eq 'M') {
+ $size = $size * 1024 * 1024;
+ } elsif ($unit eq 'G') {
+ $size = $size * 1024 * 1024 * 1024;
+ } elsif ($unit eq 'T') {
+ $size = $size * 1024 * 1024 * 1024 * 1024;
+ }
+ }
+ return int($size);
+};
+
+sub format_size {
+ my ($size) = @_;
+
+ $size = int($size);
+
+ my $kb = int($size/1024);
+ return $size if $kb*1024 != $size;
+
+ my $mb = int($kb/1024);
+ return "${kb}K" if $mb*1024 != $kb;
+
+ my $gb = int($mb/1024);
+ return "${mb}M" if $gb*1024 != $mb;
+
+ my $tb = int($gb/1024);
+ return "${gb}G" if $tb*1024 != $gb;
+
+ return "${tb}T";
+};
+
+sub parse_boolean {
+ my ($bool) = @_;
+ return 1 if $bool =~ m/^(1|on|yes|true)$/i;
+ return 0 if $bool =~ m/^(0|off|no|false)$/i;
+ return undef;
+}
+
+sub parse_property_string {
+ my ($format, $data, $path, $additional_properties) = @_;
+
+ # In property strings we default to not allowing additional properties
+ $additional_properties = 0 if !defined($additional_properties);
+
+ # Support named formats here, too:
+ if (!ref($format)) {
+ if (my $desc = $format_list->{$format}) {
+ $format = $desc;
+ } else {
+ die "unknown format: $format\n";
+ }
+ } elsif (ref($format) ne 'HASH') {
+ die "unexpected format value of type ".ref($format)."\n";
+ }
+
+ my $default_key;
+
+ my $res = {};
+ foreach my $part (split(/,/, $data)) {
+ next if $part =~ /^\s*$/;
+
+ if ($part =~ /^([^=]+)=(.+)$/) {
+ 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 $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 = parse_boolean($v) // $v;
+ }
+ $res->{$k} = $v;
+ } elsif ($part !~ /=/) {
+ die "duplicate key in comma-separated list property: $default_key\n" if $default_key;
+ foreach my $key (keys %$format) {
+ if ($format->{$key}->{default_key}) {
+ $default_key = $key;
+ if (!$res->{$default_key}) {
+ $res->{$default_key} = $part;
+ last;
+ }
+ die "duplicate key in comma-separated list property: $default_key\n";
+ }
+ }
+ die "value without key, but schema does not define a default key\n" if !$default_key;
+ } else {
+ die "missing key in comma-separated list property\n";
+ }
+ }
+
+ my $errors = {};
+ check_object($path, $format, $res, $additional_properties, $errors);
+ if (scalar(%$errors)) {
+ raise "format error\n", errors => $errors;
+ }
+
+ return $res;
+}
+
sub add_error {
my ($errors, $path, $msg) = @_;
return undef;
}
return 1;
+ } elsif ($type eq 'string' && $vt eq 'Regexp') {
+ # qr// regexes can be used as strings and make sense for format=regex
+ return 1;
} else {
if ($vt) {
add_error($errors, $path, "type check ('$type') failed - got $vt");
return 1;
#} elsif ($value =~ m/^(0|false|no|off)$/i) {
} elsif ($value eq '0') {
- return 0;
+ return 1; # return success (not value)
} else {
add_error($errors, $path, "type check ('$type') failed - got '$value'");
return undef;
check_prop($value, $requires, $path, $errors);
} elsif (!defined($value->{$requires})) {
add_error($errors, $path ? "$path.$requires" : $requires,
- "missing property - '$newpath' requiers this property");
+ "missing property - '$newpath' requires this property");
}
}
}
}
+sub check_object_warn {
+ my ($path, $schema, $value, $additional_properties) = @_;
+ my $errors = {};
+ check_object($path, $schema, $value, $additional_properties, $errors);
+ if (scalar(%$errors)) {
+ foreach my $k (keys %$errors) {
+ warn "parse error: $k: $errors->{$k}\n";
+ }
+ return 0;
+ }
+ return 1;
+}
+
sub check_prop {
my ($value, $schema, $path, $errors) = @_;
if (!defined ($value)) {
return if $schema->{type} && $schema->{type} eq 'null';
- if (!$schema->{optional}) {
+ if (!$schema->{optional} && !$schema->{alias} && !$schema->{group}) {
add_error($errors, $path, "property is missing and it is not optional");
}
return;
} else {
if (my $format = $schema->{format}) {
- eval { check_format($format, $value); };
+ eval { check_format($format, $value, $path); };
if ($@) {
add_error($errors, $path, "invalid format - $@");
return;
pattern => {
type => "string",
format => "regex",
- description => "When the instance value is a string, this provides a regular expression that a instance string value should match in order to be valid.",
+ description => "When the instance value is a string, this provides a regular expression that a instance string value should match in order to be valid.",
optional => 1,
default => ".*",
- },
-
+ },
enum => {
type => "array",
optional => 1,
optional => 1,
description => "This provides a description of the purpose the instance property. The value can be a string or it can be an object with properties corresponding to various different instance languages (with an optional default property indicating the default description).",
},
- title => {
- type => "string",
+ verbose_description => {
+ type => "string",
+ optional => 1,
+ description => "This provides a more verbose description.",
+ },
+ format_description => {
+ type => "string",
optional => 1,
- description => "This provides the title of the property",
- },
- requires => {
- type => [ "string", "object" ],
+ description => "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings.",
+ },
+ title => {
+ type => "string",
optional => 1,
- description => "indicates a required property or a schema that must be validated if this property is present",
- },
- format => {
- type => "string",
+ description => "This provides the title of the property",
+ },
+ requires => {
+ type => [ "string", "object" ],
optional => 1,
- description => "This indicates what format the data is among some predefined formats which may include:\n\ndate - a string following the ISO format \naddress \nschema - a schema definition object \nperson \npage \nhtml - a string representing HTML",
- },
+ description => "indicates a required property or a schema that must be validated if this property is present",
+ },
+ format => {
+ type => [ "string", "object" ],
+ optional => 1,
+ description => "This indicates what format the data is among some predefined formats which may include:\n\ndate - a string following the ISO format \naddress \nschema - a schema definition object \nperson \npage \nhtml - a string representing HTML",
+ },
+ default_key => {
+ type => "boolean",
+ optional => 1,
+ description => "Whether this is the default key in a comma separated list property string.",
+ },
+ alias => {
+ type => 'string',
+ 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.",
+ },
+ keyAlias => {
+ type => 'string',
+ optional => 1,
+ description => "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'.",
+ requires => 'alias',
+ },
default => {
type => "any",
optional => 1,
description => "This indicates the default for the instance property."
},
- disallow => {
- type => "object",
+ completion => {
+ type => 'coderef',
+ description => "Bash completion function. This function should return a list of possible values.",
optional => 1,
- description => "This attribute may take the same values as the \"type\" attribute, however if the instance matches the type or if this value is an array and the instance matches any type or schema in the array, than this instance is not valid.",
},
- extends => {
- type => "object",
+ disallow => {
+ type => "object",
+ optional => 1,
+ description => "This attribute may take the same values as the \"type\" attribute, however if the instance matches the type or if this value is an array and the instance matches any type or schema in the array, then this instance is not valid.",
+ },
+ extends => {
+ type => "object",
optional => 1,
- description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
+ description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
default => {},
- },
- # this is from hyper schema
- links => {
- type => "array",
- description => "This defines the link relations of the instance objects",
- optional => 1,
+ },
+ # this is from hyper schema
+ links => {
+ type => "array",
+ description => "This defines the link relations of the instance objects",
+ optional => 1,
items => {
- type => "object",
- properties => {
- href => {
- type => "string",
- description => "This defines the target URL for the relation and can be parameterized using {propertyName} notation. It should be resolved as a URI-reference relative to the URI that was used to retrieve the instance document",
- },
- rel => {
- type => "string",
- description => "This is the name of the link relation",
- optional => 1,
- default => "full",
- },
+ type => "object",
+ properties => {
+ href => {
+ type => "string",
+ description => "This defines the target URL for the relation and can be parameterized using {propertyName} notation. It should be resolved as a URI-reference relative to the URI that was used to retrieve the instance document",
+ },
+ rel => {
+ type => "string",
+ description => "This is the name of the link relation",
+ optional => 1,
+ default => "full",
+ },
method => {
- type => "string",
- description => "For submission links, this defines the method that should be used to access the target resource",
- optional => 1,
- default => "GET",
+ type => "string",
+ description => "For submission links, this defines the method that should be used to access the target resource",
+ optional => 1,
+ default => "GET",
},
},
},
},
+ print_width => {
+ type => "integer",
+ description => "For CLI context, this defines the maximal width to print before truncating",
+ optional => 1,
+ },
}
};
description => "Method needs special privileges - only pvedaemon can execute it",
optional => 1,
},
+ download => {
+ type => 'boolean',
+ description => "Method downloads the file content (filename is the return value of the method).",
+ optional => 1,
+ },
proxyto => {
type => 'string',
description => "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
optional => 1,
},
+ proxyto_callback => {
+ type => 'coderef',
+ description => "A function which is called to resolve the proxyto attribute. The default implementaion returns the value of the 'proxyto' parameter.",
+ optional => 1,
+ },
permissions => {
type => 'object',
description => "Required access permissions. By default only 'root' is allowed to access this method.",
# a way to parse command line parameters, using a
# schema to configure Getopt::Long
sub get_options {
- my ($schema, $args, $arg_param, $fixed_param, $pwcallback) = @_;
+ my ($schema, $args, $arg_param, $fixed_param, $param_mapping_hash) = @_;
if (!$schema || !$schema->{properties}) {
raise("too many arguments\n", code => HTTP_BAD_REQUEST)
$list_param = $arg_param;
}
+ my @interactive = ();
my @getopt = ();
foreach my $prop (keys %{$schema->{properties}}) {
my $pd = $schema->{properties}->{$prop};
next if $list_param && $prop eq $list_param;
next if defined($fixed_param->{$prop});
- if ($prop eq 'password' && $pwcallback) {
- # we do not accept plain password on input line, instead
- # we turn this into a boolean option and ask for password below
- # using $pwcallback() (for security reasons).
- push @getopt, "$prop";
+ my $mapping = $param_mapping_hash->{$prop};
+ if ($mapping && $mapping->{interactive}) {
+ # interactive parameters such as passwords: make the argument
+ # optional and call the mapping function afterwards.
+ push @getopt, "$prop:s";
+ push @interactive, [$prop, $mapping->{func}];
} elsif ($pd->{type} eq 'boolean') {
push @getopt, "$prop:s";
} else {
}
}
+ Getopt::Long::Configure('prefix_pattern=(--|-)');
+
my $opts = {};
raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
- if (my $acount = scalar(@$args)) {
+ if (@$args) {
if ($list_param) {
$opts->{$list_param} = $args;
$args = [];
} elsif (ref($arg_param)) {
- raise("wrong number of arguments\n", code => HTTP_BAD_REQUEST)
- if scalar(@$arg_param) != $acount;
- foreach my $p (@$arg_param) {
- $opts->{$p} = shift @$args;
+ foreach my $arg_name (@$arg_param) {
+ if ($opts->{'extra-args'}) {
+ raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
+ }
+ if ($arg_name eq 'extra-args') {
+ $opts->{'extra-args'} = $args;
+ $args = [];
+ next;
+ }
+ raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
+ $opts->{$arg_name} = shift @$args;
}
+ raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
} else {
raise("too many arguments\n", code => HTTP_BAD_REQUEST)
if scalar(@$args) != 0;
}
+ } else {
+ if (ref($arg_param)) {
+ foreach my $arg_name (@$arg_param) {
+ if ($arg_name eq 'extra-args') {
+ $opts->{'extra-args'} = [];
+ } else {
+ raise("not enough arguments\n", code => HTTP_BAD_REQUEST);
+ }
+ }
+ }
}
- if (my $pd = $schema->{properties}->{password}) {
- if ($pd->{type} ne 'boolean' && $pwcallback) {
- if ($opts->{password} || !$pd->{optional}) {
- $opts->{password} = &$pwcallback();
- }
+ foreach my $entry (@interactive) {
+ my ($opt, $func) = @$entry;
+ my $pd = $schema->{properties}->{$opt};
+ my $value = $opts->{$opt};
+ if (defined($value) || !$pd->{optional}) {
+ $opts->{$opt} = $func->($value);
}
}
- $opts = PVE::Tools::decode_utf8_parameters($opts);
+ # decode after Getopt as we are not sure how well it handles unicode
+ foreach my $p (keys %$opts) {
+ if (!ref($opts->{$p})) {
+ $opts->{$p} = decode('locale', $opts->{$p});
+ } elsif (ref($opts->{$p}) eq 'ARRAY') {
+ my $tmp = [];
+ foreach my $v (@{$opts->{$p}}) {
+ push @$tmp, decode('locale', $v);
+ }
+ $opts->{$p} = $tmp;
+ } elsif (ref($opts->{$p}) eq 'SCALAR') {
+ $opts->{$p} = decode('locale', $$opts->{$p});
+ } else {
+ raise("decoding options failed, unknown reference\n", code => HTTP_BAD_REQUEST);
+ }
+ }
foreach my $p (keys %$opts) {
if (my $pd = $schema->{properties}->{$p}) {
if ($pd->{type} eq 'boolean') {
if ($opts->{$p} eq '') {
$opts->{$p} = 1;
- } elsif ($opts->{$p} =~ m/^(1|true|yes|on)$/i) {
- $opts->{$p} = 1;
- } elsif ($opts->{$p} =~ m/^(0|false|no|off)$/i) {
- $opts->{$p} = 0;
+ } elsif (defined(my $bool = parse_boolean($opts->{$p}))) {
+ $opts->{$p} = $bool;
} else {
raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
}
if ($pd->{format} =~ m/-list/) {
# allow --vmid 100 --vmid 101 and --vmid 100,101
# allow --dow mon --dow fri and --dow mon,fri
- $opts->{$p} = join(",", @{$opts->{$p}});
+ $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
} elsif ($pd->{format} =~ m/-alist/) {
# we encode array as \0 separated strings
# Note: CGI.pm also use this encoding
my $cfg = {};
- while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
+ while ($raw =~ /^\s*(.+?)\s*$/gm) {
my $line = $1;
-
- next if $line =~ m/^\#/; # skip comment lines
- next if $line =~ m/^\s*$/; # skip empty lines
- if ($line =~ m/^(\S+):\s*(\S+)\s*$/) {
+ next if $line =~ /^#/;
+
+ if ($line =~ m/^(\S+?):\s*(.*)$/) {
my $key = $1;
my $value = $2;
if ($schema->{properties}->{$key} &&
$schema->{properties}->{$key}->{type} eq 'boolean') {
- $value = 1 if $value =~ m/^(1|on|yes|true)$/i;
- $value = 0 if $value =~ m/^(0|off|no|false)$/i;
+ $value = parse_boolean($value) // $value;
}
$cfg->{$key} = $value;
} else {
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};
+ die "found keyAlias without 'alias definition for '$key'\n"
+ if $key_alias && !$phash->{alias};
+
+ 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, $list_enums) = @_;
+
+ my ($default_key, $keyAliasProps) = &$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}) {
+ if ($list_enums || (scalar(@$enum) <= 3)) {
+ $typetext .= '<' . join('|', @$enum) . '>';
+ } else {
+ $typetext .= '<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});
+ }
+ };
+
+ my $done = {};
+
+ my $cond_add_key = sub {
+ my ($key) = @_;
+
+ return if $done->{$key}; # avoid duplicates
+
+ $done->{$key} = 1;
+
+ my $phash = $format->{$key};
+
+ return if !$phash; # should not happen
+
+ return if $phash->{alias};
+
+ &$format_key_value($key, $phash);
+
+ };
+
+ &$cond_add_key($default_key) if defined($default_key);
+
+ # add required keys first
+ foreach my $key (sort keys %$format) {
+ my $phash = $format->{$key};
+ &$cond_add_key($key) if $phash && !$phash->{optional};
+ }
+
+ # add the rest
+ foreach my $key (sort keys %$format) {
+ &$cond_add_key($key);
+ }
+
+ foreach my $keyAlias (sort keys %$keyAliasProps) {
+ &$add_option_string("<$keyAlias>=<$keyAliasProps->{$keyAlias }>", 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 = { map { $_ => 1 } @$skip };
+
+ my $cond_add_key = sub {
+ my ($key, $isdefault) = @_;
+
+ 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});
+ if ($isdefault) {
+ &$add_option_string($value_str);
+ } else {
+ &$add_option_string("$key=${value_str}");
+ }
+ };
+
+ # add default key first
+ &$cond_add_key($default_key, 1) if defined($default_key);
+
+ # add required keys first
+ foreach my $key (sort keys %$data) {
+ my $phash = $format->{$key};
+ &$cond_add_key($key) if $phash && !$phash->{optional};
+ }
+
+ # add the rest
+ foreach my $key (sort keys %$data) {
+ &$cond_add_key($key);
+ }
+
+ return $res;
+}
+
+sub schema_get_type_text {
+ my ($phash, $style) = @_;
+
+ my $type = $phash->{type} || 'string';
+
+ 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 ($type eq 'integer' || $type eq 'number') {
+ # NOTE: always access values as number (avoid converion to string)
+ if (defined($phash->{minimum}) && defined($phash->{maximum})) {
+ return "<$type> (" . ($phash->{minimum} + 0) . " - " .
+ ($phash->{maximum} + 0) . ")";
+ } elsif (defined($phash->{minimum})) {
+ return "<$type> (" . ($phash->{minimum} + 0) . " - N)";
+ } elsif (defined($phash->{maximum})) {
+ return "<$type> (-N - " . ($phash->{maximum} + 0) . ")";
+ }
+ } elsif ($type eq 'string') {
+ if (my $format = $phash->{format}) {
+ $format = get_format($format) if ref($format) ne 'HASH';
+ if (ref($format) eq 'HASH') {
+ my $list_enums = 0;
+ $list_enums = 1 if $style && $style eq 'config-sub';
+ return generate_typetext($format, $list_enums);
+ }
+ }
+ }
+
+ return "<$type>";
+}
+
1;
projects / pve-common.git / blobdiff