add 'name' to the list of utf8 encoded parameters
[pve-common.git] / data / PVE / JSONSchema.pm
CommitLineData
e143e9d8
DM
1package PVE::JSONSchema;
2
3use warnings;
4use strict;
5use Storable; # for dclone
6use Getopt::Long;
7use Devel::Cycle -quiet; # todo: remove?
8use PVE::Tools qw(split_list);
9use PVE::Exception qw(raise);
10use HTTP::Status qw(:constants);
11
12use base 'Exporter';
13
14our @EXPORT_OK = qw(
15register_standard_option
16get_standard_option
17);
18
19# Note: This class implements something similar to JSON schema, but it is not 100% complete.
20# see: http://tools.ietf.org/html/draft-zyp-json-schema-02
21# see: http://json-schema.org/
22
23# the code is similar to the javascript parser from http://code.google.com/p/jsonschema/
24
25my $standard_options = {};
26sub register_standard_option {
27 my ($name, $schema) = @_;
28
29 die "standard option '$name' already registered\n"
30 if $standard_options->{$name};
31
32 $standard_options->{$name} = $schema;
33}
34
35sub get_standard_option {
36 my ($name, $base) = @_;
37
38 my $std = $standard_options->{$name};
39 die "no such standard option\n" if !$std;
40
41 my $res = $base || {};
42
43 foreach my $opt (keys %$std) {
44 next if $res->{$opt};
45 $res->{$opt} = $std->{$opt};
46 }
47
48 return $res;
49};
50
51register_standard_option('pve-vmid', {
52 description => "The (unique) ID of the VM.",
53 type => 'integer', format => 'pve-vmid',
54 minimum => 1
55});
56
57register_standard_option('pve-node', {
58 description => "The cluster node name.",
59 type => 'string', format => 'pve-node',
60});
61
62register_standard_option('pve-node-list', {
63 description => "List of cluster node names.",
64 type => 'string', format => 'pve-node-list',
65});
66
67register_standard_option('pve-iface', {
68 description => "Network interface name.",
69 type => 'string', format => 'pve-iface',
70 minLength => 2, maxLength => 20,
71});
72
05e787c5
DM
73PVE::JSONSchema::register_standard_option('pve-storage-id', {
74 description => "The storage identifier.",
75 type => 'string', format => 'pve-storage-id',
76});
77
78
e143e9d8
DM
79my $format_list = {};
80
81sub register_format {
82 my ($format, $code) = @_;
83
84 die "JSON schema format '$format' already registered\n"
85 if $format_list->{$format};
86
87 $format_list->{$format} = $code;
88}
89
90# register some common type for pve
8ba7c72b
DM
91
92register_format('string', sub {}); # allow format => 'string-list'
93
e143e9d8
DM
94register_format('pve-configid', \&pve_verify_configid);
95sub pve_verify_configid {
96 my ($id, $noerr) = @_;
97
98 if ($id !~ m/^[a-z][a-z0-9_]+$/i) {
99 return undef if $noerr;
100 die "invalid cofiguration ID '$id'\n";
101 }
102 return $id;
103}
104
05e787c5
DM
105PVE::JSONSchema::register_format('pve-storage-id', \&parse_storage_id);
106sub parse_storage_id {
107 my ($storeid, $noerr) = @_;
108
109 if ($storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i) {
110 return undef if $noerr;
111 die "storage ID '$storeid' contains illegal characters\n";
112 }
113 return $storeid;
114}
115
116
e143e9d8
DM
117register_format('pve-vmid', \&pve_verify_vmid);
118sub pve_verify_vmid {
119 my ($vmid, $noerr) = @_;
120
121 if ($vmid !~ m/^[1-9][0-9]+$/) {
122 return undef if $noerr;
123 die "value does not look like a valid VM ID\n";
124 }
125 return $vmid;
126}
127
128register_format('pve-node', \&pve_verify_node_name);
129sub pve_verify_node_name {
130 my ($node, $noerr) = @_;
131
132 # todo: use better regex ?
133 if ($node !~ m/^[A-Za-z][[:alnum:]\-]*[[:alnum:]]+$/) {
134 return undef if $noerr;
135 die "value does not look like a valid node name\n";
136 }
137 return $node;
138}
139
140register_format('ipv4', \&pve_verify_ipv4);
141sub pve_verify_ipv4 {
142 my ($ipv4, $noerr) = @_;
143
144 if ($ipv4 !~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ||
145 !(($1 > 0) && ($1 < 255) &&
146 ($2 <= 255) && ($3 <= 255) &&
147 ($4 > 0) && ($4 < 255))) {
148 return undef if $noerr;
149 die "value does not look like a valid IP address\n";
150 }
151 return $ipv4;
152}
153register_format('ipv4mask', \&pve_verify_ipv4mask);
154sub pve_verify_ipv4mask {
155 my ($mask, $noerr) = @_;
156
157 if ($mask !~ m/^255\.255\.(\d{1,3})\.(\d{1,3})$/ ||
158 !(($1 <= 255) && ($2 <= 255))) {
159 return undef if $noerr;
160 die "value does not look like a valid IP netmask\n";
161 }
162 return $mask;
163}
164
165register_format('email', \&pve_verify_email);
166sub pve_verify_email {
167 my ($email, $noerr) = @_;
168
169 # we use same regex as extjs Ext.form.VTypes.email
170 if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,6}$/) {
171 return undef if $noerr;
172 die "value does not look like a valid email address\n";
173 }
174 return $email;
175}
176
177# network interface name
178register_format('pve-iface', \&pve_verify_iface);
179sub pve_verify_iface {
180 my ($id, $noerr) = @_;
181
182 if ($id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i) {
183 return undef if $noerr;
184 die "invalid network interface name '$id'\n";
185 }
186 return $id;
187}
188
189sub check_format {
190 my ($format, $value) = @_;
191
192 return if $format eq 'regex';
193
23dc9401 194 if ($format =~ m/^(.*)-a?list$/) {
e143e9d8
DM
195
196 my $code = $format_list->{$1};
197
198 die "undefined format '$format'\n" if !$code;
199
200 # Note: we allow empty lists
201 foreach my $v (split_list($value)) {
202 &$code($v);
203 }
204
205 } elsif ($format =~ m/^(.*)-opt$/) {
206
207 my $code = $format_list->{$1};
208
209 die "undefined format '$format'\n" if !$code;
210
211 return if !$value; # allow empty string
212
213 &$code($value);
214
215 } else {
216
217 my $code = $format_list->{$format};
218
219 die "undefined format '$format'\n" if !$code;
220
221 &$code($value);
222 }
223}
224
225sub add_error {
226 my ($errors, $path, $msg) = @_;
227
228 $path = '_root' if !$path;
229
230 if ($errors->{$path}) {
231 $errors->{$path} = join ('\n', $errors->{$path}, $msg);
232 } else {
233 $errors->{$path} = $msg;
234 }
235}
236
237sub is_number {
238 my $value = shift;
239
240 # see 'man perlretut'
241 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
242}
243
244sub is_integer {
245 my $value = shift;
246
247 return $value =~ m/^[+-]?\d+$/;
248}
249
250sub check_type {
251 my ($path, $type, $value, $errors) = @_;
252
253 return 1 if !$type;
254
255 if (!defined($value)) {
256 return 1 if $type eq 'null';
257 die "internal error"
258 }
259
260 if (my $tt = ref($type)) {
261 if ($tt eq 'ARRAY') {
262 foreach my $t (@$type) {
263 my $tmperr = {};
264 check_type($path, $t, $value, $tmperr);
265 return 1 if !scalar(%$tmperr);
266 }
267 my $ttext = join ('|', @$type);
268 add_error($errors, $path, "type check ('$ttext') failed");
269 return undef;
270 } elsif ($tt eq 'HASH') {
271 my $tmperr = {};
272 check_prop($value, $type, $path, $tmperr);
273 return 1 if !scalar(%$tmperr);
274 add_error($errors, $path, "type check failed");
275 return undef;
276 } else {
277 die "internal error - got reference type '$tt'";
278 }
279
280 } else {
281
282 return 1 if $type eq 'any';
283
284 if ($type eq 'null') {
285 if (defined($value)) {
286 add_error($errors, $path, "type check ('$type') failed - value is not null");
287 return undef;
288 }
289 return 1;
290 }
291
292 my $vt = ref($value);
293
294 if ($type eq 'array') {
295 if (!$vt || $vt ne 'ARRAY') {
296 add_error($errors, $path, "type check ('$type') failed");
297 return undef;
298 }
299 return 1;
300 } elsif ($type eq 'object') {
301 if (!$vt || $vt ne 'HASH') {
302 add_error($errors, $path, "type check ('$type') failed");
303 return undef;
304 }
305 return 1;
306 } elsif ($type eq 'coderef') {
307 if (!$vt || $vt ne 'CODE') {
308 add_error($errors, $path, "type check ('$type') failed");
309 return undef;
310 }
311 return 1;
312 } else {
313 if ($vt) {
314 add_error($errors, $path, "type check ('$type') failed - got $vt");
315 return undef;
316 } else {
317 if ($type eq 'string') {
318 return 1; # nothing to check ?
319 } elsif ($type eq 'boolean') {
320 #if ($value =~ m/^(1|true|yes|on)$/i) {
321 if ($value eq '1') {
322 return 1;
323 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
324 } elsif ($value eq '0') {
325 return 0;
326 } else {
327 add_error($errors, $path, "type check ('$type') failed - got '$value'");
328 return undef;
329 }
330 } elsif ($type eq 'integer') {
331 if (!is_integer($value)) {
332 add_error($errors, $path, "type check ('$type') failed - got '$value'");
333 return undef;
334 }
335 return 1;
336 } elsif ($type eq 'number') {
337 if (!is_number($value)) {
338 add_error($errors, $path, "type check ('$type') failed - got '$value'");
339 return undef;
340 }
341 return 1;
342 } else {
343 return 1; # no need to verify unknown types
344 }
345 }
346 }
347 }
348
349 return undef;
350}
351
352sub check_object {
353 my ($path, $schema, $value, $additional_properties, $errors) = @_;
354
355 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
356
357 my $st = ref($schema);
358 if (!$st || $st ne 'HASH') {
359 add_error($errors, $path, "Invalid schema definition.");
360 return;
361 }
362
363 my $vt = ref($value);
364 if (!$vt || $vt ne 'HASH') {
365 add_error($errors, $path, "an object is required");
366 return;
367 }
368
369 foreach my $k (keys %$schema) {
370 check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors);
371 }
372
373 foreach my $k (keys %$value) {
374
375 my $newpath = $path ? "$path.$k" : $k;
376
377 if (my $subschema = $schema->{$k}) {
378 if (my $requires = $subschema->{requires}) {
379 if (ref($requires)) {
380 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
381 check_prop($value, $requires, $path, $errors);
382 } elsif (!defined($value->{$requires})) {
383 add_error($errors, $path ? "$path.$requires" : $requires,
384 "missing property - '$newpath' requiers this property");
385 }
386 }
387
388 next; # value is already checked above
389 }
390
391 if (defined ($additional_properties) && !$additional_properties) {
392 add_error($errors, $newpath, "property is not defined in schema " .
393 "and the schema does not allow additional properties");
394 next;
395 }
396 check_prop($value->{$k}, $additional_properties, $newpath, $errors)
397 if ref($additional_properties);
398 }
399}
400
401sub check_prop {
402 my ($value, $schema, $path, $errors) = @_;
403
404 die "internal error - no schema" if !$schema;
405 die "internal error" if !$errors;
406
407 #print "check_prop $path\n" if $value;
408
409 my $st = ref($schema);
410 if (!$st || $st ne 'HASH') {
411 add_error($errors, $path, "Invalid schema definition.");
412 return;
413 }
414
415 # if it extends another schema, it must pass that schema as well
416 if($schema->{extends}) {
417 check_prop($value, $schema->{extends}, $path, $errors);
418 }
419
420 if (!defined ($value)) {
421 return if $schema->{type} && $schema->{type} eq 'null';
422 if (!$schema->{optional}) {
423 add_error($errors, $path, "property is missing and it is not optional");
424 }
425 return;
426 }
427
428 return if !check_type($path, $schema->{type}, $value, $errors);
429
430 if ($schema->{disallow}) {
431 my $tmperr = {};
432 if (check_type($path, $schema->{disallow}, $value, $tmperr)) {
433 add_error($errors, $path, "disallowed value was matched");
434 return;
435 }
436 }
437
438 if (my $vt = ref($value)) {
439
440 if ($vt eq 'ARRAY') {
441 if ($schema->{items}) {
442 my $it = ref($schema->{items});
443 if ($it && $it eq 'ARRAY') {
444 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
445 die "not implemented";
446 } else {
447 my $ind = 0;
448 foreach my $el (@$value) {
449 check_prop($el, $schema->{items}, "${path}[$ind]", $errors);
450 $ind++;
451 }
452 }
453 }
454 return;
455 } elsif ($schema->{properties} || $schema->{additionalProperties}) {
456 check_object($path, defined($schema->{properties}) ? $schema->{properties} : {},
457 $value, $schema->{additionalProperties}, $errors);
458 return;
459 }
460
461 } else {
462
463 if (my $format = $schema->{format}) {
464 eval { check_format($format, $value); };
465 if ($@) {
466 add_error($errors, $path, "invalid format - $@");
467 return;
468 }
469 }
470
471 if (my $pattern = $schema->{pattern}) {
472 if ($value !~ m/^$pattern$/) {
473 add_error($errors, $path, "value does not match the regex pattern");
474 return;
475 }
476 }
477
478 if (defined (my $max = $schema->{maxLength})) {
479 if (length($value) > $max) {
480 add_error($errors, $path, "value may only be $max characters long");
481 return;
482 }
483 }
484
485 if (defined (my $min = $schema->{minLength})) {
486 if (length($value) < $min) {
487 add_error($errors, $path, "value must be at least $min characters long");
488 return;
489 }
490 }
491
492 if (is_number($value)) {
493 if (defined (my $max = $schema->{maximum})) {
494 if ($value > $max) {
495 add_error($errors, $path, "value must have a maximum value of $max");
496 return;
497 }
498 }
499
500 if (defined (my $min = $schema->{minimum})) {
501 if ($value < $min) {
502 add_error($errors, $path, "value must have a minimum value of $min");
503 return;
504 }
505 }
506 }
507
508 if (my $ea = $schema->{enum}) {
509
510 my $found;
511 foreach my $ev (@$ea) {
512 if ($ev eq $value) {
513 $found = 1;
514 last;
515 }
516 }
517 if (!$found) {
518 add_error($errors, $path, "value '$value' does not have a value in the enumeration '" .
519 join(", ", @$ea) . "'");
520 }
521 }
522 }
523}
524
525sub validate {
526 my ($instance, $schema, $errmsg) = @_;
527
528 my $errors = {};
529 $errmsg = "Parameter verification failed.\n" if !$errmsg;
530
531 # todo: cycle detection is only needed for debugging, I guess
532 # we can disable that in the final release
533 # todo: is there a better/faster way to detect cycles?
534 my $cycles = 0;
535 find_cycle($instance, sub { $cycles = 1 });
536 if ($cycles) {
537 add_error($errors, undef, "data structure contains recursive cycles");
538 } elsif ($schema) {
539 check_prop($instance, $schema, '', $errors);
540 }
541
542 if (scalar(%$errors)) {
543 raise $errmsg, code => HTTP_BAD_REQUEST, errors => $errors;
544 }
545
546 return 1;
547}
548
549my $schema_valid_types = ["string", "object", "coderef", "array", "boolean", "number", "integer", "null", "any"];
550my $default_schema_noref = {
551 description => "This is the JSON Schema for JSON Schemas.",
552 type => [ "object" ],
553 additionalProperties => 0,
554 properties => {
555 type => {
556 type => ["string", "array"],
557 description => "This is a type definition value. This can be a simple type, or a union type",
558 optional => 1,
559 default => "any",
560 items => {
561 type => "string",
562 enum => $schema_valid_types,
563 },
564 enum => $schema_valid_types,
565 },
566 optional => {
567 type => "boolean",
568 description => "This indicates that the instance property in the instance object is not required.",
569 optional => 1,
570 default => 0
571 },
572 properties => {
573 type => "object",
574 description => "This is a definition for the properties of an object value",
575 optional => 1,
576 default => {},
577 },
578 items => {
579 type => "object",
580 description => "When the value is an array, this indicates the schema to use to validate each item in an array",
581 optional => 1,
582 default => {},
583 },
584 additionalProperties => {
585 type => [ "boolean", "object"],
586 description => "This provides a default property definition for all properties that are not explicitly defined in an object type definition.",
587 optional => 1,
588 default => {},
589 },
590 minimum => {
591 type => "number",
592 optional => 1,
593 description => "This indicates the minimum value for the instance property when the type of the instance value is a number.",
594 },
595 maximum => {
596 type => "number",
597 optional => 1,
598 description => "This indicates the maximum value for the instance property when the type of the instance value is a number.",
599 },
600 minLength => {
601 type => "integer",
602 description => "When the instance value is a string, this indicates minimum length of the string",
603 optional => 1,
604 minimum => 0,
605 default => 0,
606 },
607 maxLength => {
608 type => "integer",
609 description => "When the instance value is a string, this indicates maximum length of the string.",
610 optional => 1,
611 },
612 typetext => {
613 type => "string",
614 optional => 1,
615 description => "A text representation of the type (used to generate documentation).",
616 },
617 pattern => {
618 type => "string",
619 format => "regex",
620 description => "When the instance value is a string, this provides a regular expression that a instance string value should match in order to be valid.",
621 optional => 1,
622 default => ".*",
623 },
624
625 enum => {
626 type => "array",
627 optional => 1,
628 description => "This provides an enumeration of possible values that are valid for the instance property.",
629 },
630 description => {
631 type => "string",
632 optional => 1,
633 description => "This provides a description of the purpose the instance property. The value can be a string or it can be an object with properties corresponding to various different instance languages (with an optional default property indicating the default description).",
634 },
635 title => {
636 type => "string",
637 optional => 1,
638 description => "This provides the title of the property",
639 },
640 requires => {
641 type => [ "string", "object" ],
642 optional => 1,
643 description => "indicates a required property or a schema that must be validated if this property is present",
644 },
645 format => {
646 type => "string",
647 optional => 1,
648 description => "This indicates what format the data is among some predefined formats which may include:\n\ndate - a string following the ISO format \naddress \nschema - a schema definition object \nperson \npage \nhtml - a string representing HTML",
649 },
650 default => {
651 type => "any",
652 optional => 1,
653 description => "This indicates the default for the instance property."
654 },
655 disallow => {
656 type => "object",
657 optional => 1,
658 description => "This attribute may take the same values as the \"type\" attribute, however if the instance matches the type or if this value is an array and the instance matches any type or schema in the array, than this instance is not valid.",
659 },
660 extends => {
661 type => "object",
662 optional => 1,
663 description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
664 default => {},
665 },
666 # this is from hyper schema
667 links => {
668 type => "array",
669 description => "This defines the link relations of the instance objects",
670 optional => 1,
671 items => {
672 type => "object",
673 properties => {
674 href => {
675 type => "string",
676 description => "This defines the target URL for the relation and can be parameterized using {propertyName} notation. It should be resolved as a URI-reference relative to the URI that was used to retrieve the instance document",
677 },
678 rel => {
679 type => "string",
680 description => "This is the name of the link relation",
681 optional => 1,
682 default => "full",
683 },
684 method => {
685 type => "string",
686 description => "For submission links, this defines the method that should be used to access the target resource",
687 optional => 1,
688 default => "GET",
689 },
690 },
691 },
692 },
693 }
694};
695
696my $default_schema = Storable::dclone($default_schema_noref);
697
698$default_schema->{properties}->{properties}->{additionalProperties} = $default_schema;
699$default_schema->{properties}->{additionalProperties}->{properties} = $default_schema->{properties};
700
701$default_schema->{properties}->{items}->{properties} = $default_schema->{properties};
702$default_schema->{properties}->{items}->{additionalProperties} = 0;
703
704$default_schema->{properties}->{disallow}->{properties} = $default_schema->{properties};
705$default_schema->{properties}->{disallow}->{additionalProperties} = 0;
706
707$default_schema->{properties}->{requires}->{properties} = $default_schema->{properties};
708$default_schema->{properties}->{requires}->{additionalProperties} = 0;
709
710$default_schema->{properties}->{extends}->{properties} = $default_schema->{properties};
711$default_schema->{properties}->{extends}->{additionalProperties} = 0;
712
713my $method_schema = {
714 type => "object",
715 additionalProperties => 0,
716 properties => {
717 description => {
718 description => "This a description of the method",
719 optional => 1,
720 },
721 name => {
722 type => 'string',
723 description => "This indicates the name of the function to call.",
724 optional => 1,
725 requires => {
726 additionalProperties => 1,
727 properties => {
728 name => {},
729 description => {},
730 code => {},
731 method => {},
732 parameters => {},
733 path => {},
734 parameters => {},
735 returns => {},
736 }
737 },
738 },
739 method => {
740 type => 'string',
741 description => "The HTTP method name.",
742 enum => [ 'GET', 'POST', 'PUT', 'DELETE' ],
743 optional => 1,
744 },
745 protected => {
746 type => 'boolean',
747 description => "Method needs special privileges - only pvedaemon can execute it",
748 optional => 1,
749 },
750 proxyto => {
751 type => 'string',
752 description => "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
753 optional => 1,
754 },
755 permissions => {
756 type => 'object',
757 description => "Required access permissions. By default only 'root' is allowed to access this method.",
758 optional => 1,
759 additionalProperties => 0,
760 properties => {
b18d1722
DM
761 description => {
762 description => "Describe access permissions.",
763 optional => 1,
764 },
e143e9d8 765 user => {
b18d1722 766 description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
e143e9d8 767 type => 'string',
b18d1722 768 enum => ['all', 'world'],
e143e9d8
DM
769 optional => 1,
770 },
b18d1722
DM
771 check => {
772 description => "Array of permission checks (prefix notation).",
773 type => 'array',
774 optional => 1
775 },
e143e9d8
DM
776 },
777 },
778 match_name => {
779 description => "Used internally",
780 optional => 1,
781 },
782 match_re => {
783 description => "Used internally",
784 optional => 1,
785 },
786 path => {
787 type => 'string',
788 description => "path for URL matching (uri template)",
789 },
790 fragmentDelimiter => {
791 type => 'string',
792 description => "A ways to override the default fragment delimiter '/'. This onyl works on a whole sub-class. You can set this to the empty string to match the whole rest of the URI.",
793 optional => 1,
794 },
795 parameters => {
796 type => 'object',
797 description => "JSON Schema for parameters.",
798 optional => 1,
799 },
800 returns => {
801 type => 'object',
802 description => "JSON Schema for return value.",
803 optional => 1,
804 },
805 code => {
806 type => 'coderef',
807 description => "method implementaion (code reference)",
808 optional => 1,
809 },
810 subclass => {
811 type => 'string',
812 description => "Delegate call to this class (perl class string).",
813 optional => 1,
814 requires => {
815 additionalProperties => 0,
816 properties => {
817 subclass => {},
818 path => {},
819 match_name => {},
820 match_re => {},
821 fragmentDelimiter => { optional => 1 }
822 }
823 },
824 },
825 },
826
827};
828
829sub validate_schema {
830 my ($schema) = @_;
831
832 my $errmsg = "internal error - unable to verify schema\n";
833 validate($schema, $default_schema, $errmsg);
834}
835
836sub validate_method_info {
837 my $info = shift;
838
839 my $errmsg = "internal error - unable to verify method info\n";
840 validate($info, $method_schema, $errmsg);
841
842 validate_schema($info->{parameters}) if $info->{parameters};
843 validate_schema($info->{returns}) if $info->{returns};
844}
845
846# run a self test on load
847# make sure we can verify the default schema
848validate_schema($default_schema_noref);
849validate_schema($method_schema);
850
851# and now some utility methods (used by pve api)
852sub method_get_child_link {
853 my ($info) = @_;
854
855 return undef if !$info;
856
857 my $schema = $info->{returns};
858 return undef if !$schema || !$schema->{type} || $schema->{type} ne 'array';
859
860 my $links = $schema->{links};
861 return undef if !$links;
862
863 my $found;
864 foreach my $lnk (@$links) {
865 if ($lnk->{href} && $lnk->{rel} && ($lnk->{rel} eq 'child')) {
866 $found = $lnk;
867 last;
868 }
869 }
870
871 return $found;
872}
873
874# a way to parse command line parameters, using a
875# schema to configure Getopt::Long
876sub get_options {
0ce82909 877 my ($schema, $args, $arg_param, $fixed_param, $pwcallback) = @_;
e143e9d8
DM
878
879 if (!$schema || !$schema->{properties}) {
880 raise("too many arguments\n", code => HTTP_BAD_REQUEST)
881 if scalar(@$args) != 0;
882 return {};
883 }
884
0ce82909
DM
885 my $list_param;
886 if ($arg_param && !ref($arg_param)) {
887 my $pd = $schema->{properties}->{$arg_param};
888 die "expected list format $pd->{format}"
889 if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
890 $list_param = $arg_param;
891 }
892
e143e9d8
DM
893 my @getopt = ();
894 foreach my $prop (keys %{$schema->{properties}}) {
895 my $pd = $schema->{properties}->{$prop};
aab47b58 896 next if $list_param && $prop eq $list_param;
0ce82909 897 next if defined($fixed_param->{$prop});
e143e9d8
DM
898
899 if ($prop eq 'password' && $pwcallback) {
900 # we do not accept plain password on input line, instead
901 # we turn this into a boolean option and ask for password below
902 # using $pwcallback() (for security reasons).
903 push @getopt, "$prop";
904 } elsif ($pd->{type} eq 'boolean') {
905 push @getopt, "$prop:s";
906 } else {
23dc9401 907 if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
8ba7c72b
DM
908 push @getopt, "$prop=s@";
909 } else {
910 push @getopt, "$prop=s";
911 }
e143e9d8
DM
912 }
913 }
914
915 my $opts = {};
916 raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
917 if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
1d21344c 918
0ce82909
DM
919 if (my $acount = scalar(@$args)) {
920 if ($list_param) {
921 $opts->{$list_param} = $args;
922 $args = [];
923 } elsif (ref($arg_param)) {
924 raise("wrong number of arguments\n", code => HTTP_BAD_REQUEST)
925 if scalar(@$arg_param) != $acount;
926 foreach my $p (@$arg_param) {
927 $opts->{$p} = shift @$args;
928 }
929 } else {
930 raise("too many arguments\n", code => HTTP_BAD_REQUEST)
931 if scalar(@$args) != 0;
932 }
1d21344c
DM
933 }
934
e143e9d8
DM
935 if (my $pd = $schema->{properties}->{password}) {
936 if ($pd->{type} ne 'boolean' && $pwcallback) {
937 if ($opts->{password} || !$pd->{optional}) {
938 $opts->{password} = &$pwcallback();
939 }
940 }
941 }
815b2aba
DM
942
943 $opts = PVE::Tools::decode_utf8_parameters($opts);
944 if ($opts->{description}) {
945 print "TEST: " . PVE::Tools::encode_text($opts->{description}) . "\n";
946 }
947
e143e9d8
DM
948 foreach my $p (keys %$opts) {
949 if (my $pd = $schema->{properties}->{$p}) {
950 if ($pd->{type} eq 'boolean') {
951 if ($opts->{$p} eq '') {
952 $opts->{$p} = 1;
953 } elsif ($opts->{$p} =~ m/^(1|true|yes|on)$/i) {
954 $opts->{$p} = 1;
955 } elsif ($opts->{$p} =~ m/^(0|false|no|off)$/i) {
956 $opts->{$p} = 0;
957 } else {
958 raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
959 }
23dc9401 960 } elsif ($pd->{format}) {
8ba7c72b 961
23dc9401 962 if ($pd->{format} =~ m/-list/) {
8ba7c72b 963 # allow --vmid 100 --vmid 101 and --vmid 100,101
23dc9401 964 # allow --dow mon --dow fri and --dow mon,fri
8ba7c72b 965 $opts->{$p} = join(",", @{$opts->{$p}});
23dc9401 966 } elsif ($pd->{format} =~ m/-alist/) {
8ba7c72b
DM
967 # we encode array as \0 separated strings
968 # Note: CGI.pm also use this encoding
969 if (scalar(@{$opts->{$p}}) != 1) {
970 $opts->{$p} = join("\0", @{$opts->{$p}});
971 } else {
972 # st that split_list knows it is \0 terminated
973 my $v = $opts->{$p}->[0];
974 $opts->{$p} = "$v\0";
975 }
976 }
e143e9d8
DM
977 }
978 }
979 }
980
0ce82909
DM
981 foreach my $p (keys %$fixed_param) {
982 $opts->{$p} = $fixed_param->{$p};
e143e9d8
DM
983 }
984
985 return $opts;
986}
987
988# A way to parse configuration data by giving a json schema
989sub parse_config {
990 my ($schema, $filename, $raw) = @_;
991
992 # do fast check (avoid validate_schema($schema))
993 die "got strange schema" if !$schema->{type} ||
994 !$schema->{properties} || $schema->{type} ne 'object';
995
996 my $cfg = {};
997
998 while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
999 my $line = $1;
1000
1001 next if $line =~ m/^\#/; # skip comment lines
1002 next if $line =~ m/^\s*$/; # skip empty lines
1003
1004 if ($line =~ m/^(\S+):\s*(\S+)\s*$/) {
1005 my $key = $1;
1006 my $value = $2;
1007 if ($schema->{properties}->{$key} &&
1008 $schema->{properties}->{$key}->{type} eq 'boolean') {
1009
1010 $value = 1 if $value =~ m/^(1|on|yes|true)$/i;
1011 $value = 0 if $value =~ m/^(0|off|no|false)$/i;
1012 }
1013 $cfg->{$key} = $value;
1014 } else {
1015 warn "ignore config line: $line\n"
1016 }
1017 }
1018
1019 my $errors = {};
1020 check_prop($cfg, $schema, '', $errors);
1021
1022 foreach my $k (keys %$errors) {
1023 warn "parse error in '$filename' - '$k': $errors->{$k}\n";
1024 delete $cfg->{$k};
1025 }
1026
1027 return $cfg;
1028}
1029
1030# generate simple key/value file
1031sub dump_config {
1032 my ($schema, $filename, $cfg) = @_;
1033
1034 # do fast check (avoid validate_schema($schema))
1035 die "got strange schema" if !$schema->{type} ||
1036 !$schema->{properties} || $schema->{type} ne 'object';
1037
1038 validate($cfg, $schema, "validation error in '$filename'\n");
1039
1040 my $data = '';
1041
1042 foreach my $k (keys %$cfg) {
1043 $data .= "$k: $cfg->{$k}\n";
1044 }
1045
1046 return $data;
1047}
1048
10491;