File Coverage

blib/lib/WebService/HashiCorp/Vault/Base.pm

Criterion	Covered	Total	%
statement	6	30	20.0
branch	0	10	0.0
condition	0	3	0.0
subroutine	2	7	28.5
pod	1	1	100.0
total	9	51	17.6

#!perl
# vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab
# ABSTRACT: Perl API for HashiCorp's Vault (Base)

# See also https://github.com/hashicorp/vault-ruby
# And https://github.com/ianunruh/hvac
# And https://www.vaultproject.io/api/index.html

package WebService::HashiCorp::Vault::Base;

use Moo;
our $VERSION = '0.01'; # VERSION
use namespace::clean;

with 'WebService::Client';

has '+base_url' => ( default => 'http://127.0.0.1:8200' );
has token => ( is => 'rw' );
has _token_expires => ( is => 'rw' );
has approle => ( is => 'ro' );
has version => ( is => 'ro', default => 'v1' );
has mount => ( is => 'ro' );

before 'get' => sub {
    $_[0]->_check_token();
    $_[0]->_set_headers();
};

before 'post' => sub {
    # Skip checking the token on a token request
    if ($_[1] !~ m#auth/approle/login$#) {
        $_[0]->_check_token();
    }
    $_[0]->_set_headers();
};

before 'put' => sub {
    $_[0]->_check_token();
    $_[0]->_set_headers();
};

before 'delete' => sub {
    $_[0]->_check_token();
    $_[0]->_set_headers();
};

sub _check_token {
    my $self = shift;

    $self->_request_token()
        unless defined $self->token;

    ## Check the token and get a new one if required
    if (defined $self->_token_expires && (time > $self->_token_expires)) {
        $self->_request_token()
    }
}

sub _set_headers {
    my $self = shift;
    $self->ua->default_header(
        'X-Vault-Token' => $self->token,
        'User_Agent'    => sprintf(
            'WebService::HashiCorp::Vault %s (perl %s; %s)',
            __PACKAGE__->VERSION,
            $^V, $^O),
    );
}

sub _mkuri {
    my $self = shift;
    my @paths = @_;
    return join '/',
        $self->base_url,
        $self->version,
        $self->mount,
        @paths
}


sub _request_token {
    my $self = shift;

    die 'Must provide either token or approle'
        unless defined $self->approle;
    die 'role_id missing in approle'
        unless defined $self->approle->{role_id};
    die 'secret_id missing in approle'
        unless defined $self->approle->{secret_id};

    my $url  =  join('/', $self->base_url, $self->version, 'auth/approle/login');
    my $resp =  $self->post( $url , $self->approle );
    $self->{token} = $resp->{auth}->{client_token};
    ## Set the expiry to 1 second before acutal expiry
    $self->_token_expires(time + $resp->{auth}->{lease_duration} - 1);
}


sub list {
    my ($self, $path) = @_;

    $self->_check_token;
    $self->_set_headers;

    my $headers = $self->_headers();
    my $url = $self->_url($path);

    # HashiCorp have decided that 'LIST' is a http verb, so we must hack it in
    my $req = HTTP::Request->new(
        'LIST' => $url,
        HTTP::Headers->new(%$headers)
    );

    # this is a WebService::Client internal function. I said hack!
    return $self->req( $req );

}


1;

__END__