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