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 parse_property_string {
 435     my ($format, $data, $path) = @_;
 436
 437     my $default_key;
 438
 439     my $res = {};
 440     foreach my $part (split(/,/, $data)) {
 441         next if $part =~ /^\s*$/;
 442
 443         if ($part =~ /^([^=]+)=(.+)$/) {
 444             my ($k, $v) = ($1, $2);
 445             die "duplicate key in comma-separated list property: $k" if defined($res->{$k});
 446             my $schema = $format->{$k};
 447             die "invalid key in comma-separated list property: $k" if !$schema;
 448             if ($schema->{type} && $schema->{type} eq 'boolean') {
 449                 $v = 1 if $v =~ m/^(1|on|yes|true)$/i;
 450                 $v = 0 if $v =~ m/^(0|off|no|false)$/i;
 451             }
 452             $res->{$k} = $v;
 453         } elsif ($part !~ /=/) {
 454             die "duplicate key in comma-separated list property: $default_key" if $default_key;
 455             foreach my $key (keys %$format) {
 456                 if ($format->{$key}->{default_key}) {
 457                     $default_key = $key;
 458                     if (!$res->{$default_key}) {
 459                         $res->{$default_key} = $part;
 460                         last;
 461                     }
 462                     die "duplicate key in comma-separated list property: $default_key";
 463                 }
 464             }
 465         } else {
 466             die "missing key in comma-separated list property";
 467         }
 468     }
 469
 470     my $errors = {};
 471     check_object($path, $format, $res, undef, $errors);
 472     if (scalar(%$errors)) {
 473         raise "format error", errors => $errors;
 474     }
 475
 476     return $res;
 477 }
 478
 479 sub add_error {
 480     my ($errors, $path, $msg) = @_;
 481
 482     $path = '_root' if !$path;
 483
 484     if ($errors->{$path}) {
 485         $errors->{$path} = join ('\n', $errors->{$path}, $msg);
 486     } else {
 487         $errors->{$path} = $msg;
 488     }
 489 }
 490
 491 sub is_number {
 492     my $value = shift;
 493
 494     # see 'man perlretut'
 495     return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
 496 }
 497
 498 sub is_integer {
 499     my $value = shift;
 500
 501     return $value =~ m/^[+-]?\d+$/;
 502 }
 503
 504 sub check_type {
 505     my ($path, $type, $value, $errors) = @_;
 506
 507     return 1 if !$type;
 508
 509     if (!defined($value)) {
 510         return 1 if $type eq 'null';
 511         die "internal error"
 512     }
 513
 514     if (my $tt = ref($type)) {
 515         if ($tt eq 'ARRAY') {
 516             foreach my $t (@$type) {
 517                 my $tmperr = {};
 518                 check_type($path, $t, $value, $tmperr);
 519                 return 1 if !scalar(%$tmperr);
 520             }
 521             my $ttext = join ('|', @$type);
 522             add_error($errors, $path, "type check ('$ttext') failed");
 523             return undef;
 524         } elsif ($tt eq 'HASH') {
 525             my $tmperr = {};
 526             check_prop($value, $type, $path, $tmperr);
 527             return 1 if !scalar(%$tmperr);
 528             add_error($errors, $path, "type check failed");
 529             return undef;
 530         } else {
 531             die "internal error - got reference type '$tt'";
 532         }
 533
 534     } else {
 535
 536         return 1 if $type eq 'any';
 537
 538         if ($type eq 'null') {
 539             if (defined($value)) {
 540                 add_error($errors, $path, "type check ('$type') failed - value is not null");
 541                 return undef;
 542             }
 543             return 1;
 544         }
 545
 546         my $vt = ref($value);
 547
 548         if ($type eq 'array') {
 549             if (!$vt || $vt ne 'ARRAY') {
 550                 add_error($errors, $path, "type check ('$type') failed");
 551                 return undef;
 552             }
 553             return 1;
 554         } elsif ($type eq 'object') {
 555             if (!$vt || $vt ne 'HASH') {
 556                 add_error($errors, $path, "type check ('$type') failed");
 557                 return undef;
 558             }
 559             return 1;
 560         } elsif ($type eq 'coderef') {
 561             if (!$vt || $vt ne 'CODE') {
 562                 add_error($errors, $path, "type check ('$type') failed");
 563                 return undef;
 564             }
 565             return 1;
 566         } else {
 567             if ($vt) {
 568                 add_error($errors, $path, "type check ('$type') failed - got $vt");
 569                 return undef;
 570             } else {
 571                 if ($type eq 'string') {
 572                     return 1; # nothing to check ?
 573                 } elsif ($type eq 'boolean') {
 574                     #if ($value =~ m/^(1|true|yes|on)$/i) {
 575                     if ($value eq '1') {
 576                         return 1;
 577                     #} elsif ($value =~ m/^(0|false|no|off)$/i) {
 578                     } elsif ($value eq '0') {
 579                         return 0;
 580                     } else {
 581                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
 582                         return undef;
 583                     }
 584                 } elsif ($type eq 'integer') {
 585                     if (!is_integer($value)) {
 586                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
 587                         return undef;
 588                     }
 589                     return 1;
 590                 } elsif ($type eq 'number') {
 591                     if (!is_number($value)) {
 592                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
 593                         return undef;
 594                     }
 595                     return 1;
 596                 } else {
 597                     return 1; # no need to verify unknown types
 598                 }
 599             }
 600         }
 601     }
 602
 603     return undef;
 604 }
 605
 606 sub check_object {
 607     my ($path, $schema, $value, $additional_properties, $errors) = @_;
 608
 609     # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
 610
 611     my $st = ref($schema);
 612     if (!$st || $st ne 'HASH') {
 613         add_error($errors, $path, "Invalid schema definition.");
 614         return;
 615     }
 616
 617     my $vt = ref($value);
 618     if (!$vt || $vt ne 'HASH') {
 619         add_error($errors, $path, "an object is required");
 620         return;
 621     }
 622
 623     foreach my $k (keys %$schema) {
 624         check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors);
 625     }
 626
 627     foreach my $k (keys %$value) {
 628
 629         my $newpath =  $path ? "$path.$k" : $k;
 630
 631         if (my $subschema = $schema->{$k}) {
 632             if (my $requires = $subschema->{requires}) {
 633                 if (ref($requires)) {
 634                     #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
 635                     check_prop($value, $requires, $path, $errors);
 636                 } elsif (!defined($value->{$requires})) {
 637                     add_error($errors, $path ? "$path.$requires" : $requires,
 638                               "missing property - '$newpath' requiers this property");
 639                 }
 640             }
 641
 642             next; # value is already checked above
 643         }
 644
 645         if (defined ($additional_properties) && !$additional_properties) {
 646             add_error($errors, $newpath, "property is not defined in schema " .
 647                       "and the schema does not allow additional properties");
 648             next;
 649         }
 650         check_prop($value->{$k}, $additional_properties, $newpath, $errors)
 651             if ref($additional_properties);
 652     }
 653 }
 654
 655 sub check_object_warn {
 656     my ($path, $schema, $value, $additional_properties) = @_;
 657     my $errors = {};
 658     check_object($path, $schema, $value, $additional_properties, $errors);
 659     if (scalar(%$errors)) {
 660         foreach my $k (keys %$errors) {
 661             warn "parse error: $k: $errors->{$k}\n";
 662         }
 663         return 0;
 664     }
 665     return 1;
 666 }
 667
 668 sub check_prop {
 669     my ($value, $schema, $path, $errors) = @_;
 670
 671     die "internal error - no schema" if !$schema;
 672     die "internal error" if !$errors;
 673
 674     #print "check_prop $path\n" if $value;
 675
 676     my $st = ref($schema);
 677     if (!$st || $st ne 'HASH') {
 678         add_error($errors, $path, "Invalid schema definition.");
 679         return;
 680     }
 681
 682     # if it extends another schema, it must pass that schema as well
 683     if($schema->{extends}) {
 684         check_prop($value, $schema->{extends}, $path, $errors);
 685     }
 686
 687     if (!defined ($value)) {
 688         return if $schema->{type} && $schema->{type} eq 'null';
 689         if (!$schema->{optional}) {
 690             add_error($errors, $path, "property is missing and it is not optional");
 691         }
 692         return;
 693     }
 694
 695     return if !check_type($path, $schema->{type}, $value, $errors);
 696
 697     if ($schema->{disallow}) {
 698         my $tmperr = {};
 699         if (check_type($path, $schema->{disallow}, $value, $tmperr)) {
 700             add_error($errors, $path, "disallowed value was matched");
 701             return;
 702         }
 703     }
 704
 705     if (my $vt = ref($value)) {
 706
 707         if ($vt eq 'ARRAY') {
 708             if ($schema->{items}) {
 709                 my $it = ref($schema->{items});
 710                 if ($it && $it eq 'ARRAY') {
 711                     #die "implement me $path: $vt " . Dumper($schema) ."\n".  Dumper($value);
 712                     die "not implemented";
 713                 } else {
 714                     my $ind = 0;
 715                     foreach my $el (@$value) {
 716                         check_prop($el, $schema->{items}, "${path}[$ind]", $errors);
 717                         $ind++;
 718                     }
 719                 }
 720             }
 721             return;
 722         } elsif ($schema->{properties} || $schema->{additionalProperties}) {
 723             check_object($path, defined($schema->{properties}) ? $schema->{properties} : {},
 724                          $value, $schema->{additionalProperties}, $errors);
 725             return;
 726         }
 727
 728     } else {
 729
 730         if (my $format = $schema->{format}) {
 731             eval { check_format($format, $value); };
 732             if ($@) {
 733                 add_error($errors, $path, "invalid format - $@");
 734                 return;
 735             }
 736         }
 737
 738         if (my $pattern = $schema->{pattern}) {
 739             if ($value !~ m/^$pattern$/) {
 740                 add_error($errors, $path, "value does not match the regex pattern");
 741                 return;
 742             }
 743         }
 744
 745         if (defined (my $max = $schema->{maxLength})) {
 746             if (length($value) > $max) {
 747                 add_error($errors, $path, "value may only be $max characters long");
 748                 return;
 749             }
 750         }
 751
 752         if (defined (my $min = $schema->{minLength})) {
 753             if (length($value) < $min) {
 754                 add_error($errors, $path, "value must be at least $min characters long");
 755                 return;
 756             }
 757         }
 758
 759         if (is_number($value)) {
 760             if (defined (my $max = $schema->{maximum})) {
 761                 if ($value > $max) {
 762                     add_error($errors, $path, "value must have a maximum value of $max");
 763                     return;
 764                 }
 765             }
 766
 767             if (defined (my $min = $schema->{minimum})) {
 768                 if ($value < $min) {
 769                     add_error($errors, $path, "value must have a minimum value of $min");
 770                     return;
 771                 }
 772             }
 773         }
 774
 775         if (my $ea = $schema->{enum}) {
 776
 777             my $found;
 778             foreach my $ev (@$ea) {
 779                 if ($ev eq $value) {
 780                     $found = 1;
 781                     last;
 782                 }
 783             }
 784             if (!$found) {
 785                 add_error($errors, $path, "value '$value' does not have a value in the enumeration '" .
 786                           join(", ", @$ea) . "'");
 787             }
 788         }
 789     }
 790 }
 791
 792 sub validate {
 793     my ($instance, $schema, $errmsg) = @_;
 794
 795     my $errors = {};
 796     $errmsg = "Parameter verification failed.\n" if !$errmsg;
 797
 798     # todo: cycle detection is only needed for debugging, I guess
 799     # we can disable that in the final release
 800     # todo: is there a better/faster way to detect cycles?
 801     my $cycles = 0;
 802     find_cycle($instance, sub { $cycles = 1 });
 803     if ($cycles) {
 804         add_error($errors, undef, "data structure contains recursive cycles");
 805     } elsif ($schema) {
 806         check_prop($instance, $schema, '', $errors);
 807     }
 808
 809     if (scalar(%$errors)) {
 810         raise $errmsg, code => HTTP_BAD_REQUEST, errors => $errors;
 811     }
 812
 813     return 1;
 814 }
 815
 816 my $schema_valid_types = ["string", "object", "coderef", "array", "boolean", "number", "integer", "null", "any"];
 817 my $default_schema_noref = {
 818     description => "This is the JSON Schema for JSON Schemas.",
 819     type => [ "object" ],
 820     additionalProperties => 0,
 821     properties => {
 822         type => {
 823             type => ["string", "array"],
 824             description => "This is a type definition value. This can be a simple type, or a union type",
 825             optional => 1,
 826             default => "any",
 827             items => {
 828                 type => "string",
 829                 enum => $schema_valid_types,
 830             },
 831             enum => $schema_valid_types,
 832         },
 833         optional => {
 834             type => "boolean",
 835             description => "This indicates that the instance property in the instance object is not required.",
 836             optional => 1,
 837             default => 0
 838         },
 839         properties => {
 840             type => "object",
 841             description => "This is a definition for the properties of an object value",
 842             optional => 1,
 843             default => {},
 844         },
 845         items => {
 846             type => "object",
 847             description => "When the value is an array, this indicates the schema to use to validate each item in an array",
 848             optional => 1,
 849             default => {},
 850         },
 851         additionalProperties => {
 852             type => [ "boolean", "object"],
 853             description => "This provides a default property definition for all properties that are not explicitly defined in an object type definition.",
 854             optional => 1,
 855             default => {},
 856         },
 857         minimum => {
 858             type => "number",
 859             optional => 1,
 860             description => "This indicates the minimum value for the instance property when the type of the instance value is a number.",
 861         },
 862         maximum => {
 863             type => "number",
 864             optional => 1,
 865             description => "This indicates the maximum value for the instance property when the type of the instance value is a number.",
 866         },
 867         minLength => {
 868             type => "integer",
 869             description => "When the instance value is a string, this indicates minimum length of the string",
 870             optional => 1,
 871             minimum => 0,
 872             default => 0,
 873         },
 874         maxLength => {
 875             type => "integer",
 876             description => "When the instance value is a string, this indicates maximum length of the string.",
 877             optional => 1,
 878         },
 879         typetext => {
 880             type => "string",
 881             optional => 1,
 882             description => "A text representation of the type (used to generate documentation).",
 883         },
 884         pattern => {
 885             type => "string",
 886             format => "regex",
 887             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.",
 888             optional => 1,
 889             default => ".*",
 890         },
 891
 892         enum => {
 893             type => "array",
 894             optional => 1,
 895             description => "This provides an enumeration of possible values that are valid for the instance property.",
 896         },
 897         description => {
 898             type => "string",
 899             optional => 1,
 900             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).",
 901         },
 902         format_description => {
 903             type => "string",
 904             optional => 1,
 905             description => "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings.",
 906         },
 907         title => {
 908             type => "string",
 909             optional => 1,
 910             description => "This provides the title of the property",
 911         },
 912         requires => {
 913             type => [ "string", "object" ],
 914             optional => 1,
 915             description => "indicates a required property or a schema that must be validated if this property is present",
 916         },
 917         format => {
 918             type => "string",
 919             optional => 1,
 920             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",
 921         },
 922         default_key => {
 923             type => "boolean",
 924             optional => 1,
 925             description => "Whether this is the default key in a comma separated list property string.",
 926         },
 927         default => {
 928             type => "any",
 929             optional => 1,
 930             description => "This indicates the default for the instance property."
 931         },
 932         completion => {
 933             type => 'coderef',
 934             description => "Bash completion function. This function should return a list of possible values.",
 935             optional => 1,
 936         },
 937         disallow => {
 938             type => "object",
 939             optional => 1,
 940             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.",
 941         },
 942         extends => {
 943             type => "object",
 944             optional => 1,
 945             description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
 946             default => {},
 947         },
 948         # this is from hyper schema
 949         links => {
 950             type => "array",
 951             description => "This defines the link relations of the instance objects",
 952             optional => 1,
 953             items => {
 954                 type => "object",
 955                 properties => {
 956                     href => {
 957                         type => "string",
 958                         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",
 959                     },
 960                     rel => {
 961                         type => "string",
 962                         description => "This is the name of the link relation",
 963                         optional => 1,
 964                         default => "full",
 965                     },
 966                     method => {
 967                         type => "string",
 968                         description => "For submission links, this defines the method that should be used to access the target resource",
 969                         optional => 1,
 970                         default => "GET",
 971                     },
 972                 },
 973             },
 974         },
 975     }
 976 };
 977
 978 my $default_schema = Storable::dclone($default_schema_noref);
 979
 980 $default_schema->{properties}->{properties}->{additionalProperties} = $default_schema;
 981 $default_schema->{properties}->{additionalProperties}->{properties} = $default_schema->{properties};
 982
 983 $default_schema->{properties}->{items}->{properties} = $default_schema->{properties};
 984 $default_schema->{properties}->{items}->{additionalProperties} = 0;
 985
 986 $default_schema->{properties}->{disallow}->{properties} = $default_schema->{properties};
 987 $default_schema->{properties}->{disallow}->{additionalProperties} = 0;
 988
 989 $default_schema->{properties}->{requires}->{properties} = $default_schema->{properties};
 990 $default_schema->{properties}->{requires}->{additionalProperties} = 0;
 991
 992 $default_schema->{properties}->{extends}->{properties} = $default_schema->{properties};
 993 $default_schema->{properties}->{extends}->{additionalProperties} = 0;
 994
 995 my $method_schema = {
 996     type => "object",
 997     additionalProperties => 0,
 998     properties => {
 999         description => {
1000             description => "This a description of the method",
1001             optional => 1,
1002         },
1003         name => {
1004             type =>  'string',
1005             description => "This indicates the name of the function to call.",
1006             optional => 1,
1007             requires => {
1008                 additionalProperties => 1,
1009                 properties => {
1010                     name => {},
1011                     description => {},
1012                     code => {},
1013                     method => {},
1014                     parameters => {},
1015                     path => {},
1016                     parameters => {},
1017                     returns => {},
1018                 }
1019             },
1020         },
1021         method => {
1022             type =>  'string',
1023             description => "The HTTP method name.",
1024             enum => [ 'GET', 'POST', 'PUT', 'DELETE' ],
1025             optional => 1,
1026         },
1027         protected => {
1028             type => 'boolean',
1029             description => "Method needs special privileges - only pvedaemon can execute it",
1030             optional => 1,
1031         },
1032         proxyto => {
1033             type =>  'string',
1034             description => "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
1035             optional => 1,
1036         },
1037         permissions => {
1038             type => 'object',
1039             description => "Required access permissions. By default only 'root' is allowed to access this method.",
1040             optional => 1,
1041             additionalProperties => 0,
1042             properties => {
1043                 description => {
1044                      description => "Describe access permissions.",
1045                      optional => 1,
1046                 },
1047                 user => {
1048                     description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
1049                     type => 'string',
1050                     enum => ['all', 'world'],
1051                     optional => 1,
1052                 },
1053                 check => {
1054                     description => "Array of permission checks (prefix notation).",
1055                     type => 'array',
1056                     optional => 1
1057                 },
1058             },
1059         },
1060         match_name => {
1061             description => "Used internally",
1062             optional => 1,
1063         },
1064         match_re => {
1065             description => "Used internally",
1066             optional => 1,
1067         },
1068         path => {
1069             type =>  'string',
1070             description => "path for URL matching (uri template)",
1071         },
1072         fragmentDelimiter => {
1073             type => 'string',
1074             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.",
1075             optional => 1,
1076         },
1077         parameters => {
1078             type => 'object',
1079             description => "JSON Schema for parameters.",
1080             optional => 1,
1081         },
1082         formatter => {
1083             type => 'object',
1084             description => "Used to store page formatter information (set by PVE::RESTHandler->register_page_formatter).",
1085             optional => 1,
1086         },
1087         returns => {
1088             type => 'object',
1089             description => "JSON Schema for return value.",
1090             optional => 1,
1091         },
1092         code => {
1093             type => 'coderef',
1094             description => "method implementaion (code reference)",
1095             optional => 1,
1096         },
1097         subclass => {
1098             type => 'string',
1099             description => "Delegate call to this class (perl class string).",
1100             optional => 1,
1101             requires => {
1102                 additionalProperties => 0,
1103                 properties => {
1104                     subclass => {},
1105                     path => {},
1106                     match_name => {},
1107                     match_re => {},
1108                     fragmentDelimiter => { optional => 1 }
1109                 }
1110             },
1111         },
1112     },
1113
1114 };
1115
1116 sub validate_schema {
1117     my ($schema) = @_;
1118
1119     my $errmsg = "internal error - unable to verify schema\n";
1120     validate($schema, $default_schema, $errmsg);
1121 }
1122
1123 sub validate_method_info {
1124     my $info = shift;
1125
1126     my $errmsg = "internal error - unable to verify method info\n";
1127     validate($info, $method_schema, $errmsg);
1128
1129     validate_schema($info->{parameters}) if $info->{parameters};
1130     validate_schema($info->{returns}) if $info->{returns};
1131 }
1132
1133 # run a self test on load
1134 # make sure we can verify the default schema
1135 validate_schema($default_schema_noref);
1136 validate_schema($method_schema);
1137
1138 # and now some utility methods (used by pve api)
1139 sub method_get_child_link {
1140     my ($info) = @_;
1141
1142     return undef if !$info;
1143
1144     my $schema = $info->{returns};
1145     return undef if !$schema || !$schema->{type} || $schema->{type} ne 'array';
1146
1147     my $links = $schema->{links};
1148     return undef if !$links;
1149
1150     my $found;
1151     foreach my $lnk (@$links) {
1152         if ($lnk->{href} && $lnk->{rel} && ($lnk->{rel} eq 'child')) {
1153             $found = $lnk;
1154             last;
1155         }
1156     }
1157
1158     return $found;
1159 }
1160
1161 # a way to parse command line parameters, using a
1162 # schema to configure Getopt::Long
1163 sub get_options {
1164     my ($schema, $args, $arg_param, $fixed_param, $pwcallback) = @_;
1165
1166     if (!$schema || !$schema->{properties}) {
1167         raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1168             if scalar(@$args) != 0;
1169         return {};
1170     }
1171
1172     my $list_param;
1173     if ($arg_param && !ref($arg_param)) {
1174         my $pd = $schema->{properties}->{$arg_param};
1175         die "expected list format $pd->{format}"
1176             if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
1177         $list_param = $arg_param;
1178     }
1179
1180     my @getopt = ();
1181     foreach my $prop (keys %{$schema->{properties}}) {
1182         my $pd = $schema->{properties}->{$prop};
1183         next if $list_param && $prop eq $list_param;
1184         next if defined($fixed_param->{$prop});
1185
1186         if ($prop eq 'password' && $pwcallback) {
1187             # we do not accept plain password on input line, instead
1188             # we turn this into a boolean option and ask for password below
1189             # using $pwcallback() (for security reasons).
1190             push @getopt, "$prop";
1191         } elsif ($pd->{type} eq 'boolean') {
1192             push @getopt, "$prop:s";
1193         } else {
1194             if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
1195                 push @getopt, "$prop=s@";
1196             } else {
1197                 push @getopt, "$prop=s";
1198             }
1199         }
1200     }
1201
1202     Getopt::Long::Configure('prefix_pattern=(--|-)');
1203
1204     my $opts = {};
1205     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
1206         if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
1207
1208     if (@$args) {
1209         if ($list_param) {
1210             $opts->{$list_param} = $args;
1211             $args = [];
1212         } elsif (ref($arg_param)) {
1213             foreach my $arg_name (@$arg_param) {
1214                 if ($opts->{'extra-args'}) {
1215                     raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
1216                 }
1217                 if ($arg_name eq 'extra-args') {
1218                     $opts->{'extra-args'} = $args;
1219                     $args = [];
1220                     next;
1221                 }
1222                 raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
1223                 $opts->{$arg_name} = shift @$args;
1224             }
1225             raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
1226         } else {
1227             raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1228                 if scalar(@$args) != 0;
1229         }
1230     }
1231
1232     if (my $pd = $schema->{properties}->{password}) {
1233         if ($pd->{type} ne 'boolean' && $pwcallback) {
1234             if ($opts->{password} || !$pd->{optional}) {
1235                 $opts->{password} = &$pwcallback();
1236             }
1237         }
1238     }
1239
1240     $opts = PVE::Tools::decode_utf8_parameters($opts);
1241
1242     foreach my $p (keys %$opts) {
1243         if (my $pd = $schema->{properties}->{$p}) {
1244             if ($pd->{type} eq 'boolean') {
1245                 if ($opts->{$p} eq '') {
1246                     $opts->{$p} = 1;
1247                 } elsif ($opts->{$p} =~ m/^(1|true|yes|on)$/i) {
1248                     $opts->{$p} = 1;
1249                 } elsif ($opts->{$p} =~ m/^(0|false|no|off)$/i) {
1250                     $opts->{$p} = 0;
1251                 } else {
1252                     raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
1253                 }
1254             } elsif ($pd->{format}) {
1255
1256                 if ($pd->{format} =~ m/-list/) {
1257                     # allow --vmid 100 --vmid 101 and --vmid 100,101
1258                     # allow --dow mon --dow fri and --dow mon,fri
1259                     $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
1260                 } elsif ($pd->{format} =~ m/-alist/) {
1261                     # we encode array as \0 separated strings
1262                     # Note: CGI.pm also use this encoding
1263                     if (scalar(@{$opts->{$p}}) != 1) {
1264                         $opts->{$p} = join("\0", @{$opts->{$p}});
1265                     } else {
1266                         # st that split_list knows it is \0 terminated
1267                         my $v = $opts->{$p}->[0];
1268                         $opts->{$p} = "$v\0";
1269                     }
1270                 }
1271             }
1272         }
1273     }
1274
1275     foreach my $p (keys %$fixed_param) {
1276         $opts->{$p} = $fixed_param->{$p};
1277     }
1278
1279     return $opts;
1280 }
1281
1282 # A way to parse configuration data by giving a json schema
1283 sub parse_config {
1284     my ($schema, $filename, $raw) = @_;
1285
1286     # do fast check (avoid validate_schema($schema))
1287     die "got strange schema" if !$schema->{type} ||
1288         !$schema->{properties} || $schema->{type} ne 'object';
1289
1290     my $cfg = {};
1291
1292     while ($raw =~ /^\s*(.+?)\s*$/gm) {
1293         my $line = $1;
1294
1295         next if $line =~ /^#/;
1296
1297         if ($line =~ m/^(\S+?):\s*(.*)$/) {
1298             my $key = $1;
1299             my $value = $2;
1300             if ($schema->{properties}->{$key} &&
1301                 $schema->{properties}->{$key}->{type} eq 'boolean') {
1302
1303                 $value = 1 if $value =~ m/^(1|on|yes|true)$/i;
1304                 $value = 0 if $value =~ m/^(0|off|no|false)$/i;
1305             }
1306             $cfg->{$key} = $value;
1307         } else {
1308             warn "ignore config line: $line\n"
1309         }
1310     }
1311
1312     my $errors = {};
1313     check_prop($cfg, $schema, '', $errors);
1314
1315     foreach my $k (keys %$errors) {
1316         warn "parse error in '$filename' - '$k': $errors->{$k}\n";
1317         delete $cfg->{$k};
1318     }
1319
1320     return $cfg;
1321 }
1322
1323 # generate simple key/value file
1324 sub dump_config {
1325     my ($schema, $filename, $cfg) = @_;
1326
1327     # do fast check (avoid validate_schema($schema))
1328     die "got strange schema" if !$schema->{type} ||
1329         !$schema->{properties} || $schema->{type} ne 'object';
1330
1331     validate($cfg, $schema, "validation error in '$filename'\n");
1332
1333     my $data = '';
1334
1335     foreach my $k (keys %$cfg) {
1336         $data .= "$k: $cfg->{$k}\n";
1337     }
1338
1339     return $data;
1340 }
1341
1342 sub generate_typetext {
1343     my ($schema) = @_;
1344     my $typetext = '';
1345     my (@optional, @required);
1346     foreach my $key (sort keys %$schema) {
1347         next if !$schema->{$key}->{format_description} &&
1348                 !$schema->{$key}->{typetext};
1349         if ($schema->{$key}->{optional}) {
1350             push @optional, $key;
1351         } else {
1352             push @required, $key;
1353         }
1354     }
1355     my ($pre, $post) = ('', '');
1356     my $add = sub {
1357         my ($key) = @_;
1358         if (my $desc = $schema->{$key}->{format_description}) {
1359             $typetext .= "$pre$key=<$desc>$post";
1360         } elsif (my $text = $schema->{$key}->{typetext}) {
1361             $typetext .= "$pre$text$post";
1362         } else {
1363             die "internal error: neither format_description nor typetext found";
1364         }
1365     };
1366     foreach my $key (@required) {
1367         &$add($key);
1368         $pre = ', ';
1369     }
1370     $pre = $pre ? ' [,' : '[';
1371     $post = ']';
1372     foreach my $key (@optional) {
1373         &$add($key);
1374         $pre = ' [,';
1375     }
1376     return $typetext;
1377 }
1378
1379 1;