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