root/trunk/lib/Brackup/Target/Amazon.pm @ 167

package Brackup::Target::Amazon;
use strict;
use warnings;
use base 'Brackup::Target';
use Net::Amazon::S3 0.41;

# fields in object:
#   s3  -- Net::Amazon::S3
#   access_key_id
#   sec_access_key_id
#   prefix
#   location
#   chunk_bucket : $self->{prefix} . "-chunks";
#   backup_bucket : $self->{prefix} . "-backups";
#

sub new {
    my ($class, $confsec) = @_;
    my $self = $class->SUPER::new($confsec);

    $self->{access_key_id}     = $confsec->value("aws_access_key_id")
        or die "No 'aws_access_key_id'";
    $self->{sec_access_key_id} = $confsec->value("aws_secret_access_key")
        or die "No 'aws_secret_access_key'";
    $self->{prefix} = $confsec->value("aws_prefix") || $self->{access_key_id};
    $self->{location} = $confsec->value("aws_location") || undef;

    $self->_common_s3_init;

    my $s3      = $self->{s3};
    my $buckets = $s3->buckets or die "Failed to get bucket list";

    unless (grep { $_->{bucket} eq $self->{chunk_bucket} } @{ $buckets->{buckets} }) {
        $s3->add_bucket({ bucket => $self->{chunk_bucket}, location_constraint => $self->{location} })
            or die "Chunk bucket creation failed\n";
    }

    unless (grep { $_->{bucket} eq $self->{backup_bucket} } @{ $buckets->{buckets} }) {
        $s3->add_bucket({ bucket => $self->{backup_bucket}, location_constraint => $self->{location} })
            or die "Backup bucket creation failed\n";
    }

    return $self;
}

sub _common_s3_init {
    my $self = shift;
    $self->{chunk_bucket}  = $self->{prefix} . "-chunks";
    $self->{backup_bucket} = $self->{prefix} . "-backups";
    $self->{s3}            = Net::Amazon::S3->new({
        aws_access_key_id     => $self->{access_key_id},
        aws_secret_access_key => $self->{sec_access_key_id},
    });
}

# ghetto
sub _prompt {
    my ($q) = @_;
    print "$q";
    my $ans = <STDIN>;
    $ans =~ s/^\s+//;
    $ans =~ s/\s+$//;
    return $ans;
}

sub new_from_backup_header {
    my ($class, $header) = @_;

    my $accesskey     = ($ENV{'AWS_KEY'} || _prompt("Your Amazon AWS access key? "))
        or die "Need your Amazon access key.\n";
    my $sec_accesskey = ($ENV{'AWS_SEC_KEY'} || _prompt("Your Amazon AWS secret access key? "))
        or die "Need your Amazon secret access key.\n";
    my $prefix = ($ENV{'AWS_PREFIX'} || _prompt("Your Amazon AWS prefix? (Leave empty if none) "));

    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 $blen = $chunk->backup_length;
    my $chunkref = $chunk->chunkref;

    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, $file) = @_;

    my $rv = eval { $self->{s3}->add_key({
        bucket        => $self->{backup_bucket},
        key           => $name,
        value         => $file,
        content_type  => 'x-danga/brackup-meta',
    })};

    return $rv;
}

sub backups {
    my $self = shift;

    my @ret;
    my $backups = $self->{s3}->list_bucket_all({ bucket => $self->{backup_bucket} });
    foreach my $backup (@{ $backups->{keys} }) {
        push @ret, Brackup::TargetBackupStatInfo->new($self, $backup->{key},
                                                      time => $backup->{last_modified},
                                                      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} };
    close $out;
    return 1;
}

sub delete_backup {
    my $self = shift;
    my $name = shift;
        
    my $bucket = $self->{s3}->bucket($self->{backup_bucket});
    return $bucket->delete_key($name);
}

1;

=head1 NAME

Brackup::Target::Amazon - backup to Amazon's S3 service

=head1 EXAMPLE

In your ~/.brackup.conf file:

  [TARGET:amazon]
  type = Amazon
  aws_access_key_id  = ...
  aws_secret_access_key =  ....
  aws_prefix =  ....

=head1 CONFIG OPTIONS

All options may be omitted unless specified.

=over

=item B<type>

I<(Mandatory.)> Must be "B<Amazon>".

=item B<aws_access_key_id>

I<(Mandatory.)> Your Amazon Web Services access key id.

=item B<aws_secret_access_key>

I<(Mandatory.)> Your Amazon Web Services secret password for the above access key.  (not your Amazon password)

=item B<aws_prefix>

If you want to setup multiple backup targets on a single Amazon account you can
use different prefixes. This string is used to name the S3 buckets created by
Brackup. If not specified it defaults to the AWS access key id.

=item B<aws_location>

Sets the location constraint of the new buckets. If left unspecified, the
default S3 datacenter location will be used. Otherwise, you can set it
to 'EU' for an AWS European data center - note that costs are different.
This has only effect when your backup environment is initialized in S3 (i.e.
when buckets are created). If you want to move an existing backup environment
to another datacenter location, you have to delete its buckets before or create
a new one by specifing a different I<aws_prefix>.

=back

=head1 SEE ALSO

L<Brackup::Target>

L<Net::Amazon::S3> -- required module to use Brackup::Target::Amazon