]>
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 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
:: APIClient
:: 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
:: APIClient
:: 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" ,
1145 my $default_schema = Storable
:: dclone
( $default_schema_noref );
1147 $default_schema ->{ properties
}->{ properties
}->{ additionalProperties
} = $default_schema ;
1148 $default_schema ->{ properties
}->{ additionalProperties
}->{ properties
} = $default_schema ->{ properties
};
1150 $default_schema ->{ properties
}->{ items
}->{ properties
} = $default_schema ->{ properties
};
1151 $default_schema ->{ properties
}->{ items
}->{ additionalProperties
} = 0 ;
1153 $default_schema ->{ properties
}->{ disallow
}->{ properties
} = $default_schema ->{ properties
};
1154 $default_schema ->{ properties
}->{ disallow
}->{ additionalProperties
} = 0 ;
1156 $default_schema ->{ properties
}->{ requires
}->{ properties
} = $default_schema ->{ properties
};
1157 $default_schema ->{ properties
}->{ requires
}->{ additionalProperties
} = 0 ;
1159 $default_schema ->{ properties
}->{ extends
}->{ properties
} = $default_schema ->{ properties
};
1160 $default_schema ->{ properties
}->{ extends
}->{ additionalProperties
} = 0 ;
1162 my $method_schema = {
1164 additionalProperties
=> 0 ,
1167 description
=> "This a description of the method" ,
1172 description
=> "This indicates the name of the function to call." ,
1175 additionalProperties
=> 1 ,
1190 description
=> "The HTTP method name." ,
1191 enum
=> [ 'GET' , 'POST' , 'PUT' , 'DELETE' ],
1196 description
=> "Method needs special privileges - only pvedaemon can execute it" ,
1201 description
=> "Method downloads the file content (filename is the return value of the method)." ,
1206 description
=> "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter." ,
1209 proxyto_callback
=> {
1211 description
=> "A function which is called to resolve the proxyto attribute. The default implementaion returns the value of the 'proxyto' parameter." ,
1216 description
=> "Required access permissions. By default only 'root' is allowed to access this method." ,
1218 additionalProperties
=> 0 ,
1221 description
=> "Describe access permissions." ,
1225 description
=> "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials." ,
1227 enum
=> [ 'all' , 'world' ],
1231 description
=> "Array of permission checks (prefix notation)." ,
1238 description
=> "Used internally" ,
1242 description
=> "Used internally" ,
1247 description
=> "path for URL matching (uri template)" ,
1249 fragmentDelimiter
=> {
1251 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." ,
1256 description
=> "JSON Schema for parameters." ,
1261 description
=> "JSON Schema for return value." ,
1266 description
=> "method implementaion (code reference)" ,
1271 description
=> "Delegate call to this class (perl class string)." ,
1274 additionalProperties
=> 0 ,
1280 fragmentDelimiter
=> { optional
=> 1 }
1288 sub validate_schema
{
1291 my $errmsg = "internal error - unable to verify schema \n " ;
1292 validate
( $schema, $default_schema, $errmsg );
1295 sub validate_method_info
{
1298 my $errmsg = "internal error - unable to verify method info \n " ;
1299 validate
( $info, $method_schema, $errmsg );
1301 validate_schema
( $info ->{ parameters
}) if $info ->{ parameters
};
1302 validate_schema
( $info ->{ returns
}) if $info ->{ returns
};
1305 # run a self test on load
1306 # make sure we can verify the default schema
1307 validate_schema
( $default_schema_noref );
1308 validate_schema
( $method_schema );
1310 # and now some utility methods (used by pve api)
1311 sub method_get_child_link
{
1314 return undef if ! $info ;
1316 my $schema = $info ->{ returns
};
1317 return undef if ! $schema || ! $schema ->{ type
} || $schema ->{ type
} ne 'array' ;
1319 my $links = $schema ->{ links
};
1320 return undef if ! $links ;
1323 foreach my $lnk ( @$links ) {
1324 if ( $lnk ->{ href
} && $lnk ->{ rel
} && ( $lnk ->{ rel
} eq 'child' )) {
1333 # a way to parse command line parameters, using a
1334 # schema to configure Getopt::Long
1336 my ( $schema, $args, $arg_param, $fixed_param, $pwcallback, $param_mapping_hash ) = @_ ;
1338 if (! $schema || ! $schema ->{ properties
}) {
1339 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1340 if scalar ( @$args ) != 0 ;
1345 if ( $arg_param && ! ref ( $arg_param )) {
1346 my $pd = $schema ->{ properties
}->{ $arg_param };
1347 die "expected list format $pd ->{format}"
1348 if !( $pd && $pd ->{ format
} && $pd ->{ format
} =~ m/-list/ );
1349 $list_param = $arg_param ;
1352 my @interactive = ();
1354 foreach my $prop ( keys %{ $schema ->{ properties
}}) {
1355 my $pd = $schema ->{ properties
}->{ $prop };
1356 next if $list_param && $prop eq $list_param ;
1357 next if defined ( $fixed_param ->{ $prop });
1359 my $mapping = $param_mapping_hash ->{ $prop };
1360 if ( $mapping && $mapping ->{ interactive
}) {
1361 # interactive parameters such as passwords: make the argument
1362 # optional and call the mapping function afterwards.
1363 push @getopt, " $prop :s" ;
1364 push @interactive, [ $prop, $mapping ->{ func
}];
1365 } elsif ( $prop eq 'password' && $pwcallback ) {
1366 # we do not accept plain password on input line, instead
1367 # we turn this into a boolean option and ask for password below
1368 # using $pwcallback() (for security reasons).
1369 push @getopt, " $prop " ;
1370 } elsif ( $pd ->{ type
} eq 'boolean' ) {
1371 push @getopt, " $prop :s" ;
1373 if ( $pd ->{ format
} && $pd ->{ format
} =~ m/-a?list/ ) {
1374 push @getopt, " $prop =s@" ;
1376 push @getopt, " $prop =s" ;
1381 Getopt
:: Long
:: Configure
( 'prefix_pattern=(--|-)' );
1384 raise
( "unable to parse option \n " , code
=> HTTP_BAD_REQUEST
)
1385 if ! Getopt
:: Long
:: GetOptionsFromArray
( $args, $opts, @getopt );
1389 $opts ->{ $list_param } = $args ;
1391 } elsif ( ref ( $arg_param )) {
1392 foreach my $arg_name ( @$arg_param ) {
1393 if ( $opts ->{ 'extra-args' }) {
1394 raise
( "internal error: extra-args must be the last argument \n " , code
=> HTTP_BAD_REQUEST
);
1396 if ( $arg_name eq 'extra-args' ) {
1397 $opts ->{ 'extra-args' } = $args ;
1401 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
) if ! @$args ;
1402 $opts ->{ $arg_name } = shift @$args ;
1404 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
) if @$args ;
1406 raise
( "too many arguments \n " , code
=> HTTP_BAD_REQUEST
)
1407 if scalar ( @$args ) != 0 ;
1410 if ( ref ( $arg_param )) {
1411 foreach my $arg_name ( @$arg_param ) {
1412 if ( $arg_name eq 'extra-args' ) {
1413 $opts ->{ 'extra-args' } = [];
1415 raise
( "not enough arguments \n " , code
=> HTTP_BAD_REQUEST
);
1421 if ( my $pd = $schema ->{ properties
}->{ password
}) {
1422 if ( $pd ->{ type
} ne 'boolean' && $pwcallback ) {
1423 if ( $opts ->{ password
} || ! $pd ->{ optional
}) {
1424 $opts ->{ password
} = & $pwcallback ();
1429 foreach my $entry ( @interactive ) {
1430 my ( $opt, $func ) = @$entry ;
1431 my $pd = $schema ->{ properties
}->{ $opt };
1432 my $value = $opts ->{ $opt };
1433 if ( defined ( $value ) || ! $pd ->{ optional
}) {
1434 $opts ->{ $opt } = $func ->( $value );
1438 # decode after Getopt as we are not sure how well it handles unicode
1439 foreach my $p ( keys %$opts ) {
1440 if (! ref ( $opts ->{ $p })) {
1441 $opts ->{ $p } = decode
( 'locale' , $opts ->{ $p });
1442 } elsif ( ref ( $opts ->{ $p }) eq 'ARRAY' ) {
1444 foreach my $v (@{ $opts ->{ $p }}) {
1445 push @$tmp, decode
( 'locale' , $v );
1448 } elsif ( ref ( $opts ->{ $p }) eq 'SCALAR' ) {
1449 $opts ->{ $p } = decode
( 'locale' , $$opts ->{ $p });
1451 raise
( "decoding options failed, unknown reference \n " , code
=> HTTP_BAD_REQUEST
);
1455 foreach my $p ( keys %$opts ) {
1456 if ( my $pd = $schema ->{ properties
}->{ $p }) {
1457 if ( $pd ->{ type
} eq 'boolean' ) {
1458 if ( $opts ->{ $p } eq '' ) {
1460 } elsif ( defined ( my $bool = parse_boolean
( $opts ->{ $p }))) {
1461 $opts ->{ $p } = $bool ;
1463 raise
( "unable to parse boolean option \n " , code
=> HTTP_BAD_REQUEST
);
1465 } elsif ( $pd ->{ format
}) {
1467 if ( $pd ->{ format
} =~ m/-list/ ) {
1468 # allow --vmid 100 --vmid 101 and --vmid 100,101
1469 # allow --dow mon --dow fri and --dow mon,fri
1470 $opts ->{ $p } = join ( "," , @{ $opts ->{ $p }}) if ref ( $opts ->{ $p }) eq 'ARRAY' ;
1471 } elsif ( $pd ->{ format
} =~ m/-alist/ ) {
1472 # we encode array as \0 separated strings
1473 # Note: CGI.pm also use this encoding
1474 if ( scalar (@{ $opts ->{ $p }}) != 1 ) {
1475 $opts ->{ $p } = join ( "\0" , @{ $opts ->{ $p }});
1477 # st that split_list knows it is \0 terminated
1478 my $v = $opts ->{ $p }->[ 0 ];
1479 $opts ->{ $p } = " $v\0 " ;
1486 foreach my $p ( keys %$fixed_param ) {
1487 $opts ->{ $p } = $fixed_param ->{ $p };
1493 # A way to parse configuration data by giving a json schema
1495 my ( $schema, $filename, $raw ) = @_ ;
1497 # do fast check (avoid validate_schema($schema))
1498 die "got strange schema" if ! $schema ->{ type
} ||
1499 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1503 while ( $raw =~ /^\s*(.+?)\s*$/gm ) {
1506 next if $line =~ /^#/ ;
1508 if ( $line =~ m/^(\S+?):\s*(.*)$/ ) {
1511 if ( $schema ->{ properties
}->{ $key } &&
1512 $schema ->{ properties
}->{ $key }->{ type
} eq 'boolean' ) {
1514 $value = parse_boolean
( $value ) // $value ;
1516 $cfg ->{ $key } = $value ;
1518 warn "ignore config line: $line\n "
1523 check_prop
( $cfg, $schema, '' , $errors );
1525 foreach my $k ( keys %$errors ) {
1526 warn "parse error in ' $filename ' - ' $k ': $errors ->{ $k } \n " ;
1533 # generate simple key/value file
1535 my ( $schema, $filename, $cfg ) = @_ ;
1537 # do fast check (avoid validate_schema($schema))
1538 die "got strange schema" if ! $schema ->{ type
} ||
1539 ! $schema ->{ properties
} || $schema ->{ type
} ne 'object' ;
1541 validate
( $cfg, $schema, "validation error in ' $filename ' \n " );
1545 foreach my $k ( keys %$cfg ) {
1546 $data .= " $k : $cfg ->{ $k } \n " ;
1552 # helpers used to generate our manual pages
1554 my $find_schema_default_key = sub {
1558 my $keyAliasProps = {};
1560 foreach my $key ( keys %$format ) {
1561 my $phash = $format ->{ $key };
1562 if ( $phash ->{ default_key
}) {
1563 die "multiple default keys in schema ( $default_key, $key ) \n "
1564 if defined ( $default_key );
1565 die "default key ' $key ' is an alias - this is not allowed \n "
1566 if defined ( $phash ->{ alias
});
1567 die "default key ' $key ' with keyAlias attribute is not allowed \n "
1568 if $phash ->{ keyAlias
};
1569 $default_key = $key ;
1571 my $key_alias = $phash ->{ keyAlias
};
1572 die "found keyAlias without 'alias definition for ' $key ' \n "
1573 if $key_alias && ! $phash ->{ alias
};
1575 if ( $phash ->{ alias
} && $key_alias ) {
1576 die "inconsistent keyAlias ' $key_alias ' definition"
1577 if defined ( $keyAliasProps ->{ $key_alias }) &&
1578 $keyAliasProps ->{ $key_alias } ne $phash ->{ alias
};
1579 $keyAliasProps ->{ $key_alias } = $phash ->{ alias
};
1583 return wantarray ?
( $default_key, $keyAliasProps ) : $default_key ;
1586 sub generate_typetext
{
1587 my ( $format, $list_enums ) = @_ ;
1589 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1594 my $add_option_string = sub {
1595 my ( $text, $optional ) = @_ ;
1601 $text = "[ $text ]" if $optional ;
1606 my $format_key_value = sub {
1607 my ( $key, $phash ) = @_ ;
1609 die "internal error" if defined ( $phash ->{ alias
});
1615 if ( my $desc = $phash ->{ format_description
}) {
1616 $typetext .= "< $desc >" ;
1617 } elsif ( my $text = $phash ->{ typetext
}) {
1619 } elsif ( my $enum = $phash ->{ enum
}) {
1620 if ( $list_enums || ( scalar ( @$enum ) <= 3 )) {
1621 $typetext .= '<' . join ( '|' , @$enum ) . '>' ;
1623 $typetext .= '<enum>' ;
1625 } elsif ( $phash ->{ type
} eq 'boolean' ) {
1626 $typetext .= '<1|0>' ;
1627 } elsif ( $phash ->{ type
} eq 'integer' ) {
1628 $typetext .= '<integer>' ;
1629 } elsif ( $phash ->{ type
} eq 'number' ) {
1630 $typetext .= '<number>' ;
1632 die "internal error: neither format_description nor typetext found for option ' $key '" ;
1635 if ( defined ( $default_key ) && ( $default_key eq $key )) {
1636 & $add_option_string ( "[ $keytext =] $typetext " , $phash ->{ optional
});
1638 & $add_option_string ( " $keytext = $typetext " , $phash ->{ optional
});
1644 my $cond_add_key = sub {
1647 return if $done ->{ $key }; # avoid duplicates
1651 my $phash = $format ->{ $key };
1653 return if ! $phash ; # should not happen
1655 return if $phash ->{ alias
};
1657 & $format_key_value ( $key, $phash );
1661 & $cond_add_key ( $default_key ) if defined ( $default_key );
1663 # add required keys first
1664 foreach my $key ( sort keys %$format ) {
1665 my $phash = $format ->{ $key };
1666 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1670 foreach my $key ( sort keys %$format ) {
1671 & $cond_add_key ( $key );
1674 foreach my $keyAlias ( sort keys %$keyAliasProps ) {
1675 & $add_option_string ( "< $keyAlias >=< $keyAliasProps ->{ $keyAlias }>" , 1 );
1681 sub print_property_string
{
1682 my ( $data, $format, $skip, $path ) = @_ ;
1684 if ( ref ( $format ) ne 'HASH' ) {
1685 my $schema = get_format
( $format );
1686 die "not a valid format: $format\n " if ! $schema ;
1691 check_object
( $path, $format, $data, undef , $errors );
1692 if ( scalar ( %$errors )) {
1693 raise
"format error" , errors
=> $errors ;
1696 my ( $default_key, $keyAliasProps ) = & $find_schema_default_key ( $format );
1701 my $add_option_string = sub {
1704 $res .= ',' if $add_sep ;
1709 my $format_value = sub {
1710 my ( $key, $value, $format ) = @_ ;
1712 if ( defined ( $format ) && ( $format eq 'disk-size' )) {
1713 return format_size
( $value );
1715 die "illegal value with commas for $key\n " if $value =~ /,/ ;
1720 my $done = { map { $_ => 1 } @$skip };
1722 my $cond_add_key = sub {
1723 my ( $key, $isdefault ) = @_ ;
1725 return if $done ->{ $key }; # avoid duplicates
1729 my $value = $data ->{ $key };
1731 return if ! defined ( $value );
1733 my $phash = $format ->{ $key };
1735 # try to combine values if we have key aliases
1736 if ( my $combine = $keyAliasProps ->{ $key }) {
1737 if ( defined ( my $combine_value = $data ->{ $combine })) {
1738 my $combine_format = $format ->{ $combine }->{ format
};
1739 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1740 my $combine_str = & $format_value ( $combine, $combine_value, $combine_format );
1741 & $add_option_string ( "${value_str}=${combine_str}" );
1742 $done ->{ $combine } = 1 ;
1747 if ( $phash && $phash ->{ alias
}) {
1748 $phash = $format ->{ $phash ->{ alias
}};
1751 die "invalid key ' $key ' \n " if ! $phash ;
1752 die "internal error" if defined ( $phash ->{ alias
});
1754 my $value_str = & $format_value ( $key, $value, $phash ->{ format
});
1756 & $add_option_string ( $value_str );
1758 & $add_option_string ( " $key =${value_str}" );
1762 # add default key first
1763 & $cond_add_key ( $default_key, 1 ) if defined ( $default_key );
1765 # add required keys first
1766 foreach my $key ( sort keys %$data ) {
1767 my $phash = $format ->{ $key };
1768 & $cond_add_key ( $key ) if $phash && ! $phash ->{ optional
};
1772 foreach my $key ( sort keys %$data ) {
1773 & $cond_add_key ( $key );
1779 sub schema_get_type_text
{
1780 my ( $phash, $style ) = @_ ;
1782 my $type = $phash ->{ type
} || 'string' ;
1784 if ( $phash ->{ typetext
}) {
1785 return $phash ->{ typetext
};
1786 } elsif ( $phash ->{ format_description
}) {
1787 return "< $phash ->{format_description}>" ;
1788 } elsif ( $phash ->{ enum
}) {
1789 return "<" . join ( ' | ' , sort @{ $phash ->{ enum
}}) . ">" ;
1790 } elsif ( $phash ->{ pattern
}) {
1791 return $phash ->{ pattern
};
1792 } elsif ( $type eq 'integer' || $type eq 'number' ) {
1793 # NOTE: always access values as number (avoid converion to string)
1794 if ( defined ( $phash ->{ minimum
}) && defined ( $phash ->{ maximum
})) {
1795 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - " .
1796 ( $phash ->{ maximum
} + 0 ) . ")" ;
1797 } elsif ( defined ( $phash ->{ minimum
})) {
1798 return "< $type > (" . ( $phash ->{ minimum
} + 0 ) . " - N)" ;
1799 } elsif ( defined ( $phash ->{ maximum
})) {
1800 return "< $type > (-N - " . ( $phash ->{ maximum
} + 0 ) . ")" ;
1802 } elsif ( $type eq 'string' ) {
1803 if ( my $format = $phash ->{ format
}) {
1804 $format = get_format
( $format ) if ref ( $format ) ne 'HASH' ;
1805 if ( ref ( $format ) eq 'HASH' ) {
1807 $list_enums = 1 if $style && $style eq 'config-sub' ;
1808 return generate_typetext
( $format, $list_enums );