generate_typetext: better handling of only-optional cases

[pve-common.git] / src / PVE / JSONSchema.pm

diff --git a/src/PVE/JSONSchema.pm b/src/PVE/JSONSchema.pm
index dbe2e3516493350e3ca6509e68529d9916a1b6ab..45ce5ba58c3ad5720bdf727d4615ac2d4b8e34d7 100644 (file)
--- a/src/PVE/JSONSchema.pm
+++ b/src/PVE/JSONSchema.pm
@@ -227,18 +227,62 @@ sub pve_verify_ipv4mask {
     return $mask;
 }
 
-register_format('CIDR', \&pve_verify_cidr);
-sub pve_verify_cidr {
+register_format('CIDRv6', \&pve_verify_cidrv6);
+sub pve_verify_cidrv6 {
     my ($cidr, $noerr) = @_;
 
-    if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 < 32)) {
+    if ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 <= 120)) {
        return $cidr;
-    } elsif ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 <= 120)) {
+    }
+
+    return undef if $noerr;
+    die "value does not look like a valid IPv6 CIDR network\n";
+}
+
+register_format('CIDRv4', \&pve_verify_cidrv4);
+sub pve_verify_cidrv4 {
+    my ($cidr, $noerr) = @_;
+
+    if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 < 32)) {
        return $cidr;
     }
 
     return undef if $noerr;
-    die "value does not look like a valid CIDR network\n";
+    die "value does not look like a valid IPv4 CIDR network\n";
+}
+
+register_format('CIDR', \&pve_verify_cidr);
+sub pve_verify_cidr {
+    my ($cidr, $noerr) = @_;
+
+    if (!(pve_verify_cidrv4($cidr, 1) ||
+         pve_verify_cidrv6($cidr, 1)))
+    {
+       return undef if $noerr;
+       die "value does not look like a valid CIDR network\n";
+    }
+
+    return $cidr;
+}
+
+register_format('pve-ipv4-config', \&pve_verify_ipv4_config);
+sub pve_verify_ipv4_config {
+    my ($config, $noerr) = @_;
+
+    return $config if $config =~ /^(?:dhcp|manual)$/ ||
+                      pve_verify_cidrv4($config, 1);
+    return undef if $noerr;
+    die "value does not look like a valid ipv4 network configuration\n";
+}
+
+register_format('pve-ipv6-config', \&pve_verify_ipv6_config);
+sub pve_verify_ipv6_config {
+    my ($config, $noerr) = @_;
+
+    return $config if $config =~ /^(?:auto|dhcp|manual)$/ ||
+                      pve_verify_cidrv6($config, 1);
+    return undef if $noerr;
+    die "value does not look like a valid ipv6 network configuration\n";
 }
 
 register_format('email', \&pve_verify_email);
@@ -563,6 +607,19 @@ sub check_object {
     }
 }
 
+sub check_object_warn {
+    my ($path, $schema, $value, $additional_properties) = @_;
+    my $errors = {};
+    check_object($path, $schema, $value, $additional_properties, $errors);
+    if (scalar(%$errors)) {
+       foreach my $k (keys %$errors) {
+           warn "parse error: $k: $errors->{$k}\n";
+       }
+       return 0;
+    }
+    return 1;
+}
+
 sub check_prop {
     my ($value, $schema, $path, $errors) = @_;
 
@@ -797,6 +854,11 @@ my $default_schema_noref = {
            optional => 1,
            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).",
        },
+       format_description => {
+           type => "string",
+           optional => 1,
+           description => "This provides a shorter (usually just one word) description for a property used to generate descriptions for comma separated list property strings.",
+       },
         title => {
            type => "string",
            optional => 1,
@@ -1227,4 +1289,41 @@ sub dump_config {
     return $data;
 }
 
+sub generate_typetext {
+    my ($schema) = @_;
+    my $typetext = '';
+    my (@optional, @required);
+    foreach my $key (sort keys %$schema) {
+       next if !$schema->{$key}->{format_description} &&
+               !$schema->{$key}->{typetext};
+       if ($schema->{$key}->{optional}) {
+           push @optional, $key;
+       } else {
+           push @required, $key;
+       }
+    }
+    my ($pre, $post) = ('', '');
+    my $add = sub {
+       my ($key) = @_;
+       if (my $desc = $schema->{$key}->{format_description}) {
+           $typetext .= "$pre$key=<$desc>$post";
+       } elsif (my $text = $schema->{$key}->{typetext}) {
+           $typetext .= "$pre$text$post";
+       } else {
+           die "internal error: neither format_description nor typetext found";
+       }
+    };
+    foreach my $key (@required) {
+       &$add($key);
+       $pre = ', ';
+    }
+    $pre = $pre ? ' [,' : '[';
+    $post = ']';
+    foreach my $key (@optional) {
+       &$add($key);
+       $pre = ' [,';
+    }
+    return $typetext;
+}
+
 1;