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