Added JSONSchema::parse_property_string
[pve-common.git] / src / PVE / JSONSchema.pm
index 3e0fd52..d900a69 100644 (file)
@@ -37,12 +37,12 @@ sub get_standard_option {
     my ($name, $base) = @_;
 
     my $std =  $standard_options->{$name};
     my ($name, $base) = @_;
 
     my $std =  $standard_options->{$name};
-    die "no such standard option\n" if !$std;
+    die "no such standard option '$name'\n" if !$std;
 
     my $res = $base || {};
 
     foreach my $opt (keys %$std) {
 
     my $res = $base || {};
 
     foreach my $opt (keys %$std) {
-       next if $res->{$opt};
+       next if defined($res->{$opt});
        $res->{$opt} = $std->{$opt};
     }
 
        $res->{$opt} = $std->{$opt};
     }
 
@@ -83,6 +83,13 @@ PVE::JSONSchema::register_standard_option('pve-config-digest', {
     maxLength => 40, # sha1 hex digest lenght is 40
 });
 
     maxLength => 40, # sha1 hex digest lenght is 40
 });
 
+PVE::JSONSchema::register_standard_option('extra-args', {
+    description => "Extra arguments as array",
+    type => 'array',
+    items => { type => 'string' },
+    optional => 1
+});
+
 my $format_list = {};
 
 sub register_format {
 my $format_list = {};
 
 sub register_format {
@@ -147,13 +154,35 @@ register_format('ipv4', \&pve_verify_ipv4);
 sub pve_verify_ipv4 {
     my ($ipv4, $noerr) = @_;
 
 sub pve_verify_ipv4 {
     my ($ipv4, $noerr) = @_;
 
-    if (!Net::IP::ip_is_ipv4($ipv4))  {
-       return undef if $noerr;
-       die "value does not look like a valid IP address\n";
+    if ($ipv4 !~ m/^(?:$IPV4RE)$/) {
+       return undef if $noerr;
+       die "value does not look like a valid IPv4 address\n";
     }
     return $ipv4;
 }
 
     }
     return $ipv4;
 }
 
+register_format('ipv6', \&pve_verify_ipv6);
+sub pve_verify_ipv6 {
+    my ($ipv6, $noerr) = @_;
+
+    if ($ipv6 !~ m/^(?:$IPV6RE)$/) {
+       return undef if $noerr;
+       die "value does not look like a valid IPv6 address\n";
+    }
+    return $ipv6;
+}
+
+register_format('ip', \&pve_verify_ip);
+sub pve_verify_ip {
+    my ($ip, $noerr) = @_;
+
+    if ($ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/) {
+       return undef if $noerr;
+       die "value does not look like a valid IP address\n";
+    }
+    return $ip;
+}
+
 my $ipv4_mask_hash = {
     '128.0.0.0' => 1,
     '192.0.0.0' => 2,
 my $ipv4_mask_hash = {
     '128.0.0.0' => 1,
     '192.0.0.0' => 2,
@@ -198,26 +227,70 @@ 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);
 sub pve_verify_email {
     my ($email, $noerr) = @_;
 
 }
 
 register_format('email', \&pve_verify_email);
 sub pve_verify_email {
     my ($email, $noerr) = @_;
 
-    # we use same regex as extjs Ext.form.VTypes.email
-    if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,6}$/) {
+    # we use same regex as in Utils.js
+    if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/) {
           return undef if $noerr;
           die "value does not look like a valid email address\n";
     }
           return undef if $noerr;
           die "value does not look like a valid email address\n";
     }
@@ -249,9 +322,23 @@ sub pve_verify_iface {
     return $id;
 }
 
     return $id;
 }
 
+# general addresses by name or IP
+register_format('address', \&pve_verify_address);
+sub pve_verify_address {
+    my ($addr, $noerr) = @_;
+
+    if (!(pve_verify_ip($addr, 1) ||
+         pve_verify_dns_name($addr, 1)))
+    {
+          return undef if $noerr;
+          die "value does not look like a valid address: $addr\n";
+    }
+    return $addr;
+}
+
 register_standard_option('spice-proxy', {
     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).",
 register_standard_option('spice-proxy', {
     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).",
-    type => 'string', format => 'dns-name',
+    type => 'string', format => 'address',
 }); 
 
 register_standard_option('remote-viewer-config', {
 }); 
 
 register_standard_option('remote-viewer-config', {
@@ -266,6 +353,48 @@ register_standard_option('remote-viewer-config', {
     },
 });
 
     },
 });
 
+register_format('pve-startup-order', \&pve_verify_startup_order);
+sub pve_verify_startup_order {
+    my ($value, $noerr) = @_;
+
+    return $value if pve_parse_startup_order($value);
+
+    return undef if $noerr;
+
+    die "unable to parse startup options\n";
+}
+
+sub pve_parse_startup_order {
+    my ($value) = @_;
+
+    return undef if !$value;
+
+    my $res = {};
+
+    foreach my $p (split(/,/, $value)) {
+       next if $p =~ m/^\s*$/;
+
+       if ($p =~ m/^(order=)?(\d+)$/) {
+           $res->{order} = $2;
+       } elsif ($p =~ m/^up=(\d+)$/) {
+           $res->{up} = $1;
+       } elsif ($p =~ m/^down=(\d+)$/) {
+           $res->{down} = $1;
+       } else {
+           return undef;
+       }
+    }
+
+    return $res;
+}
+
+PVE::JSONSchema::register_standard_option('pve-startup-order', {
+    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.",
+    optional => 1,
+    type => 'string', format => 'pve-startup-order',
+    typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
+});
+
 sub check_format {
     my ($format, $value) = @_;
 
 sub check_format {
     my ($format, $value) = @_;
 
@@ -302,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) = @_;
 
@@ -478,6 +652,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) = @_;
 
 sub check_prop {
     my ($value, $schema, $path, $errors) = @_;
 
@@ -712,6 +899,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).",
        },
            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,
         title => {
            type => "string",
            optional => 1,
@@ -727,11 +919,21 @@ 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,
            description => "This indicates the default for the instance property."
        },
        default => {
            type => "any",
            optional => 1,
            description => "This indicates the default for the instance property."
        },
+        completion => {
+           type => 'coderef',
+           description => "Bash completion function. This function should return a list of possible values.",
+           optional => 1,
+        },
         disallow => {
            type => "object",
            optional => 1,
         disallow => {
            type => "object",
            optional => 1,
@@ -877,6 +1079,11 @@ my $method_schema = {
            description => "JSON Schema for parameters.",
            optional => 1,
        },
            description => "JSON Schema for parameters.",
            optional => 1,
        },
+        formatter => {
+           type => 'object',
+           description => "Used to store page formatter information (set by PVE::RESTHandler->register_page_formatter).",
+           optional => 1,
+        },
        returns => {
            type => 'object',
            description => "JSON Schema for return value.",
        returns => {
            type => 'object',
            description => "JSON Schema for return value.",
@@ -992,20 +1199,30 @@ sub get_options {
        }
     }
 
        }
     }
 
+    Getopt::Long::Configure('prefix_pattern=(--|-)');
+
     my $opts = {};
     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
        if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
 
     my $opts = {};
     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
        if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
 
-    if (my $acount = scalar(@$args)) {
+    if (@$args) {
        if ($list_param) {
            $opts->{$list_param} = $args;
            $args = [];
        } elsif (ref($arg_param)) {
        if ($list_param) {
            $opts->{$list_param} = $args;
            $args = [];
        } elsif (ref($arg_param)) {
-           raise("wrong number of arguments\n", code => HTTP_BAD_REQUEST)
-               if scalar(@$arg_param) != $acount; 
-           foreach my $p (@$arg_param) {
-               $opts->{$p} = shift @$args;
+           foreach my $arg_name (@$arg_param) {
+               if ($opts->{'extra-args'}) {
+                   raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
+               }
+               if ($arg_name eq 'extra-args') {
+                   $opts->{'extra-args'} = $args;
+                   $args = [];
+                   next;
+               }
+               raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
+               $opts->{$arg_name} = shift @$args;
            }
            }
+           raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
        } else {
            raise("too many arguments\n", code => HTTP_BAD_REQUEST)
                if scalar(@$args) != 0;
        } else {
            raise("too many arguments\n", code => HTTP_BAD_REQUEST)
                if scalar(@$args) != 0;
@@ -1039,7 +1256,7 @@ sub get_options {
                if ($pd->{format} =~ m/-list/) {
                    # allow --vmid 100 --vmid 101 and --vmid 100,101
                    # allow --dow mon --dow fri and --dow mon,fri
                if ($pd->{format} =~ m/-list/) {
                    # allow --vmid 100 --vmid 101 and --vmid 100,101
                    # allow --dow mon --dow fri and --dow mon,fri
-                   $opts->{$p} = join(",", @{$opts->{$p}});
+                   $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
                } elsif ($pd->{format} =~ m/-alist/) {
                    # we encode array as \0 separated strings
                    # Note: CGI.pm also use this encoding
                } elsif ($pd->{format} =~ m/-alist/) {
                    # we encode array as \0 separated strings
                    # Note: CGI.pm also use this encoding
@@ -1072,13 +1289,12 @@ sub parse_config {
 
     my $cfg = {};
 
 
     my $cfg = {};
 
-    while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
+    while ($raw =~ /^\s*(.+?)\s*$/gm) {
        my $line = $1;
        my $line = $1;
-       next if $line =~ m/^\#/; # skip comment lines
-       next if $line =~ m/^\s*$/; # skip empty lines
 
 
-       if ($line =~ m/^(\S+):\s*(\S+)\s*$/) {
+       next if $line =~ /^#/;
+
+       if ($line =~ m/^(\S+?):\s*(.*)$/) {
            my $key = $1;
            my $value = $2;
            if ($schema->{properties}->{$key} && 
            my $key = $1;
            my $value = $2;
            if ($schema->{properties}->{$key} && 
@@ -1123,4 +1339,41 @@ sub dump_config {
     return $data;
 }
 
     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;
 1;