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