Added JSONSchema::parse_property_string

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

diff --git a/src/PVE/JSONSchema.pm b/src/PVE/JSONSchema.pm
index e392f5898612331464d582bb90a73846dd525821..d900a69031539cbdcb81a5444022508b099d7677 100644 (file)
--- a/src/PVE/JSONSchema.pm
+++ b/src/PVE/JSONSchema.pm
@@ -227,18 +227,62 @@ sub pve_verify_ipv4mask {
     return $mask;
 }
 
     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) = @_;
 
     my ($cidr, $noerr) = @_;
 

-    if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 < 32)) {
+    if ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 <= 120)) {

        return $cidr;
        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;
        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);
 }
 
 register_format('email', \&pve_verify_email);


@@ -387,6 +431,51 @@ sub check_format {
     }
 } 
 
     }
 } 
 

+sub parse_property_string {
+    my ($format, $data, $path) = @_;
+
+    my $default_key;
+
+    my $res = {};
+    foreach my $part (split(/,/, $data)) {
+       next if $part =~ /^\s*$/;
+
+       if ($part =~ /^([^=]+)=(.+)$/) {
+           my ($k, $v) = ($1, $2);
+           die "duplicate key in comma-separated list property: $k" if defined($res->{$k});
+           my $schema = $format->{$k};
+           die "invalid key in comma-separated list property: $k" if !$schema;
+           if ($schema->{type} && $schema->{type} eq 'boolean') {
+               $v = 1 if $v =~ m/^(1|on|yes|true)$/i;
+               $v = 0 if $v =~ m/^(0|off|no|false)$/i;
+           }
+           $res->{$k} = $v;
+       } elsif ($part !~ /=/) {
+           die "duplicate key in comma-separated list property: $default_key" if $default_key;
+           foreach my $key (keys %$format) {
+               if ($format->{$key}->{default_key}) {
+                   $default_key = $key;
+                   if (!$res->{$default_key}) {
+                       $res->{$default_key} = $part;
+                       last;
+                   }
+                   die "duplicate key in comma-separated list property: $default_key";
+               }
+           }
+       } else {
+           die "missing key in comma-separated list property";
+       }
+    }
+
+    my $errors = {};
+    check_object($path, $format, $res, undef, $errors);
+    if (scalar(%$errors)) {
+       raise "format error", errors => $errors;
+    }
+
+    return $res;
+}
+

 sub add_error {
     my ($errors, $path, $msg) = @_;
 
 sub add_error {
     my ($errors, $path, $msg) = @_;
 


@@ -830,6 +919,11 @@ my $default_schema_noref = {
            optional => 1,
            description => "This indicates what format the data is among some predefined formats which may include:\n\ndate - a string following the ISO format \naddress \nschema - a schema definition object \nperson \npage \nhtml - a string representing HTML",
         },
            optional => 1,
            description => "This indicates what format the data is among some predefined formats which may include:\n\ndate - a string following the ISO format \naddress \nschema - a schema definition object \nperson \npage \nhtml - a string representing HTML",
         },

+       default_key => {
+           type => "boolean",
+           optional => 1,
+           description => "Whether this is the default key in a comma separated list property string.",
+       },

        default => {
            type => "any",
            optional => 1,
        default => {
            type => "any",
            optional => 1,


@@ -1250,7 +1344,8 @@ sub generate_typetext {
     my $typetext = '';
     my (@optional, @required);
     foreach my $key (sort keys %$schema) {
     my $typetext = '';
     my (@optional, @required);
     foreach my $key (sort keys %$schema) {

-       next if !$schema->{$key}->{format_description};
+       next if !$schema->{$key}->{format_description} &&
+               !$schema->{$key}->{typetext};

        if ($schema->{$key}->{optional}) {
            push @optional, $key;
        } else {
        if ($schema->{$key}->{optional}) {
            push @optional, $key;
        } else {


@@ -1258,17 +1353,25 @@ sub generate_typetext {
        }
     }
     my ($pre, $post) = ('', '');
        }
     }
     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) {
     foreach my $key (@required) {

-       my $desc = $schema->{$key}->{format_description};
-       $typetext .= "$pre$key=<$desc>$post";
+       &$add($key);

        $pre = ', ';
     }
        $pre = ', ';
     }

-    $pre = ' [,' if $pre;
+    $pre = $pre ? ' [,' : '[';
+    $post = ']';

     foreach my $key (@optional) {
     foreach my $key (@optional) {

-       my $desc = $schema->{$key}->{format_description};
-       $typetext .= "$pre$key=<$desc>$post";
+       &$add($key);

        $pre = ' [,';
        $pre = ' [,';

-       $post = ']';

     }
     return $typetext;
 }
     }
     return $typetext;
 }