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