src/PVE/SectionConfig.pm

   1 package PVE::SectionConfig;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp;
   7 use Digest::SHA;
   8
   9 use PVE::Exception qw(raise_param_exc);
  10 use PVE::JSONSchema qw(get_standard_option);
  11
  12 my $defaultData = {
  13     options => {},
  14     plugins => {},
  15     plugindata => {},
  16     propertyList => {},
  17 };
  18
  19 sub private {
  20     die "overwrite me";
  21     return $defaultData;
  22 }
  23
  24 sub register {
  25     my ($class) = @_;
  26
  27     my $type = $class->type();
  28     my $pdata = $class->private();
  29
  30     die "duplicate plugin registration (type = $type)"
  31         if defined($pdata->{plugins}->{$type});
  32
  33     my $plugindata = $class->plugindata();
  34     $pdata->{plugindata}->{$type} = $plugindata;
  35     $pdata->{plugins}->{$type} = $class;
  36 }
  37
  38 sub type {
  39     die "overwrite me";
  40 }
  41
  42 sub properties {
  43     return {};
  44 }
  45
  46 sub options {
  47     return {};
  48 }
  49
  50 sub plugindata {
  51     return {};
  52 }
  53
  54 sub createSchema {
  55     my ($class, $skip_type, $base) = @_;
  56
  57     my $pdata = $class->private();
  58     my $propertyList = $pdata->{propertyList};
  59     my $plugins = $pdata->{plugins};
  60
  61     my $props = $base || {};
  62
  63     my $copy_property = sub {
  64         my ($src) = @_;
  65
  66         my $res = {};
  67         foreach my $k (keys %$src) {
  68             $res->{$k} = $src->{$k};
  69         }
  70
  71         return $res;
  72     };
  73
  74     foreach my $p (keys %$propertyList) {
  75         next if $skip_type && $p eq 'type';
  76
  77         if (!$propertyList->{$p}->{optional}) {
  78             $props->{$p} = $propertyList->{$p};
  79             next;
  80         }
  81
  82         my $required = 1;
  83
  84         my $copts = $class->options();
  85         $required = 0 if defined($copts->{$p}) && $copts->{$p}->{optional};
  86
  87         foreach my $t (keys %$plugins) {
  88             my $opts = $pdata->{options}->{$t} || {};
  89             $required = 0 if !defined($opts->{$p}) || $opts->{$p}->{optional};
  90         }
  91
  92         if ($required) {
  93             # make a copy, because we modify the optional property
  94             my $res = &$copy_property($propertyList->{$p});
  95             $res->{optional} = 0;
  96             $props->{$p} = $res;
  97         } else {
  98             $props->{$p} = $propertyList->{$p};
  99         }
 100     }
 101
 102     return {
 103         type => "object",
 104         additionalProperties => 0,
 105         properties => $props,
 106     };
 107 }
 108
 109 sub updateSchema {
 110     my ($class, $single_class, $base) = @_;
 111
 112     my $pdata = $class->private();
 113     my $propertyList = $pdata->{propertyList};
 114     my $plugins = $pdata->{plugins};
 115
 116     my $props = $base || {};
 117
 118     my $filter_type = $single_class ? $class->type() : undef;
 119
 120     foreach my $p (keys %$propertyList) {
 121         next if $p eq 'type';
 122
 123         my $copts = $class->options();
 124
 125         next if defined($filter_type) && !defined($copts->{$p});
 126
 127         if (!$propertyList->{$p}->{optional}) {
 128             $props->{$p} = $propertyList->{$p};
 129             next;
 130         }
 131
 132         my $modifyable = 0;
 133
 134         $modifyable = 1 if defined($copts->{$p}) && !$copts->{$p}->{fixed};
 135
 136         foreach my $t (keys %$plugins) {
 137             my $opts = $pdata->{options}->{$t} || {};
 138             next if !defined($opts->{$p});
 139             $modifyable = 1 if !$opts->{$p}->{fixed};
 140         }
 141         next if !$modifyable;
 142
 143         $props->{$p} = $propertyList->{$p};
 144     }
 145
 146     $props->{digest} = get_standard_option('pve-config-digest');
 147
 148     $props->{delete} = {
 149         type => 'string', format => 'pve-configid-list',
 150         description => "A list of settings you want to delete.",
 151         maxLength => 4096,
 152         optional => 1,
 153     };
 154
 155     return {
 156         type => "object",
 157         additionalProperties => 0,
 158         properties => $props,
 159     };
 160 }
 161
 162 sub init {
 163     my ($class) = @_;
 164
 165     my $pdata = $class->private();
 166
 167     foreach my $k (qw(options plugins plugindata propertyList)) {
 168         $pdata->{$k} = {} if !$pdata->{$k};
 169     }
 170
 171     my $plugins = $pdata->{plugins};
 172     my $propertyList = $pdata->{propertyList};
 173
 174     foreach my $type (keys %$plugins) {
 175         my $props = $plugins->{$type}->properties();
 176         foreach my $p (keys %$props) {
 177             die "duplicate property '$p'" if defined($propertyList->{$p});
 178             my $res = $propertyList->{$p} = {};
 179             my $data = $props->{$p};
 180             for my $a (keys %$data) {
 181                 $res->{$a} = $data->{$a};
 182             }
 183             $res->{optional} = 1;
 184         }
 185     }
 186
 187     foreach my $type (keys %$plugins) {
 188         my $opts = $plugins->{$type}->options();
 189         foreach my $p (keys %$opts) {
 190             die "undefined property '$p'" if !$propertyList->{$p};
 191         }
 192         $pdata->{options}->{$type} = $opts;
 193     }
 194
 195     $propertyList->{type}->{type} = 'string';
 196     $propertyList->{type}->{enum} = [sort keys %$plugins];
 197 }
 198
 199 sub lookup {
 200     my ($class, $type) = @_;
 201
 202     croak "cannot lookup undefined type!" if !defined($type);
 203
 204     my $pdata = $class->private();
 205     my $plugin = $pdata->{plugins}->{$type};
 206
 207     die "unknown section type '$type'\n" if !$plugin;
 208
 209     return $plugin;
 210 }
 211
 212 sub lookup_types {
 213     my ($class) = @_;
 214
 215     my $pdata = $class->private();
 216
 217     return [ sort keys %{$pdata->{plugins}} ];
 218 }
 219
 220 sub decode_value {
 221     my ($class, $type, $key, $value) = @_;
 222
 223     return $value;
 224 }
 225
 226 sub encode_value {
 227     my ($class, $type, $key, $value) = @_;
 228
 229     return $value;
 230 }
 231
 232 sub check_value {
 233     my ($class, $type, $key, $value, $storeid, $skipSchemaCheck) = @_;
 234
 235     my $pdata = $class->private();
 236
 237     return $value if $key eq 'type' && $type eq $value;
 238
 239     my $opts = $pdata->{options}->{$type};
 240     die "unknown section type '$type'\n" if !$opts;
 241
 242     die "unexpected property '$key'\n" if !defined($opts->{$key});
 243
 244     my $schema = $pdata->{propertyList}->{$key};
 245     die "unknown property type\n" if !$schema;
 246
 247     my $ct = $schema->{type};
 248
 249     $value = 1 if $ct eq 'boolean' && !defined($value);
 250
 251     die "got undefined value\n" if !defined($value);
 252
 253     die "property contains a line feed\n" if $value =~ m/[\n\r]/;
 254
 255     if (!$skipSchemaCheck) {
 256         my $errors = {};
 257
 258         my $checkschema = $schema;
 259
 260         if ($ct eq 'array') {
 261             die "no item schema for array" if !defined($schema->{items});
 262             $checkschema = $schema->{items};
 263         }
 264
 265         PVE::JSONSchema::check_prop($value, $checkschema, '', $errors);
 266         if (scalar(keys %$errors)) {
 267             die "$errors->{$key}\n" if $errors->{$key};
 268             die "$errors->{_root}\n" if $errors->{_root};
 269             die "unknown error\n";
 270         }
 271     }
 272
 273     if ($ct eq 'boolean' || $ct eq 'integer' || $ct eq 'number') {
 274         return $value + 0; # convert to number
 275     }
 276
 277     return $value;
 278 }
 279
 280 sub parse_section_header {
 281     my ($class, $line) = @_;
 282
 283     if ($line =~ m/^(\S+):\s*(\S+)\s*$/) {
 284         my ($type, $sectionId) = ($1, $2);
 285         my $errmsg = undef; # set if you want to skip whole section
 286         my $config = {}; # to return additional attributes
 287         return ($type, $sectionId, $errmsg, $config);
 288     }
 289     return undef;
 290 }
 291
 292 sub format_section_header {
 293     my ($class, $type, $sectionId, $scfg, $done_hash) = @_;
 294
 295     return "$type: $sectionId\n";
 296 }
 297
 298
 299 sub parse_config {
 300     my ($class, $filename, $raw, $allow_unknown) = @_;
 301
 302     my $pdata = $class->private();
 303
 304     my $ids = {};
 305     my $order = {};
 306
 307     $raw = '' if !defined($raw);
 308
 309     my $digest = Digest::SHA::sha1_hex($raw);
 310
 311     my $pri = 1;
 312
 313     my $lineno = 0;
 314     my @lines = split(/\n/, $raw);
 315     my $nextline = sub {
 316         while (defined(my $line = shift @lines)) {
 317             $lineno++;
 318             return $line if ($line !~ /^\s*#/);
 319         }
 320     };
 321
 322     my $is_array = sub {
 323         my ($type, $key) = @_;
 324
 325         my $schema = $pdata->{propertyList}->{$key};
 326         die "unknown property type\n" if !$schema;
 327
 328         return $schema->{type} eq 'array';
 329     };
 330
 331     my $errors = [];
 332     while (@lines) {
 333         my $line = $nextline->();
 334         next if !$line;
 335
 336         my $errprefix = "file $filename line $lineno";
 337
 338         my ($type, $sectionId, $errmsg, $config) = $class->parse_section_header($line);
 339         if ($config) {
 340             my $skip = 0;
 341             my $unknown = 0;
 342
 343             my $plugin;
 344
 345             if ($errmsg) {
 346                 $skip = 1;
 347                 chomp $errmsg;
 348                 warn "$errprefix (skip section '$sectionId'): $errmsg\n";
 349             } elsif (!$type) {
 350                 $skip = 1;
 351                 warn "$errprefix (skip section '$sectionId'): missing type - internal error\n";
 352             } else {
 353                 if (!($plugin = $pdata->{plugins}->{$type})) {
 354                     if ($allow_unknown) {
 355                         $unknown = 1;
 356                     } else {
 357                         $skip = 1;
 358                         warn "$errprefix (skip section '$sectionId'): unsupported type '$type'\n";
 359                     }
 360                 }
 361             }
 362
 363             while ($line = $nextline->()) {
 364                 next if $skip; # skip
 365
 366                 $errprefix = "file $filename line $lineno";
 367
 368                 if ($line =~ m/^\s+(\S+)(\s+(.*\S))?\s*$/) {
 369                     my ($k, $v) = ($1, $3);
 370
 371                     eval {
 372                         if ($unknown) {
 373                             if (!defined($config->{$k})) {
 374                                 $config->{$k} = $v;
 375                             } else {
 376                                 if (!ref($config->{$k})) {
 377                                     $config->{$k} = [$config->{$k}];
 378                                 }
 379                                 push $config->{$k}->@*, $v;
 380                             }
 381                         } elsif ($is_array->($type, $k)) {
 382                             $v = $plugin->check_value($type, $k, $v, $sectionId);
 383                             $config->{$k} = [] if !defined($config->{$k});
 384                             push $config->{$k}->@*, $v;
 385                         } else {
 386                             die "duplicate attribute\n" if defined($config->{$k});
 387                             $v = $plugin->check_value($type, $k, $v, $sectionId);
 388                             $config->{$k} = $v;
 389                         }
 390                     };
 391                     if (my $err = $@) {
 392                         warn "$errprefix (section '$sectionId') - unable to parse value of '$k': $err";
 393                         push @$errors, {
 394                             context => $errprefix,
 395                             section => $sectionId,
 396                             key => $k,
 397                             err => $err,
 398                         };
 399                     }
 400
 401                 } else {
 402                     warn "$errprefix (section '$sectionId') - ignore config line: $line\n";
 403                 }
 404             }
 405
 406             if ($unknown) {
 407                 $config->{type} = $type;
 408                 $ids->{$sectionId} = $config;
 409                 $order->{$sectionId} = $pri++;
 410             } elsif (!$skip && $type && $plugin && $config) {
 411                 $config->{type} = $type;
 412                 if (!$unknown) {
 413                     $config = eval { $config = $plugin->check_config($sectionId, $config, 1, 1); };
 414                     warn "$errprefix (skip section '$sectionId'): $@" if $@;
 415                 }
 416                 $ids->{$sectionId} = $config;
 417                 $order->{$sectionId} = $pri++;
 418             }
 419
 420         } else {
 421             warn "$errprefix - ignore config line: $line\n";
 422         }
 423     }
 424
 425     my $cfg = {
 426         ids => $ids,
 427         order => $order,
 428         digest => $digest
 429     };
 430     $cfg->{errors} = $errors if scalar(@$errors) > 0;
 431
 432     return $cfg;
 433 }
 434
 435 sub check_config {
 436     my ($class, $sectionId, $config, $create, $skipSchemaCheck) = @_;
 437
 438     my $type = $class->type();
 439     my $pdata = $class->private();
 440     my $opts = $pdata->{options}->{$type};
 441
 442     my $settings = { type => $type };
 443
 444     foreach my $k (keys %$config) {
 445         my $value = $config->{$k};
 446
 447         die "can't change value of fixed parameter '$k'\n"
 448             if !$create && defined($opts->{$k}) && $opts->{$k}->{fixed};
 449
 450         if (defined($value)) {
 451             my $tmp = $class->check_value($type, $k, $value, $sectionId, $skipSchemaCheck);
 452             $settings->{$k} = $class->decode_value($type, $k, $tmp);
 453         } else {
 454             die "got undefined value for option '$k'\n";
 455         }
 456     }
 457
 458     if ($create) {
 459         # check if we have a value for all required options
 460         foreach my $k (keys %$opts) {
 461             next if $opts->{$k}->{optional};
 462             die "missing value for required option '$k'\n"
 463                 if !defined($config->{$k});
 464         }
 465     }
 466
 467     return $settings;
 468 }
 469
 470 my $format_config_line = sub {
 471     my ($schema, $key, $value) = @_;
 472
 473     my $ct = $schema->{type};
 474
 475     die "property '$key' contains a line feed\n"
 476         if ($key =~ m/[\n\r]/) || ($value =~ m/[\n\r]/);
 477
 478     if ($ct eq 'boolean') {
 479         return "\t$key " . ($value ? 1 : 0) . "\n"
 480             if defined($value);
 481     } elsif ($ct eq 'array') {
 482         die "property '$key' is not an array" if ref($value) ne 'ARRAY';
 483         my $result = '';
 484         for my $line ($value->@*) {
 485             $result .= "\t$key $line\n" if $value ne '';
 486         }
 487         return $result;
 488     } else {
 489         return "\t$key $value\n" if "$value" ne '';
 490     }
 491 };
 492
 493 sub write_config {
 494     my ($class, $filename, $cfg, $allow_unknown) = @_;
 495
 496     my $pdata = $class->private();
 497     my $propertyList = $pdata->{propertyList};
 498
 499     my $out = '';
 500
 501     my $ids = $cfg->{ids};
 502     my $order = $cfg->{order};
 503
 504     my $maxpri = 0;
 505     foreach my $sectionId (keys %$ids) {
 506         my $pri = $order->{$sectionId};
 507         $maxpri = $pri if $pri && $pri > $maxpri;
 508     }
 509     foreach my $sectionId (keys %$ids) {
 510         if (!defined ($order->{$sectionId})) {
 511             $order->{$sectionId} = ++$maxpri;
 512         }
 513     }
 514
 515     foreach my $sectionId (sort {$order->{$a} <=> $order->{$b}} keys %$ids) {
 516         my $scfg = $ids->{$sectionId};
 517         my $type = $scfg->{type};
 518         my $opts = $pdata->{options}->{$type};
 519
 520         die "unknown section type '$type'\n" if !$opts && !$allow_unknown;
 521
 522         my $done_hash = {};
 523
 524         my $data = $class->format_section_header($type, $sectionId, $scfg, $done_hash);
 525
 526         if (!$opts && $allow_unknown) {
 527             $done_hash->{type} = 1;
 528             my @first = exists($scfg->{comment}) ? ('comment') : ();
 529             for my $k (@first, sort keys %$scfg) {
 530                 next if defined($done_hash->{$k});
 531                 $done_hash->{$k} = 1;
 532                 my $v = $scfg->{$k};
 533                 my $ref = ref($v);
 534                 if (defined($ref) && $ref eq 'ARRAY') {
 535                     $data .= "\t$k $_\n" for $v->@*;
 536                 } else {
 537                     $data .= "\t$k $v\n";
 538                 }
 539             }
 540             $out .= "$data\n";
 541             next;
 542         }
 543
 544
 545         if ($scfg->{comment} && !$done_hash->{comment}) {
 546             my $k = 'comment';
 547             my $v = $class->encode_value($type, $k, $scfg->{$k});
 548             $data .= &$format_config_line($propertyList->{$k}, $k, $v);
 549         }
 550
 551         $data .= "\tdisable\n" if $scfg->{disable} && !$done_hash->{disable};
 552
 553         $done_hash->{comment} = 1;
 554         $done_hash->{disable} = 1;
 555
 556         my @option_keys = sort keys %$opts;
 557         foreach my $k (@option_keys) {
 558             next if defined($done_hash->{$k});
 559             next if $opts->{$k}->{optional};
 560             $done_hash->{$k} = 1;
 561             my $v = $scfg->{$k};
 562             die "section '$sectionId' - missing value for required option '$k'\n"
 563                 if !defined ($v);
 564             $v = $class->encode_value($type, $k, $v);
 565             $data .= &$format_config_line($propertyList->{$k}, $k, $v);
 566         }
 567
 568         foreach my $k (@option_keys) {
 569             next if defined($done_hash->{$k});
 570             my $v = $scfg->{$k};
 571             next if !defined($v);
 572             $v = $class->encode_value($type, $k, $v);
 573             $data .= &$format_config_line($propertyList->{$k}, $k, $v);
 574         }
 575
 576         $out .= "$data\n";
 577     }
 578
 579     return $out;
 580 }
 581
 582 sub assert_if_modified {
 583     my ($cfg, $digest) = @_;
 584
 585     PVE::Tools::assert_if_modified($cfg->{digest}, $digest);
 586 }
 587
 588 sub delete_from_config {
 589     my ($config, $option_schema, $new_options, $to_delete) = @_;
 590
 591     for my $k ($to_delete->@*) {
 592         my $d = $option_schema->{$k} || die "no such option '$k'\n";
 593         die "unable to delete required option '$k'\n" if !$d->{optional};
 594         die "unable to delete fixed option '$k'\n" if $d->{fixed};
 595         die "cannot set and delete property '$k' at the same time!\n"
 596             if defined($new_options->{$k});
 597         delete $config->{$k};
 598     }
 599
 600     return $config;
 601 }
 602
 603 1;