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