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