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 extjs Ext.form.VTypes.email
 249     if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,6}$/) {
 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         title => {
 801             type => "string",
 802             optional => 1,
 803             description => "This provides the title of the property",
 804         },
 805         requires => {
 806             type => [ "string", "object" ],
 807             optional => 1,
 808             description => "indicates a required property or a schema that must be validated if this property is present",
 809         },
 810         format => {
 811             type => "string",
 812             optional => 1,
 813             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",
 814         },
 815         default => {
 816             type => "any",
 817             optional => 1,
 818             description => "This indicates the default for the instance property."
 819         },
 820         completion => {
 821             type => 'coderef',
 822             description => "Bash completion function. This function should return a list of possible values.",
 823             optional => 1,
 824         },
 825         disallow => {
 826             type => "object",
 827             optional => 1,
 828             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.",
 829         },
 830         extends => {
 831             type => "object",
 832             optional => 1,
 833             description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
 834             default => {},
 835         },
 836         # this is from hyper schema
 837         links => {
 838             type => "array",
 839             description => "This defines the link relations of the instance objects",
 840             optional => 1,
 841             items => {
 842                 type => "object",
 843                 properties => {
 844                     href => {
 845                         type => "string",
 846                         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",
 847                     },
 848                     rel => {
 849                         type => "string",
 850                         description => "This is the name of the link relation",
 851                         optional => 1,
 852                         default => "full",
 853                     },
 854                     method => {
 855                         type => "string",
 856                         description => "For submission links, this defines the method that should be used to access the target resource",
 857                         optional => 1,
 858                         default => "GET",
 859                     },
 860                 },
 861             },
 862         },
 863     }
 864 };
 865
 866 my $default_schema = Storable::dclone($default_schema_noref);
 867
 868 $default_schema->{properties}->{properties}->{additionalProperties} = $default_schema;
 869 $default_schema->{properties}->{additionalProperties}->{properties} = $default_schema->{properties};
 870
 871 $default_schema->{properties}->{items}->{properties} = $default_schema->{properties};
 872 $default_schema->{properties}->{items}->{additionalProperties} = 0;
 873
 874 $default_schema->{properties}->{disallow}->{properties} = $default_schema->{properties};
 875 $default_schema->{properties}->{disallow}->{additionalProperties} = 0;
 876
 877 $default_schema->{properties}->{requires}->{properties} = $default_schema->{properties};
 878 $default_schema->{properties}->{requires}->{additionalProperties} = 0;
 879
 880 $default_schema->{properties}->{extends}->{properties} = $default_schema->{properties};
 881 $default_schema->{properties}->{extends}->{additionalProperties} = 0;
 882
 883 my $method_schema = {
 884     type => "object",
 885     additionalProperties => 0,
 886     properties => {
 887         description => {
 888             description => "This a description of the method",
 889             optional => 1,
 890         },
 891         name => {
 892             type =>  'string',
 893             description => "This indicates the name of the function to call.",
 894             optional => 1,
 895             requires => {
 896                 additionalProperties => 1,
 897                 properties => {
 898                     name => {},
 899                     description => {},
 900                     code => {},
 901                     method => {},
 902                     parameters => {},
 903                     path => {},
 904                     parameters => {},
 905                     returns => {},
 906                 }
 907             },
 908         },
 909         method => {
 910             type =>  'string',
 911             description => "The HTTP method name.",
 912             enum => [ 'GET', 'POST', 'PUT', 'DELETE' ],
 913             optional => 1,
 914         },
 915         protected => {
 916             type => 'boolean',
 917             description => "Method needs special privileges - only pvedaemon can execute it",
 918             optional => 1,
 919         },
 920         proxyto => {
 921             type =>  'string',
 922             description => "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
 923             optional => 1,
 924         },
 925         permissions => {
 926             type => 'object',
 927             description => "Required access permissions. By default only 'root' is allowed to access this method.",
 928             optional => 1,
 929             additionalProperties => 0,
 930             properties => {
 931                 description => {
 932                      description => "Describe access permissions.",
 933                      optional => 1,
 934                 },
 935                 user => {
 936                     description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
 937                     type => 'string',
 938                     enum => ['all', 'world'],
 939                     optional => 1,
 940                 },
 941                 check => {
 942                     description => "Array of permission checks (prefix notation).",
 943                     type => 'array',
 944                     optional => 1
 945                 },
 946             },
 947         },
 948         match_name => {
 949             description => "Used internally",
 950             optional => 1,
 951         },
 952         match_re => {
 953             description => "Used internally",
 954             optional => 1,
 955         },
 956         path => {
 957             type =>  'string',
 958             description => "path for URL matching (uri template)",
 959         },
 960         fragmentDelimiter => {
 961             type => 'string',
 962             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.",
 963             optional => 1,
 964         },
 965         parameters => {
 966             type => 'object',
 967             description => "JSON Schema for parameters.",
 968             optional => 1,
 969         },
 970         returns => {
 971             type => 'object',
 972             description => "JSON Schema for return value.",
 973             optional => 1,
 974         },
 975         code => {
 976             type => 'coderef',
 977             description => "method implementaion (code reference)",
 978             optional => 1,
 979         },
 980         subclass => {
 981             type => 'string',
 982             description => "Delegate call to this class (perl class string).",
 983             optional => 1,
 984             requires => {
 985                 additionalProperties => 0,
 986                 properties => {
 987                     subclass => {},
 988                     path => {},
 989                     match_name => {},
 990                     match_re => {},
 991                     fragmentDelimiter => { optional => 1 }
 992                 }
 993             },
 994         },
 995     },
 996
 997 };
 998
 999 sub validate_schema {
1000     my ($schema) = @_;
1001
1002     my $errmsg = "internal error - unable to verify schema\n";
1003     validate($schema, $default_schema, $errmsg);
1004 }
1005
1006 sub validate_method_info {
1007     my $info = shift;
1008
1009     my $errmsg = "internal error - unable to verify method info\n";
1010     validate($info, $method_schema, $errmsg);
1011
1012     validate_schema($info->{parameters}) if $info->{parameters};
1013     validate_schema($info->{returns}) if $info->{returns};
1014 }
1015
1016 # run a self test on load
1017 # make sure we can verify the default schema
1018 validate_schema($default_schema_noref);
1019 validate_schema($method_schema);
1020
1021 # and now some utility methods (used by pve api)
1022 sub method_get_child_link {
1023     my ($info) = @_;
1024
1025     return undef if !$info;
1026
1027     my $schema = $info->{returns};
1028     return undef if !$schema || !$schema->{type} || $schema->{type} ne 'array';
1029
1030     my $links = $schema->{links};
1031     return undef if !$links;
1032
1033     my $found;
1034     foreach my $lnk (@$links) {
1035         if ($lnk->{href} && $lnk->{rel} && ($lnk->{rel} eq 'child')) {
1036             $found = $lnk;
1037             last;
1038         }
1039     }
1040
1041     return $found;
1042 }
1043
1044 # a way to parse command line parameters, using a
1045 # schema to configure Getopt::Long
1046 sub get_options {
1047     my ($schema, $args, $arg_param, $fixed_param, $pwcallback) = @_;
1048
1049     if (!$schema || !$schema->{properties}) {
1050         raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1051             if scalar(@$args) != 0;
1052         return {};
1053     }
1054
1055     my $list_param;
1056     if ($arg_param && !ref($arg_param)) {
1057         my $pd = $schema->{properties}->{$arg_param};
1058         die "expected list format $pd->{format}"
1059             if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
1060         $list_param = $arg_param;
1061     }
1062
1063     my @getopt = ();
1064     foreach my $prop (keys %{$schema->{properties}}) {
1065         my $pd = $schema->{properties}->{$prop};
1066         next if $list_param && $prop eq $list_param;
1067         next if defined($fixed_param->{$prop});
1068
1069         if ($prop eq 'password' && $pwcallback) {
1070             # we do not accept plain password on input line, instead
1071             # we turn this into a boolean option and ask for password below
1072             # using $pwcallback() (for security reasons).
1073             push @getopt, "$prop";
1074         } elsif ($pd->{type} eq 'boolean') {
1075             push @getopt, "$prop:s";
1076         } else {
1077             if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
1078                 push @getopt, "$prop=s@";
1079             } else {
1080                 push @getopt, "$prop=s";
1081             }
1082         }
1083     }
1084
1085     Getopt::Long::Configure('prefix_pattern=(--|-)');
1086
1087     my $opts = {};
1088     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
1089         if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
1090
1091     if (@$args) {
1092         if ($list_param) {
1093             $opts->{$list_param} = $args;
1094             $args = [];
1095         } elsif (ref($arg_param)) {
1096             foreach my $arg_name (@$arg_param) {
1097                 if ($opts->{'extra-args'}) {
1098                     raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
1099                 }
1100                 if ($arg_name eq 'extra-args') {
1101                     $opts->{'extra-args'} = $args;
1102                     $args = [];
1103                     next;
1104                 }
1105                 raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
1106                 $opts->{$arg_name} = shift @$args;
1107             }
1108             raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
1109         } else {
1110             raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1111                 if scalar(@$args) != 0;
1112         }
1113     }
1114
1115     if (my $pd = $schema->{properties}->{password}) {
1116         if ($pd->{type} ne 'boolean' && $pwcallback) {
1117             if ($opts->{password} || !$pd->{optional}) {
1118                 $opts->{password} = &$pwcallback();
1119             }
1120         }
1121     }
1122
1123     $opts = PVE::Tools::decode_utf8_parameters($opts);
1124
1125     foreach my $p (keys %$opts) {
1126         if (my $pd = $schema->{properties}->{$p}) {
1127             if ($pd->{type} eq 'boolean') {
1128                 if ($opts->{$p} eq '') {
1129                     $opts->{$p} = 1;
1130                 } elsif ($opts->{$p} =~ m/^(1|true|yes|on)$/i) {
1131                     $opts->{$p} = 1;
1132                 } elsif ($opts->{$p} =~ m/^(0|false|no|off)$/i) {
1133                     $opts->{$p} = 0;
1134                 } else {
1135                     raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
1136                 }
1137             } elsif ($pd->{format}) {
1138
1139                 if ($pd->{format} =~ m/-list/) {
1140                     # allow --vmid 100 --vmid 101 and --vmid 100,101
1141                     # allow --dow mon --dow fri and --dow mon,fri
1142                     $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
1143                 } elsif ($pd->{format} =~ m/-alist/) {
1144                     # we encode array as \0 separated strings
1145                     # Note: CGI.pm also use this encoding
1146                     if (scalar(@{$opts->{$p}}) != 1) {
1147                         $opts->{$p} = join("\0", @{$opts->{$p}});
1148                     } else {
1149                         # st that split_list knows it is \0 terminated
1150                         my $v = $opts->{$p}->[0];
1151                         $opts->{$p} = "$v\0";
1152                     }
1153                 }
1154             }
1155         }
1156     }
1157
1158     foreach my $p (keys %$fixed_param) {
1159         $opts->{$p} = $fixed_param->{$p};
1160     }
1161
1162     return $opts;
1163 }
1164
1165 # A way to parse configuration data by giving a json schema
1166 sub parse_config {
1167     my ($schema, $filename, $raw) = @_;
1168
1169     # do fast check (avoid validate_schema($schema))
1170     die "got strange schema" if !$schema->{type} ||
1171         !$schema->{properties} || $schema->{type} ne 'object';
1172
1173     my $cfg = {};
1174
1175     while ($raw =~ /^\s*(.+?)\s*$/gm) {
1176         my $line = $1;
1177
1178         next if $line =~ /^#/;
1179
1180         if ($line =~ m/^(\S+?):\s*(.*)$/) {
1181             my $key = $1;
1182             my $value = $2;
1183             if ($schema->{properties}->{$key} &&
1184                 $schema->{properties}->{$key}->{type} eq 'boolean') {
1185
1186                 $value = 1 if $value =~ m/^(1|on|yes|true)$/i;
1187                 $value = 0 if $value =~ m/^(0|off|no|false)$/i;
1188             }
1189             $cfg->{$key} = $value;
1190         } else {
1191             warn "ignore config line: $line\n"
1192         }
1193     }
1194
1195     my $errors = {};
1196     check_prop($cfg, $schema, '', $errors);
1197
1198     foreach my $k (keys %$errors) {
1199         warn "parse error in '$filename' - '$k': $errors->{$k}\n";
1200         delete $cfg->{$k};
1201     }
1202
1203     return $cfg;
1204 }
1205
1206 # generate simple key/value file
1207 sub dump_config {
1208     my ($schema, $filename, $cfg) = @_;
1209
1210     # do fast check (avoid validate_schema($schema))
1211     die "got strange schema" if !$schema->{type} ||
1212         !$schema->{properties} || $schema->{type} ne 'object';
1213
1214     validate($cfg, $schema, "validation error in '$filename'\n");
1215
1216     my $data = '';
1217
1218     foreach my $k (keys %$cfg) {
1219         $data .= "$k: $cfg->{$k}\n";
1220     }
1221
1222     return $data;
1223 }
1224
1225 1;