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