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