Permalink
Fetching contributors…
Cannot retrieve contributors at this time
323 lines (279 sloc) 10 KB
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use App::Rad qw(MoreHelp);
use Carp qw(croak);
use JSON qw(from_json to_json);
use LWP;
use Pod::Select;
use Net::OpenStack::Compute;
# Need to set this for App::Rad which prints to STDOUT
binmode STDOUT, ':encoding(UTF-8)';
sub setup {
my $c = shift;
$c->register_commands({
server => 'perform server actions',
image => 'perform image actions',
flavor => 'perform flavor actions',
});
$c->register(s => \&server, 'alias for server');
$c->register(i => \&image, 'alias for image');
$c->register(f => \&flavor, 'alias for flavor');
$c->more_help(_parse_pod());
$c->getopt('verbose|v', 'insecure', 'query|q=s');
$c->stash->{compute} = Net::OpenStack::Compute->new_from_env(
$c->options->{insecure} ? (verify_ssl => 0) : ()
);
}
App::Rad->run();
sub server {
my $c = shift;
my $compute = $c->stash->{compute};
my @args = @{$c->argv};
my $sub_cmd = shift @args;
given ($sub_cmd) {
when ([undef, 'list']) { return _get_servers($c) }
when ([qw(show s)]) {
die "Usage: $0 server show <server>\n" unless @args == 1;
my $id = $args[0];
my $s = _get_server($c, $id);
return _to_json($s) if $c->options->{verbose};
return _format_servers($s);
}
when ([qw(create c)]) {
die "Usage: $0 server create <name> <flavor> <image>\n"
unless @args == 3;
my ($name, $flavor, $image) = @args;
my $s = $compute->create_server({
name => $name, flavorRef => $flavor, imageRef => $image});
return _to_json($s) if $c->options->{verbose};
return "Creating server $s->{id} with password $s->{adminPass}";
}
when ([qw(delete d rm)]) {
die "Usage: $0 server delete <server>\n" unless @args == 1;
my ($id) = @args;
my $s = _get_server($c, $id);
$compute->delete_server($s->{id});
return "Server $id has been marked for deletion.";
}
when ('rebuild') {
die "Usage: $0 server rebuild <server> <image-id>\n"
unless @args == 2;
my ($server_id, $image_id) = @args;
my $s = _get_server($c, $server_id);
$s = $compute->rebuild_server($s->{id}, { imageRef => $image_id });
return _to_json($s) if $c->options->{verbose};
return "Server $server_id is rebuilding.";
}
when ('resize') {
die "Usage: $0 server resize <server> <flavor-id>\n"
unless @args == 2;
my ($server_id, $flavor_id) = @args;
my $s = _get_server($c, $server_id);
$compute->resize_server($s->{id}, { flavorRef => $flavor_id });
return "Server $server_id is resizing.";
}
when ('reboot') {
die "Usage: $0 server reboot <server> [soft|hard]\n" unless @args;
my ($server_id, $type) = @args;
$type ||= 'SOFT';
my $s = _get_server($c, $server_id);
$compute->reboot_server($s->{id}, { type => $type });
return "Server $server_id is rebooting.";
}
when ([qw(password pass p)]) {
die "Usage: $0 server password <server> <password>\n"
unless @args == 2;
my ($server_id, $password) = @args;
my $s = _get_server($c, $server_id);
$compute->set_password($s->{id}, $password);
return "Changing password for $server_id to '$password'.";
}
default {
die "Supported server commands are list, show, create and delete."
. "\n";
}
}
}
sub image {
my $c = shift;
my $compute = $c->stash->{compute};
my @args = @{$c->argv};
my $sub_cmd = shift @args;
given ($sub_cmd) {
when ([undef, 'list']) { return _get_images($c) }
when ([qw(show s)]) {
die "Usage: $0 image show <id>\n" unless @args == 1;
my $img = $compute->get_image($args[0]);
return _to_json($img) if $c->options->{verbose};
return 'No such image' unless $img;
return _format_images($img);
}
when ([qw(create c)]) {
die "Usage: $0 image create <name> <server>\n" unless @args == 2;
my ($name, $server) = @args;
my $s = _get_server($c, $server);
$compute->create_image($s->{id}, { name => $name });
return "Snapshot of server $server has been scheduled.";
}
when ([qw(delete d rm)]) {
die "Usage: $0 image delete <id>\n" unless @args == 1;
my ($id) = @args;
$compute->delete_image($id);
return "Image $id has been marked for deletion.";
}
default {
die "Supported image commands are list, show, create and delete.\n";
}
}
}
sub flavor {
my $c = shift;
my $compute = $c->stash->{compute};
my @args = @{$c->argv};
my $sub_cmd = shift @args;
given ($sub_cmd) {
when ([undef, 'list']) { return _get_flavors($c) }
when ([qw(show s)]) {
die "Usage: $0 flavor show <id>\n" unless @args == 1;
my $flavor = $compute->get_flavor($args[0]);
die "No such flavor\n" unless $flavor;
return _to_json($flavor) if $c->options->{verbose};
return _format_flavors($flavor);
}
default {
die "Supported flavor commands are list, show, create and delete."
. "\n";
}
}
}
sub _get_server {
my ($c, $id) = @_;
die "Server id is missing.\n" unless defined $id;
my $compute = $c->stash->{compute};
my $s = $compute->get_server($id);
$s = $compute->get_servers_by_name($id)->[0] unless $s;
die "Server $id does not exist.\n" unless $s;
}
sub _get_servers {
my $c = shift;
my $compute = $c->stash->{compute};
my $q = $c->options->{query};
my $servers = $compute->get_servers(detail => 1, query => $q);
return _to_json($servers) if $c->options->{verbose};
return _format_servers(@$servers);
}
sub _get_images {
my $c = shift;
my $compute = $c->stash->{compute};
my $q = $c->options->{query};
my $images = $compute->get_images(detail => 1, query => $q);
return _to_json($images) if $c->options->{verbose};
return _format_images(@$images);
}
sub _get_flavors {
my $c = shift;
my $compute = $c->stash->{compute};
my $q = $c->options->{query};
my $flavors = $compute->get_flavors(detail => 1, query => $q);
return _to_json($flavors) if $c->options->{verbose};
return _format_flavors(@$flavors);
}
sub _format_servers {
my @servers = @_;
join "\n", map { join "\t", @$_{qw(id name status)}, _get_ip($_) } @servers;
}
sub _format_images {
my @images = @_;
join "\n", map { join "\t", @$_{qw(id name status)} } @images;
}
sub _format_flavors {
my @flavors = @_;
join "\n", map { join "\t", @$_{qw(id name ram)} } @flavors;
}
sub _get_ip {
my $server = shift;
for my $addr (map @{$server->{addresses}{$_} || []}, qw(public private)) {
return $addr->{addr} if $addr->{version} == 4;
}
return 'IP-MISSING';
}
# Warning, recursive magic ahead.
sub _to_json {
ref $_[0] ? to_json($_[0], {pretty => 1}) : _to_json(from_json($_[0]))
}
sub _parse_pod {
my $parser = Pod::Select->new();
$parser->select('ARGUMENTS');
open my $out, '>', \my $output;
open my $this_file, __FILE__;
$parser->parse_from_filehandle($this_file, $out);
# Skip the pod header, the first 2 lines
my @lines = split /\n/, $output;
return join "\n", @lines[2 .. $#lines];
}
# PODNAME: oscompute
=head1 SYNOPSIS
Usage: oscompute command [arguments]
Available Commands:
f alias for flavor
flavor perform flavor actions
help show syntax and available commands
i alias for image
image perform image actions
s alias for server
server perform server actions
Examples:
# List all servers.
oscompute s
# Same thing.
oscompute server
# Same thing.
oscompute server list
# Show all details.
oscompute server -v list
# Show info for a particular server by id.
oscompute server show ec05b52e-f575-469c-a91e-7f0ddd4fab95
# Show info for a particular server by name.
oscompute server show bob
# Create a new server.
# Order of arguments are server create `name` `flavor` `image`
oscompute server create bob 1 11b2a5bf-590c-4dd4-931f-a65751a4db0e
# Delete a server.
oscompute server delete ec05b52e-f575-469c-a91e-7f0ddd4fab95
# Rebuild server bob with the given image.
oscompute server rebuild bob d54c514e-da74-4307-805a-423a06160f6c
# List all available images.
oscompute image list
# Create a snapshot image of a given server.
oscompute image create new-img-name bob
=head1 ARGUMENTS
Server commands:
server [list]
server show <server>
server create <name> <flavor> <image-id>
server delete <server>
server rebuild <server> <image-id>
server resize <server> <flavor-id>
server reboot <server> [soft|hard]
server password <server> <new-password>
Image commands:
image [list]
image show <image-id>
image create <name> <server>
image delete <image-id>
Flavor commands:
flavor [list]
flavor show <flavor-id>
Options:
--verbose|v causes output to contain all info returned from the server
--insecure turns off ssl verification
--query|q provide a query string to append to your request
Notes:
Any <server> param can be a server id or a server name.
OSCOMPUTE_INSECURE env variable sets --insecure on all commands.
Run `man oscompute` to see examples and full documentation.
=head1 DESCRIPTION
This is a command line tool for interacting with the OpenStack Compute API.
=cut