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