PVE/APIClient/SectionConfig.pm

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