src/PVE/JSONSchema.pm

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