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 Devel::Cycle -quiet; # todo: remove?
   8 use PVE::Tools qw(split_list $IPV6RE $IPV4RE);
   9 use PVE::Exception qw(raise);
  10 use HTTP::Status qw(:constants);
  11 use Net::IP qw(:PROC);
  12
  13 use base 'Exporter';
  14
  15 our @EXPORT_OK = qw(
  16 register_standard_option
  17 get_standard_option
  18 );
  19
  20 # Note: This class implements something similar to JSON schema, but it is not 100% complete.
  21 # see: http://tools.ietf.org/html/draft-zyp-json-schema-02
  22 # see: http://json-schema.org/
  23
  24 # the code is similar to the javascript parser from http://code.google.com/p/jsonschema/
  25
  26 my $standard_options = {};
  27 sub register_standard_option {
  28     my ($name, $schema) = @_;
  29
  30     die "standard option '$name' already registered\n"
  31         if $standard_options->{$name};
  32
  33     $standard_options->{$name} = $schema;
  34 }
  35
  36 sub get_standard_option {
  37     my ($name, $base) = @_;
  38
  39     my $std =  $standard_options->{$name};
  40     die "no such standard option '$name'\n" if !$std;
  41
  42     my $res = $base || {};
  43
  44     foreach my $opt (keys %$std) {
  45         next if defined($res->{$opt});
  46         $res->{$opt} = $std->{$opt};
  47     }
  48
  49     return $res;
  50 };
  51
  52 register_standard_option('pve-vmid', {
  53     description => "The (unique) ID of the VM.",
  54     type => 'integer', format => 'pve-vmid',
  55     minimum => 1
  56 });
  57
  58 register_standard_option('pve-node', {
  59     description => "The cluster node name.",
  60     type => 'string', format => 'pve-node',
  61 });
  62
  63 register_standard_option('pve-node-list', {
  64     description => "List of cluster node names.",
  65     type => 'string', format => 'pve-node-list',
  66 });
  67
  68 register_standard_option('pve-iface', {
  69     description => "Network interface name.",
  70     type => 'string', format => 'pve-iface',
  71     minLength => 2, maxLength => 20,
  72 });
  73
  74 PVE::JSONSchema::register_standard_option('pve-storage-id', {
  75     description => "The storage identifier.",
  76     type => 'string', format => 'pve-storage-id',
  77 });
  78
  79 PVE::JSONSchema::register_standard_option('pve-config-digest', {
  80     description => 'Prevent changes if current configuration file has different SHA1 digest. This can be used to prevent concurrent modifications.',
  81     type => 'string',
  82     optional => 1,
  83     maxLength => 40, # sha1 hex digest lenght is 40
  84 });
  85
  86 PVE::JSONSchema::register_standard_option('extra-args', {
  87     description => "Extra arguments as array",
  88     type => 'array',
  89     items => { type => 'string' },
  90     optional => 1
  91 });
  92
  93 my $format_list = {};
  94
  95 sub register_format {
  96     my ($format, $code) = @_;
  97
  98     die "JSON schema format '$format' already registered\n"
  99         if $format_list->{$format};
 100
 101     $format_list->{$format} = $code;
 102 }
 103
 104 # register some common type for pve
 105
 106 register_format('string', sub {}); # allow format => 'string-list'
 107
 108 register_format('pve-configid', \&pve_verify_configid);
 109 sub pve_verify_configid {
 110     my ($id, $noerr) = @_;
 111
 112     if ($id !~ m/^[a-z][a-z0-9_]+$/i) {
 113         return undef if $noerr;
 114         die "invalid configuration ID '$id'\n";
 115     }
 116     return $id;
 117 }
 118
 119 PVE::JSONSchema::register_format('pve-storage-id', \&parse_storage_id);
 120 sub parse_storage_id {
 121     my ($storeid, $noerr) = @_;
 122
 123     if ($storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i) {
 124         return undef if $noerr;
 125         die "storage ID '$storeid' contains illegal characters\n";
 126     }
 127     return $storeid;
 128 }
 129
 130
 131 register_format('pve-vmid', \&pve_verify_vmid);
 132 sub pve_verify_vmid {
 133     my ($vmid, $noerr) = @_;
 134
 135     if ($vmid !~ m/^[1-9][0-9]+$/) {
 136         return undef if $noerr;
 137         die "value does not look like a valid VM ID\n";
 138     }
 139     return $vmid;
 140 }
 141
 142 register_format('pve-node', \&pve_verify_node_name);
 143 sub pve_verify_node_name {
 144     my ($node, $noerr) = @_;
 145
 146     if ($node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/) {
 147         return undef if $noerr;
 148         die "value does not look like a valid node name\n";
 149     }
 150     return $node;
 151 }
 152
 153 register_format('ipv4', \&pve_verify_ipv4);
 154 sub pve_verify_ipv4 {
 155     my ($ipv4, $noerr) = @_;
 156
 157     if ($ipv4 !~ m/^(?:$IPV4RE)$/) {
 158         return undef if $noerr;
 159         die "value does not look like a valid IPv4 address\n";
 160     }
 161     return $ipv4;
 162 }
 163
 164 register_format('ipv6', \&pve_verify_ipv6);
 165 sub pve_verify_ipv6 {
 166     my ($ipv6, $noerr) = @_;
 167
 168     if ($ipv6 !~ m/^(?:$IPV6RE)$/) {
 169         return undef if $noerr;
 170         die "value does not look like a valid IPv6 address\n";
 171     }
 172     return $ipv6;
 173 }
 174
 175 register_format('ip', \&pve_verify_ip);
 176 sub pve_verify_ip {
 177     my ($ip, $noerr) = @_;
 178
 179     if ($ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/) {
 180         return undef if $noerr;
 181         die "value does not look like a valid IP address\n";
 182     }
 183     return $ip;
 184 }
 185
 186 my $ipv4_mask_hash = {
 187     '128.0.0.0' => 1,
 188     '192.0.0.0' => 2,
 189     '224.0.0.0' => 3,
 190     '240.0.0.0' => 4,
 191     '248.0.0.0' => 5,
 192     '252.0.0.0' => 6,
 193     '254.0.0.0' => 7,
 194     '255.0.0.0' => 8,
 195     '255.128.0.0' => 9,
 196     '255.192.0.0' => 10,
 197     '255.224.0.0' => 11,
 198     '255.240.0.0' => 12,
 199     '255.248.0.0' => 13,
 200     '255.252.0.0' => 14,
 201     '255.254.0.0' => 15,
 202     '255.255.0.0' => 16,
 203     '255.255.128.0' => 17,
 204     '255.255.192.0' => 18,
 205     '255.255.224.0' => 19,
 206     '255.255.240.0' => 20,
 207     '255.255.248.0' => 21,
 208     '255.255.252.0' => 22,
 209     '255.255.254.0' => 23,
 210     '255.255.255.0' => 24,
 211     '255.255.255.128' => 25,
 212     '255.255.255.192' => 26,
 213     '255.255.255.224' => 27,
 214     '255.255.255.240' => 28,
 215     '255.255.255.248' => 29,
 216     '255.255.255.252' => 30
 217 };
 218
 219 register_format('ipv4mask', \&pve_verify_ipv4mask);
 220 sub pve_verify_ipv4mask {
 221     my ($mask, $noerr) = @_;
 222
 223     if (!defined($ipv4_mask_hash->{$mask})) {
 224         return undef if $noerr;
 225         die "value does not look like a valid IP netmask\n";
 226     }
 227     return $mask;
 228 }
 229
 230 register_format('CIDR', \&pve_verify_cidr);
 231 sub pve_verify_cidr {
 232     my ($cidr, $noerr) = @_;
 233
 234     if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 < 32)) {
 235         return $cidr;
 236     } elsif ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 <= 120)) {
 237         return $cidr;
 238     }
 239
 240     return undef if $noerr;
 241     die "value does not look like a valid CIDR network\n";
 242 }
 243
 244 register_format('email', \&pve_verify_email);
 245 sub pve_verify_email {
 246     my ($email, $noerr) = @_;
 247
 248     # we use same regex as in Utils.js
 249     if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/) {
 250            return undef if $noerr;
 251            die "value does not look like a valid email address\n";
 252     }
 253     return $email;
 254 }
 255
 256 register_format('dns-name', \&pve_verify_dns_name);
 257 sub pve_verify_dns_name {
 258     my ($name, $noerr) = @_;
 259
 260     my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)";
 261
 262     if ($name !~ /^(${namere}\.)*${namere}$/) {
 263            return undef if $noerr;
 264            die "value does not look like a valid DNS name\n";
 265     }
 266     return $name;
 267 }
 268
 269 # network interface name
 270 register_format('pve-iface', \&pve_verify_iface);
 271 sub pve_verify_iface {
 272     my ($id, $noerr) = @_;
 273
 274     if ($id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i) {
 275         return undef if $noerr;
 276         die "invalid network interface name '$id'\n";
 277     }
 278     return $id;
 279 }
 280
 281 # general addresses by name or IP
 282 register_format('address', \&pve_verify_address);
 283 sub pve_verify_address {
 284     my ($addr, $noerr) = @_;
 285
 286     if (!(pve_verify_ip($addr, 1) ||
 287           pve_verify_dns_name($addr, 1)))
 288     {
 289            return undef if $noerr;
 290            die "value does not look like a valid address: $addr\n";
 291     }
 292     return $addr;
 293 }
 294
 295 register_standard_option('spice-proxy', {
 296     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 resonable setting is to use same node you use to connect to the API (This is window.location.hostname for the JS GUI).",
 297     type => 'string', format => 'address',
 298 });
 299
 300 register_standard_option('remote-viewer-config', {
 301     description => "Returned values can be directly passed to the 'remote-viewer' application.",
 302     additionalProperties => 1,
 303     properties => {
 304         type => { type => 'string' },
 305         password => { type => 'string' },
 306         proxy => { type => 'string' },
 307         host => { type => 'string' },
 308         'tls-port' => { type => 'integer' },
 309     },
 310 });
 311
 312 register_format('pve-startup-order', \&pve_verify_startup_order);
 313 sub pve_verify_startup_order {
 314     my ($value, $noerr) = @_;
 315
 316     return $value if pve_parse_startup_order($value);
 317
 318     return undef if $noerr;
 319
 320     die "unable to parse startup options\n";
 321 }
 322
 323 sub pve_parse_startup_order {
 324     my ($value) = @_;
 325
 326     return undef if !$value;
 327
 328     my $res = {};
 329
 330     foreach my $p (split(/,/, $value)) {
 331         next if $p =~ m/^\s*$/;
 332
 333         if ($p =~ m/^(order=)?(\d+)$/) {
 334             $res->{order} = $2;
 335         } elsif ($p =~ m/^up=(\d+)$/) {
 336             $res->{up} = $1;
 337         } elsif ($p =~ m/^down=(\d+)$/) {
 338             $res->{down} = $1;
 339         } else {
 340             return undef;
 341         }
 342     }
 343
 344     return $res;
 345 }
 346
 347 PVE::JSONSchema::register_standard_option('pve-startup-order', {
 348     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.",
 349     optional => 1,
 350     type => 'string', format => 'pve-startup-order',
 351     typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
 352 });
 353
 354 sub check_format {
 355     my ($format, $value) = @_;
 356
 357     return if $format eq 'regex';
 358
 359     if ($format =~ m/^(.*)-a?list$/) {
 360
 361         my $code = $format_list->{$1};
 362
 363         die "undefined format '$format'\n" if !$code;
 364
 365         # Note: we allow empty lists
 366         foreach my $v (split_list($value)) {
 367             &$code($v);
 368         }
 369
 370     } elsif ($format =~ m/^(.*)-opt$/) {
 371
 372         my $code = $format_list->{$1};
 373
 374         die "undefined format '$format'\n" if !$code;
 375
 376         return if !$value; # allow empty string
 377
 378         &$code($value);
 379
 380    } else {
 381
 382         my $code = $format_list->{$format};
 383
 384         die "undefined format '$format'\n" if !$code;
 385
 386         &$code($value);
 387     }
 388 }
 389
 390 sub add_error {
 391     my ($errors, $path, $msg) = @_;
 392
 393     $path = '_root' if !$path;
 394
 395     if ($errors->{$path}) {
 396         $errors->{$path} = join ('\n', $errors->{$path}, $msg);
 397     } else {
 398         $errors->{$path} = $msg;
 399     }
 400 }
 401
 402 sub is_number {
 403     my $value = shift;
 404
 405     # see 'man perlretut'
 406     return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
 407 }
 408
 409 sub is_integer {
 410     my $value = shift;
 411
 412     return $value =~ m/^[+-]?\d+$/;
 413 }
 414
 415 sub check_type {
 416     my ($path, $type, $value, $errors) = @_;
 417
 418     return 1 if !$type;
 419
 420     if (!defined($value)) {
 421         return 1 if $type eq 'null';
 422         die "internal error"
 423     }
 424
 425     if (my $tt = ref($type)) {
 426         if ($tt eq 'ARRAY') {
 427             foreach my $t (@$type) {
 428                 my $tmperr = {};
 429                 check_type($path, $t, $value, $tmperr);
 430                 return 1 if !scalar(%$tmperr);
 431             }
 432             my $ttext = join ('|', @$type);
 433             add_error($errors, $path, "type check ('$ttext') failed");
 434             return undef;
 435         } elsif ($tt eq 'HASH') {
 436             my $tmperr = {};
 437             check_prop($value, $type, $path, $tmperr);
 438             return 1 if !scalar(%$tmperr);
 439             add_error($errors, $path, "type check failed");
 440             return undef;
 441         } else {
 442             die "internal error - got reference type '$tt'";
 443         }
 444
 445     } else {
 446
 447         return 1 if $type eq 'any';
 448
 449         if ($type eq 'null') {
 450             if (defined($value)) {
 451                 add_error($errors, $path, "type check ('$type') failed - value is not null");
 452                 return undef;
 453             }
 454             return 1;
 455         }
 456
 457         my $vt = ref($value);
 458
 459         if ($type eq 'array') {
 460             if (!$vt || $vt ne 'ARRAY') {
 461                 add_error($errors, $path, "type check ('$type') failed");
 462                 return undef;
 463             }
 464             return 1;
 465         } elsif ($type eq 'object') {
 466             if (!$vt || $vt ne 'HASH') {
 467                 add_error($errors, $path, "type check ('$type') failed");
 468                 return undef;
 469             }
 470             return 1;
 471         } elsif ($type eq 'coderef') {
 472             if (!$vt || $vt ne 'CODE') {
 473                 add_error($errors, $path, "type check ('$type') failed");
 474                 return undef;
 475             }
 476             return 1;
 477         } else {
 478             if ($vt) {
 479                 add_error($errors, $path, "type check ('$type') failed - got $vt");
 480                 return undef;
 481             } else {
 482                 if ($type eq 'string') {
 483                     return 1; # nothing to check ?
 484                 } elsif ($type eq 'boolean') {
 485                     #if ($value =~ m/^(1|true|yes|on)$/i) {
 486                     if ($value eq '1') {
 487                         return 1;
 488                     #} elsif ($value =~ m/^(0|false|no|off)$/i) {
 489                     } elsif ($value eq '0') {
 490                         return 0;
 491                     } else {
 492                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
 493                         return undef;
 494                     }
 495                 } elsif ($type eq 'integer') {
 496                     if (!is_integer($value)) {
 497                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
 498                         return undef;
 499                     }
 500                     return 1;
 501                 } elsif ($type eq 'number') {
 502                     if (!is_number($value)) {
 503                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
 504                         return undef;
 505                     }
 506                     return 1;
 507                 } else {
 508                     return 1; # no need to verify unknown types
 509                 }
 510             }
 511         }
 512     }
 513
 514     return undef;
 515 }
 516
 517 sub check_object {
 518     my ($path, $schema, $value, $additional_properties, $errors) = @_;
 519
 520     # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
 521
 522     my $st = ref($schema);
 523     if (!$st || $st ne 'HASH') {
 524         add_error($errors, $path, "Invalid schema definition.");
 525         return;
 526     }
 527
 528     my $vt = ref($value);
 529     if (!$vt || $vt ne 'HASH') {
 530         add_error($errors, $path, "an object is required");
 531         return;
 532     }
 533
 534     foreach my $k (keys %$schema) {
 535         check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors);
 536     }
 537
 538     foreach my $k (keys %$value) {
 539
 540         my $newpath =  $path ? "$path.$k" : $k;
 541
 542         if (my $subschema = $schema->{$k}) {
 543             if (my $requires = $subschema->{requires}) {
 544                 if (ref($requires)) {
 545                     #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
 546                     check_prop($value, $requires, $path, $errors);
 547                 } elsif (!defined($value->{$requires})) {
 548                     add_error($errors, $path ? "$path.$requires" : $requires,
 549                               "missing property - '$newpath' requiers this property");
 550                 }
 551             }
 552
 553             next; # value is already checked above
 554         }
 555
 556         if (defined ($additional_properties) && !$additional_properties) {
 557             add_error($errors, $newpath, "property is not defined in schema " .
 558                       "and the schema does not allow additional properties");
 559             next;
 560         }
 561         check_prop($value->{$k}, $additional_properties, $newpath, $errors)
 562             if ref($additional_properties);
 563     }
 564 }
 565
 566 sub check_prop {
 567     my ($value, $schema, $path, $errors) = @_;
 568
 569     die "internal error - no schema" if !$schema;
 570     die "internal error" if !$errors;
 571
 572     #print "check_prop $path\n" if $value;
 573
 574     my $st = ref($schema);
 575     if (!$st || $st ne 'HASH') {
 576         add_error($errors, $path, "Invalid schema definition.");
 577         return;
 578     }
 579
 580     # if it extends another schema, it must pass that schema as well
 581     if($schema->{extends}) {
 582         check_prop($value, $schema->{extends}, $path, $errors);
 583     }
 584
 585     if (!defined ($value)) {
 586         return if $schema->{type} && $schema->{type} eq 'null';
 587         if (!$schema->{optional}) {
 588             add_error($errors, $path, "property is missing and it is not optional");
 589         }
 590         return;
 591     }
 592
 593     return if !check_type($path, $schema->{type}, $value, $errors);
 594
 595     if ($schema->{disallow}) {
 596         my $tmperr = {};
 597         if (check_type($path, $schema->{disallow}, $value, $tmperr)) {
 598             add_error($errors, $path, "disallowed value was matched");
 599             return;
 600         }
 601     }
 602
 603     if (my $vt = ref($value)) {
 604
 605         if ($vt eq 'ARRAY') {
 606             if ($schema->{items}) {
 607                 my $it = ref($schema->{items});
 608                 if ($it && $it eq 'ARRAY') {
 609                     #die "implement me $path: $vt " . Dumper($schema) ."\n".  Dumper($value);
 610                     die "not implemented";
 611                 } else {
 612                     my $ind = 0;
 613                     foreach my $el (@$value) {
 614                         check_prop($el, $schema->{items}, "${path}[$ind]", $errors);
 615                         $ind++;
 616                     }
 617                 }
 618             }
 619             return;
 620         } elsif ($schema->{properties} || $schema->{additionalProperties}) {
 621             check_object($path, defined($schema->{properties}) ? $schema->{properties} : {},
 622                          $value, $schema->{additionalProperties}, $errors);
 623             return;
 624         }
 625
 626     } else {
 627
 628         if (my $format = $schema->{format}) {
 629             eval { check_format($format, $value); };
 630             if ($@) {
 631                 add_error($errors, $path, "invalid format - $@");
 632                 return;
 633             }
 634         }
 635
 636         if (my $pattern = $schema->{pattern}) {
 637             if ($value !~ m/^$pattern$/) {
 638                 add_error($errors, $path, "value does not match the regex pattern");
 639                 return;
 640             }
 641         }
 642
 643         if (defined (my $max = $schema->{maxLength})) {
 644             if (length($value) > $max) {
 645                 add_error($errors, $path, "value may only be $max characters long");
 646                 return;
 647             }
 648         }
 649
 650         if (defined (my $min = $schema->{minLength})) {
 651             if (length($value) < $min) {
 652                 add_error($errors, $path, "value must be at least $min characters long");
 653                 return;
 654             }
 655         }
 656
 657         if (is_number($value)) {
 658             if (defined (my $max = $schema->{maximum})) {
 659                 if ($value > $max) {
 660                     add_error($errors, $path, "value must have a maximum value of $max");
 661                     return;
 662                 }
 663             }
 664
 665             if (defined (my $min = $schema->{minimum})) {
 666                 if ($value < $min) {
 667                     add_error($errors, $path, "value must have a minimum value of $min");
 668                     return;
 669                 }
 670             }
 671         }
 672
 673         if (my $ea = $schema->{enum}) {
 674
 675             my $found;
 676             foreach my $ev (@$ea) {
 677                 if ($ev eq $value) {
 678                     $found = 1;
 679                     last;
 680                 }
 681             }
 682             if (!$found) {
 683                 add_error($errors, $path, "value '$value' does not have a value in the enumeration '" .
 684                           join(", ", @$ea) . "'");
 685             }
 686         }
 687     }
 688 }
 689
 690 sub validate {
 691     my ($instance, $schema, $errmsg) = @_;
 692
 693     my $errors = {};
 694     $errmsg = "Parameter verification failed.\n" if !$errmsg;
 695
 696     # todo: cycle detection is only needed for debugging, I guess
 697     # we can disable that in the final release
 698     # todo: is there a better/faster way to detect cycles?
 699     my $cycles = 0;
 700     find_cycle($instance, sub { $cycles = 1 });
 701     if ($cycles) {
 702         add_error($errors, undef, "data structure contains recursive cycles");
 703     } elsif ($schema) {
 704         check_prop($instance, $schema, '', $errors);
 705     }
 706
 707     if (scalar(%$errors)) {
 708         raise $errmsg, code => HTTP_BAD_REQUEST, errors => $errors;
 709     }
 710
 711     return 1;
 712 }
 713
 714 my $schema_valid_types = ["string", "object", "coderef", "array", "boolean", "number", "integer", "null", "any"];
 715 my $default_schema_noref = {
 716     description => "This is the JSON Schema for JSON Schemas.",
 717     type => [ "object" ],
 718     additionalProperties => 0,
 719     properties => {
 720         type => {
 721             type => ["string", "array"],
 722             description => "This is a type definition value. This can be a simple type, or a union type",
 723             optional => 1,
 724             default => "any",
 725             items => {
 726                 type => "string",
 727                 enum => $schema_valid_types,
 728             },
 729             enum => $schema_valid_types,
 730         },
 731         optional => {
 732             type => "boolean",
 733             description => "This indicates that the instance property in the instance object is not required.",
 734             optional => 1,
 735             default => 0
 736         },
 737         properties => {
 738             type => "object",
 739             description => "This is a definition for the properties of an object value",
 740             optional => 1,
 741             default => {},
 742         },
 743         items => {
 744             type => "object",
 745             description => "When the value is an array, this indicates the schema to use to validate each item in an array",
 746             optional => 1,
 747             default => {},
 748         },
 749         additionalProperties => {
 750             type => [ "boolean", "object"],
 751             description => "This provides a default property definition for all properties that are not explicitly defined in an object type definition.",
 752             optional => 1,
 753             default => {},
 754         },
 755         minimum => {
 756             type => "number",
 757             optional => 1,
 758             description => "This indicates the minimum value for the instance property when the type of the instance value is a number.",
 759         },
 760         maximum => {
 761             type => "number",
 762             optional => 1,
 763             description => "This indicates the maximum value for the instance property when the type of the instance value is a number.",
 764         },
 765         minLength => {
 766             type => "integer",
 767             description => "When the instance value is a string, this indicates minimum length of the string",
 768             optional => 1,
 769             minimum => 0,
 770             default => 0,
 771         },
 772         maxLength => {
 773             type => "integer",
 774             description => "When the instance value is a string, this indicates maximum length of the string.",
 775             optional => 1,
 776         },
 777         typetext => {
 778             type => "string",
 779             optional => 1,
 780             description => "A text representation of the type (used to generate documentation).",
 781         },
 782         pattern => {
 783             type => "string",
 784             format => "regex",
 785             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.",
 786             optional => 1,
 787             default => ".*",
 788         },
 789
 790         enum => {
 791             type => "array",
 792             optional => 1,
 793             description => "This provides an enumeration of possible values that are valid for the instance property.",
 794         },
 795         description => {
 796             type => "string",
 797             optional => 1,
 798             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).",
 799         },
 800         format_description => {
 801             type => "string",
 802             optional => 1,
 803             description => "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings.",
 804         },
 805         title => {
 806             type => "string",
 807             optional => 1,
 808             description => "This provides the title of the property",
 809         },
 810         requires => {
 811             type => [ "string", "object" ],
 812             optional => 1,
 813             description => "indicates a required property or a schema that must be validated if this property is present",
 814         },
 815         format => {
 816             type => "string",
 817             optional => 1,
 818             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",
 819         },
 820         default => {
 821             type => "any",
 822             optional => 1,
 823             description => "This indicates the default for the instance property."
 824         },
 825         completion => {
 826             type => 'coderef',
 827             description => "Bash completion function. This function should return a list of possible values.",
 828             optional => 1,
 829         },
 830         disallow => {
 831             type => "object",
 832             optional => 1,
 833             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, than this instance is not valid.",
 834         },
 835         extends => {
 836             type => "object",
 837             optional => 1,
 838             description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
 839             default => {},
 840         },
 841         # this is from hyper schema
 842         links => {
 843             type => "array",
 844             description => "This defines the link relations of the instance objects",
 845             optional => 1,
 846             items => {
 847                 type => "object",
 848                 properties => {
 849                     href => {
 850                         type => "string",
 851                         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",
 852                     },
 853                     rel => {
 854                         type => "string",
 855                         description => "This is the name of the link relation",
 856                         optional => 1,
 857                         default => "full",
 858                     },
 859                     method => {
 860                         type => "string",
 861                         description => "For submission links, this defines the method that should be used to access the target resource",
 862                         optional => 1,
 863                         default => "GET",
 864                     },
 865                 },
 866             },
 867         },
 868     }
 869 };
 870
 871 my $default_schema = Storable::dclone($default_schema_noref);
 872
 873 $default_schema->{properties}->{properties}->{additionalProperties} = $default_schema;
 874 $default_schema->{properties}->{additionalProperties}->{properties} = $default_schema->{properties};
 875
 876 $default_schema->{properties}->{items}->{properties} = $default_schema->{properties};
 877 $default_schema->{properties}->{items}->{additionalProperties} = 0;
 878
 879 $default_schema->{properties}->{disallow}->{properties} = $default_schema->{properties};
 880 $default_schema->{properties}->{disallow}->{additionalProperties} = 0;
 881
 882 $default_schema->{properties}->{requires}->{properties} = $default_schema->{properties};
 883 $default_schema->{properties}->{requires}->{additionalProperties} = 0;
 884
 885 $default_schema->{properties}->{extends}->{properties} = $default_schema->{properties};
 886 $default_schema->{properties}->{extends}->{additionalProperties} = 0;
 887
 888 my $method_schema = {
 889     type => "object",
 890     additionalProperties => 0,
 891     properties => {
 892         description => {
 893             description => "This a description of the method",
 894             optional => 1,
 895         },
 896         name => {
 897             type =>  'string',
 898             description => "This indicates the name of the function to call.",
 899             optional => 1,
 900             requires => {
 901                 additionalProperties => 1,
 902                 properties => {
 903                     name => {},
 904                     description => {},
 905                     code => {},
 906                     method => {},
 907                     parameters => {},
 908                     path => {},
 909                     parameters => {},
 910                     returns => {},
 911                 }
 912             },
 913         },
 914         method => {
 915             type =>  'string',
 916             description => "The HTTP method name.",
 917             enum => [ 'GET', 'POST', 'PUT', 'DELETE' ],
 918             optional => 1,
 919         },
 920         protected => {
 921             type => 'boolean',
 922             description => "Method needs special privileges - only pvedaemon can execute it",
 923             optional => 1,
 924         },
 925         proxyto => {
 926             type =>  'string',
 927             description => "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
 928             optional => 1,
 929         },
 930         permissions => {
 931             type => 'object',
 932             description => "Required access permissions. By default only 'root' is allowed to access this method.",
 933             optional => 1,
 934             additionalProperties => 0,
 935             properties => {
 936                 description => {
 937                      description => "Describe access permissions.",
 938                      optional => 1,
 939                 },
 940                 user => {
 941                     description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
 942                     type => 'string',
 943                     enum => ['all', 'world'],
 944                     optional => 1,
 945                 },
 946                 check => {
 947                     description => "Array of permission checks (prefix notation).",
 948                     type => 'array',
 949                     optional => 1
 950                 },
 951             },
 952         },
 953         match_name => {
 954             description => "Used internally",
 955             optional => 1,
 956         },
 957         match_re => {
 958             description => "Used internally",
 959             optional => 1,
 960         },
 961         path => {
 962             type =>  'string',
 963             description => "path for URL matching (uri template)",
 964         },
 965         fragmentDelimiter => {
 966             type => 'string',
 967             description => "A ways to override the default fragment delimiter '/'. This onyl works on a whole sub-class. You can set this to the empty string to match the whole rest of the URI.",
 968             optional => 1,
 969         },
 970         parameters => {
 971             type => 'object',
 972             description => "JSON Schema for parameters.",
 973             optional => 1,
 974         },
 975         formatter => {
 976             type => 'object',
 977             description => "Used to store page formatter information (set by PVE::RESTHandler->register_page_formatter).",
 978             optional => 1,
 979         },
 980         returns => {
 981             type => 'object',
 982             description => "JSON Schema for return value.",
 983             optional => 1,
 984         },
 985         code => {
 986             type => 'coderef',
 987             description => "method implementaion (code reference)",
 988             optional => 1,
 989         },
 990         subclass => {
 991             type => 'string',
 992             description => "Delegate call to this class (perl class string).",
 993             optional => 1,
 994             requires => {
 995                 additionalProperties => 0,
 996                 properties => {
 997                     subclass => {},
 998                     path => {},
 999                     match_name => {},
1000                     match_re => {},
1001                     fragmentDelimiter => { optional => 1 }
1002                 }
1003             },
1004         },
1005     },
1006
1007 };
1008
1009 sub validate_schema {
1010     my ($schema) = @_;
1011
1012     my $errmsg = "internal error - unable to verify schema\n";
1013     validate($schema, $default_schema, $errmsg);
1014 }
1015
1016 sub validate_method_info {
1017     my $info = shift;
1018
1019     my $errmsg = "internal error - unable to verify method info\n";
1020     validate($info, $method_schema, $errmsg);
1021
1022     validate_schema($info->{parameters}) if $info->{parameters};
1023     validate_schema($info->{returns}) if $info->{returns};
1024 }
1025
1026 # run a self test on load
1027 # make sure we can verify the default schema
1028 validate_schema($default_schema_noref);
1029 validate_schema($method_schema);
1030
1031 # and now some utility methods (used by pve api)
1032 sub method_get_child_link {
1033     my ($info) = @_;
1034
1035     return undef if !$info;
1036
1037     my $schema = $info->{returns};
1038     return undef if !$schema || !$schema->{type} || $schema->{type} ne 'array';
1039
1040     my $links = $schema->{links};
1041     return undef if !$links;
1042
1043     my $found;
1044     foreach my $lnk (@$links) {
1045         if ($lnk->{href} && $lnk->{rel} && ($lnk->{rel} eq 'child')) {
1046             $found = $lnk;
1047             last;
1048         }
1049     }
1050
1051     return $found;
1052 }
1053
1054 # a way to parse command line parameters, using a
1055 # schema to configure Getopt::Long
1056 sub get_options {
1057     my ($schema, $args, $arg_param, $fixed_param, $pwcallback) = @_;
1058
1059     if (!$schema || !$schema->{properties}) {
1060         raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1061             if scalar(@$args) != 0;
1062         return {};
1063     }
1064
1065     my $list_param;
1066     if ($arg_param && !ref($arg_param)) {
1067         my $pd = $schema->{properties}->{$arg_param};
1068         die "expected list format $pd->{format}"
1069             if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
1070         $list_param = $arg_param;
1071     }
1072
1073     my @getopt = ();
1074     foreach my $prop (keys %{$schema->{properties}}) {
1075         my $pd = $schema->{properties}->{$prop};
1076         next if $list_param && $prop eq $list_param;
1077         next if defined($fixed_param->{$prop});
1078
1079         if ($prop eq 'password' && $pwcallback) {
1080             # we do not accept plain password on input line, instead
1081             # we turn this into a boolean option and ask for password below
1082             # using $pwcallback() (for security reasons).
1083             push @getopt, "$prop";
1084         } elsif ($pd->{type} eq 'boolean') {
1085             push @getopt, "$prop:s";
1086         } else {
1087             if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
1088                 push @getopt, "$prop=s@";
1089             } else {
1090                 push @getopt, "$prop=s";
1091             }
1092         }
1093     }
1094
1095     Getopt::Long::Configure('prefix_pattern=(--|-)');
1096
1097     my $opts = {};
1098     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
1099         if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
1100
1101     if (@$args) {
1102         if ($list_param) {
1103             $opts->{$list_param} = $args;
1104             $args = [];
1105         } elsif (ref($arg_param)) {
1106             foreach my $arg_name (@$arg_param) {
1107                 if ($opts->{'extra-args'}) {
1108                     raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
1109                 }
1110                 if ($arg_name eq 'extra-args') {
1111                     $opts->{'extra-args'} = $args;
1112                     $args = [];
1113                     next;
1114                 }
1115                 raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
1116                 $opts->{$arg_name} = shift @$args;
1117             }
1118             raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
1119         } else {
1120             raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1121                 if scalar(@$args) != 0;
1122         }
1123     }
1124
1125     if (my $pd = $schema->{properties}->{password}) {
1126         if ($pd->{type} ne 'boolean' && $pwcallback) {
1127             if ($opts->{password} || !$pd->{optional}) {
1128                 $opts->{password} = &$pwcallback();
1129             }
1130         }
1131     }
1132
1133     $opts = PVE::Tools::decode_utf8_parameters($opts);
1134
1135     foreach my $p (keys %$opts) {
1136         if (my $pd = $schema->{properties}->{$p}) {
1137             if ($pd->{type} eq 'boolean') {
1138                 if ($opts->{$p} eq '') {
1139                     $opts->{$p} = 1;
1140                 } elsif ($opts->{$p} =~ m/^(1|true|yes|on)$/i) {
1141                     $opts->{$p} = 1;
1142                 } elsif ($opts->{$p} =~ m/^(0|false|no|off)$/i) {
1143                     $opts->{$p} = 0;
1144                 } else {
1145                     raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
1146                 }
1147             } elsif ($pd->{format}) {
1148
1149                 if ($pd->{format} =~ m/-list/) {
1150                     # allow --vmid 100 --vmid 101 and --vmid 100,101
1151                     # allow --dow mon --dow fri and --dow mon,fri
1152                     $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
1153                 } elsif ($pd->{format} =~ m/-alist/) {
1154                     # we encode array as \0 separated strings
1155                     # Note: CGI.pm also use this encoding
1156                     if (scalar(@{$opts->{$p}}) != 1) {
1157                         $opts->{$p} = join("\0", @{$opts->{$p}});
1158                     } else {
1159                         # st that split_list knows it is \0 terminated
1160                         my $v = $opts->{$p}->[0];
1161                         $opts->{$p} = "$v\0";
1162                     }
1163                 }
1164             }
1165         }
1166     }
1167
1168     foreach my $p (keys %$fixed_param) {
1169         $opts->{$p} = $fixed_param->{$p};
1170     }
1171
1172     return $opts;
1173 }
1174
1175 # A way to parse configuration data by giving a json schema
1176 sub parse_config {
1177     my ($schema, $filename, $raw) = @_;
1178
1179     # do fast check (avoid validate_schema($schema))
1180     die "got strange schema" if !$schema->{type} ||
1181         !$schema->{properties} || $schema->{type} ne 'object';
1182
1183     my $cfg = {};
1184
1185     while ($raw =~ /^\s*(.+?)\s*$/gm) {
1186         my $line = $1;
1187
1188         next if $line =~ /^#/;
1189
1190         if ($line =~ m/^(\S+?):\s*(.*)$/) {
1191             my $key = $1;
1192             my $value = $2;
1193             if ($schema->{properties}->{$key} &&
1194                 $schema->{properties}->{$key}->{type} eq 'boolean') {
1195
1196                 $value = 1 if $value =~ m/^(1|on|yes|true)$/i;
1197                 $value = 0 if $value =~ m/^(0|off|no|false)$/i;
1198             }
1199             $cfg->{$key} = $value;
1200         } else {
1201             warn "ignore config line: $line\n"
1202         }
1203     }
1204
1205     my $errors = {};
1206     check_prop($cfg, $schema, '', $errors);
1207
1208     foreach my $k (keys %$errors) {
1209         warn "parse error in '$filename' - '$k': $errors->{$k}\n";
1210         delete $cfg->{$k};
1211     }
1212
1213     return $cfg;
1214 }
1215
1216 # generate simple key/value file
1217 sub dump_config {
1218     my ($schema, $filename, $cfg) = @_;
1219
1220     # do fast check (avoid validate_schema($schema))
1221     die "got strange schema" if !$schema->{type} ||
1222         !$schema->{properties} || $schema->{type} ne 'object';
1223
1224     validate($cfg, $schema, "validation error in '$filename'\n");
1225
1226     my $data = '';
1227
1228     foreach my $k (keys %$cfg) {
1229         $data .= "$k: $cfg->{$k}\n";
1230     }
1231
1232     return $data;
1233 }
1234
1235 sub generate_typetext {
1236     my ($schema) = @_;
1237     my $typetext = '';
1238     my (@optional, @required);
1239     foreach my $key (sort keys %$schema) {
1240         next if !$schema->{$key}->{format_description};
1241         if ($schema->{$key}->{optional}) {
1242             push @optional, $key;
1243         } else {
1244             push @required, $key;
1245         }
1246     }
1247     my ($pre, $post) = ('', '');
1248     foreach my $key (@required) {
1249         my $desc = $schema->{$key}->{format_description};
1250         $typetext .= "$pre$key=<$desc>$post";
1251         $pre = ', ';
1252     }
1253     $pre = ' [,' if $pre;
1254     foreach my $key (@optional) {
1255         my $desc = $schema->{$key}->{format_description};
1256         $typetext .= "$pre$key=<$desc>$post";
1257         $pre = ' [,';
1258         $post = ']';
1259     }
1260     return $typetext;
1261 }
1262
1263 1;