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