]>
git.proxmox.com Git - pve-common.git/blob - data/PVE/JSONSchema.pm
881120769778d944ef706357244ef0faaff1d8a2
1 package PVE
:: JSONSchema
;
5 use Storable
; # for dclone
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) ;
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 \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' ,
82 my ( $format, $code ) = @_ ;
84 die "JSON schema format ' $format ' already registered \n "
85 if $format_list ->{ $format };
87 $format_list ->{ $format } = $code ;
90 # register some common type for pve
92 register_format
( 'string' , sub {}); # allow format => 'string-list'
94 register_format
( 'pve-configid' , \
& pve_verify_configid
);
95 sub pve_verify_configid
{
96 my ( $id, $noerr ) = @_ ;
98 if ( $id !~ m/^[a-z][a-z0-9_]+$/i ) {
99 return undef if $noerr ;
100 die "invalid configuration ID ' $id ' \n " ;
105 PVE
:: JSONSchema
:: register_format
( 'pve-storage-id' , \
& parse_storage_id
);
106 sub parse_storage_id
{
107 my ( $storeid, $noerr ) = @_ ;
109 if ( $storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i ) {
110 return undef if $noerr ;
111 die "storage ID ' $storeid ' contains illegal characters \n " ;
117 register_format
( 'pve-vmid' , \
& pve_verify_vmid
);
118 sub pve_verify_vmid
{
119 my ( $vmid, $noerr ) = @_ ;
121 if ( $vmid !~ m/^[1-9][0-9]+$/ ) {
122 return undef if $noerr ;
123 die "value does not look like a valid VM ID \n " ;
128 register_format
( 'pve-node' , \
& pve_verify_node_name
);
129 sub pve_verify_node_name
{
130 my ( $node, $noerr ) = @_ ;
132 if ( $node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/ ) {
133 return undef if $noerr ;
134 die "value does not look like a valid node name \n " ;
139 register_format
( 'ipv4' , \
& pve_verify_ipv4
);
140 sub pve_verify_ipv4
{
141 my ( $ipv4, $noerr ) = @_ ;
143 if (! Net
:: IP
:: ip_is_ipv4
( $ipv4 )) {
144 return undef if $noerr ;
145 die "value does not look like a valid IP address \n " ;
150 my $ipv4_mask_hash = {
167 '255.255.128.0' => 17 ,
168 '255.255.192.0' => 18 ,
169 '255.255.224.0' => 19 ,
170 '255.255.240.0' => 20 ,
171 '255.255.248.0' => 21 ,
172 '255.255.252.0' => 22 ,
173 '255.255.254.0' => 23 ,
174 '255.255.255.0' => 24 ,
175 '255.255.255.128' => 25 ,
176 '255.255.255.192' => 26 ,
177 '255.255.255.224' => 27 ,
178 '255.255.255.240' => 28 ,
179 '255.255.255.248' => 29 ,
180 '255.255.255.252' => 30
183 register_format
( 'ipv4mask' , \
& pve_verify_ipv4mask
);
184 sub pve_verify_ipv4mask
{
185 my ( $mask, $noerr ) = @_ ;
187 if (! defined ( $ipv4_mask_hash ->{ $mask })) {
188 return undef if $noerr ;
189 die "value does not look like a valid IP netmask \n " ;
194 register_format
( 'email' , \
& pve_verify_email
);
195 sub pve_verify_email
{
196 my ( $email, $noerr ) = @_ ;
198 # we use same regex as extjs Ext.form.VTypes.email
199 if ( $email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,6}$/ ) {
200 return undef if $noerr ;
201 die "value does not look like a valid email address \n " ;
206 register_format
( 'dns-name' , \
& pve_verify_dns_name
);
207 sub pve_verify_dns_name
{
208 my ( $name, $noerr ) = @_ ;
210 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)" ;
212 if ( $name !~ /^(${namere}\.)*${namere}$/ ) {
213 return undef if $noerr ;
214 die "value does not look like a valid DNS name \n " ;
219 # network interface name
220 register_format
( 'pve-iface' , \
& pve_verify_iface
);
221 sub pve_verify_iface
{
222 my ( $id, $noerr ) = @_ ;
224 if ( $id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i ) {
225 return undef if $noerr ;
226 die "invalid network interface name ' $id ' \n " ;
231 register_standard_option
( 'spice-proxy' , {
232 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)." ,
233 type
=> 'string' , format
=> 'dns-name' ,
236 register_standard_option
( 'remote-viewer-config' , {
237 description
=> "Returned values can be directly passed to the 'remote-viewer' application." ,
238 additionalProperties
=> 1 ,
240 type
=> { type
=> 'string' },
241 password
=> { type
=> 'string' },
242 proxy
=> { type
=> 'string' },
243 host
=> { type
=> 'string' },
244 'tls-port' => { type
=> 'integer' },
249 my ( $format, $value ) = @_ ;
251 return if $format eq 'regex' ;
253 if ( $format =~ m/^(.*)-a?list$/ ) {
255 my $code = $format_list ->{ $1 };
257 die "undefined format ' $format ' \n " if ! $code ;
259 # Note: we allow empty lists
260 foreach my $v ( split_list
( $value )) {
264 } elsif ( $format =~ m/^(.*)-opt$/ ) {
266 my $code = $format_list ->{ $1 };
268 die "undefined format ' $format ' \n " if ! $code ;
270 return if ! $value ; # allow empty string
276 my $code = $format_list ->{ $format };
278 die "undefined format ' $format ' \n " if ! $code ;
285 my ( $errors, $path, $msg ) = @_ ;
287 $path = '_root' if ! $path ;
289 if ( $errors ->{ $path }) {
290 $errors ->{ $path } = join ( ' \n ' , $errors ->{ $path }, $msg );
292 $errors ->{ $path } = $msg ;
299 # see 'man perlretut'
300 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/ ;
306 return $value =~ m/^[+-]?\d+$/ ;
310 my ( $path, $type, $value, $errors ) = @_ ;
314 if (! defined ( $value )) {
315 return 1 if $type eq 'null' ;
319 if ( my $tt = ref ( $type )) {
320 if ( $tt eq 'ARRAY' ) {
321 foreach my $t ( @$type ) {
323 check_type
( $path, $t, $value, $tmperr );
324 return 1 if ! scalar ( %$tmperr );
326 my $ttext = join ( '|' , @$type );
327 add_error
( $errors, $path, "type check (' $ttext ') failed" );
329 } elsif ( $tt eq 'HASH' ) {
331 check_prop
( $value, $type, $path, $tmperr );
332 return 1 if ! scalar ( %$tmperr );
333 add_error
( $errors, $path, "type check failed" );
336 die "internal error - got reference type ' $tt '" ;
341 return 1 if $type eq 'any' ;
343 if ( $type eq 'null' ) {
344 if ( defined ( $value )) {
345 add_error
( $errors, $path, "type check (' $type ') failed - value is not null" );
351 my $vt = ref ( $value );
353 if ( $type eq 'array' ) {
354 if (! $vt || $vt ne 'ARRAY' ) {
355 add_error
( $errors, $path, "type check (' $type ') failed" );
359 } elsif ( $type eq 'object' ) {
360 if (! $vt || $vt ne 'HASH' ) {
361 add_error
( $errors, $path, "type check (' $type ') failed" );
365 } elsif ( $type eq 'coderef' ) {
366 if (! $vt || $vt ne 'CODE' ) {
367 add_error
( $errors, $path, "type check (' $type ') failed" );
373 add_error
( $errors, $path, "type check (' $type ') failed - got $vt " );
376 if ( $type eq 'string' ) {
377 return 1 ; # nothing to check ?
378 } elsif ( $type eq 'boolean' ) {
379 #if ($value =~ m/^(1|true|yes|on)$/i) {
382 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
383 } elsif ( $value eq '0' ) {
386 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
389 } elsif ( $type eq 'integer' ) {
390 if (! is_integer
( $value )) {
391 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
395 } elsif ( $type eq 'number' ) {
396 if (! is_number
( $value )) {
397 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
402 return 1 ; # no need to verify unknown types
412 my ( $path, $schema, $value, $additional_properties, $errors ) = @_ ;
414 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
416 my $st = ref ( $schema );
417 if (! $st || $st ne 'HASH' ) {
418 add_error
( $errors, $path, "Invalid schema definition." );
422 my $vt = ref ( $value );
423 if (! $vt || $vt ne 'HASH' ) {
424 add_error
( $errors, $path, "an object is required" );
428 foreach my $k ( keys %$schema ) {
429 check_prop
( $value ->{ $k }, $schema ->{ $k }, $path ?
" $path . $k " : $k, $errors );
432 foreach my $k ( keys %$value ) {
434 my $newpath = $path ?
" $path . $k " : $k ;
436 if ( my $subschema = $schema ->{ $k }) {
437 if ( my $requires = $subschema ->{ requires
}) {
438 if ( ref ( $requires )) {
439 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
440 check_prop
( $value, $requires, $path, $errors );
441 } elsif (! defined ( $value ->{ $requires })) {
442 add_error
( $errors, $path ?
" $path . $requires " : $requires,
443 "missing property - ' $newpath ' requiers this property" );
447 next ; # value is already checked above
450 if ( defined ( $additional_properties ) && ! $additional_properties ) {
451 add_error
( $errors, $newpath, "property is not defined in schema " .
452 "and the schema does not allow additional properties" );
455 check_prop
( $value ->{ $k }, $additional_properties, $newpath, $errors )
456 if ref ( $additional_properties );
461 my ( $value, $schema, $path, $errors ) = @_ ;
463 die "internal error - no schema" if ! $schema ;
464 die "internal error" if ! $errors ;
466 #print "check_prop $path\n" if $value;
468 my $st = ref ( $schema );
469 if (! $st || $st ne 'HASH' ) {
470 add_error
( $errors, $path, "Invalid schema definition." );
474 # if it extends another schema, it must pass that schema as well
475 if ( $schema ->{ extends
}) {
476 check_prop
( $value, $schema ->{ extends
}, $path, $errors );
479 if (! defined ( $value )) {
480 return if $schema ->{ type
} && $schema ->{ type
} eq 'null' ;
481 if (! $schema ->{ optional
}) {
482 add_error
( $errors, $path, "property is missing and it is not optional" );
487 return if ! check_type
( $path, $schema ->{ type
}, $value, $errors );
489 if ( $schema ->{ disallow
}) {
491 if ( check_type
( $path, $schema ->{ disallow
}, $value, $tmperr )) {
492 add_error
( $errors, $path, "disallowed value was matched" );
497 if ( my $vt = ref ( $value )) {
499 if ( $vt eq 'ARRAY' ) {
500 if ( $schema ->{ items
}) {
501 my $it = ref ( $schema ->{ items
});
502 if ( $it && $it eq 'ARRAY' ) {
503 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
504 die "not implemented" ;
507 foreach my $el ( @$value ) {
508 check_prop
( $el, $schema ->{ items
}, "${path}[ $ind ]" , $errors );
514 } elsif ( $schema ->{ properties
} || $schema ->{ additionalProperties
}) {
515 check_object
( $path, defined ( $schema ->{ properties
}) ?
$schema ->{ properties
} : {},
516 $value, $schema ->{ additionalProperties
}, $errors );
522 if ( my $format = $schema ->{ format
}) {
523 eval { check_format
( $format, $value ); };
525 add_error
( $errors, $path, "invalid format - $@ " );
530 if ( my $pattern = $schema ->{ pattern
}) {
531 if ( $value !~ m/^$pattern$/ ) {
532 add_error
( $errors, $path, "value does not match the regex pattern" );
537 if ( defined ( my $max = $schema ->{ maxLength
})) {
538 if ( length ( $value ) > $max ) {
539 add_error
( $errors, $path, "value may only be $max characters long" );
544 if ( defined ( my $min = $schema ->{ minLength
})) {
545 if ( length ( $value ) < $min ) {
546 add_error
( $errors, $path, "value must be at least $min characters long" );
551 if ( is_number
( $value )) {
552 if ( defined ( my $max = $schema ->{ maximum
})) {
554 add_error
( $errors, $path, "value must have a maximum value of $max " );
559 if ( defined ( my $min = $schema ->{ minimum
})) {
561 add_error
( $errors, $path, "value must have a minimum value of $min " );
567 if ( my $ea = $schema ->{ enum
}) {
570 foreach my $ev ( @$ea ) {
577 add_error
( $errors, $path, "value ' $value ' does not have a value in the enumeration '" .
578 join ( ", " , @$ea ) . "'" );
585 my ( $instance, $schema, $errmsg ) = @_ ;
588 $errmsg = "Parameter verification failed. \n " if ! $errmsg ;
590 # todo: cycle detection is only needed for debugging, I guess
591 # we can disable that in the final release
592 # todo: is there a better/faster way to detect cycles?
594 find_cycle
( $instance, sub { $cycles = 1 });
596 add_error
( $errors, undef , "data structure contains recursive cycles" );
598 check_prop
( $instance, $schema, '' , $errors );
601 if ( scalar ( %$errors )) {
602 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors ;
608 my $schema_valid_types = [ "string" , "object" , "coderef" , "array" , "boolean" , "number" , "integer" , "null" , "any" ];
609 my $default_schema_noref = {
610 description
=> "This is the JSON Schema for JSON Schemas." ,
611 type
=> [ "object" ],
612 additionalProperties
=> 0 ,
615 type
=> [ "string" , "array" ],
616 description
=> "This is a type definition value. This can be a simple type, or a union type" ,
621 enum
=> $schema_valid_types,
623 enum
=> $schema_valid_types,
627 description
=> "This indicates that the instance property in the instance object is not required." ,
633 description
=> "This is a definition for the properties of an object value" ,
639 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array" ,
643 additionalProperties
=> {
644 type
=> [ "boolean" , "object" ],
645 description
=> "This provides a default property definition for all properties that are not explicitly defined in an object type definition." ,
652 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number." ,
657 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number." ,
661 description
=> "When the instance value is a string, this indicates minimum length of the string" ,
668 description
=> "When the instance value is a string, this indicates maximum length of the string." ,
674 description
=> "A text representation of the type (used to generate documentation)." ,
679 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." ,
687 description
=> "This provides an enumeration of possible values that are valid for the instance property." ,
692 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)." ,
697 description
=> "This provides the title of the property" ,
700 type
=> [ "string" , "object" ],
702 description
=> "indicates a required property or a schema that must be validated if this property is present" ,
707 description
=> "This indicates what format the data is among some predefined formats which may include: \n\n date - a string following the ISO format \n address \n schema - a schema definition object \n person \n page \n html - a string representing HTML" ,
712 description
=> "This indicates the default for the instance property."
717 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." ,
722 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also." ,
725 # this is from hyper schema
728 description
=> "This defines the link relations of the instance objects" ,
735 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" ,
739 description
=> "This is the name of the link relation" ,
745 description
=> "For submission links, this defines the method that should be used to access the target resource" ,
755 my $default_schema = Storable
:: dclone
( $default_schema_noref );
757 $default_schema ->{ properties
}->{ properties
}->{ additionalProperties
} = $default_schema ;
758 $default_schema ->{ properties
}->{ additionalProperties
}->{ properties
} = $default_schema ->{ properties
};
760 $default_schema ->{ properties
}->{ items
}->{ properties
} = $default_schema ->{ properties
};
761 $default_schema ->{ properties
}->{ items
}->{ additionalProperties
} = 0 ;
763 $default_schema ->{ properties
}->{ disallow
}->{ properties
} = $default_schema ->{ properties
};
764 $default_schema ->{ properties
}->{ disallow
}->{ additionalProperties
} = 0 ;
766 $default_schema ->{ properties
}->{ requires
}->{ properties
} = $default_schema ->{ properties
};
767 $default_schema ->{ properties
}->{ requires
}->{ additionalProperties
} = 0 ;
769 $default_schema ->{ properties
}->{ extends
}->{ properties
} = $default_schema ->{ properties
};
770 $default_schema ->{ properties
}->{ extends
}->{ additionalProperties
} = 0 ;
772 my $method_schema = {
774 additionalProperties
=> 0 ,
777 description
=> "This a description of the method" ,
782 description
=> "This indicates the name of the function to call." ,
785 additionalProperties
=> 1 ,
800 description
=> "The HTTP method name." ,
801 enum
=> [ 'GET' , 'POST' , 'PUT' , 'DELETE' ],
806 description
=> "Method needs special privileges - only pvedaemon can execute it" ,
811 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter." ,
816 description
=> "Required access permissions. By default only 'root' is allowed to access this method." ,
818 additionalProperties
=> 0 ,
821 description
=> "Describe access permissions." ,
825 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials." ,
827 enum
=> [ 'all' , 'world' ],
831 description
=> "Array of permission checks (prefix notation)." ,
838 description
=> "Used internally" ,
842 description
=> "Used internally" ,
847 description
=> "path for URL matching (uri template)" ,
849 fragmentDelimiter
=> {
851 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." ,
856 description
=> "JSON Schema for parameters." ,
861 description
=> "JSON Schema for return value." ,
866 description
=> "method implementaion (code reference)" ,
871 description
=> "Delegate call to this class (perl class string)." ,
874 additionalProperties
=> 0 ,
880 fragmentDelimiter
=> { optional
=> 1 }
888 sub validate_schema
{
891 my $errmsg = "internal error - unable to verify schema \n " ;
892 validate
( $schema, $default_schema, $errmsg );
895 sub validate_method_info
{
898 my $errmsg = "internal error - unable to verify method info \n " ;
899 validate
( $info, $method_schema, $errmsg );
901 validate_schema
( $info ->{ parameters
}) if $info ->{ parameters
};
902 validate_schema
( $info ->{ returns
}) if $info ->{ returns
};
905 # run a self test on load
906 # make sure we can verify the default schema
907 validate_schema
( $default_schema_noref );
908 validate_schema
( $method_schema );
910 # and now some utility methods (used by pve api)
911 sub method_get_child_link
{
914 return undef if ! $info ;
916 my $schema = $info ->{ returns
};
917 return undef if ! $schema || ! $schema ->{ type
} || $schema ->{ type
} ne 'array' ;
919 my $links = $schema ->{ links
};
920 return undef if ! $links ;
923 foreach my $lnk ( @$links ) {
924 if ( $lnk ->{ href
} && $lnk ->{ rel
} && ( $lnk ->{ rel
} eq 'child' )) {
933 # a way to parse command line parameters, using a
934 # schema to configure Getopt::Long
936 my ( $schema, $args, $arg_param, $fixed_param, $pwcallback ) = @_ ;
938 if (! $schema || ! $schema ->{ properties
}) {
939 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
940 if scalar ( @$args ) != 0 ;
945 if ( $arg_param && ! ref ( $arg_param )) {
946 my $pd = $schema ->{ properties
}->{ $arg_param };
947 die "expected list format $pd ->{format}"
948 if !( $pd && $pd ->{ format
} && $pd ->{ format
} =~ m/-list/ );
949 $list_param = $arg_param ;
953 foreach my $prop ( keys %{ $schema ->{ properties
}}) {
954 my $pd = $schema ->{ properties
}->{ $prop };
955 next if $list_param && $prop eq $list_param ;
956 next if defined ( $fixed_param ->{ $prop });
958 if ( $prop eq 'password' && $pwcallback ) {
959 # we do not accept plain password on input line, instead
960 # we turn this into a boolean option and ask for password below
961 # using $pwcallback() (for security reasons).
962 push @getopt, " $prop " ;
963 } elsif ( $pd ->{ type
} eq 'boolean' ) {
964 push @getopt, " $prop :s" ;
966 if ( $pd ->{ format
} && $pd ->{ format
} =~ m/-a?list/ ) {
967 push @getopt, " $prop =s@" ;
969 push @getopt, " $prop =s" ;
975 raise
( "unable to parse option \n " , code
=> HTTP_BAD_REQUEST
)
976 if ! Getopt
:: Long
:: GetOptionsFromArray
( $args, $opts, @getopt );
978 if ( my $acount = scalar ( @$args )) {
980 $opts ->{ $list_param } = $args ;
982 } elsif ( ref ( $arg_param )) {
983 raise
( "wrong number of arguments \n " , code
=> HTTP_BAD_REQUEST
)
984 if scalar ( @$arg_param ) != $acount ;
985 foreach my $p ( @$arg_param ) {
986 $opts ->{ $p } = shift @$args ;
989 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
990 if scalar ( @$args ) != 0 ;
994 if ( my $pd = $schema ->{ properties
}->{ password
}) {
995 if ( $pd ->{ type
} ne 'boolean' && $pwcallback ) {
996 if ( $opts ->{ password
} || ! $pd ->{ optional
}) {
997 $opts ->{ password
} = & $pwcallback ();
1002 $opts = PVE
:: Tools
:: decode_utf8_parameters
( $opts );
1004 foreach my $p ( keys %$opts ) {
1005 if ( my $pd = $schema ->{ properties
}->{ $p }) {
1006 if ( $pd ->{ type
} eq 'boolean' ) {
1007 if ( $opts ->{ $p } eq '' ) {
1009 } elsif ( $opts ->{ $p } =~ m/^(1|true|yes|on)$/i ) {
1011 } elsif ( $opts ->{ $p } =~ m/^(0|false|no|off)$/i ) {
1014 raise
( "unable to parse boolean option \n " , code
=> HTTP_BAD_REQUEST
);
1016 } elsif ( $pd ->{ format
}) {
1018 if ( $pd ->{ format
} =~ m/-list/ ) {
1019 # allow --vmid 100 --vmid 101 and --vmid 100,101
1020 # allow --dow mon --dow fri and --dow mon,fri
1021 $opts ->{ $p } = join ( "," , @{ $opts ->{ $p }});
1022 } elsif ( $pd ->{ format
} =~ m/-alist/ ) {
1023 # we encode array as \0 separated strings
1024 # Note: CGI.pm also use this encoding
1025 if ( scalar (@{ $opts ->{ $p }}) != 1 ) {
1026 $opts ->{ $p } = join ( "\0" , @{ $opts ->{ $p }});
1028 # st that split_list knows it is \0 terminated
1029 my $v = $opts ->{ $p }->[ 0 ];
1030 $opts ->{ $p } = " $v\0 " ;
1037 foreach my $p ( keys %$fixed_param ) {
1038 $opts ->{ $p } = $fixed_param ->{ $p };
1044 # A way to parse configuration data by giving a json schema
1046 my ( $schema, $filename, $raw ) = @_ ;
1048 # do fast check (avoid validate_schema($schema))
1049 die "got strange schema" if ! $schema ->{ type
} ||
1050 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1054 while ( $raw && $raw =~ s/^(.*?)(\n|$)// ) {
1057 next if $line =~ m/^\#/ ; # skip comment lines
1058 next if $line =~ m/^\s*$/ ; # skip empty lines
1060 if ( $line =~ m/^(\S+):\s*(\S+)\s*$/ ) {
1063 if ( $schema ->{ properties
}->{ $key } &&
1064 $schema ->{ properties
}->{ $key }->{ type
} eq 'boolean' ) {
1066 $value = 1 if $value =~ m/^(1|on|yes|true)$/i ;
1067 $value = 0 if $value =~ m/^(0|off|no|false)$/i ;
1069 $cfg ->{ $key } = $value ;
1071 warn "ignore config line: $line\n "
1076 check_prop
( $cfg, $schema, '' , $errors );
1078 foreach my $k ( keys %$errors ) {
1079 warn "parse error in ' $filename ' - ' $k ': $errors ->{ $k } \n " ;
1086 # generate simple key/value file
1088 my ( $schema, $filename, $cfg ) = @_ ;
1090 # do fast check (avoid validate_schema($schema))
1091 die "got strange schema" if ! $schema ->{ type
} ||
1092 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1094 validate
( $cfg, $schema, "validation error in ' $filename ' \n " );
1098 foreach my $k ( keys %$cfg ) {
1099 $data .= " $k : $cfg ->{ $k } \n " ;