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