mirror of
https://git.proxmox.com/git/pve-client
synced 2025-10-04 09:23:07 +00:00
copy and use files from pve-common packages
We don't want to depend on pve-common, so we simply copy used files.
This commit is contained in:
Dietmar Maurer
parent
81ddc6f6ee
commit
565bbc73ca
16
Makefile
16
Makefile
@ -6,7 +6,7 @@ DEB=${PACKAGE}_${PKGVER}-${PKGREL}_all.deb
|
||||
|
||||
DESTDIR=
|
||||
|
||||
PERL5DIR=${DESTDIR}/usr/share/perl5
|
||||
LIB_DIR=${DESTDIR}/usr/share/${PACKAGE}
|
||||
DOCDIR=${DESTDIR}/usr/share/doc/${PACKAGE}
|
||||
|
||||
all: ${DEB}
|
||||
@ -20,8 +20,18 @@ deb ${DEB}:
|
||||
lintian ${DEB}
|
||||
|
||||
install: pve-api-definition.js
|
||||
install -D -m 0644 PVE/APIClient/Helpers.pm ${PERL5DIR}/PVE/APIClient/Helpers.pm
|
||||
install -D -m 0644 pve-api-definition.js ${DESTDIR}/usr/share/${PACKAGE}/pve-api-definition.js
|
||||
install -d -m 0755 ${LIB_DIR}/PVE
|
||||
# install library tools from pve-common
|
||||
install -m 0644 PVE/Tools.pm ${LIB_DIR}/PVE
|
||||
install -m 0644 PVE/SafeSyslog.pm ${LIB_DIR}/PVE
|
||||
install -m 0644 PVE/Exception.pm ${LIB_DIR}/PVE
|
||||
install -m 0644 PVE/JSONSchema.pm ${LIB_DIR}/PVE
|
||||
install -m 0644 PVE/RESTHandler.pm ${LIB_DIR}/PVE
|
||||
install -m 0644 PVE/CLIHandler.pm ${LIB_DIR}/PVE
|
||||
# install pveclient
|
||||
install -D -m 0644 PVE/APIClient/Helpers.pm ${LIB_DIR}/PVE/APIClient/Helpers.pm
|
||||
install -D -m 0644 PVE/APIClient/Commands/remote.pm ${LIB_DIR}/PVE/APIClient/Commands/remote.pm
|
||||
install -D -m 0644 pve-api-definition.js ${LIB_DIR}/pve-api-definition.js
|
||||
install -D -m 0755 pveclient ${DESTDIR}/usr/bin/pveclient
|
||||
|
||||
pve-api-definition.js:
|
||||
|
||||
68
PVE/APIClient/Commands/remote.pm
Normal file
68
PVE/APIClient/Commands/remote.pm
Normal file
@ -0,0 +1,68 @@
|
||||
package PVE::APIClient::Commands::remote;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use PVE::CLIHandler;
|
||||
|
||||
use base qw(PVE::CLIHandler);
|
||||
|
||||
__PACKAGE__->register_method ({
|
||||
name => 'add',
|
||||
path => 'add',
|
||||
method => 'POST',
|
||||
description => "Add a remote to your config file.",
|
||||
parameters => {
|
||||
additionalProperties => 0,
|
||||
properties => {
|
||||
name => {
|
||||
description => "The name of the remote.",
|
||||
type => 'string',
|
||||
},
|
||||
host => {
|
||||
description => "The host, either host, host:port or https://host:port",
|
||||
type => 'string',
|
||||
},
|
||||
username => {
|
||||
description => "The username.",
|
||||
type => 'string',
|
||||
optional => 1,
|
||||
},
|
||||
},
|
||||
},
|
||||
returns => { type => 'null'},
|
||||
code => sub {
|
||||
my ($param) = @_;
|
||||
|
||||
die "implement me";
|
||||
|
||||
}});
|
||||
|
||||
__PACKAGE__->register_method ({
|
||||
name => 'remove',
|
||||
path => 'remove',
|
||||
method => 'DELETE',
|
||||
description => "Removes a remote from your config file.",
|
||||
parameters => {
|
||||
additionalProperties => 0,
|
||||
properties => {
|
||||
name => {
|
||||
description => "The name of the remote.",
|
||||
type => 'string',
|
||||
},
|
||||
},
|
||||
},
|
||||
returns => { type => 'null'},
|
||||
code => sub {
|
||||
my ($param) = @_;
|
||||
|
||||
die "implement me";
|
||||
|
||||
}});
|
||||
|
||||
our $cmddef = {
|
||||
add => [ __PACKAGE__, 'add', ['name', 'host']],
|
||||
remove => [ __PACKAGE__, 'remove', ['name']],
|
||||
};
|
||||
|
||||
1;
|
||||
565
PVE/CLIHandler.pm
Normal file
565
PVE/CLIHandler.pm
Normal file
@ -0,0 +1,565 @@
|
||||
package PVE::CLIHandler;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use PVE::SafeSyslog;
|
||||
use PVE::Exception qw(raise raise_param_exc);
|
||||
use PVE::RESTHandler;
|
||||
|
||||
use base qw(PVE::RESTHandler);
|
||||
|
||||
# $cmddef defines which (sub)commands are available in a specific CLI class.
|
||||
# A real command is always an array consisting of its class, name, array of
|
||||
# position fixed (required) parameters and hash of predefined parameters when
|
||||
# mapping a CLI command t o an API call. Optionally an output method can be
|
||||
# passed at the end, e.g., for formatting or transformation purpose.
|
||||
#
|
||||
# [class, name, fixed_params, API_pre-set params, output_sub ]
|
||||
#
|
||||
# In case of so called 'simple commands', the $cmddef can be also just an
|
||||
# array.
|
||||
#
|
||||
# Examples:
|
||||
# $cmddef = {
|
||||
# command => [ 'PVE::API2::Class', 'command', [ 'arg1', 'arg2' ], { node => $nodename } ],
|
||||
# do => {
|
||||
# this => [ 'PVE::API2::OtherClass', 'method', [ 'arg1' ], undef, sub {
|
||||
# my ($res) = @_;
|
||||
# print "$res\n";
|
||||
# }],
|
||||
# that => [ 'PVE::API2::OtherClass', 'subroutine' [] ],
|
||||
# },
|
||||
# dothat => { alias => 'do that' },
|
||||
# }
|
||||
my $cmddef;
|
||||
my $exename;
|
||||
my $cli_handler_class;
|
||||
|
||||
my $assert_initialized = sub {
|
||||
my @caller = caller;
|
||||
die "$caller[0]:$caller[2] - not initialized\n"
|
||||
if !($cmddef && $exename && $cli_handler_class);
|
||||
};
|
||||
|
||||
my $abort = sub {
|
||||
my ($reason, $cmd) = @_;
|
||||
print_usage_short (\*STDERR, $reason, $cmd);
|
||||
exit (-1);
|
||||
};
|
||||
|
||||
my $expand_command_name = sub {
|
||||
my ($def, $cmd) = @_;
|
||||
|
||||
if (!$def->{$cmd}) {
|
||||
my @expanded = grep { /^\Q$cmd\E/ } keys %$def;
|
||||
return $expanded[0] if scalar(@expanded) == 1; # enforce exact match
|
||||
}
|
||||
return $cmd;
|
||||
};
|
||||
|
||||
my $get_commands = sub {
|
||||
my $def = shift // die "no command definition passed!";
|
||||
return [ grep { !(ref($def->{$_}) eq 'HASH' && defined($def->{$_}->{alias})) } sort keys %$def ];
|
||||
};
|
||||
|
||||
my $complete_command_names = sub { $get_commands->($cmddef) };
|
||||
|
||||
# traverses the command definition using the $argv array, resolving one level
|
||||
# of aliases.
|
||||
# Returns the matching (sub) command and its definition, and argument array for
|
||||
# this (sub) command and a hash where we marked which (sub) commands got
|
||||
# expanded (e.g. st => status) while traversing
|
||||
sub resolve_cmd {
|
||||
my ($argv, $is_alias) = @_;
|
||||
|
||||
my ($def, $cmd) = ($cmddef, $argv);
|
||||
my $cmdstr = $exename;
|
||||
|
||||
if (ref($argv) eq 'ARRAY') {
|
||||
my $expanded = {};
|
||||
my $last_arg_id = scalar(@$argv) - 1;
|
||||
|
||||
for my $i (0..$last_arg_id) {
|
||||
$cmd = $expand_command_name->($def, $argv->[$i]);
|
||||
$cmdstr .= " $cmd";
|
||||
$expanded->{$argv->[$i]} = $cmd if $cmd ne $argv->[$i];
|
||||
last if !defined($def->{$cmd});
|
||||
$def = $def->{$cmd};
|
||||
|
||||
if (ref($def) eq 'ARRAY') {
|
||||
# could expand to a real command, rest of $argv are its arguments
|
||||
my $cmd_args = [ @$argv[$i+1..$last_arg_id] ];
|
||||
return ($cmd, $def, $cmd_args, $expanded, $cmdstr);
|
||||
}
|
||||
|
||||
if (defined($def->{alias})) {
|
||||
die "alias loop detected for '$cmd'" if $is_alias; # avoids cycles
|
||||
# replace aliased (sub)command with the expanded aliased command
|
||||
splice @$argv, $i, 1, split(/ +/, $def->{alias});
|
||||
return resolve_cmd($argv, 1);
|
||||
}
|
||||
}
|
||||
# got either a special command (bashcomplete, verifyapi) or an unknown
|
||||
# cmd, just return first entry as cmd and the rest of $argv as cmd_arg
|
||||
my $cmd_args = [ @$argv[1..$last_arg_id] ];
|
||||
return ($argv->[0], $def, $cmd_args, $expanded, $cmdstr);
|
||||
}
|
||||
return ($cmd, $def, undef, undef, $cmdstr);
|
||||
}
|
||||
|
||||
sub generate_usage_str {
|
||||
my ($format, $cmd, $indent, $separator, $sortfunc) = @_;
|
||||
|
||||
$assert_initialized->();
|
||||
die 'format required' if !$format;
|
||||
|
||||
$sortfunc //= sub { sort keys %{$_[0]} };
|
||||
$separator //= '';
|
||||
$indent //= '';
|
||||
|
||||
my $read_password_func = $cli_handler_class->can('read_password');
|
||||
my $param_mapping_func = $cli_handler_class->can('param_mapping') ||
|
||||
$cli_handler_class->can('string_param_file_mapping');
|
||||
|
||||
my ($subcmd, $def, undef, undef, $cmdstr) = resolve_cmd($cmd);
|
||||
|
||||
my $generate;
|
||||
$generate = sub {
|
||||
my ($indent, $separator, $def, $prefix) = @_;
|
||||
|
||||
my $str = '';
|
||||
if (ref($def) eq 'HASH') {
|
||||
my $oldclass = undef;
|
||||
foreach my $cmd (&$sortfunc($def)) {
|
||||
|
||||
if (ref($def->{$cmd}) eq 'ARRAY') {
|
||||
my ($class, $name, $arg_param, $fixed_param) = @{$def->{$cmd}};
|
||||
|
||||
$str .= $separator if $oldclass && $oldclass ne $class;
|
||||
$str .= $indent;
|
||||
$str .= $class->usage_str($name, "$prefix $cmd", $arg_param,
|
||||
$fixed_param, $format,
|
||||
$read_password_func, $param_mapping_func);
|
||||
$oldclass = $class;
|
||||
|
||||
} elsif (defined($def->{$cmd}->{alias}) && ($format eq 'asciidoc')) {
|
||||
|
||||
$str .= "*$prefix $cmd*\n\nAn alias for '$exename $def->{$cmd}->{alias}'.\n\n";
|
||||
|
||||
} else {
|
||||
next if $def->{$cmd}->{alias};
|
||||
|
||||
my $substr = $generate->($indent, $separator, $def->{$cmd}, "$prefix $cmd");
|
||||
if ($substr) {
|
||||
$substr .= $separator if $substr !~ /\Q$separator\E{2}/;
|
||||
$str .= $substr;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
} else {
|
||||
my ($class, $name, $arg_param, $fixed_param) = @$def;
|
||||
$abort->("unknown command '$cmd'") if !$class;
|
||||
|
||||
$str .= $indent;
|
||||
$str .= $class->usage_str($name, $prefix, $arg_param, $fixed_param, $format,
|
||||
$read_password_func, $param_mapping_func);
|
||||
}
|
||||
return $str;
|
||||
};
|
||||
|
||||
return $generate->($indent, $separator, $def, $cmdstr);
|
||||
}
|
||||
|
||||
__PACKAGE__->register_method ({
|
||||
name => 'help',
|
||||
path => 'help',
|
||||
method => 'GET',
|
||||
description => "Get help about specified command.",
|
||||
parameters => {
|
||||
additionalProperties => 0,
|
||||
properties => {
|
||||
'extra-args' => PVE::JSONSchema::get_standard_option('extra-args', {
|
||||
description => 'Shows help for a specific command',
|
||||
completion => $complete_command_names,
|
||||
}),
|
||||
verbose => {
|
||||
description => "Verbose output format.",
|
||||
type => 'boolean',
|
||||
optional => 1,
|
||||
},
|
||||
},
|
||||
},
|
||||
returns => { type => 'null' },
|
||||
|
||||
code => sub {
|
||||
my ($param) = @_;
|
||||
|
||||
$assert_initialized->();
|
||||
|
||||
my $cmd = $param->{'extra-args'};
|
||||
|
||||
my $verbose = defined($cmd) && $cmd;
|
||||
$verbose = $param->{verbose} if defined($param->{verbose});
|
||||
|
||||
if (!$cmd) {
|
||||
if ($verbose) {
|
||||
print_usage_verbose();
|
||||
} else {
|
||||
print_usage_short(\*STDOUT);
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $str;
|
||||
if ($verbose) {
|
||||
$str = generate_usage_str('full', $cmd, '');
|
||||
} else {
|
||||
$str = generate_usage_str('short', $cmd, ' ' x 7);
|
||||
}
|
||||
$str =~ s/^\s+//;
|
||||
|
||||
if ($verbose) {
|
||||
print "$str\n";
|
||||
} else {
|
||||
print "USAGE: $str\n";
|
||||
}
|
||||
|
||||
return undef;
|
||||
|
||||
}});
|
||||
|
||||
sub print_simple_asciidoc_synopsis {
|
||||
$assert_initialized->();
|
||||
|
||||
my $synopsis = "*${exename}* `help`\n\n";
|
||||
$synopsis .= generate_usage_str('asciidoc');
|
||||
|
||||
return $synopsis;
|
||||
}
|
||||
|
||||
sub print_asciidoc_synopsis {
|
||||
$assert_initialized->();
|
||||
|
||||
my $synopsis = "";
|
||||
|
||||
$synopsis .= "*${exename}* `<COMMAND> [ARGS] [OPTIONS]`\n\n";
|
||||
|
||||
$synopsis .= generate_usage_str('asciidoc');
|
||||
|
||||
$synopsis .= "\n";
|
||||
|
||||
return $synopsis;
|
||||
}
|
||||
|
||||
sub print_usage_verbose {
|
||||
$assert_initialized->();
|
||||
|
||||
print "USAGE: $exename <COMMAND> [ARGS] [OPTIONS]\n\n";
|
||||
|
||||
my $str = generate_usage_str('full');
|
||||
|
||||
print "$str\n";
|
||||
}
|
||||
|
||||
sub print_usage_short {
|
||||
my ($fd, $msg, $cmd) = @_;
|
||||
|
||||
$assert_initialized->();
|
||||
|
||||
print $fd "ERROR: $msg\n" if $msg;
|
||||
print $fd "USAGE: $exename <COMMAND> [ARGS] [OPTIONS]\n";
|
||||
|
||||
print {$fd} generate_usage_str('short', $cmd, ' ' x 7, "\n", sub {
|
||||
my ($h) = @_;
|
||||
return sort {
|
||||
if (ref($h->{$a}) eq 'ARRAY' && ref($h->{$b}) eq 'ARRAY') {
|
||||
# $a and $b are both real commands order them by their class
|
||||
return $h->{$a}->[0] cmp $h->{$b}->[0] || $a cmp $b;
|
||||
} elsif (ref($h->{$a}) eq 'ARRAY' xor ref($h->{$b}) eq 'ARRAY') {
|
||||
# real command and subcommand mixed, put sub commands first
|
||||
return ref($h->{$b}) eq 'ARRAY' ? -1 : 1;
|
||||
} else {
|
||||
# both are either from the same class or subcommands
|
||||
return $a cmp $b;
|
||||
}
|
||||
} keys %$h;
|
||||
});
|
||||
}
|
||||
|
||||
my $print_bash_completion = sub {
|
||||
my ($simple_cmd, $bash_command, $cur, $prev) = @_;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
return if !(defined($cur) && defined($prev) && defined($bash_command));
|
||||
return if !defined($ENV{COMP_LINE});
|
||||
return if !defined($ENV{COMP_POINT});
|
||||
|
||||
my $cmdline = substr($ENV{COMP_LINE}, 0, $ENV{COMP_POINT});
|
||||
print STDERR "\nCMDLINE: $ENV{COMP_LINE}\n" if $debug;
|
||||
|
||||
my $args = PVE::Tools::split_args($cmdline);
|
||||
shift @$args; # no need for program name
|
||||
my $print_result = sub {
|
||||
foreach my $p (@_) {
|
||||
print "$p\n" if $p =~ m/^$cur/;
|
||||
}
|
||||
};
|
||||
|
||||
my ($cmd, $def) = ($simple_cmd, $cmddef);
|
||||
if (!$simple_cmd) {
|
||||
($cmd, $def, $args, my $expaned) = resolve_cmd($args);
|
||||
|
||||
if (ref($def) eq 'HASH') {
|
||||
&$print_result(@{$get_commands->($def)});
|
||||
return;
|
||||
}
|
||||
if (my $expanded_cmd = $expaned->{$cur}) {
|
||||
print "$expanded_cmd\n";
|
||||
return;
|
||||
}
|
||||
}
|
||||
return if !$def;
|
||||
|
||||
my $pos = scalar(@$args) - 1;
|
||||
$pos += 1 if $cmdline =~ m/\s+$/;
|
||||
print STDERR "pos: $pos\n" if $debug;
|
||||
return if $pos < 0;
|
||||
|
||||
my $skip_param = {};
|
||||
|
||||
my ($class, $name, $arg_param, $uri_param) = @$def;
|
||||
$arg_param //= [];
|
||||
$uri_param //= {};
|
||||
|
||||
$arg_param = [ $arg_param ] if !ref($arg_param);
|
||||
|
||||
map { $skip_param->{$_} = 1; } @$arg_param;
|
||||
map { $skip_param->{$_} = 1; } keys %$uri_param;
|
||||
|
||||
my $info = $class->map_method_by_name($name);
|
||||
|
||||
my $prop = $info->{parameters}->{properties};
|
||||
|
||||
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}});
|
||||
}
|
||||
};
|
||||
|
||||
# positional arguments
|
||||
$pos++ if $simple_cmd;
|
||||
if ($pos < scalar(@$arg_param)) {
|
||||
my $pname = $arg_param->[$pos];
|
||||
&$print_parameter_completion($pname);
|
||||
return;
|
||||
}
|
||||
|
||||
my @option_list = ();
|
||||
foreach my $key (keys %$prop) {
|
||||
next if $skip_param->{$key};
|
||||
push @option_list, "--$key";
|
||||
}
|
||||
|
||||
if ($cur =~ m/^-/) {
|
||||
&$print_result(@option_list);
|
||||
return;
|
||||
}
|
||||
|
||||
if ($prev =~ m/^--?(.+)$/ && $prop->{$1}) {
|
||||
my $pname = $1;
|
||||
&$print_parameter_completion($pname);
|
||||
return;
|
||||
}
|
||||
|
||||
&$print_result(@option_list);
|
||||
};
|
||||
|
||||
sub verify_api {
|
||||
my ($class) = @_;
|
||||
|
||||
# simply verify all registered methods
|
||||
PVE::RESTHandler::validate_method_schemas();
|
||||
}
|
||||
|
||||
my $get_exe_name = sub {
|
||||
my ($class) = @_;
|
||||
|
||||
my $name = $class;
|
||||
$name =~ s/^.*:://;
|
||||
$name =~ s/_/-/g;
|
||||
|
||||
return $name;
|
||||
};
|
||||
|
||||
sub generate_bash_completions {
|
||||
my ($class) = @_;
|
||||
|
||||
# generate bash completion config
|
||||
|
||||
$exename = &$get_exe_name($class);
|
||||
|
||||
print <<__EOD__;
|
||||
# $exename bash completion
|
||||
|
||||
# see http://tiswww.case.edu/php/chet/bash/FAQ
|
||||
# and __ltrim_colon_completions() in /usr/share/bash-completion/bash_completion
|
||||
# this modifies global var, but I found no better way
|
||||
COMP_WORDBREAKS=\${COMP_WORDBREAKS//:}
|
||||
|
||||
complete -o default -C '$exename bashcomplete' $exename
|
||||
__EOD__
|
||||
}
|
||||
|
||||
sub generate_asciidoc_synopsys {
|
||||
my ($class) = @_;
|
||||
$class->generate_asciidoc_synopsis();
|
||||
};
|
||||
|
||||
sub generate_asciidoc_synopsis {
|
||||
my ($class) = @_;
|
||||
|
||||
$cli_handler_class = $class;
|
||||
|
||||
$exename = &$get_exe_name($class);
|
||||
|
||||
no strict 'refs';
|
||||
my $def = ${"${class}::cmddef"};
|
||||
$cmddef = $def;
|
||||
|
||||
if (ref($def) eq 'ARRAY') {
|
||||
print_simple_asciidoc_synopsis();
|
||||
} else {
|
||||
$cmddef->{help} = [ __PACKAGE__, 'help', ['cmd'] ];
|
||||
|
||||
print_asciidoc_synopsis();
|
||||
}
|
||||
}
|
||||
|
||||
# overwrite this if you want to run/setup things early
|
||||
sub setup_environment {
|
||||
my ($class) = @_;
|
||||
|
||||
# do nothing by default
|
||||
}
|
||||
|
||||
my $handle_cmd = sub {
|
||||
my ($args, $read_password_func, $preparefunc, $param_mapping_func) = @_;
|
||||
|
||||
$cmddef->{help} = [ __PACKAGE__, 'help', ['extra-args'] ];
|
||||
|
||||
my ($cmd, $def, $cmd_args, undef, $cmd_str) = resolve_cmd($args);
|
||||
|
||||
$abort->("no command specified") if !$cmd;
|
||||
|
||||
# call verifyapi before setup_environment(), don't execute any real code in
|
||||
# this case
|
||||
if ($cmd eq 'verifyapi') {
|
||||
PVE::RESTHandler::validate_method_schemas();
|
||||
return;
|
||||
}
|
||||
|
||||
$cli_handler_class->setup_environment();
|
||||
|
||||
if ($cmd eq 'bashcomplete') {
|
||||
&$print_bash_completion(undef, @$cmd_args);
|
||||
return;
|
||||
}
|
||||
|
||||
# checked special commands, if def is still a hash we got an incomplete sub command
|
||||
$abort->("incomplete command '$cmd_str'") if ref($def) eq 'HASH';
|
||||
|
||||
&$preparefunc() if $preparefunc;
|
||||
|
||||
my ($class, $name, $arg_param, $uri_param, $outsub) = @{$def || []};
|
||||
$abort->("unknown command '$cmd_str'") if !$class;
|
||||
|
||||
my $res = $class->cli_handler($cmd_str, $name, $cmd_args, $arg_param, $uri_param, $read_password_func, $param_mapping_func);
|
||||
|
||||
&$outsub($res) if $outsub;
|
||||
};
|
||||
|
||||
my $handle_simple_cmd = sub {
|
||||
my ($args, $read_password_func, $preparefunc, $param_mapping_func) = @_;
|
||||
|
||||
my ($class, $name, $arg_param, $uri_param, $outsub) = @{$cmddef};
|
||||
die "no class specified" if !$class;
|
||||
|
||||
if (scalar(@$args) >= 1) {
|
||||
if ($args->[0] eq 'help') {
|
||||
my $str = "USAGE: $name help\n";
|
||||
$str .= generate_usage_str('long');
|
||||
print STDERR "$str\n\n";
|
||||
return;
|
||||
} elsif ($args->[0] eq 'verifyapi') {
|
||||
PVE::RESTHandler::validate_method_schemas();
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
$cli_handler_class->setup_environment();
|
||||
|
||||
if (scalar(@$args) >= 1) {
|
||||
if ($args->[0] eq 'bashcomplete') {
|
||||
shift @$args;
|
||||
&$print_bash_completion($name, @$args);
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
&$preparefunc() if $preparefunc;
|
||||
|
||||
my $res = $class->cli_handler($name, $name, \@ARGV, $arg_param, $uri_param, $read_password_func, $param_mapping_func);
|
||||
|
||||
&$outsub($res) if $outsub;
|
||||
};
|
||||
|
||||
sub run_cli_handler {
|
||||
my ($class, %params) = @_;
|
||||
|
||||
$cli_handler_class = $class;
|
||||
|
||||
$ENV{'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin';
|
||||
|
||||
foreach my $key (keys %params) {
|
||||
next if $key eq 'prepare';
|
||||
next if $key eq 'no_init'; # not used anymore
|
||||
next if $key eq 'no_rpcenv'; # not used anymore
|
||||
die "unknown parameter '$key'";
|
||||
}
|
||||
|
||||
my $preparefunc = $params{prepare};
|
||||
|
||||
my $read_password_func = $class->can('read_password');
|
||||
my $param_mapping_func = $cli_handler_class->can('param_mapping') ||
|
||||
$class->can('string_param_file_mapping');
|
||||
|
||||
$exename = &$get_exe_name($class);
|
||||
|
||||
initlog($exename);
|
||||
|
||||
no strict 'refs';
|
||||
$cmddef = ${"${class}::cmddef"};
|
||||
|
||||
if (ref($cmddef) eq 'ARRAY') {
|
||||
&$handle_simple_cmd(\@ARGV, $read_password_func, $preparefunc, $param_mapping_func);
|
||||
} else {
|
||||
&$handle_cmd(\@ARGV, $read_password_func, $preparefunc, $param_mapping_func);
|
||||
}
|
||||
|
||||
exit 0;
|
||||
}
|
||||
|
||||
1;
|
||||
142
PVE/Exception.pm
Normal file
142
PVE/Exception.pm
Normal file
@ -0,0 +1,142 @@
|
||||
package PVE::Exception;
|
||||
|
||||
# a way to add more information to exceptions (see man perlfunc (die))
|
||||
# use PVE::Exception qw(raise);
|
||||
# raise ("my error message", code => 400, errors => { param1 => "err1", ...} );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw(@ISA @EXPORT_OK);
|
||||
require Exporter;
|
||||
use Storable qw(dclone);
|
||||
use HTTP::Status qw(:constants);
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
|
||||
use overload '""' => sub {local $@; shift->stringify};
|
||||
use overload 'cmp' => sub {
|
||||
my ($a, $b) = @_;
|
||||
local $@;
|
||||
return "$a" cmp "$b"; # compare as string
|
||||
};
|
||||
|
||||
@EXPORT_OK = qw(raise raise_param_exc raise_perm_exc);
|
||||
|
||||
sub new {
|
||||
my ($class, $msg, %param) = @_;
|
||||
|
||||
$class = ref($class) || $class;
|
||||
|
||||
my $self = {
|
||||
msg => $msg,
|
||||
};
|
||||
|
||||
foreach my $p (keys %param) {
|
||||
next if defined($self->{$p});
|
||||
my $v = $param{$p};
|
||||
$self->{$p} = ref($v) ? dclone($v) : $v;
|
||||
}
|
||||
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub raise {
|
||||
|
||||
my $exc = PVE::Exception->new(@_);
|
||||
|
||||
my ($pkg, $filename, $line) = caller;
|
||||
|
||||
$exc->{filename} = $filename;
|
||||
$exc->{line} = $line;
|
||||
|
||||
die $exc;
|
||||
}
|
||||
|
||||
sub raise_perm_exc {
|
||||
my ($what) = @_;
|
||||
|
||||
my $param = { code => HTTP_FORBIDDEN };
|
||||
|
||||
my $msg = "Permission check failed";
|
||||
|
||||
$msg .= " ($what)" if $what;
|
||||
|
||||
my $exc = PVE::Exception->new("$msg\n", %$param);
|
||||
|
||||
my ($pkg, $filename, $line) = caller;
|
||||
|
||||
$exc->{filename} = $filename;
|
||||
$exc->{line} = $line;
|
||||
|
||||
die $exc;
|
||||
}
|
||||
|
||||
sub is_param_exc {
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{code} && $self->{code} eq HTTP_BAD_REQUEST;
|
||||
}
|
||||
|
||||
sub raise_param_exc {
|
||||
my ($errors, $usage) = @_;
|
||||
|
||||
my $param = {
|
||||
code => HTTP_BAD_REQUEST,
|
||||
errors => $errors,
|
||||
};
|
||||
|
||||
$param->{usage} = $usage if $usage;
|
||||
|
||||
my $exc = PVE::Exception->new("Parameter verification failed.\n", %$param);
|
||||
|
||||
my ($pkg, $filename, $line) = caller;
|
||||
|
||||
$exc->{filename} = $filename;
|
||||
$exc->{line} = $line;
|
||||
|
||||
die $exc;
|
||||
}
|
||||
|
||||
sub stringify {
|
||||
my $self = shift;
|
||||
|
||||
my $msg = $self->{code} ? "$self->{code} $self->{msg}" : $self->{msg};
|
||||
|
||||
if ($msg !~ m/\n$/) {
|
||||
|
||||
if ($self->{filename} && $self->{line}) {
|
||||
$msg .= " at $self->{filename} line $self->{line}";
|
||||
}
|
||||
|
||||
$msg .= "\n";
|
||||
}
|
||||
|
||||
if ($self->{errors}) {
|
||||
foreach my $e (keys %{$self->{errors}}) {
|
||||
$msg .= "$e: $self->{errors}->{$e}\n";
|
||||
}
|
||||
}
|
||||
|
||||
if ($self->{propagate}) {
|
||||
foreach my $pi (@{$self->{propagate}}) {
|
||||
$msg .= "\t...propagated at $pi->[0] line $pi->[1]\n";
|
||||
}
|
||||
}
|
||||
|
||||
if ($self->{usage}) {
|
||||
$msg .= $self->{usage};
|
||||
$msg .= "\n" if $msg !~ m/\n$/;
|
||||
}
|
||||
|
||||
return $msg;
|
||||
}
|
||||
|
||||
sub PROPAGATE {
|
||||
my ($self, $file, $line) = @_;
|
||||
|
||||
push @{$self->{propagate}}, [$file, $line];
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
1;
|
||||
1806
PVE/JSONSchema.pm
Normal file
1806
PVE/JSONSchema.pm
Normal file
File diff suppressed because it is too large
Load Diff
780
PVE/RESTHandler.pm
Normal file
780
PVE/RESTHandler.pm
Normal file
@ -0,0 +1,780 @@
|
||||
package PVE::RESTHandler;
|
||||
|
||||
use strict;
|
||||
no strict 'refs'; # our autoload requires this
|
||||
use warnings;
|
||||
use PVE::SafeSyslog;
|
||||
use PVE::Exception qw(raise raise_param_exc);
|
||||
use PVE::JSONSchema;
|
||||
use PVE::Tools;
|
||||
use HTTP::Status qw(:constants :is status_message);
|
||||
use Text::Wrap;
|
||||
use Clone qw(clone);
|
||||
|
||||
my $method_registry = {};
|
||||
my $method_by_name = {};
|
||||
my $method_path_lookup = {};
|
||||
|
||||
our $AUTOLOAD; # it's a package global
|
||||
|
||||
sub api_clone_schema {
|
||||
my ($schema) = @_;
|
||||
|
||||
my $res = {};
|
||||
my $ref = ref($schema);
|
||||
die "not a HASH reference" if !($ref && $ref eq 'HASH');
|
||||
|
||||
foreach my $k (keys %$schema) {
|
||||
my $d = $schema->{$k};
|
||||
if ($k ne 'properties') {
|
||||
$res->{$k} = ref($d) ? clone($d) : $d;
|
||||
next;
|
||||
}
|
||||
# convert indexed parameters like -net\d+ to -net[n]
|
||||
foreach my $p (keys %$d) {
|
||||
my $pd = $d->{$p};
|
||||
if ($p =~ m/^([a-z]+)(\d+)$/) {
|
||||
my ($name, $idx) = ($1, $2);
|
||||
if ($idx == 0 && defined($d->{"${name}1"})) {
|
||||
$p = "${name}[n]";
|
||||
} elsif (defined($d->{"${name}0"})) {
|
||||
next; # only handle once for -xx0, but only if -xx0 exists
|
||||
}
|
||||
}
|
||||
my $tmp = ref($pd) ? clone($pd) : $pd;
|
||||
# NOTE: add typetext property for more complex types, to
|
||||
# make the web api viewer code simpler
|
||||
if (!(defined($tmp->{enum}) || defined($tmp->{pattern}))) {
|
||||
my $typetext = PVE::JSONSchema::schema_get_type_text($tmp);
|
||||
if ($tmp->{type} && ($tmp->{type} ne $typetext)) {
|
||||
$tmp->{typetext} = $typetext;
|
||||
}
|
||||
}
|
||||
$res->{$k}->{$p} = $tmp;
|
||||
}
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub api_dump_full {
|
||||
my ($tree, $index, $class, $prefix) = @_;
|
||||
|
||||
$prefix = '' if !$prefix;
|
||||
|
||||
my $ma = $method_registry->{$class};
|
||||
|
||||
foreach my $info (@$ma) {
|
||||
|
||||
my $path = "$prefix/$info->{path}";
|
||||
$path =~ s/\/+$//;
|
||||
|
||||
if ($info->{subclass}) {
|
||||
api_dump_full($tree, $index, $info->{subclass}, $path);
|
||||
} else {
|
||||
next if !$path;
|
||||
|
||||
# check if method is unique
|
||||
my $realpath = $path;
|
||||
$realpath =~ s/\{[^\}]+\}/\{\}/g;
|
||||
my $fullpath = "$info->{method} $realpath";
|
||||
die "duplicate path '$realpath'" if $index->{$fullpath};
|
||||
$index->{$fullpath} = $info;
|
||||
|
||||
# insert into tree
|
||||
my $treedir = $tree;
|
||||
my $res;
|
||||
my $sp = '';
|
||||
foreach my $dir (split('/', $path)) {
|
||||
next if !$dir;
|
||||
$sp .= "/$dir";
|
||||
$res = (grep { $_->{text} eq $dir } @$treedir)[0];
|
||||
if ($res) {
|
||||
$res->{children} = [] if !$res->{children};
|
||||
$treedir = $res->{children};
|
||||
} else {
|
||||
$res = {
|
||||
path => $sp,
|
||||
text => $dir,
|
||||
children => [],
|
||||
};
|
||||
push @$treedir, $res;
|
||||
$treedir = $res->{children};
|
||||
}
|
||||
}
|
||||
|
||||
if ($res) {
|
||||
my $data = {};
|
||||
foreach my $k (keys %$info) {
|
||||
next if $k eq 'code' || $k eq "match_name" || $k eq "match_re" ||
|
||||
$k eq "path";
|
||||
|
||||
my $d = $info->{$k};
|
||||
|
||||
if ($k eq 'parameters') {
|
||||
$data->{$k} = api_clone_schema($d);
|
||||
} else {
|
||||
|
||||
$data->{$k} = ref($d) ? clone($d) : $d;
|
||||
}
|
||||
}
|
||||
$res->{info}->{$info->{method}} = $data;
|
||||
};
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
sub api_dump_cleanup_tree {
|
||||
my ($tree) = @_;
|
||||
|
||||
foreach my $rec (@$tree) {
|
||||
delete $rec->{children} if $rec->{children} && !scalar(@{$rec->{children}});
|
||||
if ($rec->{children}) {
|
||||
$rec->{leaf} = 0;
|
||||
api_dump_cleanup_tree($rec->{children});
|
||||
} else {
|
||||
$rec->{leaf} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# api_dump_remove_refs: prepare API tree for use with to_json($tree)
|
||||
sub api_dump_remove_refs {
|
||||
my ($tree) = @_;
|
||||
|
||||
my $class = ref($tree);
|
||||
return $tree if !$class;
|
||||
|
||||
if ($class eq 'ARRAY') {
|
||||
my $res = [];
|
||||
foreach my $el (@$tree) {
|
||||
push @$res, api_dump_remove_refs($el);
|
||||
}
|
||||
return $res;
|
||||
} elsif ($class eq 'HASH') {
|
||||
my $res = {};
|
||||
foreach my $k (keys %$tree) {
|
||||
if (my $itemclass = ref($tree->{$k})) {
|
||||
if ($itemclass eq 'CODE') {
|
||||
next if $k eq 'completion';
|
||||
}
|
||||
$res->{$k} = api_dump_remove_refs($tree->{$k});
|
||||
} else {
|
||||
$res->{$k} = $tree->{$k};
|
||||
}
|
||||
}
|
||||
return $res;
|
||||
} elsif ($class eq 'Regexp') {
|
||||
return "$tree"; # return string representation
|
||||
} else {
|
||||
die "unknown class '$class'\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub api_dump {
|
||||
my ($class, $prefix) = @_;
|
||||
|
||||
my $tree = [];
|
||||
|
||||
my $index = {};
|
||||
api_dump_full($tree, $index, $class);
|
||||
api_dump_cleanup_tree($tree);
|
||||
return $tree;
|
||||
};
|
||||
|
||||
sub validate_method_schemas {
|
||||
|
||||
foreach my $class (keys %$method_registry) {
|
||||
my $ma = $method_registry->{$class};
|
||||
|
||||
foreach my $info (@$ma) {
|
||||
PVE::JSONSchema::validate_method_info($info);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub register_method {
|
||||
my ($self, $info) = @_;
|
||||
|
||||
my $match_re = [];
|
||||
my $match_name = [];
|
||||
|
||||
my $errprefix;
|
||||
|
||||
my $method;
|
||||
if ($info->{subclass}) {
|
||||
$errprefix = "register subclass $info->{subclass} at ${self}/$info->{path} -";
|
||||
$method = 'SUBCLASS';
|
||||
} else {
|
||||
$errprefix = "register method ${self}/$info->{path} -";
|
||||
$info->{method} = 'GET' if !$info->{method};
|
||||
$method = $info->{method};
|
||||
}
|
||||
|
||||
$method_path_lookup->{$self} = {} if !defined($method_path_lookup->{$self});
|
||||
my $path_lookup = $method_path_lookup->{$self};
|
||||
|
||||
die "$errprefix no path" if !defined($info->{path});
|
||||
|
||||
foreach my $comp (split(/\/+/, $info->{path})) {
|
||||
die "$errprefix path compoment has zero length\n" if $comp eq '';
|
||||
my ($name, $regex);
|
||||
if ($comp =~ m/^\{(\w+)(:(.*))?\}$/) {
|
||||
$name = $1;
|
||||
$regex = $3 ? $3 : '\S+';
|
||||
push @$match_re, $regex;
|
||||
push @$match_name, $name;
|
||||
} else {
|
||||
$name = $comp;
|
||||
push @$match_re, $name;
|
||||
push @$match_name, undef;
|
||||
}
|
||||
|
||||
if ($regex) {
|
||||
$path_lookup->{regex} = {} if !defined($path_lookup->{regex});
|
||||
|
||||
my $old_name = $path_lookup->{regex}->{match_name};
|
||||
die "$errprefix found changed regex match name\n"
|
||||
if defined($old_name) && ($old_name ne $name);
|
||||
my $old_re = $path_lookup->{regex}->{match_re};
|
||||
die "$errprefix found changed regex\n"
|
||||
if defined($old_re) && ($old_re ne $regex);
|
||||
$path_lookup->{regex}->{match_name} = $name;
|
||||
$path_lookup->{regex}->{match_re} = $regex;
|
||||
|
||||
die "$errprefix path match error - regex and fixed items\n"
|
||||
if defined($path_lookup->{folders});
|
||||
|
||||
$path_lookup = $path_lookup->{regex};
|
||||
|
||||
} else {
|
||||
$path_lookup->{folders}->{$name} = {} if !defined($path_lookup->{folders}->{$name});
|
||||
|
||||
die "$errprefix path match error - regex and fixed items\n"
|
||||
if defined($path_lookup->{regex});
|
||||
|
||||
$path_lookup = $path_lookup->{folders}->{$name};
|
||||
}
|
||||
}
|
||||
|
||||
die "$errprefix duplicate method definition\n"
|
||||
if defined($path_lookup->{$method});
|
||||
|
||||
if ($method eq 'SUBCLASS') {
|
||||
foreach my $m (qw(GET PUT POST DELETE)) {
|
||||
die "$errprefix duplicate method definition SUBCLASS and $m\n" if $path_lookup->{$m};
|
||||
}
|
||||
}
|
||||
$path_lookup->{$method} = $info;
|
||||
|
||||
$info->{match_re} = $match_re;
|
||||
$info->{match_name} = $match_name;
|
||||
|
||||
$method_by_name->{$self} = {} if !defined($method_by_name->{$self});
|
||||
|
||||
if ($info->{name}) {
|
||||
die "$errprefix method name already defined\n"
|
||||
if defined($method_by_name->{$self}->{$info->{name}});
|
||||
|
||||
$method_by_name->{$self}->{$info->{name}} = $info;
|
||||
}
|
||||
|
||||
push @{$method_registry->{$self}}, $info;
|
||||
}
|
||||
|
||||
sub DESTROY {}; # avoid problems with autoload
|
||||
|
||||
sub AUTOLOAD {
|
||||
my ($this) = @_;
|
||||
|
||||
# also see "man perldiag"
|
||||
|
||||
my $sub = $AUTOLOAD;
|
||||
(my $method = $sub) =~ s/.*:://;
|
||||
|
||||
my $info = $this->map_method_by_name($method);
|
||||
|
||||
*{$sub} = sub {
|
||||
my $self = shift;
|
||||
return $self->handle($info, @_);
|
||||
};
|
||||
goto &$AUTOLOAD;
|
||||
}
|
||||
|
||||
sub method_attributes {
|
||||
my ($self) = @_;
|
||||
|
||||
return $method_registry->{$self};
|
||||
}
|
||||
|
||||
sub map_method_by_name {
|
||||
my ($self, $name) = @_;
|
||||
|
||||
my $info = $method_by_name->{$self}->{$name};
|
||||
die "no such method '${self}::$name'\n" if !$info;
|
||||
|
||||
return $info;
|
||||
}
|
||||
|
||||
sub map_path_to_methods {
|
||||
my ($class, $stack, $uri_param, $pathmatchref) = @_;
|
||||
|
||||
my $path_lookup = $method_path_lookup->{$class};
|
||||
|
||||
# Note: $pathmatchref can be used to obtain path including
|
||||
# uri patterns like '/cluster/firewall/groups/{group}'.
|
||||
# Used by pvesh to display help
|
||||
if (defined($pathmatchref)) {
|
||||
$$pathmatchref = '' if !$$pathmatchref;
|
||||
}
|
||||
|
||||
while (defined(my $comp = shift @$stack)) {
|
||||
return undef if !$path_lookup; # not registerd?
|
||||
if ($path_lookup->{regex}) {
|
||||
my $name = $path_lookup->{regex}->{match_name};
|
||||
my $regex = $path_lookup->{regex}->{match_re};
|
||||
|
||||
return undef if $comp !~ m/^($regex)$/;
|
||||
$uri_param->{$name} = $1;
|
||||
$path_lookup = $path_lookup->{regex};
|
||||
$$pathmatchref .= '/{' . $name . '}' if defined($pathmatchref);
|
||||
} elsif ($path_lookup->{folders}) {
|
||||
$path_lookup = $path_lookup->{folders}->{$comp};
|
||||
$$pathmatchref .= '/' . $comp if defined($pathmatchref);
|
||||
} else {
|
||||
die "internal error";
|
||||
}
|
||||
|
||||
return undef if !$path_lookup;
|
||||
|
||||
if (my $info = $path_lookup->{SUBCLASS}) {
|
||||
$class = $info->{subclass};
|
||||
|
||||
my $fd = $info->{fragmentDelimiter};
|
||||
|
||||
if (defined($fd)) {
|
||||
# we only support the empty string '' (match whole URI)
|
||||
die "unsupported fragmentDelimiter '$fd'"
|
||||
if $fd ne '';
|
||||
|
||||
$stack = [ join ('/', @$stack) ] if scalar(@$stack) > 1;
|
||||
}
|
||||
$path_lookup = $method_path_lookup->{$class};
|
||||
}
|
||||
}
|
||||
|
||||
return undef if !$path_lookup;
|
||||
|
||||
return ($class, $path_lookup);
|
||||
}
|
||||
|
||||
sub find_handler {
|
||||
my ($class, $method, $path, $uri_param, $pathmatchref) = @_;
|
||||
|
||||
my $stack = [ grep { length($_) > 0 } split('\/+' , $path)]; # skip empty fragments
|
||||
|
||||
my ($handler_class, $path_info);
|
||||
eval {
|
||||
($handler_class, $path_info) = $class->map_path_to_methods($stack, $uri_param, $pathmatchref);
|
||||
};
|
||||
my $err = $@;
|
||||
syslog('err', $err) if $err;
|
||||
|
||||
return undef if !($handler_class && $path_info);
|
||||
|
||||
my $method_info = $path_info->{$method};
|
||||
|
||||
return undef if !$method_info;
|
||||
|
||||
return ($handler_class, $method_info);
|
||||
}
|
||||
|
||||
sub handle {
|
||||
my ($self, $info, $param) = @_;
|
||||
|
||||
my $func = $info->{code};
|
||||
|
||||
if (!($info->{name} && $func)) {
|
||||
raise("Method lookup failed ('$info->{name}')\n",
|
||||
code => HTTP_INTERNAL_SERVER_ERROR);
|
||||
}
|
||||
|
||||
if (my $schema = $info->{parameters}) {
|
||||
# warn "validate ". Dumper($param}) . "\n" . Dumper($schema);
|
||||
PVE::JSONSchema::validate($param, $schema);
|
||||
# untaint data (already validated)
|
||||
my $extra = delete $param->{'extra-args'};
|
||||
while (my ($key, $val) = each %$param) {
|
||||
($param->{$key}) = $val =~ /^(.*)$/s;
|
||||
}
|
||||
$param->{'extra-args'} = [map { /^(.*)$/ } @$extra] if $extra;
|
||||
}
|
||||
|
||||
my $result = &$func($param);
|
||||
|
||||
# todo: this is only to be safe - disable?
|
||||
if (my $schema = $info->{returns}) {
|
||||
PVE::JSONSchema::validate($result, $schema, "Result verification failed\n");
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
# format option, display type and description
|
||||
# $name: option name
|
||||
# $display_name: for example "-$name" of "<$name>", pass undef to use "$name:"
|
||||
# $phash: json schema property hash
|
||||
# $format: 'asciidoc', 'short', 'long' or 'full'
|
||||
# $style: 'config', 'config-sub', 'arg' or 'fixed'
|
||||
# $mapdef: parameter mapping ({ desc => XXX, func => sub {...} })
|
||||
my $get_property_description = sub {
|
||||
my ($name, $style, $phash, $format, $hidepw, $mapdef) = @_;
|
||||
|
||||
my $res = '';
|
||||
|
||||
$format = 'asciidoc' if !defined($format);
|
||||
|
||||
my $descr = $phash->{description} || "no description available";
|
||||
|
||||
if ($phash->{verbose_description} &&
|
||||
($style eq 'config' || $style eq 'config-sub')) {
|
||||
$descr = $phash->{verbose_description};
|
||||
}
|
||||
|
||||
chomp $descr;
|
||||
|
||||
my $type_text = PVE::JSONSchema::schema_get_type_text($phash, $style);
|
||||
|
||||
if ($hidepw && $name eq 'password') {
|
||||
$type_text = '';
|
||||
}
|
||||
|
||||
if ($mapdef && $phash->{type} eq 'string') {
|
||||
$type_text = $mapdef->{desc};
|
||||
}
|
||||
|
||||
if ($format eq 'asciidoc') {
|
||||
|
||||
if ($style eq 'config') {
|
||||
$res .= "`$name`: ";
|
||||
} elsif ($style eq 'config-sub') {
|
||||
$res .= "`$name`=";
|
||||
} elsif ($style eq 'arg') {
|
||||
$res .= "`--$name` ";
|
||||
} elsif ($style eq 'fixed') {
|
||||
$res .= "`<$name>`: ";
|
||||
} else {
|
||||
die "unknown style '$style'";
|
||||
}
|
||||
|
||||
$res .= "`$type_text` " if $type_text;
|
||||
|
||||
if (defined(my $dv = $phash->{default})) {
|
||||
$res .= "('default =' `$dv`)";
|
||||
}
|
||||
|
||||
if ($style eq 'config-sub') {
|
||||
$res .= ";;\n\n";
|
||||
} else {
|
||||
$res .= "::\n\n";
|
||||
}
|
||||
|
||||
my $wdescr = $descr;
|
||||
chomp $wdescr;
|
||||
$wdescr =~ s/^$/+/mg;
|
||||
|
||||
$res .= $wdescr . "\n";
|
||||
|
||||
if (my $req = $phash->{requires}) {
|
||||
my $tmp .= ref($req) ? join(', ', @$req) : $req;
|
||||
$res .= "+\nNOTE: Requires option(s): `$tmp`\n";
|
||||
}
|
||||
$res .= "\n";
|
||||
|
||||
} elsif ($format eq 'short' || $format eq 'long' || $format eq 'full') {
|
||||
|
||||
my $defaulttxt = '';
|
||||
if (defined(my $dv = $phash->{default})) {
|
||||
$defaulttxt = " (default=$dv)";
|
||||
}
|
||||
|
||||
my $display_name;
|
||||
if ($style eq 'config') {
|
||||
$display_name = "$name:";
|
||||
} elsif ($style eq 'arg') {
|
||||
$display_name = "-$name";
|
||||
} elsif ($style eq 'fixed') {
|
||||
$display_name = "<$name>";
|
||||
} else {
|
||||
die "unknown style '$style'";
|
||||
}
|
||||
|
||||
my $tmp = sprintf " %-10s %s$defaulttxt\n", $display_name, "$type_text";
|
||||
my $indend = " ";
|
||||
|
||||
$res .= Text::Wrap::wrap('', $indend, ($tmp));
|
||||
$res .= "\n",
|
||||
$res .= Text::Wrap::wrap($indend, $indend, ($descr)) . "\n\n";
|
||||
|
||||
if (my $req = $phash->{requires}) {
|
||||
my $tmp = "Requires option(s): ";
|
||||
$tmp .= ref($req) ? join(', ', @$req) : $req;
|
||||
$res .= Text::Wrap::wrap($indend, $indend, ($tmp)). "\n\n";
|
||||
}
|
||||
|
||||
} else {
|
||||
die "unknown format '$format'";
|
||||
}
|
||||
|
||||
return $res;
|
||||
};
|
||||
|
||||
# translate parameter mapping definition
|
||||
# $mapping_array is a array which can contain:
|
||||
# strings ... in that case we assume it is a parameter name, and
|
||||
# we want to load that parameter from a file
|
||||
# [ param_name, func, desc] ... allows you to specify a arbitrary
|
||||
# mapping func for any param
|
||||
#
|
||||
# Returns: a hash indexed by parameter_name,
|
||||
# i.e. { param_name => { func => .., desc => ... } }
|
||||
my $compute_param_mapping_hash = sub {
|
||||
my ($mapping_array) = @_;
|
||||
|
||||
my $res = {};
|
||||
|
||||
return $res if !defined($mapping_array);
|
||||
|
||||
foreach my $item (@$mapping_array) {
|
||||
my ($name, $func, $desc, $interactive);
|
||||
if (ref($item) eq 'ARRAY') {
|
||||
($name, $func, $desc, $interactive) = @$item;
|
||||
} else {
|
||||
$name = $item;
|
||||
$func = sub { return PVE::Tools::file_get_contents($_[0]) };
|
||||
}
|
||||
$desc //= '<filepath>';
|
||||
$res->{$name} = { desc => $desc, func => $func, interactive => $interactive };
|
||||
}
|
||||
|
||||
return $res;
|
||||
};
|
||||
|
||||
# generate usage information for command line tools
|
||||
#
|
||||
# $name ... the name of the method
|
||||
# $prefix ... usually something like "$exename $cmd" ('pvesm add')
|
||||
# $arg_param ... list of parameters we want to get as ordered arguments
|
||||
# on the command line (or single parameter name for lists)
|
||||
# $fixed_param ... do not generate and info about those parameters
|
||||
# $format:
|
||||
# 'long' ... default (text, list all options)
|
||||
# 'short' ... command line only (text, one line)
|
||||
# 'full' ... text, include description
|
||||
# 'asciidoc' ... generate asciidoc for man pages (like 'full')
|
||||
# $hidepw ... hide password option (use this if you provide a read passwork callback)
|
||||
# $param_mapping_func ... mapping for string parameters to file path parameters
|
||||
sub usage_str {
|
||||
my ($self, $name, $prefix, $arg_param, $fixed_param, $format, $hidepw, $param_mapping_func) = @_;
|
||||
|
||||
$format = 'long' if !$format;
|
||||
|
||||
my $info = $self->map_method_by_name($name);
|
||||
my $schema = $info->{parameters};
|
||||
my $prop = $schema->{properties};
|
||||
|
||||
my $out = '';
|
||||
|
||||
my $arg_hash = {};
|
||||
|
||||
my $args = '';
|
||||
|
||||
$arg_param = [ $arg_param ] if $arg_param && !ref($arg_param);
|
||||
|
||||
foreach my $p (@$arg_param) {
|
||||
next if !$prop->{$p}; # just to be sure
|
||||
my $pd = $prop->{$p};
|
||||
|
||||
$arg_hash->{$p} = 1;
|
||||
$args .= " " if $args;
|
||||
if ($pd->{format} && $pd->{format} =~ m/-list/) {
|
||||
$args .= "{<$p>}";
|
||||
} else {
|
||||
$args .= $pd->{optional} ? "[<$p>]" : "<$p>";
|
||||
}
|
||||
}
|
||||
|
||||
my $argdescr = '';
|
||||
foreach my $k (@$arg_param) {
|
||||
next if defined($fixed_param->{$k}); # just to be sure
|
||||
next if !$prop->{$k}; # just to be sure
|
||||
$argdescr .= &$get_property_description($k, 'fixed', $prop->{$k}, $format, 0);
|
||||
}
|
||||
|
||||
my $idx_param = {}; # -vlan\d+ -scsi\d+
|
||||
|
||||
my $opts = '';
|
||||
foreach my $k (sort keys %$prop) {
|
||||
next if $arg_hash->{$k};
|
||||
next if defined($fixed_param->{$k});
|
||||
|
||||
my $type_text = $prop->{$k}->{type} || 'string';
|
||||
|
||||
next if $hidepw && ($k eq 'password') && !$prop->{$k}->{optional};
|
||||
|
||||
my $base = $k;
|
||||
if ($k =~ m/^([a-z]+)(\d+)$/) {
|
||||
my ($name, $idx) = ($1, $2);
|
||||
next if $idx_param->{$name};
|
||||
if ($idx == 0 && defined($prop->{"${name}1"})) {
|
||||
$idx_param->{$name} = 1;
|
||||
$base = "${name}[n]";
|
||||
}
|
||||
}
|
||||
|
||||
my $param_mapping_hash = $compute_param_mapping_hash->(&$param_mapping_func($name))
|
||||
if $param_mapping_func;
|
||||
|
||||
$opts .= &$get_property_description($base, 'arg', $prop->{$k}, $format,
|
||||
$hidepw, $param_mapping_hash->{$k});
|
||||
|
||||
if (!$prop->{$k}->{optional}) {
|
||||
$args .= " " if $args;
|
||||
$args .= "--$base <$type_text>"
|
||||
}
|
||||
}
|
||||
|
||||
if ($format eq 'asciidoc') {
|
||||
$out .= "*${prefix}*";
|
||||
$out .= " `$args`" if $args;
|
||||
$out .= $opts ? " `[OPTIONS]`\n" : "\n";
|
||||
} else {
|
||||
$out .= "USAGE: " if $format ne 'short';
|
||||
$out .= "$prefix $args";
|
||||
$out .= $opts ? " [OPTIONS]\n" : "\n";
|
||||
}
|
||||
|
||||
return $out if $format eq 'short';
|
||||
|
||||
if ($info->{description}) {
|
||||
if ($format eq 'asciidoc') {
|
||||
my $desc = Text::Wrap::wrap('', '', ($info->{description}));
|
||||
$out .= "\n$desc\n\n";
|
||||
} elsif ($format eq 'full') {
|
||||
my $desc = Text::Wrap::wrap(' ', ' ', ($info->{description}));
|
||||
$out .= "\n$desc\n\n";
|
||||
}
|
||||
}
|
||||
|
||||
$out .= $argdescr if $argdescr;
|
||||
|
||||
$out .= $opts if $opts;
|
||||
|
||||
return $out;
|
||||
}
|
||||
|
||||
# generate docs from JSON schema properties
|
||||
sub dump_properties {
|
||||
my ($prop, $format, $style, $filterFn) = @_;
|
||||
|
||||
my $raw = '';
|
||||
|
||||
$style //= 'config';
|
||||
|
||||
my $idx_param = {}; # -vlan\d+ -scsi\d+
|
||||
|
||||
foreach my $k (sort keys %$prop) {
|
||||
my $phash = $prop->{$k};
|
||||
|
||||
next if defined($filterFn) && &$filterFn($k, $phash);
|
||||
next if $phash->{alias};
|
||||
|
||||
my $base = $k;
|
||||
if ($k =~ m/^([a-z]+)(\d+)$/) {
|
||||
my ($name, $idx) = ($1, $2);
|
||||
next if $idx_param->{$name};
|
||||
if ($idx == 0 && defined($prop->{"${name}1"})) {
|
||||
$idx_param->{$name} = 1;
|
||||
$base = "${name}[n]";
|
||||
}
|
||||
}
|
||||
|
||||
$raw .= &$get_property_description($base, $style, $phash, $format, 0);
|
||||
|
||||
next if $style ne 'config';
|
||||
|
||||
my $prop_fmt = $phash->{format};
|
||||
next if !$prop_fmt;
|
||||
|
||||
if (ref($prop_fmt) ne 'HASH') {
|
||||
$prop_fmt = PVE::JSONSchema::get_format($prop_fmt);
|
||||
}
|
||||
|
||||
next if !(ref($prop_fmt) && (ref($prop_fmt) eq 'HASH'));
|
||||
|
||||
$raw .= dump_properties($prop_fmt, $format, 'config-sub')
|
||||
|
||||
}
|
||||
|
||||
return $raw;
|
||||
}
|
||||
|
||||
my $replace_file_names_with_contents = sub {
|
||||
my ($param, $param_mapping_hash) = @_;
|
||||
|
||||
while (my ($k, $d) = each %$param_mapping_hash) {
|
||||
next if $d->{interactive}; # handled by the JSONSchema's get_options code
|
||||
$param->{$k} = $d->{func}->($param->{$k})
|
||||
if defined($param->{$k});
|
||||
}
|
||||
|
||||
return $param;
|
||||
};
|
||||
|
||||
sub cli_handler {
|
||||
my ($self, $prefix, $name, $args, $arg_param, $fixed_param, $read_password_func, $param_mapping_func) = @_;
|
||||
|
||||
my $info = $self->map_method_by_name($name);
|
||||
|
||||
my $res;
|
||||
eval {
|
||||
my $param_mapping_hash = $compute_param_mapping_hash->($param_mapping_func->($name)) if $param_mapping_func;
|
||||
my $param = PVE::JSONSchema::get_options($info->{parameters}, $args, $arg_param, $fixed_param, $read_password_func, $param_mapping_hash);
|
||||
|
||||
if (defined($param_mapping_hash)) {
|
||||
&$replace_file_names_with_contents($param, $param_mapping_hash);
|
||||
}
|
||||
|
||||
$res = $self->handle($info, $param);
|
||||
};
|
||||
if (my $err = $@) {
|
||||
my $ec = ref($err);
|
||||
|
||||
die $err if !$ec || $ec ne "PVE::Exception" || !$err->is_param_exc();
|
||||
|
||||
$err->{usage} = $self->usage_str($name, $prefix, $arg_param, $fixed_param, 'short', $read_password_func, $param_mapping_func);
|
||||
|
||||
die $err;
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
# utility methods
|
||||
# note: this modifies the original hash by adding the id property
|
||||
sub hash_to_array {
|
||||
my ($hash, $idprop) = @_;
|
||||
|
||||
my $res = [];
|
||||
return $res if !$hash;
|
||||
|
||||
foreach my $k (keys %$hash) {
|
||||
$hash->{$k}->{$idprop} = $k;
|
||||
push @$res, $hash->{$k};
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
1;
|
||||
51
PVE/SafeSyslog.pm
Normal file
51
PVE/SafeSyslog.pm
Normal file
@ -0,0 +1,51 @@
|
||||
package PVE::SafeSyslog;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use File::Basename;
|
||||
use Sys::Syslog ();
|
||||
use Encode;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT);
|
||||
|
||||
$VERSION = '1.00';
|
||||
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
|
||||
@EXPORT = qw(syslog initlog);
|
||||
|
||||
my $log_tag = "unknown";
|
||||
|
||||
# never log to console - thats too slow, and
|
||||
# it corrupts the DBD database connection!
|
||||
|
||||
sub syslog {
|
||||
eval { Sys::Syslog::syslog (@_); }; # ignore errors
|
||||
}
|
||||
|
||||
sub initlog {
|
||||
my ($tag, $facility) = @_;
|
||||
|
||||
if ($tag) {
|
||||
$tag = basename($tag);
|
||||
|
||||
$tag = encode("ascii", decode_utf8($tag));
|
||||
|
||||
$log_tag = $tag;
|
||||
}
|
||||
|
||||
$facility = "daemon" if !$facility;
|
||||
|
||||
# never log to console - thats too slow
|
||||
Sys::Syslog::setlogsock ('unix');
|
||||
|
||||
Sys::Syslog::openlog ($log_tag, 'pid', $facility);
|
||||
}
|
||||
|
||||
sub tag {
|
||||
return $log_tag;
|
||||
}
|
||||
|
||||
1;
|
||||
129
PVE/Tools.pm
Normal file
129
PVE/Tools.pm
Normal file
@ -0,0 +1,129 @@
|
||||
package PVE::Tools;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use POSIX qw(EINTR EEXIST EOPNOTSUPP);
|
||||
use base 'Exporter';
|
||||
|
||||
use IO::File;
|
||||
|
||||
our @EXPORT_OK = qw(
|
||||
$IPV6RE
|
||||
$IPV4RE
|
||||
split_list
|
||||
file_set_contents
|
||||
file_get_contents
|
||||
);
|
||||
|
||||
my $IPV4OCTET = "(?:25[0-5]|(?:2[0-4]|1[0-9]|[1-9])?[0-9])";
|
||||
our $IPV4RE = "(?:(?:$IPV4OCTET\\.){3}$IPV4OCTET)";
|
||||
my $IPV6H16 = "(?:[0-9a-fA-F]{1,4})";
|
||||
my $IPV6LS32 = "(?:(?:$IPV4RE|$IPV6H16:$IPV6H16))";
|
||||
|
||||
our $IPV6RE = "(?:" .
|
||||
"(?:(?:" . "(?:$IPV6H16:){6})$IPV6LS32)|" .
|
||||
"(?:(?:" . "::(?:$IPV6H16:){5})$IPV6LS32)|" .
|
||||
"(?:(?:(?:" . "$IPV6H16)?::(?:$IPV6H16:){4})$IPV6LS32)|" .
|
||||
"(?:(?:(?:(?:$IPV6H16:){0,1}$IPV6H16)?::(?:$IPV6H16:){3})$IPV6LS32)|" .
|
||||
"(?:(?:(?:(?:$IPV6H16:){0,2}$IPV6H16)?::(?:$IPV6H16:){2})$IPV6LS32)|" .
|
||||
"(?:(?:(?:(?:$IPV6H16:){0,3}$IPV6H16)?::(?:$IPV6H16:){1})$IPV6LS32)|" .
|
||||
"(?:(?:(?:(?:$IPV6H16:){0,4}$IPV6H16)?::" . ")$IPV6LS32)|" .
|
||||
"(?:(?:(?:(?:$IPV6H16:){0,5}$IPV6H16)?::" . ")$IPV6H16)|" .
|
||||
"(?:(?:(?:(?:$IPV6H16:){0,6}$IPV6H16)?::" . ")))";
|
||||
|
||||
our $IPRE = "(?:$IPV4RE|$IPV6RE)";
|
||||
|
||||
sub file_set_contents {
|
||||
my ($filename, $data, $perm) = @_;
|
||||
|
||||
$perm = 0644 if !defined($perm);
|
||||
|
||||
my $tmpname = "$filename.tmp.$$";
|
||||
|
||||
eval {
|
||||
my ($fh, $tries) = (undef, 0);
|
||||
while (!$fh && $tries++ < 3) {
|
||||
$fh = IO::File->new($tmpname, O_WRONLY|O_CREAT|O_EXCL, $perm);
|
||||
if (!$fh && $! == EEXIST) {
|
||||
unlink($tmpname) or die "unable to delete old temp file: $!\n";
|
||||
}
|
||||
}
|
||||
die "unable to open file '$tmpname' - $!\n" if !$fh;
|
||||
die "unable to write '$tmpname' - $!\n" unless print $fh $data;
|
||||
die "closing file '$tmpname' failed - $!\n" unless close $fh;
|
||||
};
|
||||
my $err = $@;
|
||||
|
||||
if ($err) {
|
||||
unlink $tmpname;
|
||||
die $err;
|
||||
}
|
||||
|
||||
if (!rename($tmpname, $filename)) {
|
||||
my $msg = "close (rename) atomic file '$filename' failed: $!\n";
|
||||
unlink $tmpname;
|
||||
die $msg;
|
||||
}
|
||||
}
|
||||
|
||||
sub file_get_contents {
|
||||
my ($filename, $max) = @_;
|
||||
|
||||
my $fh = IO::File->new($filename, "r") ||
|
||||
die "can't open '$filename' - $!\n";
|
||||
|
||||
my $content = safe_read_from($fh, $max, 0, $filename);
|
||||
|
||||
close $fh;
|
||||
|
||||
return $content;
|
||||
}
|
||||
|
||||
sub file_read_firstline {
|
||||
my ($filename) = @_;
|
||||
|
||||
my $fh = IO::File->new ($filename, "r");
|
||||
return undef if !$fh;
|
||||
my $res = <$fh>;
|
||||
chomp $res if $res;
|
||||
$fh->close;
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub safe_read_from {
|
||||
my ($fh, $max, $oneline, $filename) = @_;
|
||||
|
||||
$max = 32768 if !$max;
|
||||
|
||||
my $subject = defined($filename) ? "file '$filename'" : 'input';
|
||||
|
||||
my $br = 0;
|
||||
my $input = '';
|
||||
my $count;
|
||||
while ($count = sysread($fh, $input, 8192, $br)) {
|
||||
$br += $count;
|
||||
die "$subject too long - aborting\n" if $br > $max;
|
||||
if ($oneline && $input =~ m/^(.*)\n/) {
|
||||
$input = $1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
die "unable to read $subject - $!\n" if !defined($count);
|
||||
|
||||
return $input;
|
||||
}
|
||||
|
||||
sub split_list {
|
||||
my $listtxt = shift || '';
|
||||
|
||||
return split (/\0/, $listtxt) if $listtxt =~ m/\0/;
|
||||
|
||||
$listtxt =~ s/[,;]/ /g;
|
||||
$listtxt =~ s/^\s+//;
|
||||
|
||||
my @data = split (/\s+/, $listtxt);
|
||||
|
||||
return @data;
|
||||
}
|
||||
|
||||
1;
|
||||
10
README
10
README
@ -1 +1,11 @@
|
||||
Experimental PVE Client
|
||||
|
||||
|
||||
The following files are copied from our pve-common package:
|
||||
|
||||
PVE/CLIHandler.pm: removed PVE::Inotify use.
|
||||
PVE/Exception.pm
|
||||
PVE/JSONSchema.pm
|
||||
PVE/RESTHandler.pm
|
||||
PVE/SafeSyslog.pm
|
||||
PVE/Tools.pm: only selected/required helpers
|
||||
12
pveclient
12
pveclient
@ -2,11 +2,15 @@
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib '.';
|
||||
use lib '/usr/share/pve-client';
|
||||
use Data::Dumper;
|
||||
|
||||
use PVE::CLIHandler;
|
||||
|
||||
use PVE::APIClient::LWP;
|
||||
use PVE::APIClient::Helpers;
|
||||
use PVE::APIClient::Commands::remote;
|
||||
|
||||
use JSON;
|
||||
|
||||
sub print_usage {
|
||||
@ -61,10 +65,10 @@ if ($cmd eq 'get') {
|
||||
die "implement me";
|
||||
} elsif ($cmd eq 'delete') {
|
||||
die "implement me";
|
||||
} elsif ($cmd eq 'enter') {
|
||||
die "implement me";
|
||||
} elsif ($cmd eq 'remote') {
|
||||
PVE::APIClient::Commands::remote->run_cli_handler();
|
||||
} else {
|
||||
print_usage();
|
||||
}
|
||||
|
||||
die "implement me";
|
||||
exit(0);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user