src/PVE/JSONSchema.pm

   1 package PVE::JSONSchema;
   2
   3 use strict;
   4 use warnings;
   5 use Storable; # for dclone
   6 use Getopt::Long;
   7 use Encode::Locale;
   8 use Encode;
   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);
  13 use JSON;
  14 use Net::IP qw(:PROC);
  15 use Data::Dumper;
  16
  17 use base 'Exporter';
  18
  19 our @EXPORT_OK = qw(
  20 register_standard_option
  21 get_standard_option
  22 parse_property_string
  23 print_property_string
  24 );
  25
  26 our $CONFIGID_RE = qr/[a-z][a-z0-9_-]+/i;
  27
  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/
  31
  32 # the code is similar to the javascript parser from http://code.google.com/p/jsonschema/
  33
  34 my $standard_options = {};
  35 sub register_standard_option {
  36     my ($name, $schema) = @_;
  37
  38     die "standard option '$name' already registered\n"
  39         if $standard_options->{$name};
  40
  41     $standard_options->{$name} = $schema;
  42 }
  43
  44 sub get_standard_option {
  45     my ($name, $base) = @_;
  46
  47     my $std =  $standard_options->{$name};
  48     die "no such standard option '$name'\n" if !$std;
  49
  50     my $res = $base || {};
  51
  52     foreach my $opt (keys %$std) {
  53         next if defined($res->{$opt});
  54         $res->{$opt} = $std->{$opt};
  55     }
  56
  57     return $res;
  58 };
  59
  60 register_standard_option('pve-vmid', {
  61     description => "The (unique) ID of the VM.",
  62     type => 'integer',
  63     format => 'pve-vmid',
  64     minimum => 100,
  65     maximum => 999_999_999,
  66 });
  67
  68 register_standard_option('pve-node', {
  69     description => "The cluster node name.",
  70     type => 'string', format => 'pve-node',
  71 });
  72
  73 register_standard_option('pve-node-list', {
  74     description => "List of cluster node names.",
  75     type => 'string', format => 'pve-node-list',
  76 });
  77
  78 register_standard_option('pve-iface', {
  79     description => "Network interface name.",
  80     type => 'string', format => 'pve-iface',
  81     minLength => 2, maxLength => 20,
  82 });
  83
  84 register_standard_option('pve-storage-id', {
  85     description => "The storage identifier.",
  86     type => 'string', format => 'pve-storage-id',
  87 });
  88
  89 register_standard_option('pve-bridge-id', {
  90     description => "Bridge to attach guest network devices to.",
  91     type => 'string', format => 'pve-bridge-id',
  92     format_description => 'bridge',
  93 });
  94
  95 register_standard_option('pve-config-digest', {
  96     description => 'Prevent changes if current configuration file has a different digest. '
  97         . 'This can be used to prevent concurrent modifications.',
  98     type => 'string',
  99     optional => 1,
 100     # sha1 hex digests are 40 characters long
 101     # sha256 hex digests are 64 characters long (sha256 is used in our Rust code)
 102     maxLength => 64,
 103 });
 104
 105 register_standard_option('skiplock', {
 106     description => "Ignore locks - only root is allowed to use this option.",
 107     type => 'boolean',
 108     optional => 1,
 109 });
 110
 111 register_standard_option('extra-args', {
 112     description => "Extra arguments as array",
 113     type => 'array',
 114     items => { type => 'string' },
 115     optional => 1
 116 });
 117
 118 register_standard_option('fingerprint-sha256', {
 119     description => "Certificate SHA 256 fingerprint.",
 120     type => 'string',
 121     pattern => '([A-Fa-f0-9]{2}:){31}[A-Fa-f0-9]{2}',
 122 });
 123
 124 register_standard_option('pve-output-format', {
 125     type => 'string',
 126     description => 'Output format.',
 127     enum => [ 'text', 'json', 'json-pretty', 'yaml' ],
 128     optional => 1,
 129     default => 'text',
 130 });
 131
 132 register_standard_option('pve-snapshot-name', {
 133     description => "The name of the snapshot.",
 134     type => 'string', format => 'pve-configid',
 135     maxLength => 40,
 136 });
 137
 138 my $format_list = {};
 139 my $format_validators = {};
 140
 141 sub register_format {
 142     my ($name, $format, $validator) = @_;
 143
 144     die "JSON schema format '$name' already registered\n"
 145         if $format_list->{$name};
 146
 147     if ($validator) {
 148         die "A \$validator function can only be specified for hash-based formats\n"
 149             if ref($format) ne 'HASH';
 150         $format_validators->{$name} = $validator;
 151     }
 152
 153     $format_list->{$name} = $format;
 154 }
 155
 156 sub get_format {
 157     my ($name) = @_;
 158     return $format_list->{$name};
 159 }
 160
 161 my $renderer_hash = {};
 162
 163 sub register_renderer {
 164     my ($name, $code) = @_;
 165
 166     die "renderer '$name' already registered\n"
 167         if $renderer_hash->{$name};
 168
 169     $renderer_hash->{$name} = $code;
 170 }
 171
 172 sub get_renderer {
 173     my ($name) = @_;
 174     return $renderer_hash->{$name};
 175 }
 176
 177 # register some common type for pve
 178
 179 register_format('string', sub {}); # allow format => 'string-list'
 180
 181 register_format('urlencoded', \&pve_verify_urlencoded);
 182 sub pve_verify_urlencoded {
 183     my ($text, $noerr) = @_;
 184     if ($text !~ /^[-%a-zA-Z0-9_.!~*'()]*$/) {
 185         return undef if $noerr;
 186         die "invalid urlencoded string: $text\n";
 187     }
 188     return $text;
 189 }
 190
 191 register_format('pve-configid', \&pve_verify_configid);
 192 sub pve_verify_configid {
 193     my ($id, $noerr) = @_;
 194
 195     if ($id !~ m/^$CONFIGID_RE$/) {
 196         return undef if $noerr;
 197         die "invalid configuration ID '$id'\n";
 198     }
 199     return $id;
 200 }
 201
 202 PVE::JSONSchema::register_format('pve-storage-id', \&parse_storage_id);
 203 sub parse_storage_id {
 204     my ($storeid, $noerr) = @_;
 205
 206     return parse_id($storeid, 'storage', $noerr);
 207 }
 208
 209 PVE::JSONSchema::register_format('pve-bridge-id', \&parse_bridge_id);
 210 sub parse_bridge_id {
 211     my ($id, $noerr) = @_;
 212
 213     if ($id !~ m/^[-_.\w\d]+$/) {
 214         return undef if $noerr;
 215         die "invalid bridge ID '$id'\n";
 216     }
 217     return $id;
 218 }
 219
 220 PVE::JSONSchema::register_format('acme-plugin-id', \&parse_acme_plugin_id);
 221 sub parse_acme_plugin_id {
 222     my ($pluginid, $noerr) = @_;
 223
 224     return parse_id($pluginid, 'ACME plugin', $noerr);
 225 }
 226
 227 sub parse_id {
 228     my ($id, $type, $noerr) = @_;
 229
 230      if ($id !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i) {
 231         return undef if $noerr;
 232         die "$type ID '$id' contains illegal characters\n";
 233     }
 234     return $id;
 235 }
 236
 237 register_format('pve-vmid', \&pve_verify_vmid);
 238 sub pve_verify_vmid {
 239     my ($vmid, $noerr) = @_;
 240
 241     if ($vmid !~ m/^[1-9][0-9]{2,8}$/) {
 242         return undef if $noerr;
 243         die "value does not look like a valid VM ID\n";
 244     }
 245     return $vmid;
 246 }
 247
 248 register_format('pve-node', \&pve_verify_node_name);
 249 sub pve_verify_node_name {
 250     my ($node, $noerr) = @_;
 251
 252     if ($node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/) {
 253         return undef if $noerr;
 254         die "value does not look like a valid node name\n";
 255     }
 256     return $node;
 257 }
 258
 259 # maps source to target ID using an ID map
 260 sub map_id {
 261     my ($map, $source) = @_;
 262
 263     return $source if !defined($map);
 264
 265     return $map->{entries}->{$source}
 266         if $map->{entries} && defined($map->{entries}->{$source});
 267
 268     return $map->{default} if $map->{default};
 269
 270     # identity (fallback)
 271     return $source;
 272 }
 273
 274 sub parse_idmap {
 275     my ($idmap, $idformat) = @_;
 276
 277     return undef if !$idmap;
 278
 279     my $map = {};
 280
 281     foreach my $entry (PVE::Tools::split_list($idmap)) {
 282         if ($entry eq '1') {
 283             $map->{identity} = 1;
 284         } elsif ($entry =~ m/^([^:]+):([^:]+)$/) {
 285             my ($source, $target) = ($1, $2);
 286             eval {
 287                 check_format($idformat, $source, '');
 288                 check_format($idformat, $target, '');
 289             };
 290             die "entry '$entry' contains invalid ID - $@\n" if $@;
 291
 292             die "duplicate mapping for source '$source'\n"
 293                 if exists $map->{entries}->{$source};
 294
 295             $map->{entries}->{$source} = $target;
 296         } else {
 297             eval {
 298                 check_format($idformat, $entry);
 299             };
 300             die "entry '$entry' contains invalid ID - $@\n" if $@;
 301
 302             die "default target ID can only be provided once\n"
 303                 if exists $map->{default};
 304
 305             $map->{default} = $entry;
 306         }
 307     }
 308
 309     die "identity mapping cannot be combined with other mappings\n"
 310         if $map->{identity} && ($map->{default} || exists $map->{entries});
 311
 312     return $map;
 313 }
 314
 315 my $verify_idpair = sub {
 316     my ($input, $noerr, $format) = @_;
 317
 318     eval { parse_idmap($input, $format) };
 319     if ($@) {
 320         return undef if $noerr;
 321         die "$@\n";
 322     }
 323
 324     return $input;
 325 };
 326
 327 PVE::JSONSchema::register_standard_option('pve-targetstorage', {
 328     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.",
 329     type => 'string',
 330     format => 'storage-pair-list',
 331     optional => 1,
 332 });
 333
 334 # note: this only checks a single list entry
 335 # when using a storage-pair-list map, you need to pass the full parameter to
 336 # parse_idmap
 337 register_format('storage-pair', \&verify_storagepair);
 338 sub verify_storagepair {
 339     my ($storagepair, $noerr) = @_;
 340     return $verify_idpair->($storagepair, $noerr, 'pve-storage-id');
 341 }
 342
 343 # note: this only checks a single list entry
 344 # when using a bridge-pair-list map, you need to pass the full parameter to
 345 # parse_idmap
 346 register_format('bridge-pair', \&verify_bridgepair);
 347 sub verify_bridgepair {
 348     my ($bridgepair, $noerr) = @_;
 349     return $verify_idpair->($bridgepair, $noerr, 'pve-bridge-id');
 350 }
 351
 352 register_format('mac-addr', \&pve_verify_mac_addr);
 353 sub pve_verify_mac_addr {
 354     my ($mac_addr, $noerr) = @_;
 355
 356     # don't allow I/G bit to be set, most of the time it breaks things, see:
 357     # https://pve.proxmox.com/pipermail/pve-devel/2019-March/035998.html
 358     if ($mac_addr !~ m/^[a-f0-9][02468ace](?::[a-f0-9]{2}){5}$/i) {
 359         return undef if $noerr;
 360         die "value does not look like a valid unicast MAC address\n";
 361     }
 362     return $mac_addr;
 363
 364 }
 365 register_standard_option('mac-addr', {
 366     type => 'string',
 367     description => 'Unicast MAC address.',
 368     verbose_description => 'A common MAC address with the I/G (Individual/Group) bit not set.',
 369     format_description => "XX:XX:XX:XX:XX:XX",
 370     optional => 1,
 371     format => 'mac-addr',
 372 });
 373
 374 register_format('ipv4', \&pve_verify_ipv4);
 375 sub pve_verify_ipv4 {
 376     my ($ipv4, $noerr) = @_;
 377
 378     if ($ipv4 !~ m/^(?:$IPV4RE)$/) {
 379         return undef if $noerr;
 380         die "value does not look like a valid IPv4 address\n";
 381     }
 382     return $ipv4;
 383 }
 384
 385 register_format('ipv6', \&pve_verify_ipv6);
 386 sub pve_verify_ipv6 {
 387     my ($ipv6, $noerr) = @_;
 388
 389     if ($ipv6 !~ m/^(?:$IPV6RE)$/) {
 390         return undef if $noerr;
 391         die "value does not look like a valid IPv6 address\n";
 392     }
 393     return $ipv6;
 394 }
 395
 396 register_format('ip', \&pve_verify_ip);
 397 sub pve_verify_ip {
 398     my ($ip, $noerr) = @_;
 399
 400     if ($ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/) {
 401         return undef if $noerr;
 402         die "value does not look like a valid IP address\n";
 403     }
 404     return $ip;
 405 }
 406
 407 PVE::JSONSchema::register_format('ldap-simple-attr', \&verify_ldap_simple_attr);
 408 sub verify_ldap_simple_attr {
 409     my ($attr, $noerr) = @_;
 410
 411     if ($attr =~ m/^[a-zA-Z0-9]+$/) {
 412         return $attr;
 413     }
 414
 415     die "value '$attr' does not look like a simple ldap attribute name\n" if !$noerr;
 416
 417     return undef;
 418 }
 419
 420 my $ipv4_mask_hash = {
 421     '0.0.0.0' => 0,
 422     '128.0.0.0' => 1,
 423     '192.0.0.0' => 2,
 424     '224.0.0.0' => 3,
 425     '240.0.0.0' => 4,
 426     '248.0.0.0' => 5,
 427     '252.0.0.0' => 6,
 428     '254.0.0.0' => 7,
 429     '255.0.0.0' => 8,
 430     '255.128.0.0' => 9,
 431     '255.192.0.0' => 10,
 432     '255.224.0.0' => 11,
 433     '255.240.0.0' => 12,
 434     '255.248.0.0' => 13,
 435     '255.252.0.0' => 14,
 436     '255.254.0.0' => 15,
 437     '255.255.0.0' => 16,
 438     '255.255.128.0' => 17,
 439     '255.255.192.0' => 18,
 440     '255.255.224.0' => 19,
 441     '255.255.240.0' => 20,
 442     '255.255.248.0' => 21,
 443     '255.255.252.0' => 22,
 444     '255.255.254.0' => 23,
 445     '255.255.255.0' => 24,
 446     '255.255.255.128' => 25,
 447     '255.255.255.192' => 26,
 448     '255.255.255.224' => 27,
 449     '255.255.255.240' => 28,
 450     '255.255.255.248' => 29,
 451     '255.255.255.252' => 30,
 452     '255.255.255.254' => 31,
 453     '255.255.255.255' => 32,
 454 };
 455
 456 sub get_netmask_bits {
 457     my ($mask) = @_;
 458     return $ipv4_mask_hash->{$mask};
 459 }
 460
 461 register_format('ipv4mask', \&pve_verify_ipv4mask);
 462 sub pve_verify_ipv4mask {
 463     my ($mask, $noerr) = @_;
 464
 465     if (!defined($ipv4_mask_hash->{$mask})) {
 466         return undef if $noerr;
 467         die "value does not look like a valid IP netmask\n";
 468     }
 469     return $mask;
 470 }
 471
 472 register_format('CIDRv6', \&pve_verify_cidrv6);
 473 sub pve_verify_cidrv6 {
 474     my ($cidr, $noerr) = @_;
 475
 476     if ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) && ($1 <= 128)) {
 477         return $cidr;
 478     }
 479
 480     return undef if $noerr;
 481     die "value does not look like a valid IPv6 CIDR network\n";
 482 }
 483
 484 register_format('CIDRv4', \&pve_verify_cidrv4);
 485 sub pve_verify_cidrv4 {
 486     my ($cidr, $noerr) = @_;
 487
 488     if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 <= 32)) {
 489         return $cidr;
 490     }
 491
 492     return undef if $noerr;
 493     die "value does not look like a valid IPv4 CIDR network\n";
 494 }
 495
 496 register_format('CIDR', \&pve_verify_cidr);
 497 sub pve_verify_cidr {
 498     my ($cidr, $noerr) = @_;
 499
 500     if (!(pve_verify_cidrv4($cidr, 1) ||
 501           pve_verify_cidrv6($cidr, 1)))
 502     {
 503         return undef if $noerr;
 504         die "value does not look like a valid CIDR network\n";
 505     }
 506
 507     return $cidr;
 508 }
 509
 510 register_format('pve-ipv4-config', \&pve_verify_ipv4_config);
 511 sub pve_verify_ipv4_config {
 512     my ($config, $noerr) = @_;
 513
 514     return $config if $config =~ /^(?:dhcp|manual)$/ ||
 515                       pve_verify_cidrv4($config, 1);
 516     return undef if $noerr;
 517     die "value does not look like a valid ipv4 network configuration\n";
 518 }
 519
 520 register_format('pve-ipv6-config', \&pve_verify_ipv6_config);
 521 sub pve_verify_ipv6_config {
 522     my ($config, $noerr) = @_;
 523
 524     return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
 525                       pve_verify_cidrv6($config, 1);
 526     return undef if $noerr;
 527     die "value does not look like a valid ipv6 network configuration\n";
 528 }
 529
 530 register_format('email', \&pve_verify_email);
 531 sub pve_verify_email {
 532     my ($email, $noerr) = @_;
 533
 534     if ($email !~ /^$PVE::Tools::EMAIL_RE$/) {
 535            return undef if $noerr;
 536            die "value does not look like a valid email address\n";
 537     }
 538     return $email;
 539 }
 540
 541 register_format('email-or-username', \&pve_verify_email_or_username);
 542 sub pve_verify_email_or_username {
 543     my ($email, $noerr) = @_;
 544
 545     if ($email !~ /^$PVE::Tools::EMAIL_RE$/ &&
 546         $email !~ /^$PVE::Tools::EMAIL_USER_RE$/) {
 547            return undef if $noerr;
 548            die "value does not look like a valid email address or user name\n";
 549     }
 550     return $email;
 551 }
 552
 553 register_format('dns-name', \&pve_verify_dns_name);
 554 sub pve_verify_dns_name {
 555     my ($name, $noerr) = @_;
 556
 557     my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)";
 558
 559     if ($name !~ /^(${namere}\.)*${namere}$/) {
 560            return undef if $noerr;
 561            die "value does not look like a valid DNS name\n";
 562     }
 563     return $name;
 564 }
 565
 566 register_format('timezone', \&pve_verify_timezone);
 567 sub pve_verify_timezone {
 568     my ($timezone, $noerr) = @_;
 569
 570     return $timezone if $timezone eq 'UTC';
 571
 572     open(my $fh, "<",  "/usr/share/zoneinfo/zone.tab");
 573     while (my $line = <$fh>) {
 574         next if $line =~ /^\s*#/;
 575         chomp $line;
 576         my $zone = (split /\t/, $line)[2];
 577         return $timezone if $timezone eq $zone; # found
 578     }
 579     close $fh;
 580
 581     return undef if $noerr;
 582     die "invalid time zone '$timezone'\n";
 583 }
 584
 585 # network interface name
 586 register_format('pve-iface', \&pve_verify_iface);
 587 sub pve_verify_iface {
 588     my ($id, $noerr) = @_;
 589
 590     if ($id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i) {
 591         return undef if $noerr;
 592         die "invalid network interface name '$id'\n";
 593     }
 594     return $id;
 595 }
 596
 597 # general addresses by name or IP
 598 register_format('address', \&pve_verify_address);
 599 sub pve_verify_address {
 600     my ($addr, $noerr) = @_;
 601
 602     if (!(pve_verify_ip($addr, 1) ||
 603           pve_verify_dns_name($addr, 1)))
 604     {
 605            return undef if $noerr;
 606            die "value does not look like a valid address: $addr\n";
 607     }
 608     return $addr;
 609 }
 610
 611 register_format('disk-size', \&pve_verify_disk_size);
 612 sub pve_verify_disk_size {
 613     my ($size, $noerr) = @_;
 614     if (!defined(parse_size($size))) {
 615         return undef if $noerr;
 616         die "value does not look like a valid disk size: $size\n";
 617     }
 618     return $size;
 619 }
 620
 621 register_standard_option('spice-proxy', {
 622     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).",
 623     type => 'string', format => 'address',
 624 });
 625
 626 register_standard_option('remote-viewer-config', {
 627     description => "Returned values can be directly passed to the 'remote-viewer' application.",
 628     additionalProperties => 1,
 629     properties => {
 630         type => { type => 'string' },
 631         password => { type => 'string' },
 632         proxy => { type => 'string' },
 633         host => { type => 'string' },
 634         'tls-port' => { type => 'integer' },
 635     },
 636 });
 637
 638 register_format('pve-startup-order', \&pve_verify_startup_order);
 639 sub pve_verify_startup_order {
 640     my ($value, $noerr) = @_;
 641
 642     return $value if pve_parse_startup_order($value);
 643
 644     return undef if $noerr;
 645
 646     die "unable to parse startup options\n";
 647 }
 648
 649 my %bwlimit_opt = (
 650     optional => 1,
 651     type => 'number', minimum => '0',
 652     format_description => 'LIMIT',
 653 );
 654
 655 my $bwlimit_format = {
 656         default => {
 657             %bwlimit_opt,
 658             description => 'default bandwidth limit in KiB/s',
 659         },
 660         restore => {
 661             %bwlimit_opt,
 662             description => 'bandwidth limit in KiB/s for restoring guests from backups',
 663         },
 664         migration => {
 665             %bwlimit_opt,
 666             description => 'bandwidth limit in KiB/s for migrating guests (including moving local disks)',
 667         },
 668         clone => {
 669             %bwlimit_opt,
 670             description => 'bandwidth limit in KiB/s for cloning disks',
 671         },
 672         move => {
 673             %bwlimit_opt,
 674             description => 'bandwidth limit in KiB/s for moving disks',
 675         },
 676 };
 677 register_format('bwlimit', $bwlimit_format);
 678 register_standard_option('bwlimit', {
 679     description => "Set I/O bandwidth limit for various operations (in KiB/s).",
 680     optional => 1,
 681     type => 'string',
 682     format => $bwlimit_format,
 683 });
 684
 685 my $remote_format = {
 686     host => {
 687         type => 'string',
 688         description => 'Remote Proxmox hostname or IP',
 689         format_description => 'ADDRESS',
 690     },
 691     port => {
 692         type => 'integer',
 693         optional => 1,
 694         description => 'Port to connect to',
 695         format_description => 'PORT',
 696     },
 697     apitoken => {
 698         type => 'string',
 699         description => 'A full Proxmox API token including the secret value.',
 700         format_description => 'user@realm!token=SECRET',
 701     },
 702     fingerprint => get_standard_option(
 703         'fingerprint-sha256',
 704         {
 705             optional => 1,
 706             description => 'Remote host\'s certificate fingerprint, if not trusted by system store.',
 707             format_description => 'FINGERPRINT',
 708         }
 709     ),
 710 };
 711 register_format('proxmox-remote', $remote_format);
 712 register_standard_option('proxmox-remote', {
 713     description => "Specification of a remote endpoint.",
 714     type => 'string', format => 'proxmox-remote',
 715 });
 716
 717 our $PVE_TAG_RE = qr/[a-z0-9_][a-z0-9_\-\+\.]*/i;
 718
 719 # used for pve-tag-list in e.g., guest configs
 720 register_format('pve-tag', \&pve_verify_tag);
 721 sub pve_verify_tag {
 722     my ($value, $noerr) = @_;
 723
 724     return $value if $value =~ m/^${PVE_TAG_RE}$/i;
 725
 726     return undef if $noerr;
 727
 728     die "invalid characters in tag\n";
 729 }
 730
 731 sub pve_parse_startup_order {
 732     my ($value) = @_;
 733
 734     return undef if !$value;
 735
 736     my $res = {};
 737
 738     foreach my $p (split(/,/, $value)) {
 739         next if $p =~ m/^\s*$/;
 740
 741         if ($p =~ m/^(order=)?(\d+)$/) {
 742             $res->{order} = $2;
 743         } elsif ($p =~ m/^up=(\d+)$/) {
 744             $res->{up} = $1;
 745         } elsif ($p =~ m/^down=(\d+)$/) {
 746             $res->{down} = $1;
 747         } else {
 748             return undef;
 749         }
 750     }
 751
 752     return $res;
 753 }
 754
 755 PVE::JSONSchema::register_standard_option('pve-startup-order', {
 756     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.",
 757     optional => 1,
 758     type => 'string', format => 'pve-startup-order',
 759     typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
 760 });
 761
 762 register_format('pve-tfa-secret', \&pve_verify_tfa_secret);
 763 sub pve_verify_tfa_secret {
 764     my ($key, $noerr) = @_;
 765
 766     # The old format used 16 base32 chars or 40 hex digits. Since they have a common subset it's
 767     # hard to distinguish them without the our previous length constraints, so add a 'v2' of the
 768     # format to support arbitrary lengths properly:
 769     if ($key =~ /^v2-0x[0-9a-fA-F]{16,128}$/ || # hex
 770         $key =~ /^v2-[A-Z2-7=]{16,128}$/ ||     # base32
 771         $key =~ /^(?:[A-Z2-7=]{16}|[A-Fa-f0-9]{40})$/) # and the old pattern copy&pasted
 772     {
 773         return $key;
 774     }
 775
 776     return undef if $noerr;
 777
 778     die "unable to decode TFA secret\n";
 779 }
 780
 781
 782 PVE::JSONSchema::register_format('pve-task-status-type', \&verify_task_status_type);
 783 sub verify_task_status_type {
 784     my ($value, $noerr) = @_;
 785
 786     return $value if $value =~ m/^(ok|error|warning|unknown)$/i;
 787
 788     return undef if $noerr;
 789
 790     die "invalid status '$value'\n";
 791 }
 792
 793 sub check_format {
 794     my ($format, $value, $path) = @_;
 795
 796     if (ref($format) eq 'HASH') {
 797         # hash ref cannot have validator/list/opt handling attached
 798         return parse_property_string($format, $value, $path);
 799     }
 800
 801     if (ref($format) eq 'CODE') {
 802         # we are the (sole, old-style) validator
 803         return $format->($value);
 804     }
 805
 806     return if $format eq 'regex';
 807
 808     my $parsed;
 809     $format =~ m/^(.*?)(?:-(list|opt))?$/;
 810     my ($format_name, $format_type) = ($1, $2 // 'none');
 811     my $registered = get_format($format_name);
 812     die "undefined format '$format'\n" if !$registered;
 813
 814     die "'-$format_type' format must have code ref, not hash\n"
 815         if $format_type ne 'none' && ref($registered) ne 'CODE';
 816
 817     if ($format_type eq 'list') {
 818         $parsed = [];
 819         # Note: we allow empty lists
 820         foreach my $v (split_list($value)) {
 821             push @{$parsed}, $registered->($v);
 822         }
 823     } elsif ($format_type eq 'opt') {
 824         $parsed = $registered->($value) if $value;
 825     } else {
 826         if (ref($registered) eq 'HASH') {
 827             # Note: this is the only case where a validator function could be
 828             # attached, hence it's safe to handle that in parse_property_string.
 829             # We do however have to call it with $format_name instead of
 830             # $registered, so it knows about the name (and thus any validators).
 831             $parsed = parse_property_string($format, $value, $path);
 832         } else {
 833             $parsed = $registered->($value);
 834         }
 835     }
 836
 837     return $parsed;
 838 }
 839
 840 sub parse_size {
 841     my ($value) = @_;
 842
 843     return undef if $value !~ m/^(\d+(\.\d+)?)([KMGT])?$/;
 844     my ($size, $unit) = ($1, $3);
 845     if ($unit) {
 846         if ($unit eq 'K') {
 847             $size = $size * 1024;
 848         } elsif ($unit eq 'M') {
 849             $size = $size * 1024 * 1024;
 850         } elsif ($unit eq 'G') {
 851             $size = $size * 1024 * 1024 * 1024;
 852         } elsif ($unit eq 'T') {
 853             $size = $size * 1024 * 1024 * 1024 * 1024;
 854         }
 855     }
 856     return int($size);
 857 };
 858
 859 sub format_size {
 860     my ($size) = @_;
 861
 862     $size = int($size);
 863
 864     my $kb = int($size/1024);
 865     return $size if $kb*1024 != $size;
 866
 867     my $mb = int($kb/1024);
 868     return "${kb}K" if $mb*1024 != $kb;
 869
 870     my $gb = int($mb/1024);
 871     return "${mb}M" if $gb*1024 != $mb;
 872
 873     my $tb = int($gb/1024);
 874     return "${gb}G" if $tb*1024 != $gb;
 875
 876     return "${tb}T";
 877 };
 878
 879 sub parse_boolean {
 880     my ($bool) = @_;
 881     return 1 if $bool =~ m/^(1|on|yes|true)$/i;
 882     return 0 if $bool =~ m/^(0|off|no|false)$/i;
 883     return undef;
 884 }
 885
 886 sub parse_property_string {
 887     my ($format, $data, $path, $additional_properties) = @_;
 888
 889     # In property strings we default to not allowing additional properties
 890     $additional_properties = 0 if !defined($additional_properties);
 891
 892     # Support named formats here, too:
 893     my $validator;
 894     if (!ref($format)) {
 895         if (my $reg = get_format($format)) {
 896             die "parse_property_string only accepts hash based named formats\n"
 897                 if ref($reg) ne 'HASH';
 898
 899             # named formats can have validators attached
 900             $validator = $format_validators->{$format};
 901
 902             $format = $reg;
 903         } else {
 904             die "unknown format: $format\n";
 905         }
 906     } elsif (ref($format) ne 'HASH') {
 907         die "unexpected format value of type ".ref($format)."\n";
 908     }
 909
 910     my $default_key;
 911
 912     my $res = {};
 913     foreach my $part (split(/,/, $data)) {
 914         next if $part =~ /^\s*$/;
 915
 916         if ($part =~ /^([^=]+)=(.+)$/) {
 917             my ($k, $v) = ($1, $2);
 918             die "duplicate key in comma-separated list property: $k\n" if defined($res->{$k});
 919             my $schema = $format->{$k};
 920             if (my $alias = $schema->{alias}) {
 921                 if (my $key_alias = $schema->{keyAlias}) {
 922                     die "key alias '$key_alias' is already defined\n" if defined($res->{$key_alias});
 923                     $res->{$key_alias} = $k;
 924                 }
 925                 $k = $alias;
 926                 $schema = $format->{$k};
 927             }
 928
 929             die "invalid key in comma-separated list property: $k\n" if !$schema;
 930             if ($schema->{type} && $schema->{type} eq 'boolean') {
 931                 $v = parse_boolean($v) // $v;
 932             }
 933             $res->{$k} = $v;
 934         } elsif ($part !~ /=/) {
 935             die "duplicate key in comma-separated list property: $default_key\n" if $default_key;
 936             foreach my $key (keys %$format) {
 937                 if ($format->{$key}->{default_key}) {
 938                     $default_key = $key;
 939                     if (!$res->{$default_key}) {
 940                         $res->{$default_key} = $part;
 941                         last;
 942                     }
 943                     die "duplicate key in comma-separated list property: $default_key\n";
 944                 }
 945             }
 946             die "value without key, but schema does not define a default key\n" if !$default_key;
 947         } else {
 948             die "missing key in comma-separated list property\n";
 949         }
 950     }
 951
 952     my $errors = {};
 953     check_object($path, $format, $res, $additional_properties, $errors);
 954     if (scalar(%$errors)) {
 955         raise "format error\n", errors => $errors;
 956     }
 957
 958     return $validator->($res) if $validator;
 959     return $res;
 960 }
 961
 962 sub add_error {
 963     my ($errors, $path, $msg) = @_;
 964
 965     $path = '_root' if !$path;
 966
 967     if ($errors->{$path}) {
 968         $errors->{$path} = join ('\n', $errors->{$path}, $msg);
 969     } else {
 970         $errors->{$path} = $msg;
 971     }
 972 }
 973
 974 sub is_number {
 975     my $value = shift;
 976
 977     # see 'man perlretut'
 978     return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
 979 }
 980
 981 sub is_integer {
 982     my $value = shift;
 983
 984     return $value =~ m/^[+-]?\d+$/;
 985 }
 986
 987 sub check_type {
 988     my ($path, $type, $value, $errors) = @_;
 989
 990     return 1 if !$type;
 991
 992     if (!defined($value)) {
 993         return 1 if $type eq 'null';
 994         die "internal error"
 995     }
 996
 997     if (my $tt = ref($type)) {
 998         if ($tt eq 'ARRAY') {
 999             foreach my $t (@$type) {
1000                 my $tmperr = {};
1001                 check_type($path, $t, $value, $tmperr);
1002                 return 1 if !scalar(%$tmperr);
1003             }
1004             my $ttext = join ('|', @$type);
1005             add_error($errors, $path, "type check ('$ttext') failed");
1006             return undef;
1007         } elsif ($tt eq 'HASH') {
1008             my $tmperr = {};
1009             check_prop($value, $type, $path, $tmperr);
1010             return 1 if !scalar(%$tmperr);
1011             add_error($errors, $path, "type check failed");
1012             return undef;
1013         } else {
1014             die "internal error - got reference type '$tt'";
1015         }
1016
1017     } else {
1018
1019         return 1 if $type eq 'any';
1020
1021         if ($type eq 'null') {
1022             if (defined($value)) {
1023                 add_error($errors, $path, "type check ('$type') failed - value is not null");
1024                 return undef;
1025             }
1026             return 1;
1027         }
1028
1029         my $vt = ref($value);
1030
1031         if ($type eq 'array') {
1032             if (!$vt || $vt ne 'ARRAY') {
1033                 add_error($errors, $path, "type check ('$type') failed");
1034                 return undef;
1035             }
1036             return 1;
1037         } elsif ($type eq 'object') {
1038             if (!$vt || $vt ne 'HASH') {
1039                 add_error($errors, $path, "type check ('$type') failed");
1040                 return undef;
1041             }
1042             return 1;
1043         } elsif ($type eq 'coderef') {
1044             if (!$vt || $vt ne 'CODE') {
1045                 add_error($errors, $path, "type check ('$type') failed");
1046                 return undef;
1047             }
1048             return 1;
1049         } elsif ($type eq 'string' && $vt eq 'Regexp') {
1050             # qr// regexes can be used as strings and make sense for format=regex
1051             return 1;
1052         } else {
1053             if ($vt) {
1054                 if ($type eq 'boolean' && JSON::is_bool($value)) {
1055                     return 1;
1056                 }
1057                 add_error($errors, $path, "type check ('$type') failed - got $vt");
1058                 return undef;
1059             } else {
1060                 if ($type eq 'string') {
1061                     return 1; # nothing to check ?
1062                 } elsif ($type eq 'boolean') {
1063                     #if ($value =~ m/^(1|true|yes|on)$/i) {
1064                     if ($value eq '1') {
1065                         return 1;
1066                     #} elsif ($value =~ m/^(0|false|no|off)$/i) {
1067                     } elsif ($value eq '0') {
1068                         return 1; # return success (not value)
1069                     } else {
1070                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
1071                         return undef;
1072                     }
1073                 } elsif ($type eq 'integer') {
1074                     if (!is_integer($value)) {
1075                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
1076                         return undef;
1077                     }
1078                     return 1;
1079                 } elsif ($type eq 'number') {
1080                     if (!is_number($value)) {
1081                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
1082                         return undef;
1083                     }
1084                     return 1;
1085                 } else {
1086                     return 1; # no need to verify unknown types
1087                 }
1088             }
1089         }
1090     }
1091
1092     return undef;
1093 }
1094
1095 my sub get_instance_type {
1096     my ($schema, $key, $value) = @_;
1097
1098     if (my $type_property = $schema->{$key}->{'type-property'}) {
1099         return $value->{$type_property};
1100     }
1101
1102     return undef;
1103 }
1104
1105 sub check_object {
1106     my ($path, $schema, $value, $additional_properties, $errors) = @_;
1107
1108     # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
1109
1110     my $st = ref($schema);
1111     if (!$st || $st ne 'HASH') {
1112         add_error($errors, $path, "Invalid schema definition.");
1113         return;
1114     }
1115
1116     my $vt = ref($value);
1117     if (!$vt || $vt ne 'HASH') {
1118         add_error($errors, $path, "an object is required");
1119         return;
1120     }
1121
1122     foreach my $k (keys %$schema) {
1123         my $instance_type = get_instance_type($schema, $k, $value);
1124         check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors, $instance_type);
1125     }
1126
1127     foreach my $k (keys %$value) {
1128
1129         my $newpath =  $path ? "$path.$k" : $k;
1130
1131         if (my $subschema = $schema->{$k}) {
1132             if (my $requires = $subschema->{requires}) {
1133                 if (ref($requires)) {
1134                     #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
1135                     check_prop($value, $requires, $path, $errors);
1136                 } elsif (!defined($value->{$requires})) {
1137                     add_error($errors, $path ? "$path.$requires" : $requires,
1138                               "missing property - '$newpath' requires this property");
1139                 }
1140             }
1141
1142             # if it's a oneOf, check if there is a matching type
1143             my $matched_type = 1;
1144             if ($subschema->{oneOf}) {
1145                 my $instance_type = get_instance_type($schema, $k, $value);
1146                 $matched_type = 0;
1147                 for my $alternative ($subschema->{oneOf}->@*) {
1148                     if (my $instance_types = $alternative->{'instance-types'}) {
1149                         if (!grep { $instance_type eq $_ } $instance_types->@*) {
1150                             next;
1151                         }
1152                     }
1153                     $matched_type = 1;
1154                     last;
1155                 }
1156             }
1157
1158             next if $matched_type; # value is already checked above
1159         }
1160
1161         if (defined ($additional_properties) && !$additional_properties) {
1162             add_error($errors, $newpath, "property is not defined in schema " .
1163                       "and the schema does not allow additional properties");
1164             next;
1165         }
1166         check_prop($value->{$k}, $additional_properties, $newpath, $errors)
1167             if ref($additional_properties);
1168     }
1169 }
1170
1171 sub check_object_warn {
1172     my ($path, $schema, $value, $additional_properties) = @_;
1173     my $errors = {};
1174     check_object($path, $schema, $value, $additional_properties, $errors);
1175     if (scalar(%$errors)) {
1176         foreach my $k (keys %$errors) {
1177             warn "parse error: $k: $errors->{$k}\n";
1178         }
1179         return 0;
1180     }
1181     return 1;
1182 }
1183
1184 sub check_prop {
1185     my ($value, $schema, $path, $errors, $instance_type) = @_;
1186
1187     die "internal error - no schema" if !$schema;
1188     die "internal error" if !$errors;
1189
1190     #print "check_prop $path\n" if $value;
1191
1192     my $st = ref($schema);
1193     if (!$st || $st ne 'HASH') {
1194         add_error($errors, $path, "Invalid schema definition.");
1195         return;
1196     }
1197
1198     # must pass any of the given schemas
1199     my $optional_for_type = 0;
1200     if ($schema->{oneOf}) {
1201         # in case we have an instance_type given, just check for that variant
1202         if ($schema->{'type-property'}) {
1203             $optional_for_type = 1;
1204             for (my $i = 0; $i < scalar($schema->{oneOf}->@*); $i++) {
1205                 last if !$instance_type; # treat as optional if we don't have a type
1206                 my $inner_schema = $schema->{oneOf}->[$i];
1207
1208                 if (!defined($inner_schema->{'instance-types'})) {
1209                     add_error($errors, $path, "missing 'instance-types' in oneOf alternative");
1210                     return;
1211                 }
1212
1213                 next if !grep { $_ eq $instance_type } $inner_schema->{'instance-types'}->@*;
1214                 $optional_for_type = $inner_schema->{optional} // 0;
1215                 check_prop($value, $inner_schema, $path, $errors);
1216             }
1217         } else {
1218             my $is_valid = 0;
1219             my $collected_errors = {};
1220             for (my $i = 0; $i < scalar($schema->{oneOf}->@*); $i++) {
1221                 my $inner_schema = $schema->{oneOf}->[$i];
1222                 my $inner_errors = {};
1223                 check_prop($value, $inner_schema, "$path.oneOf[$i]", $inner_errors);
1224                 if (!$inner_errors->%*) {
1225                     $is_valid = 1;
1226                     last;
1227                 }
1228
1229                 for my $inner_path (keys $inner_errors->%*) {
1230                     add_error($collected_errors, $inner_path, $inner_errors->{$path});
1231                 }
1232             }
1233
1234             if (!$is_valid) {
1235                 for my $inner_path (keys $collected_errors->%*) {
1236                     add_error($errors, $inner_path, $collected_errors->{$path});
1237                 }
1238             }
1239         }
1240     } elsif ($instance_type) {
1241         if (!defined($schema->{'instance-types'})) {
1242             add_error($errors, $path, "missing 'instance-types'");
1243             return;
1244         }
1245         if (grep { $_ eq $instance_type} $schema->{'instance_types'}->@*) {
1246             $optional_for_type = 1;
1247         }
1248     }
1249
1250     # if it extends another schema, it must pass that schema as well
1251     if($schema->{extends}) {
1252         check_prop($value, $schema->{extends}, $path, $errors);
1253     }
1254
1255     if (!defined ($value)) {
1256         return if $schema->{type} && $schema->{type} eq 'null';
1257         if (!$schema->{optional} && !$schema->{alias} && !$schema->{group} && !$optional_for_type) {
1258             add_error($errors, $path, "property is missing and it is not optional");
1259         }
1260         return;
1261     }
1262
1263     return if !check_type($path, $schema->{type}, $value, $errors);
1264
1265     if ($schema->{disallow}) {
1266         my $tmperr = {};
1267         if (check_type($path, $schema->{disallow}, $value, $tmperr)) {
1268             add_error($errors, $path, "disallowed value was matched");
1269             return;
1270         }
1271     }
1272
1273     if (my $vt = ref($value)) {
1274
1275         if ($vt eq 'ARRAY') {
1276             if ($schema->{items}) {
1277                 my $it = ref($schema->{items});
1278                 if ($it && $it eq 'ARRAY') {
1279                     #die "implement me $path: $vt " . Dumper($schema) ."\n".  Dumper($value);
1280                     die "not implemented";
1281                 } else {
1282                     my $ind = 0;
1283                     foreach my $el (@$value) {
1284                         check_prop($el, $schema->{items}, "${path}[$ind]", $errors);
1285                         $ind++;
1286                     }
1287                 }
1288             }
1289             return;
1290         } elsif ($schema->{properties} || $schema->{additionalProperties}) {
1291             check_object($path, defined($schema->{properties}) ? $schema->{properties} : {},
1292                          $value, $schema->{additionalProperties}, $errors);
1293             return;
1294         }
1295
1296     } else {
1297
1298         if (my $format = $schema->{format}) {
1299             eval { check_format($format, $value, $path); };
1300             if ($@) {
1301                 add_error($errors, $path, "invalid format - $@");
1302                 return;
1303             }
1304         }
1305
1306         if (my $pattern = $schema->{pattern}) {
1307             if ($value !~ m/^$pattern$/) {
1308                 add_error($errors, $path, "value does not match the regex pattern");
1309                 return;
1310             }
1311         }
1312
1313         if (defined (my $max = $schema->{maxLength})) {
1314             if (length($value) > $max) {
1315                 add_error($errors, $path, "value may only be $max characters long");
1316                 return;
1317             }
1318         }
1319
1320         if (defined (my $min = $schema->{minLength})) {
1321             if (length($value) < $min) {
1322                 add_error($errors, $path, "value must be at least $min characters long");
1323                 return;
1324             }
1325         }
1326
1327         if (is_number($value)) {
1328             if (defined (my $max = $schema->{maximum})) {
1329                 if ($value > $max) {
1330                     add_error($errors, $path, "value must have a maximum value of $max");
1331                     return;
1332                 }
1333             }
1334
1335             if (defined (my $min = $schema->{minimum})) {
1336                 if ($value < $min) {
1337                     add_error($errors, $path, "value must have a minimum value of $min");
1338                     return;
1339                 }
1340             }
1341         }
1342
1343         if (my $ea = $schema->{enum}) {
1344
1345             my $found;
1346             foreach my $ev (@$ea) {
1347                 if ($ev eq $value) {
1348                     $found = 1;
1349                     last;
1350                 }
1351             }
1352             if (!$found) {
1353                 add_error($errors, $path, "value '$value' does not have a value in the enumeration '" .
1354                           join(", ", @$ea) . "'");
1355             }
1356         }
1357     }
1358 }
1359
1360 sub validate {
1361     my ($instance, $schema, $errmsg) = @_;
1362
1363     my $errors = {};
1364     $errmsg = "Parameter verification failed.\n" if !$errmsg;
1365
1366     # todo: cycle detection is only needed for debugging, I guess
1367     # we can disable that in the final release
1368     # todo: is there a better/faster way to detect cycles?
1369     my $cycles = 0;
1370     # 'download' responses can contain a filehandle, don't cycle-check that as
1371     # it produces a warning
1372     my $is_download = ref($instance) eq 'HASH' && exists($instance->{download});
1373     find_cycle($instance, sub { $cycles = 1 }) if !$is_download;
1374     if ($cycles) {
1375         add_error($errors, undef, "data structure contains recursive cycles");
1376     } elsif ($schema) {
1377         check_prop($instance, $schema, '', $errors);
1378     }
1379
1380     if (scalar(%$errors)) {
1381         raise $errmsg, code => HTTP_BAD_REQUEST, errors => $errors;
1382     }
1383
1384     return 1;
1385 }
1386
1387 my $schema_valid_types = ["string", "object", "coderef", "array", "boolean", "number", "integer", "null", "any"];
1388 my $default_schema_noref = {
1389     description => "This is the JSON Schema for JSON Schemas.",
1390     type => [ "object" ],
1391     additionalProperties => 0,
1392     properties => {
1393         type => {
1394             type => ["string", "array"],
1395             description => "This is a type definition value. This can be a simple type, or a union type",
1396             optional => 1,
1397             default => "any",
1398             items => {
1399                 type => "string",
1400                 enum => $schema_valid_types,
1401             },
1402             enum => $schema_valid_types,
1403         },
1404         oneOf => {
1405             type => 'array',
1406             description => "This represents the alternative options for this Schema instance.",
1407             optional => 1,
1408             items => {
1409                 type => 'object',
1410                 description => "A valid option of the properties",
1411             },
1412         },
1413         'instance-types' => {
1414             type => 'array',
1415             description => "Indicate to which type the parameter (or variant if inside a oneOf) belongs.",
1416             optional => 1,
1417             items => {
1418                 type => 'string',
1419             },
1420         },
1421         'type-property' => {
1422             type => 'string',
1423             description => "The property to check for instance types.",
1424             optional => 1,
1425         },
1426         optional => {
1427             type => "boolean",
1428             description => "This indicates that the instance property in the instance object is not required.",
1429             optional => 1,
1430             default => 0
1431         },
1432         properties => {
1433             type => "object",
1434             description => "This is a definition for the properties of an object value",
1435             optional => 1,
1436             default => {},
1437         },
1438         items => {
1439             type => "object",
1440             description => "When the value is an array, this indicates the schema to use to validate each item in an array",
1441             optional => 1,
1442             default => {},
1443         },
1444         additionalProperties => {
1445             type => [ "boolean", "object"],
1446             description => "This provides a default property definition for all properties that are not explicitly defined in an object type definition.",
1447             optional => 1,
1448             default => {},
1449         },
1450         minimum => {
1451             type => "number",
1452             optional => 1,
1453             description => "This indicates the minimum value for the instance property when the type of the instance value is a number.",
1454         },
1455         maximum => {
1456             type => "number",
1457             optional => 1,
1458             description => "This indicates the maximum value for the instance property when the type of the instance value is a number.",
1459         },
1460         minLength => {
1461             type => "integer",
1462             description => "When the instance value is a string, this indicates minimum length of the string",
1463             optional => 1,
1464             minimum => 0,
1465             default => 0,
1466         },
1467         maxLength => {
1468             type => "integer",
1469             description => "When the instance value is a string, this indicates maximum length of the string.",
1470             optional => 1,
1471         },
1472         typetext => {
1473             type => "string",
1474             optional => 1,
1475             description => "A text representation of the type (used to generate documentation).",
1476         },
1477         pattern => {
1478             type => "string",
1479             format => "regex",
1480             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.",
1481             optional => 1,
1482             default => ".*",
1483         },
1484         enum => {
1485             type => "array",
1486             optional => 1,
1487             description => "This provides an enumeration of possible values that are valid for the instance property.",
1488         },
1489         description => {
1490             type => "string",
1491             optional => 1,
1492             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).",
1493         },
1494         verbose_description => {
1495             type => "string",
1496             optional => 1,
1497             description => "This provides a more verbose description.",
1498         },
1499         format_description => {
1500             type => "string",
1501             optional => 1,
1502             description => "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings.",
1503         },
1504         title => {
1505             type => "string",
1506             optional => 1,
1507             description => "This provides the title of the property",
1508         },
1509         renderer => {
1510             type => "string",
1511             optional => 1,
1512             description => "This is used to provide rendering hints to format cli command output.",
1513         },
1514         requires => {
1515             type => [ "string", "object" ],
1516             optional => 1,
1517             description => "indicates a required property or a schema that must be validated if this property is present",
1518         },
1519         format => {
1520             type => [ "string", "object" ],
1521             optional => 1,
1522             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",
1523         },
1524         default_key => {
1525             type => "boolean",
1526             optional => 1,
1527             description => "Whether this is the default key in a comma separated list property string.",
1528         },
1529         alias => {
1530             type => 'string',
1531             optional => 1,
1532             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.",
1533         },
1534         keyAlias => {
1535             type => 'string',
1536             optional => 1,
1537             description => "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'.",
1538             requires => 'alias',
1539         },
1540         default => {
1541             type => "any",
1542             optional => 1,
1543             description => "This indicates the default for the instance property."
1544         },
1545         completion => {
1546             type => 'coderef',
1547             description => "Bash completion function. This function should return a list of possible values.",
1548             optional => 1,
1549         },
1550         disallow => {
1551             type => "object",
1552             optional => 1,
1553             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.",
1554         },
1555         extends => {
1556             type => "object",
1557             optional => 1,
1558             description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
1559             default => {},
1560         },
1561         # this is from hyper schema
1562         links => {
1563             type => "array",
1564             description => "This defines the link relations of the instance objects",
1565             optional => 1,
1566             items => {
1567                 type => "object",
1568                 properties => {
1569                     href => {
1570                         type => "string",
1571                         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",
1572                     },
1573                     rel => {
1574                         type => "string",
1575                         description => "This is the name of the link relation",
1576                         optional => 1,
1577                         default => "full",
1578                     },
1579                     method => {
1580                         type => "string",
1581                         description => "For submission links, this defines the method that should be used to access the target resource",
1582                         optional => 1,
1583                         default => "GET",
1584                     },
1585                 },
1586             },
1587         },
1588         print_width => {
1589             type => "integer",
1590             description => "For CLI context, this defines the maximal width to print before truncating",
1591             optional => 1,
1592         },
1593     }
1594 };
1595
1596 my $default_schema = Storable::dclone($default_schema_noref);
1597
1598 $default_schema->{properties}->{properties}->{additionalProperties} = $default_schema;
1599 $default_schema->{properties}->{additionalProperties}->{properties} = $default_schema->{properties};
1600 $default_schema->{properties}->{oneOf}->{items}->{properties} = $default_schema->{properties};
1601
1602 $default_schema->{properties}->{items}->{properties} = $default_schema->{properties};
1603 $default_schema->{properties}->{items}->{additionalProperties} = 0;
1604
1605 $default_schema->{properties}->{disallow}->{properties} = $default_schema->{properties};
1606 $default_schema->{properties}->{disallow}->{additionalProperties} = 0;
1607
1608 $default_schema->{properties}->{requires}->{properties} = $default_schema->{properties};
1609 $default_schema->{properties}->{requires}->{additionalProperties} = 0;
1610
1611 $default_schema->{properties}->{extends}->{properties} = $default_schema->{properties};
1612 $default_schema->{properties}->{extends}->{additionalProperties} = 0;
1613
1614 my $method_schema = {
1615     type => "object",
1616     additionalProperties => 0,
1617     properties => {
1618         description => {
1619             description => "This a description of the method",
1620             optional => 1,
1621         },
1622         name => {
1623             type =>  'string',
1624             description => "This indicates the name of the function to call.",
1625             optional => 1,
1626             requires => {
1627                 additionalProperties => 1,
1628                 properties => {
1629                     name => {},
1630                     description => {},
1631                     code => {},
1632                     method => {},
1633                     parameters => {},
1634                     path => {},
1635                     parameters => {},
1636                     returns => {},
1637                 }
1638             },
1639         },
1640         method => {
1641             type =>  'string',
1642             description => "The HTTP method name.",
1643             enum => [ 'GET', 'POST', 'PUT', 'DELETE' ],
1644             optional => 1,
1645         },
1646         protected => {
1647             type => 'boolean',
1648             description => "Method needs special privileges - only pvedaemon can execute it",
1649             optional => 1,
1650         },
1651         allowtoken => {
1652             type => 'boolean',
1653             description => "Method is available for clients authenticated using an API token.",
1654             optional => 1,
1655             default => 1,
1656         },
1657         download => {
1658             type => 'boolean',
1659             description => "Method downloads the file content (filename is the return value of the method).",
1660             optional => 1,
1661         },
1662         proxyto => {
1663             type =>  'string',
1664             description => "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
1665             optional => 1,
1666         },
1667         proxyto_callback => {
1668             type =>  'coderef',
1669             description => "A function which is called to resolve the proxyto attribute. The default implementation returns the value of the 'proxyto' parameter.",
1670             optional => 1,
1671         },
1672         permissions => {
1673             type => 'object',
1674             description => "Required access permissions. By default only 'root' is allowed to access this method.",
1675             optional => 1,
1676             additionalProperties => 0,
1677             properties => {
1678                 description => {
1679                      description => "Describe access permissions.",
1680                      optional => 1,
1681                 },
1682                 user => {
1683                     description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
1684                     type => 'string',
1685                     enum => ['all', 'world'],
1686                     optional => 1,
1687                 },
1688                 check => {
1689                     description => "Array of permission checks (prefix notation).",
1690                     type => 'array',
1691                     optional => 1
1692                 },
1693             },
1694         },
1695         match_name => {
1696             description => "Used internally",
1697             optional => 1,
1698         },
1699         match_re => {
1700             description => "Used internally",
1701             optional => 1,
1702         },
1703         path => {
1704             type =>  'string',
1705             description => "path for URL matching (uri template)",
1706         },
1707         fragmentDelimiter => {
1708             type => 'string',
1709             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.",
1710             optional => 1,
1711         },
1712         parameters => {
1713             type => 'object',
1714             description => "JSON Schema for parameters.",
1715             optional => 1,
1716         },
1717         returns => {
1718             type => 'object',
1719             description => "JSON Schema for return value.",
1720             optional => 1,
1721         },
1722         code => {
1723             type => 'coderef',
1724             description => "method implementation (code reference)",
1725             optional => 1,
1726         },
1727         subclass => {
1728             type => 'string',
1729             description => "Delegate call to this class (perl class string).",
1730             optional => 1,
1731             requires => {
1732                 additionalProperties => 0,
1733                 properties => {
1734                     subclass => {},
1735                     path => {},
1736                     match_name => {},
1737                     match_re => {},
1738                     fragmentDelimiter => { optional => 1 }
1739                 }
1740             },
1741         },
1742     },
1743
1744 };
1745
1746 sub validate_schema {
1747     my ($schema) = @_;
1748
1749     my $errmsg = "internal error - unable to verify schema\n";
1750     validate($schema, $default_schema, $errmsg);
1751 }
1752
1753 sub validate_method_info {
1754     my $info = shift;
1755
1756     my $errmsg = "internal error - unable to verify method info\n";
1757     validate($info, $method_schema, $errmsg);
1758
1759     validate_schema($info->{parameters}) if $info->{parameters};
1760     validate_schema($info->{returns}) if $info->{returns};
1761 }
1762
1763 # run a self test on load
1764 # make sure we can verify the default schema
1765 validate_schema($default_schema_noref);
1766 validate_schema($method_schema);
1767
1768 # and now some utility methods (used by pve api)
1769 sub method_get_child_link {
1770     my ($info) = @_;
1771
1772     return undef if !$info;
1773
1774     my $schema = $info->{returns};
1775     return undef if !$schema || !$schema->{type} || $schema->{type} ne 'array';
1776
1777     my $links = $schema->{links};
1778     return undef if !$links;
1779
1780     my $found;
1781     foreach my $lnk (@$links) {
1782         if ($lnk->{href} && $lnk->{rel} && ($lnk->{rel} eq 'child')) {
1783             $found = $lnk;
1784             last;
1785         }
1786     }
1787
1788     return $found;
1789 }
1790
1791 # a way to parse command line parameters, using a
1792 # schema to configure Getopt::Long
1793 sub get_options {
1794     my ($schema, $args, $arg_param, $fixed_param, $param_mapping_hash) = @_;
1795
1796     if (!$schema || !$schema->{properties}) {
1797         raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1798             if scalar(@$args) != 0;
1799         return {};
1800     }
1801
1802     my $list_param;
1803     if ($arg_param && !ref($arg_param)) {
1804         my $pd = $schema->{properties}->{$arg_param};
1805         die "expected list format $pd->{format}"
1806             if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
1807         $list_param = $arg_param;
1808     }
1809
1810     my @interactive = ();
1811     my @getopt = ();
1812     foreach my $prop (keys %{$schema->{properties}}) {
1813         my $pd = $schema->{properties}->{$prop};
1814         next if $list_param && $prop eq $list_param;
1815         next if defined($fixed_param->{$prop});
1816
1817         my $mapping = $param_mapping_hash->{$prop};
1818         if ($mapping && $mapping->{interactive}) {
1819             # interactive parameters such as passwords: make the argument
1820             # optional and call the mapping function afterwards.
1821             push @getopt, "$prop:s";
1822             push @interactive, [$prop, $mapping->{func}];
1823         } elsif ($pd->{type} && $pd->{type} eq 'boolean') {
1824             push @getopt, "$prop:s";
1825         } else {
1826             if ($pd->{format} && $pd->{format} =~ m/-list/) {
1827                 push @getopt, "$prop=s@";
1828             } elsif ($pd->{type} && $pd->{type} eq 'array') {
1829                 push @getopt, "$prop=s@";
1830             } else {
1831                 push @getopt, "$prop=s";
1832             }
1833         }
1834     }
1835
1836     Getopt::Long::Configure('prefix_pattern=(--|-)');
1837
1838     my $opts = {};
1839     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
1840         if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
1841
1842     if (@$args) {
1843         if ($list_param) {
1844             $opts->{$list_param} = $args;
1845             $args = [];
1846         } elsif (ref($arg_param)) {
1847             for (my $i = 0; $i < scalar(@$arg_param); $i++) {
1848                 my $arg_name = $arg_param->[$i];
1849                 if ($opts->{'extra-args'}) {
1850                     raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
1851                 }
1852                 if ($arg_name eq 'extra-args') {
1853                     $opts->{'extra-args'} = $args;
1854                     $args = [];
1855                     next;
1856                 }
1857                 if (!@$args) {
1858                     # check if all left-over arg_param are optional, else we
1859                     # must die as the mapping is then ambigious
1860                     for (; $i < scalar(@$arg_param); $i++) {
1861                         my $prop = $arg_param->[$i];
1862                         raise("not enough arguments\n", code => HTTP_BAD_REQUEST)
1863                             if !$schema->{properties}->{$prop}->{optional};
1864                     }
1865                     if ($arg_param->[-1] eq 'extra-args') {
1866                         $opts->{'extra-args'} = [];
1867                     }
1868                     last;
1869                 }
1870                 $opts->{$arg_name} = shift @$args;
1871             }
1872             raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
1873         } else {
1874             raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1875                 if scalar(@$args) != 0;
1876         }
1877     } else {
1878         if (ref($arg_param)) {
1879             foreach my $arg_name (@$arg_param) {
1880                 if ($arg_name eq 'extra-args') {
1881                     $opts->{'extra-args'} = [];
1882                 } elsif (!$schema->{properties}->{$arg_name}->{optional}) {
1883                     raise("not enough arguments\n", code => HTTP_BAD_REQUEST);
1884                 }
1885             }
1886         }
1887     }
1888
1889     foreach my $entry (@interactive) {
1890         my ($opt, $func) = @$entry;
1891         my $pd = $schema->{properties}->{$opt};
1892         my $value = $opts->{$opt};
1893         if (defined($value) || !$pd->{optional}) {
1894             $opts->{$opt} = $func->($value);
1895         }
1896     }
1897
1898     # decode after Getopt as we are not sure how well it handles unicode
1899     foreach my $p (keys %$opts) {
1900         if (!ref($opts->{$p})) {
1901             $opts->{$p} = decode('locale', $opts->{$p});
1902         } elsif (ref($opts->{$p}) eq 'ARRAY') {
1903             my $tmp = [];
1904             foreach my $v (@{$opts->{$p}}) {
1905                 push @$tmp, decode('locale', $v);
1906             }
1907             $opts->{$p} = $tmp;
1908         } elsif (ref($opts->{$p}) eq 'SCALAR') {
1909             $opts->{$p} = decode('locale', $$opts->{$p});
1910         } else {
1911             raise("decoding options failed, unknown reference\n", code => HTTP_BAD_REQUEST);
1912         }
1913     }
1914
1915     foreach my $p (keys %$opts) {
1916         if (my $pd = $schema->{properties}->{$p}) {
1917             if ($pd->{type} && $pd->{type} eq 'boolean') {
1918                 if ($opts->{$p} eq '') {
1919                     $opts->{$p} = 1;
1920                 } elsif (defined(my $bool = parse_boolean($opts->{$p}))) {
1921                     $opts->{$p} = $bool;
1922                 } else {
1923                     raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
1924                 }
1925             } elsif ($pd->{format}) {
1926
1927                 if ($pd->{format} =~ m/-list/) {
1928                     # allow --vmid 100 --vmid 101 and --vmid 100,101
1929                     # allow --dow mon --dow fri and --dow mon,fri
1930                     $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
1931                 }
1932             }
1933         }
1934     }
1935
1936     foreach my $p (keys %$fixed_param) {
1937         $opts->{$p} = $fixed_param->{$p};
1938     }
1939
1940     return $opts;
1941 }
1942
1943 # A way to parse configuration data by giving a json schema
1944 sub parse_config : prototype($$$;$) {
1945     my ($schema, $filename, $raw, $comment_key) = @_;
1946
1947     # do fast check (avoid validate_schema($schema))
1948     die "got strange schema" if !$schema->{type} ||
1949         !$schema->{properties} || $schema->{type} ne 'object';
1950
1951     my $cfg = {};
1952
1953     my $comment_data;
1954     my $handle_comment = sub { $_[0] =~ /^#/ };
1955     if (defined($comment_key)) {
1956         $comment_data = '';
1957         my $comment_re = qr/^\Q$comment_key\E:\s*(.*\S)\s*$/;
1958         $handle_comment = sub {
1959             if ($_[0] =~ /^\#(.*)\s*$/ || $_[0] =~ $comment_re) {
1960                 $comment_data .= PVE::Tools::decode_text($1) . "\n";
1961                 return 1;
1962             }
1963             return undef;
1964         };
1965     }
1966
1967     while ($raw =~ /^\s*(.+?)\s*$/gm) {
1968         my $line = $1;
1969
1970         next if $handle_comment->($line);
1971
1972         if ($line =~ m/^(\S+?):\s*(.*)$/) {
1973             my $key = $1;
1974             my $value = $2;
1975             if ($schema->{properties}->{$key} &&
1976                 $schema->{properties}->{$key}->{type} eq 'boolean') {
1977
1978                 $value = parse_boolean($value) // $value;
1979             }
1980             if (
1981                 $schema->{properties}->{$key}
1982                 && $schema->{properties}->{$key}->{type} eq 'array'
1983             ) {
1984
1985                 $cfg->{$key} //= [];
1986                 push $cfg->{$key}->@*, $value;
1987                 next;
1988             }
1989             $cfg->{$key} = $value;
1990         } else {
1991             warn "ignore config line: $line\n"
1992         }
1993     }
1994
1995     if (defined($comment_data)) {
1996         $cfg->{$comment_key} = $comment_data;
1997     }
1998
1999     my $errors = {};
2000     check_prop($cfg, $schema, '', $errors);
2001
2002     foreach my $k (keys %$errors) {
2003         warn "parse error in '$filename' - '$k': $errors->{$k}\n";
2004         delete $cfg->{$k};
2005     }
2006
2007     return $cfg;
2008 }
2009
2010 # generate simple key/value file
2011 sub dump_config {
2012     my ($schema, $filename, $cfg) = @_;
2013
2014     # do fast check (avoid validate_schema($schema))
2015     die "got strange schema" if !$schema->{type} ||
2016         !$schema->{properties} || $schema->{type} ne 'object';
2017
2018     validate($cfg, $schema, "validation error in '$filename'\n");
2019
2020     my $data = '';
2021
2022     foreach my $k (sort keys %$cfg) {
2023         $data .= "$k: $cfg->{$k}\n";
2024     }
2025
2026     return $data;
2027 }
2028
2029 # helpers used to generate our manual pages
2030
2031 my $find_schema_default_key = sub {
2032     my ($format) = @_;
2033
2034     my $default_key;
2035     my $keyAliasProps = {};
2036
2037     foreach my $key (keys %$format) {
2038         my $phash = $format->{$key};
2039         if ($phash->{default_key}) {
2040             die "multiple default keys in schema ($default_key, $key)\n"
2041                 if defined($default_key);
2042             die "default key '$key' is an alias - this is not allowed\n"
2043                 if defined($phash->{alias});
2044             die "default key '$key' with keyAlias attribute is not allowed\n"
2045                 if $phash->{keyAlias};
2046             $default_key = $key;
2047         }
2048         my $key_alias = $phash->{keyAlias};
2049         die "found keyAlias without 'alias definition for '$key'\n"
2050             if $key_alias && !$phash->{alias};
2051
2052         if ($phash->{alias} && $key_alias) {
2053             die "inconsistent keyAlias '$key_alias' definition"
2054                 if defined($keyAliasProps->{$key_alias}) &&
2055                 $keyAliasProps->{$key_alias} ne $phash->{alias};
2056             $keyAliasProps->{$key_alias} = $phash->{alias};
2057         }
2058     }
2059
2060     return wantarray ? ($default_key, $keyAliasProps) : $default_key;
2061 };
2062
2063 sub generate_typetext {
2064     my ($format, $list_enums) = @_;
2065
2066     my ($default_key, $keyAliasProps) = &$find_schema_default_key($format);
2067
2068     my $res = '';
2069     my $add_sep = 0;
2070
2071     my $add_option_string = sub {
2072         my ($text, $optional) = @_;
2073
2074         if ($add_sep) {
2075             $text = ",$text";
2076             $res .= ' ';
2077         }
2078         $text = "[$text]" if $optional;
2079         $res .= $text;
2080         $add_sep = 1;
2081     };
2082
2083     my $format_key_value = sub {
2084         my ($key, $phash) = @_;
2085
2086         die "internal error" if defined($phash->{alias});
2087
2088         my $keytext = $key;
2089
2090         my $typetext = '';
2091
2092         if (my $desc = $phash->{format_description}) {
2093             $typetext .= "<$desc>";
2094         } elsif (my $text = $phash->{typetext}) {
2095             $typetext .= $text;
2096         } elsif (my $enum = $phash->{enum}) {
2097             if ($list_enums || (scalar(@$enum) <= 3)) {
2098                 $typetext .= '<' . join('|', @$enum) . '>';
2099             } else {
2100                 $typetext .= '<enum>';
2101             }
2102         } elsif ($phash->{type} eq 'boolean') {
2103             $typetext .= '<1|0>';
2104         } elsif ($phash->{type} eq 'integer') {
2105             $typetext .= '<integer>';
2106         } elsif ($phash->{type} eq 'number') {
2107             $typetext .= '<number>';
2108         } else {
2109             die "internal error: neither format_description nor typetext found for option '$key'";
2110         }
2111
2112         if (defined($default_key) && ($default_key eq $key)) {
2113             &$add_option_string("[$keytext=]$typetext", $phash->{optional});
2114         } else {
2115             &$add_option_string("$keytext=$typetext", $phash->{optional});
2116         }
2117     };
2118
2119     my $done = {};
2120
2121     my $cond_add_key = sub {
2122         my ($key) = @_;
2123
2124         return if $done->{$key}; # avoid duplicates
2125
2126         $done->{$key} = 1;
2127
2128         my $phash = $format->{$key};
2129
2130         return if !$phash; # should not happen
2131
2132         return if $phash->{alias};
2133
2134         &$format_key_value($key, $phash);
2135
2136     };
2137
2138     &$cond_add_key($default_key) if defined($default_key);
2139
2140     # add required keys first
2141     foreach my $key (sort keys %$format) {
2142         my $phash = $format->{$key};
2143         &$cond_add_key($key) if $phash && !$phash->{optional};
2144     }
2145
2146     # add the rest
2147     foreach my $key (sort keys %$format) {
2148         &$cond_add_key($key);
2149     }
2150
2151     foreach my $keyAlias (sort keys %$keyAliasProps) {
2152         &$add_option_string("<$keyAlias>=<$keyAliasProps->{$keyAlias }>", 1);
2153     }
2154
2155     return $res;
2156 }
2157
2158 sub print_property_string {
2159     my ($data, $format, $skip, $path) = @_;
2160
2161     my $validator;
2162     if (ref($format) ne 'HASH') {
2163         my $schema = get_format($format);
2164         die "not a valid format: $format\n" if !$schema;
2165         # named formats can have validators attached
2166         $validator = $format_validators->{$format};
2167         $format = $schema;
2168     }
2169
2170     my $errors = {};
2171     check_object($path, $format, $data, undef, $errors);
2172     if (scalar(%$errors)) {
2173         raise "format error", errors => $errors;
2174     }
2175
2176     $data = $validator->($data) if $validator;
2177
2178     my ($default_key, $keyAliasProps) = &$find_schema_default_key($format);
2179
2180     my $res = '';
2181     my $add_sep = 0;
2182
2183     my $add_option_string = sub {
2184         my ($text) = @_;
2185
2186         $res .= ',' if $add_sep;
2187         $res .= $text;
2188         $add_sep = 1;
2189     };
2190
2191     my $format_value = sub {
2192         my ($key, $value, $format) = @_;
2193
2194         if (defined($format) && ($format eq 'disk-size')) {
2195             return format_size($value);
2196         } else {
2197             die "illegal value with commas for $key\n" if $value =~ /,/;
2198             return $value;
2199         }
2200     };
2201
2202     my $done = { map { $_ => 1 } @$skip };
2203
2204     my $cond_add_key = sub {
2205         my ($key, $isdefault) = @_;
2206
2207         return if $done->{$key}; # avoid duplicates
2208
2209         $done->{$key} = 1;
2210
2211         my $value = $data->{$key};
2212
2213         return if !defined($value);
2214
2215         my $phash = $format->{$key};
2216
2217         # try to combine values if we have key aliases
2218         if (my $combine = $keyAliasProps->{$key}) {
2219             if (defined(my $combine_value = $data->{$combine})) {
2220                 my $combine_format = $format->{$combine}->{format};
2221                 my $value_str = &$format_value($key, $value, $phash->{format});
2222                 my $combine_str = &$format_value($combine, $combine_value, $combine_format);
2223                 &$add_option_string("${value_str}=${combine_str}");
2224                 $done->{$combine} = 1;
2225                 return;
2226             }
2227         }
2228
2229         if ($phash && $phash->{alias}) {
2230             $phash = $format->{$phash->{alias}};
2231         }
2232
2233         die "invalid key '$key'\n" if !$phash;
2234         die "internal error" if defined($phash->{alias});
2235
2236         my $value_str = &$format_value($key, $value, $phash->{format});
2237         if ($isdefault) {
2238             &$add_option_string($value_str);
2239         } else {
2240             &$add_option_string("$key=${value_str}");
2241         }
2242     };
2243
2244     # add default key first
2245     &$cond_add_key($default_key, 1) if defined($default_key);
2246
2247     # add required keys first
2248     foreach my $key (sort keys %$data) {
2249         my $phash = $format->{$key};
2250         &$cond_add_key($key) if $phash && !$phash->{optional};
2251     }
2252
2253     # add the rest
2254     foreach my $key (sort keys %$data) {
2255         &$cond_add_key($key);
2256     }
2257
2258     return $res;
2259 }
2260
2261 sub schema_get_type_text {
2262     my ($phash, $style) = @_;
2263
2264     my $type = $phash->{type} || 'string';
2265
2266     if ($phash->{typetext}) {
2267         return $phash->{typetext};
2268     } elsif ($phash->{format_description}) {
2269         return "<$phash->{format_description}>";
2270     } elsif ($phash->{enum}) {
2271         return "<" . join(' | ', sort @{$phash->{enum}}) . ">";
2272     } elsif ($phash->{pattern}) {
2273         return $phash->{pattern};
2274     } elsif ($type eq 'integer' || $type eq 'number') {
2275         # NOTE: always access values as number (avoid converion to string)
2276         if (defined($phash->{minimum}) && defined($phash->{maximum})) {
2277             return "<$type> (" . ($phash->{minimum} + 0) . " - " .
2278                 ($phash->{maximum} + 0) . ")";
2279         } elsif (defined($phash->{minimum})) {
2280             return "<$type> (" . ($phash->{minimum} + 0) . " - N)";
2281         } elsif (defined($phash->{maximum})) {
2282             return "<$type> (-N - " . ($phash->{maximum} + 0) . ")";
2283         }
2284     } elsif ($type eq 'string') {
2285         if (my $format = $phash->{format}) {
2286             $format = get_format($format) if ref($format) ne 'HASH';
2287             if (ref($format) eq 'HASH') {
2288                 my $list_enums = 0;
2289                 $list_enums = 1 if $style && $style eq 'config-sub';
2290                 return generate_typetext($format, $list_enums);
2291             }
2292         }
2293     }
2294
2295     return "<$type>";
2296 }
2297
2298 1;