our
$VERSION
=
"1.0.0"
;
sub
from_json {
JSON->new->utf8->decode(
@_
);
}
sub
to_json {
JSON->new->utf8->encode(
@_
);
}
sub
new {
my
(
$class
,
$vault_addr
) =
@_
;
$vault_addr
||=
$ENV
{VAULT_ADDR};
$vault_addr
=~ s|/$||;
bless
{
ua
=> LWP::UserAgent->new(
agent
=> __PACKAGE__.
'/'
.
$VERSION
),
vault
=>
$vault_addr
,
_debug
=>
$ENV
{STANCE_VAULT_DEBUG} &&
$ENV
{STANCE_VAULT_DEBUG} eq
'on'
,
_error
=>
undef
,
},
$class
;
}
sub
debug {
my
(
$self
,
$on
) =
@_
;
$self
->{_debug} = !!
$on
;
}
sub
url {
my
(
$self
,
$rel
) =
@_
;
$rel
||=
'/'
;
$rel
=~ s|^/||;
return
"$self->{vault}/$rel"
;
}
sub
get {
my
(
$self
,
$url
) =
@_
;
my
$req
= HTTP::Request->new(
GET
=>
$self
->url(
$url
))
or
die
"unable to create GET $url request: $!\n"
;
$req
->header(
'Accept'
=>
'application/json'
);
$req
->header(
'X-Vault-Token'
,
'[REDACTED]'
)
if
$self
->{_token};
if
(
$self
->{_debug}) {
print
STDERR
"=====[ GET $url ]========================\n"
;
print
STDERR
$req
->as_string;
print
STDERR
"\n\n"
;
}
$req
->header(
'X-Vault-Token'
,
$self
->{_token})
if
$self
->{_token};
my
$res
=
$self
->{ua}->request(
$req
)
or
die
"unable to send GET $url request: $!\n"
;
if
(
$self
->{_debug}) {
print
STDERR
"-----------------------------------------\n"
;
print
STDERR
$res
->as_string;
print
STDERR
"\n\n"
;
}
my
$body
= from_json(
$res
->decoded_content);
if
(!
$res
->is_success) {
$self
->{_error} =
$body
;
return
undef
;
}
return
$body
;
}
sub
post {
my
(
$self
,
$url
,
$payload
) =
@_
;
my
$req
= HTTP::Request->new(
POST
=>
$self
->url(
$url
))
or
die
"unable to create POST $url request: $!\n"
;
$req
->header(
'Accept'
=>
'application/json'
);
$req
->header(
'Content-Type'
,
'application/json'
);
$req
->header(
'X-Vault-Token'
,
'[REDACTED]'
)
if
$self
->{_token};
$req
->content(to_json(
$payload
))
if
$payload
;
if
(
$self
->{_debug}) {
print
STDERR
"=====[ POST $url ]========================\n"
;
print
STDERR
$req
->as_string;
print
STDERR
"\n\n"
;
}
$req
->header(
'X-Vault-Token'
,
$self
->{_token})
if
$self
->{_token};
my
$res
=
$self
->{ua}->request(
$req
)
or
die
"unable to send POST $url request: $!\n"
;
if
(
$self
->{_debug}) {
print
STDERR
"-----------------------------------------\n"
;
print
STDERR
$res
->as_string;
print
STDERR
"\n\n"
;
}
my
$body
= from_json(
$res
->decoded_content);
if
(!
$res
->is_success) {
$self
->{_error} =
$body
;
return
undef
;
}
return
$body
;
}
sub
last_error {
my
(
$self
) =
@_
;
return
$self
->{_error};
}
sub
authenticate {
my
(
$self
,
$method
,
$creds
) =
@_
;
if
(
$method
eq
'token'
) {
$self
->{_token} =
$creds
;
return
$self
;
}
if
(
$method
eq
'app_role'
) {
my
(
$ok
,
$token
) =
$self
->post(
'/v1/auth/approle/login'
, {
role_id
=>
$creds
->{role_id},
secret_id
=>
$creds
->{secret_id},
});
if
(!
$ok
) {
return
undef
;
}
$self
->{_token} =
$token
->{auth}{client_token};
$self
->{_renew} =
$token
->{auth}{lease_duration};
my
$pid
=
fork
;
if
(
$pid
) {
$self
->{pid} =
$pid
;
return
$self
;
}
$self
->renew();
}
die
"unrecognized authentication method '$method'!"
;
}
sub
renew {
my
(
$self
) =
@_
;
while
(
$self
->{_renew}) {
$self
->{_renew} /= 2;
sleep
(
$self
->{_renew});
my
(
$ok
,
$renewal
) =
$self
->post(
'/v1/auth/token/renew-self'
, {});
if
(
$ok
) {
$self
->{_renew} =
$renewal
->{auth}{lease_duration};
}
}
}
sub
kv_set {
my
(
$self
,
$path
,
$data
) =
@_
;
$path
=~ s|^/||;
return
$self
->post(
"/v1/secret/data/$path"
, {
options
=> {
cas
=> 0,
},
data
=>
$data
});
}
sub
kv_get {
my
(
$self
,
$path
) =
@_
;
$path
=~ s|^/||;
return
$self
->get(
"/v1/secret/data/$path"
);
}
=head1 NAME
Stance::Vault - A Perl Interface to Hashicorp Vault
=head1 DESCRIPTION
C<Stance::GitHub> provides an object-oriented interface to the Hashicorp Vault API.
=end
1;