src/PVE/SectionConfig.pm

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