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