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


line stmt bran cond sub pod time code
1             #!perl
2             # vim: softtabstop=4 tabstop=4 shiftwidth=4 ft=perl expandtab smarttab
3             # ABSTRACT: Perl API for HashiCorp's Vault (Base)
4              
5             # See also https://github.com/hashicorp/vault-ruby
6             # And https://github.com/ianunruh/hvac
7             # And https://www.vaultproject.io/api/index.html
8              
9             package WebService::HashiCorp::Vault::Base;
10              
11 2     2   1495 use Moo;
  2         6  
  2         10  
12             our $VERSION = '0.02'; # VERSION
13 2     2   673 use namespace::clean;
  2         4  
  2         20  
14              
15             with 'WebService::Client';
16              
17             has '+base_url' => ( default => 'http://127.0.0.1:8200' );
18             has token => ( is => 'rw' );
19             has _token_expires => ( is => 'rw' );
20             has approle => ( is => 'ro' );
21             has version => ( is => 'ro', default => 'v1' );
22             has mount => ( is => 'ro' );
23              
24             before 'get' => sub {
25             $_[0]->_check_token();
26             $_[0]->_set_headers();
27             };
28              
29             before 'post' => sub {
30             # Skip checking the token on a token request
31             if ($_[1] !~ m#auth/approle/login$#) {
32             $_[0]->_check_token();
33             }
34             $_[0]->_set_headers();
35             };
36              
37             before 'put' => sub {
38             $_[0]->_check_token();
39             $_[0]->_set_headers();
40             };
41              
42             before 'delete' => sub {
43             $_[0]->_check_token();
44             $_[0]->_set_headers();
45             };
46              
47             sub _check_token {
48 0     0     my $self = shift;
49              
50 0 0         $self->_request_token()
51             unless defined $self->token;
52              
53             ## Check the token and get a new one if required
54 0 0 0       if (defined $self->_token_expires && (time > $self->_token_expires)) {
55 0           $self->_request_token()
56             }
57             }
58              
59             sub _set_headers {
60 0     0     my $self = shift;
61 0           $self->ua->default_header(
62             'X-Vault-Token' => $self->token,
63             'User_Agent' => sprintf(
64             'WebService::HashiCorp::Vault %s (perl %s; %s)',
65             __PACKAGE__->VERSION,
66             $^V, $^O),
67             );
68             }
69              
70             sub _mkuri {
71 0     0     my $self = shift;
72 0           my @paths = @_;
73 0           return join '/',
74             $self->base_url,
75             $self->version,
76             $self->mount,
77             @paths
78             }
79              
80              
81             sub _request_token {
82 0     0     my $self = shift;
83              
84 0 0         die 'Must provide either token or approle'
85             unless defined $self->approle;
86             die 'role_id missing in approle'
87 0 0         unless defined $self->approle->{role_id};
88             die 'secret_id missing in approle'
89 0 0         unless defined $self->approle->{secret_id};
90              
91 0           my $url = join('/', $self->base_url, $self->version, 'auth/approle/login');
92 0           my $resp = $self->post( $url , $self->approle );
93 0           $self->{token} = $resp->{auth}->{client_token};
94             ## Set the expiry to 1 second before acutal expiry
95 0           $self->_token_expires(time + $resp->{auth}->{lease_duration} - 1);
96             }
97              
98              
99             sub list {
100 0     0 1   my ($self, $path) = @_;
101              
102 0           $self->_check_token;
103 0           $self->_set_headers;
104              
105 0           my $headers = $self->_headers();
106 0           my $url = $self->_url($path);
107              
108             # HashiCorp have decided that 'LIST' is a http verb, so we must hack it in
109 0           my $req = HTTP::Request->new(
110             'LIST' => $url,
111             HTTP::Headers->new(%$headers)
112             );
113              
114             # this is a WebService::Client internal function. I said hack!
115 0           return $self->req( $req );
116              
117             }
118              
119              
120             1;
121              
122             __END__