use strict;
use warnings;
-use Data::Dumper;
+use Storable;
use JSON;
+use File::Path qw(make_path);
+
use PVE::APIClient::Exception qw(raise);
-use Getopt::Long;
use Encode::Locale;
use Encode;
use HTTP::Status qw(:constants);
my $pve_api_definition;
-my $pve_api_path_hash;
-my $pve_api_definition_fn = "/usr/share/pve-client/pve-api-definition.js";
+my $pve_api_definition_fn = "/usr/share/pve-client/pve-api-definition.dat";
-my $build_pve_api_path_hash;
-$build_pve_api_path_hash = sub {
- my ($tree) = @_;
+my $method_map = {
+ create => 'POST',
+ set => 'PUT',
+ get => 'GET',
+ delete => 'DELETE',
+};
- my $class = ref($tree);
- return $tree if !$class;
+my $default_output_format = 'text';
+my $client_output_format = $default_output_format;
- if ($class eq 'ARRAY') {
- foreach my $el (@$tree) {
- $build_pve_api_path_hash->($el);
- }
- } elsif ($class eq 'HASH') {
- if (defined($tree->{leaf}) && defined(my $path = $tree->{path})) {
- $pve_api_path_hash->{$path} = $tree;
- }
- foreach my $k (keys %$tree) {
- $build_pve_api_path_hash->($tree->{$k});
+sub set_output_format {
+ my ($format) = @_;
+
+ if (!defined($format)) {
+ $client_output_format = $default_output_format;
+ } else {
+ $client_output_format = $format;
+ }
+}
+
+sub get_output_format {
+ return $client_output_format;
+}
+
+sub print_result {
+ my ($data, $result_schema) = @_;
+
+ my $format = get_output_format();
+
+ return if $result_schema->{type} eq 'null';
+
+ # TODO: implement different output formats ($format)
+
+ if ($format eq 'json') {
+ print to_json($data, {utf8 => 1, allow_nonref => 1, canonical => 1, pretty => 1 });
+ } elsif ($format eq 'text') {
+ my $type = $result_schema->{type};
+ if ($type eq 'object') {
+ die "implement me";
+ } elsif ($type eq 'array') {
+ my $item_type = $result_schema->{items}->{type};
+ if ($item_type eq 'object') {
+ die "implement me";
+ } elsif ($item_type eq 'array') {
+ die "implement me";
+ } else {
+ foreach my $el (@$data) {
+ print "$el\n"
+ }
+ }
+ } else {
+ print "$data\n";
}
+ } else {
+ die "internal error: unknown output format"; # should not happen
}
-};
+}
sub get_api_definition {
if (!defined($pve_api_definition)) {
- local $/;
open(my $fh, '<', $pve_api_definition_fn) ||
die "unable to open '$pve_api_definition_fn' - $!\n";
- my $json_text = <$fh>;
- $pve_api_definition = decode_json($json_text);
-
- $build_pve_api_path_hash->($pve_api_definition);
+ $pve_api_definition = Storable::fd_retrieve($fh);
}
-
return $pve_api_definition;
}
-sub lookup_api_method {
- my ($path, $method) = @_;
+my $map_path_to_info = sub {
+ my ($child_list, $stack, $uri_param) = @_;
- get_api_definition(); # make sure API data is loaded
+ while (defined(my $comp = shift @$stack)) {
+ foreach my $child (@$child_list) {
+ my $text = $child->{text};
- my $info = $pve_api_path_hash->{$path} ||
- die "unable to find API info for path '$path'\n";
+ if ($text eq $comp) {
+ # found
+ } elsif ($text =~ m/^\{(\S+)\}$/) {
+ # found
+ $uri_param->{$1} = $comp;
+ } else {
+ next; # text next child
+ }
+ if ($child->{leaf} || !scalar(@$stack)) {
+ return $child;
+ } else {
+ $child_list = $child->{children};
+ last; # test next path component
+ }
+ }
+ }
+ return undef;
+};
+
+sub find_method_info {
+ my ($path, $method, $uri_param, $noerr) = @_;
+
+ $uri_param //= {};
+
+ my $stack = [ grep { length($_) > 0 } split('\/+' , $path)]; # skip empty fragments
- my $data = $info->{info}->{$method} ||
+ my $child = $map_path_to_info->(get_api_definition(), $stack, $uri_param);
+
+ if (!($child && $child->{info} && $child->{info}->{$method})) {
+ return undef if $noerr;
die "unable to find API method '$method' for path '$path'\n";
+ }
- return $data;
+ return $child->{info}->{$method};
}
-# Getopt wrapper - copied from PVE::JSONSchema::get_options
-# a way to parse command line parameters, using a
-# schema to configure Getopt::Long
-sub get_options {
- my ($schema, $args, $arg_param, $fixed_param, $pwcallback, $param_mapping_hash) = @_;
+sub complete_api_call_options {
+ my ($cmd, $prop, $prev, $cur, $args) = @_;
+
+ my $print_result = sub {
+ foreach my $p (@_) {
+ print "$p\n" if $p =~ m/^$cur/;
+ }
+ };
+
+ my $print_parameter_completion = sub {
+ my ($pname) = @_;
+ my $d = $prop->{$pname};
+ if ($d->{completion}) {
+ my $vt = ref($d->{completion});
+ if ($vt eq 'CODE') {
+ my $res = $d->{completion}->($cmd, $pname, $cur, $args);
+ &$print_result(@$res);
+ }
+ } elsif ($d->{type} eq 'boolean') {
+ &$print_result('0', '1');
+ } elsif ($d->{enum}) {
+ &$print_result(@{$d->{enum}});
+ }
+ };
- if (!$schema || !$schema->{properties}) {
- raise("too many arguments\n", code => HTTP_BAD_REQUEST)
- if scalar(@$args) != 0;
- return {};
+ my @option_list = ();
+ foreach my $key (keys %$prop) {
+ push @option_list, "--$key";
}
- my $list_param;
- if ($arg_param && !ref($arg_param)) {
- my $pd = $schema->{properties}->{$arg_param};
- die "expected list format $pd->{format}"
- if !($pd && $pd->{format} && $pd->{format} =~ m/-list/);
- $list_param = $arg_param;
+ if ($cur =~ m/^-/) {
+ &$print_result(@option_list);
+ return;
}
- my @interactive = ();
- my @getopt = ();
- foreach my $prop (keys %{$schema->{properties}}) {
- my $pd = $schema->{properties}->{$prop};
- next if $list_param && $prop eq $list_param;
- next if defined($fixed_param->{$prop});
-
- my $mapping = $param_mapping_hash->{$prop};
- if ($mapping && $mapping->{interactive}) {
- # interactive parameters such as passwords: make the argument
- # optional and call the mapping function afterwards.
- push @getopt, "$prop:s";
- push @interactive, [$prop, $mapping->{func}];
- } elsif ($prop eq 'password' && $pwcallback) {
- # we do not accept plain password on input line, instead
- # we turn this into a boolean option and ask for password below
- # using $pwcallback() (for security reasons).
- push @getopt, "$prop";
- } elsif ($pd->{type} eq 'boolean') {
- push @getopt, "$prop:s";
- } else {
- if ($pd->{format} && $pd->{format} =~ m/-a?list/) {
- push @getopt, "$prop=s@";
- } else {
- push @getopt, "$prop=s";
- }
- }
+ if ($prev =~ m/^--?(.+)$/ && $prop->{$1}) {
+ my $pname = $1;
+ &$print_parameter_completion($pname);
+ return;
}
- Getopt::Long::Configure('prefix_pattern=(--|-)');
+ &$print_result(@option_list);
+}
- my $opts = {};
- raise("unable to parse option\n", code => HTTP_BAD_REQUEST)
- if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
+sub complete_api_path {
+ my ($text) = @_;
- if (@$args) {
- if ($list_param) {
- $opts->{$list_param} = $args;
- $args = [];
- } elsif (ref($arg_param)) {
- foreach my $arg_name (@$arg_param) {
- if ($opts->{'extra-args'}) {
- raise("internal error: extra-args must be the last argument\n", code => HTTP_BAD_REQUEST);
- }
- if ($arg_name eq 'extra-args') {
- $opts->{'extra-args'} = $args;
- $args = [];
- next;
+ get_api_definition(); # make sure API data is loaded
+
+ $text =~ s!^/!!;
+
+ my ($dir, $rest) = $text =~ m|^(?:(.*)/)?(?:([^/]*))?$|;
+
+ my $info;
+ if (!defined($dir)) {
+ $dir = '';
+ $info = { children => $pve_api_definition };
+ } else {
+ my $stack = [ grep { length($_) > 0 } split('\/+' , $dir)]; # skip empty fragments
+ $info = $map_path_to_info->($pve_api_definition, $stack, {});
+ }
+
+ my $res = [];
+ if ($info) {
+ my $prefix = length($dir) ? "/$dir/" : '/';
+ if (my $children = $info->{children}) {
+ foreach my $c (@$children) {
+ my $ctext = $c->{text};
+ if ($ctext =~ m/^\{(\S+)\}$/) {
+ push @$res, "$prefix$ctext";
+ push @$res, "$prefix$ctext/";
+ if (length($rest)) {
+ push @$res, "$prefix$rest";
+ push @$res, "$prefix$rest/";
+ }
+ } elsif ($ctext =~ m/^\Q$rest/) {
+ push @$res, "$prefix$ctext";
+ push @$res, "$prefix$ctext/" if $c->{children};
}
- raise("not enough arguments\n", code => HTTP_BAD_REQUEST) if !@$args;
- $opts->{$arg_name} = shift @$args;
}
- raise("too many arguments\n", code => HTTP_BAD_REQUEST) if @$args;
- } else {
- raise("too many arguments\n", code => HTTP_BAD_REQUEST)
- if scalar(@$args) != 0;
}
}
- if (my $pd = $schema->{properties}->{password}) {
- if ($pd->{type} ne 'boolean' && $pwcallback) {
- if ($opts->{password} || !$pd->{optional}) {
- $opts->{password} = &$pwcallback();
- }
+ return $res;
+}
+
+# test for command lines with api calls (or similar bash completion calls):
+# example1: pveclient api get remote1 /cluster
+sub extract_path_info {
+ my ($uri_param) = @_;
+
+ my $info;
+
+ my $test_path_properties = sub {
+ my ($args) = @_;
+
+ return if scalar(@$args) < 5;
+ return if $args->[1] ne 'api';
+
+ my $path = $args->[4];
+ if (my $method = $method_map->{$args->[2]}) {
+ $info = find_method_info($path, $method, $uri_param, 1);
+ }
+ };
+
+ if (defined(my $cmd = $ARGV[0])) {
+ if ($cmd eq 'api') {
+ $test_path_properties->([$0, @ARGV]);
+ } elsif ($cmd eq 'bashcomplete') {
+ my $cmdline = substr($ENV{COMP_LINE}, 0, $ENV{COMP_POINT});
+ my $args = PVE::APIClient::Tools::split_args($cmdline);
+ $test_path_properties->($args);
}
}
- foreach my $entry (@interactive) {
- my ($opt, $func) = @$entry;
- my $pd = $schema->{properties}->{$opt};
- my $value = $opts->{$opt};
- if (defined($value) || !$pd->{optional}) {
- $opts->{$opt} = $func->($value);
+ return $info;
+}
+
+sub get_vmid_resource {
+ my ($conn, $vmid) = @_;
+
+ my $resources = $conn->get('api2/json/cluster/resources', {type => 'vm'});
+
+ my $resource;
+ for my $tmp (@$resources) {
+ if ($tmp->{vmid} eq $vmid) {
+ $resource = $tmp;
+ last;
}
}
- # decode after Getopt as we are not sure how well it handles unicode
- foreach my $p (keys %$opts) {
- if (!ref($opts->{$p})) {
- $opts->{$p} = decode('locale', $opts->{$p});
- } elsif (ref($opts->{$p}) eq 'ARRAY') {
- my $tmp = [];
- foreach my $v (@{$opts->{$p}}) {
- push @$tmp, decode('locale', $v);
- }
- $opts->{$p} = $tmp;
- } elsif (ref($opts->{$p}) eq 'SCALAR') {
- $opts->{$p} = decode('locale', $$opts->{$p});
- } else {
- raise("decoding options failed, unknown reference\n", code => HTTP_BAD_REQUEST);
- }
+ if (!defined($resource)) {
+ die "\"$vmid\" not found";
}
- foreach my $p (keys %$opts) {
- if (my $pd = $schema->{properties}->{$p}) {
- if ($pd->{type} eq 'boolean') {
- if ($opts->{$p} eq '') {
- $opts->{$p} = 1;
- } elsif (defined(my $bool = parse_boolean($opts->{$p}))) {
- $opts->{$p} = $bool;
- } else {
- raise("unable to parse boolean option\n", code => HTTP_BAD_REQUEST);
- }
- } elsif ($pd->{format}) {
-
- if ($pd->{format} =~ m/-list/) {
- # allow --vmid 100 --vmid 101 and --vmid 100,101
- # allow --dow mon --dow fri and --dow mon,fri
- $opts->{$p} = join(",", @{$opts->{$p}}) if ref($opts->{$p}) eq 'ARRAY';
- } elsif ($pd->{format} =~ m/-alist/) {
- # we encode array as \0 separated strings
- # Note: CGI.pm also use this encoding
- if (scalar(@{$opts->{$p}}) != 1) {
- $opts->{$p} = join("\0", @{$opts->{$p}});
- } else {
- # st that split_list knows it is \0 terminated
- my $v = $opts->{$p}->[0];
- $opts->{$p} = "$v\0";
- }
- }
- }
+ return $resource;
+}
+
+sub poll_task {
+ my ($conn, $node, $upid) = @_;
+
+ my $path = "api2/json/nodes/$node/tasks/$upid/status";
+
+ my $task_status;
+ while(1) {
+ $task_status = $conn->get($path, {});
+
+ if ($task_status->{status} eq "stopped") {
+ last;
}
+
+ sleep(10);
}
- foreach my $p (keys %$fixed_param) {
- $opts->{$p} = $fixed_param->{$p};
+ return $task_status->{exitstatus};
+}
+
+sub configuration_directory {
+
+ my $home = $ENV{HOME} // '';
+ my $xdg = $ENV{XDG_CONFIG_HOME} // '';
+
+ my $subdir = "pveclient";
+
+ return "$xdg/$subdir" if length($xdg);
+
+ return "$home/.config/$subdir" if length($home);
+
+ die "neither XDG_CONFIG_HOME nor HOME environment variable set\n";
+}
+
+my $ticket_cache_filename = "/.tickets";
+
+sub ticket_cache_lookup {
+ my ($remote) = @_;
+
+ my $dir = configuration_directory();
+ my $filename = "$dir/$ticket_cache_filename";
+
+ my $data = {};
+ eval { $data = from_json(PVE::APIClient::Tools::file_get_contents($filename)); };
+ # ignore errors
+
+ my $ticket = $data->{$remote};
+ return undef if !defined($ticket);
+
+ my $min_age = - 60;
+ my $max_age = 3600*2 - 60;
+
+ if ($ticket =~ m/:([a-fA-F0-9]{8})::/) {
+ my $ttime = hex($1);
+ my $ctime = time();
+ my $age = $ctime - $ttime;
+
+ return $ticket if ($age > $min_age) && ($age < $max_age);
}
- return $opts;
+ return undef;
+}
+
+sub ticket_cache_update {
+ my ($remote, $ticket) = @_;
+
+ my $dir = configuration_directory();
+ my $filename = "$dir/$ticket_cache_filename";
+
+ my $code = sub {
+ make_path($dir);
+ my $data = {};
+ if (-f $filename) {
+ my $raw = PVE::APIClient::Tools::file_get_contents($filename);
+ eval { $data = from_json($raw); };
+ # ignore errors
+ }
+ $data->{$remote} = $ticket;
+
+ PVE::APIClient::Tools::file_set_contents($filename, to_json($data), 0600);
+ };
+
+ PVE::APIClient::Tools::lock_file($filename, undef, $code);
+ die $@ if $@;
}
projects / pve-client.git / blobdiff