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