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