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