1 package PVE
::JSONSchema
;
5 use Storable
; # for dclone
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);
16 register_standard_option
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/
24 # the code is similar to the javascript parser from http://code.google.com/p/jsonschema/
26 my $standard_options = {};
27 sub register_standard_option
{
28 my ($name, $schema) = @_;
30 die "standard option '$name' already registered\n"
31 if $standard_options->{$name};
33 $standard_options->{$name} = $schema;
36 sub get_standard_option
{
37 my ($name, $base) = @_;
39 my $std = $standard_options->{$name};
40 die "no such standard option '$name'\n" if !$std;
42 my $res = $base || {};
44 foreach my $opt (keys %$std) {
46 $res->{$opt} = $std->{$opt};
52 register_standard_option
('pve-vmid', {
53 description
=> "The (unique) ID of the VM.",
54 type
=> 'integer', format
=> 'pve-vmid',
58 register_standard_option
('pve-node', {
59 description
=> "The cluster node name.",
60 type
=> 'string', format
=> 'pve-node',
63 register_standard_option
('pve-node-list', {
64 description
=> "List of cluster node names.",
65 type
=> 'string', format
=> 'pve-node-list',
68 register_standard_option
('pve-iface', {
69 description
=> "Network interface name.",
70 type
=> 'string', format
=> 'pve-iface',
71 minLength
=> 2, maxLength
=> 20,
74 PVE
::JSONSchema
::register_standard_option
('pve-storage-id', {
75 description
=> "The storage identifier.",
76 type
=> 'string', format
=> 'pve-storage-id',
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.',
83 maxLength
=> 40, # sha1 hex digest lenght is 40
89 my ($format, $code) = @_;
91 die "JSON schema format '$format' already registered\n"
92 if $format_list->{$format};
94 $format_list->{$format} = $code;
97 # register some common type for pve
99 register_format
('string', sub {}); # allow format => 'string-list'
101 register_format
('pve-configid', \
&pve_verify_configid
);
102 sub pve_verify_configid
{
103 my ($id, $noerr) = @_;
105 if ($id !~ m/^[a-z][a-z0-9_]+$/i) {
106 return undef if $noerr;
107 die "invalid configuration ID '$id'\n";
112 PVE
::JSONSchema
::register_format
('pve-storage-id', \
&parse_storage_id
);
113 sub parse_storage_id
{
114 my ($storeid, $noerr) = @_;
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";
124 register_format
('pve-vmid', \
&pve_verify_vmid
);
125 sub pve_verify_vmid
{
126 my ($vmid, $noerr) = @_;
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";
135 register_format
('pve-node', \
&pve_verify_node_name
);
136 sub pve_verify_node_name
{
137 my ($node, $noerr) = @_;
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";
146 register_format
('ipv4', \
&pve_verify_ipv4
);
147 sub pve_verify_ipv4
{
148 my ($ipv4, $noerr) = @_;
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";
157 my $ipv4_mask_hash = {
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
190 register_format
('ipv4mask', \
&pve_verify_ipv4mask
);
191 sub pve_verify_ipv4mask
{
192 my ($mask, $noerr) = @_;
194 if (!defined($ipv4_mask_hash->{$mask})) {
195 return undef if $noerr;
196 die "value does not look like a valid IP netmask\n";
201 register_format
('CIDR', \
&pve_verify_cidr
);
202 sub pve_verify_cidr
{
203 my ($cidr, $noerr) = @_;
205 if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) && ($1 < 32)) {
207 } elsif ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) && ($1 <= 120)) {
211 return undef if $noerr;
212 die "value does not look like a valid CIDR network\n";
215 register_format
('email', \
&pve_verify_email
);
216 sub pve_verify_email
{
217 my ($email, $noerr) = @_;
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";
227 register_format
('dns-name', \
&pve_verify_dns_name
);
228 sub pve_verify_dns_name
{
229 my ($name, $noerr) = @_;
231 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)";
233 if ($name !~ /^(${namere}\.)*${namere}$/) {
234 return undef if $noerr;
235 die "value does not look like a valid DNS name\n";
240 # network interface name
241 register_format
('pve-iface', \
&pve_verify_iface
);
242 sub pve_verify_iface
{
243 my ($id, $noerr) = @_;
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";
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',
257 register_standard_option
('remote-viewer-config', {
258 description
=> "Returned values can be directly passed to the 'remote-viewer' application.",
259 additionalProperties
=> 1,
261 type
=> { type
=> 'string' },
262 password
=> { type
=> 'string' },
263 proxy
=> { type
=> 'string' },
264 host
=> { type
=> 'string' },
265 'tls-port' => { type
=> 'integer' },
269 PVE
::JSONSchema
::register_format
('pve-startup-order', \
&pve_verify_startup_order
);
270 sub pve_verify_startup_order
{
271 my ($value, $noerr) = @_;
273 return $value if pve_parse_startup_order
($value);
275 return undef if $noerr;
277 die "unable to parse startup options\n";
280 sub pve_parse_startup_order
{
283 return undef if !$value;
287 foreach my $p (split(/,/, $value)) {
288 next if $p =~ m/^\s*$/;
290 if ($p =~ m/^(order=)?(\d+)$/) {
292 } elsif ($p =~ m/^up=(\d+)$/) {
294 } elsif ($p =~ m/^down=(\d+)$/) {
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.",
307 type
=> 'string', format
=> 'pve-startup-order',
308 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
312 my ($format, $value) = @_;
314 return if $format eq 'regex';
316 if ($format =~ m/^(.*)-a?list$/) {
318 my $code = $format_list->{$1};
320 die "undefined format '$format'\n" if !$code;
322 # Note: we allow empty lists
323 foreach my $v (split_list
($value)) {
327 } elsif ($format =~ m/^(.*)-opt$/) {
329 my $code = $format_list->{$1};
331 die "undefined format '$format'\n" if !$code;
333 return if !$value; # allow empty string
339 my $code = $format_list->{$format};
341 die "undefined format '$format'\n" if !$code;
348 my ($errors, $path, $msg) = @_;
350 $path = '_root' if !$path;
352 if ($errors->{$path}) {
353 $errors->{$path} = join ('\n', $errors->{$path}, $msg);
355 $errors->{$path} = $msg;
362 # see 'man perlretut'
363 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/;
369 return $value =~ m/^[+-]?\d+$/;
373 my ($path, $type, $value, $errors) = @_;
377 if (!defined($value)) {
378 return 1 if $type eq 'null';
382 if (my $tt = ref($type)) {
383 if ($tt eq 'ARRAY') {
384 foreach my $t (@$type) {
386 check_type
($path, $t, $value, $tmperr);
387 return 1 if !scalar(%$tmperr);
389 my $ttext = join ('|', @$type);
390 add_error
($errors, $path, "type check ('$ttext') failed");
392 } elsif ($tt eq 'HASH') {
394 check_prop
($value, $type, $path, $tmperr);
395 return 1 if !scalar(%$tmperr);
396 add_error
($errors, $path, "type check failed");
399 die "internal error - got reference type '$tt'";
404 return 1 if $type eq 'any';
406 if ($type eq 'null') {
407 if (defined($value)) {
408 add_error
($errors, $path, "type check ('$type') failed - value is not null");
414 my $vt = ref($value);
416 if ($type eq 'array') {
417 if (!$vt || $vt ne 'ARRAY') {
418 add_error
($errors, $path, "type check ('$type') failed");
422 } elsif ($type eq 'object') {
423 if (!$vt || $vt ne 'HASH') {
424 add_error
($errors, $path, "type check ('$type') failed");
428 } elsif ($type eq 'coderef') {
429 if (!$vt || $vt ne 'CODE') {
430 add_error
($errors, $path, "type check ('$type') failed");
436 add_error
($errors, $path, "type check ('$type') failed - got $vt");
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) {
445 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
446 } elsif ($value eq '0') {
449 add_error
($errors, $path, "type check ('$type') failed - got '$value'");
452 } elsif ($type eq 'integer') {
453 if (!is_integer
($value)) {
454 add_error
($errors, $path, "type check ('$type') failed - got '$value'");
458 } elsif ($type eq 'number') {
459 if (!is_number
($value)) {
460 add_error
($errors, $path, "type check ('$type') failed - got '$value'");
465 return 1; # no need to verify unknown types
475 my ($path, $schema, $value, $additional_properties, $errors) = @_;
477 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
479 my $st = ref($schema);
480 if (!$st || $st ne 'HASH') {
481 add_error
($errors, $path, "Invalid schema definition.");
485 my $vt = ref($value);
486 if (!$vt || $vt ne 'HASH') {
487 add_error
($errors, $path, "an object is required");
491 foreach my $k (keys %$schema) {
492 check_prop
($value->{$k}, $schema->{$k}, $path ?
"$path.$k" : $k, $errors);
495 foreach my $k (keys %$value) {
497 my $newpath = $path ?
"$path.$k" : $k;
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");
510 next; # value is already checked above
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");
518 check_prop
($value->{$k}, $additional_properties, $newpath, $errors)
519 if ref($additional_properties);
524 my ($value, $schema, $path, $errors) = @_;
526 die "internal error - no schema" if !$schema;
527 die "internal error" if !$errors;
529 #print "check_prop $path\n" if $value;
531 my $st = ref($schema);
532 if (!$st || $st ne 'HASH') {
533 add_error
($errors, $path, "Invalid schema definition.");
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);
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");
550 return if !check_type
($path, $schema->{type
}, $value, $errors);
552 if ($schema->{disallow
}) {
554 if (check_type
($path, $schema->{disallow
}, $value, $tmperr)) {
555 add_error
($errors, $path, "disallowed value was matched");
560 if (my $vt = ref($value)) {
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";
570 foreach my $el (@$value) {
571 check_prop
($el, $schema->{items
}, "${path}[$ind]", $errors);
577 } elsif ($schema->{properties
} || $schema->{additionalProperties
}) {
578 check_object
($path, defined($schema->{properties
}) ?
$schema->{properties
} : {},
579 $value, $schema->{additionalProperties
}, $errors);
585 if (my $format = $schema->{format
}) {
586 eval { check_format
($format, $value); };
588 add_error
($errors, $path, "invalid format - $@");
593 if (my $pattern = $schema->{pattern
}) {
594 if ($value !~ m/^$pattern$/) {
595 add_error
($errors, $path, "value does not match the regex pattern");
600 if (defined (my $max = $schema->{maxLength
})) {
601 if (length($value) > $max) {
602 add_error
($errors, $path, "value may only be $max characters long");
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");
614 if (is_number
($value)) {
615 if (defined (my $max = $schema->{maximum
})) {
617 add_error
($errors, $path, "value must have a maximum value of $max");
622 if (defined (my $min = $schema->{minimum
})) {
624 add_error
($errors, $path, "value must have a minimum value of $min");
630 if (my $ea = $schema->{enum
}) {
633 foreach my $ev (@$ea) {
640 add_error
($errors, $path, "value '$value' does not have a value in the enumeration '" .
641 join(", ", @$ea) . "'");
648 my ($instance, $schema, $errmsg) = @_;
651 $errmsg = "Parameter verification failed.\n" if !$errmsg;
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?
657 find_cycle
($instance, sub { $cycles = 1 });
659 add_error
($errors, undef, "data structure contains recursive cycles");
661 check_prop
($instance, $schema, '', $errors);
664 if (scalar(%$errors)) {
665 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors;
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,
678 type
=> ["string", "array"],
679 description
=> "This is a type definition value. This can be a simple type, or a union type",
684 enum
=> $schema_valid_types,
686 enum
=> $schema_valid_types,
690 description
=> "This indicates that the instance property in the instance object is not required.",
696 description
=> "This is a definition for the properties of an object value",
702 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array",
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.",
715 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number.",
720 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number.",
724 description
=> "When the instance value is a string, this indicates minimum length of the string",
731 description
=> "When the instance value is a string, this indicates maximum length of the string.",
737 description
=> "A text representation of the type (used to generate documentation).",
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.",
750 description
=> "This provides an enumeration of possible values that are valid for the instance property.",
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).",
760 description
=> "This provides the title of the property",
763 type
=> [ "string", "object" ],
765 description
=> "indicates a required property or a schema that must be validated if this property is present",
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",
775 description
=> "This indicates the default for the instance property."
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.",
785 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
788 # this is from hyper schema
791 description
=> "This defines the link relations of the instance objects",
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",
802 description
=> "This is the name of the link relation",
808 description
=> "For submission links, this defines the method that should be used to access the target resource",
818 my $default_schema = Storable
::dclone
($default_schema_noref);
820 $default_schema->{properties
}->{properties
}->{additionalProperties
} = $default_schema;
821 $default_schema->{properties
}->{additionalProperties
}->{properties
} = $default_schema->{properties
};
823 $default_schema->{properties
}->{items
}->{properties
} = $default_schema->{properties
};
824 $default_schema->{properties
}->{items
}->{additionalProperties
} = 0;
826 $default_schema->{properties
}->{disallow
}->{properties
} = $default_schema->{properties
};
827 $default_schema->{properties
}->{disallow
}->{additionalProperties
} = 0;
829 $default_schema->{properties
}->{requires
}->{properties
} = $default_schema->{properties
};
830 $default_schema->{properties
}->{requires
}->{additionalProperties
} = 0;
832 $default_schema->{properties
}->{extends
}->{properties
} = $default_schema->{properties
};
833 $default_schema->{properties
}->{extends
}->{additionalProperties
} = 0;
835 my $method_schema = {
837 additionalProperties
=> 0,
840 description
=> "This a description of the method",
845 description
=> "This indicates the name of the function to call.",
848 additionalProperties
=> 1,
863 description
=> "The HTTP method name.",
864 enum
=> [ 'GET', 'POST', 'PUT', 'DELETE' ],
869 description
=> "Method needs special privileges - only pvedaemon can execute it",
874 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
879 description
=> "Required access permissions. By default only 'root' is allowed to access this method.",
881 additionalProperties
=> 0,
884 description
=> "Describe access permissions.",
888 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.",
890 enum
=> ['all', 'world'],
894 description
=> "Array of permission checks (prefix notation).",
901 description
=> "Used internally",
905 description
=> "Used internally",
910 description
=> "path for URL matching (uri template)",
912 fragmentDelimiter
=> {
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.",
919 description
=> "JSON Schema for parameters.",
924 description
=> "JSON Schema for return value.",
929 description
=> "method implementaion (code reference)",
934 description
=> "Delegate call to this class (perl class string).",
937 additionalProperties
=> 0,
943 fragmentDelimiter
=> { optional
=> 1 }
951 sub validate_schema
{
954 my $errmsg = "internal error - unable to verify schema\n";
955 validate
($schema, $default_schema, $errmsg);
958 sub validate_method_info
{
961 my $errmsg = "internal error - unable to verify method info\n";
962 validate
($info, $method_schema, $errmsg);
964 validate_schema
($info->{parameters
}) if $info->{parameters
};
965 validate_schema
($info->{returns
}) if $info->{returns
};
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);
973 # and now some utility methods (used by pve api)
974 sub method_get_child_link
{
977 return undef if !$info;
979 my $schema = $info->{returns
};
980 return undef if !$schema || !$schema->{type
} || $schema->{type
} ne 'array';
982 my $links = $schema->{links
};
983 return undef if !$links;
986 foreach my $lnk (@$links) {
987 if ($lnk->{href
} && $lnk->{rel
} && ($lnk->{rel
} eq 'child')) {
996 # a way to parse command line parameters, using a
997 # schema to configure Getopt::Long
999 my ($schema, $args, $arg_param, $fixed_param, $pwcallback) = @_;
1001 if (!$schema || !$schema->{properties
}) {
1002 raise
("too many arguments\n", code
=> HTTP_BAD_REQUEST
)
1003 if scalar(@$args) != 0;
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;
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});
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";
1029 if ($pd->{format
} && $pd->{format
} =~ m/-a?list/) {
1030 push @getopt, "$prop=s@";
1032 push @getopt, "$prop=s";
1038 raise
("unable to parse option\n", code
=> HTTP_BAD_REQUEST
)
1039 if !Getopt
::Long
::GetOptionsFromArray
($args, $opts, @getopt);
1041 if (my $acount = scalar(@$args)) {
1043 $opts->{$list_param} = $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;
1052 raise
("too many arguments\n", code
=> HTTP_BAD_REQUEST
)
1053 if scalar(@$args) != 0;
1057 if (my $pd = $schema->{properties
}->{password
}) {
1058 if ($pd->{type
} ne 'boolean' && $pwcallback) {
1059 if ($opts->{password
} || !$pd->{optional
}) {
1060 $opts->{password
} = &$pwcallback();
1065 $opts = PVE
::Tools
::decode_utf8_parameters
($opts);
1067 foreach my $p (keys %$opts) {
1068 if (my $pd = $schema->{properties
}->{$p}) {
1069 if ($pd->{type
} eq 'boolean') {
1070 if ($opts->{$p} eq '') {
1072 } elsif ($opts->{$p} =~ m/^(1|true|yes|on)$/i) {
1074 } elsif ($opts->{$p} =~ m/^(0|false|no|off)$/i) {
1077 raise
("unable to parse boolean option\n", code
=> HTTP_BAD_REQUEST
);
1079 } elsif ($pd->{format
}) {
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}});
1091 # st that split_list knows it is \0 terminated
1092 my $v = $opts->{$p}->[0];
1093 $opts->{$p} = "$v\0";
1100 foreach my $p (keys %$fixed_param) {
1101 $opts->{$p} = $fixed_param->{$p};
1107 # A way to parse configuration data by giving a json schema
1109 my ($schema, $filename, $raw) = @_;
1111 # do fast check (avoid validate_schema($schema))
1112 die "got strange schema" if !$schema->{type
} ||
1113 !$schema->{properties
} || $schema->{type
} ne 'object';
1117 while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
1120 next if $line =~ m/^\#/; # skip comment lines
1121 next if $line =~ m/^\s*$/; # skip empty lines
1123 if ($line =~ m/^(\S+):\s*(\S+)\s*$/) {
1126 if ($schema->{properties
}->{$key} &&
1127 $schema->{properties
}->{$key}->{type
} eq 'boolean') {
1129 $value = 1 if $value =~ m/^(1|on|yes|true)$/i;
1130 $value = 0 if $value =~ m/^(0|off|no|false)$/i;
1132 $cfg->{$key} = $value;
1134 warn "ignore config line: $line\n"
1139 check_prop
($cfg, $schema, '', $errors);
1141 foreach my $k (keys %$errors) {
1142 warn "parse error in '$filename' - '$k': $errors->{$k}\n";
1149 # generate simple key/value file
1151 my ($schema, $filename, $cfg) = @_;
1153 # do fast check (avoid validate_schema($schema))
1154 die "got strange schema" if !$schema->{type
} ||
1155 !$schema->{properties
} || $schema->{type
} ne 'object';
1157 validate
($cfg, $schema, "validation error in '$filename'\n");
1161 foreach my $k (keys %$cfg) {
1162 $data .= "$k: $cfg->{$k}\n";