#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use App::Rad;
use HTTP::Async;
use HTTP::Request;
use JSON qw(to_json from_json);
use LWP;
use Method::Signatures::Simple;
use Net::OpenStack::Compute::Auth;
use Time::SoFar qw(runtime);

func setup($ctx) {
    $ctx->register_commands({
        bad    => 'send invalid requests',
        create => 'create servers (--image|-i optional)',
        delete => 'delete all servers created by stackattack',
        get    => 'send get servers requests',
    });
    $ctx->register('get-images' => \&get_images, 'send image list requests');

    my $nova_url = $ENV{NOVA_URL} or die
        "NOVA_URL env var is missing. Did you forget to source novarc?\n";

    # Do auth and stash the auth token and base url
    my $auth = Net::OpenStack::Compute::Auth->new(
        auth_url   => $nova_url,
        user       => $ENV{NOVA_USERNAME},
        password   => $ENV{NOVA_API_KEY},
        project_id => $ENV{NOVA_PROJECT_ID},
        region     => $ENV{NOVA_REGION_NAME},
    );
    $ctx->stash->{base_url} = $auth->base_url;
    $ctx->stash->{auth_headers} = [
        x_auth_token => $auth->token,
        content_type => 'application/json',
    ];
}

func pre_process($ctx) {
    $ctx->stash->{num_runs} = $ctx->argv->[0] || 1;
}

#---------- Commands ----------------------------------------------------------

func create($ctx) {
    my $num_runs = $ctx->stash->{num_runs};
    my $image = $ctx->options->{image} || get_any_image($ctx);
    my $body = to_json {
        server => {
            name      => 'stackattack',
            imageRef  => $image,
            flavorRef => 1,
        }
    };
    my @reqs = map makereq($ctx, POST => '/servers', $body), 1 .. $num_runs;
    say "Creating $num_runs servers...";
    return sendreqs($ctx, @reqs);
}

func delete($ctx) {
    my $ua = LWP::UserAgent->new();
    my $base_url = $ctx->stash->{base_url};
    my $res = $ua->get("$base_url/servers", @{ $ctx->stash->{auth_headers} });

    die "Error getting server list: " . $res->content unless $res->is_success;

    my $data = from_json($res->content);
    my @servers = grep { $_->{name} eq 'stackattack' } @{ $data->{servers} };
    my @reqs = map { makereq($ctx, DELETE => "/servers/$_->{id}") } @servers;
    say "Deleting " . @servers . " servers...";
    return sendreqs($ctx, @reqs);
}

func bad($ctx) {
    my $num_runs = $ctx->stash->{num_runs};
    my @reqs = map makereq($ctx, GET => '/bad'), 1 .. $num_runs;
    say "Sending $num_runs /bad requests...";
    return sendreqs($ctx, @reqs);
}

func get($ctx) {
    my $num_runs = $ctx->stash->{num_runs};
    my @reqs = map makereq($ctx, GET => '/servers'), 1 .. $num_runs;
    say "Sending $num_runs /servers requests...";
    return sendreqs($ctx, @reqs);
}

func get_images($ctx) {
    my $num_runs = $ctx->stash->{num_runs};
    my @reqs = map makereq($ctx, GET => '/images'), 1 .. $num_runs;
    say "Sending $num_runs /images requests...";
    return sendreqs($ctx, @reqs);
}

#---------- Helpers -----------------------------------------------------------

func makereq($ctx, $method, $resource, $body) {
    my $url = $ctx->stash->{base_url} . $resource;
    my $headers = $ctx->stash->{auth_headers};
    return HTTP::Request->new($method => $url, $headers, $body);
}

func sendreqs($ctx, @reqs) {
    my $async = HTTP::Async->new;
    $async->add(@reqs);
    my ($successes, $failures, @errmsgs) = (0, 0);
    while (my $res = $async->wait_for_next_response) {
        if ($res->is_success) {
            $successes++;
        } else {
            $failures++;
            warn sprintf "Error: %s: %s", $res->status_line, $res->content;
        }
    }

    return "Successes: $successes Failures: $failures Time: " . runtime();
}

func get_any_image($ctx) {
    my $ua = LWP::UserAgent->new();
    my $base_url = $ctx->stash->{base_url};
    my $res = $ua->get("$base_url/images", @{ $ctx->stash->{auth_headers} });
    die "Error grabbing arbitrary image id: " . $res->content
        unless $res->is_success;
    return from_json($res->content)->{images}[0]{id};
}

App::Rad->run();

# PODNAME: stackattack


__END__
=pod

=head1 NAME

stackattack

=head1 VERSION

version 1.0000

=head1 SYNOPSIS

    Usage: stackattack command [arguments]

    Available Commands:
        bad         send invalid requests
        create      create servers (--image|-i optional)
        delete      delete all servers created by stackattack
        get         send get servers requests
        get-images  send image list requests
        help        show syntax and available commands

    Examples:

    # Create a server
    $ stackattack create

    # Create 10 servers in parallel
    $ stackattack create 10

    # Create 10 servers with an explicit image id
    $ stackattack create -i b79cf9f9-cea9-44c7-a3ac-74a6668eb78b 10

=head1 DESCRIPTION

This is a command line utility for stress testing an OpenStack deployment.
All http requests are run in parallel using L<HTTP::Async>.

=head1 AUTHORS

=over 4

=item *

William Wolf <throughnothing@gmail.com>

=item *

Naveed Massjouni <naveedm9@gmail.com>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Naveed Massjouni.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

