]>
git.proxmox.com Git - pve-common.git/blob - src/PVE/JSONSchema.pm
45ce5ba58c3ad5720bdf727d4615ac2d4b8e34d7
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 ) {
45 next if defined ( $res ->{ $opt });
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
86 PVE
:: JSONSchema
:: register_standard_option
( 'extra-args' , {
87 description
=> "Extra arguments as array" ,
89 items
=> { type
=> 'string' },
96 my ( $format, $code ) = @_ ;
98 die "JSON schema format ' $format ' already registered \n "
99 if $format_list ->{ $format };
101 $format_list ->{ $format } = $code ;
104 # register some common type for pve
106 register_format
( 'string' , sub {}); # allow format => 'string-list'
108 register_format
( 'pve-configid' , \
& pve_verify_configid
);
109 sub pve_verify_configid
{
110 my ( $id, $noerr ) = @_ ;
112 if ( $id !~ m/^[a-z][a-z0-9_]+$/i ) {
113 return undef if $noerr ;
114 die "invalid configuration ID ' $id ' \n " ;
119 PVE
:: JSONSchema
:: register_format
( 'pve-storage-id' , \
& parse_storage_id
);
120 sub parse_storage_id
{
121 my ( $storeid, $noerr ) = @_ ;
123 if ( $storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i ) {
124 return undef if $noerr ;
125 die "storage ID ' $storeid ' contains illegal characters \n " ;
131 register_format
( 'pve-vmid' , \
& pve_verify_vmid
);
132 sub pve_verify_vmid
{
133 my ( $vmid, $noerr ) = @_ ;
135 if ( $vmid !~ m/^[1-9][0-9]+$/ ) {
136 return undef if $noerr ;
137 die "value does not look like a valid VM ID \n " ;
142 register_format
( 'pve-node' , \
& pve_verify_node_name
);
143 sub pve_verify_node_name
{
144 my ( $node, $noerr ) = @_ ;
146 if ( $node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/ ) {
147 return undef if $noerr ;
148 die "value does not look like a valid node name \n " ;
153 register_format
( 'ipv4' , \
& pve_verify_ipv4
);
154 sub pve_verify_ipv4
{
155 my ( $ipv4, $noerr ) = @_ ;
157 if ( $ipv4 !~ m/^(?:$IPV4RE)$/ ) {
158 return undef if $noerr ;
159 die "value does not look like a valid IPv4 address \n " ;
164 register_format
( 'ipv6' , \
& pve_verify_ipv6
);
165 sub pve_verify_ipv6
{
166 my ( $ipv6, $noerr ) = @_ ;
168 if ( $ipv6 !~ m/^(?:$IPV6RE)$/ ) {
169 return undef if $noerr ;
170 die "value does not look like a valid IPv6 address \n " ;
175 register_format
( 'ip' , \
& pve_verify_ip
);
177 my ( $ip, $noerr ) = @_ ;
179 if ( $ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/ ) {
180 return undef if $noerr ;
181 die "value does not look like a valid IP address \n " ;
186 my $ipv4_mask_hash = {
203 '255.255.128.0' => 17 ,
204 '255.255.192.0' => 18 ,
205 '255.255.224.0' => 19 ,
206 '255.255.240.0' => 20 ,
207 '255.255.248.0' => 21 ,
208 '255.255.252.0' => 22 ,
209 '255.255.254.0' => 23 ,
210 '255.255.255.0' => 24 ,
211 '255.255.255.128' => 25 ,
212 '255.255.255.192' => 26 ,
213 '255.255.255.224' => 27 ,
214 '255.255.255.240' => 28 ,
215 '255.255.255.248' => 29 ,
216 '255.255.255.252' => 30
219 register_format
( 'ipv4mask' , \
& pve_verify_ipv4mask
);
220 sub pve_verify_ipv4mask
{
221 my ( $mask, $noerr ) = @_ ;
223 if (! defined ( $ipv4_mask_hash ->{ $mask })) {
224 return undef if $noerr ;
225 die "value does not look like a valid IP netmask \n " ;
230 register_format
( 'CIDRv6' , \
& pve_verify_cidrv6
);
231 sub pve_verify_cidrv6
{
232 my ( $cidr, $noerr ) = @_ ;
234 if ( $cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 120 )) {
238 return undef if $noerr ;
239 die "value does not look like a valid IPv6 CIDR network \n " ;
242 register_format
( 'CIDRv4' , \
& pve_verify_cidrv4
);
243 sub pve_verify_cidrv4
{
244 my ( $cidr, $noerr ) = @_ ;
246 if ( $cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 < 32 )) {
250 return undef if $noerr ;
251 die "value does not look like a valid IPv4 CIDR network \n " ;
254 register_format
( 'CIDR' , \
& pve_verify_cidr
);
255 sub pve_verify_cidr
{
256 my ( $cidr, $noerr ) = @_ ;
258 if (!( pve_verify_cidrv4
( $cidr, 1 ) ||
259 pve_verify_cidrv6
( $cidr, 1 )))
261 return undef if $noerr ;
262 die "value does not look like a valid CIDR network \n " ;
268 register_format
( 'pve-ipv4-config' , \
& pve_verify_ipv4_config
);
269 sub pve_verify_ipv4_config
{
270 my ( $config, $noerr ) = @_ ;
272 return $config if $config =~ /^(?:dhcp|manual)$/ ||
273 pve_verify_cidrv4
( $config, 1 );
274 return undef if $noerr ;
275 die "value does not look like a valid ipv4 network configuration \n " ;
278 register_format
( 'pve-ipv6-config' , \
& pve_verify_ipv6_config
);
279 sub pve_verify_ipv6_config
{
280 my ( $config, $noerr ) = @_ ;
282 return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
283 pve_verify_cidrv6
( $config, 1 );
284 return undef if $noerr ;
285 die "value does not look like a valid ipv6 network configuration \n " ;
288 register_format
( 'email' , \
& pve_verify_email
);
289 sub pve_verify_email
{
290 my ( $email, $noerr ) = @_ ;
292 # we use same regex as in Utils.js
293 if ( $email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/ ) {
294 return undef if $noerr ;
295 die "value does not look like a valid email address \n " ;
300 register_format
( 'dns-name' , \
& pve_verify_dns_name
);
301 sub pve_verify_dns_name
{
302 my ( $name, $noerr ) = @_ ;
304 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)" ;
306 if ( $name !~ /^(${namere}\.)*${namere}$/ ) {
307 return undef if $noerr ;
308 die "value does not look like a valid DNS name \n " ;
313 # network interface name
314 register_format
( 'pve-iface' , \
& pve_verify_iface
);
315 sub pve_verify_iface
{
316 my ( $id, $noerr ) = @_ ;
318 if ( $id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i ) {
319 return undef if $noerr ;
320 die "invalid network interface name ' $id ' \n " ;
325 # general addresses by name or IP
326 register_format
( 'address' , \
& pve_verify_address
);
327 sub pve_verify_address
{
328 my ( $addr, $noerr ) = @_ ;
330 if (!( pve_verify_ip
( $addr, 1 ) ||
331 pve_verify_dns_name
( $addr, 1 )))
333 return undef if $noerr ;
334 die "value does not look like a valid address: $addr\n " ;
339 register_standard_option
( 'spice-proxy' , {
340 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)." ,
341 type
=> 'string' , format
=> 'address' ,
344 register_standard_option
( 'remote-viewer-config' , {
345 description
=> "Returned values can be directly passed to the 'remote-viewer' application." ,
346 additionalProperties
=> 1 ,
348 type
=> { type
=> 'string' },
349 password
=> { type
=> 'string' },
350 proxy
=> { type
=> 'string' },
351 host
=> { type
=> 'string' },
352 'tls-port' => { type
=> 'integer' },
356 register_format
( 'pve-startup-order' , \
& pve_verify_startup_order
);
357 sub pve_verify_startup_order
{
358 my ( $value, $noerr ) = @_ ;
360 return $value if pve_parse_startup_order
( $value );
362 return undef if $noerr ;
364 die "unable to parse startup options \n " ;
367 sub pve_parse_startup_order
{
370 return undef if ! $value ;
374 foreach my $p ( split ( /,/ , $value )) {
375 next if $p =~ m/^\s*$/ ;
377 if ( $p =~ m/^(order=)?(\d+)$/ ) {
379 } elsif ( $p =~ m/^up=(\d+)$/ ) {
381 } elsif ( $p =~ m/^down=(\d+)$/ ) {
391 PVE
:: JSONSchema
:: register_standard_option
( 'pve-startup-order' , {
392 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." ,
394 type
=> 'string' , format
=> 'pve-startup-order' ,
395 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ' ,
399 my ( $format, $value ) = @_ ;
401 return if $format eq 'regex' ;
403 if ( $format =~ m/^(.*)-a?list$/ ) {
405 my $code = $format_list ->{ $1 };
407 die "undefined format ' $format ' \n " if ! $code ;
409 # Note: we allow empty lists
410 foreach my $v ( split_list
( $value )) {
414 } elsif ( $format =~ m/^(.*)-opt$/ ) {
416 my $code = $format_list ->{ $1 };
418 die "undefined format ' $format ' \n " if ! $code ;
420 return if ! $value ; # allow empty string
426 my $code = $format_list ->{ $format };
428 die "undefined format ' $format ' \n " if ! $code ;
435 my ( $errors, $path, $msg ) = @_ ;
437 $path = '_root' if ! $path ;
439 if ( $errors ->{ $path }) {
440 $errors ->{ $path } = join ( ' \n ' , $errors ->{ $path }, $msg );
442 $errors ->{ $path } = $msg ;
449 # see 'man perlretut'
450 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/ ;
456 return $value =~ m/^[+-]?\d+$/ ;
460 my ( $path, $type, $value, $errors ) = @_ ;
464 if (! defined ( $value )) {
465 return 1 if $type eq 'null' ;
469 if ( my $tt = ref ( $type )) {
470 if ( $tt eq 'ARRAY' ) {
471 foreach my $t ( @$type ) {
473 check_type
( $path, $t, $value, $tmperr );
474 return 1 if ! scalar ( %$tmperr );
476 my $ttext = join ( '|' , @$type );
477 add_error
( $errors, $path, "type check (' $ttext ') failed" );
479 } elsif ( $tt eq 'HASH' ) {
481 check_prop
( $value, $type, $path, $tmperr );
482 return 1 if ! scalar ( %$tmperr );
483 add_error
( $errors, $path, "type check failed" );
486 die "internal error - got reference type ' $tt '" ;
491 return 1 if $type eq 'any' ;
493 if ( $type eq 'null' ) {
494 if ( defined ( $value )) {
495 add_error
( $errors, $path, "type check (' $type ') failed - value is not null" );
501 my $vt = ref ( $value );
503 if ( $type eq 'array' ) {
504 if (! $vt || $vt ne 'ARRAY' ) {
505 add_error
( $errors, $path, "type check (' $type ') failed" );
509 } elsif ( $type eq 'object' ) {
510 if (! $vt || $vt ne 'HASH' ) {
511 add_error
( $errors, $path, "type check (' $type ') failed" );
515 } elsif ( $type eq 'coderef' ) {
516 if (! $vt || $vt ne 'CODE' ) {
517 add_error
( $errors, $path, "type check (' $type ') failed" );
523 add_error
( $errors, $path, "type check (' $type ') failed - got $vt " );
526 if ( $type eq 'string' ) {
527 return 1 ; # nothing to check ?
528 } elsif ( $type eq 'boolean' ) {
529 #if ($value =~ m/^(1|true|yes|on)$/i) {
532 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
533 } elsif ( $value eq '0' ) {
536 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
539 } elsif ( $type eq 'integer' ) {
540 if (! is_integer
( $value )) {
541 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
545 } elsif ( $type eq 'number' ) {
546 if (! is_number
( $value )) {
547 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
552 return 1 ; # no need to verify unknown types
562 my ( $path, $schema, $value, $additional_properties, $errors ) = @_ ;
564 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
566 my $st = ref ( $schema );
567 if (! $st || $st ne 'HASH' ) {
568 add_error
( $errors, $path, "Invalid schema definition." );
572 my $vt = ref ( $value );
573 if (! $vt || $vt ne 'HASH' ) {
574 add_error
( $errors, $path, "an object is required" );
578 foreach my $k ( keys %$schema ) {
579 check_prop
( $value ->{ $k }, $schema ->{ $k }, $path ?
" $path . $k " : $k, $errors );
582 foreach my $k ( keys %$value ) {
584 my $newpath = $path ?
" $path . $k " : $k ;
586 if ( my $subschema = $schema ->{ $k }) {
587 if ( my $requires = $subschema ->{ requires
}) {
588 if ( ref ( $requires )) {
589 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
590 check_prop
( $value, $requires, $path, $errors );
591 } elsif (! defined ( $value ->{ $requires })) {
592 add_error
( $errors, $path ?
" $path . $requires " : $requires,
593 "missing property - ' $newpath ' requiers this property" );
597 next ; # value is already checked above
600 if ( defined ( $additional_properties ) && ! $additional_properties ) {
601 add_error
( $errors, $newpath, "property is not defined in schema " .
602 "and the schema does not allow additional properties" );
605 check_prop
( $value ->{ $k }, $additional_properties, $newpath, $errors )
606 if ref ( $additional_properties );
610 sub check_object_warn
{
611 my ( $path, $schema, $value, $additional_properties ) = @_ ;
613 check_object
( $path, $schema, $value, $additional_properties, $errors );
614 if ( scalar ( %$errors )) {
615 foreach my $k ( keys %$errors ) {
616 warn "parse error: $k : $errors ->{ $k } \n " ;
624 my ( $value, $schema, $path, $errors ) = @_ ;
626 die "internal error - no schema" if ! $schema ;
627 die "internal error" if ! $errors ;
629 #print "check_prop $path\n" if $value;
631 my $st = ref ( $schema );
632 if (! $st || $st ne 'HASH' ) {
633 add_error
( $errors, $path, "Invalid schema definition." );
637 # if it extends another schema, it must pass that schema as well
638 if ( $schema ->{ extends
}) {
639 check_prop
( $value, $schema ->{ extends
}, $path, $errors );
642 if (! defined ( $value )) {
643 return if $schema ->{ type
} && $schema ->{ type
} eq 'null' ;
644 if (! $schema ->{ optional
}) {
645 add_error
( $errors, $path, "property is missing and it is not optional" );
650 return if ! check_type
( $path, $schema ->{ type
}, $value, $errors );
652 if ( $schema ->{ disallow
}) {
654 if ( check_type
( $path, $schema ->{ disallow
}, $value, $tmperr )) {
655 add_error
( $errors, $path, "disallowed value was matched" );
660 if ( my $vt = ref ( $value )) {
662 if ( $vt eq 'ARRAY' ) {
663 if ( $schema ->{ items
}) {
664 my $it = ref ( $schema ->{ items
});
665 if ( $it && $it eq 'ARRAY' ) {
666 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
667 die "not implemented" ;
670 foreach my $el ( @$value ) {
671 check_prop
( $el, $schema ->{ items
}, "${path}[ $ind ]" , $errors );
677 } elsif ( $schema ->{ properties
} || $schema ->{ additionalProperties
}) {
678 check_object
( $path, defined ( $schema ->{ properties
}) ?
$schema ->{ properties
} : {},
679 $value, $schema ->{ additionalProperties
}, $errors );
685 if ( my $format = $schema ->{ format
}) {
686 eval { check_format
( $format, $value ); };
688 add_error
( $errors, $path, "invalid format - $@ " );
693 if ( my $pattern = $schema ->{ pattern
}) {
694 if ( $value !~ m/^$pattern$/ ) {
695 add_error
( $errors, $path, "value does not match the regex pattern" );
700 if ( defined ( my $max = $schema ->{ maxLength
})) {
701 if ( length ( $value ) > $max ) {
702 add_error
( $errors, $path, "value may only be $max characters long" );
707 if ( defined ( my $min = $schema ->{ minLength
})) {
708 if ( length ( $value ) < $min ) {
709 add_error
( $errors, $path, "value must be at least $min characters long" );
714 if ( is_number
( $value )) {
715 if ( defined ( my $max = $schema ->{ maximum
})) {
717 add_error
( $errors, $path, "value must have a maximum value of $max " );
722 if ( defined ( my $min = $schema ->{ minimum
})) {
724 add_error
( $errors, $path, "value must have a minimum value of $min " );
730 if ( my $ea = $schema ->{ enum
}) {
733 foreach my $ev ( @$ea ) {
740 add_error
( $errors, $path, "value ' $value ' does not have a value in the enumeration '" .
741 join ( ", " , @$ea ) . "'" );
748 my ( $instance, $schema, $errmsg ) = @_ ;
751 $errmsg = "Parameter verification failed. \n " if ! $errmsg ;
753 # todo: cycle detection is only needed for debugging, I guess
754 # we can disable that in the final release
755 # todo: is there a better/faster way to detect cycles?
757 find_cycle
( $instance, sub { $cycles = 1 });
759 add_error
( $errors, undef , "data structure contains recursive cycles" );
761 check_prop
( $instance, $schema, '' , $errors );
764 if ( scalar ( %$errors )) {
765 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors ;
771 my $schema_valid_types = [ "string" , "object" , "coderef" , "array" , "boolean" , "number" , "integer" , "null" , "any" ];
772 my $default_schema_noref = {
773 description
=> "This is the JSON Schema for JSON Schemas." ,
774 type
=> [ "object" ],
775 additionalProperties
=> 0 ,
778 type
=> [ "string" , "array" ],
779 description
=> "This is a type definition value. This can be a simple type, or a union type" ,
784 enum
=> $schema_valid_types,
786 enum
=> $schema_valid_types,
790 description
=> "This indicates that the instance property in the instance object is not required." ,
796 description
=> "This is a definition for the properties of an object value" ,
802 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array" ,
806 additionalProperties
=> {
807 type
=> [ "boolean" , "object" ],
808 description
=> "This provides a default property definition for all properties that are not explicitly defined in an object type definition." ,
815 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number." ,
820 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number." ,
824 description
=> "When the instance value is a string, this indicates minimum length of the string" ,
831 description
=> "When the instance value is a string, this indicates maximum length of the string." ,
837 description
=> "A text representation of the type (used to generate documentation)." ,
842 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." ,
850 description
=> "This provides an enumeration of possible values that are valid for the instance property." ,
855 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)." ,
857 format_description
=> {
860 description
=> "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings." ,
865 description
=> "This provides the title of the property" ,
868 type
=> [ "string" , "object" ],
870 description
=> "indicates a required property or a schema that must be validated if this property is present" ,
875 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" ,
880 description
=> "This indicates the default for the instance property."
884 description
=> "Bash completion function. This function should return a list of possible values." ,
890 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." ,
895 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also." ,
898 # this is from hyper schema
901 description
=> "This defines the link relations of the instance objects" ,
908 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" ,
912 description
=> "This is the name of the link relation" ,
918 description
=> "For submission links, this defines the method that should be used to access the target resource" ,
928 my $default_schema = Storable
:: dclone
( $default_schema_noref );
930 $default_schema ->{ properties
}->{ properties
}->{ additionalProperties
} = $default_schema ;
931 $default_schema ->{ properties
}->{ additionalProperties
}->{ properties
} = $default_schema ->{ properties
};
933 $default_schema ->{ properties
}->{ items
}->{ properties
} = $default_schema ->{ properties
};
934 $default_schema ->{ properties
}->{ items
}->{ additionalProperties
} = 0 ;
936 $default_schema ->{ properties
}->{ disallow
}->{ properties
} = $default_schema ->{ properties
};
937 $default_schema ->{ properties
}->{ disallow
}->{ additionalProperties
} = 0 ;
939 $default_schema ->{ properties
}->{ requires
}->{ properties
} = $default_schema ->{ properties
};
940 $default_schema ->{ properties
}->{ requires
}->{ additionalProperties
} = 0 ;
942 $default_schema ->{ properties
}->{ extends
}->{ properties
} = $default_schema ->{ properties
};
943 $default_schema ->{ properties
}->{ extends
}->{ additionalProperties
} = 0 ;
945 my $method_schema = {
947 additionalProperties
=> 0 ,
950 description
=> "This a description of the method" ,
955 description
=> "This indicates the name of the function to call." ,
958 additionalProperties
=> 1 ,
973 description
=> "The HTTP method name." ,
974 enum
=> [ 'GET' , 'POST' , 'PUT' , 'DELETE' ],
979 description
=> "Method needs special privileges - only pvedaemon can execute it" ,
984 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter." ,
989 description
=> "Required access permissions. By default only 'root' is allowed to access this method." ,
991 additionalProperties
=> 0 ,
994 description
=> "Describe access permissions." ,
998 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials." ,
1000 enum
=> [ 'all' , 'world' ],
1004 description
=> "Array of permission checks (prefix notation)." ,
1011 description
=> "Used internally" ,
1015 description
=> "Used internally" ,
1020 description
=> "path for URL matching (uri template)" ,
1022 fragmentDelimiter
=> {
1024 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." ,
1029 description
=> "JSON Schema for parameters." ,
1034 description
=> "Used to store page formatter information (set by PVE::RESTHandler->register_page_formatter)." ,
1039 description
=> "JSON Schema for return value." ,
1044 description
=> "method implementaion (code reference)" ,
1049 description
=> "Delegate call to this class (perl class string)." ,
1052 additionalProperties
=> 0 ,
1058 fragmentDelimiter
=> { optional
=> 1 }
1066 sub validate_schema
{
1069 my $errmsg = "internal error - unable to verify schema \n " ;
1070 validate
( $schema, $default_schema, $errmsg );
1073 sub validate_method_info
{
1076 my $errmsg = "internal error - unable to verify method info \n " ;
1077 validate
( $info, $method_schema, $errmsg );
1079 validate_schema
( $info ->{ parameters
}) if $info ->{ parameters
};
1080 validate_schema
( $info ->{ returns
}) if $info ->{ returns
};
1083 # run a self test on load
1084 # make sure we can verify the default schema
1085 validate_schema
( $default_schema_noref );
1086 validate_schema
( $method_schema );
1088 # and now some utility methods (used by pve api)
1089 sub method_get_child_link
{
1092 return undef if ! $info ;
1094 my $schema = $info ->{ returns
};
1095 return undef if ! $schema || ! $schema ->{ type
} || $schema ->{ type
} ne 'array' ;
1097 my $links = $schema ->{ links
};
1098 return undef if ! $links ;
1101 foreach my $lnk ( @$links ) {
1102 if ( $lnk ->{ href
} && $lnk ->{ rel
} && ( $lnk ->{ rel
} eq 'child' )) {
1111 # a way to parse command line parameters, using a
1112 # schema to configure Getopt::Long
1114 my ( $schema, $args, $arg_param, $fixed_param, $pwcallback ) = @_ ;
1116 if (! $schema || ! $schema ->{ properties
}) {
1117 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1118 if scalar ( @$args ) != 0 ;
1123 if ( $arg_param && ! ref ( $arg_param )) {
1124 my $pd = $schema ->{ properties
}->{ $arg_param };
1125 die "expected list format $pd ->{format}"
1126 if !( $pd && $pd ->{ format
} && $pd ->{ format
} =~ m/-list/ );
1127 $list_param = $arg_param ;
1131 foreach my $prop ( keys %{ $schema ->{ properties
}}) {
1132 my $pd = $schema ->{ properties
}->{ $prop };
1133 next if $list_param && $prop eq $list_param ;
1134 next if defined ( $fixed_param ->{ $prop });
1136 if ( $prop eq 'password' && $pwcallback ) {
1137 # we do not accept plain password on input line, instead
1138 # we turn this into a boolean option and ask for password below
1139 # using $pwcallback() (for security reasons).
1140 push @getopt, " $prop " ;
1141 } elsif ( $pd ->{ type
} eq 'boolean' ) {
1142 push @getopt, " $prop :s" ;
1144 if ( $pd ->{ format
} && $pd ->{ format
} =~ m/-a?list/ ) {
1145 push @getopt, " $prop =s@" ;
1147 push @getopt, " $prop =s" ;
1152 Getopt
:: Long
:: Configure
( 'prefix_pattern=(--|-)' );
1155 raise
( "unable to parse option \n " , code
=> HTTP_BAD_REQUEST
)
1156 if ! Getopt
:: Long
:: GetOptionsFromArray
( $args, $opts, @getopt );
1160 $opts ->{ $list_param } = $args ;
1162 } elsif ( ref ( $arg_param )) {
1163 foreach my $arg_name ( @$arg_param ) {
1164 if ( $opts ->{ 'extra-args' }) {
1165 raise
( "internal error: extra-args must be the last argument \n " , code
=> HTTP_BAD_REQUEST
);
1167 if ( $arg_name eq 'extra-args' ) {
1168 $opts ->{ 'extra-args' } = $args ;
1172 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
) if ! @$args ;
1173 $opts ->{ $arg_name } = shift @$args ;
1175 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
) if @$args ;
1177 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1178 if scalar ( @$args ) != 0 ;
1182 if ( my $pd = $schema ->{ properties
}->{ password
}) {
1183 if ( $pd ->{ type
} ne 'boolean' && $pwcallback ) {
1184 if ( $opts ->{ password
} || ! $pd ->{ optional
}) {
1185 $opts ->{ password
} = & $pwcallback ();
1190 $opts = PVE
:: Tools
:: decode_utf8_parameters
( $opts );
1192 foreach my $p ( keys %$opts ) {
1193 if ( my $pd = $schema ->{ properties
}->{ $p }) {
1194 if ( $pd ->{ type
} eq 'boolean' ) {
1195 if ( $opts ->{ $p } eq '' ) {
1197 } elsif ( $opts ->{ $p } =~ m/^(1|true|yes|on)$/i ) {
1199 } elsif ( $opts ->{ $p } =~ m/^(0|false|no|off)$/i ) {
1202 raise
( "unable to parse boolean option \n " , code
=> HTTP_BAD_REQUEST
);
1204 } elsif ( $pd ->{ format
}) {
1206 if ( $pd ->{ format
} =~ m/-list/ ) {
1207 # allow --vmid 100 --vmid 101 and --vmid 100,101
1208 # allow --dow mon --dow fri and --dow mon,fri
1209 $opts ->{ $p } = join ( "," , @{ $opts ->{ $p }}) if ref ( $opts ->{ $p }) eq 'ARRAY' ;
1210 } elsif ( $pd ->{ format
} =~ m/-alist/ ) {
1211 # we encode array as \0 separated strings
1212 # Note: CGI.pm also use this encoding
1213 if ( scalar (@{ $opts ->{ $p }}) != 1 ) {
1214 $opts ->{ $p } = join ( "\0" , @{ $opts ->{ $p }});
1216 # st that split_list knows it is \0 terminated
1217 my $v = $opts ->{ $p }->[ 0 ];
1218 $opts ->{ $p } = " $v\0 " ;
1225 foreach my $p ( keys %$fixed_param ) {
1226 $opts ->{ $p } = $fixed_param ->{ $p };
1232 # A way to parse configuration data by giving a json schema
1234 my ( $schema, $filename, $raw ) = @_ ;
1236 # do fast check (avoid validate_schema($schema))
1237 die "got strange schema" if ! $schema ->{ type
} ||
1238 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1242 while ( $raw =~ /^\s*(.+?)\s*$/gm ) {
1245 next if $line =~ /^#/ ;
1247 if ( $line =~ m/^(\S+?):\s*(.*)$/ ) {
1250 if ( $schema ->{ properties
}->{ $key } &&
1251 $schema ->{ properties
}->{ $key }->{ type
} eq 'boolean' ) {
1253 $value = 1 if $value =~ m/^(1|on|yes|true)$/i ;
1254 $value = 0 if $value =~ m/^(0|off|no|false)$/i ;
1256 $cfg ->{ $key } = $value ;
1258 warn "ignore config line: $line\n "
1263 check_prop
( $cfg, $schema, '' , $errors );
1265 foreach my $k ( keys %$errors ) {
1266 warn "parse error in ' $filename ' - ' $k ': $errors ->{ $k } \n " ;
1273 # generate simple key/value file
1275 my ( $schema, $filename, $cfg ) = @_ ;
1277 # do fast check (avoid validate_schema($schema))
1278 die "got strange schema" if ! $schema ->{ type
} ||
1279 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1281 validate
( $cfg, $schema, "validation error in ' $filename ' \n " );
1285 foreach my $k ( keys %$cfg ) {
1286 $data .= " $k : $cfg ->{ $k } \n " ;
1292 sub generate_typetext
{
1295 my ( @optional, @required );
1296 foreach my $key ( sort keys %$schema ) {
1297 next if ! $schema ->{ $key }->{ format_description
} &&
1298 ! $schema ->{ $key }->{ typetext
};
1299 if ( $schema ->{ $key }->{ optional
}) {
1300 push @optional, $key ;
1302 push @required, $key ;
1305 my ( $pre, $post ) = ( '' , '' );
1308 if ( my $desc = $schema ->{ $key }->{ format_description
}) {
1309 $typetext .= " $pre$key =< $desc > $post " ;
1310 } elsif ( my $text = $schema ->{ $key }->{ typetext
}) {
1311 $typetext .= " $pre$text$post " ;
1313 die "internal error: neither format_description nor typetext found" ;
1316 foreach my $key ( @required ) {
1320 $pre = $pre ?
' [,' : '[' ;
1322 foreach my $key ( @optional ) {