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