view release on metacpan or  search on metacpan

lib/Brackup/Target/Amazon.pm  view on Meta::CPAN

                         $confsec->value('aws_secret_access_key') || 
                         _prompt("Your Amazon AWS secret access key? "))
        or die "Need your Amazon secret access key.\n";
    my $prefix        = ($ENV{'AWS_PREFIX'} || 
                         $header->{AWSPrefix} ||
                         $confsec->value('aws_prefix'));

    my $self = bless {}, $class;
    $self->{access_key_id}     = $accesskey;
    $self->{sec_access_key_id} = $sec_accesskey;
    $self->{prefix}            = $prefix || $self->{access_key_id};
    $self->_common_s3_init;
    return $self;
}

sub has_chunk {
    my ($self, $chunk) = @_;
    my $dig = $chunk->backup_digest;   # "sha1:sdfsdf" format scalar

    my $res = eval { $self->{s3}->head_key({ bucket => $self->{chunk_bucket}, key => $dig }); };
    return 0 unless $res;
    return 0 if $@ && $@ =~ /key not found/;
    return 0 unless $res->{content_type} eq "x-danga/brackup-chunk";
    return 1;
}

sub load_chunk {
    my ($self, $dig) = @_;
    my $bucket = $self->{s3}->bucket($self->{chunk_bucket});

    my $val = $bucket->get_key($dig)
        or return 0;
    return \ $val->{value};
}

sub store_chunk {
    my ($self, $chunk) = @_;
    my $dig = $chunk->backup_digest;
    my $fh = $chunk->chunkref;
    my $chunkref = do { local $/; <$fh> };

    my $try = sub {
        eval {
            $self->{s3}->add_key({
                bucket        => $self->{chunk_bucket},
                key           => $dig,
                value         => $chunkref,
                content_type  => 'x-danga/brackup-chunk',
            });
        };
    };

    my $rv;
    my $n_fails = 0;
    while (!$rv && $n_fails < 5) {
        $rv = $try->();
        last if $rv;

        # transient failure?
        $n_fails++;
        warn "Error uploading chunk $chunk [$@]... will do retry \#$n_fails in 5 seconds ...\n";
        sleep 5;
    }
    unless ($rv) {
        warn "Error uploading chunk again: " . $self->{s3}->errstr . "\n";
        return 0;
    }
    return 1;
}

sub delete_chunk {
    my ($self, $dig) = @_;
    my $bucket = $self->{s3}->bucket($self->{chunk_bucket});
    return $bucket->delete_key($dig);
}

# returns a list of names of all chunks
sub chunks {
    my $self = shift;

    my $chunks = $self->{s3}->list_bucket_all({ bucket => $self->{chunk_bucket} });
    return map { $_->{key} } @{ $chunks->{keys} };
}

sub store_backup_meta {
    my ($self, $name, $fh, $meta) = @_;

    $name = $self->{backup_prefix} . "-" . $name if defined $self->{backup_prefix};

    eval { 
        my $bucket = $self->{s3}->bucket($self->{backup_bucket}); 
        $bucket->add_key_filename(
            $name,
            $meta->{filename},
            { content_type => 'x-danga/brackup-meta' },
        );
    };
}

sub backups {
    my $self = shift;

    my @ret;
    my $backups = $self->{s3}->list_bucket_all({ bucket => $self->{backup_bucket} });
    foreach my $backup (@{ $backups->{keys} }) {
        my $iso8601 = DateTime::Format::ISO8601->parse_datetime( $backup->{last_modified} );
        push @ret, Brackup::TargetBackupStatInfo->new($self, $backup->{key},
                                                      time => $iso8601->epoch,
                                                      size => $backup->{size});
    }
    return @ret;
}

sub get_backup {
    my $self = shift;
    my ($name, $output_file) = @_;

    my $bucket = $self->{s3}->bucket($self->{backup_bucket});
    my $val = $bucket->get_key($name)
        or return 0;

	$output_file ||= "$name.brackup";
    open(my $out, ">$output_file") or die "Failed to open $output_file: $!\n";
    my $outv = syswrite($out, $val->{value});
    die "download/write error" unless $outv == do { use bytes; length $val->{value} };