use PVE::Tools qw(split_list $IPV6RE $IPV4RE);
use PVE::Exception qw(raise);
use HTTP::Status qw(:constants);
+use JSON;
use Net::IP qw(:PROC);
use Data::Dumper;
our @EXPORT_OK = qw(
register_standard_option
get_standard_option
+parse_property_string
+print_property_string
);
+our $CONFIGID_RE = qr/[a-z][a-z0-9_-]+/i;
+
# Note: This class implements something similar to JSON schema, but it is not 100% complete.
# see: http://tools.ietf.org/html/draft-zyp-json-schema-02
# see: http://json-schema.org/
register_standard_option('pve-vmid', {
description => "The (unique) ID of the VM.",
- type => 'integer', format => 'pve-vmid',
- minimum => 1
+ type => 'integer',
+ format => 'pve-vmid',
+ minimum => 100,
+ maximum => 999_999_999,
});
register_standard_option('pve-node', {
register_standard_option('pve-storage-id', {
description => "The storage identifier.",
type => 'string', format => 'pve-storage-id',
+ format_description => 'storage ID',
+});
+
+register_standard_option('pve-bridge-id', {
+ description => "Bridge to attach guest network devices to.",
+ type => 'string', format => 'pve-bridge-id',
+ format_description => 'bridge',
});
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.',
+ description => 'Prevent changes if current configuration file has a different digest. '
+ . 'This can be used to prevent concurrent modifications.',
type => 'string',
optional => 1,
- maxLength => 40, # sha1 hex digest length is 40
+ # sha1 hex digests are 40 characters long
+ # sha256 hex digests are 64 characters long (sha256 is used in our Rust code)
+ maxLength => 64,
});
register_standard_option('skiplock', {
});
my $format_list = {};
+my $format_validators = {};
sub register_format {
- my ($format, $code) = @_;
+ my ($name, $format, $validator) = @_;
- die "JSON schema format '$format' already registered\n"
- if $format_list->{$format};
+ die "JSON schema format '$name' already registered\n"
+ if $format_list->{$name};
+
+ if ($validator) {
+ die "A \$validator function can only be specified for hash-based formats\n"
+ if ref($format) ne 'HASH';
+ $format_validators->{$name} = $validator;
+ }
- $format_list->{$format} = $code;
+ $format_list->{$name} = $format;
}
sub get_format {
- my ($format) = @_;
- return $format_list->{$format};
+ my ($name) = @_;
+ return $format_list->{$name};
}
my $renderer_hash = {};
sub pve_verify_configid {
my ($id, $noerr) = @_;
- if ($id !~ m/^[a-z][a-z0-9_]+$/i) {
+ if ($id !~ m/^$CONFIGID_RE$/) {
return undef if $noerr;
die "invalid configuration ID '$id'\n";
}
return parse_id($storeid, 'storage', $noerr);
}
+PVE::JSONSchema::register_format('pve-bridge-id', \&parse_bridge_id);
+sub parse_bridge_id {
+ my ($id, $noerr) = @_;
+
+ if ($id !~ m/^[-_.\w\d]+$/) {
+ return undef if $noerr;
+ die "invalid bridge ID '$id'\n";
+ }
+ return $id;
+}
+
PVE::JSONSchema::register_format('acme-plugin-id', \&parse_acme_plugin_id);
sub parse_acme_plugin_id {
my ($pluginid, $noerr) = @_;
return $node;
}
+# maps source to target ID using an ID map
+sub map_id {
+ my ($map, $source) = @_;
+
+ return $source if !defined($map);
+
+ return $map->{entries}->{$source}
+ if $map->{entries} && defined($map->{entries}->{$source});
+
+ return $map->{default} if $map->{default};
+
+ # identity (fallback)
+ return $source;
+}
+
sub parse_idmap {
my ($idmap, $idformat) = @_;
} elsif ($entry =~ m/^([^:]+):([^:]+)$/) {
my ($source, $target) = ($1, $2);
eval {
- PVE::JSONSchema::check_format($idformat, $source, '');
- PVE::JSONSchema::check_format($idformat, $target, '');
+ check_format($idformat, $source, '');
+ check_format($idformat, $target, '');
};
- die "entry '$entry' contains invalid ID - $@\n"
- if $@;
+ die "entry '$entry' contains invalid ID - $@\n" if $@;
die "duplicate mapping for source '$source'\n"
- if $map->{entries}->{$source};
+ if exists $map->{entries}->{$source};
$map->{entries}->{$source} = $target;
} else {
eval {
- PVE::JSONSchema::check_format($idformat, $entry);
+ check_format($idformat, $entry);
};
-
- die "entry '$entry' contains invalid ID - $@\n"
- if $@;
+ die "entry '$entry' contains invalid ID - $@\n" if $@;
die "default target ID can only be provided once\n"
- if $map->{default};
+ if exists $map->{default};
$map->{default} = $entry;
}
}
die "identity mapping cannot be combined with other mappings\n"
- if $map->{identity} && ($map->{default} || $map->{entries});
+ if $map->{identity} && ($map->{default} || exists $map->{entries});
return $map;
}
-register_format('storagepair', \&verify_storagepair);
-sub verify_storagepair {
- my ($storagepair, $noerr) = @_;
+my $verify_idpair = sub {
+ my ($input, $noerr, $format) = @_;
- # note: this only checks a single list entry
- # when using a storagepair-list map, you need to pass the full
- # parameter to parse_idmap
- eval { parse_idmap($storagepair, 'pve-storage-id') };
+ eval { parse_idmap($input, $format) };
if ($@) {
return undef if $noerr;
die "$@\n";
}
- return $storagepair;
+ return $input;
+};
+
+PVE::JSONSchema::register_standard_option('pve-targetstorage', {
+ description => "Mapping from source to target storages. Providing only a single storage ID maps all source storages to that storage. Providing the special value '1' will map each source storage to itself.",
+ type => 'string',
+ format => 'storage-pair-list',
+ optional => 1,
+});
+
+# note: this only checks a single list entry
+# when using a storage-pair-list map, you need to pass the full parameter to
+# parse_idmap
+register_format('storage-pair', \&verify_storagepair);
+sub verify_storagepair {
+ my ($storagepair, $noerr) = @_;
+ return $verify_idpair->($storagepair, $noerr, 'pve-storage-id');
+}
+
+# note: this only checks a single list entry
+# when using a bridge-pair-list map, you need to pass the full parameter to
+# parse_idmap
+register_format('bridge-pair', \&verify_bridgepair);
+sub verify_bridgepair {
+ my ($bridgepair, $noerr) = @_;
+ return $verify_idpair->($bridgepair, $noerr, 'pve-bridge-id');
}
register_format('mac-addr', \&pve_verify_mac_addr);
sub pve_verify_email {
my ($email, $noerr) = @_;
- if ($email !~ /^[\w\+\-\~]+(\.[\w\+\-\~]+)*@[a-zA-Z0-9\-]+(\.[a-zA-Z0-9\-]+)*$/) {
+ if ($email !~ /^$PVE::Tools::EMAIL_RE$/) {
return undef if $noerr;
die "value does not look like a valid email address\n";
}
return $email;
}
+register_format('email-or-username', \&pve_verify_email_or_username);
+sub pve_verify_email_or_username {
+ my ($email, $noerr) = @_;
+
+ if ($email !~ /^$PVE::Tools::EMAIL_RE$/ &&
+ $email !~ /^$PVE::Tools::EMAIL_USER_RE$/) {
+ return undef if $noerr;
+ die "value does not look like a valid email address or user name\n";
+ }
+ return $email;
+}
+
register_format('dns-name', \&pve_verify_dns_name);
sub pve_verify_dns_name {
my ($name, $noerr) = @_;
return $name;
}
+register_format('timezone', \&pve_verify_timezone);
+sub pve_verify_timezone {
+ my ($timezone, $noerr) = @_;
+
+ return $timezone if $timezone eq 'UTC';
+
+ open(my $fh, "<", "/usr/share/zoneinfo/zone.tab");
+ while (my $line = <$fh>) {
+ next if $line =~ /^\s*#/;
+ chomp $line;
+ my $zone = (split /\t/, $line)[2];
+ return $timezone if $timezone eq $zone; # found
+ }
+ close $fh;
+
+ return undef if $noerr;
+ die "invalid time zone '$timezone'\n";
+}
+
# network interface name
register_format('pve-iface', \&pve_verify_iface);
sub pve_verify_iface {
};
register_format('bwlimit', $bwlimit_format);
register_standard_option('bwlimit', {
- description => "Set bandwidth/io limits various operations.",
+ description => "Set I/O bandwidth limit for various operations (in KiB/s).",
optional => 1,
type => 'string',
format => $bwlimit_format,
});
+my $remote_format = {
+ host => {
+ type => 'string',
+ description => 'Remote Proxmox hostname or IP',
+ format_description => 'ADDRESS',
+ },
+ port => {
+ type => 'integer',
+ optional => 1,
+ description => 'Port to connect to',
+ format_description => 'PORT',
+ },
+ apitoken => {
+ type => 'string',
+ description => 'A full Proxmox API token including the secret value.',
+ format_description => 'PVEAPIToken=user@realm!token=SECRET',
+ },
+ fingerprint => get_standard_option(
+ 'fingerprint-sha256',
+ {
+ optional => 1,
+ description => 'Remote host\'s certificate fingerprint, if not trusted by system store.',
+ format_description => 'FINGERPRINT',
+ }
+ ),
+};
+register_format('proxmox-remote', $remote_format);
+register_standard_option('proxmox-remote', {
+ description => "Specification of a remote endpoint.",
+ type => 'string', format => 'proxmox-remote',
+});
+
+our $PVE_TAG_RE = qr/[a-z0-9_][a-z0-9_\-\+\.]*/i;
+
# used for pve-tag-list in e.g., guest configs
register_format('pve-tag', \&pve_verify_tag);
sub pve_verify_tag {
my ($value, $noerr) = @_;
- return $value if $value =~ m/^[a-z0-9_][a-z0-9_\-\+\.]*$/i;
+ return $value if $value =~ m/^${PVE_TAG_RE}$/i;
return undef if $noerr;
die "unable to decode TFA secret\n";
}
-sub check_format {
- 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$/) {
-
- my $code = $format_list->{$1};
-
- die "undefined format '$format'\n" if !$code;
+PVE::JSONSchema::register_format('pve-task-status-type', \&verify_task_status_type);
+sub verify_task_status_type {
+ my ($value, $noerr) = @_;
- # Note: we allow empty lists
- foreach my $v (split_list($value)) {
- &$code($v);
- }
+ return $value if $value =~ m/^(ok|error|warning|unknown)$/i;
- } elsif ($format =~ m/^(.*)-opt$/) {
+ return undef if $noerr;
- my $code = $format_list->{$1};
+ die "invalid status '$value'\n";
+}
- die "undefined format '$format'\n" if !$code;
+sub check_format {
+ my ($format, $value, $path) = @_;
- return if !$value; # allow empty string
+ if (ref($format) eq 'HASH') {
+ # hash ref cannot have validator/list/opt handling attached
+ return parse_property_string($format, $value, $path);
+ }
- &$code($value);
+ if (ref($format) eq 'CODE') {
+ # we are the (sole, old-style) validator
+ return $format->($value);
+ }
- } else {
+ return if $format eq 'regex';
- my $code = $format_list->{$format};
+ my $parsed;
+ $format =~ m/^(.*?)(?:-(list|opt))?$/;
+ my ($format_name, $format_type) = ($1, $2 // 'none');
+ my $registered = get_format($format_name);
+ die "undefined format '$format'\n" if !$registered;
- die "undefined format '$format'\n" if !$code;
+ die "'-$format_type' format must have code ref, not hash\n"
+ if $format_type ne 'none' && ref($registered) ne 'CODE';
- return parse_property_string($code, $value, $path) if ref($code) eq 'HASH';
- &$code($value);
+ if ($format_type eq 'list') {
+ $parsed = [];
+ # Note: we allow empty lists
+ foreach my $v (split_list($value)) {
+ push @{$parsed}, $registered->($v);
+ }
+ } elsif ($format_type eq 'opt') {
+ $parsed = $registered->($value) if $value;
+ } else {
+ if (ref($registered) eq 'HASH') {
+ # Note: this is the only case where a validator function could be
+ # attached, hence it's safe to handle that in parse_property_string.
+ # We do however have to call it with $format_name instead of
+ # $registered, so it knows about the name (and thus any validators).
+ $parsed = parse_property_string($format, $value, $path);
+ } else {
+ $parsed = $registered->($value);
+ }
}
+
+ return $parsed;
}
sub parse_size {
$additional_properties = 0 if !defined($additional_properties);
# Support named formats here, too:
+ my $validator;
if (!ref($format)) {
- if (my $desc = $format_list->{$format}) {
- $format = $desc;
+ if (my $reg = get_format($format)) {
+ die "parse_property_string only accepts hash based named formats\n"
+ if ref($reg) ne 'HASH';
+
+ # named formats can have validators attached
+ $validator = $format_validators->{$format};
+
+ $format = $reg;
} else {
die "unknown format: $format\n";
}
raise "format error\n", errors => $errors;
}
+ return $validator->($res) if $validator;
return $res;
}
return 1;
} else {
if ($vt) {
+ if ($type eq 'boolean' && JSON::is_bool($value)) {
+ return 1;
+ }
add_error($errors, $path, "type check ('$type') failed - got $vt");
return undef;
} else {
return undef;
}
+my sub get_instance_type {
+ my ($schema, $key, $value) = @_;
+
+ if (my $type_property = $schema->{$key}->{'type-property'}) {
+ return $value->{$type_property};
+ }
+
+ return undef;
+}
+
sub check_object {
my ($path, $schema, $value, $additional_properties, $errors) = @_;
}
foreach my $k (keys %$schema) {
- check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors);
+ my $instance_type = get_instance_type($schema, $k, $value);
+ check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors, $instance_type);
}
foreach my $k (keys %$value) {
}
}
- next; # value is already checked above
+ # if it's a oneOf, check if there is a matching type
+ my $matched_type = 1;
+ if ($subschema->{oneOf}) {
+ my $instance_type = get_instance_type($schema, $k, $value);
+ $matched_type = 0;
+ for my $alternative ($subschema->{oneOf}->@*) {
+ if (my $instance_types = $alternative->{'instance-types'}) {
+ if (!grep { $instance_type eq $_ } $instance_types->@*) {
+ next;
+ }
+ }
+ $matched_type = 1;
+ last;
+ }
+ }
+
+ next if $matched_type; # value is already checked above
}
if (defined ($additional_properties) && !$additional_properties) {
}
sub check_prop {
- my ($value, $schema, $path, $errors) = @_;
+ my ($value, $schema, $path, $errors, $instance_type) = @_;
die "internal error - no schema" if !$schema;
die "internal error" if !$errors;
return;
}
+ # must pass any of the given schemas
+ my $optional_for_type = 0;
+ if ($schema->{oneOf}) {
+ # in case we have an instance_type given, just check for that variant
+ if ($schema->{'type-property'}) {
+ $optional_for_type = 1;
+ for (my $i = 0; $i < scalar($schema->{oneOf}->@*); $i++) {
+ last if !$instance_type; # treat as optional if we don't have a type
+ my $inner_schema = $schema->{oneOf}->[$i];
+
+ if (!defined($inner_schema->{'instance-types'})) {
+ add_error($errors, $path, "missing 'instance-types' in oneOf alternative");
+ return;
+ }
+
+ next if !grep { $_ eq $instance_type } $inner_schema->{'instance-types'}->@*;
+ $optional_for_type = $inner_schema->{optional} // 0;
+ check_prop($value, $inner_schema, $path, $errors);
+ }
+ } else {
+ my $is_valid = 0;
+ my $collected_errors = {};
+ for (my $i = 0; $i < scalar($schema->{oneOf}->@*); $i++) {
+ my $inner_schema = $schema->{oneOf}->[$i];
+ my $inner_errors = {};
+ check_prop($value, $inner_schema, "$path.oneOf[$i]", $inner_errors);
+ if (!$inner_errors->%*) {
+ $is_valid = 1;
+ last;
+ }
+
+ for my $inner_path (keys $inner_errors->%*) {
+ add_error($collected_errors, $inner_path, $inner_errors->{$path});
+ }
+ }
+
+ if (!$is_valid) {
+ for my $inner_path (keys $collected_errors->%*) {
+ add_error($errors, $inner_path, $collected_errors->{$path});
+ }
+ }
+ }
+ } elsif ($instance_type) {
+ if (!defined($schema->{'instance-types'})) {
+ add_error($errors, $path, "missing 'instance-types'");
+ return;
+ }
+ if (grep { $_ eq $instance_type} $schema->{'instance_types'}->@*) {
+ $optional_for_type = 1;
+ }
+ }
+
# if it extends another schema, it must pass that schema as well
if($schema->{extends}) {
check_prop($value, $schema->{extends}, $path, $errors);
if (!defined ($value)) {
return if $schema->{type} && $schema->{type} eq 'null';
- if (!$schema->{optional} && !$schema->{alias} && !$schema->{group}) {
+ if (!$schema->{optional} && !$schema->{alias} && !$schema->{group} && !$optional_for_type) {
add_error($errors, $path, "property is missing and it is not optional");
}
return;
# we can disable that in the final release
# todo: is there a better/faster way to detect cycles?
my $cycles = 0;
- find_cycle($instance, sub { $cycles = 1 });
+ # 'download' responses can contain a filehandle, don't cycle-check that as
+ # it produces a warning
+ my $is_download = ref($instance) eq 'HASH' && exists($instance->{download});
+ find_cycle($instance, sub { $cycles = 1 }) if !$is_download;
if ($cycles) {
add_error($errors, undef, "data structure contains recursive cycles");
} elsif ($schema) {
},
enum => $schema_valid_types,
},
+ oneOf => {
+ type => 'array',
+ description => "This represents the alternative options for this Schema instance.",
+ optional => 1,
+ items => {
+ type => 'object',
+ description => "A valid option of the properties",
+ },
+ },
+ 'instance-types' => {
+ type => 'array',
+ description => "Indicate to which type the parameter (or variant if inside a oneOf) belongs.",
+ optional => 1,
+ items => {
+ type => 'string',
+ },
+ },
+ 'type-property' => {
+ type => 'string',
+ description => "The property to check for instance types.",
+ optional => 1,
+ },
optional => {
type => "boolean",
description => "This indicates that the instance property in the instance object is not required.",
$default_schema->{properties}->{properties}->{additionalProperties} = $default_schema;
$default_schema->{properties}->{additionalProperties}->{properties} = $default_schema->{properties};
+$default_schema->{properties}->{oneOf}->{items}->{properties} = $default_schema->{properties};
$default_schema->{properties}->{items}->{properties} = $default_schema->{properties};
$default_schema->{properties}->{items}->{additionalProperties} = 0;
# optional and call the mapping function afterwards.
push @getopt, "$prop:s";
push @interactive, [$prop, $mapping->{func}];
- } elsif ($pd->{type} eq 'boolean') {
+ } elsif ($pd->{type} && $pd->{type} eq 'boolean') {
push @getopt, "$prop:s";
} else {
- if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
+ if ($pd->{format} && $pd->{format} =~ m/-list/) {
+ push @getopt, "$prop=s@";
+ } elsif ($pd->{type} && $pd->{type} eq 'array') {
push @getopt, "$prop=s@";
} else {
push @getopt, "$prop=s";
$opts->{$list_param} = $args;
$args = [];
} elsif (ref($arg_param)) {
- foreach my $arg_name (@$arg_param) {
+ for (my $i = 0; $i < scalar(@$arg_param); $i++) {
+ my $arg_name = $arg_param->[$i];
if ($opts->{'extra-args'}) {
raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
}
$args = [];
next;
}
- raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
+ if (!@$args) {
+ # check if all left-over arg_param are optional, else we
+ # must die as the mapping is then ambigious
+ for (; $i < scalar(@$arg_param); $i++) {
+ my $prop = $arg_param->[$i];
+ raise("not enough arguments\n", code => HTTP_BAD_REQUEST)
+ if !$schema->{properties}->{$prop}->{optional};
+ }
+ if ($arg_param->[-1] eq 'extra-args') {
+ $opts->{'extra-args'} = [];
+ }
+ last;
+ }
$opts->{$arg_name} = shift @$args;
}
raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
foreach my $arg_name (@$arg_param) {
if ($arg_name eq 'extra-args') {
$opts->{'extra-args'} = [];
- } else {
+ } elsif (!$schema->{properties}->{$arg_name}->{optional}) {
raise("not enough arguments\n", code => HTTP_BAD_REQUEST);
}
}
foreach my $p (keys %$opts) {
if (my $pd = $schema->{properties}->{$p}) {
- if ($pd->{type} eq 'boolean') {
+ if ($pd->{type} && $pd->{type} eq 'boolean') {
if ($opts->{$p} eq '') {
$opts->{$p} = 1;
} elsif (defined(my $bool = parse_boolean($opts->{$p}))) {
# allow --vmid 100 --vmid 101 and --vmid 100,101
# allow --dow mon --dow fri and --dow mon,fri
$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
- if (scalar(@{$opts->{$p}}) != 1) {
- $opts->{$p} = join("\0", @{$opts->{$p}});
- } else {
- # st that split_list knows it is \0 terminated
- my $v = $opts->{$p}->[0];
- $opts->{$p} = "$v\0";
- }
}
}
}
}
# A way to parse configuration data by giving a json schema
-sub parse_config {
- my ($schema, $filename, $raw) = @_;
+sub parse_config : prototype($$$;$) {
+ my ($schema, $filename, $raw, $comment_key) = @_;
# do fast check (avoid validate_schema($schema))
die "got strange schema" if !$schema->{type} ||
my $cfg = {};
+ my $comment_data;
+ my $handle_comment = sub { $_[0] =~ /^#/ };
+ if (defined($comment_key)) {
+ $comment_data = '';
+ my $comment_re = qr/^\Q$comment_key\E:\s*(.*\S)\s*$/;
+ $handle_comment = sub {
+ if ($_[0] =~ /^\#(.*)\s*$/ || $_[0] =~ $comment_re) {
+ $comment_data .= PVE::Tools::decode_text($1) . "\n";
+ return 1;
+ }
+ return undef;
+ };
+ }
+
while ($raw =~ /^\s*(.+?)\s*$/gm) {
my $line = $1;
- next if $line =~ /^#/;
+ next if $handle_comment->($line);
if ($line =~ m/^(\S+?):\s*(.*)$/) {
my $key = $1;
$value = parse_boolean($value) // $value;
}
+ if (
+ $schema->{properties}->{$key}
+ && $schema->{properties}->{$key}->{type} eq 'array'
+ ) {
+
+ $cfg->{$key} //= [];
+ push $cfg->{$key}->@*, $value;
+ next;
+ }
$cfg->{$key} = $value;
} else {
warn "ignore config line: $line\n"
}
}
+ if (defined($comment_data)) {
+ $cfg->{$comment_key} = $comment_data;
+ }
+
my $errors = {};
check_prop($cfg, $schema, '', $errors);
sub print_property_string {
my ($data, $format, $skip, $path) = @_;
+ my $validator;
if (ref($format) ne 'HASH') {
my $schema = get_format($format);
die "not a valid format: $format\n" if !$schema;
+ # named formats can have validators attached
+ $validator = $format_validators->{$format};
$format = $schema;
}
raise "format error", errors => $errors;
}
+ $data = $validator->($data) if $validator;
+
my ($default_key, $keyAliasProps) = &$find_schema_default_key($format);
my $res = '';