src/PVE/JSONSchema.pm

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