]>
git.proxmox.com Git - pve-common.git/blob - src/PVE/JSONSchema.pm
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 ( $ipv4 !~ m/^(?:$IPV4RE)$/ ) {
151 return undef if $noerr ;
152 die "value does not look like a valid IPv4 address \n " ;
157 register_format
( 'ipv6' , \
& pve_verify_ipv6
);
158 sub pve_verify_ipv6
{
159 my ( $ipv6, $noerr ) = @_ ;
161 if ( $ipv6 !~ m/^(?:$IPV6RE)$/ ) {
162 return undef if $noerr ;
163 die "value does not look like a valid IPv6 address \n " ;
168 register_format
( 'ip' , \
& pve_verify_ip
);
170 my ( $ip, $noerr ) = @_ ;
172 if ( $ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/ ) {
173 return undef if $noerr ;
174 die "value does not look like a valid IP address \n " ;
179 my $ipv4_mask_hash = {
196 '255.255.128.0' => 17 ,
197 '255.255.192.0' => 18 ,
198 '255.255.224.0' => 19 ,
199 '255.255.240.0' => 20 ,
200 '255.255.248.0' => 21 ,
201 '255.255.252.0' => 22 ,
202 '255.255.254.0' => 23 ,
203 '255.255.255.0' => 24 ,
204 '255.255.255.128' => 25 ,
205 '255.255.255.192' => 26 ,
206 '255.255.255.224' => 27 ,
207 '255.255.255.240' => 28 ,
208 '255.255.255.248' => 29 ,
209 '255.255.255.252' => 30
212 register_format
( 'ipv4mask' , \
& pve_verify_ipv4mask
);
213 sub pve_verify_ipv4mask
{
214 my ( $mask, $noerr ) = @_ ;
216 if (! defined ( $ipv4_mask_hash ->{ $mask })) {
217 return undef if $noerr ;
218 die "value does not look like a valid IP netmask \n " ;
223 register_format
( 'CIDR' , \
& pve_verify_cidr
);
224 sub pve_verify_cidr
{
225 my ( $cidr, $noerr ) = @_ ;
227 if ( $cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 < 32 )) {
229 } elsif ( $cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 120 )) {
233 return undef if $noerr ;
234 die "value does not look like a valid CIDR network \n " ;
237 register_format
( 'email' , \
& pve_verify_email
);
238 sub pve_verify_email
{
239 my ( $email, $noerr ) = @_ ;
241 # we use same regex as extjs Ext.form.VTypes.email
242 if ( $email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,6}$/ ) {
243 return undef if $noerr ;
244 die "value does not look like a valid email address \n " ;
249 register_format
( 'dns-name' , \
& pve_verify_dns_name
);
250 sub pve_verify_dns_name
{
251 my ( $name, $noerr ) = @_ ;
253 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)" ;
255 if ( $name !~ /^(${namere}\.)*${namere}$/ ) {
256 return undef if $noerr ;
257 die "value does not look like a valid DNS name \n " ;
262 # network interface name
263 register_format
( 'pve-iface' , \
& pve_verify_iface
);
264 sub pve_verify_iface
{
265 my ( $id, $noerr ) = @_ ;
267 if ( $id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i ) {
268 return undef if $noerr ;
269 die "invalid network interface name ' $id ' \n " ;
274 register_standard_option
( 'spice-proxy' , {
275 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)." ,
276 type
=> 'string' , format
=> 'dns-name' ,
279 register_standard_option
( 'remote-viewer-config' , {
280 description
=> "Returned values can be directly passed to the 'remote-viewer' application." ,
281 additionalProperties
=> 1 ,
283 type
=> { type
=> 'string' },
284 password
=> { type
=> 'string' },
285 proxy
=> { type
=> 'string' },
286 host
=> { type
=> 'string' },
287 'tls-port' => { type
=> 'integer' },
291 register_format
( 'pve-startup-order' , \
& pve_verify_startup_order
);
292 sub pve_verify_startup_order
{
293 my ( $value, $noerr ) = @_ ;
295 return $value if pve_parse_startup_order
( $value );
297 return undef if $noerr ;
299 die "unable to parse startup options \n " ;
302 sub pve_parse_startup_order
{
305 return undef if ! $value ;
309 foreach my $p ( split ( /,/ , $value )) {
310 next if $p =~ m/^\s*$/ ;
312 if ( $p =~ m/^(order=)?(\d+)$/ ) {
314 } elsif ( $p =~ m/^up=(\d+)$/ ) {
316 } elsif ( $p =~ m/^down=(\d+)$/ ) {
326 PVE
:: JSONSchema
:: register_standard_option
( 'pve-startup-order' , {
327 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." ,
329 type
=> 'string' , format
=> 'pve-startup-order' ,
330 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ' ,
334 my ( $format, $value ) = @_ ;
336 return if $format eq 'regex' ;
338 if ( $format =~ m/^(.*)-a?list$/ ) {
340 my $code = $format_list ->{ $1 };
342 die "undefined format ' $format ' \n " if ! $code ;
344 # Note: we allow empty lists
345 foreach my $v ( split_list
( $value )) {
349 } elsif ( $format =~ m/^(.*)-opt$/ ) {
351 my $code = $format_list ->{ $1 };
353 die "undefined format ' $format ' \n " if ! $code ;
355 return if ! $value ; # allow empty string
361 my $code = $format_list ->{ $format };
363 die "undefined format ' $format ' \n " if ! $code ;
370 my ( $errors, $path, $msg ) = @_ ;
372 $path = '_root' if ! $path ;
374 if ( $errors ->{ $path }) {
375 $errors ->{ $path } = join ( ' \n ' , $errors ->{ $path }, $msg );
377 $errors ->{ $path } = $msg ;
384 # see 'man perlretut'
385 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/ ;
391 return $value =~ m/^[+-]?\d+$/ ;
395 my ( $path, $type, $value, $errors ) = @_ ;
399 if (! defined ( $value )) {
400 return 1 if $type eq 'null' ;
404 if ( my $tt = ref ( $type )) {
405 if ( $tt eq 'ARRAY' ) {
406 foreach my $t ( @$type ) {
408 check_type
( $path, $t, $value, $tmperr );
409 return 1 if ! scalar ( %$tmperr );
411 my $ttext = join ( '|' , @$type );
412 add_error
( $errors, $path, "type check (' $ttext ') failed" );
414 } elsif ( $tt eq 'HASH' ) {
416 check_prop
( $value, $type, $path, $tmperr );
417 return 1 if ! scalar ( %$tmperr );
418 add_error
( $errors, $path, "type check failed" );
421 die "internal error - got reference type ' $tt '" ;
426 return 1 if $type eq 'any' ;
428 if ( $type eq 'null' ) {
429 if ( defined ( $value )) {
430 add_error
( $errors, $path, "type check (' $type ') failed - value is not null" );
436 my $vt = ref ( $value );
438 if ( $type eq 'array' ) {
439 if (! $vt || $vt ne 'ARRAY' ) {
440 add_error
( $errors, $path, "type check (' $type ') failed" );
444 } elsif ( $type eq 'object' ) {
445 if (! $vt || $vt ne 'HASH' ) {
446 add_error
( $errors, $path, "type check (' $type ') failed" );
450 } elsif ( $type eq 'coderef' ) {
451 if (! $vt || $vt ne 'CODE' ) {
452 add_error
( $errors, $path, "type check (' $type ') failed" );
458 add_error
( $errors, $path, "type check (' $type ') failed - got $vt " );
461 if ( $type eq 'string' ) {
462 return 1 ; # nothing to check ?
463 } elsif ( $type eq 'boolean' ) {
464 #if ($value =~ m/^(1|true|yes|on)$/i) {
467 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
468 } elsif ( $value eq '0' ) {
471 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
474 } elsif ( $type eq 'integer' ) {
475 if (! is_integer
( $value )) {
476 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
480 } elsif ( $type eq 'number' ) {
481 if (! is_number
( $value )) {
482 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
487 return 1 ; # no need to verify unknown types
497 my ( $path, $schema, $value, $additional_properties, $errors ) = @_ ;
499 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
501 my $st = ref ( $schema );
502 if (! $st || $st ne 'HASH' ) {
503 add_error
( $errors, $path, "Invalid schema definition." );
507 my $vt = ref ( $value );
508 if (! $vt || $vt ne 'HASH' ) {
509 add_error
( $errors, $path, "an object is required" );
513 foreach my $k ( keys %$schema ) {
514 check_prop
( $value ->{ $k }, $schema ->{ $k }, $path ?
" $path . $k " : $k, $errors );
517 foreach my $k ( keys %$value ) {
519 my $newpath = $path ?
" $path . $k " : $k ;
521 if ( my $subschema = $schema ->{ $k }) {
522 if ( my $requires = $subschema ->{ requires
}) {
523 if ( ref ( $requires )) {
524 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
525 check_prop
( $value, $requires, $path, $errors );
526 } elsif (! defined ( $value ->{ $requires })) {
527 add_error
( $errors, $path ?
" $path . $requires " : $requires,
528 "missing property - ' $newpath ' requiers this property" );
532 next ; # value is already checked above
535 if ( defined ( $additional_properties ) && ! $additional_properties ) {
536 add_error
( $errors, $newpath, "property is not defined in schema " .
537 "and the schema does not allow additional properties" );
540 check_prop
( $value ->{ $k }, $additional_properties, $newpath, $errors )
541 if ref ( $additional_properties );
546 my ( $value, $schema, $path, $errors ) = @_ ;
548 die "internal error - no schema" if ! $schema ;
549 die "internal error" if ! $errors ;
551 #print "check_prop $path\n" if $value;
553 my $st = ref ( $schema );
554 if (! $st || $st ne 'HASH' ) {
555 add_error
( $errors, $path, "Invalid schema definition." );
559 # if it extends another schema, it must pass that schema as well
560 if ( $schema ->{ extends
}) {
561 check_prop
( $value, $schema ->{ extends
}, $path, $errors );
564 if (! defined ( $value )) {
565 return if $schema ->{ type
} && $schema ->{ type
} eq 'null' ;
566 if (! $schema ->{ optional
}) {
567 add_error
( $errors, $path, "property is missing and it is not optional" );
572 return if ! check_type
( $path, $schema ->{ type
}, $value, $errors );
574 if ( $schema ->{ disallow
}) {
576 if ( check_type
( $path, $schema ->{ disallow
}, $value, $tmperr )) {
577 add_error
( $errors, $path, "disallowed value was matched" );
582 if ( my $vt = ref ( $value )) {
584 if ( $vt eq 'ARRAY' ) {
585 if ( $schema ->{ items
}) {
586 my $it = ref ( $schema ->{ items
});
587 if ( $it && $it eq 'ARRAY' ) {
588 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
589 die "not implemented" ;
592 foreach my $el ( @$value ) {
593 check_prop
( $el, $schema ->{ items
}, "${path}[ $ind ]" , $errors );
599 } elsif ( $schema ->{ properties
} || $schema ->{ additionalProperties
}) {
600 check_object
( $path, defined ( $schema ->{ properties
}) ?
$schema ->{ properties
} : {},
601 $value, $schema ->{ additionalProperties
}, $errors );
607 if ( my $format = $schema ->{ format
}) {
608 eval { check_format
( $format, $value ); };
610 add_error
( $errors, $path, "invalid format - $@ " );
615 if ( my $pattern = $schema ->{ pattern
}) {
616 if ( $value !~ m/^$pattern$/ ) {
617 add_error
( $errors, $path, "value does not match the regex pattern" );
622 if ( defined ( my $max = $schema ->{ maxLength
})) {
623 if ( length ( $value ) > $max ) {
624 add_error
( $errors, $path, "value may only be $max characters long" );
629 if ( defined ( my $min = $schema ->{ minLength
})) {
630 if ( length ( $value ) < $min ) {
631 add_error
( $errors, $path, "value must be at least $min characters long" );
636 if ( is_number
( $value )) {
637 if ( defined ( my $max = $schema ->{ maximum
})) {
639 add_error
( $errors, $path, "value must have a maximum value of $max " );
644 if ( defined ( my $min = $schema ->{ minimum
})) {
646 add_error
( $errors, $path, "value must have a minimum value of $min " );
652 if ( my $ea = $schema ->{ enum
}) {
655 foreach my $ev ( @$ea ) {
662 add_error
( $errors, $path, "value ' $value ' does not have a value in the enumeration '" .
663 join ( ", " , @$ea ) . "'" );
670 my ( $instance, $schema, $errmsg ) = @_ ;
673 $errmsg = "Parameter verification failed. \n " if ! $errmsg ;
675 # todo: cycle detection is only needed for debugging, I guess
676 # we can disable that in the final release
677 # todo: is there a better/faster way to detect cycles?
679 find_cycle
( $instance, sub { $cycles = 1 });
681 add_error
( $errors, undef , "data structure contains recursive cycles" );
683 check_prop
( $instance, $schema, '' , $errors );
686 if ( scalar ( %$errors )) {
687 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors ;
693 my $schema_valid_types = [ "string" , "object" , "coderef" , "array" , "boolean" , "number" , "integer" , "null" , "any" ];
694 my $default_schema_noref = {
695 description
=> "This is the JSON Schema for JSON Schemas." ,
696 type
=> [ "object" ],
697 additionalProperties
=> 0 ,
700 type
=> [ "string" , "array" ],
701 description
=> "This is a type definition value. This can be a simple type, or a union type" ,
706 enum
=> $schema_valid_types,
708 enum
=> $schema_valid_types,
712 description
=> "This indicates that the instance property in the instance object is not required." ,
718 description
=> "This is a definition for the properties of an object value" ,
724 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array" ,
728 additionalProperties
=> {
729 type
=> [ "boolean" , "object" ],
730 description
=> "This provides a default property definition for all properties that are not explicitly defined in an object type definition." ,
737 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number." ,
742 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number." ,
746 description
=> "When the instance value is a string, this indicates minimum length of the string" ,
753 description
=> "When the instance value is a string, this indicates maximum length of the string." ,
759 description
=> "A text representation of the type (used to generate documentation)." ,
764 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." ,
772 description
=> "This provides an enumeration of possible values that are valid for the instance property." ,
777 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)." ,
782 description
=> "This provides the title of the property" ,
785 type
=> [ "string" , "object" ],
787 description
=> "indicates a required property or a schema that must be validated if this property is present" ,
792 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" ,
797 description
=> "This indicates the default for the instance property."
802 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." ,
807 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also." ,
810 # this is from hyper schema
813 description
=> "This defines the link relations of the instance objects" ,
820 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" ,
824 description
=> "This is the name of the link relation" ,
830 description
=> "For submission links, this defines the method that should be used to access the target resource" ,
840 my $default_schema = Storable
:: dclone
( $default_schema_noref );
842 $default_schema ->{ properties
}->{ properties
}->{ additionalProperties
} = $default_schema ;
843 $default_schema ->{ properties
}->{ additionalProperties
}->{ properties
} = $default_schema ->{ properties
};
845 $default_schema ->{ properties
}->{ items
}->{ properties
} = $default_schema ->{ properties
};
846 $default_schema ->{ properties
}->{ items
}->{ additionalProperties
} = 0 ;
848 $default_schema ->{ properties
}->{ disallow
}->{ properties
} = $default_schema ->{ properties
};
849 $default_schema ->{ properties
}->{ disallow
}->{ additionalProperties
} = 0 ;
851 $default_schema ->{ properties
}->{ requires
}->{ properties
} = $default_schema ->{ properties
};
852 $default_schema ->{ properties
}->{ requires
}->{ additionalProperties
} = 0 ;
854 $default_schema ->{ properties
}->{ extends
}->{ properties
} = $default_schema ->{ properties
};
855 $default_schema ->{ properties
}->{ extends
}->{ additionalProperties
} = 0 ;
857 my $method_schema = {
859 additionalProperties
=> 0 ,
862 description
=> "This a description of the method" ,
867 description
=> "This indicates the name of the function to call." ,
870 additionalProperties
=> 1 ,
885 description
=> "The HTTP method name." ,
886 enum
=> [ 'GET' , 'POST' , 'PUT' , 'DELETE' ],
891 description
=> "Method needs special privileges - only pvedaemon can execute it" ,
896 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter." ,
901 description
=> "Required access permissions. By default only 'root' is allowed to access this method." ,
903 additionalProperties
=> 0 ,
906 description
=> "Describe access permissions." ,
910 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials." ,
912 enum
=> [ 'all' , 'world' ],
916 description
=> "Array of permission checks (prefix notation)." ,
923 description
=> "Used internally" ,
927 description
=> "Used internally" ,
932 description
=> "path for URL matching (uri template)" ,
934 fragmentDelimiter
=> {
936 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." ,
941 description
=> "JSON Schema for parameters." ,
946 description
=> "JSON Schema for return value." ,
951 description
=> "method implementaion (code reference)" ,
956 description
=> "Delegate call to this class (perl class string)." ,
959 additionalProperties
=> 0 ,
965 fragmentDelimiter
=> { optional
=> 1 }
973 sub validate_schema
{
976 my $errmsg = "internal error - unable to verify schema \n " ;
977 validate
( $schema, $default_schema, $errmsg );
980 sub validate_method_info
{
983 my $errmsg = "internal error - unable to verify method info \n " ;
984 validate
( $info, $method_schema, $errmsg );
986 validate_schema
( $info ->{ parameters
}) if $info ->{ parameters
};
987 validate_schema
( $info ->{ returns
}) if $info ->{ returns
};
990 # run a self test on load
991 # make sure we can verify the default schema
992 validate_schema
( $default_schema_noref );
993 validate_schema
( $method_schema );
995 # and now some utility methods (used by pve api)
996 sub method_get_child_link
{
999 return undef if ! $info ;
1001 my $schema = $info ->{ returns
};
1002 return undef if ! $schema || ! $schema ->{ type
} || $schema ->{ type
} ne 'array' ;
1004 my $links = $schema ->{ links
};
1005 return undef if ! $links ;
1008 foreach my $lnk ( @$links ) {
1009 if ( $lnk ->{ href
} && $lnk ->{ rel
} && ( $lnk ->{ rel
} eq 'child' )) {
1018 # a way to parse command line parameters, using a
1019 # schema to configure Getopt::Long
1021 my ( $schema, $args, $arg_param, $fixed_param, $pwcallback ) = @_ ;
1023 if (! $schema || ! $schema ->{ properties
}) {
1024 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1025 if scalar ( @$args ) != 0 ;
1030 if ( $arg_param && ! ref ( $arg_param )) {
1031 my $pd = $schema ->{ properties
}->{ $arg_param };
1032 die "expected list format $pd ->{format}"
1033 if !( $pd && $pd ->{ format
} && $pd ->{ format
} =~ m/-list/ );
1034 $list_param = $arg_param ;
1038 foreach my $prop ( keys %{ $schema ->{ properties
}}) {
1039 my $pd = $schema ->{ properties
}->{ $prop };
1040 next if $list_param && $prop eq $list_param ;
1041 next if defined ( $fixed_param ->{ $prop });
1043 if ( $prop eq 'password' && $pwcallback ) {
1044 # we do not accept plain password on input line, instead
1045 # we turn this into a boolean option and ask for password below
1046 # using $pwcallback() (for security reasons).
1047 push @getopt, " $prop " ;
1048 } elsif ( $pd ->{ type
} eq 'boolean' ) {
1049 push @getopt, " $prop :s" ;
1051 if ( $pd ->{ format
} && $pd ->{ format
} =~ m/-a?list/ ) {
1052 push @getopt, " $prop =s@" ;
1054 push @getopt, " $prop =s" ;
1060 raise
( "unable to parse option \n " , code
=> HTTP_BAD_REQUEST
)
1061 if ! Getopt
:: Long
:: GetOptionsFromArray
( $args, $opts, @getopt );
1063 if ( my $acount = scalar ( @$args )) {
1065 $opts ->{ $list_param } = $args ;
1067 } elsif ( ref ( $arg_param )) {
1068 raise
( "wrong number of arguments \n " , code
=> HTTP_BAD_REQUEST
)
1069 if scalar ( @$arg_param ) != $acount ;
1070 foreach my $p ( @$arg_param ) {
1071 $opts ->{ $p } = shift @$args ;
1074 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1075 if scalar ( @$args ) != 0 ;
1079 if ( my $pd = $schema ->{ properties
}->{ password
}) {
1080 if ( $pd ->{ type
} ne 'boolean' && $pwcallback ) {
1081 if ( $opts ->{ password
} || ! $pd ->{ optional
}) {
1082 $opts ->{ password
} = & $pwcallback ();
1087 $opts = PVE
:: Tools
:: decode_utf8_parameters
( $opts );
1089 foreach my $p ( keys %$opts ) {
1090 if ( my $pd = $schema ->{ properties
}->{ $p }) {
1091 if ( $pd ->{ type
} eq 'boolean' ) {
1092 if ( $opts ->{ $p } eq '' ) {
1094 } elsif ( $opts ->{ $p } =~ m/^(1|true|yes|on)$/i ) {
1096 } elsif ( $opts ->{ $p } =~ m/^(0|false|no|off)$/i ) {
1099 raise
( "unable to parse boolean option \n " , code
=> HTTP_BAD_REQUEST
);
1101 } elsif ( $pd ->{ format
}) {
1103 if ( $pd ->{ format
} =~ m/-list/ ) {
1104 # allow --vmid 100 --vmid 101 and --vmid 100,101
1105 # allow --dow mon --dow fri and --dow mon,fri
1106 $opts ->{ $p } = join ( "," , @{ $opts ->{ $p }});
1107 } elsif ( $pd ->{ format
} =~ m/-alist/ ) {
1108 # we encode array as \0 separated strings
1109 # Note: CGI.pm also use this encoding
1110 if ( scalar (@{ $opts ->{ $p }}) != 1 ) {
1111 $opts ->{ $p } = join ( "\0" , @{ $opts ->{ $p }});
1113 # st that split_list knows it is \0 terminated
1114 my $v = $opts ->{ $p }->[ 0 ];
1115 $opts ->{ $p } = " $v\0 " ;
1122 foreach my $p ( keys %$fixed_param ) {
1123 $opts ->{ $p } = $fixed_param ->{ $p };
1129 # A way to parse configuration data by giving a json schema
1131 my ( $schema, $filename, $raw ) = @_ ;
1133 # do fast check (avoid validate_schema($schema))
1134 die "got strange schema" if ! $schema ->{ type
} ||
1135 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1139 while ( $raw && $raw =~ s/^(.*?)(\n|$)// ) {
1142 next if $line =~ m/^\#/ ; # skip comment lines
1143 next if $line =~ m/^\s*$/ ; # skip empty lines
1145 if ( $line =~ m/^(\S+):\s*(\S+)\s*$/ ) {
1148 if ( $schema ->{ properties
}->{ $key } &&
1149 $schema ->{ properties
}->{ $key }->{ type
} eq 'boolean' ) {
1151 $value = 1 if $value =~ m/^(1|on|yes|true)$/i ;
1152 $value = 0 if $value =~ m/^(0|off|no|false)$/i ;
1154 $cfg ->{ $key } = $value ;
1156 warn "ignore config line: $line\n "
1161 check_prop
( $cfg, $schema, '' , $errors );
1163 foreach my $k ( keys %$errors ) {
1164 warn "parse error in ' $filename ' - ' $k ': $errors ->{ $k } \n " ;
1171 # generate simple key/value file
1173 my ( $schema, $filename, $cfg ) = @_ ;
1175 # do fast check (avoid validate_schema($schema))
1176 die "got strange schema" if ! $schema ->{ type
} ||
1177 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1179 validate
( $cfg, $schema, "validation error in ' $filename ' \n " );
1183 foreach my $k ( keys %$cfg ) {
1184 $data .= " $k : $cfg ->{ $k } \n " ;