]>
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 # register some common type for pve
126 register_format
( 'string' , sub {}); # allow format => 'string-list'
128 register_format
( 'urlencoded' , \
& pve_verify_urlencoded
);
129 sub pve_verify_urlencoded
{
130 my ( $text, $noerr ) = @_ ;
131 if ( $text !~ /^[-%a-zA-Z0-9_.!~*'()]*$/ ) {
132 return undef if $noerr ;
133 die "invalid urlencoded string: $text\n " ;
138 register_format
( 'pve-configid' , \
& pve_verify_configid
);
139 sub pve_verify_configid
{
140 my ( $id, $noerr ) = @_ ;
142 if ( $id !~ m/^[a-z][a-z0-9_]+$/i ) {
143 return undef if $noerr ;
144 die "invalid configuration ID ' $id ' \n " ;
149 PVE
:: JSONSchema
:: register_format
( 'pve-storage-id' , \
& parse_storage_id
);
150 sub parse_storage_id
{
151 my ( $storeid, $noerr ) = @_ ;
153 if ( $storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i ) {
154 return undef if $noerr ;
155 die "storage ID ' $storeid ' contains illegal characters \n " ;
161 register_format
( 'pve-vmid' , \
& pve_verify_vmid
);
162 sub pve_verify_vmid
{
163 my ( $vmid, $noerr ) = @_ ;
165 if ( $vmid !~ m/^[1-9][0-9]{2,8}$/ ) {
166 return undef if $noerr ;
167 die "value does not look like a valid VM ID \n " ;
172 register_format
( 'pve-node' , \
& pve_verify_node_name
);
173 sub pve_verify_node_name
{
174 my ( $node, $noerr ) = @_ ;
176 if ( $node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/ ) {
177 return undef if $noerr ;
178 die "value does not look like a valid node name \n " ;
183 register_format
( 'ipv4' , \
& pve_verify_ipv4
);
184 sub pve_verify_ipv4
{
185 my ( $ipv4, $noerr ) = @_ ;
187 if ( $ipv4 !~ m/^(?:$IPV4RE)$/ ) {
188 return undef if $noerr ;
189 die "value does not look like a valid IPv4 address \n " ;
194 register_format
( 'ipv6' , \
& pve_verify_ipv6
);
195 sub pve_verify_ipv6
{
196 my ( $ipv6, $noerr ) = @_ ;
198 if ( $ipv6 !~ m/^(?:$IPV6RE)$/ ) {
199 return undef if $noerr ;
200 die "value does not look like a valid IPv6 address \n " ;
205 register_format
( 'ip' , \
& pve_verify_ip
);
207 my ( $ip, $noerr ) = @_ ;
209 if ( $ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/ ) {
210 return undef if $noerr ;
211 die "value does not look like a valid IP address \n " ;
216 my $ipv4_mask_hash = {
233 '255.255.128.0' => 17 ,
234 '255.255.192.0' => 18 ,
235 '255.255.224.0' => 19 ,
236 '255.255.240.0' => 20 ,
237 '255.255.248.0' => 21 ,
238 '255.255.252.0' => 22 ,
239 '255.255.254.0' => 23 ,
240 '255.255.255.0' => 24 ,
241 '255.255.255.128' => 25 ,
242 '255.255.255.192' => 26 ,
243 '255.255.255.224' => 27 ,
244 '255.255.255.240' => 28 ,
245 '255.255.255.248' => 29 ,
246 '255.255.255.252' => 30 ,
247 '255.255.255.254' => 31 ,
248 '255.255.255.255' => 32 ,
251 register_format
( 'ipv4mask' , \
& pve_verify_ipv4mask
);
252 sub pve_verify_ipv4mask
{
253 my ( $mask, $noerr ) = @_ ;
255 if (! defined ( $ipv4_mask_hash ->{ $mask })) {
256 return undef if $noerr ;
257 die "value does not look like a valid IP netmask \n " ;
262 register_format
( 'CIDRv6' , \
& pve_verify_cidrv6
);
263 sub pve_verify_cidrv6
{
264 my ( $cidr, $noerr ) = @_ ;
266 if ( $cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 128 )) {
270 return undef if $noerr ;
271 die "value does not look like a valid IPv6 CIDR network \n " ;
274 register_format
( 'CIDRv4' , \
& pve_verify_cidrv4
);
275 sub pve_verify_cidrv4
{
276 my ( $cidr, $noerr ) = @_ ;
278 if ( $cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ( $1 > 7 ) && ( $1 <= 32 )) {
282 return undef if $noerr ;
283 die "value does not look like a valid IPv4 CIDR network \n " ;
286 register_format
( 'CIDR' , \
& pve_verify_cidr
);
287 sub pve_verify_cidr
{
288 my ( $cidr, $noerr ) = @_ ;
290 if (!( pve_verify_cidrv4
( $cidr, 1 ) ||
291 pve_verify_cidrv6
( $cidr, 1 )))
293 return undef if $noerr ;
294 die "value does not look like a valid CIDR network \n " ;
300 register_format
( 'pve-ipv4-config' , \
& pve_verify_ipv4_config
);
301 sub pve_verify_ipv4_config
{
302 my ( $config, $noerr ) = @_ ;
304 return $config if $config =~ /^(?:dhcp|manual)$/ ||
305 pve_verify_cidrv4
( $config, 1 );
306 return undef if $noerr ;
307 die "value does not look like a valid ipv4 network configuration \n " ;
310 register_format
( 'pve-ipv6-config' , \
& pve_verify_ipv6_config
);
311 sub pve_verify_ipv6_config
{
312 my ( $config, $noerr ) = @_ ;
314 return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
315 pve_verify_cidrv6
( $config, 1 );
316 return undef if $noerr ;
317 die "value does not look like a valid ipv6 network configuration \n " ;
320 register_format
( 'email' , \
& pve_verify_email
);
321 sub pve_verify_email
{
322 my ( $email, $noerr ) = @_ ;
324 # we use same regex as in Utils.js
325 if ( $email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/ ) {
326 return undef if $noerr ;
327 die "value does not look like a valid email address \n " ;
332 register_format
( 'dns-name' , \
& pve_verify_dns_name
);
333 sub pve_verify_dns_name
{
334 my ( $name, $noerr ) = @_ ;
336 my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)" ;
338 if ( $name !~ /^(${namere}\.)*${namere}$/ ) {
339 return undef if $noerr ;
340 die "value does not look like a valid DNS name \n " ;
345 # network interface name
346 register_format
( 'pve-iface' , \
& pve_verify_iface
);
347 sub pve_verify_iface
{
348 my ( $id, $noerr ) = @_ ;
350 if ( $id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i ) {
351 return undef if $noerr ;
352 die "invalid network interface name ' $id ' \n " ;
357 # general addresses by name or IP
358 register_format
( 'address' , \
& pve_verify_address
);
359 sub pve_verify_address
{
360 my ( $addr, $noerr ) = @_ ;
362 if (!( pve_verify_ip
( $addr, 1 ) ||
363 pve_verify_dns_name
( $addr, 1 )))
365 return undef if $noerr ;
366 die "value does not look like a valid address: $addr\n " ;
371 register_format
( 'disk-size' , \
& pve_verify_disk_size
);
372 sub pve_verify_disk_size
{
373 my ( $size, $noerr ) = @_ ;
374 if (! defined ( parse_size
( $size ))) {
375 return undef if $noerr ;
376 die "value does not look like a valid disk size: $size\n " ;
381 register_standard_option
( 'spice-proxy' , {
382 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)." ,
383 type
=> 'string' , format
=> 'address' ,
386 register_standard_option
( 'remote-viewer-config' , {
387 description
=> "Returned values can be directly passed to the 'remote-viewer' application." ,
388 additionalProperties
=> 1 ,
390 type
=> { type
=> 'string' },
391 password
=> { type
=> 'string' },
392 proxy
=> { type
=> 'string' },
393 host
=> { type
=> 'string' },
394 'tls-port' => { type
=> 'integer' },
398 register_format
( 'pve-startup-order' , \
& pve_verify_startup_order
);
399 sub pve_verify_startup_order
{
400 my ( $value, $noerr ) = @_ ;
402 return $value if pve_parse_startup_order
( $value );
404 return undef if $noerr ;
406 die "unable to parse startup options \n " ;
411 type
=> 'number' , minimum
=> '0' ,
412 format_description
=> 'LIMIT' ,
415 my $bwlimit_format = {
418 description
=> 'default bandwidth limit in MiB/s' ,
422 description
=> 'bandwidth limit in MiB/s for restoring guests from backups' ,
426 description
=> 'bandwidth limit in MiB/s for migrating guests' ,
430 description
=> 'bandwidth limit in MiB/s for cloning disks' ,
434 description
=> 'bandwidth limit in MiB/s for moving disks' ,
437 register_format
( 'bwlimit' , $bwlimit_format );
438 register_standard_option
( 'bwlimit' , {
439 description
=> "Set bandwidth/io limits various operations." ,
442 format
=> $bwlimit_format,
445 sub pve_parse_startup_order
{
448 return undef if ! $value ;
452 foreach my $p ( split ( /,/ , $value )) {
453 next if $p =~ m/^\s*$/ ;
455 if ( $p =~ m/^(order=)?(\d+)$/ ) {
457 } elsif ( $p =~ m/^up=(\d+)$/ ) {
459 } elsif ( $p =~ m/^down=(\d+)$/ ) {
469 PVE
:: JSONSchema
:: register_standard_option
( 'pve-startup-order' , {
470 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." ,
472 type
=> 'string' , format
=> 'pve-startup-order' ,
473 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ' ,
477 my ( $format, $value, $path ) = @_ ;
479 return parse_property_string
( $format, $value, $path ) if ref ( $format ) eq 'HASH' ;
480 return if $format eq 'regex' ;
482 if ( $format =~ m/^(.*)-a?list$/ ) {
484 my $code = $format_list ->{ $1 };
486 die "undefined format ' $format ' \n " if ! $code ;
488 # Note: we allow empty lists
489 foreach my $v ( split_list
( $value )) {
493 } elsif ( $format =~ m/^(.*)-opt$/ ) {
495 my $code = $format_list ->{ $1 };
497 die "undefined format ' $format ' \n " if ! $code ;
499 return if ! $value ; # allow empty string
505 my $code = $format_list ->{ $format };
507 die "undefined format ' $format ' \n " if ! $code ;
509 return parse_property_string
( $code, $value, $path ) if ref ( $code ) eq 'HASH' ;
517 return undef if $value !~ m/^(\d+(\.\d+)?)([KMGT])?$/ ;
518 my ( $size, $unit ) = ( $1, $3 );
521 $size = $size * 1024 ;
522 } elsif ( $unit eq 'M' ) {
523 $size = $size * 1024 * 1024 ;
524 } elsif ( $unit eq 'G' ) {
525 $size = $size * 1024 * 1024 * 1024 ;
526 } elsif ( $unit eq 'T' ) {
527 $size = $size * 1024 * 1024 * 1024 * 1024 ;
538 my $kb = int ( $size/1024 );
539 return $size if $kb*1024 != $size ;
541 my $mb = int ( $kb/1024 );
542 return "${kb}K" if $mb*1024 != $kb ;
544 my $gb = int ( $mb/1024 );
545 return "${mb}M" if $gb*1024 != $mb ;
547 my $tb = int ( $gb/1024 );
548 return "${gb}G" if $tb*1024 != $gb ;
555 return 1 if $bool =~ m/^(1|on|yes|true)$/i ;
556 return 0 if $bool =~ m/^(0|off|no|false)$/i ;
560 sub parse_property_string
{
561 my ( $format, $data, $path, $additional_properties ) = @_ ;
563 # In property strings we default to not allowing additional properties
564 $additional_properties = 0 if ! defined ( $additional_properties );
566 # Support named formats here, too:
568 if ( my $desc = $format_list ->{ $format }) {
571 die "unknown format: $format\n " ;
573 } elsif ( ref ( $format ) ne 'HASH' ) {
574 die "unexpected format value of type " . ref ( $format ). " \n " ;
580 foreach my $part ( split ( /,/ , $data )) {
581 next if $part =~ /^\s*$/ ;
583 if ( $part =~ /^([^=]+)=(.+)$/ ) {
584 my ( $k, $v ) = ( $1, $2 );
585 die "duplicate key in comma-separated list property: $k\n " if defined ( $res ->{ $k });
586 my $schema = $format ->{ $k };
587 if ( my $alias = $schema ->{ alias
}) {
588 if ( my $key_alias = $schema ->{ keyAlias
}) {
589 die "key alias ' $key_alias ' is already defined \n " if defined ( $res ->{ $key_alias });
590 $res ->{ $key_alias } = $k ;
593 $schema = $format ->{ $k };
596 die "invalid key in comma-separated list property: $k\n " if ! $schema ;
597 if ( $schema ->{ type
} && $schema ->{ type
} eq 'boolean' ) {
598 $v = parse_boolean
( $v ) // $v ;
601 } elsif ( $part !~ /=/ ) {
602 die "duplicate key in comma-separated list property: $default_key\n " if $default_key ;
603 foreach my $key ( keys %$format ) {
604 if ( $format ->{ $key }->{ default_key
}) {
606 if (! $res ->{ $default_key }) {
607 $res ->{ $default_key } = $part ;
610 die "duplicate key in comma-separated list property: $default_key\n " ;
613 die "value without key, but schema does not define a default key \n " if ! $default_key ;
615 die "missing key in comma-separated list property \n " ;
620 check_object
( $path, $format, $res, $additional_properties, $errors );
621 if ( scalar ( %$errors )) {
622 raise
"format error \n " , errors
=> $errors ;
629 my ( $errors, $path, $msg ) = @_ ;
631 $path = '_root' if ! $path ;
633 if ( $errors ->{ $path }) {
634 $errors ->{ $path } = join ( ' \n ' , $errors ->{ $path }, $msg );
636 $errors ->{ $path } = $msg ;
643 # see 'man perlretut'
644 return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/ ;
650 return $value =~ m/^[+-]?\d+$/ ;
654 my ( $path, $type, $value, $errors ) = @_ ;
658 if (! defined ( $value )) {
659 return 1 if $type eq 'null' ;
663 if ( my $tt = ref ( $type )) {
664 if ( $tt eq 'ARRAY' ) {
665 foreach my $t ( @$type ) {
667 check_type
( $path, $t, $value, $tmperr );
668 return 1 if ! scalar ( %$tmperr );
670 my $ttext = join ( '|' , @$type );
671 add_error
( $errors, $path, "type check (' $ttext ') failed" );
673 } elsif ( $tt eq 'HASH' ) {
675 check_prop
( $value, $type, $path, $tmperr );
676 return 1 if ! scalar ( %$tmperr );
677 add_error
( $errors, $path, "type check failed" );
680 die "internal error - got reference type ' $tt '" ;
685 return 1 if $type eq 'any' ;
687 if ( $type eq 'null' ) {
688 if ( defined ( $value )) {
689 add_error
( $errors, $path, "type check (' $type ') failed - value is not null" );
695 my $vt = ref ( $value );
697 if ( $type eq 'array' ) {
698 if (! $vt || $vt ne 'ARRAY' ) {
699 add_error
( $errors, $path, "type check (' $type ') failed" );
703 } elsif ( $type eq 'object' ) {
704 if (! $vt || $vt ne 'HASH' ) {
705 add_error
( $errors, $path, "type check (' $type ') failed" );
709 } elsif ( $type eq 'coderef' ) {
710 if (! $vt || $vt ne 'CODE' ) {
711 add_error
( $errors, $path, "type check (' $type ') failed" );
715 } elsif ( $type eq 'string' && $vt eq 'Regexp' ) {
716 # qr// regexes can be used as strings and make sense for format=regex
720 add_error
( $errors, $path, "type check (' $type ') failed - got $vt " );
723 if ( $type eq 'string' ) {
724 return 1 ; # nothing to check ?
725 } elsif ( $type eq 'boolean' ) {
726 #if ($value =~ m/^(1|true|yes|on)$/i) {
729 #} elsif ($value =~ m/^(0|false|no|off)$/i) {
730 } elsif ( $value eq '0' ) {
731 return 1 ; # return success (not value)
733 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
736 } elsif ( $type eq 'integer' ) {
737 if (! is_integer
( $value )) {
738 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
742 } elsif ( $type eq 'number' ) {
743 if (! is_number
( $value )) {
744 add_error
( $errors, $path, "type check (' $type ') failed - got ' $value '" );
749 return 1 ; # no need to verify unknown types
759 my ( $path, $schema, $value, $additional_properties, $errors ) = @_ ;
761 # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
763 my $st = ref ( $schema );
764 if (! $st || $st ne 'HASH' ) {
765 add_error
( $errors, $path, "Invalid schema definition." );
769 my $vt = ref ( $value );
770 if (! $vt || $vt ne 'HASH' ) {
771 add_error
( $errors, $path, "an object is required" );
775 foreach my $k ( keys %$schema ) {
776 check_prop
( $value ->{ $k }, $schema ->{ $k }, $path ?
" $path . $k " : $k, $errors );
779 foreach my $k ( keys %$value ) {
781 my $newpath = $path ?
" $path . $k " : $k ;
783 if ( my $subschema = $schema ->{ $k }) {
784 if ( my $requires = $subschema ->{ requires
}) {
785 if ( ref ( $requires )) {
786 #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
787 check_prop
( $value, $requires, $path, $errors );
788 } elsif (! defined ( $value ->{ $requires })) {
789 add_error
( $errors, $path ?
" $path . $requires " : $requires,
790 "missing property - ' $newpath ' requires this property" );
794 next ; # value is already checked above
797 if ( defined ( $additional_properties ) && ! $additional_properties ) {
798 add_error
( $errors, $newpath, "property is not defined in schema " .
799 "and the schema does not allow additional properties" );
802 check_prop
( $value ->{ $k }, $additional_properties, $newpath, $errors )
803 if ref ( $additional_properties );
807 sub check_object_warn
{
808 my ( $path, $schema, $value, $additional_properties ) = @_ ;
810 check_object
( $path, $schema, $value, $additional_properties, $errors );
811 if ( scalar ( %$errors )) {
812 foreach my $k ( keys %$errors ) {
813 warn "parse error: $k : $errors ->{ $k } \n " ;
821 my ( $value, $schema, $path, $errors ) = @_ ;
823 die "internal error - no schema" if ! $schema ;
824 die "internal error" if ! $errors ;
826 #print "check_prop $path\n" if $value;
828 my $st = ref ( $schema );
829 if (! $st || $st ne 'HASH' ) {
830 add_error
( $errors, $path, "Invalid schema definition." );
834 # if it extends another schema, it must pass that schema as well
835 if ( $schema ->{ extends
}) {
836 check_prop
( $value, $schema ->{ extends
}, $path, $errors );
839 if (! defined ( $value )) {
840 return if $schema ->{ type
} && $schema ->{ type
} eq 'null' ;
841 if (! $schema ->{ optional
} && ! $schema ->{ alias
} && ! $schema ->{ group
}) {
842 add_error
( $errors, $path, "property is missing and it is not optional" );
847 return if ! check_type
( $path, $schema ->{ type
}, $value, $errors );
849 if ( $schema ->{ disallow
}) {
851 if ( check_type
( $path, $schema ->{ disallow
}, $value, $tmperr )) {
852 add_error
( $errors, $path, "disallowed value was matched" );
857 if ( my $vt = ref ( $value )) {
859 if ( $vt eq 'ARRAY' ) {
860 if ( $schema ->{ items
}) {
861 my $it = ref ( $schema ->{ items
});
862 if ( $it && $it eq 'ARRAY' ) {
863 #die "implement me $path: $vt " . Dumper($schema) ."\n". Dumper($value);
864 die "not implemented" ;
867 foreach my $el ( @$value ) {
868 check_prop
( $el, $schema ->{ items
}, "${path}[ $ind ]" , $errors );
874 } elsif ( $schema ->{ properties
} || $schema ->{ additionalProperties
}) {
875 check_object
( $path, defined ( $schema ->{ properties
}) ?
$schema ->{ properties
} : {},
876 $value, $schema ->{ additionalProperties
}, $errors );
882 if ( my $format = $schema ->{ format
}) {
883 eval { check_format
( $format, $value, $path ); };
885 add_error
( $errors, $path, "invalid format - $@ " );
890 if ( my $pattern = $schema ->{ pattern
}) {
891 if ( $value !~ m/^$pattern$/ ) {
892 add_error
( $errors, $path, "value does not match the regex pattern" );
897 if ( defined ( my $max = $schema ->{ maxLength
})) {
898 if ( length ( $value ) > $max ) {
899 add_error
( $errors, $path, "value may only be $max characters long" );
904 if ( defined ( my $min = $schema ->{ minLength
})) {
905 if ( length ( $value ) < $min ) {
906 add_error
( $errors, $path, "value must be at least $min characters long" );
911 if ( is_number
( $value )) {
912 if ( defined ( my $max = $schema ->{ maximum
})) {
914 add_error
( $errors, $path, "value must have a maximum value of $max " );
919 if ( defined ( my $min = $schema ->{ minimum
})) {
921 add_error
( $errors, $path, "value must have a minimum value of $min " );
927 if ( my $ea = $schema ->{ enum
}) {
930 foreach my $ev ( @$ea ) {
937 add_error
( $errors, $path, "value ' $value ' does not have a value in the enumeration '" .
938 join ( ", " , @$ea ) . "'" );
945 my ( $instance, $schema, $errmsg ) = @_ ;
948 $errmsg = "Parameter verification failed. \n " if ! $errmsg ;
950 # todo: cycle detection is only needed for debugging, I guess
951 # we can disable that in the final release
952 # todo: is there a better/faster way to detect cycles?
954 find_cycle
( $instance, sub { $cycles = 1 });
956 add_error
( $errors, undef , "data structure contains recursive cycles" );
958 check_prop
( $instance, $schema, '' , $errors );
961 if ( scalar ( %$errors )) {
962 raise
$errmsg, code
=> HTTP_BAD_REQUEST
, errors
=> $errors ;
968 my $schema_valid_types = [ "string" , "object" , "coderef" , "array" , "boolean" , "number" , "integer" , "null" , "any" ];
969 my $default_schema_noref = {
970 description
=> "This is the JSON Schema for JSON Schemas." ,
971 type
=> [ "object" ],
972 additionalProperties
=> 0 ,
975 type
=> [ "string" , "array" ],
976 description
=> "This is a type definition value. This can be a simple type, or a union type" ,
981 enum
=> $schema_valid_types,
983 enum
=> $schema_valid_types,
987 description
=> "This indicates that the instance property in the instance object is not required." ,
993 description
=> "This is a definition for the properties of an object value" ,
999 description
=> "When the value is an array, this indicates the schema to use to validate each item in an array" ,
1003 additionalProperties
=> {
1004 type
=> [ "boolean" , "object" ],
1005 description
=> "This provides a default property definition for all properties that are not explicitly defined in an object type definition." ,
1012 description
=> "This indicates the minimum value for the instance property when the type of the instance value is a number." ,
1017 description
=> "This indicates the maximum value for the instance property when the type of the instance value is a number." ,
1021 description
=> "When the instance value is a string, this indicates minimum length of the string" ,
1028 description
=> "When the instance value is a string, this indicates maximum length of the string." ,
1034 description
=> "A text representation of the type (used to generate documentation)." ,
1039 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." ,
1046 description
=> "This provides an enumeration of possible values that are valid for the instance property." ,
1051 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)." ,
1053 verbose_description
=> {
1056 description
=> "This provides a more verbose description." ,
1058 format_description
=> {
1061 description
=> "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings." ,
1066 description
=> "This provides the title of the property" ,
1069 type
=> [ "string" , "object" ],
1071 description
=> "indicates a required property or a schema that must be validated if this property is present" ,
1074 type
=> [ "string" , "object" ],
1076 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" ,
1081 description
=> "Whether this is the default key in a comma separated list property string." ,
1086 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." ,
1091 description
=> "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'." ,
1092 requires
=> 'alias' ,
1097 description
=> "This indicates the default for the instance property."
1101 description
=> "Bash completion function. This function should return a list of possible values." ,
1107 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." ,
1112 description
=> "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also." ,
1115 # this is from hyper schema
1118 description
=> "This defines the link relations of the instance objects" ,
1125 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" ,
1129 description
=> "This is the name of the link relation" ,
1135 description
=> "For submission links, this defines the method that should be used to access the target resource" ,
1144 description
=> "For CLI context, this defines the maximal width to print before truncating" ,
1150 my $default_schema = Storable
:: dclone
( $default_schema_noref );
1152 $default_schema ->{ properties
}->{ properties
}->{ additionalProperties
} = $default_schema ;
1153 $default_schema ->{ properties
}->{ additionalProperties
}->{ properties
} = $default_schema ->{ properties
};
1155 $default_schema ->{ properties
}->{ items
}->{ properties
} = $default_schema ->{ properties
};
1156 $default_schema ->{ properties
}->{ items
}->{ additionalProperties
} = 0 ;
1158 $default_schema ->{ properties
}->{ disallow
}->{ properties
} = $default_schema ->{ properties
};
1159 $default_schema ->{ properties
}->{ disallow
}->{ additionalProperties
} = 0 ;
1161 $default_schema ->{ properties
}->{ requires
}->{ properties
} = $default_schema ->{ properties
};
1162 $default_schema ->{ properties
}->{ requires
}->{ additionalProperties
} = 0 ;
1164 $default_schema ->{ properties
}->{ extends
}->{ properties
} = $default_schema ->{ properties
};
1165 $default_schema ->{ properties
}->{ extends
}->{ additionalProperties
} = 0 ;
1167 my $method_schema = {
1169 additionalProperties
=> 0 ,
1172 description
=> "This a description of the method" ,
1177 description
=> "This indicates the name of the function to call." ,
1180 additionalProperties
=> 1 ,
1195 description
=> "The HTTP method name." ,
1196 enum
=> [ 'GET' , 'POST' , 'PUT' , 'DELETE' ],
1201 description
=> "Method needs special privileges - only pvedaemon can execute it" ,
1206 description
=> "Method downloads the file content (filename is the return value of the method)." ,
1211 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter." ,
1214 proxyto_callback
=> {
1216 description
=> "A function which is called to resolve the proxyto attribute. The default implementaion returns the value of the 'proxyto' parameter." ,
1221 description
=> "Required access permissions. By default only 'root' is allowed to access this method." ,
1223 additionalProperties
=> 0 ,
1226 description
=> "Describe access permissions." ,
1230 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials." ,
1232 enum
=> [ 'all' , 'world' ],
1236 description
=> "Array of permission checks (prefix notation)." ,
1243 description
=> "Used internally" ,
1247 description
=> "Used internally" ,
1252 description
=> "path for URL matching (uri template)" ,
1254 fragmentDelimiter
=> {
1256 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." ,
1261 description
=> "JSON Schema for parameters." ,
1266 description
=> "JSON Schema for return value." ,
1271 description
=> "method implementaion (code reference)" ,
1276 description
=> "Delegate call to this class (perl class string)." ,
1279 additionalProperties
=> 0 ,
1285 fragmentDelimiter
=> { optional
=> 1 }
1293 sub validate_schema
{
1296 my $errmsg = "internal error - unable to verify schema \n " ;
1297 validate
( $schema, $default_schema, $errmsg );
1300 sub validate_method_info
{
1303 my $errmsg = "internal error - unable to verify method info \n " ;
1304 validate
( $info, $method_schema, $errmsg );
1306 validate_schema
( $info ->{ parameters
}) if $info ->{ parameters
};
1307 validate_schema
( $info ->{ returns
}) if $info ->{ returns
};
1310 # run a self test on load
1311 # make sure we can verify the default schema
1312 validate_schema
( $default_schema_noref );
1313 validate_schema
( $method_schema );
1315 # and now some utility methods (used by pve api)
1316 sub method_get_child_link
{
1319 return undef if ! $info ;
1321 my $schema = $info ->{ returns
};
1322 return undef if ! $schema || ! $schema ->{ type
} || $schema ->{ type
} ne 'array' ;
1324 my $links = $schema ->{ links
};
1325 return undef if ! $links ;
1328 foreach my $lnk ( @$links ) {
1329 if ( $lnk ->{ href
} && $lnk ->{ rel
} && ( $lnk ->{ rel
} eq 'child' )) {
1338 # a way to parse command line parameters, using a
1339 # schema to configure Getopt::Long
1341 my ( $schema, $args, $arg_param, $fixed_param, $pwcallback, $param_mapping_hash ) = @_ ;
1343 if (! $schema || ! $schema ->{ properties
}) {
1344 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1345 if scalar ( @$args ) != 0 ;
1350 if ( $arg_param && ! ref ( $arg_param )) {
1351 my $pd = $schema ->{ properties
}->{ $arg_param };
1352 die "expected list format $pd ->{format}"
1353 if !( $pd && $pd ->{ format
} && $pd ->{ format
} =~ m/-list/ );
1354 $list_param = $arg_param ;
1357 my @interactive = ();
1359 foreach my $prop ( keys %{ $schema ->{ properties
}}) {
1360 my $pd = $schema ->{ properties
}->{ $prop };
1361 next if $list_param && $prop eq $list_param ;
1362 next if defined ( $fixed_param ->{ $prop });
1364 my $mapping = $param_mapping_hash ->{ $prop };
1365 if ( $mapping && $mapping ->{ interactive
}) {
1366 # interactive parameters such as passwords: make the argument
1367 # optional and call the mapping function afterwards.
1368 push @getopt, " $prop :s" ;
1369 push @interactive, [ $prop, $mapping ->{ func
}];
1370 } elsif ( $prop eq 'password' && $pwcallback ) {
1371 # we do not accept plain password on input line, instead
1372 # we turn this into a boolean option and ask for password below
1373 # using $pwcallback() (for security reasons).
1374 push @getopt, " $prop " ;
1375 } elsif ( $pd ->{ type
} eq 'boolean' ) {
1376 push @getopt, " $prop :s" ;
1378 if ( $pd ->{ format
} && $pd ->{ format
} =~ m/-a?list/ ) {
1379 push @getopt, " $prop =s@" ;
1381 push @getopt, " $prop =s" ;
1386 Getopt
:: Long
:: Configure
( 'prefix_pattern=(--|-)' );
1389 raise
( "unable to parse option \n " , code
=> HTTP_BAD_REQUEST
)
1390 if ! Getopt
:: Long
:: GetOptionsFromArray
( $args, $opts, @getopt );
1394 $opts ->{ $list_param } = $args ;
1396 } elsif ( ref ( $arg_param )) {
1397 foreach my $arg_name ( @$arg_param ) {
1398 if ( $opts ->{ 'extra-args' }) {
1399 raise
( "internal error: extra-args must be the last argument \n " , code
=> HTTP_BAD_REQUEST
);
1401 if ( $arg_name eq 'extra-args' ) {
1402 $opts ->{ 'extra-args' } = $args ;
1406 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
) if ! @$args ;
1407 $opts ->{ $arg_name } = shift @$args ;
1409 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
) if @$args ;
1411 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1412 if scalar ( @$args ) != 0 ;
1415 if ( ref ( $arg_param )) {
1416 foreach my $arg_name ( @$arg_param ) {
1417 if ( $arg_name eq 'extra-args' ) {
1418 $opts ->{ 'extra-args' } = [];
1420 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
);
1426 if ( my $pd = $schema ->{ properties
}->{ password
}) {
1427 if ( $pd ->{ type
} ne 'boolean' && $pwcallback ) {
1428 if ( $opts ->{ password
} || ! $pd ->{ optional
}) {
1429 $opts ->{ password
} = & $pwcallback ();
1434 foreach my $entry ( @interactive ) {
1435 my ( $opt, $func ) = @$entry ;
1436 my $pd = $schema ->{ properties
}->{ $opt };
1437 my $value = $opts ->{ $opt };
1438 if ( defined ( $value ) || ! $pd ->{ optional
}) {
1439 $opts ->{ $opt } = $func ->( $value );
1443 # decode after Getopt as we are not sure how well it handles unicode
1444 foreach my $p ( keys %$opts ) {
1445 if (! ref ( $opts ->{ $p })) {
1446 $opts ->{ $p } = decode
( 'locale' , $opts ->{ $p });
1447 } elsif ( ref ( $opts ->{ $p }) eq 'ARRAY' ) {
1449 foreach my $v (@{ $opts ->{ $p }}) {
1450 push @$tmp, decode
( 'locale' , $v );
1453 } elsif ( ref ( $opts ->{ $p }) eq 'SCALAR' ) {
1454 $opts ->{ $p } = decode
( 'locale' , $$opts ->{ $p });
1456 raise
( "decoding options failed, unknown reference \n " , code
=> HTTP_BAD_REQUEST
);
1460 foreach my $p ( keys %$opts ) {
1461 if ( my $pd = $schema ->{ properties
}->{ $p }) {
1462 if ( $pd ->{ type
} eq 'boolean' ) {
1463 if ( $opts ->{ $p } eq '' ) {
1465 } elsif ( defined ( my $bool = parse_boolean
( $opts ->{ $p }))) {
1466 $opts ->{ $p } = $bool ;
1468 raise
( "unable to parse boolean option \n " , code
=> HTTP_BAD_REQUEST
);
1470 } elsif ( $pd ->{ format
}) {
1472 if ( $pd ->{ format
} =~ m/-list/ ) {
1473 # allow --vmid 100 --vmid 101 and --vmid 100,101
1474 # allow --dow mon --dow fri and --dow mon,fri
1475 $opts ->{ $p } = join ( "," , @{ $opts ->{ $p }}) if ref ( $opts ->{ $p }) eq 'ARRAY' ;
1476 } elsif ( $pd ->{ format
} =~ m/-alist/ ) {
1477 # we encode array as \0 separated strings
1478 # Note: CGI.pm also use this encoding
1479 if ( scalar (@{ $opts ->{ $p }}) != 1 ) {
1480 $opts ->{ $p } = join ( "\0" , @{ $opts ->{ $p }});
1482 # st that split_list knows it is \0 terminated
1483 my $v = $opts ->{ $p }->[ 0 ];
1484 $opts ->{ $p } = " $v\0 " ;
1491 foreach my $p ( keys %$fixed_param ) {
1492 $opts ->{ $p } = $fixed_param ->{ $p };
1498 # A way to parse configuration data by giving a json schema
1500 my ( $schema, $filename, $raw ) = @_ ;
1502 # do fast check (avoid validate_schema($schema))
1503 die "got strange schema" if ! $schema ->{ type
} ||
1504 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1508 while ( $raw =~ /^\s*(.+?)\s*$/gm ) {
1511 next if $line =~ /^#/ ;
1513 if ( $line =~ m/^(\S+?):\s*(.*)$/ ) {
1516 if ( $schema ->{ properties
}->{ $key } &&
1517 $schema ->{ properties
}->{ $key }->{ type
} eq 'boolean' ) {
1519 $value = parse_boolean
( $value ) // $value ;
1521 $cfg ->{ $key } = $value ;
1523 warn "ignore config line: $line\n "
1528 check_prop
( $cfg, $schema, '' , $errors );
1530 foreach my $k ( keys %$errors ) {
1531 warn "parse error in ' $filename ' - ' $k ': $errors ->{ $k } \n " ;
1538 # generate simple key/value file
1540 my ( $schema, $filename, $cfg ) = @_ ;
1542 # do fast check (avoid validate_schema($schema))
1543 die "got strange schema" if ! $schema ->{ type
} ||
1544 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1546 validate
( $cfg, $schema, "validation error in ' $filename ' \n " );
1550 foreach my $k ( keys %$cfg ) {
1551 $data .= " $k : $cfg ->{ $k } \n " ;
1557 # helpers used to generate our manual pages
1559 my $find_schema_default_key = sub {
1563 my $keyAliasProps = {};
1565 foreach my $key ( keys %$format ) {
1566 my $phash = $format ->{ $key };
1567 if ( $phash ->{ default_key
}) {
1568 die "multiple default keys in schema ( $default_key, $key ) \n "
1569 if defined ( $default_key );
1570 die "default key ' $key ' is an alias - this is not allowed \n "
1571 if defined ( $phash ->{ alias
});
1572 die "default key ' $key ' with keyAlias attribute is not allowed \n "
1573 if $phash ->{ keyAlias
};
1574 $default_key = $key ;
1576 my $key_alias = $phash ->{ keyAlias
};
1577 die "found keyAlias without 'alias definition for ' $key ' \n "
1578 if $key_alias && ! $phash ->{ alias
};
1580 if ( $phash ->{ alias
} && $key_alias ) {
1581 die "inconsistent keyAlias ' $key_alias ' definition"
1582 if defined ( $keyAliasProps ->{ $key_alias }) &&
1583 $keyAliasProps ->{ $key_alias } ne $phash ->{ alias
};
1584 $keyAliasProps ->{ $key_alias } = $phash ->{ alias
};
1588 return wantarray ?
( $default_key, $keyAliasProps ) : $default_key ;
1591 sub generate_typetext
{
1592 my ( $format, $list_enums ) = @_ ;
1594 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1599 my $add_option_string = sub {
1600 my ( $text, $optional ) = @_ ;
1606 $text = "[ $text ]" if $optional ;
1611 my $format_key_value = sub {
1612 my ( $key, $phash ) = @_ ;
1614 die "internal error" if defined ( $phash ->{ alias
});
1620 if ( my $desc = $phash ->{ format_description
}) {
1621 $typetext .= "< $desc >" ;
1622 } elsif ( my $text = $phash ->{ typetext
}) {
1624 } elsif ( my $enum = $phash ->{ enum
}) {
1625 if ( $list_enums || ( scalar ( @$enum ) <= 3 )) {
1626 $typetext .= '<' . join ( '|' , @$enum ) . '>' ;
1628 $typetext .= '<enum>' ;
1630 } elsif ( $phash ->{ type
} eq 'boolean' ) {
1631 $typetext .= '<1|0>' ;
1632 } elsif ( $phash ->{ type
} eq 'integer' ) {
1633 $typetext .= '<integer>' ;
1634 } elsif ( $phash ->{ type
} eq 'number' ) {
1635 $typetext .= '<number>' ;
1637 die "internal error: neither format_description nor typetext found for option ' $key '" ;
1640 if ( defined ( $default_key ) && ( $default_key eq $key )) {
1641 & $add_option_string ( "[ $keytext =] $typetext " , $phash ->{ optional
});
1643 & $add_option_string ( " $keytext = $typetext " , $phash ->{ optional
});
1649 my $cond_add_key = sub {
1652 return if $done ->{ $key }; # avoid duplicates
1656 my $phash = $format ->{ $key };
1658 return if ! $phash ; # should not happen
1660 return if $phash ->{ alias
};
1662 & $format_key_value ( $key, $phash );
1666 & $cond_add_key ( $default_key ) if defined ( $default_key );
1668 # add required keys first
1669 foreach my $key ( sort keys %$format ) {
1670 my $phash = $format ->{ $key };
1671 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1675 foreach my $key ( sort keys %$format ) {
1676 & $cond_add_key ( $key );
1679 foreach my $keyAlias ( sort keys %$keyAliasProps ) {
1680 & $add_option_string ( "< $keyAlias >=< $keyAliasProps ->{ $keyAlias }>" , 1 );
1686 sub print_property_string
{
1687 my ( $data, $format, $skip, $path ) = @_ ;
1689 if ( ref ( $format ) ne 'HASH' ) {
1690 my $schema = get_format
( $format );
1691 die "not a valid format: $format\n " if ! $schema ;
1696 check_object
( $path, $format, $data, undef , $errors );
1697 if ( scalar ( %$errors )) {
1698 raise
"format error" , errors
=> $errors ;
1701 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1706 my $add_option_string = sub {
1709 $res .= ',' if $add_sep ;
1714 my $format_value = sub {
1715 my ( $key, $value, $format ) = @_ ;
1717 if ( defined ( $format ) && ( $format eq 'disk-size' )) {
1718 return format_size
( $value );
1720 die "illegal value with commas for $key\n " if $value =~ /,/ ;
1725 my $done = { map { $_ => 1 } @$skip };
1727 my $cond_add_key = sub {
1728 my ( $key, $isdefault ) = @_ ;
1730 return if $done ->{ $key }; # avoid duplicates
1734 my $value = $data ->{ $key };
1736 return if ! defined ( $value );
1738 my $phash = $format ->{ $key };
1740 # try to combine values if we have key aliases
1741 if ( my $combine = $keyAliasProps ->{ $key }) {
1742 if ( defined ( my $combine_value = $data ->{ $combine })) {
1743 my $combine_format = $format ->{ $combine }->{ format
};
1744 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1745 my $combine_str = & $format_value ( $combine, $combine_value, $combine_format );
1746 & $add_option_string ( "${value_str}=${combine_str}" );
1747 $done ->{ $combine } = 1 ;
1752 if ( $phash && $phash ->{ alias
}) {
1753 $phash = $format ->{ $phash ->{ alias
}};
1756 die "invalid key ' $key ' \n " if ! $phash ;
1757 die "internal error" if defined ( $phash ->{ alias
});
1759 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1761 & $add_option_string ( $value_str );
1763 & $add_option_string ( " $key =${value_str}" );
1767 # add default key first
1768 & $cond_add_key ( $default_key, 1 ) if defined ( $default_key );
1770 # add required keys first
1771 foreach my $key ( sort keys %$data ) {
1772 my $phash = $format ->{ $key };
1773 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1777 foreach my $key ( sort keys %$data ) {
1778 & $cond_add_key ( $key );
1784 sub schema_get_type_text
{
1785 my ( $phash, $style ) = @_ ;
1787 my $type = $phash ->{ type
} || 'string' ;
1789 if ( $phash ->{ typetext
}) {
1790 return $phash ->{ typetext
};
1791 } elsif ( $phash ->{ format_description
}) {
1792 return "< $phash ->{format_description}>" ;
1793 } elsif ( $phash ->{ enum
}) {
1794 return "<" . join ( ' | ' , sort @{ $phash ->{ enum
}}) . ">" ;
1795 } elsif ( $phash ->{ pattern
}) {
1796 return $phash ->{ pattern
};
1797 } elsif ( $type eq 'integer' || $type eq 'number' ) {
1798 # NOTE: always access values as number (avoid converion to string)
1799 if ( defined ( $phash ->{ minimum
}) && defined ( $phash ->{ maximum
})) {
1800 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - " .
1801 ( $phash ->{ maximum
} + 0 ) . ")" ;
1802 } elsif ( defined ( $phash ->{ minimum
})) {
1803 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - N)" ;
1804 } elsif ( defined ( $phash ->{ maximum
})) {
1805 return "< $type > (-N - " . ( $phash ->{ maximum
} + 0 ) . ")" ;
1807 } elsif ( $type eq 'string' ) {
1808 if ( my $format = $phash ->{ format
}) {
1809 $format = get_format
( $format ) if ref ( $format ) ne 'HASH' ;
1810 if ( ref ( $format ) eq 'HASH' ) {
1812 $list_enums = 1 if $style && $style eq 'config-sub' ;
1813 return generate_typetext
( $format, $list_enums );