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