dbe2e3516493350e3ca6509e68529d9916a1b6ab
[pve-common.git] / src / PVE / JSONSchema.pm
1 package PVE::JSONSchema;
2
3 use strict;
4 use warnings;
5 use Storable; # for dclone
6 use Getopt::Long;
7 use Devel::Cycle -quiet; # todo: remove?
8 use PVE::Tools qw(split_list $IPV6RE $IPV4RE);
9 use PVE::Exception qw(raise);
10 use HTTP::Status qw(:constants);
11 use Net::IP qw(:PROC);
12
13 use base 'Exporter';
14
15 our @EXPORT_OK = qw(
16 register_standard_option 
17 get_standard_option
18 );
19
20 # Note: This class implements something similar to JSON schema, but it is not 100% complete. 
21 # see: http://tools.ietf.org/html/draft-zyp-json-schema-02
22 # see: http://json-schema.org/
23
24 # the code is similar to the javascript parser from http://code.google.com/p/jsonschema/
25
26 my $standard_options = {};
27 sub register_standard_option {
28     my ($name, $schema) = @_;
29
30     die "standard option '$name' already registered\n" 
31         if $standard_options->{$name};
32
33     $standard_options->{$name} = $schema;
34 }
35
36 sub get_standard_option {
37     my ($name, $base) = @_;
38
39     my $std =  $standard_options->{$name};
40     die "no such standard option '$name'\n" if !$std;
41
42     my $res = $base || {};
43
44     foreach my $opt (keys %$std) {
45         next if defined($res->{$opt});
46         $res->{$opt} = $std->{$opt};
47     }
48
49     return $res;
50 };
51
52 register_standard_option('pve-vmid', {
53     description => "The (unique) ID of the VM.",
54     type => 'integer', format => 'pve-vmid',
55     minimum => 1
56 });
57
58 register_standard_option('pve-node', {
59     description => "The cluster node name.",
60     type => 'string', format => 'pve-node',
61 });
62
63 register_standard_option('pve-node-list', {
64     description => "List of cluster node names.",
65     type => 'string', format => 'pve-node-list',
66 });
67
68 register_standard_option('pve-iface', {
69     description => "Network interface name.",
70     type => 'string', format => 'pve-iface',
71     minLength => 2, maxLength => 20,
72 });
73
74 PVE::JSONSchema::register_standard_option('pve-storage-id', {
75     description => "The storage identifier.",
76     type => 'string', format => 'pve-storage-id',
77 }); 
78
79 PVE::JSONSchema::register_standard_option('pve-config-digest', {
80     description => 'Prevent changes if current configuration file has different SHA1 digest. This can be used to prevent concurrent modifications.',
81     type => 'string',
82     optional => 1,
83     maxLength => 40, # sha1 hex digest lenght is 40
84 });
85
86 PVE::JSONSchema::register_standard_option('extra-args', {
87     description => "Extra arguments as array",
88     type => 'array',
89     items => { type => 'string' },
90     optional => 1
91 });
92
93 my $format_list = {};
94
95 sub register_format {
96     my ($format, $code) = @_;
97
98     die "JSON schema format '$format' already registered\n" 
99         if $format_list->{$format};
100
101     $format_list->{$format} = $code;
102 }
103
104 # register some common type for pve
105
106 register_format('string', sub {}); # allow format => 'string-list'
107
108 register_format('pve-configid', \&pve_verify_configid);
109 sub pve_verify_configid {
110     my ($id, $noerr) = @_;
111  
112     if ($id !~ m/^[a-z][a-z0-9_]+$/i) {
113         return undef if $noerr;
114         die "invalid configuration ID '$id'\n"; 
115     }
116     return $id;
117 }
118
119 PVE::JSONSchema::register_format('pve-storage-id', \&parse_storage_id);
120 sub parse_storage_id {
121     my ($storeid, $noerr) = @_;
122
123     if ($storeid !~ m/^[a-z][a-z0-9\-\_\.]*[a-z0-9]$/i) {
124         return undef if $noerr;
125         die "storage ID '$storeid' contains illegal characters\n";
126     }
127     return $storeid;
128 }
129
130
131 register_format('pve-vmid', \&pve_verify_vmid);
132 sub pve_verify_vmid {
133     my ($vmid, $noerr) = @_;
134
135     if ($vmid !~ m/^[1-9][0-9]+$/) {
136         return undef if $noerr;
137         die "value does not look like a valid VM ID\n";
138     }
139     return $vmid;
140 }
141
142 register_format('pve-node', \&pve_verify_node_name);
143 sub pve_verify_node_name {
144     my ($node, $noerr) = @_;
145
146     if ($node !~ m/^([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)$/) {
147         return undef if $noerr;
148         die "value does not look like a valid node name\n";
149     }
150     return $node;
151 }
152
153 register_format('ipv4', \&pve_verify_ipv4);
154 sub pve_verify_ipv4 {
155     my ($ipv4, $noerr) = @_;
156
157     if ($ipv4 !~ m/^(?:$IPV4RE)$/) {
158         return undef if $noerr;
159         die "value does not look like a valid IPv4 address\n";
160     }
161     return $ipv4;
162 }
163
164 register_format('ipv6', \&pve_verify_ipv6);
165 sub pve_verify_ipv6 {
166     my ($ipv6, $noerr) = @_;
167
168     if ($ipv6 !~ m/^(?:$IPV6RE)$/) {
169         return undef if $noerr;
170         die "value does not look like a valid IPv6 address\n";
171     }
172     return $ipv6;
173 }
174
175 register_format('ip', \&pve_verify_ip);
176 sub pve_verify_ip {
177     my ($ip, $noerr) = @_;
178
179     if ($ip !~ m/^(?:(?:$IPV4RE)|(?:$IPV6RE))$/) {
180         return undef if $noerr;
181         die "value does not look like a valid IP address\n";
182     }
183     return $ip;
184 }
185
186 my $ipv4_mask_hash = {
187     '128.0.0.0' => 1,
188     '192.0.0.0' => 2,
189     '224.0.0.0' => 3,
190     '240.0.0.0' => 4,
191     '248.0.0.0' => 5,
192     '252.0.0.0' => 6,
193     '254.0.0.0' => 7,
194     '255.0.0.0' => 8,
195     '255.128.0.0' => 9,
196     '255.192.0.0' => 10,
197     '255.224.0.0' => 11,
198     '255.240.0.0' => 12,
199     '255.248.0.0' => 13,
200     '255.252.0.0' => 14,
201     '255.254.0.0' => 15,
202     '255.255.0.0' => 16,
203     '255.255.128.0' => 17,
204     '255.255.192.0' => 18,
205     '255.255.224.0' => 19,
206     '255.255.240.0' => 20,
207     '255.255.248.0' => 21,
208     '255.255.252.0' => 22,
209     '255.255.254.0' => 23,
210     '255.255.255.0' => 24,
211     '255.255.255.128' => 25,
212     '255.255.255.192' => 26,
213     '255.255.255.224' => 27,
214     '255.255.255.240' => 28,
215     '255.255.255.248' => 29,
216     '255.255.255.252' => 30
217 };
218
219 register_format('ipv4mask', \&pve_verify_ipv4mask);
220 sub pve_verify_ipv4mask {
221     my ($mask, $noerr) = @_;
222
223     if (!defined($ipv4_mask_hash->{$mask})) {
224         return undef if $noerr;
225         die "value does not look like a valid IP netmask\n";
226     }
227     return $mask;
228 }
229
230 register_format('CIDR', \&pve_verify_cidr);
231 sub pve_verify_cidr {
232     my ($cidr, $noerr) = @_;
233
234     if ($cidr =~ m!^(?:$IPV4RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 < 32)) {
235         return $cidr;
236     } elsif ($cidr =~ m!^(?:$IPV6RE)(?:/(\d+))$! && ($1 > 7) &&  ($1 <= 120)) {
237         return $cidr;
238     }
239
240     return undef if $noerr;
241     die "value does not look like a valid CIDR network\n";
242 }
243
244 register_format('email', \&pve_verify_email);
245 sub pve_verify_email {
246     my ($email, $noerr) = @_;
247
248     # we use same regex as in Utils.js
249     if ($email !~ /^(\w+)([\-+.][\w]+)*@(\w[\-\w]*\.){1,5}([A-Za-z]){2,63}$/) {
250            return undef if $noerr;
251            die "value does not look like a valid email address\n";
252     }
253     return $email;
254 }
255
256 register_format('dns-name', \&pve_verify_dns_name);
257 sub pve_verify_dns_name {
258     my ($name, $noerr) = @_;
259
260     my $namere = "([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?)";
261
262     if ($name !~ /^(${namere}\.)*${namere}$/) {
263            return undef if $noerr;
264            die "value does not look like a valid DNS name\n";
265     }
266     return $name;
267 }
268
269 # network interface name
270 register_format('pve-iface', \&pve_verify_iface);
271 sub pve_verify_iface {
272     my ($id, $noerr) = @_;
273  
274     if ($id !~ m/^[a-z][a-z0-9_]{1,20}([:\.]\d+)?$/i) {
275         return undef if $noerr;
276         die "invalid network interface name '$id'\n"; 
277     }
278     return $id;
279 }
280
281 # general addresses by name or IP
282 register_format('address', \&pve_verify_address);
283 sub pve_verify_address {
284     my ($addr, $noerr) = @_;
285
286     if (!(pve_verify_ip($addr, 1) ||
287           pve_verify_dns_name($addr, 1)))
288     {
289            return undef if $noerr;
290            die "value does not look like a valid address: $addr\n";
291     }
292     return $addr;
293 }
294
295 register_standard_option('spice-proxy', {
296     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).",
297     type => 'string', format => 'address',
298 }); 
299
300 register_standard_option('remote-viewer-config', {
301     description => "Returned values can be directly passed to the 'remote-viewer' application.",
302     additionalProperties => 1,
303     properties => {
304         type => { type => 'string' },
305         password => { type => 'string' },
306         proxy => { type => 'string' },
307         host => { type => 'string' },
308         'tls-port' => { type => 'integer' },
309     },
310 });
311
312 register_format('pve-startup-order', \&pve_verify_startup_order);
313 sub pve_verify_startup_order {
314     my ($value, $noerr) = @_;
315
316     return $value if pve_parse_startup_order($value);
317
318     return undef if $noerr;
319
320     die "unable to parse startup options\n";
321 }
322
323 sub pve_parse_startup_order {
324     my ($value) = @_;
325
326     return undef if !$value;
327
328     my $res = {};
329
330     foreach my $p (split(/,/, $value)) {
331         next if $p =~ m/^\s*$/;
332
333         if ($p =~ m/^(order=)?(\d+)$/) {
334             $res->{order} = $2;
335         } elsif ($p =~ m/^up=(\d+)$/) {
336             $res->{up} = $1;
337         } elsif ($p =~ m/^down=(\d+)$/) {
338             $res->{down} = $1;
339         } else {
340             return undef;
341         }
342     }
343
344     return $res;
345 }
346
347 PVE::JSONSchema::register_standard_option('pve-startup-order', {
348     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.",
349     optional => 1,
350     type => 'string', format => 'pve-startup-order',
351     typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
352 });
353
354 sub check_format {
355     my ($format, $value) = @_;
356
357     return if $format eq 'regex';
358
359     if ($format =~ m/^(.*)-a?list$/) {
360         
361         my $code = $format_list->{$1};
362
363         die "undefined format '$format'\n" if !$code;
364
365         # Note: we allow empty lists
366         foreach my $v (split_list($value)) {
367             &$code($v);
368         }
369
370     } elsif ($format =~ m/^(.*)-opt$/) {
371
372         my $code = $format_list->{$1};
373
374         die "undefined format '$format'\n" if !$code;
375
376         return if !$value; # allow empty string
377
378         &$code($value);
379
380    } else {
381
382         my $code = $format_list->{$format};
383
384         die "undefined format '$format'\n" if !$code;
385
386         &$code($value);
387     }
388
389
390 sub add_error {
391     my ($errors, $path, $msg) = @_;
392
393     $path = '_root' if !$path;
394     
395     if ($errors->{$path}) {
396         $errors->{$path} = join ('\n', $errors->{$path}, $msg);
397     } else {
398         $errors->{$path} = $msg;
399     }
400 }
401
402 sub is_number {
403     my $value = shift;
404
405     # see 'man perlretut'
406     return $value =~ /^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/; 
407 }
408
409 sub is_integer {
410     my $value = shift;
411
412     return $value =~ m/^[+-]?\d+$/;
413 }
414
415 sub check_type {
416     my ($path, $type, $value, $errors) = @_;
417
418     return 1 if !$type;
419
420     if (!defined($value)) {
421         return 1 if $type eq 'null';
422         die "internal error" 
423     }
424
425     if (my $tt = ref($type)) {
426         if ($tt eq 'ARRAY') {
427             foreach my $t (@$type) {
428                 my $tmperr = {};
429                 check_type($path, $t, $value, $tmperr);
430                 return 1 if !scalar(%$tmperr); 
431             }
432             my $ttext = join ('|', @$type);
433             add_error($errors, $path, "type check ('$ttext') failed"); 
434             return undef;
435         } elsif ($tt eq 'HASH') {
436             my $tmperr = {};
437             check_prop($value, $type, $path, $tmperr);
438             return 1 if !scalar(%$tmperr); 
439             add_error($errors, $path, "type check failed");         
440             return undef;
441         } else {
442             die "internal error - got reference type '$tt'";
443         }
444
445     } else {
446
447         return 1 if $type eq 'any';
448
449         if ($type eq 'null') {
450             if (defined($value)) {
451                 add_error($errors, $path, "type check ('$type') failed - value is not null");
452                 return undef;
453             }
454             return 1;
455         }
456
457         my $vt = ref($value);
458
459         if ($type eq 'array') {
460             if (!$vt || $vt ne 'ARRAY') {
461                 add_error($errors, $path, "type check ('$type') failed");
462                 return undef;
463             }
464             return 1;
465         } elsif ($type eq 'object') {
466             if (!$vt || $vt ne 'HASH') {
467                 add_error($errors, $path, "type check ('$type') failed");
468                 return undef;
469             }
470             return 1;
471         } elsif ($type eq 'coderef') {
472             if (!$vt || $vt ne 'CODE') {
473                 add_error($errors, $path, "type check ('$type') failed");
474                 return undef;
475             }
476             return 1;
477         } else {
478             if ($vt) {
479                 add_error($errors, $path, "type check ('$type') failed - got $vt");
480                 return undef;
481             } else {
482                 if ($type eq 'string') {
483                     return 1; # nothing to check ?
484                 } elsif ($type eq 'boolean') {
485                     #if ($value =~ m/^(1|true|yes|on)$/i) {
486                     if ($value eq '1') {
487                         return 1;
488                     #} elsif ($value =~ m/^(0|false|no|off)$/i) {
489                     } elsif ($value eq '0') {
490                         return 0;
491                     } else {
492                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
493                         return undef;
494                     }
495                 } elsif ($type eq 'integer') {
496                     if (!is_integer($value)) {
497                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
498                         return undef;
499                     }
500                     return 1;
501                 } elsif ($type eq 'number') {
502                     if (!is_number($value)) {
503                         add_error($errors, $path, "type check ('$type') failed - got '$value'");
504                         return undef;
505                     }
506                     return 1;
507                 } else {
508                     return 1; # no need to verify unknown types
509                 }
510             }
511         }
512     }  
513
514     return undef;
515 }
516
517 sub check_object {
518     my ($path, $schema, $value, $additional_properties, $errors) = @_;
519
520     # print "Check Object " . Dumper($value) . "\nSchema: " . Dumper($schema);
521
522     my $st = ref($schema);
523     if (!$st || $st ne 'HASH') {
524         add_error($errors, $path, "Invalid schema definition.");
525         return;
526     }
527
528     my $vt = ref($value);
529     if (!$vt || $vt ne 'HASH') {
530         add_error($errors, $path, "an object is required");
531         return;
532     }
533
534     foreach my $k (keys %$schema) {
535         check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors);
536     }
537
538     foreach my $k (keys %$value) {
539
540         my $newpath =  $path ? "$path.$k" : $k;
541
542         if (my $subschema = $schema->{$k}) {
543             if (my $requires = $subschema->{requires}) {
544                 if (ref($requires)) {
545                     #print "TEST: " . Dumper($value) . "\n", Dumper($requires) ;
546                     check_prop($value, $requires, $path, $errors);
547                 } elsif (!defined($value->{$requires})) {
548                     add_error($errors, $path ? "$path.$requires" : $requires, 
549                               "missing property - '$newpath' requiers this property");
550                 }
551             }
552
553             next; # value is already checked above
554         }
555
556         if (defined ($additional_properties) && !$additional_properties) {
557             add_error($errors, $newpath, "property is not defined in schema " .
558                       "and the schema does not allow additional properties");
559             next;
560         }
561         check_prop($value->{$k}, $additional_properties, $newpath, $errors)
562             if ref($additional_properties);
563     }
564 }
565
566 sub check_prop {
567     my ($value, $schema, $path, $errors) = @_;
568
569     die "internal error - no schema" if !$schema;
570     die "internal error" if !$errors;
571
572     #print "check_prop $path\n" if $value;
573
574     my $st = ref($schema);
575     if (!$st || $st ne 'HASH') {
576         add_error($errors, $path, "Invalid schema definition.");
577         return;
578     }
579
580     # if it extends another schema, it must pass that schema as well
581     if($schema->{extends}) {
582         check_prop($value, $schema->{extends}, $path, $errors);
583     }
584
585     if (!defined ($value)) {
586         return if $schema->{type} && $schema->{type} eq 'null';
587         if (!$schema->{optional}) {
588             add_error($errors, $path, "property is missing and it is not optional");
589         }
590         return;
591     }
592
593     return if !check_type($path, $schema->{type}, $value, $errors);
594
595     if ($schema->{disallow}) {
596         my $tmperr = {};
597         if (check_type($path, $schema->{disallow}, $value, $tmperr)) {
598             add_error($errors, $path, "disallowed value was matched");
599             return;
600         }
601     }
602
603     if (my $vt = ref($value)) {
604
605         if ($vt eq 'ARRAY') {
606             if ($schema->{items}) {
607                 my $it = ref($schema->{items});
608                 if ($it && $it eq 'ARRAY') {
609                     #die "implement me $path: $vt " . Dumper($schema) ."\n".  Dumper($value);
610                     die "not implemented";
611                 } else {
612                     my $ind = 0;
613                     foreach my $el (@$value) {
614                         check_prop($el, $schema->{items}, "${path}[$ind]", $errors);
615                         $ind++;
616                     }
617                 }
618             }
619             return; 
620         } elsif ($schema->{properties} || $schema->{additionalProperties}) {
621             check_object($path, defined($schema->{properties}) ? $schema->{properties} : {},
622                          $value, $schema->{additionalProperties}, $errors);
623             return;
624         }
625
626     } else {
627
628         if (my $format = $schema->{format}) {
629             eval { check_format($format, $value); };
630             if ($@) {
631                 add_error($errors, $path, "invalid format - $@");
632                 return;
633             }
634         }
635
636         if (my $pattern = $schema->{pattern}) {
637             if ($value !~ m/^$pattern$/) {
638                 add_error($errors, $path, "value does not match the regex pattern");
639                 return;
640             }
641         }
642
643         if (defined (my $max = $schema->{maxLength})) {
644             if (length($value) > $max) {
645                 add_error($errors, $path, "value may only be $max characters long");
646                 return;
647             }
648         }
649
650         if (defined (my $min = $schema->{minLength})) {
651             if (length($value) < $min) {
652                 add_error($errors, $path, "value must be at least $min characters long");
653                 return;
654             }
655         }
656         
657         if (is_number($value)) {
658             if (defined (my $max = $schema->{maximum})) {
659                 if ($value > $max) { 
660                     add_error($errors, $path, "value must have a maximum value of $max");
661                     return;
662                 }
663             }
664
665             if (defined (my $min = $schema->{minimum})) {
666                 if ($value < $min) { 
667                     add_error($errors, $path, "value must have a minimum value of $min");
668                     return;
669                 }
670             }
671         }
672
673         if (my $ea = $schema->{enum}) {
674
675             my $found;
676             foreach my $ev (@$ea) {
677                 if ($ev eq $value) {
678                     $found = 1;
679                     last;
680                 }
681             }
682             if (!$found) {
683                 add_error($errors, $path, "value '$value' does not have a value in the enumeration '" .
684                           join(", ", @$ea) . "'");
685             }
686         }
687     }
688 }
689
690 sub validate {
691     my ($instance, $schema, $errmsg) = @_;
692
693     my $errors = {};
694     $errmsg = "Parameter verification failed.\n" if !$errmsg;
695
696     # todo: cycle detection is only needed for debugging, I guess
697     # we can disable that in the final release
698     # todo: is there a better/faster way to detect cycles?
699     my $cycles = 0;
700     find_cycle($instance, sub { $cycles = 1 });
701     if ($cycles) {
702         add_error($errors, undef, "data structure contains recursive cycles");
703     } elsif ($schema) {
704         check_prop($instance, $schema, '', $errors);
705     }
706     
707     if (scalar(%$errors)) {
708         raise $errmsg, code => HTTP_BAD_REQUEST, errors => $errors;
709     }
710
711     return 1;
712 }
713
714 my $schema_valid_types = ["string", "object", "coderef", "array", "boolean", "number", "integer", "null", "any"];
715 my $default_schema_noref = {
716     description => "This is the JSON Schema for JSON Schemas.",
717     type => [ "object" ],
718     additionalProperties => 0,
719     properties => {
720         type => {
721             type => ["string", "array"],
722             description => "This is a type definition value. This can be a simple type, or a union type",
723             optional => 1,
724             default => "any",
725             items => {
726                 type => "string",
727                 enum => $schema_valid_types,
728             },
729             enum => $schema_valid_types,
730         },
731         optional => {
732             type => "boolean",
733             description => "This indicates that the instance property in the instance object is not required.",
734             optional => 1,
735             default => 0
736         },
737         properties => {
738             type => "object",
739             description => "This is a definition for the properties of an object value",
740             optional => 1,
741             default => {},
742         },
743         items => {
744             type => "object",
745             description => "When the value is an array, this indicates the schema to use to validate each item in an array",
746             optional => 1,
747             default => {},
748         },
749         additionalProperties => {
750             type => [ "boolean", "object"],
751             description => "This provides a default property definition for all properties that are not explicitly defined in an object type definition.",
752             optional => 1,
753             default => {},
754         },
755         minimum => {
756             type => "number",
757             optional => 1,
758             description => "This indicates the minimum value for the instance property when the type of the instance value is a number.",
759         },
760         maximum => {
761             type => "number",
762             optional => 1,
763             description => "This indicates the maximum value for the instance property when the type of the instance value is a number.",
764         },
765         minLength => {
766             type => "integer",
767             description => "When the instance value is a string, this indicates minimum length of the string",
768             optional => 1,
769             minimum => 0,
770             default => 0,
771         },      
772         maxLength => {
773             type => "integer",
774             description => "When the instance value is a string, this indicates maximum length of the string.",
775             optional => 1,
776         },
777         typetext => {
778             type => "string",
779             optional => 1,
780             description => "A text representation of the type (used to generate documentation).",
781         },
782         pattern => {
783             type => "string",
784             format => "regex",
785             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.",
786             optional => 1,
787             default => ".*",
788         },
789
790         enum => {
791             type => "array",
792             optional => 1,
793             description => "This provides an enumeration of possible values that are valid for the instance property.",
794         },
795         description => {
796             type => "string",
797             optional => 1,
798             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).",
799         },
800         title => {
801             type => "string",
802             optional => 1,
803             description => "This provides the title of the property",
804         },
805         requires => {
806             type => [ "string", "object" ],
807             optional => 1,
808             description => "indicates a required property or a schema that must be validated if this property is present",
809         },
810         format => {
811             type => "string",
812             optional => 1,
813             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",
814         },
815         default => {
816             type => "any",
817             optional => 1,
818             description => "This indicates the default for the instance property."
819         },
820         completion => {
821             type => 'coderef',
822             description => "Bash completion function. This function should return a list of possible values.",
823             optional => 1,
824         },
825         disallow => {
826             type => "object",
827             optional => 1,
828             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, than this instance is not valid.",
829         },
830         extends => {
831             type => "object",
832             optional => 1,
833             description => "This indicates the schema extends the given schema. All instances of this schema must be valid to by the extended schema also.",
834             default => {},
835         },
836         # this is from hyper schema
837         links => {
838             type => "array",
839             description => "This defines the link relations of the instance objects",
840             optional => 1,
841             items => {
842                 type => "object",
843                 properties => {
844                     href => {
845                         type => "string",
846                         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",
847                     },
848                     rel => {
849                         type => "string",
850                         description => "This is the name of the link relation",
851                         optional => 1,
852                         default => "full",
853                     },
854                     method => {
855                         type => "string",
856                         description => "For submission links, this defines the method that should be used to access the target resource",
857                         optional => 1,
858                         default => "GET",
859                     },
860                 },
861             },
862         },
863     }   
864 };
865
866 my $default_schema = Storable::dclone($default_schema_noref);
867
868 $default_schema->{properties}->{properties}->{additionalProperties} = $default_schema;
869 $default_schema->{properties}->{additionalProperties}->{properties} = $default_schema->{properties};
870
871 $default_schema->{properties}->{items}->{properties} = $default_schema->{properties};
872 $default_schema->{properties}->{items}->{additionalProperties} = 0;
873
874 $default_schema->{properties}->{disallow}->{properties} = $default_schema->{properties};
875 $default_schema->{properties}->{disallow}->{additionalProperties} = 0;
876
877 $default_schema->{properties}->{requires}->{properties} = $default_schema->{properties};
878 $default_schema->{properties}->{requires}->{additionalProperties} = 0;
879
880 $default_schema->{properties}->{extends}->{properties} = $default_schema->{properties};
881 $default_schema->{properties}->{extends}->{additionalProperties} = 0;
882
883 my $method_schema = {
884     type => "object",
885     additionalProperties => 0,
886     properties => {
887         description => {
888             description => "This a description of the method",
889             optional => 1,
890         },
891         name => {
892             type =>  'string',
893             description => "This indicates the name of the function to call.",
894             optional => 1,
895             requires => {
896                 additionalProperties => 1,
897                 properties => {
898                     name => {},
899                     description => {},
900                     code => {},
901                     method => {},
902                     parameters => {},
903                     path => {},
904                     parameters => {},
905                     returns => {},
906                 }             
907             },
908         },
909         method => {
910             type =>  'string',
911             description => "The HTTP method name.",
912             enum => [ 'GET', 'POST', 'PUT', 'DELETE' ],
913             optional => 1,
914         },
915         protected => {
916             type => 'boolean',
917             description => "Method needs special privileges - only pvedaemon can execute it",            
918             optional => 1,
919         },
920         proxyto => {
921             type =>  'string',
922             description => "A parameter name. If specified, all calls to this method are proxied to the host contained in that parameter.",
923             optional => 1,
924         },
925         permissions => {
926             type => 'object',
927             description => "Required access permissions. By default only 'root' is allowed to access this method.",
928             optional => 1,
929             additionalProperties => 0,
930             properties => {
931                 description => {
932                      description => "Describe access permissions.",
933                      optional => 1,
934                 },
935                 user => {
936                     description => "A simply way to allow access for 'all' authenticated users. Value 'world' is used to allow access without credentials.", 
937                     type => 'string', 
938                     enum => ['all', 'world'],
939                     optional => 1,
940                 },
941                 check => {
942                     description => "Array of permission checks (prefix notation).",
943                     type => 'array', 
944                     optional => 1 
945                 },
946             },
947         },
948         match_name => {
949             description => "Used internally",
950             optional => 1,
951         },
952         match_re => {
953             description => "Used internally",
954             optional => 1,
955         },
956         path => {
957             type =>  'string',
958             description => "path for URL matching (uri template)",
959         },
960         fragmentDelimiter => {
961             type => 'string',
962             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.",            
963             optional => 1,
964         },
965         parameters => {
966             type => 'object',
967             description => "JSON Schema for parameters.",
968             optional => 1,
969         },
970         formatter => {
971             type => 'object',
972             description => "Used to store page formatter information (set by PVE::RESTHandler->register_page_formatter).",
973             optional => 1,
974         },
975         returns => {
976             type => 'object',
977             description => "JSON Schema for return value.",
978             optional => 1,
979         },
980         code => {
981             type => 'coderef',
982             description => "method implementaion (code reference)",
983             optional => 1,
984         },
985         subclass => {
986             type => 'string',
987             description => "Delegate call to this class (perl class string).",
988             optional => 1,
989             requires => {
990                 additionalProperties => 0,
991                 properties => {
992                     subclass => {},
993                     path => {},
994                     match_name => {},
995                     match_re => {},
996                     fragmentDelimiter => { optional => 1 }
997                 }             
998             },
999         }, 
1000     },
1001
1002 };
1003
1004 sub validate_schema {
1005     my ($schema) = @_; 
1006
1007     my $errmsg = "internal error - unable to verify schema\n";
1008     validate($schema, $default_schema, $errmsg);
1009 }
1010
1011 sub validate_method_info {
1012     my $info = shift;
1013
1014     my $errmsg = "internal error - unable to verify method info\n";
1015     validate($info, $method_schema, $errmsg);
1016  
1017     validate_schema($info->{parameters}) if $info->{parameters};
1018     validate_schema($info->{returns}) if $info->{returns};
1019 }
1020
1021 # run a self test on load
1022 # make sure we can verify the default schema 
1023 validate_schema($default_schema_noref);
1024 validate_schema($method_schema);
1025
1026 # and now some utility methods (used by pve api)
1027 sub method_get_child_link {
1028     my ($info) = @_;
1029
1030     return undef if !$info;
1031
1032     my $schema = $info->{returns};
1033     return undef if !$schema || !$schema->{type} || $schema->{type} ne 'array';
1034
1035     my $links = $schema->{links};
1036     return undef if !$links;
1037
1038     my $found;
1039     foreach my $lnk (@$links) {
1040         if ($lnk->{href} && $lnk->{rel} && ($lnk->{rel} eq 'child')) {
1041             $found = $lnk;
1042             last;
1043         }
1044     }
1045
1046     return $found;
1047 }
1048
1049 # a way to parse command line parameters, using a 
1050 # schema to configure Getopt::Long
1051 sub get_options {
1052     my ($schema, $args, $arg_param, $fixed_param, $pwcallback) = @_;
1053
1054     if (!$schema || !$schema->{properties}) {
1055         raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1056             if scalar(@$args) != 0;
1057         return {};
1058     }
1059
1060     my $list_param;
1061     if ($arg_param && !ref($arg_param)) {
1062         my $pd = $schema->{properties}->{$arg_param};
1063         die "expected list format $pd->{format}"
1064             if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
1065         $list_param = $arg_param;
1066     }
1067
1068     my @getopt = ();
1069     foreach my $prop (keys %{$schema->{properties}}) {
1070         my $pd = $schema->{properties}->{$prop};
1071         next if $list_param && $prop eq $list_param;
1072         next if defined($fixed_param->{$prop});
1073
1074         if ($prop eq 'password' && $pwcallback) {
1075             # we do not accept plain password on input line, instead
1076             # we turn this into a boolean option and ask for password below
1077             # using $pwcallback() (for security reasons).
1078             push @getopt, "$prop";
1079         } elsif ($pd->{type} eq 'boolean') {
1080             push @getopt, "$prop:s";
1081         } else {
1082             if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
1083                 push @getopt, "$prop=s@";
1084             } else {
1085                 push @getopt, "$prop=s";
1086             }
1087         }
1088     }
1089
1090     Getopt::Long::Configure('prefix_pattern=(--|-)');
1091
1092     my $opts = {};
1093     raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
1094         if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
1095
1096     if (@$args) {
1097         if ($list_param) {
1098             $opts->{$list_param} = $args;
1099             $args = [];
1100         } elsif (ref($arg_param)) {
1101             foreach my $arg_name (@$arg_param) {
1102                 if ($opts->{'extra-args'}) {
1103                     raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
1104                 }
1105                 if ($arg_name eq 'extra-args') {
1106                     $opts->{'extra-args'} = $args;
1107                     $args = [];
1108                     next;
1109                 }
1110                 raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
1111                 $opts->{$arg_name} = shift @$args;
1112             }
1113             raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
1114         } else {
1115             raise("too many arguments\n", code => HTTP_BAD_REQUEST)
1116                 if scalar(@$args) != 0;
1117         }
1118     }
1119
1120     if (my $pd = $schema->{properties}->{password}) {
1121         if ($pd->{type} ne 'boolean' && $pwcallback) {
1122             if ($opts->{password} || !$pd->{optional}) {
1123                 $opts->{password} = &$pwcallback(); 
1124             }
1125         }
1126     }
1127
1128     $opts = PVE::Tools::decode_utf8_parameters($opts);
1129
1130     foreach my $p (keys %$opts) {
1131         if (my $pd = $schema->{properties}->{$p}) {
1132             if ($pd->{type} eq 'boolean') {
1133                 if ($opts->{$p} eq '') {
1134                     $opts->{$p} = 1;
1135                 } elsif ($opts->{$p} =~ m/^(1|true|yes|on)$/i) {
1136                     $opts->{$p} = 1;
1137                 } elsif ($opts->{$p} =~ m/^(0|false|no|off)$/i) {
1138                     $opts->{$p} = 0;
1139                 } else {
1140                     raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
1141                 }
1142             } elsif ($pd->{format}) {
1143
1144                 if ($pd->{format} =~ m/-list/) {
1145                     # allow --vmid 100 --vmid 101 and --vmid 100,101
1146                     # allow --dow mon --dow fri and --dow mon,fri
1147                     $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
1148                 } elsif ($pd->{format} =~ m/-alist/) {
1149                     # we encode array as \0 separated strings
1150                     # Note: CGI.pm also use this encoding
1151                     if (scalar(@{$opts->{$p}}) != 1) {
1152                         $opts->{$p} = join("\0", @{$opts->{$p}});
1153                     } else {
1154                         # st that split_list knows it is \0 terminated
1155                         my $v = $opts->{$p}->[0];
1156                         $opts->{$p} = "$v\0";
1157                     }
1158                 }
1159             }
1160         }       
1161     }
1162
1163     foreach my $p (keys %$fixed_param) {
1164         $opts->{$p} = $fixed_param->{$p};
1165     }
1166
1167     return $opts;
1168 }
1169
1170 # A way to parse configuration data by giving a json schema
1171 sub parse_config {
1172     my ($schema, $filename, $raw) = @_;
1173
1174     # do fast check (avoid validate_schema($schema))
1175     die "got strange schema" if !$schema->{type} || 
1176         !$schema->{properties} || $schema->{type} ne 'object';
1177
1178     my $cfg = {};
1179
1180     while ($raw =~ /^\s*(.+?)\s*$/gm) {
1181         my $line = $1;
1182
1183         next if $line =~ /^#/;
1184
1185         if ($line =~ m/^(\S+?):\s*(.*)$/) {
1186             my $key = $1;
1187             my $value = $2;
1188             if ($schema->{properties}->{$key} && 
1189                 $schema->{properties}->{$key}->{type} eq 'boolean') {
1190
1191                 $value = 1 if $value =~ m/^(1|on|yes|true)$/i; 
1192                 $value = 0 if $value =~ m/^(0|off|no|false)$/i; 
1193             }
1194             $cfg->{$key} = $value;
1195         } else {
1196             warn "ignore config line: $line\n"
1197         }
1198     }
1199
1200     my $errors = {};
1201     check_prop($cfg, $schema, '', $errors);
1202
1203     foreach my $k (keys %$errors) {
1204         warn "parse error in '$filename' - '$k': $errors->{$k}\n";
1205         delete $cfg->{$k};
1206     } 
1207
1208     return $cfg;
1209 }
1210
1211 # generate simple key/value file
1212 sub dump_config {
1213     my ($schema, $filename, $cfg) = @_;
1214
1215     # do fast check (avoid validate_schema($schema))
1216     die "got strange schema" if !$schema->{type} || 
1217         !$schema->{properties} || $schema->{type} ne 'object';
1218
1219     validate($cfg, $schema, "validation error in '$filename'\n");
1220
1221     my $data = '';
1222
1223     foreach my $k (keys %$cfg) {
1224         $data .= "$k: $cfg->{$k}\n";
1225     }
1226
1227     return $data;
1228 }
1229
1230 1;