use base 'Exporter';
our @EXPORT_OK = qw(
-register_standard_option
get_standard_option
+parse_property_string
+register_standard_option
);
-# Note: This class implements something similar to JSON schema, but it is not 100% complete.
+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/
sub register_standard_option {
my ($name, $schema) = @_;
- die "standard option '$name' already registered\n"
+ die "standard option '$name' already registered\n"
if $standard_options->{$name};
$standard_options->{$name} = $schema;
register_standard_option('pve-storage-id', {
description => "The storage identifier.",
type => 'string', format => 'pve-storage-id',
-});
+});
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.',
default => 'text',
});
+register_standard_option('pve-snapshot-name', {
+ description => "The name of the snapshot.",
+ type => 'string', format => 'pve-configid',
+ maxLength => 40,
+});
+
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};
- $format_list->{$format} = $code;
+ 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->{$name} = $format;
}
sub get_format {
- my ($format) = @_;
- return $format_list->{$format};
+ my ($name) = @_;
+ return $format_list->{$name};
}
my $renderer_hash = {};
register_format('pve-configid', \&pve_verify_configid);
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";
+ die "invalid configuration ID '$id'\n";
}
return $id;
}
sub parse_storage_id {
my ($storeid, $noerr) = @_;
- if ($storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i) {
+ return parse_id($storeid, 'storage', $noerr);
+}
+
+PVE::JSONSchema::register_format('acme-plugin-id', \&parse_acme_plugin_id);
+sub parse_acme_plugin_id {
+ my ($pluginid, $noerr) = @_;
+
+ return parse_id($pluginid, 'ACME plugin', $noerr);
+}
+
+sub parse_id {
+ my ($id, $type, $noerr) = @_;
+
+ if ($id !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i) {
return undef if $noerr;
- die "storage ID '$storeid' contains illegal characters\n";
+ die "$type ID '$id' contains illegal characters\n";
}
- return $storeid;
+ return $id;
}
-
register_format('pve-vmid', \&pve_verify_vmid);
sub pve_verify_vmid {
my ($vmid, $noerr) = @_;
return $node;
}
+sub parse_idmap {
+ my ($idmap, $idformat) = @_;
+
+ return undef if !$idmap;
+
+ my $map = {};
+
+ foreach my $entry (PVE::Tools::split_list($idmap)) {
+ if ($entry eq '1') {
+ $map->{identity} = 1;
+ } elsif ($entry =~ m/^([^:]+):([^:]+)$/) {
+ my ($source, $target) = ($1, $2);
+ eval {
+ check_format($idformat, $source, '');
+ check_format($idformat, $target, '');
+ };
+ die "entry '$entry' contains invalid ID - $@\n" if $@;
+
+ die "duplicate mapping for source '$source'\n"
+ if exists $map->{entries}->{$source};
+
+ $map->{entries}->{$source} = $target;
+ } else {
+ eval {
+ check_format($idformat, $entry);
+ };
+ die "entry '$entry' contains invalid ID - $@\n" if $@;
+
+ die "default target ID can only be provided once\n"
+ if exists $map->{default};
+
+ $map->{default} = $entry;
+ }
+ }
+
+ die "identity mapping cannot be combined with other mappings\n"
+ if $map->{identity} && ($map->{default} || exists $map->{entries});
+
+ return $map;
+}
+
+my $verify_idpair = sub {
+ my ($input, $noerr, $format) = @_;
+
+ eval { parse_idmap($input, $format) };
+ if ($@) {
+ return undef if $noerr;
+ die "$@\n";
+ }
+
+ return $input;
+};
+
+# note: this only checks a single list entry
+# when using a storagepair-list map, you need to pass the full parameter to
+# parse_idmap
+register_format('storagepair', \&verify_storagepair);
+sub verify_storagepair {
+ my ($storagepair, $noerr) = @_;
+ return $verify_idpair->($storagepair, $noerr, 'pve-storage-id');
+}
+
register_format('mac-addr', \&pve_verify_mac_addr);
sub pve_verify_mac_addr {
my ($mac_addr, $noerr) = @_;
return $ip;
}
+PVE::JSONSchema::register_format('ldap-simple-attr', \&verify_ldap_simple_attr);
+sub verify_ldap_simple_attr {
+ my ($attr, $noerr) = @_;
+
+ if ($attr =~ m/^[a-zA-Z0-9]+$/) {
+ return $attr;
+ }
+
+ die "value '$attr' does not look like a simple ldap attribute name\n" if !$noerr;
+
+ return undef;
+}
+
my $ipv4_mask_hash = {
+ '0.0.0.0' => 0,
'128.0.0.0' => 1,
'192.0.0.0' => 2,
'224.0.0.0' => 3,
'255.255.255.255' => 32,
};
+sub get_netmask_bits {
+ my ($mask) = @_;
+ return $ipv4_mask_hash->{$mask};
+}
+
register_format('ipv4mask', \&pve_verify_ipv4mask);
sub pve_verify_ipv4mask {
my ($mask, $noerr) = @_;
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 {
my ($id, $noerr) = @_;
-
+
if ($id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i) {
return undef if $noerr;
- die "invalid network interface name '$id'\n";
+ die "invalid network interface name '$id'\n";
}
return $id;
}
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 reasonable 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 => 'address',
-});
+});
register_standard_option('remote-viewer-config', {
description => "Returned values can be directly passed to the 'remote-viewer' application.",
my $bwlimit_format = {
default => {
%bwlimit_opt,
- description => 'default bandwidth limit in MiB/s',
+ description => 'default bandwidth limit in KiB/s',
},
restore => {
%bwlimit_opt,
- description => 'bandwidth limit in MiB/s for restoring guests from backups',
+ description => 'bandwidth limit in KiB/s for restoring guests from backups',
},
migration => {
%bwlimit_opt,
- description => 'bandwidth limit in MiB/s for migrating guests',
+ description => 'bandwidth limit in KiB/s for migrating guests (including moving local disks)',
},
clone => {
%bwlimit_opt,
- description => 'bandwidth limit in MiB/s for cloning disks',
+ description => 'bandwidth limit in KiB/s for cloning disks',
},
move => {
%bwlimit_opt,
- description => 'bandwidth limit in MiB/s for moving disks',
+ description => 'bandwidth limit in KiB/s for moving disks',
},
};
register_format('bwlimit', $bwlimit_format);
format => $bwlimit_format,
});
+# 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 undef if $noerr;
+
+ die "invalid characters in tag\n";
+}
+
sub pve_parse_startup_order {
my ($value) = @_;
typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
});
-sub check_format {
- my ($format, $value, $path) = @_;
+register_format('pve-tfa-secret', \&pve_verify_tfa_secret);
+sub pve_verify_tfa_secret {
+ my ($key, $noerr) = @_;
- return parse_property_string($format, $value, $path) if ref($format) eq 'HASH';
- return if $format eq 'regex';
+ # The old format used 16 base32 chars or 40 hex digits. Since they have a common subset it's
+ # hard to distinguish them without the our previous length constraints, so add a 'v2' of the
+ # format to support arbitrary lengths properly:
+ if ($key =~ /^v2-0x[0-9a-fA-F]{16,128}$/ || # hex
+ $key =~ /^v2-[A-Z2-7=]{16,128}$/ || # base32
+ $key =~ /^(?:[A-Z2-7=]{16}|[A-Fa-f0-9]{40})$/) # and the old pattern copy&pasted
+ {
+ return $key;
+ }
- if ($format =~ m/^(.*)-a?list$/) {
-
- my $code = $format_list->{$1};
+ return undef if $noerr;
- die "undefined format '$format'\n" if !$code;
+ die "unable to decode TFA secret\n";
+}
- # Note: we allow empty lists
- foreach my $v (split_list($value)) {
- &$code($v);
- }
- } elsif ($format =~ m/^(.*)-opt$/) {
+PVE::JSONSchema::register_format('pve-task-status-type', \&verify_task_status_type);
+sub verify_task_status_type {
+ my ($value, $noerr) = @_;
- my $code = $format_list->{$1};
+ return $value if $value =~ m/^(ok|error|warning|unknown)$/i;
- die "undefined format '$format'\n" if !$code;
+ return undef if $noerr;
- return if !$value; # allow empty string
+ die "invalid status '$value'\n";
+}
- &$code($value);
+sub check_format {
+ my ($format, $value, $path) = @_;
+
+ if (ref($format) eq 'HASH') {
+ # hash ref cannot have validator/list/opt handling attached
+ return parse_property_string($format, $value, $path);
+ }
- } else {
+ if (ref($format) eq 'CODE') {
+ # we are the (sole, old-style) validator
+ return $format->($value);
+ }
+
+ return if $format eq 'regex';
- my $code = $format_list->{$format};
+ my $parsed;
+ $format =~ m/^(.*?)(?:-a?(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 {
my ($value) = @_;
$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;
}
my ($errors, $path, $msg) = @_;
$path = '_root' if !$path;
-
+
if ($errors->{$path}) {
$errors->{$path} = join ('\n', $errors->{$path}, $msg);
} else {
my $value = shift;
# see 'man perlretut'
- return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
+ return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
}
sub is_integer {
if (!defined($value)) {
return 1 if $type eq 'null';
- die "internal error"
+ die "internal error"
}
if (my $tt = ref($type)) {
foreach my $t (@$type) {
my $tmperr = {};
check_type($path, $t, $value, $tmperr);
- return 1 if !scalar(%$tmperr);
+ return 1 if !scalar(%$tmperr);
}
my $ttext = join ('|', @$type);
- add_error($errors, $path, "type check ('$ttext') failed");
+ add_error($errors, $path, "type check ('$ttext') failed");
return undef;
} elsif ($tt eq 'HASH') {
my $tmperr = {};
check_prop($value, $type, $path, $tmperr);
- return 1 if !scalar(%$tmperr);
- add_error($errors, $path, "type check failed");
+ return 1 if !scalar(%$tmperr);
+ add_error($errors, $path, "type check failed");
return undef;
} else {
die "internal error - got reference type '$tt'";
}
}
}
- }
+ }
return undef;
}
#print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
check_prop($value, $requires, $path, $errors);
} elsif (!defined($value->{$requires})) {
- add_error($errors, $path ? "$path.$requires" : $requires,
+ add_error($errors, $path ? "$path.$requires" : $requires,
"missing property - '$newpath' requires this property");
}
}
}
}
}
- return;
+ return;
} elsif ($schema->{properties} || $schema->{additionalProperties}) {
check_object($path, defined($schema->{properties}) ? $schema->{properties} : {},
$value, $schema->{additionalProperties}, $errors);
return;
}
}
-
+
if (is_number($value)) {
if (defined (my $max = $schema->{maximum})) {
- if ($value > $max) {
+ if ($value > $max) {
add_error($errors, $path, "value must have a maximum value of $max");
return;
}
}
if (defined (my $min = $schema->{minimum})) {
- if ($value < $min) {
+ if ($value < $min) {
add_error($errors, $path, "value must have a minimum value of $min");
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) {
check_prop($instance, $schema, '', $errors);
}
-
+
if (scalar(%$errors)) {
raise $errmsg, code => HTTP_BAD_REQUEST, errors => $errors;
}
optional => 1,
minimum => 0,
default => 0,
- },
+ },
maxLength => {
type => "integer",
description => "When the instance value is a string, this indicates maximum length of the string.",
description => "For CLI context, this defines the maximal width to print before truncating",
optional => 1,
},
- }
+ }
};
my $default_schema = Storable::dclone($default_schema_noref);
path => {},
parameters => {},
returns => {},
- }
+ }
},
},
method => {
},
protected => {
type => 'boolean',
- description => "Method needs special privileges - only pvedaemon can execute it",
+ description => "Method needs special privileges - only pvedaemon can execute it",
optional => 1,
},
+ allowtoken => {
+ type => 'boolean',
+ description => "Method is available for clients authenticated using an API token.",
+ optional => 1,
+ default => 1,
+ },
download => {
type => 'boolean',
description => "Method downloads the file content (filename is the return value of the method).",
optional => 1,
},
user => {
- description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
- type => 'string',
+ description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
+ type => 'string',
enum => ['all', 'world'],
optional => 1,
},
check => {
description => "Array of permission checks (prefix notation).",
- type => 'array',
- optional => 1
+ type => 'array',
+ optional => 1
},
},
},
match_name => {},
match_re => {},
fragmentDelimiter => { optional => 1 }
- }
+ }
},
- },
+ },
},
};
sub validate_schema {
- my ($schema) = @_;
+ my ($schema) = @_;
my $errmsg = "internal error - unable to verify schema\n";
validate($schema, $default_schema, $errmsg);
my $errmsg = "internal error - unable to verify method info\n";
validate($info, $method_schema, $errmsg);
-
+
validate_schema($info->{parameters}) if $info->{parameters};
validate_schema($info->{returns}) if $info->{returns};
}
# run a self test on load
-# make sure we can verify the default schema
+# make sure we can verify the default schema
validate_schema($default_schema_noref);
validate_schema($method_schema);
return $found;
}
-# a way to parse command line parameters, using a
+# a way to parse command line parameters, using a
# schema to configure Getopt::Long
sub get_options {
my ($schema, $args, $arg_param, $fixed_param, $param_mapping_hash) = @_;
$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 %$fixed_param) {
my ($schema, $filename, $raw) = @_;
# do fast check (avoid validate_schema($schema))
- die "got strange schema" if !$schema->{type} ||
+ die "got strange schema" if !$schema->{type} ||
!$schema->{properties} || $schema->{type} ne 'object';
my $cfg = {};
if ($line =~ m/^(\S+?):\s*(.*)$/) {
my $key = $1;
my $value = $2;
- if ($schema->{properties}->{$key} &&
+ if ($schema->{properties}->{$key} &&
$schema->{properties}->{$key}->{type} eq 'boolean') {
$value = parse_boolean($value) // $value;
foreach my $k (keys %$errors) {
warn "parse error in '$filename' - '$k': $errors->{$k}\n";
delete $cfg->{$k};
- }
+ }
return $cfg;
}
my ($schema, $filename, $cfg) = @_;
# do fast check (avoid validate_schema($schema))
- die "got strange schema" if !$schema->{type} ||
+ die "got strange schema" if !$schema->{type} ||
!$schema->{properties} || $schema->{type} ne 'object';
validate($cfg, $schema, "validation error in '$filename'\n");
my $data = '';
- foreach my $k (keys %$cfg) {
+ foreach my $k (sort keys %$cfg) {
$data .= "$k: $cfg->{$k}\n";
}
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 = '';