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