update files from pve-common
[pve-client.git] / 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;