data/PVE/JSONSchema.pm

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