]>
git.proxmox.com Git - pve-client.git/blob - PVE/APIClient/JSONSchema.pm
1 package PVE
:: APIClient
:: JSONSchema
;
5 use Storable
; # for dclone
9 use Devel
:: Cycle
- quiet
; # todo: remove?
10 use PVE
:: APIClient
:: Tools
qw(split_list $IPV6RE $IPV4RE ) ;
11 use PVE
:: APIClient
:: 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 register_standard_option
( 'pve-output-format' , {
110 description
=> 'Output format.' ,
111 enum
=> [ 'text' , 'json' , 'json-pretty' ],
116 my $format_list = {};
118 sub register_format
{
119 my ( $format, $code ) = @_ ;
121 die "JSON schema format ' $format ' already registered \n "
122 if $format_list ->{ $format };
124 $format_list ->{ $format } = $code ;
129 return $format_list ->{ $format };
132 my $renderer_hash = {};
134 sub register_renderer
{
135 my ( $name, $code ) = @_ ;
137 die "renderer ' $name ' already registered \n "
138 if $renderer_hash ->{ $name };
140 $renderer_hash ->{ $name } = $code ;
145 return $renderer_hash ->{ $name };
148 # register some common type for pve
150 register_format
( 'string' , sub {}); # allow format => 'string-list'
152 register_format
( 'urlencoded' , \
& pve_verify_urlencoded
);
153 sub pve_verify_urlencoded
{
154 my ( $text, $noerr ) = @_ ;
155 if ( $text !~ /^[-%a-zA-Z0-9_.!~*'()]*$/ ) {
156 return undef if $noerr ;
157 die "invalid urlencoded string: $text\n " ;
162 register_format
( 'pve-configid' , \
& pve_verify_configid
);
163 sub pve_verify_configid
{
164 my ( $id, $noerr ) = @_ ;
166 if ( $id !~ m/^[a-z][a-z0-9_]+$/i ) {
167 return undef if $noerr ;
168 die "invalid configuration ID ' $id ' \n " ;
173 PVE
:: APIClient
:: JSONSchema
:: register_format
( 'pve-storage-id' , \
& parse_storage_id
);
174 sub parse_storage_id
{
175 my ( $storeid, $noerr ) = @_ ;
177 if ( $storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i ) {
178 return undef if $noerr ;
179 die "storage ID ' $storeid ' contains illegal characters \n " ;
185 register_format
( 'pve-vmid' , \
& pve_verify_vmid
);
186 sub pve_verify_vmid
{
187 my ( $vmid, $noerr ) = @_ ;
189 if ( $vmid !~ m/^[1-9][0-9]{2,8}$/ ) {
190 return undef if $noerr ;
191 die "value does not look like a valid VM ID \n " ;
196 register_format
( 'pve-node' , \
& pve_verify_node_name
);
197 sub pve_verify_node_name
{
198 my ( $node, $noerr ) = @_ ;
200 if ( $node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/ ) {
201 return undef if $noerr ;
202 die "value does not look like a valid node name \n " ;
207 register_format
( 'ipv4' , \
& pve_verify_ipv4
);
208 sub pve_verify_ipv4
{
209 my ( $ipv4, $noerr ) = @_ ;
211 if ( $ipv4 !~ m/^(?:$IPV4RE)$/ ) {
212 return undef if $noerr ;
213 die "value does not look like a valid IPv4 address \n " ;
218 register_format
( 'ipv6' , \
& pve_verify_ipv6
);
219 sub pve_verify_ipv6
{
220 my ( $ipv6, $noerr ) = @_ ;
222 if ( $ipv6 !~ m/^(?:$IPV6RE)$/ ) {
223 return undef if $noerr ;
224 die "value does not look like a valid IPv6 address \n " ;
229 register_format
( 'ip' , \
& pve_verify_ip
);
231 my ( $ip, $noerr ) = @_ ;
233 if ( $ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/ ) {
234 return undef if $noerr ;
235 die "value does not look like a valid IP address \n " ;
240 my $ipv4_mask_hash = {
257 '255.255.128.0' => 17 ,
258 '255.255.192.0' => 18 ,
259 '255.255.224.0' => 19 ,
260 '255.255.240.0' => 20 ,
261 '255.255.248.0' => 21 ,
262 '255.255.252.0' => 22 ,
263 '255.255.254.0' => 23 ,
264 '255.255.255.0' => 24 ,
265 '255.255.255.128' => 25 ,
266 '255.255.255.192' => 26 ,
267 '255.255.255.224' => 27 ,
268 '255.255.255.240' => 28 ,
269 '255.255.255.248' => 29 ,
270 '255.255.255.252' => 30 ,
271 '255.255.255.254' => 31 ,
272 '255.255.255.255' => 32 ,
275 register_format
( 'ipv4mask' , \
& pve_verify_ipv4mask
);
276 sub pve_verify_ipv4mask
{
277 my ( $mask, $noerr ) = @_ ;
279 if (! defined ( $ipv4_mask_hash ->{ $mask })) {
280 return undef if $noerr ;
281 die "value does not look like a valid IP netmask \n " ;
286 register_format
( 'CIDRv6' , \
& pve_verify_cidrv6
);
287 sub pve_verify_cidrv6
{
288 my ( $cidr, $noerr ) = @_ ;
290 if ( $cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 128 )) {
294 return undef if $noerr ;
295 die "value does not look like a valid IPv6 CIDR network \n " ;
298 register_format
( 'CIDRv4' , \
& pve_verify_cidrv4
);
299 sub pve_verify_cidrv4
{
300 my ( $cidr, $noerr ) = @_ ;
302 if ( $cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 32 )) {
306 return undef if $noerr ;
307 die "value does not look like a valid IPv4 CIDR network \n " ;
310 register_format
( 'CIDR' , \
& pve_verify_cidr
);
311 sub pve_verify_cidr
{
312 my ( $cidr, $noerr ) = @_ ;
314 if (!( pve_verify_cidrv4
( $cidr, 1 ) ||
315 pve_verify_cidrv6
( $cidr, 1 )))
317 return undef if $noerr ;
318 die "value does not look like a valid CIDR network \n " ;
324 register_format
( 'pve-ipv4-config' , \
& pve_verify_ipv4_config
);
325 sub pve_verify_ipv4_config
{
326 my ( $config, $noerr ) = @_ ;
328 return $config if $config =~ /^(?:dhcp|manual)$/ ||
329 pve_verify_cidrv4
( $config, 1 );
330 return undef if $noerr ;
331 die "value does not look like a valid ipv4 network configuration \n " ;
334 register_format
( 'pve-ipv6-config' , \
& pve_verify_ipv6_config
);
335 sub pve_verify_ipv6_config
{
336 my ( $config, $noerr ) = @_ ;
338 return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
339 pve_verify_cidrv6
( $config, 1 );
340 return undef if $noerr ;
341 die "value does not look like a valid ipv6 network configuration \n " ;
344 register_format
( 'email' , \
& pve_verify_email
);
345 sub pve_verify_email
{
346 my ( $email, $noerr ) = @_ ;
348 # we use same regex as in Utils.js
349 if ( $email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/ ) {
350 return undef if $noerr ;
351 die "value does not look like a valid email address \n " ;
356 register_format
( 'dns-name' , \
& pve_verify_dns_name
);
357 sub pve_verify_dns_name
{
358 my ( $name, $noerr ) = @_ ;
360 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)" ;
362 if ( $name !~ /^(${namere}\.)*${namere}$/ ) {
363 return undef if $noerr ;
364 die "value does not look like a valid DNS name \n " ;
369 # network interface name
370 register_format
( 'pve-iface' , \
& pve_verify_iface
);
371 sub pve_verify_iface
{
372 my ( $id, $noerr ) = @_ ;
374 if ( $id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i ) {
375 return undef if $noerr ;
376 die "invalid network interface name ' $id ' \n " ;
381 # general addresses by name or IP
382 register_format
( 'address' , \
& pve_verify_address
);
383 sub pve_verify_address
{
384 my ( $addr, $noerr ) = @_ ;
386 if (!( pve_verify_ip
( $addr, 1 ) ||
387 pve_verify_dns_name
( $addr, 1 )))
389 return undef if $noerr ;
390 die "value does not look like a valid address: $addr\n " ;
395 register_format
( 'disk-size' , \
& pve_verify_disk_size
);
396 sub pve_verify_disk_size
{
397 my ( $size, $noerr ) = @_ ;
398 if (! defined ( parse_size
( $size ))) {
399 return undef if $noerr ;
400 die "value does not look like a valid disk size: $size\n " ;
405 register_standard_option
( 'spice-proxy' , {
406 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)." ,
407 type
=> 'string' , format
=> 'address' ,
410 register_standard_option
( 'remote-viewer-config' , {
411 description
=> "Returned values can be directly passed to the 'remote-viewer' application." ,
412 additionalProperties
=> 1 ,
414 type
=> { type
=> 'string' },
415 password
=> { type
=> 'string' },
416 proxy
=> { type
=> 'string' },
417 host
=> { type
=> 'string' },
418 'tls-port' => { type
=> 'integer' },
422 register_format
( 'pve-startup-order' , \
& pve_verify_startup_order
);
423 sub pve_verify_startup_order
{
424 my ( $value, $noerr ) = @_ ;
426 return $value if pve_parse_startup_order
( $value );
428 return undef if $noerr ;
430 die "unable to parse startup options \n " ;
435 type
=> 'number' , minimum
=> '0' ,
436 format_description
=> 'LIMIT' ,
439 my $bwlimit_format = {
442 description
=> 'default bandwidth limit in MiB/s' ,
446 description
=> 'bandwidth limit in MiB/s for restoring guests from backups' ,
450 description
=> 'bandwidth limit in MiB/s for migrating guests' ,
454 description
=> 'bandwidth limit in MiB/s for cloning disks' ,
458 description
=> 'bandwidth limit in MiB/s for moving disks' ,
461 register_format
( 'bwlimit' , $bwlimit_format );
462 register_standard_option
( 'bwlimit' , {
463 description
=> "Set bandwidth/io limits various operations." ,
466 format
=> $bwlimit_format,
469 sub pve_parse_startup_order
{
472 return undef if ! $value ;
476 foreach my $p ( split ( /,/ , $value )) {
477 next if $p =~ m/^\s*$/ ;
479 if ( $p =~ m/^(order=)?(\d+)$/ ) {
481 } elsif ( $p =~ m/^up=(\d+)$/ ) {
483 } elsif ( $p =~ m/^down=(\d+)$/ ) {
493 PVE
:: APIClient
:: JSONSchema
:: register_standard_option
( 'pve-startup-order' , {
494 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." ,
496 type
=> 'string' , format
=> 'pve-startup-order' ,
497 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ' ,
501 my ( $format, $value, $path ) = @_ ;
503 return parse_property_string
( $format, $value, $path ) if ref ( $format ) eq 'HASH' ;
504 return if $format eq 'regex' ;
506 if ( $format =~ m/^(.*)-a?list$/ ) {
508 my $code = $format_list ->{ $1 };
510 die "undefined format ' $format ' \n " if ! $code ;
512 # Note: we allow empty lists
513 foreach my $v ( split_list
( $value )) {
517 } elsif ( $format =~ m/^(.*)-opt$/ ) {
519 my $code = $format_list ->{ $1 };
521 die "undefined format ' $format ' \n " if ! $code ;
523 return if ! $value ; # allow empty string
529 my $code = $format_list ->{ $format };
531 die "undefined format ' $format ' \n " if ! $code ;
533 return parse_property_string
( $code, $value, $path ) if ref ( $code ) eq 'HASH' ;
541 return undef if $value !~ m/^(\d+(\.\d+)?)([KMGT])?$/ ;
542 my ( $size, $unit ) = ( $1, $3 );
545 $size = $size * 1024 ;
546 } elsif ( $unit eq 'M' ) {
547 $size = $size * 1024 * 1024 ;
548 } elsif ( $unit eq 'G' ) {
549 $size = $size * 1024 * 1024 * 1024 ;
550 } elsif ( $unit eq 'T' ) {
551 $size = $size * 1024 * 1024 * 1024 * 1024 ;
562 my $kb = int ( $size/1024 );
563 return $size if $kb*1024 != $size ;
565 my $mb = int ( $kb/1024 );
566 return "${kb}K" if $mb*1024 != $kb ;
568 my $gb = int ( $mb/1024 );
569 return "${mb}M" if $gb*1024 != $mb ;
571 my $tb = int ( $gb/1024 );
572 return "${gb}G" if $tb*1024 != $gb ;
579 return 1 if $bool =~ m/^(1|on|yes|true)$/i ;
580 return 0 if $bool =~ m/^(0|off|no|false)$/i ;
584 sub parse_property_string
{
585 my ( $format, $data, $path, $additional_properties ) = @_ ;
587 # In property strings we default to not allowing additional properties
588 $additional_properties = 0 if ! defined ( $additional_properties );
590 # Support named formats here, too:
592 if ( my $desc = $format_list ->{ $format }) {
595 die "unknown format: $format\n " ;
597 } elsif ( ref ( $format ) ne 'HASH' ) {
598 die "unexpected format value of type " . ref ( $format ). " \n " ;
604 foreach my $part ( split ( /,/ , $data )) {
605 next if $part =~ /^\s*$/ ;
607 if ( $part =~ /^([^=]+)=(.+)$/ ) {
608 my ( $k, $v ) = ( $1, $2 );
609 die "duplicate key in comma-separated list property: $k\n " if defined ( $res ->{ $k });
610 my $schema = $format ->{ $k };
611 if ( my $alias = $schema ->{ alias
}) {
612 if ( my $key_alias = $schema ->{ keyAlias
}) {
613 die "key alias ' $key_alias ' is already defined \n " if defined ( $res ->{ $key_alias });
614 $res ->{ $key_alias } = $k ;
617 $schema = $format ->{ $k };
620 die "invalid key in comma-separated list property: $k\n " if ! $schema ;
621 if ( $schema ->{ type
} && $schema ->{ type
} eq 'boolean' ) {
622 $v = parse_boolean
( $v ) // $v ;
625 } elsif ( $part !~ /=/ ) {
626 die "duplicate key in comma-separated list property: $default_key\n " if $default_key ;
627 foreach my $key ( keys %$format ) {
628 if ( $format ->{ $key }->{ default_key
}) {
630 if (! $res ->{ $default_key }) {
631 $res ->{ $default_key } = $part ;
634 die "duplicate key in comma-separated list property: $default_key\n " ;
637 die "value without key, but schema does not define a default key \n " if ! $default_key ;
639 die "missing key in comma-separated list property \n " ;
644 check_object
( $path, $format, $res, $additional_properties, $errors );
645 if ( scalar ( %$errors )) {
646 raise
"format error \n " , errors
=> $errors ;
653 my ( $errors, $path, $msg ) = @_ ;
655 $path = '_root' if ! $path ;
657 if ( $errors ->{ $path }) {
658 $errors ->{ $path } = join ( ' \n ' , $errors ->{ $path }, $msg );
660 $errors ->{ $path } = $msg ;
667 # see 'man perlretut'
668 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/ ;
674 return $value =~ m/^[+-]?\d+$/ ;
678 my ( $path, $type, $value, $errors ) = @_ ;
682 if (! defined ( $value )) {
683 return 1 if $type eq 'null' ;
687 if ( my $tt = ref ( $type )) {
688 if ( $tt eq 'ARRAY' ) {
689 foreach my $t ( @$type ) {
691 check_type
( $path, $t, $value, $tmperr );
692 return 1 if ! scalar ( %$tmperr );
694 my $ttext = join ( '|' , @$type );
695 add_error
( $errors, $path, "type check (' $ttext ') failed" );
697 } elsif ( $tt eq 'HASH' ) {
699 check_prop
( $value, $type, $path, $tmperr );
700 return 1 if ! scalar ( %$tmperr );
701 add_error
( $errors, $path, "type check failed" );
704 die "internal error - got reference type ' $tt '" ;
709 return 1 if $type eq 'any' ;
711 if ( $type eq 'null' ) {
712 if ( defined ( $value )) {
713 add_error
( $errors, $path, "type check (' $type ') failed - value is not null" );
719 my $vt = ref ( $value );
721 if ( $type eq 'array' ) {
722 if (! $vt || $vt ne 'ARRAY' ) {
723 add_error
( $errors, $path, "type check (' $type ') failed" );
727 } elsif ( $type eq 'object' ) {
728 if (! $vt || $vt ne 'HASH' ) {
729 add_error
( $errors, $path, "type check (' $type ') failed" );
733 } elsif ( $type eq 'coderef' ) {
734 if (! $vt || $vt ne 'CODE' ) {
735 add_error
( $errors, $path, "type check (' $type ') failed" );
739 } elsif ( $type eq 'string' && $vt eq 'Regexp' ) {
740 # qr// regexes can be used as strings and make sense for format=regex
744 add_error
( $errors, $path, "type check (' $type ') failed - got $vt " );
747 if ( $type eq 'string' ) {
748 return 1 ; # nothing to check ?
749 } elsif ( $type eq 'boolean' ) {
750 #if ($value =~ m/^(1|true|yes|on)$/i) {
753 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
754 } elsif ( $value eq '0' ) {
755 return 1 ; # return success (not value)
757 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
760 } elsif ( $type eq 'integer' ) {
761 if (! is_integer
( $value )) {
762 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
766 } elsif ( $type eq 'number' ) {
767 if (! is_number
( $value )) {
768 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
773 return 1 ; # no need to verify unknown types
783 my ( $path, $schema, $value, $additional_properties, $errors ) = @_ ;
785 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
787 my $st = ref ( $schema );
788 if (! $st || $st ne 'HASH' ) {
789 add_error
( $errors, $path, "Invalid schema definition." );
793 my $vt = ref ( $value );
794 if (! $vt || $vt ne 'HASH' ) {
795 add_error
( $errors, $path, "an object is required" );
799 foreach my $k ( keys %$schema ) {
800 check_prop
( $value ->{ $k }, $schema ->{ $k }, $path ?
" $path . $k " : $k, $errors );
803 foreach my $k ( keys %$value ) {
805 my $newpath = $path ?
" $path . $k " : $k ;
807 if ( my $subschema = $schema ->{ $k }) {
808 if ( my $requires = $subschema ->{ requires
}) {
809 if ( ref ( $requires )) {
810 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
811 check_prop
( $value, $requires, $path, $errors );
812 } elsif (! defined ( $value ->{ $requires })) {
813 add_error
( $errors, $path ?
" $path . $requires " : $requires,
814 "missing property - ' $newpath ' requires this property" );
818 next ; # value is already checked above
821 if ( defined ( $additional_properties ) && ! $additional_properties ) {
822 add_error
( $errors, $newpath, "property is not defined in schema " .
823 "and the schema does not allow additional properties" );
826 check_prop
( $value ->{ $k }, $additional_properties, $newpath, $errors )
827 if ref ( $additional_properties );
831 sub check_object_warn
{
832 my ( $path, $schema, $value, $additional_properties ) = @_ ;
834 check_object
( $path, $schema, $value, $additional_properties, $errors );
835 if ( scalar ( %$errors )) {
836 foreach my $k ( keys %$errors ) {
837 warn "parse error: $k : $errors ->{ $k } \n " ;
845 my ( $value, $schema, $path, $errors ) = @_ ;
847 die "internal error - no schema" if ! $schema ;
848 die "internal error" if ! $errors ;
850 #print "check_prop $path\n" if $value;
852 my $st = ref ( $schema );
853 if (! $st || $st ne 'HASH' ) {
854 add_error
( $errors, $path, "Invalid schema definition." );
858 # if it extends another schema, it must pass that schema as well
859 if ( $schema ->{ extends
}) {
860 check_prop
( $value, $schema ->{ extends
}, $path, $errors );
863 if (! defined ( $value )) {
864 return if $schema ->{ type
} && $schema ->{ type
} eq 'null' ;
865 if (! $schema ->{ optional
} && ! $schema ->{ alias
} && ! $schema ->{ group
}) {
866 add_error
( $errors, $path, "property is missing and it is not optional" );
871 return if ! check_type
( $path, $schema ->{ type
}, $value, $errors );
873 if ( $schema ->{ disallow
}) {
875 if ( check_type
( $path, $schema ->{ disallow
}, $value, $tmperr )) {
876 add_error
( $errors, $path, "disallowed value was matched" );
881 if ( my $vt = ref ( $value )) {
883 if ( $vt eq 'ARRAY' ) {
884 if ( $schema ->{ items
}) {
885 my $it = ref ( $schema ->{ items
});
886 if ( $it && $it eq 'ARRAY' ) {
887 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
888 die "not implemented" ;
891 foreach my $el ( @$value ) {
892 check_prop
( $el, $schema ->{ items
}, "${path}[ $ind ]" , $errors );
898 } elsif ( $schema ->{ properties
} || $schema ->{ additionalProperties
}) {
899 check_object
( $path, defined ( $schema ->{ properties
}) ?
$schema ->{ properties
} : {},
900 $value, $schema ->{ additionalProperties
}, $errors );
906 if ( my $format = $schema ->{ format
}) {
907 eval { check_format
( $format, $value, $path ); };
909 add_error
( $errors, $path, "invalid format - $@ " );
914 if ( my $pattern = $schema ->{ pattern
}) {
915 if ( $value !~ m/^$pattern$/ ) {
916 add_error
( $errors, $path, "value does not match the regex pattern" );
921 if ( defined ( my $max = $schema ->{ maxLength
})) {
922 if ( length ( $value ) > $max ) {
923 add_error
( $errors, $path, "value may only be $max characters long" );
928 if ( defined ( my $min = $schema ->{ minLength
})) {
929 if ( length ( $value ) < $min ) {
930 add_error
( $errors, $path, "value must be at least $min characters long" );
935 if ( is_number
( $value )) {
936 if ( defined ( my $max = $schema ->{ maximum
})) {
938 add_error
( $errors, $path, "value must have a maximum value of $max " );
943 if ( defined ( my $min = $schema ->{ minimum
})) {
945 add_error
( $errors, $path, "value must have a minimum value of $min " );
951 if ( my $ea = $schema ->{ enum
}) {
954 foreach my $ev ( @$ea ) {
961 add_error
( $errors, $path, "value ' $value ' does not have a value in the enumeration '" .
962 join ( ", " , @$ea ) . "'" );
969 my ( $instance, $schema, $errmsg ) = @_ ;
972 $errmsg = "Parameter verification failed. \n " if ! $errmsg ;
974 # todo: cycle detection is only needed for debugging, I guess
975 # we can disable that in the final release
976 # todo: is there a better/faster way to detect cycles?
978 find_cycle
( $instance, sub { $cycles = 1 });
980 add_error
( $errors, undef , "data structure contains recursive cycles" );
982 check_prop
( $instance, $schema, '' , $errors );
985 if ( scalar ( %$errors )) {
986 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors ;
992 my $schema_valid_types = [ "string" , "object" , "coderef" , "array" , "boolean" , "number" , "integer" , "null" , "any" ];
993 my $default_schema_noref = {
994 description
=> "This is the JSON Schema for JSON Schemas." ,
995 type
=> [ "object" ],
996 additionalProperties
=> 0 ,
999 type
=> [ "string" , "array" ],
1000 description
=> "This is a type definition value. This can be a simple type, or a union type" ,
1005 enum
=> $schema_valid_types,
1007 enum
=> $schema_valid_types,
1011 description
=> "This indicates that the instance property in the instance object is not required." ,
1017 description
=> "This is a definition for the properties of an object value" ,
1023 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array" ,
1027 additionalProperties
=> {
1028 type
=> [ "boolean" , "object" ],
1029 description
=> "This provides a default property definition for all properties that are not explicitly defined in an object type definition." ,
1036 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number." ,
1041 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number." ,
1045 description
=> "When the instance value is a string, this indicates minimum length of the string" ,
1052 description
=> "When the instance value is a string, this indicates maximum length of the string." ,
1058 description
=> "A text representation of the type (used to generate documentation)." ,
1063 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." ,
1070 description
=> "This provides an enumeration of possible values that are valid for the instance property." ,
1075 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)." ,
1077 verbose_description
=> {
1080 description
=> "This provides a more verbose description." ,
1082 format_description
=> {
1085 description
=> "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings." ,
1090 description
=> "This provides the title of the property" ,
1095 description
=> "This is used to provide rendering hints to format cli command output." ,
1098 type
=> [ "string" , "object" ],
1100 description
=> "indicates a required property or a schema that must be validated if this property is present" ,
1103 type
=> [ "string" , "object" ],
1105 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" ,
1110 description
=> "Whether this is the default key in a comma separated list property string." ,
1115 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." ,
1120 description
=> "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'." ,
1121 requires
=> 'alias' ,
1126 description
=> "This indicates the default for the instance property."
1130 description
=> "Bash completion function. This function should return a list of possible values." ,
1136 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." ,
1141 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also." ,
1144 # this is from hyper schema
1147 description
=> "This defines the link relations of the instance objects" ,
1154 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" ,
1158 description
=> "This is the name of the link relation" ,
1164 description
=> "For submission links, this defines the method that should be used to access the target resource" ,
1173 description
=> "For CLI context, this defines the maximal width to print before truncating" ,
1179 my $default_schema = Storable
:: dclone
( $default_schema_noref );
1181 $default_schema ->{ properties
}->{ properties
}->{ additionalProperties
} = $default_schema ;
1182 $default_schema ->{ properties
}->{ additionalProperties
}->{ properties
} = $default_schema ->{ properties
};
1184 $default_schema ->{ properties
}->{ items
}->{ properties
} = $default_schema ->{ properties
};
1185 $default_schema ->{ properties
}->{ items
}->{ additionalProperties
} = 0 ;
1187 $default_schema ->{ properties
}->{ disallow
}->{ properties
} = $default_schema ->{ properties
};
1188 $default_schema ->{ properties
}->{ disallow
}->{ additionalProperties
} = 0 ;
1190 $default_schema ->{ properties
}->{ requires
}->{ properties
} = $default_schema ->{ properties
};
1191 $default_schema ->{ properties
}->{ requires
}->{ additionalProperties
} = 0 ;
1193 $default_schema ->{ properties
}->{ extends
}->{ properties
} = $default_schema ->{ properties
};
1194 $default_schema ->{ properties
}->{ extends
}->{ additionalProperties
} = 0 ;
1196 my $method_schema = {
1198 additionalProperties
=> 0 ,
1201 description
=> "This a description of the method" ,
1206 description
=> "This indicates the name of the function to call." ,
1209 additionalProperties
=> 1 ,
1224 description
=> "The HTTP method name." ,
1225 enum
=> [ 'GET' , 'POST' , 'PUT' , 'DELETE' ],
1230 description
=> "Method needs special privileges - only pvedaemon can execute it" ,
1235 description
=> "Method downloads the file content (filename is the return value of the method)." ,
1240 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter." ,
1243 proxyto_callback
=> {
1245 description
=> "A function which is called to resolve the proxyto attribute. The default implementaion returns the value of the 'proxyto' parameter." ,
1250 description
=> "Required access permissions. By default only 'root' is allowed to access this method." ,
1252 additionalProperties
=> 0 ,
1255 description
=> "Describe access permissions." ,
1259 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials." ,
1261 enum
=> [ 'all' , 'world' ],
1265 description
=> "Array of permission checks (prefix notation)." ,
1272 description
=> "Used internally" ,
1276 description
=> "Used internally" ,
1281 description
=> "path for URL matching (uri template)" ,
1283 fragmentDelimiter
=> {
1285 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." ,
1290 description
=> "JSON Schema for parameters." ,
1295 description
=> "JSON Schema for return value." ,
1300 description
=> "method implementaion (code reference)" ,
1305 description
=> "Delegate call to this class (perl class string)." ,
1308 additionalProperties
=> 0 ,
1314 fragmentDelimiter
=> { optional
=> 1 }
1322 sub validate_schema
{
1325 my $errmsg = "internal error - unable to verify schema \n " ;
1326 validate
( $schema, $default_schema, $errmsg );
1329 sub validate_method_info
{
1332 my $errmsg = "internal error - unable to verify method info \n " ;
1333 validate
( $info, $method_schema, $errmsg );
1335 validate_schema
( $info ->{ parameters
}) if $info ->{ parameters
};
1336 validate_schema
( $info ->{ returns
}) if $info ->{ returns
};
1339 # run a self test on load
1340 # make sure we can verify the default schema
1341 validate_schema
( $default_schema_noref );
1342 validate_schema
( $method_schema );
1344 # and now some utility methods (used by pve api)
1345 sub method_get_child_link
{
1348 return undef if ! $info ;
1350 my $schema = $info ->{ returns
};
1351 return undef if ! $schema || ! $schema ->{ type
} || $schema ->{ type
} ne 'array' ;
1353 my $links = $schema ->{ links
};
1354 return undef if ! $links ;
1357 foreach my $lnk ( @$links ) {
1358 if ( $lnk ->{ href
} && $lnk ->{ rel
} && ( $lnk ->{ rel
} eq 'child' )) {
1367 # a way to parse command line parameters, using a
1368 # schema to configure Getopt::Long
1370 my ( $schema, $args, $arg_param, $fixed_param, $param_mapping_hash ) = @_ ;
1372 if (! $schema || ! $schema ->{ properties
}) {
1373 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1374 if scalar ( @$args ) != 0 ;
1379 if ( $arg_param && ! ref ( $arg_param )) {
1380 my $pd = $schema ->{ properties
}->{ $arg_param };
1381 die "expected list format $pd ->{format}"
1382 if !( $pd && $pd ->{ format
} && $pd ->{ format
} =~ m/-list/ );
1383 $list_param = $arg_param ;
1386 my @interactive = ();
1388 foreach my $prop ( keys %{ $schema ->{ properties
}}) {
1389 my $pd = $schema ->{ properties
}->{ $prop };
1390 next if $list_param && $prop eq $list_param ;
1391 next if defined ( $fixed_param ->{ $prop });
1393 my $mapping = $param_mapping_hash ->{ $prop };
1394 if ( $mapping && $mapping ->{ interactive
}) {
1395 # interactive parameters such as passwords: make the argument
1396 # optional and call the mapping function afterwards.
1397 push @getopt, " $prop :s" ;
1398 push @interactive, [ $prop, $mapping ->{ func
}];
1399 } elsif ( $pd ->{ type
} eq 'boolean' ) {
1400 push @getopt, " $prop :s" ;
1402 if ( $pd ->{ format
} && $pd ->{ format
} =~ m/-a?list/ ) {
1403 push @getopt, " $prop =s@" ;
1405 push @getopt, " $prop =s" ;
1410 Getopt
:: Long
:: Configure
( 'prefix_pattern=(--|-)' );
1413 raise
( "unable to parse option \n " , code
=> HTTP_BAD_REQUEST
)
1414 if ! Getopt
:: Long
:: GetOptionsFromArray
( $args, $opts, @getopt );
1418 $opts ->{ $list_param } = $args ;
1420 } elsif ( ref ( $arg_param )) {
1421 foreach my $arg_name ( @$arg_param ) {
1422 if ( $opts ->{ 'extra-args' }) {
1423 raise
( "internal error: extra-args must be the last argument \n " , code
=> HTTP_BAD_REQUEST
);
1425 if ( $arg_name eq 'extra-args' ) {
1426 $opts ->{ 'extra-args' } = $args ;
1430 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
) if ! @$args ;
1431 $opts ->{ $arg_name } = shift @$args ;
1433 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
) if @$args ;
1435 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1436 if scalar ( @$args ) != 0 ;
1439 if ( ref ( $arg_param )) {
1440 foreach my $arg_name ( @$arg_param ) {
1441 if ( $arg_name eq 'extra-args' ) {
1442 $opts ->{ 'extra-args' } = [];
1444 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
);
1450 foreach my $entry ( @interactive ) {
1451 my ( $opt, $func ) = @$entry ;
1452 my $pd = $schema ->{ properties
}->{ $opt };
1453 my $value = $opts ->{ $opt };
1454 if ( defined ( $value ) || ! $pd ->{ optional
}) {
1455 $opts ->{ $opt } = $func ->( $value );
1459 # decode after Getopt as we are not sure how well it handles unicode
1460 foreach my $p ( keys %$opts ) {
1461 if (! ref ( $opts ->{ $p })) {
1462 $opts ->{ $p } = decode
( 'locale' , $opts ->{ $p });
1463 } elsif ( ref ( $opts ->{ $p }) eq 'ARRAY' ) {
1465 foreach my $v (@{ $opts ->{ $p }}) {
1466 push @$tmp, decode
( 'locale' , $v );
1469 } elsif ( ref ( $opts ->{ $p }) eq 'SCALAR' ) {
1470 $opts ->{ $p } = decode
( 'locale' , $$opts ->{ $p });
1472 raise
( "decoding options failed, unknown reference \n " , code
=> HTTP_BAD_REQUEST
);
1476 foreach my $p ( keys %$opts ) {
1477 if ( my $pd = $schema ->{ properties
}->{ $p }) {
1478 if ( $pd ->{ type
} eq 'boolean' ) {
1479 if ( $opts ->{ $p } eq '' ) {
1481 } elsif ( defined ( my $bool = parse_boolean
( $opts ->{ $p }))) {
1482 $opts ->{ $p } = $bool ;
1484 raise
( "unable to parse boolean option \n " , code
=> HTTP_BAD_REQUEST
);
1486 } elsif ( $pd ->{ format
}) {
1488 if ( $pd ->{ format
} =~ m/-list/ ) {
1489 # allow --vmid 100 --vmid 101 and --vmid 100,101
1490 # allow --dow mon --dow fri and --dow mon,fri
1491 $opts ->{ $p } = join ( "," , @{ $opts ->{ $p }}) if ref ( $opts ->{ $p }) eq 'ARRAY' ;
1492 } elsif ( $pd ->{ format
} =~ m/-alist/ ) {
1493 # we encode array as \0 separated strings
1494 # Note: CGI.pm also use this encoding
1495 if ( scalar (@{ $opts ->{ $p }}) != 1 ) {
1496 $opts ->{ $p } = join ( "\0" , @{ $opts ->{ $p }});
1498 # st that split_list knows it is \0 terminated
1499 my $v = $opts ->{ $p }->[ 0 ];
1500 $opts ->{ $p } = " $v\0 " ;
1507 foreach my $p ( keys %$fixed_param ) {
1508 $opts ->{ $p } = $fixed_param ->{ $p };
1514 # A way to parse configuration data by giving a json schema
1516 my ( $schema, $filename, $raw ) = @_ ;
1518 # do fast check (avoid validate_schema($schema))
1519 die "got strange schema" if ! $schema ->{ type
} ||
1520 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1524 while ( $raw =~ /^\s*(.+?)\s*$/gm ) {
1527 next if $line =~ /^#/ ;
1529 if ( $line =~ m/^(\S+?):\s*(.*)$/ ) {
1532 if ( $schema ->{ properties
}->{ $key } &&
1533 $schema ->{ properties
}->{ $key }->{ type
} eq 'boolean' ) {
1535 $value = parse_boolean
( $value ) // $value ;
1537 $cfg ->{ $key } = $value ;
1539 warn "ignore config line: $line\n "
1544 check_prop
( $cfg, $schema, '' , $errors );
1546 foreach my $k ( keys %$errors ) {
1547 warn "parse error in ' $filename ' - ' $k ': $errors ->{ $k } \n " ;
1554 # generate simple key/value file
1556 my ( $schema, $filename, $cfg ) = @_ ;
1558 # do fast check (avoid validate_schema($schema))
1559 die "got strange schema" if ! $schema ->{ type
} ||
1560 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1562 validate
( $cfg, $schema, "validation error in ' $filename ' \n " );
1566 foreach my $k ( keys %$cfg ) {
1567 $data .= " $k : $cfg ->{ $k } \n " ;
1573 # helpers used to generate our manual pages
1575 my $find_schema_default_key = sub {
1579 my $keyAliasProps = {};
1581 foreach my $key ( keys %$format ) {
1582 my $phash = $format ->{ $key };
1583 if ( $phash ->{ default_key
}) {
1584 die "multiple default keys in schema ( $default_key, $key ) \n "
1585 if defined ( $default_key );
1586 die "default key ' $key ' is an alias - this is not allowed \n "
1587 if defined ( $phash ->{ alias
});
1588 die "default key ' $key ' with keyAlias attribute is not allowed \n "
1589 if $phash ->{ keyAlias
};
1590 $default_key = $key ;
1592 my $key_alias = $phash ->{ keyAlias
};
1593 die "found keyAlias without 'alias definition for ' $key ' \n "
1594 if $key_alias && ! $phash ->{ alias
};
1596 if ( $phash ->{ alias
} && $key_alias ) {
1597 die "inconsistent keyAlias ' $key_alias ' definition"
1598 if defined ( $keyAliasProps ->{ $key_alias }) &&
1599 $keyAliasProps ->{ $key_alias } ne $phash ->{ alias
};
1600 $keyAliasProps ->{ $key_alias } = $phash ->{ alias
};
1604 return wantarray ?
( $default_key, $keyAliasProps ) : $default_key ;
1607 sub generate_typetext
{
1608 my ( $format, $list_enums ) = @_ ;
1610 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1615 my $add_option_string = sub {
1616 my ( $text, $optional ) = @_ ;
1622 $text = "[ $text ]" if $optional ;
1627 my $format_key_value = sub {
1628 my ( $key, $phash ) = @_ ;
1630 die "internal error" if defined ( $phash ->{ alias
});
1636 if ( my $desc = $phash ->{ format_description
}) {
1637 $typetext .= "< $desc >" ;
1638 } elsif ( my $text = $phash ->{ typetext
}) {
1640 } elsif ( my $enum = $phash ->{ enum
}) {
1641 if ( $list_enums || ( scalar ( @$enum ) <= 3 )) {
1642 $typetext .= '<' . join ( '|' , @$enum ) . '>' ;
1644 $typetext .= '<enum>' ;
1646 } elsif ( $phash ->{ type
} eq 'boolean' ) {
1647 $typetext .= '<1|0>' ;
1648 } elsif ( $phash ->{ type
} eq 'integer' ) {
1649 $typetext .= '<integer>' ;
1650 } elsif ( $phash ->{ type
} eq 'number' ) {
1651 $typetext .= '<number>' ;
1653 die "internal error: neither format_description nor typetext found for option ' $key '" ;
1656 if ( defined ( $default_key ) && ( $default_key eq $key )) {
1657 & $add_option_string ( "[ $keytext =] $typetext " , $phash ->{ optional
});
1659 & $add_option_string ( " $keytext = $typetext " , $phash ->{ optional
});
1665 my $cond_add_key = sub {
1668 return if $done ->{ $key }; # avoid duplicates
1672 my $phash = $format ->{ $key };
1674 return if ! $phash ; # should not happen
1676 return if $phash ->{ alias
};
1678 & $format_key_value ( $key, $phash );
1682 & $cond_add_key ( $default_key ) if defined ( $default_key );
1684 # add required keys first
1685 foreach my $key ( sort keys %$format ) {
1686 my $phash = $format ->{ $key };
1687 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1691 foreach my $key ( sort keys %$format ) {
1692 & $cond_add_key ( $key );
1695 foreach my $keyAlias ( sort keys %$keyAliasProps ) {
1696 & $add_option_string ( "< $keyAlias >=< $keyAliasProps ->{ $keyAlias }>" , 1 );
1702 sub print_property_string
{
1703 my ( $data, $format, $skip, $path ) = @_ ;
1705 if ( ref ( $format ) ne 'HASH' ) {
1706 my $schema = get_format
( $format );
1707 die "not a valid format: $format\n " if ! $schema ;
1712 check_object
( $path, $format, $data, undef , $errors );
1713 if ( scalar ( %$errors )) {
1714 raise
"format error" , errors
=> $errors ;
1717 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1722 my $add_option_string = sub {
1725 $res .= ',' if $add_sep ;
1730 my $format_value = sub {
1731 my ( $key, $value, $format ) = @_ ;
1733 if ( defined ( $format ) && ( $format eq 'disk-size' )) {
1734 return format_size
( $value );
1736 die "illegal value with commas for $key\n " if $value =~ /,/ ;
1741 my $done = { map { $_ => 1 } @$skip };
1743 my $cond_add_key = sub {
1744 my ( $key, $isdefault ) = @_ ;
1746 return if $done ->{ $key }; # avoid duplicates
1750 my $value = $data ->{ $key };
1752 return if ! defined ( $value );
1754 my $phash = $format ->{ $key };
1756 # try to combine values if we have key aliases
1757 if ( my $combine = $keyAliasProps ->{ $key }) {
1758 if ( defined ( my $combine_value = $data ->{ $combine })) {
1759 my $combine_format = $format ->{ $combine }->{ format
};
1760 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1761 my $combine_str = & $format_value ( $combine, $combine_value, $combine_format );
1762 & $add_option_string ( "${value_str}=${combine_str}" );
1763 $done ->{ $combine } = 1 ;
1768 if ( $phash && $phash ->{ alias
}) {
1769 $phash = $format ->{ $phash ->{ alias
}};
1772 die "invalid key ' $key ' \n " if ! $phash ;
1773 die "internal error" if defined ( $phash ->{ alias
});
1775 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1777 & $add_option_string ( $value_str );
1779 & $add_option_string ( " $key =${value_str}" );
1783 # add default key first
1784 & $cond_add_key ( $default_key, 1 ) if defined ( $default_key );
1786 # add required keys first
1787 foreach my $key ( sort keys %$data ) {
1788 my $phash = $format ->{ $key };
1789 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1793 foreach my $key ( sort keys %$data ) {
1794 & $cond_add_key ( $key );
1800 sub schema_get_type_text
{
1801 my ( $phash, $style ) = @_ ;
1803 my $type = $phash ->{ type
} || 'string' ;
1805 if ( $phash ->{ typetext
}) {
1806 return $phash ->{ typetext
};
1807 } elsif ( $phash ->{ format_description
}) {
1808 return "< $phash ->{format_description}>" ;
1809 } elsif ( $phash ->{ enum
}) {
1810 return "<" . join ( ' | ' , sort @{ $phash ->{ enum
}}) . ">" ;
1811 } elsif ( $phash ->{ pattern
}) {
1812 return $phash ->{ pattern
};
1813 } elsif ( $type eq 'integer' || $type eq 'number' ) {
1814 # NOTE: always access values as number (avoid converion to string)
1815 if ( defined ( $phash ->{ minimum
}) && defined ( $phash ->{ maximum
})) {
1816 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - " .
1817 ( $phash ->{ maximum
} + 0 ) . ")" ;
1818 } elsif ( defined ( $phash ->{ minimum
})) {
1819 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - N)" ;
1820 } elsif ( defined ( $phash ->{ maximum
})) {
1821 return "< $type > (-N - " . ( $phash ->{ maximum
} + 0 ) . ")" ;
1823 } elsif ( $type eq 'string' ) {
1824 if ( my $format = $phash ->{ format
}) {
1825 $format = get_format
( $format ) if ref ( $format ) ne 'HASH' ;
1826 if ( ref ( $format ) eq 'HASH' ) {
1828 $list_enums = 1 if $style && $style eq 'config-sub' ;
1829 return generate_typetext
( $format, $list_enums );