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     if ($ct eq 'boolean' || $ct eq 'integer' || $ct eq 'number') {
 263         return $value + 0; # convert to number
 264     }
 265
 266     return $value;
 267 }
 268
 269 sub parse_section_header {
 270     my ($class, $line) = @_;
 271
 272     if ($line =~ m/^(\S+):\s*(\S+)\s*$/) {
 273         my ($type, $sectionId) = ($1, $2);
 274         my $errmsg = undef; # set if you want to skip whole section
 275         my $config = {}; # to return additional attributes
 276         return ($type, $sectionId, $errmsg, $config);
 277     }
 278     return undef;
 279 }
 280
 281 sub format_section_header {
 282     my ($class, $type, $sectionId, $scfg, $done_hash) = @_;
 283
 284     return "$type: $sectionId\n";
 285 }
 286
 287
 288 sub parse_config {
 289     my ($class, $filename, $raw) = @_;
 290
 291     my $pdata = $class->private();
 292
 293     my $ids = {};
 294     my $order = {};
 295
 296     $raw = '' if !defined($raw);
 297
 298     my $digest = Digest::SHA::sha1_hex($raw);
 299
 300     my $pri = 1;
 301
 302     my $lineno = 0;
 303     my @lines = split(/\n/, $raw);
 304     my $nextline = sub {
 305         while (defined(my $line = shift @lines)) {
 306             $lineno++;
 307             return $line if ($line !~ /^\s*#/);
 308         }
 309     };
 310
 311     while (@lines) {
 312         my $line = $nextline->();
 313         next if !$line;
 314
 315         my $errprefix = "file $filename line $lineno";
 316
 317         my ($type, $sectionId, $errmsg, $config) = $class->parse_section_header($line);
 318         if ($config) {
 319             my $ignore = 0;
 320
 321             my $plugin;
 322
 323             if ($errmsg) {
 324                 $ignore = 1;
 325                 chomp $errmsg;
 326                 warn "$errprefix (skip section '$sectionId'): $errmsg\n";
 327             } elsif (!$type) {
 328                 $ignore = 1;
 329                 warn "$errprefix (skip section '$sectionId'): missing type - internal error\n";
 330             } else {
 331                 if (!($plugin = $pdata->{plugins}->{$type})) {
 332                     $ignore = 1;
 333                     warn "$errprefix (skip section '$sectionId'): unsupported type '$type'\n";
 334                 }
 335             }
 336
 337             while ($line = $nextline->()) {
 338                 next if $ignore; # skip
 339
 340                 $errprefix = "file $filename line $lineno";
 341
 342                 if ($line =~ m/^\s+(\S+)(\s+(.*\S))?\s*$/) {
 343                     my ($k, $v) = ($1, $3);
 344
 345                     eval {
 346                         die "duplicate attribute\n" if defined($config->{$k});
 347                         $config->{$k} = $plugin->check_value($type, $k, $v, $sectionId);
 348                     };
 349                     warn "$errprefix (section '$sectionId') - unable to parse value of '$k': $@" if $@;
 350
 351                 } else {
 352                     warn "$errprefix (section '$sectionId') - ignore config line: $line\n";
 353                 }
 354             }
 355
 356             if (!$ignore && $type && $plugin && $config) {
 357                 $config->{type} = $type;
 358                 eval { $ids->{$sectionId} = $plugin->check_config($sectionId, $config, 1, 1); };
 359                 warn "$errprefix (skip section '$sectionId'): $@" if $@;
 360                 $order->{$sectionId} = $pri++;
 361             }
 362
 363         } else {
 364             warn "$errprefix - ignore config line: $line\n";
 365         }
 366     }
 367
 368
 369     my $cfg = { ids => $ids, order => $order, digest => $digest};
 370
 371     return $cfg;
 372 }
 373
 374 sub check_config {
 375     my ($class, $sectionId, $config, $create, $skipSchemaCheck) = @_;
 376
 377     my $type = $class->type();
 378     my $pdata = $class->private();
 379     my $opts = $pdata->{options}->{$type};
 380
 381     my $settings = { type => $type };
 382
 383     foreach my $k (keys %$config) {
 384         my $value = $config->{$k};
 385
 386         die "can't change value of fixed parameter '$k'\n"
 387             if !$create && defined($opts->{$k}) && $opts->{$k}->{fixed};
 388
 389         if (defined($value)) {
 390             my $tmp = $class->check_value($type, $k, $value, $sectionId, $skipSchemaCheck);
 391             $settings->{$k} = $class->decode_value($type, $k, $tmp);
 392         } else {
 393             die "got undefined value for option '$k'\n";
 394         }
 395     }
 396
 397     if ($create) {
 398         # check if we have a value for all required options
 399         foreach my $k (keys %$opts) {
 400             next if $opts->{$k}->{optional};
 401             die "missing value for required option '$k'\n"
 402                 if !defined($config->{$k});
 403         }
 404     }
 405
 406     return $settings;
 407 }
 408
 409 my $format_config_line = sub {
 410     my ($schema, $key, $value) = @_;
 411
 412     my $ct = $schema->{type};
 413
 414     die "property '$key' contains a line feed\n"
 415         if ($key =~ m/[\n\r]/) || ($value =~ m/[\n\r]/);
 416
 417     if ($ct eq 'boolean') {
 418         return "\t$key " . ($value ? 1 : 0) . "\n"
 419             if defined($value);
 420     } else {
 421         return "\t$key $value\n" if "$value" ne '';
 422     }
 423 };
 424
 425 sub write_config {
 426     my ($class, $filename, $cfg) = @_;
 427
 428     my $pdata = $class->private();
 429     my $propertyList = $pdata->{propertyList};
 430
 431     my $out = '';
 432
 433     my $ids = $cfg->{ids};
 434     my $order = $cfg->{order};
 435
 436     my $maxpri = 0;
 437     foreach my $sectionId (keys %$ids) {
 438         my $pri = $order->{$sectionId};
 439         $maxpri = $pri if $pri && $pri > $maxpri;
 440     }
 441     foreach my $sectionId (keys %$ids) {
 442         if (!defined ($order->{$sectionId})) {
 443             $order->{$sectionId} = ++$maxpri;
 444         }
 445     }
 446
 447     foreach my $sectionId (sort {$order->{$a} <=> $order->{$b}} keys %$ids) {
 448         my $scfg = $ids->{$sectionId};
 449         my $type = $scfg->{type};
 450         my $opts = $pdata->{options}->{$type};
 451
 452         die "unknown section type '$type'\n" if !$opts;
 453
 454         my $done_hash = {};
 455
 456         my $data = $class->format_section_header($type, $sectionId, $scfg, $done_hash);
 457         if ($scfg->{comment} && !$done_hash->{comment}) {
 458             my $k = 'comment';
 459             my $v = $class->encode_value($type, $k, $scfg->{$k});
 460             $data .= &$format_config_line($propertyList->{$k}, $k, $v);
 461         }
 462
 463         $data .= "\tdisable\n" if $scfg->{disable} && !$done_hash->{disable};
 464
 465         $done_hash->{comment} = 1;
 466         $done_hash->{disable} = 1;
 467
 468         my @option_keys = sort keys %$opts;
 469         foreach my $k (@option_keys) {
 470             next if defined($done_hash->{$k});
 471             next if $opts->{$k}->{optional};
 472             $done_hash->{$k} = 1;
 473             my $v = $scfg->{$k};
 474             die "section '$sectionId' - missing value for required option '$k'\n"
 475                 if !defined ($v);
 476             $v = $class->encode_value($type, $k, $v);
 477             $data .= &$format_config_line($propertyList->{$k}, $k, $v);
 478         }
 479
 480         foreach my $k (@option_keys) {
 481             next if defined($done_hash->{$k});
 482             my $v = $scfg->{$k};
 483             next if !defined($v);
 484             $v = $class->encode_value($type, $k, $v);
 485             $data .= &$format_config_line($propertyList->{$k}, $k, $v);
 486         }
 487
 488         $out .= "$data\n";
 489     }
 490
 491     return $out;
 492 }
 493
 494 sub assert_if_modified {
 495     my ($cfg, $digest) = @_;
 496
 497     PVE::Tools::assert_if_modified($cfg->{digest}, $digest);
 498 }
 499
 500 1;