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