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