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