data/PVE/JSONSchema.pm

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