]>
git.proxmox.com Git - pve-common.git/blob - src/PVE/JSONSchema.pm
1 package PVE
:: JSONSchema
;
5 use Storable
; # for dclone
9 use Devel
:: Cycle
- quiet
; # todo: remove?
10 use PVE
:: Tools
qw(split_list $IPV6RE $IPV4RE ) ;
11 use PVE
:: Exception
qw(raise) ;
12 use HTTP
:: Status
qw(:constants) ;
13 use Net
:: IP
qw(:PROC) ;
19 register_standard_option
23 # Note: This class implements something similar to JSON schema, but it is not 100% complete.
24 # see: http://tools.ietf.org/html/draft-zyp-json-schema-02
25 # see: http://json-schema.org/
27 # the code is similar to the javascript parser from http://code.google.com/p/jsonschema/
29 my $standard_options = {};
30 sub register_standard_option
{
31 my ( $name, $schema ) = @_ ;
33 die "standard option ' $name ' already registered \n "
34 if $standard_options ->{ $name };
36 $standard_options ->{ $name } = $schema ;
39 sub get_standard_option
{
40 my ( $name, $base ) = @_ ;
42 my $std = $standard_options ->{ $name };
43 die "no such standard option ' $name ' \n " if ! $std ;
45 my $res = $base || {};
47 foreach my $opt ( keys %$std ) {
48 next if defined ( $res ->{ $opt });
49 $res ->{ $opt } = $std ->{ $opt };
55 register_standard_option
( 'pve-vmid' , {
56 description
=> "The (unique) ID of the VM." ,
57 type
=> 'integer' , format
=> 'pve-vmid' ,
61 register_standard_option
( 'pve-node' , {
62 description
=> "The cluster node name." ,
63 type
=> 'string' , format
=> 'pve-node' ,
66 register_standard_option
( 'pve-node-list' , {
67 description
=> "List of cluster node names." ,
68 type
=> 'string' , format
=> 'pve-node-list' ,
71 register_standard_option
( 'pve-iface' , {
72 description
=> "Network interface name." ,
73 type
=> 'string' , format
=> 'pve-iface' ,
74 minLength
=> 2 , maxLength
=> 20 ,
77 register_standard_option
( 'pve-storage-id' , {
78 description
=> "The storage identifier." ,
79 type
=> 'string' , format
=> 'pve-storage-id' ,
82 register_standard_option
( 'pve-config-digest' , {
83 description
=> 'Prevent changes if current configuration file has different SHA1 digest. This can be used to prevent concurrent modifications.' ,
86 maxLength
=> 40 , # sha1 hex digest lenght is 40
89 register_standard_option
( 'skiplock' , {
90 description
=> "Ignore locks - only root is allowed to use this option." ,
95 register_standard_option
( 'extra-args' , {
96 description
=> "Extra arguments as array" ,
98 items
=> { type
=> 'string' },
102 register_standard_option
( 'fingerprint-sha256' , {
103 description
=> "Certificate SHA 256 fingerprint." ,
105 pattern
=> '([A-Fa-f0-9]{2}:){31}[A-Fa-f0-9]{2}' ,
108 my $format_list = {};
110 sub register_format
{
111 my ( $format, $code ) = @_ ;
113 die "JSON schema format ' $format ' already registered \n "
114 if $format_list ->{ $format };
116 $format_list ->{ $format } = $code ;
121 return $format_list ->{ $format };
124 my $renderer_hash = {};
126 sub register_renderer
{
127 my ( $name, $code ) = @_ ;
129 die "renderer ' $name ' already registered \n "
130 if $renderer_hash ->{ $name };
132 $renderer_hash ->{ $name } = $code ;
137 return $renderer_hash ->{ $name };
140 # register some common type for pve
142 register_format
( 'string' , sub {}); # allow format => 'string-list'
144 register_format
( 'urlencoded' , \
& pve_verify_urlencoded
);
145 sub pve_verify_urlencoded
{
146 my ( $text, $noerr ) = @_ ;
147 if ( $text !~ /^[-%a-zA-Z0-9_.!~*'()]*$/ ) {
148 return undef if $noerr ;
149 die "invalid urlencoded string: $text\n " ;
154 register_format
( 'pve-configid' , \
& pve_verify_configid
);
155 sub pve_verify_configid
{
156 my ( $id, $noerr ) = @_ ;
158 if ( $id !~ m/^[a-z][a-z0-9_]+$/i ) {
159 return undef if $noerr ;
160 die "invalid configuration ID ' $id ' \n " ;
165 PVE
:: JSONSchema
:: register_format
( 'pve-storage-id' , \
& parse_storage_id
);
166 sub parse_storage_id
{
167 my ( $storeid, $noerr ) = @_ ;
169 if ( $storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i ) {
170 return undef if $noerr ;
171 die "storage ID ' $storeid ' contains illegal characters \n " ;
177 register_format
( 'pve-vmid' , \
& pve_verify_vmid
);
178 sub pve_verify_vmid
{
179 my ( $vmid, $noerr ) = @_ ;
181 if ( $vmid !~ m/^[1-9][0-9]{2,8}$/ ) {
182 return undef if $noerr ;
183 die "value does not look like a valid VM ID \n " ;
188 register_format
( 'pve-node' , \
& pve_verify_node_name
);
189 sub pve_verify_node_name
{
190 my ( $node, $noerr ) = @_ ;
192 if ( $node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/ ) {
193 return undef if $noerr ;
194 die "value does not look like a valid node name \n " ;
199 register_format
( 'ipv4' , \
& pve_verify_ipv4
);
200 sub pve_verify_ipv4
{
201 my ( $ipv4, $noerr ) = @_ ;
203 if ( $ipv4 !~ m/^(?:$IPV4RE)$/ ) {
204 return undef if $noerr ;
205 die "value does not look like a valid IPv4 address \n " ;
210 register_format
( 'ipv6' , \
& pve_verify_ipv6
);
211 sub pve_verify_ipv6
{
212 my ( $ipv6, $noerr ) = @_ ;
214 if ( $ipv6 !~ m/^(?:$IPV6RE)$/ ) {
215 return undef if $noerr ;
216 die "value does not look like a valid IPv6 address \n " ;
221 register_format
( 'ip' , \
& pve_verify_ip
);
223 my ( $ip, $noerr ) = @_ ;
225 if ( $ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/ ) {
226 return undef if $noerr ;
227 die "value does not look like a valid IP address \n " ;
232 my $ipv4_mask_hash = {
249 '255.255.128.0' => 17 ,
250 '255.255.192.0' => 18 ,
251 '255.255.224.0' => 19 ,
252 '255.255.240.0' => 20 ,
253 '255.255.248.0' => 21 ,
254 '255.255.252.0' => 22 ,
255 '255.255.254.0' => 23 ,
256 '255.255.255.0' => 24 ,
257 '255.255.255.128' => 25 ,
258 '255.255.255.192' => 26 ,
259 '255.255.255.224' => 27 ,
260 '255.255.255.240' => 28 ,
261 '255.255.255.248' => 29 ,
262 '255.255.255.252' => 30 ,
263 '255.255.255.254' => 31 ,
264 '255.255.255.255' => 32 ,
267 register_format
( 'ipv4mask' , \
& pve_verify_ipv4mask
);
268 sub pve_verify_ipv4mask
{
269 my ( $mask, $noerr ) = @_ ;
271 if (! defined ( $ipv4_mask_hash ->{ $mask })) {
272 return undef if $noerr ;
273 die "value does not look like a valid IP netmask \n " ;
278 register_format
( 'CIDRv6' , \
& pve_verify_cidrv6
);
279 sub pve_verify_cidrv6
{
280 my ( $cidr, $noerr ) = @_ ;
282 if ( $cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 128 )) {
286 return undef if $noerr ;
287 die "value does not look like a valid IPv6 CIDR network \n " ;
290 register_format
( 'CIDRv4' , \
& pve_verify_cidrv4
);
291 sub pve_verify_cidrv4
{
292 my ( $cidr, $noerr ) = @_ ;
294 if ( $cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 32 )) {
298 return undef if $noerr ;
299 die "value does not look like a valid IPv4 CIDR network \n " ;
302 register_format
( 'CIDR' , \
& pve_verify_cidr
);
303 sub pve_verify_cidr
{
304 my ( $cidr, $noerr ) = @_ ;
306 if (!( pve_verify_cidrv4
( $cidr, 1 ) ||
307 pve_verify_cidrv6
( $cidr, 1 )))
309 return undef if $noerr ;
310 die "value does not look like a valid CIDR network \n " ;
316 register_format
( 'pve-ipv4-config' , \
& pve_verify_ipv4_config
);
317 sub pve_verify_ipv4_config
{
318 my ( $config, $noerr ) = @_ ;
320 return $config if $config =~ /^(?:dhcp|manual)$/ ||
321 pve_verify_cidrv4
( $config, 1 );
322 return undef if $noerr ;
323 die "value does not look like a valid ipv4 network configuration \n " ;
326 register_format
( 'pve-ipv6-config' , \
& pve_verify_ipv6_config
);
327 sub pve_verify_ipv6_config
{
328 my ( $config, $noerr ) = @_ ;
330 return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
331 pve_verify_cidrv6
( $config, 1 );
332 return undef if $noerr ;
333 die "value does not look like a valid ipv6 network configuration \n " ;
336 register_format
( 'email' , \
& pve_verify_email
);
337 sub pve_verify_email
{
338 my ( $email, $noerr ) = @_ ;
340 # we use same regex as in Utils.js
341 if ( $email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/ ) {
342 return undef if $noerr ;
343 die "value does not look like a valid email address \n " ;
348 register_format
( 'dns-name' , \
& pve_verify_dns_name
);
349 sub pve_verify_dns_name
{
350 my ( $name, $noerr ) = @_ ;
352 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)" ;
354 if ( $name !~ /^(${namere}\.)*${namere}$/ ) {
355 return undef if $noerr ;
356 die "value does not look like a valid DNS name \n " ;
361 # network interface name
362 register_format
( 'pve-iface' , \
& pve_verify_iface
);
363 sub pve_verify_iface
{
364 my ( $id, $noerr ) = @_ ;
366 if ( $id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i ) {
367 return undef if $noerr ;
368 die "invalid network interface name ' $id ' \n " ;
373 # general addresses by name or IP
374 register_format
( 'address' , \
& pve_verify_address
);
375 sub pve_verify_address
{
376 my ( $addr, $noerr ) = @_ ;
378 if (!( pve_verify_ip
( $addr, 1 ) ||
379 pve_verify_dns_name
( $addr, 1 )))
381 return undef if $noerr ;
382 die "value does not look like a valid address: $addr\n " ;
387 register_format
( 'disk-size' , \
& pve_verify_disk_size
);
388 sub pve_verify_disk_size
{
389 my ( $size, $noerr ) = @_ ;
390 if (! defined ( parse_size
( $size ))) {
391 return undef if $noerr ;
392 die "value does not look like a valid disk size: $size\n " ;
397 register_standard_option
( 'spice-proxy' , {
398 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)." ,
399 type
=> 'string' , format
=> 'address' ,
402 register_standard_option
( 'remote-viewer-config' , {
403 description
=> "Returned values can be directly passed to the 'remote-viewer' application." ,
404 additionalProperties
=> 1 ,
406 type
=> { type
=> 'string' },
407 password
=> { type
=> 'string' },
408 proxy
=> { type
=> 'string' },
409 host
=> { type
=> 'string' },
410 'tls-port' => { type
=> 'integer' },
414 register_format
( 'pve-startup-order' , \
& pve_verify_startup_order
);
415 sub pve_verify_startup_order
{
416 my ( $value, $noerr ) = @_ ;
418 return $value if pve_parse_startup_order
( $value );
420 return undef if $noerr ;
422 die "unable to parse startup options \n " ;
427 type
=> 'number' , minimum
=> '0' ,
428 format_description
=> 'LIMIT' ,
431 my $bwlimit_format = {
434 description
=> 'default bandwidth limit in MiB/s' ,
438 description
=> 'bandwidth limit in MiB/s for restoring guests from backups' ,
442 description
=> 'bandwidth limit in MiB/s for migrating guests' ,
446 description
=> 'bandwidth limit in MiB/s for cloning disks' ,
450 description
=> 'bandwidth limit in MiB/s for moving disks' ,
453 register_format
( 'bwlimit' , $bwlimit_format );
454 register_standard_option
( 'bwlimit' , {
455 description
=> "Set bandwidth/io limits various operations." ,
458 format
=> $bwlimit_format,
461 sub pve_parse_startup_order
{
464 return undef if ! $value ;
468 foreach my $p ( split ( /,/ , $value )) {
469 next if $p =~ m/^\s*$/ ;
471 if ( $p =~ m/^(order=)?(\d+)$/ ) {
473 } elsif ( $p =~ m/^up=(\d+)$/ ) {
475 } elsif ( $p =~ m/^down=(\d+)$/ ) {
485 PVE
:: JSONSchema
:: register_standard_option
( 'pve-startup-order' , {
486 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." ,
488 type
=> 'string' , format
=> 'pve-startup-order' ,
489 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ' ,
493 my ( $format, $value, $path ) = @_ ;
495 return parse_property_string
( $format, $value, $path ) if ref ( $format ) eq 'HASH' ;
496 return if $format eq 'regex' ;
498 if ( $format =~ m/^(.*)-a?list$/ ) {
500 my $code = $format_list ->{ $1 };
502 die "undefined format ' $format ' \n " if ! $code ;
504 # Note: we allow empty lists
505 foreach my $v ( split_list
( $value )) {
509 } elsif ( $format =~ m/^(.*)-opt$/ ) {
511 my $code = $format_list ->{ $1 };
513 die "undefined format ' $format ' \n " if ! $code ;
515 return if ! $value ; # allow empty string
521 my $code = $format_list ->{ $format };
523 die "undefined format ' $format ' \n " if ! $code ;
525 return parse_property_string
( $code, $value, $path ) if ref ( $code ) eq 'HASH' ;
533 return undef if $value !~ m/^(\d+(\.\d+)?)([KMGT])?$/ ;
534 my ( $size, $unit ) = ( $1, $3 );
537 $size = $size * 1024 ;
538 } elsif ( $unit eq 'M' ) {
539 $size = $size * 1024 * 1024 ;
540 } elsif ( $unit eq 'G' ) {
541 $size = $size * 1024 * 1024 * 1024 ;
542 } elsif ( $unit eq 'T' ) {
543 $size = $size * 1024 * 1024 * 1024 * 1024 ;
554 my $kb = int ( $size/1024 );
555 return $size if $kb*1024 != $size ;
557 my $mb = int ( $kb/1024 );
558 return "${kb}K" if $mb*1024 != $kb ;
560 my $gb = int ( $mb/1024 );
561 return "${mb}M" if $gb*1024 != $mb ;
563 my $tb = int ( $gb/1024 );
564 return "${gb}G" if $tb*1024 != $gb ;
571 return 1 if $bool =~ m/^(1|on|yes|true)$/i ;
572 return 0 if $bool =~ m/^(0|off|no|false)$/i ;
576 sub parse_property_string
{
577 my ( $format, $data, $path, $additional_properties ) = @_ ;
579 # In property strings we default to not allowing additional properties
580 $additional_properties = 0 if ! defined ( $additional_properties );
582 # Support named formats here, too:
584 if ( my $desc = $format_list ->{ $format }) {
587 die "unknown format: $format\n " ;
589 } elsif ( ref ( $format ) ne 'HASH' ) {
590 die "unexpected format value of type " . ref ( $format ). " \n " ;
596 foreach my $part ( split ( /,/ , $data )) {
597 next if $part =~ /^\s*$/ ;
599 if ( $part =~ /^([^=]+)=(.+)$/ ) {
600 my ( $k, $v ) = ( $1, $2 );
601 die "duplicate key in comma-separated list property: $k\n " if defined ( $res ->{ $k });
602 my $schema = $format ->{ $k };
603 if ( my $alias = $schema ->{ alias
}) {
604 if ( my $key_alias = $schema ->{ keyAlias
}) {
605 die "key alias ' $key_alias ' is already defined \n " if defined ( $res ->{ $key_alias });
606 $res ->{ $key_alias } = $k ;
609 $schema = $format ->{ $k };
612 die "invalid key in comma-separated list property: $k\n " if ! $schema ;
613 if ( $schema ->{ type
} && $schema ->{ type
} eq 'boolean' ) {
614 $v = parse_boolean
( $v ) // $v ;
617 } elsif ( $part !~ /=/ ) {
618 die "duplicate key in comma-separated list property: $default_key\n " if $default_key ;
619 foreach my $key ( keys %$format ) {
620 if ( $format ->{ $key }->{ default_key
}) {
622 if (! $res ->{ $default_key }) {
623 $res ->{ $default_key } = $part ;
626 die "duplicate key in comma-separated list property: $default_key\n " ;
629 die "value without key, but schema does not define a default key \n " if ! $default_key ;
631 die "missing key in comma-separated list property \n " ;
636 check_object
( $path, $format, $res, $additional_properties, $errors );
637 if ( scalar ( %$errors )) {
638 raise
"format error \n " , errors
=> $errors ;
645 my ( $errors, $path, $msg ) = @_ ;
647 $path = '_root' if ! $path ;
649 if ( $errors ->{ $path }) {
650 $errors ->{ $path } = join ( ' \n ' , $errors ->{ $path }, $msg );
652 $errors ->{ $path } = $msg ;
659 # see 'man perlretut'
660 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/ ;
666 return $value =~ m/^[+-]?\d+$/ ;
670 my ( $path, $type, $value, $errors ) = @_ ;
674 if (! defined ( $value )) {
675 return 1 if $type eq 'null' ;
679 if ( my $tt = ref ( $type )) {
680 if ( $tt eq 'ARRAY' ) {
681 foreach my $t ( @$type ) {
683 check_type
( $path, $t, $value, $tmperr );
684 return 1 if ! scalar ( %$tmperr );
686 my $ttext = join ( '|' , @$type );
687 add_error
( $errors, $path, "type check (' $ttext ') failed" );
689 } elsif ( $tt eq 'HASH' ) {
691 check_prop
( $value, $type, $path, $tmperr );
692 return 1 if ! scalar ( %$tmperr );
693 add_error
( $errors, $path, "type check failed" );
696 die "internal error - got reference type ' $tt '" ;
701 return 1 if $type eq 'any' ;
703 if ( $type eq 'null' ) {
704 if ( defined ( $value )) {
705 add_error
( $errors, $path, "type check (' $type ') failed - value is not null" );
711 my $vt = ref ( $value );
713 if ( $type eq 'array' ) {
714 if (! $vt || $vt ne 'ARRAY' ) {
715 add_error
( $errors, $path, "type check (' $type ') failed" );
719 } elsif ( $type eq 'object' ) {
720 if (! $vt || $vt ne 'HASH' ) {
721 add_error
( $errors, $path, "type check (' $type ') failed" );
725 } elsif ( $type eq 'coderef' ) {
726 if (! $vt || $vt ne 'CODE' ) {
727 add_error
( $errors, $path, "type check (' $type ') failed" );
731 } elsif ( $type eq 'string' && $vt eq 'Regexp' ) {
732 # qr// regexes can be used as strings and make sense for format=regex
736 add_error
( $errors, $path, "type check (' $type ') failed - got $vt " );
739 if ( $type eq 'string' ) {
740 return 1 ; # nothing to check ?
741 } elsif ( $type eq 'boolean' ) {
742 #if ($value =~ m/^(1|true|yes|on)$/i) {
745 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
746 } elsif ( $value eq '0' ) {
747 return 1 ; # return success (not value)
749 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
752 } elsif ( $type eq 'integer' ) {
753 if (! is_integer
( $value )) {
754 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
758 } elsif ( $type eq 'number' ) {
759 if (! is_number
( $value )) {
760 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
765 return 1 ; # no need to verify unknown types
775 my ( $path, $schema, $value, $additional_properties, $errors ) = @_ ;
777 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
779 my $st = ref ( $schema );
780 if (! $st || $st ne 'HASH' ) {
781 add_error
( $errors, $path, "Invalid schema definition." );
785 my $vt = ref ( $value );
786 if (! $vt || $vt ne 'HASH' ) {
787 add_error
( $errors, $path, "an object is required" );
791 foreach my $k ( keys %$schema ) {
792 check_prop
( $value ->{ $k }, $schema ->{ $k }, $path ?
" $path . $k " : $k, $errors );
795 foreach my $k ( keys %$value ) {
797 my $newpath = $path ?
" $path . $k " : $k ;
799 if ( my $subschema = $schema ->{ $k }) {
800 if ( my $requires = $subschema ->{ requires
}) {
801 if ( ref ( $requires )) {
802 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
803 check_prop
( $value, $requires, $path, $errors );
804 } elsif (! defined ( $value ->{ $requires })) {
805 add_error
( $errors, $path ?
" $path . $requires " : $requires,
806 "missing property - ' $newpath ' requires this property" );
810 next ; # value is already checked above
813 if ( defined ( $additional_properties ) && ! $additional_properties ) {
814 add_error
( $errors, $newpath, "property is not defined in schema " .
815 "and the schema does not allow additional properties" );
818 check_prop
( $value ->{ $k }, $additional_properties, $newpath, $errors )
819 if ref ( $additional_properties );
823 sub check_object_warn
{
824 my ( $path, $schema, $value, $additional_properties ) = @_ ;
826 check_object
( $path, $schema, $value, $additional_properties, $errors );
827 if ( scalar ( %$errors )) {
828 foreach my $k ( keys %$errors ) {
829 warn "parse error: $k : $errors ->{ $k } \n " ;
837 my ( $value, $schema, $path, $errors ) = @_ ;
839 die "internal error - no schema" if ! $schema ;
840 die "internal error" if ! $errors ;
842 #print "check_prop $path\n" if $value;
844 my $st = ref ( $schema );
845 if (! $st || $st ne 'HASH' ) {
846 add_error
( $errors, $path, "Invalid schema definition." );
850 # if it extends another schema, it must pass that schema as well
851 if ( $schema ->{ extends
}) {
852 check_prop
( $value, $schema ->{ extends
}, $path, $errors );
855 if (! defined ( $value )) {
856 return if $schema ->{ type
} && $schema ->{ type
} eq 'null' ;
857 if (! $schema ->{ optional
} && ! $schema ->{ alias
} && ! $schema ->{ group
}) {
858 add_error
( $errors, $path, "property is missing and it is not optional" );
863 return if ! check_type
( $path, $schema ->{ type
}, $value, $errors );
865 if ( $schema ->{ disallow
}) {
867 if ( check_type
( $path, $schema ->{ disallow
}, $value, $tmperr )) {
868 add_error
( $errors, $path, "disallowed value was matched" );
873 if ( my $vt = ref ( $value )) {
875 if ( $vt eq 'ARRAY' ) {
876 if ( $schema ->{ items
}) {
877 my $it = ref ( $schema ->{ items
});
878 if ( $it && $it eq 'ARRAY' ) {
879 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
880 die "not implemented" ;
883 foreach my $el ( @$value ) {
884 check_prop
( $el, $schema ->{ items
}, "${path}[ $ind ]" , $errors );
890 } elsif ( $schema ->{ properties
} || $schema ->{ additionalProperties
}) {
891 check_object
( $path, defined ( $schema ->{ properties
}) ?
$schema ->{ properties
} : {},
892 $value, $schema ->{ additionalProperties
}, $errors );
898 if ( my $format = $schema ->{ format
}) {
899 eval { check_format
( $format, $value, $path ); };
901 add_error
( $errors, $path, "invalid format - $@ " );
906 if ( my $pattern = $schema ->{ pattern
}) {
907 if ( $value !~ m/^$pattern$/ ) {
908 add_error
( $errors, $path, "value does not match the regex pattern" );
913 if ( defined ( my $max = $schema ->{ maxLength
})) {
914 if ( length ( $value ) > $max ) {
915 add_error
( $errors, $path, "value may only be $max characters long" );
920 if ( defined ( my $min = $schema ->{ minLength
})) {
921 if ( length ( $value ) < $min ) {
922 add_error
( $errors, $path, "value must be at least $min characters long" );
927 if ( is_number
( $value )) {
928 if ( defined ( my $max = $schema ->{ maximum
})) {
930 add_error
( $errors, $path, "value must have a maximum value of $max " );
935 if ( defined ( my $min = $schema ->{ minimum
})) {
937 add_error
( $errors, $path, "value must have a minimum value of $min " );
943 if ( my $ea = $schema ->{ enum
}) {
946 foreach my $ev ( @$ea ) {
953 add_error
( $errors, $path, "value ' $value ' does not have a value in the enumeration '" .
954 join ( ", " , @$ea ) . "'" );
961 my ( $instance, $schema, $errmsg ) = @_ ;
964 $errmsg = "Parameter verification failed. \n " if ! $errmsg ;
966 # todo: cycle detection is only needed for debugging, I guess
967 # we can disable that in the final release
968 # todo: is there a better/faster way to detect cycles?
970 find_cycle
( $instance, sub { $cycles = 1 });
972 add_error
( $errors, undef , "data structure contains recursive cycles" );
974 check_prop
( $instance, $schema, '' , $errors );
977 if ( scalar ( %$errors )) {
978 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors ;
984 my $schema_valid_types = [ "string" , "object" , "coderef" , "array" , "boolean" , "number" , "integer" , "null" , "any" ];
985 my $default_schema_noref = {
986 description
=> "This is the JSON Schema for JSON Schemas." ,
987 type
=> [ "object" ],
988 additionalProperties
=> 0 ,
991 type
=> [ "string" , "array" ],
992 description
=> "This is a type definition value. This can be a simple type, or a union type" ,
997 enum
=> $schema_valid_types,
999 enum
=> $schema_valid_types,
1003 description
=> "This indicates that the instance property in the instance object is not required." ,
1009 description
=> "This is a definition for the properties of an object value" ,
1015 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array" ,
1019 additionalProperties
=> {
1020 type
=> [ "boolean" , "object" ],
1021 description
=> "This provides a default property definition for all properties that are not explicitly defined in an object type definition." ,
1028 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number." ,
1033 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number." ,
1037 description
=> "When the instance value is a string, this indicates minimum length of the string" ,
1044 description
=> "When the instance value is a string, this indicates maximum length of the string." ,
1050 description
=> "A text representation of the type (used to generate documentation)." ,
1055 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." ,
1062 description
=> "This provides an enumeration of possible values that are valid for the instance property." ,
1067 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)." ,
1069 verbose_description
=> {
1072 description
=> "This provides a more verbose description." ,
1074 format_description
=> {
1077 description
=> "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings." ,
1082 description
=> "This provides the title of the property" ,
1085 type
=> [ "string" , "object" ],
1087 description
=> "indicates a required property or a schema that must be validated if this property is present" ,
1090 type
=> [ "string" , "object" ],
1092 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" ,
1097 description
=> "Whether this is the default key in a comma separated list property string." ,
1102 description
=> "When a key represents the same property as another it can be an alias to it, causing the parsed datastructure to use the other key to store the current value under." ,
1107 description
=> "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'." ,
1108 requires
=> 'alias' ,
1113 description
=> "This indicates the default for the instance property."
1117 description
=> "Bash completion function. This function should return a list of possible values." ,
1123 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, then this instance is not valid." ,
1128 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also." ,
1131 # this is from hyper schema
1134 description
=> "This defines the link relations of the instance objects" ,
1141 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" ,
1145 description
=> "This is the name of the link relation" ,
1151 description
=> "For submission links, this defines the method that should be used to access the target resource" ,
1160 description
=> "For CLI context, this defines the maximal width to print before truncating" ,
1166 my $default_schema = Storable
:: dclone
( $default_schema_noref );
1168 $default_schema ->{ properties
}->{ properties
}->{ additionalProperties
} = $default_schema ;
1169 $default_schema ->{ properties
}->{ additionalProperties
}->{ properties
} = $default_schema ->{ properties
};
1171 $default_schema ->{ properties
}->{ items
}->{ properties
} = $default_schema ->{ properties
};
1172 $default_schema ->{ properties
}->{ items
}->{ additionalProperties
} = 0 ;
1174 $default_schema ->{ properties
}->{ disallow
}->{ properties
} = $default_schema ->{ properties
};
1175 $default_schema ->{ properties
}->{ disallow
}->{ additionalProperties
} = 0 ;
1177 $default_schema ->{ properties
}->{ requires
}->{ properties
} = $default_schema ->{ properties
};
1178 $default_schema ->{ properties
}->{ requires
}->{ additionalProperties
} = 0 ;
1180 $default_schema ->{ properties
}->{ extends
}->{ properties
} = $default_schema ->{ properties
};
1181 $default_schema ->{ properties
}->{ extends
}->{ additionalProperties
} = 0 ;
1183 my $method_schema = {
1185 additionalProperties
=> 0 ,
1188 description
=> "This a description of the method" ,
1193 description
=> "This indicates the name of the function to call." ,
1196 additionalProperties
=> 1 ,
1211 description
=> "The HTTP method name." ,
1212 enum
=> [ 'GET' , 'POST' , 'PUT' , 'DELETE' ],
1217 description
=> "Method needs special privileges - only pvedaemon can execute it" ,
1222 description
=> "Method downloads the file content (filename is the return value of the method)." ,
1227 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter." ,
1230 proxyto_callback
=> {
1232 description
=> "A function which is called to resolve the proxyto attribute. The default implementaion returns the value of the 'proxyto' parameter." ,
1237 description
=> "Required access permissions. By default only 'root' is allowed to access this method." ,
1239 additionalProperties
=> 0 ,
1242 description
=> "Describe access permissions." ,
1246 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials." ,
1248 enum
=> [ 'all' , 'world' ],
1252 description
=> "Array of permission checks (prefix notation)." ,
1259 description
=> "Used internally" ,
1263 description
=> "Used internally" ,
1268 description
=> "path for URL matching (uri template)" ,
1270 fragmentDelimiter
=> {
1272 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." ,
1277 description
=> "JSON Schema for parameters." ,
1282 description
=> "JSON Schema for return value." ,
1287 description
=> "method implementaion (code reference)" ,
1292 description
=> "Delegate call to this class (perl class string)." ,
1295 additionalProperties
=> 0 ,
1301 fragmentDelimiter
=> { optional
=> 1 }
1309 sub validate_schema
{
1312 my $errmsg = "internal error - unable to verify schema \n " ;
1313 validate
( $schema, $default_schema, $errmsg );
1316 sub validate_method_info
{
1319 my $errmsg = "internal error - unable to verify method info \n " ;
1320 validate
( $info, $method_schema, $errmsg );
1322 validate_schema
( $info ->{ parameters
}) if $info ->{ parameters
};
1323 validate_schema
( $info ->{ returns
}) if $info ->{ returns
};
1326 # run a self test on load
1327 # make sure we can verify the default schema
1328 validate_schema
( $default_schema_noref );
1329 validate_schema
( $method_schema );
1331 # and now some utility methods (used by pve api)
1332 sub method_get_child_link
{
1335 return undef if ! $info ;
1337 my $schema = $info ->{ returns
};
1338 return undef if ! $schema || ! $schema ->{ type
} || $schema ->{ type
} ne 'array' ;
1340 my $links = $schema ->{ links
};
1341 return undef if ! $links ;
1344 foreach my $lnk ( @$links ) {
1345 if ( $lnk ->{ href
} && $lnk ->{ rel
} && ( $lnk ->{ rel
} eq 'child' )) {
1354 # a way to parse command line parameters, using a
1355 # schema to configure Getopt::Long
1357 my ( $schema, $args, $arg_param, $fixed_param, $param_mapping_hash ) = @_ ;
1359 if (! $schema || ! $schema ->{ properties
}) {
1360 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1361 if scalar ( @$args ) != 0 ;
1366 if ( $arg_param && ! ref ( $arg_param )) {
1367 my $pd = $schema ->{ properties
}->{ $arg_param };
1368 die "expected list format $pd ->{format}"
1369 if !( $pd && $pd ->{ format
} && $pd ->{ format
} =~ m/-list/ );
1370 $list_param = $arg_param ;
1373 my @interactive = ();
1375 foreach my $prop ( keys %{ $schema ->{ properties
}}) {
1376 my $pd = $schema ->{ properties
}->{ $prop };
1377 next if $list_param && $prop eq $list_param ;
1378 next if defined ( $fixed_param ->{ $prop });
1380 my $mapping = $param_mapping_hash ->{ $prop };
1381 if ( $mapping && $mapping ->{ interactive
}) {
1382 # interactive parameters such as passwords: make the argument
1383 # optional and call the mapping function afterwards.
1384 push @getopt, " $prop :s" ;
1385 push @interactive, [ $prop, $mapping ->{ func
}];
1386 } elsif ( $pd ->{ type
} eq 'boolean' ) {
1387 push @getopt, " $prop :s" ;
1389 if ( $pd ->{ format
} && $pd ->{ format
} =~ m/-a?list/ ) {
1390 push @getopt, " $prop =s@" ;
1392 push @getopt, " $prop =s" ;
1397 Getopt
:: Long
:: Configure
( 'prefix_pattern=(--|-)' );
1400 raise
( "unable to parse option \n " , code
=> HTTP_BAD_REQUEST
)
1401 if ! Getopt
:: Long
:: GetOptionsFromArray
( $args, $opts, @getopt );
1405 $opts ->{ $list_param } = $args ;
1407 } elsif ( ref ( $arg_param )) {
1408 foreach my $arg_name ( @$arg_param ) {
1409 if ( $opts ->{ 'extra-args' }) {
1410 raise
( "internal error: extra-args must be the last argument \n " , code
=> HTTP_BAD_REQUEST
);
1412 if ( $arg_name eq 'extra-args' ) {
1413 $opts ->{ 'extra-args' } = $args ;
1417 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
) if ! @$args ;
1418 $opts ->{ $arg_name } = shift @$args ;
1420 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
) if @$args ;
1422 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1423 if scalar ( @$args ) != 0 ;
1426 if ( ref ( $arg_param )) {
1427 foreach my $arg_name ( @$arg_param ) {
1428 if ( $arg_name eq 'extra-args' ) {
1429 $opts ->{ 'extra-args' } = [];
1431 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
);
1437 foreach my $entry ( @interactive ) {
1438 my ( $opt, $func ) = @$entry ;
1439 my $pd = $schema ->{ properties
}->{ $opt };
1440 my $value = $opts ->{ $opt };
1441 if ( defined ( $value ) || ! $pd ->{ optional
}) {
1442 $opts ->{ $opt } = $func ->( $value );
1446 # decode after Getopt as we are not sure how well it handles unicode
1447 foreach my $p ( keys %$opts ) {
1448 if (! ref ( $opts ->{ $p })) {
1449 $opts ->{ $p } = decode
( 'locale' , $opts ->{ $p });
1450 } elsif ( ref ( $opts ->{ $p }) eq 'ARRAY' ) {
1452 foreach my $v (@{ $opts ->{ $p }}) {
1453 push @$tmp, decode
( 'locale' , $v );
1456 } elsif ( ref ( $opts ->{ $p }) eq 'SCALAR' ) {
1457 $opts ->{ $p } = decode
( 'locale' , $$opts ->{ $p });
1459 raise
( "decoding options failed, unknown reference \n " , code
=> HTTP_BAD_REQUEST
);
1463 foreach my $p ( keys %$opts ) {
1464 if ( my $pd = $schema ->{ properties
}->{ $p }) {
1465 if ( $pd ->{ type
} eq 'boolean' ) {
1466 if ( $opts ->{ $p } eq '' ) {
1468 } elsif ( defined ( my $bool = parse_boolean
( $opts ->{ $p }))) {
1469 $opts ->{ $p } = $bool ;
1471 raise
( "unable to parse boolean option \n " , code
=> HTTP_BAD_REQUEST
);
1473 } elsif ( $pd ->{ format
}) {
1475 if ( $pd ->{ format
} =~ m/-list/ ) {
1476 # allow --vmid 100 --vmid 101 and --vmid 100,101
1477 # allow --dow mon --dow fri and --dow mon,fri
1478 $opts ->{ $p } = join ( "," , @{ $opts ->{ $p }}) if ref ( $opts ->{ $p }) eq 'ARRAY' ;
1479 } elsif ( $pd ->{ format
} =~ m/-alist/ ) {
1480 # we encode array as \0 separated strings
1481 # Note: CGI.pm also use this encoding
1482 if ( scalar (@{ $opts ->{ $p }}) != 1 ) {
1483 $opts ->{ $p } = join ( "\0" , @{ $opts ->{ $p }});
1485 # st that split_list knows it is \0 terminated
1486 my $v = $opts ->{ $p }->[ 0 ];
1487 $opts ->{ $p } = " $v\0 " ;
1494 foreach my $p ( keys %$fixed_param ) {
1495 $opts ->{ $p } = $fixed_param ->{ $p };
1501 # A way to parse configuration data by giving a json schema
1503 my ( $schema, $filename, $raw ) = @_ ;
1505 # do fast check (avoid validate_schema($schema))
1506 die "got strange schema" if ! $schema ->{ type
} ||
1507 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1511 while ( $raw =~ /^\s*(.+?)\s*$/gm ) {
1514 next if $line =~ /^#/ ;
1516 if ( $line =~ m/^(\S+?):\s*(.*)$/ ) {
1519 if ( $schema ->{ properties
}->{ $key } &&
1520 $schema ->{ properties
}->{ $key }->{ type
} eq 'boolean' ) {
1522 $value = parse_boolean
( $value ) // $value ;
1524 $cfg ->{ $key } = $value ;
1526 warn "ignore config line: $line\n "
1531 check_prop
( $cfg, $schema, '' , $errors );
1533 foreach my $k ( keys %$errors ) {
1534 warn "parse error in ' $filename ' - ' $k ': $errors ->{ $k } \n " ;
1541 # generate simple key/value file
1543 my ( $schema, $filename, $cfg ) = @_ ;
1545 # do fast check (avoid validate_schema($schema))
1546 die "got strange schema" if ! $schema ->{ type
} ||
1547 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1549 validate
( $cfg, $schema, "validation error in ' $filename ' \n " );
1553 foreach my $k ( keys %$cfg ) {
1554 $data .= " $k : $cfg ->{ $k } \n " ;
1560 # helpers used to generate our manual pages
1562 my $find_schema_default_key = sub {
1566 my $keyAliasProps = {};
1568 foreach my $key ( keys %$format ) {
1569 my $phash = $format ->{ $key };
1570 if ( $phash ->{ default_key
}) {
1571 die "multiple default keys in schema ( $default_key, $key ) \n "
1572 if defined ( $default_key );
1573 die "default key ' $key ' is an alias - this is not allowed \n "
1574 if defined ( $phash ->{ alias
});
1575 die "default key ' $key ' with keyAlias attribute is not allowed \n "
1576 if $phash ->{ keyAlias
};
1577 $default_key = $key ;
1579 my $key_alias = $phash ->{ keyAlias
};
1580 die "found keyAlias without 'alias definition for ' $key ' \n "
1581 if $key_alias && ! $phash ->{ alias
};
1583 if ( $phash ->{ alias
} && $key_alias ) {
1584 die "inconsistent keyAlias ' $key_alias ' definition"
1585 if defined ( $keyAliasProps ->{ $key_alias }) &&
1586 $keyAliasProps ->{ $key_alias } ne $phash ->{ alias
};
1587 $keyAliasProps ->{ $key_alias } = $phash ->{ alias
};
1591 return wantarray ?
( $default_key, $keyAliasProps ) : $default_key ;
1594 sub generate_typetext
{
1595 my ( $format, $list_enums ) = @_ ;
1597 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1602 my $add_option_string = sub {
1603 my ( $text, $optional ) = @_ ;
1609 $text = "[ $text ]" if $optional ;
1614 my $format_key_value = sub {
1615 my ( $key, $phash ) = @_ ;
1617 die "internal error" if defined ( $phash ->{ alias
});
1623 if ( my $desc = $phash ->{ format_description
}) {
1624 $typetext .= "< $desc >" ;
1625 } elsif ( my $text = $phash ->{ typetext
}) {
1627 } elsif ( my $enum = $phash ->{ enum
}) {
1628 if ( $list_enums || ( scalar ( @$enum ) <= 3 )) {
1629 $typetext .= '<' . join ( '|' , @$enum ) . '>' ;
1631 $typetext .= '<enum>' ;
1633 } elsif ( $phash ->{ type
} eq 'boolean' ) {
1634 $typetext .= '<1|0>' ;
1635 } elsif ( $phash ->{ type
} eq 'integer' ) {
1636 $typetext .= '<integer>' ;
1637 } elsif ( $phash ->{ type
} eq 'number' ) {
1638 $typetext .= '<number>' ;
1640 die "internal error: neither format_description nor typetext found for option ' $key '" ;
1643 if ( defined ( $default_key ) && ( $default_key eq $key )) {
1644 & $add_option_string ( "[ $keytext =] $typetext " , $phash ->{ optional
});
1646 & $add_option_string ( " $keytext = $typetext " , $phash ->{ optional
});
1652 my $cond_add_key = sub {
1655 return if $done ->{ $key }; # avoid duplicates
1659 my $phash = $format ->{ $key };
1661 return if ! $phash ; # should not happen
1663 return if $phash ->{ alias
};
1665 & $format_key_value ( $key, $phash );
1669 & $cond_add_key ( $default_key ) if defined ( $default_key );
1671 # add required keys first
1672 foreach my $key ( sort keys %$format ) {
1673 my $phash = $format ->{ $key };
1674 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1678 foreach my $key ( sort keys %$format ) {
1679 & $cond_add_key ( $key );
1682 foreach my $keyAlias ( sort keys %$keyAliasProps ) {
1683 & $add_option_string ( "< $keyAlias >=< $keyAliasProps ->{ $keyAlias }>" , 1 );
1689 sub print_property_string
{
1690 my ( $data, $format, $skip, $path ) = @_ ;
1692 if ( ref ( $format ) ne 'HASH' ) {
1693 my $schema = get_format
( $format );
1694 die "not a valid format: $format\n " if ! $schema ;
1699 check_object
( $path, $format, $data, undef , $errors );
1700 if ( scalar ( %$errors )) {
1701 raise
"format error" , errors
=> $errors ;
1704 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1709 my $add_option_string = sub {
1712 $res .= ',' if $add_sep ;
1717 my $format_value = sub {
1718 my ( $key, $value, $format ) = @_ ;
1720 if ( defined ( $format ) && ( $format eq 'disk-size' )) {
1721 return format_size
( $value );
1723 die "illegal value with commas for $key\n " if $value =~ /,/ ;
1728 my $done = { map { $_ => 1 } @$skip };
1730 my $cond_add_key = sub {
1731 my ( $key, $isdefault ) = @_ ;
1733 return if $done ->{ $key }; # avoid duplicates
1737 my $value = $data ->{ $key };
1739 return if ! defined ( $value );
1741 my $phash = $format ->{ $key };
1743 # try to combine values if we have key aliases
1744 if ( my $combine = $keyAliasProps ->{ $key }) {
1745 if ( defined ( my $combine_value = $data ->{ $combine })) {
1746 my $combine_format = $format ->{ $combine }->{ format
};
1747 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1748 my $combine_str = & $format_value ( $combine, $combine_value, $combine_format );
1749 & $add_option_string ( "${value_str}=${combine_str}" );
1750 $done ->{ $combine } = 1 ;
1755 if ( $phash && $phash ->{ alias
}) {
1756 $phash = $format ->{ $phash ->{ alias
}};
1759 die "invalid key ' $key ' \n " if ! $phash ;
1760 die "internal error" if defined ( $phash ->{ alias
});
1762 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1764 & $add_option_string ( $value_str );
1766 & $add_option_string ( " $key =${value_str}" );
1770 # add default key first
1771 & $cond_add_key ( $default_key, 1 ) if defined ( $default_key );
1773 # add required keys first
1774 foreach my $key ( sort keys %$data ) {
1775 my $phash = $format ->{ $key };
1776 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1780 foreach my $key ( sort keys %$data ) {
1781 & $cond_add_key ( $key );
1787 sub schema_get_type_text
{
1788 my ( $phash, $style ) = @_ ;
1790 my $type = $phash ->{ type
} || 'string' ;
1792 if ( $phash ->{ typetext
}) {
1793 return $phash ->{ typetext
};
1794 } elsif ( $phash ->{ format_description
}) {
1795 return "< $phash ->{format_description}>" ;
1796 } elsif ( $phash ->{ enum
}) {
1797 return "<" . join ( ' | ' , sort @{ $phash ->{ enum
}}) . ">" ;
1798 } elsif ( $phash ->{ pattern
}) {
1799 return $phash ->{ pattern
};
1800 } elsif ( $type eq 'integer' || $type eq 'number' ) {
1801 # NOTE: always access values as number (avoid converion to string)
1802 if ( defined ( $phash ->{ minimum
}) && defined ( $phash ->{ maximum
})) {
1803 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - " .
1804 ( $phash ->{ maximum
} + 0 ) . ")" ;
1805 } elsif ( defined ( $phash ->{ minimum
})) {
1806 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - N)" ;
1807 } elsif ( defined ( $phash ->{ maximum
})) {
1808 return "< $type > (-N - " . ( $phash ->{ maximum
} + 0 ) . ")" ;
1810 } elsif ( $type eq 'string' ) {
1811 if ( my $format = $phash ->{ format
}) {
1812 $format = get_format
( $format ) if ref ( $format ) ne 'HASH' ;
1813 if ( ref ( $format ) eq 'HASH' ) {
1815 $list_enums = 1 if $style && $style eq 'config-sub' ;
1816 return generate_typetext
( $format, $list_enums );