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