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