1 package PVE
::JSONSchema
;
5 use Storable
; # for dclone
9 use Devel
::Cycle
-quiet
; # todo: remove?
10 use PVE
::Tools
qw(split_list $IPV6RE $IPV4RE);
11 use PVE
::Exception
qw(raise);
12 use HTTP
::Status
qw(:constants);
14 use Net
::IP
qw(:PROC);
20 register_standard_option
26 our $CONFIGID_RE = qr/[a-z][a-z0-9_-]+/i;
28 # Note: This class implements something similar to JSON schema, but it is not 100% complete.
29 # see: http://tools.ietf.org/html/draft-zyp-json-schema-02
30 # see: http://json-schema.org/
32 # the code is similar to the javascript parser from http://code.google.com/p/jsonschema/
34 my $standard_options = {};
35 sub register_standard_option
{
36 my ($name, $schema) = @_;
38 die "standard option '$name' already registered\n"
39 if $standard_options->{$name};
41 $standard_options->{$name} = $schema;
44 sub get_standard_option
{
45 my ($name, $base) = @_;
47 my $std = $standard_options->{$name};
48 die "no such standard option '$name'\n" if !$std;
50 my $res = $base || {};
52 foreach my $opt (keys %$std) {
53 next if defined($res->{$opt});
54 $res->{$opt} = $std->{$opt};
60 register_standard_option
('pve-vmid', {
61 description
=> "The (unique) ID of the VM.",
65 maximum
=> 999_999_999,
68 register_standard_option
('pve-node', {
69 description
=> "The cluster node name.",
70 type
=> 'string', format
=> 'pve-node',
73 register_standard_option
('pve-node-list', {
74 description
=> "List of cluster node names.",
75 type
=> 'string', format
=> 'pve-node-list',
78 register_standard_option
('pve-iface', {
79 description
=> "Network interface name.",
80 type
=> 'string', format
=> 'pve-iface',
81 minLength
=> 2, maxLength
=> 20,
84 register_standard_option
('pve-storage-id', {
85 description
=> "The storage identifier.",
86 type
=> 'string', format
=> 'pve-storage-id',
87 format_description
=> 'storage ID',
90 register_standard_option
('pve-bridge-id', {
91 description
=> "Bridge to attach guest network devices to.",
92 type
=> 'string', format
=> 'pve-bridge-id',
93 format_description
=> 'bridge',
96 register_standard_option
('pve-config-digest', {
97 description
=> 'Prevent changes if current configuration file has a different digest. '
98 . 'This can be used to prevent concurrent modifications.',
101 # sha1 hex digests are 40 characters long
102 # sha256 hex digests are 64 characters long (sha256 is used in our Rust code)
106 register_standard_option
('skiplock', {
107 description
=> "Ignore locks - only root is allowed to use this option.",
112 register_standard_option
('extra-args', {
113 description
=> "Extra arguments as array",
115 items
=> { type
=> 'string' },
119 register_standard_option
('fingerprint-sha256', {
120 description
=> "Certificate SHA 256 fingerprint.",
122 pattern
=> '([A-Fa-f0-9]{2}:){31}[A-Fa-f0-9]{2}',
125 register_standard_option
('pve-output-format', {
127 description
=> 'Output format.',
128 enum
=> [ 'text', 'json', 'json-pretty', 'yaml' ],
133 register_standard_option
('pve-snapshot-name', {
134 description
=> "The name of the snapshot.",
135 type
=> 'string', format
=> 'pve-configid',
139 my $format_list = {};
140 my $format_validators = {};
142 sub register_format
{
143 my ($name, $format, $validator) = @_;
145 die "JSON schema format '$name' already registered\n"
146 if $format_list->{$name};
149 die "A \$validator function can only be specified for hash-based formats\n"
150 if ref($format) ne 'HASH';
151 $format_validators->{$name} = $validator;
154 $format_list->{$name} = $format;
159 return $format_list->{$name};
162 my $renderer_hash = {};
164 sub register_renderer
{
165 my ($name, $code) = @_;
167 die "renderer '$name' already registered\n"
168 if $renderer_hash->{$name};
170 $renderer_hash->{$name} = $code;
175 return $renderer_hash->{$name};
178 # register some common type for pve
180 register_format
('string', sub {}); # allow format => 'string-list'
182 register_format
('urlencoded', \
&pve_verify_urlencoded
);
183 sub pve_verify_urlencoded
{
184 my ($text, $noerr) = @_;
185 if ($text !~ /^[-%a-zA-Z0-9_.!~*'()]*$/) {
186 return undef if $noerr;
187 die "invalid urlencoded string: $text\n";
192 register_format
('pve-configid', \
&pve_verify_configid
);
193 sub pve_verify_configid
{
194 my ($id, $noerr) = @_;
196 if ($id !~ m/^$CONFIGID_RE$/) {
197 return undef if $noerr;
198 die "invalid configuration ID '$id'\n";
203 PVE
::JSONSchema
::register_format
('pve-storage-id', \
&parse_storage_id
);
204 sub parse_storage_id
{
205 my ($storeid, $noerr) = @_;
207 return parse_id
($storeid, 'storage', $noerr);
210 PVE
::JSONSchema
::register_format
('pve-bridge-id', \
&parse_bridge_id
);
211 sub parse_bridge_id
{
212 my ($id, $noerr) = @_;
214 if ($id !~ m/^[-_.\w\d]+$/) {
215 return undef if $noerr;
216 die "invalid bridge ID '$id'\n";
221 PVE
::JSONSchema
::register_format
('acme-plugin-id', \
&parse_acme_plugin_id
);
222 sub parse_acme_plugin_id
{
223 my ($pluginid, $noerr) = @_;
225 return parse_id
($pluginid, 'ACME plugin', $noerr);
229 my ($id, $type, $noerr) = @_;
231 if ($id !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i) {
232 return undef if $noerr;
233 die "$type ID '$id' contains illegal characters\n";
238 register_format
('pve-vmid', \
&pve_verify_vmid
);
239 sub pve_verify_vmid
{
240 my ($vmid, $noerr) = @_;
242 if ($vmid !~ m/^[1-9][0-9]{2,8}$/) {
243 return undef if $noerr;
244 die "value does not look like a valid VM ID\n";
249 register_format
('pve-node', \
&pve_verify_node_name
);
250 sub pve_verify_node_name
{
251 my ($node, $noerr) = @_;
253 if ($node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/) {
254 return undef if $noerr;
255 die "value does not look like a valid node name\n";
260 # maps source to target ID using an ID map
262 my ($map, $source) = @_;
264 return $source if !defined($map);
266 return $map->{entries
}->{$source}
267 if $map->{entries
} && defined($map->{entries
}->{$source});
269 return $map->{default} if $map->{default};
271 # identity (fallback)
276 my ($idmap, $idformat) = @_;
278 return undef if !$idmap;
282 foreach my $entry (PVE
::Tools
::split_list
($idmap)) {
284 $map->{identity
} = 1;
285 } elsif ($entry =~ m/^([^:]+):([^:]+)$/) {
286 my ($source, $target) = ($1, $2);
288 check_format
($idformat, $source, '');
289 check_format
($idformat, $target, '');
291 die "entry '$entry' contains invalid ID - $@\n" if $@;
293 die "duplicate mapping for source '$source'\n"
294 if exists $map->{entries
}->{$source};
296 $map->{entries
}->{$source} = $target;
299 check_format
($idformat, $entry);
301 die "entry '$entry' contains invalid ID - $@\n" if $@;
303 die "default target ID can only be provided once\n"
304 if exists $map->{default};
306 $map->{default} = $entry;
310 die "identity mapping cannot be combined with other mappings\n"
311 if $map->{identity
} && ($map->{default} || exists $map->{entries
});
316 my $verify_idpair = sub {
317 my ($input, $noerr, $format) = @_;
319 eval { parse_idmap
($input, $format) };
321 return undef if $noerr;
328 PVE
::JSONSchema
::register_standard_option
('pve-targetstorage', {
329 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.",
331 format
=> 'storage-pair-list',
335 # note: this only checks a single list entry
336 # when using a storage-pair-list map, you need to pass the full parameter to
338 register_format
('storage-pair', \
&verify_storagepair
);
339 sub verify_storagepair
{
340 my ($storagepair, $noerr) = @_;
341 return $verify_idpair->($storagepair, $noerr, 'pve-storage-id');
344 # note: this only checks a single list entry
345 # when using a bridge-pair-list map, you need to pass the full parameter to
347 register_format
('bridge-pair', \
&verify_bridgepair
);
348 sub verify_bridgepair
{
349 my ($bridgepair, $noerr) = @_;
350 return $verify_idpair->($bridgepair, $noerr, 'pve-bridge-id');
353 register_format
('mac-addr', \
&pve_verify_mac_addr
);
354 sub pve_verify_mac_addr
{
355 my ($mac_addr, $noerr) = @_;
357 # don't allow I/G bit to be set, most of the time it breaks things, see:
358 # https://pve.proxmox.com/pipermail/pve-devel/2019-March/035998.html
359 if ($mac_addr !~ m/^[a-f0-9][02468ace](?::[a-f0-9]{2}){5}$/i) {
360 return undef if $noerr;
361 die "value does not look like a valid unicast MAC address\n";
366 register_standard_option
('mac-addr', {
368 description
=> 'Unicast MAC address.',
369 verbose_description
=> 'A common MAC address with the I/G (Individual/Group) bit not set.',
370 format_description
=> "XX:XX:XX:XX:XX:XX",
372 format
=> 'mac-addr',
375 register_format
('ipv4', \
&pve_verify_ipv4
);
376 sub pve_verify_ipv4
{
377 my ($ipv4, $noerr) = @_;
379 if ($ipv4 !~ m/^(?:$IPV4RE)$/) {
380 return undef if $noerr;
381 die "value does not look like a valid IPv4 address\n";
386 register_format
('ipv6', \
&pve_verify_ipv6
);
387 sub pve_verify_ipv6
{
388 my ($ipv6, $noerr) = @_;
390 if ($ipv6 !~ m/^(?:$IPV6RE)$/) {
391 return undef if $noerr;
392 die "value does not look like a valid IPv6 address\n";
397 register_format
('ip', \
&pve_verify_ip
);
399 my ($ip, $noerr) = @_;
401 if ($ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/) {
402 return undef if $noerr;
403 die "value does not look like a valid IP address\n";
408 PVE
::JSONSchema
::register_format
('ldap-simple-attr', \
&verify_ldap_simple_attr
);
409 sub verify_ldap_simple_attr
{
410 my ($attr, $noerr) = @_;
412 if ($attr =~ m/^[a-zA-Z0-9]+$/) {
416 die "value '$attr' does not look like a simple ldap attribute name\n" if !$noerr;
421 my $ipv4_mask_hash = {
439 '255.255.128.0' => 17,
440 '255.255.192.0' => 18,
441 '255.255.224.0' => 19,
442 '255.255.240.0' => 20,
443 '255.255.248.0' => 21,
444 '255.255.252.0' => 22,
445 '255.255.254.0' => 23,
446 '255.255.255.0' => 24,
447 '255.255.255.128' => 25,
448 '255.255.255.192' => 26,
449 '255.255.255.224' => 27,
450 '255.255.255.240' => 28,
451 '255.255.255.248' => 29,
452 '255.255.255.252' => 30,
453 '255.255.255.254' => 31,
454 '255.255.255.255' => 32,
457 sub get_netmask_bits
{
459 return $ipv4_mask_hash->{$mask};
462 register_format
('ipv4mask', \
&pve_verify_ipv4mask
);
463 sub pve_verify_ipv4mask
{
464 my ($mask, $noerr) = @_;
466 if (!defined($ipv4_mask_hash->{$mask})) {
467 return undef if $noerr;
468 die "value does not look like a valid IP netmask\n";
473 register_format
('CIDRv6', \
&pve_verify_cidrv6
);
474 sub pve_verify_cidrv6
{
475 my ($cidr, $noerr) = @_;
477 if ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) && ($1 <= 128)) {
481 return undef if $noerr;
482 die "value does not look like a valid IPv6 CIDR network\n";
485 register_format
('CIDRv4', \
&pve_verify_cidrv4
);
486 sub pve_verify_cidrv4
{
487 my ($cidr, $noerr) = @_;
489 if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) && ($1 <= 32)) {
493 return undef if $noerr;
494 die "value does not look like a valid IPv4 CIDR network\n";
497 register_format
('CIDR', \
&pve_verify_cidr
);
498 sub pve_verify_cidr
{
499 my ($cidr, $noerr) = @_;
501 if (!(pve_verify_cidrv4
($cidr, 1) ||
502 pve_verify_cidrv6
($cidr, 1)))
504 return undef if $noerr;
505 die "value does not look like a valid CIDR network\n";
511 register_format
('pve-ipv4-config', \
&pve_verify_ipv4_config
);
512 sub pve_verify_ipv4_config
{
513 my ($config, $noerr) = @_;
515 return $config if $config =~ /^(?:dhcp|manual)$/ ||
516 pve_verify_cidrv4
($config, 1);
517 return undef if $noerr;
518 die "value does not look like a valid ipv4 network configuration\n";
521 register_format
('pve-ipv6-config', \
&pve_verify_ipv6_config
);
522 sub pve_verify_ipv6_config
{
523 my ($config, $noerr) = @_;
525 return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
526 pve_verify_cidrv6
($config, 1);
527 return undef if $noerr;
528 die "value does not look like a valid ipv6 network configuration\n";
531 register_format
('email', \
&pve_verify_email
);
532 sub pve_verify_email
{
533 my ($email, $noerr) = @_;
535 if ($email !~ /^$PVE::Tools::EMAIL_RE$/) {
536 return undef if $noerr;
537 die "value does not look like a valid email address\n";
542 register_format
('email-or-username', \
&pve_verify_email_or_username
);
543 sub pve_verify_email_or_username
{
544 my ($email, $noerr) = @_;
546 if ($email !~ /^$PVE::Tools::EMAIL_RE$/ &&
547 $email !~ /^$PVE::Tools::EMAIL_USER_RE$/) {
548 return undef if $noerr;
549 die "value does not look like a valid email address or user name\n";
554 register_format
('dns-name', \
&pve_verify_dns_name
);
555 sub pve_verify_dns_name
{
556 my ($name, $noerr) = @_;
558 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)";
560 if ($name !~ /^(${namere}\.)*${namere}$/) {
561 return undef if $noerr;
562 die "value does not look like a valid DNS name\n";
567 register_format
('timezone', \
&pve_verify_timezone
);
568 sub pve_verify_timezone
{
569 my ($timezone, $noerr) = @_;
571 return $timezone if $timezone eq 'UTC';
573 open(my $fh, "<", "/usr/share/zoneinfo/zone.tab");
574 while (my $line = <$fh>) {
575 next if $line =~ /^\s*#/;
577 my $zone = (split /\t/, $line)[2];
578 return $timezone if $timezone eq $zone; # found
582 return undef if $noerr;
583 die "invalid time zone '$timezone'\n";
586 # network interface name
587 register_format
('pve-iface', \
&pve_verify_iface
);
588 sub pve_verify_iface
{
589 my ($id, $noerr) = @_;
591 if ($id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i) {
592 return undef if $noerr;
593 die "invalid network interface name '$id'\n";
598 # general addresses by name or IP
599 register_format
('address', \
&pve_verify_address
);
600 sub pve_verify_address
{
601 my ($addr, $noerr) = @_;
603 if (!(pve_verify_ip
($addr, 1) ||
604 pve_verify_dns_name
($addr, 1)))
606 return undef if $noerr;
607 die "value does not look like a valid address: $addr\n";
612 register_format
('disk-size', \
&pve_verify_disk_size
);
613 sub pve_verify_disk_size
{
614 my ($size, $noerr) = @_;
615 if (!defined(parse_size
($size))) {
616 return undef if $noerr;
617 die "value does not look like a valid disk size: $size\n";
622 register_standard_option
('spice-proxy', {
623 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).",
624 type
=> 'string', format
=> 'address',
627 register_standard_option
('remote-viewer-config', {
628 description
=> "Returned values can be directly passed to the 'remote-viewer' application.",
629 additionalProperties
=> 1,
631 type
=> { type
=> 'string' },
632 password
=> { type
=> 'string' },
633 proxy
=> { type
=> 'string' },
634 host
=> { type
=> 'string' },
635 'tls-port' => { type
=> 'integer' },
639 register_format
('pve-startup-order', \
&pve_verify_startup_order
);
640 sub pve_verify_startup_order
{
641 my ($value, $noerr) = @_;
643 return $value if pve_parse_startup_order
($value);
645 return undef if $noerr;
647 die "unable to parse startup options\n";
652 type
=> 'number', minimum
=> '0',
653 format_description
=> 'LIMIT',
656 my $bwlimit_format = {
659 description
=> 'default bandwidth limit in KiB/s',
663 description
=> 'bandwidth limit in KiB/s for restoring guests from backups',
667 description
=> 'bandwidth limit in KiB/s for migrating guests (including moving local disks)',
671 description
=> 'bandwidth limit in KiB/s for cloning disks',
675 description
=> 'bandwidth limit in KiB/s for moving disks',
678 register_format
('bwlimit', $bwlimit_format);
679 register_standard_option
('bwlimit', {
680 description
=> "Set I/O bandwidth limit for various operations (in KiB/s).",
683 format
=> $bwlimit_format,
686 my $remote_format = {
689 description
=> 'Remote Proxmox hostname or IP',
690 format_description
=> 'ADDRESS',
695 description
=> 'Port to connect to',
696 format_description
=> 'PORT',
700 description
=> 'A full Proxmox API token including the secret value.',
701 format_description
=> 'PVEAPIToken=user@realm!token=SECRET',
703 fingerprint
=> get_standard_option
(
704 'fingerprint-sha256',
707 description
=> 'Remote host\'s certificate fingerprint, if not trusted by system store.',
708 format_description
=> 'FINGERPRINT',
712 register_format
('proxmox-remote', $remote_format);
713 register_standard_option
('proxmox-remote', {
714 description
=> "Specification of a remote endpoint.",
715 type
=> 'string', format
=> 'proxmox-remote',
718 our $PVE_TAG_RE = qr/[a-z0-9_][a-z0-9_\-\+\.]*/i;
720 # used for pve-tag-list in e.g., guest configs
721 register_format
('pve-tag', \
&pve_verify_tag
);
723 my ($value, $noerr) = @_;
725 return $value if $value =~ m/^${PVE_TAG_RE}$/i;
727 return undef if $noerr;
729 die "invalid characters in tag\n";
732 sub pve_parse_startup_order
{
735 return undef if !$value;
739 foreach my $p (split(/,/, $value)) {
740 next if $p =~ m/^\s*$/;
742 if ($p =~ m/^(order=)?(\d+)$/) {
744 } elsif ($p =~ m/^up=(\d+)$/) {
746 } elsif ($p =~ m/^down=(\d+)$/) {
756 PVE
::JSONSchema
::register_standard_option
('pve-startup-order', {
757 description
=> "Startup and shutdown behavior. Order is a non-negative number defining the general startup order. Shutdown in done with reverse ordering. Additionally you can set the 'up' or 'down' delay in seconds, which specifies a delay to wait before the next VM is started or stopped.",
759 type
=> 'string', format
=> 'pve-startup-order',
760 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
763 register_format
('pve-tfa-secret', \
&pve_verify_tfa_secret
);
764 sub pve_verify_tfa_secret
{
765 my ($key, $noerr) = @_;
767 # The old format used 16 base32 chars or 40 hex digits. Since they have a common subset it's
768 # hard to distinguish them without the our previous length constraints, so add a 'v2' of the
769 # format to support arbitrary lengths properly:
770 if ($key =~ /^v2-0x[0-9a-fA-F]{16,128}$/ || # hex
771 $key =~ /^v2-[A-Z2-7=]{16,128}$/ || # base32
772 $key =~ /^(?:[A-Z2-7=]{16}|[A-Fa-f0-9]{40})$/) # and the old pattern copy&pasted
777 return undef if $noerr;
779 die "unable to decode TFA secret\n";
783 PVE
::JSONSchema
::register_format
('pve-task-status-type', \
&verify_task_status_type
);
784 sub verify_task_status_type
{
785 my ($value, $noerr) = @_;
787 return $value if $value =~ m/^(ok|error|warning|unknown)$/i;
789 return undef if $noerr;
791 die "invalid status '$value'\n";
795 my ($format, $value, $path) = @_;
797 if (ref($format) eq 'HASH') {
798 # hash ref cannot have validator/list/opt handling attached
799 return parse_property_string
($format, $value, $path);
802 if (ref($format) eq 'CODE') {
803 # we are the (sole, old-style) validator
804 return $format->($value);
807 return if $format eq 'regex';
810 $format =~ m/^(.*?)(?:-(list|opt))?$/;
811 my ($format_name, $format_type) = ($1, $2 // 'none');
812 my $registered = get_format
($format_name);
813 die "undefined format '$format'\n" if !$registered;
815 die "'-$format_type' format must have code ref, not hash\n"
816 if $format_type ne 'none' && ref($registered) ne 'CODE';
818 if ($format_type eq 'list') {
820 # Note: we allow empty lists
821 foreach my $v (split_list
($value)) {
822 push @{$parsed}, $registered->($v);
824 } elsif ($format_type eq 'opt') {
825 $parsed = $registered->($value) if $value;
827 if (ref($registered) eq 'HASH') {
828 # Note: this is the only case where a validator function could be
829 # attached, hence it's safe to handle that in parse_property_string.
830 # We do however have to call it with $format_name instead of
831 # $registered, so it knows about the name (and thus any validators).
832 $parsed = parse_property_string
($format, $value, $path);
834 $parsed = $registered->($value);
844 return undef if $value !~ m/^(\d+(\.\d+)?)([KMGT])?$/;
845 my ($size, $unit) = ($1, $3);
848 $size = $size * 1024;
849 } elsif ($unit eq 'M') {
850 $size = $size * 1024 * 1024;
851 } elsif ($unit eq 'G') {
852 $size = $size * 1024 * 1024 * 1024;
853 } elsif ($unit eq 'T') {
854 $size = $size * 1024 * 1024 * 1024 * 1024;
865 my $kb = int($size/1024);
866 return $size if $kb*1024 != $size;
868 my $mb = int($kb/1024);
869 return "${kb}K" if $mb*1024 != $kb;
871 my $gb = int($mb/1024);
872 return "${mb}M" if $gb*1024 != $mb;
874 my $tb = int($gb/1024);
875 return "${gb}G" if $tb*1024 != $gb;
882 return 1 if $bool =~ m/^(1|on|yes|true)$/i;
883 return 0 if $bool =~ m/^(0|off|no|false)$/i;
887 sub parse_property_string
{
888 my ($format, $data, $path, $additional_properties) = @_;
890 # In property strings we default to not allowing additional properties
891 $additional_properties = 0 if !defined($additional_properties);
893 # Support named formats here, too:
896 if (my $reg = get_format
($format)) {
897 die "parse_property_string only accepts hash based named formats\n"
898 if ref($reg) ne 'HASH';
900 # named formats can have validators attached
901 $validator = $format_validators->{$format};
905 die "unknown format: $format\n";
907 } elsif (ref($format) ne 'HASH') {
908 die "unexpected format value of type ".ref($format)."\n";
914 foreach my $part (split(/,/, $data)) {
915 next if $part =~ /^\s*$/;
917 if ($part =~ /^([^=]+)=(.+)$/) {
918 my ($k, $v) = ($1, $2);
919 die "duplicate key in comma-separated list property: $k\n" if defined($res->{$k});
920 my $schema = $format->{$k};
921 if (my $alias = $schema->{alias
}) {
922 if (my $key_alias = $schema->{keyAlias
}) {
923 die "key alias '$key_alias' is already defined\n" if defined($res->{$key_alias});
924 $res->{$key_alias} = $k;
927 $schema = $format->{$k};
930 die "invalid key in comma-separated list property: $k\n" if !$schema;
931 if ($schema->{type
} && $schema->{type
} eq 'boolean') {
932 $v = parse_boolean
($v) // $v;
935 } elsif ($part !~ /=/) {
936 die "duplicate key in comma-separated list property: $default_key\n" if $default_key;
937 foreach my $key (keys %$format) {
938 if ($format->{$key}->{default_key
}) {
940 if (!$res->{$default_key}) {
941 $res->{$default_key} = $part;
944 die "duplicate key in comma-separated list property: $default_key\n";
947 die "value without key, but schema does not define a default key\n" if !$default_key;
949 die "missing key in comma-separated list property\n";
954 check_object
($path, $format, $res, $additional_properties, $errors);
955 if (scalar(%$errors)) {
956 raise
"format error\n", errors
=> $errors;
959 return $validator->($res) if $validator;
964 my ($errors, $path, $msg) = @_;
966 $path = '_root' if !$path;
968 if ($errors->{$path}) {
969 $errors->{$path} = join ('\n', $errors->{$path}, $msg);
971 $errors->{$path} = $msg;
978 # see 'man perlretut'
979 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
985 return $value =~ m/^[+-]?\d+$/;
989 my ($path, $type, $value, $errors) = @_;
993 if (!defined($value)) {
994 return 1 if $type eq 'null';
998 if (my $tt = ref($type)) {
999 if ($tt eq 'ARRAY') {
1000 foreach my $t (@$type) {
1002 check_type
($path, $t, $value, $tmperr);
1003 return 1 if !scalar(%$tmperr);
1005 my $ttext = join ('|', @$type);
1006 add_error
($errors, $path, "type check ('$ttext') failed");
1008 } elsif ($tt eq 'HASH') {
1010 check_prop
($value, $type, $path, $tmperr);
1011 return 1 if !scalar(%$tmperr);
1012 add_error
($errors, $path, "type check failed");
1015 die "internal error - got reference type '$tt'";
1020 return 1 if $type eq 'any';
1022 if ($type eq 'null') {
1023 if (defined($value)) {
1024 add_error
($errors, $path, "type check ('$type') failed - value is not null");
1030 my $vt = ref($value);
1032 if ($type eq 'array') {
1033 if (!$vt || $vt ne 'ARRAY') {
1034 add_error
($errors, $path, "type check ('$type') failed");
1038 } elsif ($type eq 'object') {
1039 if (!$vt || $vt ne 'HASH') {
1040 add_error
($errors, $path, "type check ('$type') failed");
1044 } elsif ($type eq 'coderef') {
1045 if (!$vt || $vt ne 'CODE') {
1046 add_error
($errors, $path, "type check ('$type') failed");
1050 } elsif ($type eq 'string' && $vt eq 'Regexp') {
1051 # qr// regexes can be used as strings and make sense for format=regex
1055 if ($type eq 'boolean' && JSON
::is_bool
($value)) {
1058 add_error
($errors, $path, "type check ('$type') failed - got $vt");
1061 if ($type eq 'string') {
1062 return 1; # nothing to check ?
1063 } elsif ($type eq 'boolean') {
1064 #if ($value =~ m/^(1|true|yes|on)$/i) {
1065 if ($value eq '1') {
1067 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
1068 } elsif ($value eq '0') {
1069 return 1; # return success (not value)
1071 add_error
($errors, $path, "type check ('$type') failed - got '$value'");
1074 } elsif ($type eq 'integer') {
1075 if (!is_integer
($value)) {
1076 add_error
($errors, $path, "type check ('$type') failed - got '$value'");
1080 } elsif ($type eq 'number') {
1081 if (!is_number
($value)) {
1082 add_error
($errors, $path, "type check ('$type') failed - got '$value'");
1087 return 1; # no need to verify unknown types
1096 my sub get_instance_type
{
1097 my ($schema, $key, $value) = @_;
1099 if (my $type_property = $schema->{$key}->{'type-property'}) {
1100 return $value->{$type_property};
1107 my ($path, $schema, $value, $additional_properties, $errors) = @_;
1109 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
1111 my $st = ref($schema);
1112 if (!$st || $st ne 'HASH') {
1113 add_error
($errors, $path, "Invalid schema definition.");
1117 my $vt = ref($value);
1118 if (!$vt || $vt ne 'HASH') {
1119 add_error
($errors, $path, "an object is required");
1123 foreach my $k (keys %$schema) {
1124 my $instance_type = get_instance_type
($schema, $k, $value);
1125 check_prop
($value->{$k}, $schema->{$k}, $path ?
"$path.$k" : $k, $errors, $instance_type);
1128 foreach my $k (keys %$value) {
1130 my $newpath = $path ?
"$path.$k" : $k;
1132 if (my $subschema = $schema->{$k}) {
1133 if (my $requires = $subschema->{requires
}) {
1134 if (ref($requires)) {
1135 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
1136 check_prop
($value, $requires, $path, $errors);
1137 } elsif (!defined($value->{$requires})) {
1138 add_error
($errors, $path ?
"$path.$requires" : $requires,
1139 "missing property - '$newpath' requires this property");
1143 # if it's a oneOf, check if there is a matching type
1144 my $matched_type = 1;
1145 if ($subschema->{oneOf
}) {
1146 my $instance_type = get_instance_type
($schema, $k, $value);
1148 for my $alternative ($subschema->{oneOf
}->@*) {
1149 if (my $instance_types = $alternative->{'instance-types'}) {
1150 if (!grep { $instance_type eq $_ } $instance_types->@*) {
1159 next if $matched_type; # value is already checked above
1162 if (defined ($additional_properties) && !$additional_properties) {
1163 add_error
($errors, $newpath, "property is not defined in schema " .
1164 "and the schema does not allow additional properties");
1167 check_prop
($value->{$k}, $additional_properties, $newpath, $errors)
1168 if ref($additional_properties);
1172 sub check_object_warn
{
1173 my ($path, $schema, $value, $additional_properties) = @_;
1175 check_object
($path, $schema, $value, $additional_properties, $errors);
1176 if (scalar(%$errors)) {
1177 foreach my $k (keys %$errors) {
1178 warn "parse error: $k: $errors->{$k}\n";
1186 my ($value, $schema, $path, $errors, $instance_type) = @_;
1188 die "internal error - no schema" if !$schema;
1189 die "internal error" if !$errors;
1191 #print "check_prop $path\n" if $value;
1193 my $st = ref($schema);
1194 if (!$st || $st ne 'HASH') {
1195 add_error
($errors, $path, "Invalid schema definition.");
1199 # must pass any of the given schemas
1200 my $optional_for_type = 0;
1201 if ($schema->{oneOf
}) {
1202 # in case we have an instance_type given, just check for that variant
1203 if ($schema->{'type-property'}) {
1204 $optional_for_type = 1;
1205 for (my $i = 0; $i < scalar($schema->{oneOf
}->@*); $i++) {
1206 last if !$instance_type; # treat as optional if we don't have a type
1207 my $inner_schema = $schema->{oneOf
}->[$i];
1209 if (!defined($inner_schema->{'instance-types'})) {
1210 add_error
($errors, $path, "missing 'instance-types' in oneOf alternative");
1214 next if !grep { $_ eq $instance_type } $inner_schema->{'instance-types'}->@*;
1215 $optional_for_type = $inner_schema->{optional
} // 0;
1216 check_prop
($value, $inner_schema, $path, $errors);
1220 my $collected_errors = {};
1221 for (my $i = 0; $i < scalar($schema->{oneOf
}->@*); $i++) {
1222 my $inner_schema = $schema->{oneOf
}->[$i];
1223 my $inner_errors = {};
1224 check_prop
($value, $inner_schema, "$path.oneOf[$i]", $inner_errors);
1225 if (!$inner_errors->%*) {
1230 for my $inner_path (keys $inner_errors->%*) {
1231 add_error
($collected_errors, $inner_path, $inner_errors->{$path});
1236 for my $inner_path (keys $collected_errors->%*) {
1237 add_error
($errors, $inner_path, $collected_errors->{$path});
1241 } elsif ($instance_type) {
1242 if (!defined($schema->{'instance-types'})) {
1243 add_error
($errors, $path, "missing 'instance-types'");
1246 if (grep { $_ eq $instance_type} $schema->{'instance_types'}->@*) {
1247 $optional_for_type = 1;
1251 # if it extends another schema, it must pass that schema as well
1252 if($schema->{extends
}) {
1253 check_prop
($value, $schema->{extends
}, $path, $errors);
1256 if (!defined ($value)) {
1257 return if $schema->{type
} && $schema->{type
} eq 'null';
1258 if (!$schema->{optional
} && !$schema->{alias
} && !$schema->{group
} && !$optional_for_type) {
1259 add_error
($errors, $path, "property is missing and it is not optional");
1264 return if !check_type
($path, $schema->{type
}, $value, $errors);
1266 if ($schema->{disallow
}) {
1268 if (check_type
($path, $schema->{disallow
}, $value, $tmperr)) {
1269 add_error
($errors, $path, "disallowed value was matched");
1274 if (my $vt = ref($value)) {
1276 if ($vt eq 'ARRAY') {
1277 if ($schema->{items
}) {
1278 my $it = ref($schema->{items
});
1279 if ($it && $it eq 'ARRAY') {
1280 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
1281 die "not implemented";
1284 foreach my $el (@$value) {
1285 check_prop
($el, $schema->{items
}, "${path}[$ind]", $errors);
1291 } elsif ($schema->{properties
} || $schema->{additionalProperties
}) {
1292 check_object
($path, defined($schema->{properties
}) ?
$schema->{properties
} : {},
1293 $value, $schema->{additionalProperties
}, $errors);
1299 if (my $format = $schema->{format
}) {
1300 eval { check_format
($format, $value, $path); };
1302 add_error
($errors, $path, "invalid format - $@");
1307 if (my $pattern = $schema->{pattern
}) {
1308 if ($value !~ m/^$pattern$/) {
1309 add_error
($errors, $path, "value does not match the regex pattern");
1314 if (defined (my $max = $schema->{maxLength
})) {
1315 if (length($value) > $max) {
1316 add_error
($errors, $path, "value may only be $max characters long");
1321 if (defined (my $min = $schema->{minLength
})) {
1322 if (length($value) < $min) {
1323 add_error
($errors, $path, "value must be at least $min characters long");
1328 if (is_number
($value)) {
1329 if (defined (my $max = $schema->{maximum
})) {
1330 if ($value > $max) {
1331 add_error
($errors, $path, "value must have a maximum value of $max");
1336 if (defined (my $min = $schema->{minimum
})) {
1337 if ($value < $min) {
1338 add_error
($errors, $path, "value must have a minimum value of $min");
1344 if (my $ea = $schema->{enum
}) {
1347 foreach my $ev (@$ea) {
1348 if ($ev eq $value) {
1354 add_error
($errors, $path, "value '$value' does not have a value in the enumeration '" .
1355 join(", ", @$ea) . "'");
1362 my ($instance, $schema, $errmsg) = @_;
1365 $errmsg = "Parameter verification failed.\n" if !$errmsg;
1367 # todo: cycle detection is only needed for debugging, I guess
1368 # we can disable that in the final release
1369 # todo: is there a better/faster way to detect cycles?
1371 # 'download' responses can contain a filehandle, don't cycle-check that as
1372 # it produces a warning
1373 my $is_download = ref($instance) eq 'HASH' && exists($instance->{download
});
1374 find_cycle
($instance, sub { $cycles = 1 }) if !$is_download;
1376 add_error
($errors, undef, "data structure contains recursive cycles");
1378 check_prop
($instance, $schema, '', $errors);
1381 if (scalar(%$errors)) {
1382 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors;
1388 my $schema_valid_types = ["string", "object", "coderef", "array", "boolean", "number", "integer", "null", "any"];
1389 my $default_schema_noref = {
1390 description
=> "This is the JSON Schema for JSON Schemas.",
1391 type
=> [ "object" ],
1392 additionalProperties
=> 0,
1395 type
=> ["string", "array"],
1396 description
=> "This is a type definition value. This can be a simple type, or a union type",
1401 enum
=> $schema_valid_types,
1403 enum
=> $schema_valid_types,
1407 description
=> "This represents the alternative options for this Schema instance.",
1411 description
=> "A valid option of the properties",
1414 'instance-types' => {
1416 description
=> "Indicate to which type the parameter (or variant if inside a oneOf) belongs.",
1422 'type-property' => {
1424 description
=> "The property to check for instance types.",
1429 description
=> "This indicates that the instance property in the instance object is not required.",
1435 description
=> "This is a definition for the properties of an object value",
1441 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array",
1445 additionalProperties
=> {
1446 type
=> [ "boolean", "object"],
1447 description
=> "This provides a default property definition for all properties that are not explicitly defined in an object type definition.",
1454 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number.",
1459 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number.",
1463 description
=> "When the instance value is a string, this indicates minimum length of the string",
1470 description
=> "When the instance value is a string, this indicates maximum length of the string.",
1476 description
=> "A text representation of the type (used to generate documentation).",
1481 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.",
1488 description
=> "This provides an enumeration of possible values that are valid for the instance property.",
1493 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).",
1495 verbose_description
=> {
1498 description
=> "This provides a more verbose description.",
1500 format_description
=> {
1503 description
=> "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings.",
1508 description
=> "This provides the title of the property",
1513 description
=> "This is used to provide rendering hints to format cli command output.",
1516 type
=> [ "string", "object" ],
1518 description
=> "indicates a required property or a schema that must be validated if this property is present",
1521 type
=> [ "string", "object" ],
1523 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",
1528 description
=> "Whether this is the default key in a comma separated list property string.",
1533 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.",
1538 description
=> "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'.",
1539 requires
=> 'alias',
1544 description
=> "This indicates the default for the instance property."
1548 description
=> "Bash completion function. This function should return a list of possible values.",
1554 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.",
1559 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
1562 # this is from hyper schema
1565 description
=> "This defines the link relations of the instance objects",
1572 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",
1576 description
=> "This is the name of the link relation",
1582 description
=> "For submission links, this defines the method that should be used to access the target resource",
1591 description
=> "For CLI context, this defines the maximal width to print before truncating",
1597 my $default_schema = Storable
::dclone
($default_schema_noref);
1599 $default_schema->{properties
}->{properties
}->{additionalProperties
} = $default_schema;
1600 $default_schema->{properties
}->{additionalProperties
}->{properties
} = $default_schema->{properties
};
1601 $default_schema->{properties
}->{oneOf
}->{items
}->{properties
} = $default_schema->{properties
};
1603 $default_schema->{properties
}->{items
}->{properties
} = $default_schema->{properties
};
1604 $default_schema->{properties
}->{items
}->{additionalProperties
} = 0;
1606 $default_schema->{properties
}->{disallow
}->{properties
} = $default_schema->{properties
};
1607 $default_schema->{properties
}->{disallow
}->{additionalProperties
} = 0;
1609 $default_schema->{properties
}->{requires
}->{properties
} = $default_schema->{properties
};
1610 $default_schema->{properties
}->{requires
}->{additionalProperties
} = 0;
1612 $default_schema->{properties
}->{extends
}->{properties
} = $default_schema->{properties
};
1613 $default_schema->{properties
}->{extends
}->{additionalProperties
} = 0;
1615 my $method_schema = {
1617 additionalProperties
=> 0,
1620 description
=> "This a description of the method",
1625 description
=> "This indicates the name of the function to call.",
1628 additionalProperties
=> 1,
1643 description
=> "The HTTP method name.",
1644 enum
=> [ 'GET', 'POST', 'PUT', 'DELETE' ],
1649 description
=> "Method needs special privileges - only pvedaemon can execute it",
1654 description
=> "Method is available for clients authenticated using an API token.",
1660 description
=> "Method downloads the file content (filename is the return value of the method).",
1665 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
1668 proxyto_callback
=> {
1670 description
=> "A function which is called to resolve the proxyto attribute. The default implementation returns the value of the 'proxyto' parameter.",
1675 description
=> "Required access permissions. By default only 'root' is allowed to access this method.",
1677 additionalProperties
=> 0,
1680 description
=> "Describe access permissions.",
1684 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
1686 enum
=> ['all', 'world'],
1690 description
=> "Array of permission checks (prefix notation).",
1697 description
=> "Used internally",
1701 description
=> "Used internally",
1706 description
=> "path for URL matching (uri template)",
1708 fragmentDelimiter
=> {
1710 description
=> "A way to override the default fragment delimiter '/'. This only works on a whole sub-class. You can set this to the empty string to match the whole rest of the URI.",
1715 description
=> "JSON Schema for parameters.",
1720 description
=> "JSON Schema for return value.",
1725 description
=> "method implementation (code reference)",
1730 description
=> "Delegate call to this class (perl class string).",
1733 additionalProperties
=> 0,
1739 fragmentDelimiter
=> { optional
=> 1 }
1747 sub validate_schema
{
1750 my $errmsg = "internal error - unable to verify schema\n";
1751 validate
($schema, $default_schema, $errmsg);
1754 sub validate_method_info
{
1757 my $errmsg = "internal error - unable to verify method info\n";
1758 validate
($info, $method_schema, $errmsg);
1760 validate_schema
($info->{parameters
}) if $info->{parameters
};
1761 validate_schema
($info->{returns
}) if $info->{returns
};
1764 # run a self test on load
1765 # make sure we can verify the default schema
1766 validate_schema
($default_schema_noref);
1767 validate_schema
($method_schema);
1769 # and now some utility methods (used by pve api)
1770 sub method_get_child_link
{
1773 return undef if !$info;
1775 my $schema = $info->{returns
};
1776 return undef if !$schema || !$schema->{type
} || $schema->{type
} ne 'array';
1778 my $links = $schema->{links
};
1779 return undef if !$links;
1782 foreach my $lnk (@$links) {
1783 if ($lnk->{href
} && $lnk->{rel
} && ($lnk->{rel
} eq 'child')) {
1792 # a way to parse command line parameters, using a
1793 # schema to configure Getopt::Long
1795 my ($schema, $args, $arg_param, $fixed_param, $param_mapping_hash) = @_;
1797 if (!$schema || !$schema->{properties
}) {
1798 raise
("too many arguments\n", code
=> HTTP_BAD_REQUEST
)
1799 if scalar(@$args) != 0;
1804 if ($arg_param && !ref($arg_param)) {
1805 my $pd = $schema->{properties
}->{$arg_param};
1806 die "expected list format $pd->{format}"
1807 if !($pd && $pd->{format
} && $pd->{format
} =~ m/-list/);
1808 $list_param = $arg_param;
1811 my @interactive = ();
1813 foreach my $prop (keys %{$schema->{properties
}}) {
1814 my $pd = $schema->{properties
}->{$prop};
1815 next if $list_param && $prop eq $list_param;
1816 next if defined($fixed_param->{$prop});
1818 my $mapping = $param_mapping_hash->{$prop};
1819 if ($mapping && $mapping->{interactive
}) {
1820 # interactive parameters such as passwords: make the argument
1821 # optional and call the mapping function afterwards.
1822 push @getopt, "$prop:s";
1823 push @interactive, [$prop, $mapping->{func
}];
1824 } elsif ($pd->{type
} && $pd->{type
} eq 'boolean') {
1825 push @getopt, "$prop:s";
1827 if ($pd->{format
} && $pd->{format
} =~ m/-list/) {
1828 push @getopt, "$prop=s@";
1829 } elsif ($pd->{type
} && $pd->{type
} eq 'array') {
1830 push @getopt, "$prop=s@";
1832 push @getopt, "$prop=s";
1837 Getopt
::Long
::Configure
('prefix_pattern=(--|-)');
1840 raise
("unable to parse option\n", code
=> HTTP_BAD_REQUEST
)
1841 if !Getopt
::Long
::GetOptionsFromArray
($args, $opts, @getopt);
1845 $opts->{$list_param} = $args;
1847 } elsif (ref($arg_param)) {
1848 for (my $i = 0; $i < scalar(@$arg_param); $i++) {
1849 my $arg_name = $arg_param->[$i];
1850 if ($opts->{'extra-args'}) {
1851 raise
("internal error: extra-args must be the last argument\n", code
=> HTTP_BAD_REQUEST
);
1853 if ($arg_name eq 'extra-args') {
1854 $opts->{'extra-args'} = $args;
1859 # check if all left-over arg_param are optional, else we
1860 # must die as the mapping is then ambigious
1861 for (; $i < scalar(@$arg_param); $i++) {
1862 my $prop = $arg_param->[$i];
1863 raise
("not enough arguments\n", code
=> HTTP_BAD_REQUEST
)
1864 if !$schema->{properties
}->{$prop}->{optional
};
1866 if ($arg_param->[-1] eq 'extra-args') {
1867 $opts->{'extra-args'} = [];
1871 $opts->{$arg_name} = shift @$args;
1873 raise
("too many arguments\n", code
=> HTTP_BAD_REQUEST
) if @$args;
1875 raise
("too many arguments\n", code
=> HTTP_BAD_REQUEST
)
1876 if scalar(@$args) != 0;
1879 if (ref($arg_param)) {
1880 foreach my $arg_name (@$arg_param) {
1881 if ($arg_name eq 'extra-args') {
1882 $opts->{'extra-args'} = [];
1883 } elsif (!$schema->{properties
}->{$arg_name}->{optional
}) {
1884 raise
("not enough arguments\n", code
=> HTTP_BAD_REQUEST
);
1890 foreach my $entry (@interactive) {
1891 my ($opt, $func) = @$entry;
1892 my $pd = $schema->{properties
}->{$opt};
1893 my $value = $opts->{$opt};
1894 if (defined($value) || !$pd->{optional
}) {
1895 $opts->{$opt} = $func->($value);
1899 # decode after Getopt as we are not sure how well it handles unicode
1900 foreach my $p (keys %$opts) {
1901 if (!ref($opts->{$p})) {
1902 $opts->{$p} = decode
('locale', $opts->{$p});
1903 } elsif (ref($opts->{$p}) eq 'ARRAY') {
1905 foreach my $v (@{$opts->{$p}}) {
1906 push @$tmp, decode
('locale', $v);
1909 } elsif (ref($opts->{$p}) eq 'SCALAR') {
1910 $opts->{$p} = decode
('locale', $$opts->{$p});
1912 raise
("decoding options failed, unknown reference\n", code
=> HTTP_BAD_REQUEST
);
1916 foreach my $p (keys %$opts) {
1917 if (my $pd = $schema->{properties
}->{$p}) {
1918 if ($pd->{type
} && $pd->{type
} eq 'boolean') {
1919 if ($opts->{$p} eq '') {
1921 } elsif (defined(my $bool = parse_boolean
($opts->{$p}))) {
1922 $opts->{$p} = $bool;
1924 raise
("unable to parse boolean option\n", code
=> HTTP_BAD_REQUEST
);
1926 } elsif ($pd->{format
}) {
1928 if ($pd->{format
} =~ m/-list/) {
1929 # allow --vmid 100 --vmid 101 and --vmid 100,101
1930 # allow --dow mon --dow fri and --dow mon,fri
1931 $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
1937 foreach my $p (keys %$fixed_param) {
1938 $opts->{$p} = $fixed_param->{$p};
1944 # A way to parse configuration data by giving a json schema
1945 sub parse_config
: prototype($$$;$) {
1946 my ($schema, $filename, $raw, $comment_key) = @_;
1948 # do fast check (avoid validate_schema($schema))
1949 die "got strange schema" if !$schema->{type
} ||
1950 !$schema->{properties
} || $schema->{type
} ne 'object';
1955 my $handle_comment = sub { $_[0] =~ /^#/ };
1956 if (defined($comment_key)) {
1958 my $comment_re = qr/^\Q$comment_key\E:\s*(.*\S)\s*$/;
1959 $handle_comment = sub {
1960 if ($_[0] =~ /^\#(.*)\s*$/ || $_[0] =~ $comment_re) {
1961 $comment_data .= PVE
::Tools
::decode_text
($1) . "\n";
1968 while ($raw =~ /^\s*(.+?)\s*$/gm) {
1971 next if $handle_comment->($line);
1973 if ($line =~ m/^(\S+?):\s*(.*)$/) {
1976 if ($schema->{properties
}->{$key} &&
1977 $schema->{properties
}->{$key}->{type
} eq 'boolean') {
1979 $value = parse_boolean
($value) // $value;
1982 $schema->{properties
}->{$key}
1983 && $schema->{properties
}->{$key}->{type
} eq 'array'
1986 $cfg->{$key} //= [];
1987 push $cfg->{$key}->@*, $value;
1990 $cfg->{$key} = $value;
1992 warn "ignore config line: $line\n"
1996 if (defined($comment_data)) {
1997 $cfg->{$comment_key} = $comment_data;
2001 check_prop
($cfg, $schema, '', $errors);
2003 foreach my $k (keys %$errors) {
2004 warn "parse error in '$filename' - '$k': $errors->{$k}\n";
2011 # generate simple key/value file
2013 my ($schema, $filename, $cfg) = @_;
2015 # do fast check (avoid validate_schema($schema))
2016 die "got strange schema" if !$schema->{type
} ||
2017 !$schema->{properties
} || $schema->{type
} ne 'object';
2019 validate
($cfg, $schema, "validation error in '$filename'\n");
2023 foreach my $k (sort keys %$cfg) {
2024 $data .= "$k: $cfg->{$k}\n";
2030 # helpers used to generate our manual pages
2032 my $find_schema_default_key = sub {
2036 my $keyAliasProps = {};
2038 foreach my $key (keys %$format) {
2039 my $phash = $format->{$key};
2040 if ($phash->{default_key
}) {
2041 die "multiple default keys in schema ($default_key, $key)\n"
2042 if defined($default_key);
2043 die "default key '$key' is an alias - this is not allowed\n"
2044 if defined($phash->{alias
});
2045 die "default key '$key' with keyAlias attribute is not allowed\n"
2046 if $phash->{keyAlias
};
2047 $default_key = $key;
2049 my $key_alias = $phash->{keyAlias
};
2050 die "found keyAlias without 'alias definition for '$key'\n"
2051 if $key_alias && !$phash->{alias
};
2053 if ($phash->{alias
} && $key_alias) {
2054 die "inconsistent keyAlias '$key_alias' definition"
2055 if defined($keyAliasProps->{$key_alias}) &&
2056 $keyAliasProps->{$key_alias} ne $phash->{alias
};
2057 $keyAliasProps->{$key_alias} = $phash->{alias
};
2061 return wantarray ?
($default_key, $keyAliasProps) : $default_key;
2064 sub generate_typetext
{
2065 my ($format, $list_enums) = @_;
2067 my ($default_key, $keyAliasProps) = &$find_schema_default_key($format);
2072 my $add_option_string = sub {
2073 my ($text, $optional) = @_;
2079 $text = "[$text]" if $optional;
2084 my $format_key_value = sub {
2085 my ($key, $phash) = @_;
2087 die "internal error" if defined($phash->{alias
});
2093 if (my $desc = $phash->{format_description
}) {
2094 $typetext .= "<$desc>";
2095 } elsif (my $text = $phash->{typetext
}) {
2097 } elsif (my $enum = $phash->{enum
}) {
2098 if ($list_enums || (scalar(@$enum) <= 3)) {
2099 $typetext .= '<' . join('|', @$enum) . '>';
2101 $typetext .= '<enum>';
2103 } elsif ($phash->{type
} eq 'boolean') {
2104 $typetext .= '<1|0>';
2105 } elsif ($phash->{type
} eq 'integer') {
2106 $typetext .= '<integer>';
2107 } elsif ($phash->{type
} eq 'number') {
2108 $typetext .= '<number>';
2110 die "internal error: neither format_description nor typetext found for option '$key'";
2113 if (defined($default_key) && ($default_key eq $key)) {
2114 &$add_option_string("[$keytext=]$typetext", $phash->{optional
});
2116 &$add_option_string("$keytext=$typetext", $phash->{optional
});
2122 my $cond_add_key = sub {
2125 return if $done->{$key}; # avoid duplicates
2129 my $phash = $format->{$key};
2131 return if !$phash; # should not happen
2133 return if $phash->{alias
};
2135 &$format_key_value($key, $phash);
2139 &$cond_add_key($default_key) if defined($default_key);
2141 # add required keys first
2142 foreach my $key (sort keys %$format) {
2143 my $phash = $format->{$key};
2144 &$cond_add_key($key) if $phash && !$phash->{optional
};
2148 foreach my $key (sort keys %$format) {
2149 &$cond_add_key($key);
2152 foreach my $keyAlias (sort keys %$keyAliasProps) {
2153 &$add_option_string("<$keyAlias>=<$keyAliasProps->{$keyAlias }>", 1);
2159 sub print_property_string
{
2160 my ($data, $format, $skip, $path) = @_;
2163 if (ref($format) ne 'HASH') {
2164 my $schema = get_format
($format);
2165 die "not a valid format: $format\n" if !$schema;
2166 # named formats can have validators attached
2167 $validator = $format_validators->{$format};
2172 check_object
($path, $format, $data, undef, $errors);
2173 if (scalar(%$errors)) {
2174 raise
"format error", errors
=> $errors;
2177 $data = $validator->($data) if $validator;
2179 my ($default_key, $keyAliasProps) = &$find_schema_default_key($format);
2184 my $add_option_string = sub {
2187 $res .= ',' if $add_sep;
2192 my $format_value = sub {
2193 my ($key, $value, $format) = @_;
2195 if (defined($format) && ($format eq 'disk-size')) {
2196 return format_size
($value);
2198 die "illegal value with commas for $key\n" if $value =~ /,/;
2203 my $done = { map { $_ => 1 } @$skip };
2205 my $cond_add_key = sub {
2206 my ($key, $isdefault) = @_;
2208 return if $done->{$key}; # avoid duplicates
2212 my $value = $data->{$key};
2214 return if !defined($value);
2216 my $phash = $format->{$key};
2218 # try to combine values if we have key aliases
2219 if (my $combine = $keyAliasProps->{$key}) {
2220 if (defined(my $combine_value = $data->{$combine})) {
2221 my $combine_format = $format->{$combine}->{format
};
2222 my $value_str = &$format_value($key, $value, $phash->{format
});
2223 my $combine_str = &$format_value($combine, $combine_value, $combine_format);
2224 &$add_option_string("${value_str}=${combine_str}");
2225 $done->{$combine} = 1;
2230 if ($phash && $phash->{alias
}) {
2231 $phash = $format->{$phash->{alias
}};
2234 die "invalid key '$key'\n" if !$phash;
2235 die "internal error" if defined($phash->{alias
});
2237 my $value_str = &$format_value($key, $value, $phash->{format
});
2239 &$add_option_string($value_str);
2241 &$add_option_string("$key=${value_str}");
2245 # add default key first
2246 &$cond_add_key($default_key, 1) if defined($default_key);
2248 # add required keys first
2249 foreach my $key (sort keys %$data) {
2250 my $phash = $format->{$key};
2251 &$cond_add_key($key) if $phash && !$phash->{optional
};
2255 foreach my $key (sort keys %$data) {
2256 &$cond_add_key($key);
2262 sub schema_get_type_text
{
2263 my ($phash, $style) = @_;
2265 my $type = $phash->{type
} || 'string';
2267 if ($phash->{typetext
}) {
2268 return $phash->{typetext
};
2269 } elsif ($phash->{format_description
}) {
2270 return "<$phash->{format_description}>";
2271 } elsif ($phash->{enum
}) {
2272 return "<" . join(' | ', sort @{$phash->{enum
}}) . ">";
2273 } elsif ($phash->{pattern
}) {
2274 return $phash->{pattern
};
2275 } elsif ($type eq 'integer' || $type eq 'number') {
2276 # NOTE: always access values as number (avoid converion to string)
2277 if (defined($phash->{minimum
}) && defined($phash->{maximum
})) {
2278 return "<$type> (" . ($phash->{minimum
} + 0) . " - " .
2279 ($phash->{maximum
} + 0) . ")";
2280 } elsif (defined($phash->{minimum
})) {
2281 return "<$type> (" . ($phash->{minimum
} + 0) . " - N)";
2282 } elsif (defined($phash->{maximum
})) {
2283 return "<$type> (-N - " . ($phash->{maximum
} + 0) . ")";
2285 } elsif ($type eq 'string') {
2286 if (my $format = $phash->{format
}) {
2287 $format = get_format
($format) if ref($format) ne 'HASH';
2288 if (ref($format) eq 'HASH') {
2290 $list_enums = 1 if $style && $style eq 'config-sub';
2291 return generate_typetext
($format, $list_enums);