src/PVE/JSONSchema.pm

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