aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore1
-rw-r--r--MANIFEST.SKIP1
-rw-r--r--lib/App/Glacier.pm2
-rw-r--r--lib/App/Glacier/Bre.pm67
-rw-r--r--lib/App/Glacier/Command.pm21
-rw-r--r--lib/App/Glacier/DB/GDBM.pm15
-rw-r--r--lib/App/Glacier/Job/InventoryRetrieval.pm4
-rw-r--r--lib/App/Glacier/Signature.pm24
8 files changed, 109 insertions, 26 deletions
diff --git a/.gitignore b/.gitignore
index 3ff109b..36948c4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,6 +4,7 @@
\#*#
TAGS
core
+*.tar
*.tar.*
tmp
/MYMETA.json
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
index 3fb78f0..4abb17f 100644
--- a/MANIFEST.SKIP
+++ b/MANIFEST.SKIP
@@ -57,6 +57,7 @@
^debug.sh
^tmp
+^patches/
^buildreq
^\.emacs\.*
diff --git a/lib/App/Glacier.pm b/lib/App/Glacier.pm
index e8c6cf9..fea94d5 100644
--- a/lib/App/Glacier.pm
+++ b/lib/App/Glacier.pm
@@ -8,7 +8,7 @@ use App::Glacier::Command;
use File::Basename;
use Carp;
-our $VERSION = '2.00';
+our $VERSION = '2.00.90';
my %comtab = (
diff --git a/lib/App/Glacier/Bre.pm b/lib/App/Glacier/Bre.pm
index 0eff7a4..3b1d190 100644
--- a/lib/App/Glacier/Bre.pm
+++ b/lib/App/Glacier/Bre.pm
@@ -3,15 +3,71 @@ use strict;
use warnings;
use parent 'Net::Amazon::Glacier';
use App::Glacier::HttpCatch;
+use App::Glacier::Signature;
use Carp;
use version 0.77;
+use LWP::UserAgent;
+use JSON;
sub new {
my ($class, %opts) = @_;
- my $region = delete $opts{region} or croak 'region must be supplied';
- my $access = delete $opts{access} or croak 'access must be supplied';
- my $secret = delete $opts{secret} or croak 'secret must be supplied';
- $class->SUPER::new($region, $access, $secret);
+ my $region = (delete $opts{region} || _get_instore_region())
+ or return $class->new_failed('availability region not supplied');
+ my $access = delete $opts{access};
+ my ($secret,$token);
+ if (defined($access)) {
+ $secret = delete $opts{secret}
+ or $class->new_failed('secret not supplied');
+ } else {
+ ($access, $secret, $token) = _get_instore_creds()
+ or return $class->new_failed('no credentials supplied');
+ }
+ my $self = $class->SUPER::new($region, $access, $secret);
+ if ($token) {
+ # Overwrite the 'sig' attribute.
+ # FIXME: The attribute itself is not documented, so this
+ # this method may fail if the internals of the base class
+ # change in its future releases.
+ # This approach works with Net::Amazon::Glacier 0.15
+ $self->{sig} = new App::Glacier::Signature($self->{sig}, $token);
+ }
+ return $self;
+}
+
+sub new_failed {
+ my ($class, $message) = @_;
+ bless { _error => $message }, $class;
+}
+
+my $istore_base_url = "http://169.254.169.254/latest/";
+my $istore_document_path = "dynamic/instance-identity/document";
+my $istore_credentials_path = "meta-data/iam/security-credentials/";
+
+sub _get_instore_region {
+ my $ua = LWP::UserAgent->new(timeout => 10);
+ my $response = $ua->get($istore_base_url . $istore_document_path);
+ unless ($response->is_success) {
+ return undef;
+ }
+ my $doc = JSON->new->decode($response->decoded_content);
+ return $doc->{region};
+}
+
+sub _get_instore_creds {
+ my $ua = LWP::UserAgent->new(timeout => 10);
+ my $url = $istore_base_url . $istore_credentials_path;
+ my $response = $ua->get($url);
+ unless ($response->is_success) {
+ return undef;
+ }
+ chomp(my $name = $response->decoded_content);
+ $url .= $name;
+ $response = $ua->get($url);
+ unless ($response->is_success) {
+ return undef;
+ }
+ my $doc = JSON->new->decode($response->decoded_content);
+ return ($doc->{AccessKeyId}, $doc->{SecretAccessKey}, $doc->{Token});
}
# Fix bugs in Net::Amazon::Glacier 0.15
@@ -41,6 +97,7 @@ sub _eval {
sub lasterr {
my ($self, $key) = @_;
+ return $self->{_error} if exists $self->{_error};
return undef unless defined $self->{_last_http_err};
return 1 unless defined $key;
return $self->{_last_http_err}{$key};
@@ -48,6 +105,7 @@ sub lasterr {
sub last_error_message {
my ($self) = @_;
+ return $self->{_error} if exists $self->{_error};
return "No error" unless $self->lasterr;
return $self->lasterr('mesg') || $self->lasterr('text');
}
@@ -115,6 +173,7 @@ our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
+ croak $self->{_error} if exists $self->{_error};
(my $meth = $AUTOLOAD) =~ s/.*:://;
if ($meth =~ s/^([A-Z])(.*)/\L$1\E$2/) {
return $self->_eval($meth, @_);
diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index 449950c..62a236b 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -97,9 +97,11 @@ sub new {
my $argref = shift;
local %_ = @_;
- my $config_file = delete $_{config}
- || $ENV{GLACIER_CONF}
- || "/etc/glacier.conf";
+ my $config_file = delete $_{config} || $ENV{GLACIER_CONF};
+ unless ($config_file) {
+ $config_file = -f '/etc/glacier.conf'
+ ? '/etc/glacier.conf' : '/dev/null';
+ }
my $account = delete $_{account};
my $region = delete $_{region};
@@ -139,19 +141,12 @@ sub new {
$region = $creds->region($account) unless defined $region;
}
}
- $self->abend(EX_CONFIG, "no access credentials found")
- unless ($self->{_config}->isset(qw(glacier access))
- && $self->{_config}->isset(qw(glacier secret)));
}
- if ($region) {
- $self->{_config}->set(qw(glacier region), $region);
- } elsif (!$self->{_config}->isset(qw(glacier region))) {
- $self->{_config}->set(qw(glacier region), 'eu-west-1');
+ $self->{_glacier} = new App::Glacier::Bre(%{$self->config->as_hash('glacier')//{}});
+ if ($self->{_glacier}->lasterr) {
+ $self->abend(EX_CONFIG, $self->{_glacier}->last_error_message);
}
-
- $self->{_glacier} = new App::Glacier::Bre(%{$self->config->as_hash('glacier')});
-
return $self;
}
diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm
index d375e0d..0e14a65 100644
--- a/lib/App/Glacier/DB/GDBM.pm
+++ b/lib/App/Glacier/DB/GDBM.pm
@@ -4,6 +4,7 @@ use warnings;
use GDBM_File;
use Carp;
use File::Basename;
+use File::Path qw(make_path);
sub new {
my $class = shift;
@@ -19,12 +20,14 @@ sub new {
my $dir = dirname($file);
unless (-d $dir) {
make_path($dir, {error=>\my $err});
- for my $diag (@$err) {
- my ($filename, $message) = %$diag;
- $filename = $dir if ($filename eq '');
- carp("error creating $filename: $message");
- }
- croak("failed to create $dir");
+ if (@$err) {
+ for my $diag (@$err) {
+ my ($filename, $message) = %$diag;
+ $filename = $dir if ($filename eq '');
+ carp("error creating $filename: $message");
+ }
+ croak("failed to create $dir");
+ }
}
}
my $self = bless {}, $class;
diff --git a/lib/App/Glacier/Job/InventoryRetrieval.pm b/lib/App/Glacier/Job/InventoryRetrieval.pm
index e73546e..d9aa545 100644
--- a/lib/App/Glacier/Job/InventoryRetrieval.pm
+++ b/lib/App/Glacier/Job/InventoryRetrieval.pm
@@ -32,8 +32,8 @@ sub init {
} else {
$self->command->abend(EX_FAILURE,
"can't create job: ",
- $self->command->lasterr('code'),
- $self->command->last_error_message);
+ $self->glacier->lasterr('code'),
+ $self->glacier->last_error_message);
}
}
return $jid;
diff --git a/lib/App/Glacier/Signature.pm b/lib/App/Glacier/Signature.pm
new file mode 100644
index 0000000..10d0ea7
--- /dev/null
+++ b/lib/App/Glacier/Signature.pm
@@ -0,0 +1,24 @@
+package App::Glacier::Signature;
+
+# A wrapper class over Net::Amazon::Signature::V4, that supplies
+# the X-Amz-Security-Token header for EC2 instance profile authentication.
+sub new {
+ my ($class, $sig, $token) = @_;
+ bless { _sig => $sig, _token => $token }, $class;
+};
+
+sub sign {
+ my ($self, $request) = @_;
+ $request->header('X-Amz-Security-Token' => $self->{_token});
+ return $self->{_sig}->sign($request);
+}
+
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+ my $self = shift;
+ (my $meth = $AUTOLOAD) =~ s/.*:://;
+ $self->{_sig}->method(@_);
+}
+
+1;

Return to:

Send suggestions and report system problems to the System administrator.

Generated by cgit.