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