Net-Amazon-S3-Client-GPG

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

NAME
    Net::Amazon::S3::Client::GPG - Use GPG with Amazon S3 - Simple Storage
    Service

SYNOPSIS
      use Net::Amazon::S3;
      my $aws_access_key_id     = 'fill me in';
      my $aws_secret_access_key = 'fill me in too';
      my $gpg_recipient         = 'fill@meintoo.com';
      my $gpg_passphrase        = 'secret!';

      my $s3 = Net::Amazon::S3->new(
          aws_access_key_id     => $aws_access_key_id,
          aws_secret_access_key => $aws_secret_access_key,
          retry                 => 1,
      );

      my $gnupg = GnuPG::Interface->new();
      $gnupg->options->hash_init(
          armor            => 0,
          recipients       => [$gpg_recipient],
          meta_interactive => 0,
      );

      my $client = Net::Amazon::S3::Client::GPG->new(
          s3              => $s3,
          gnupg_interface => $gnupg,
          passphrase      => $gpg_passphrase,
      );

      # then can call $object->gpg_get, $object->gpg_get_filename,
      # $object->gpg_put, $object->$gpg_put_filename on
      # Net::Amazon::S3::Client::Object objects.

DESCRIPTION
    Net::Amazon::S3 provides a simple interface to Amazon's Simple Storage
    Service. GnuPG::Interface provides a Perl interface to GNU Privacy
    Guard, an implementation of the OpenPGP standard. Net::Amazon::S3 can
    use SSL so that data can not be intercepted while in transit over the
    internet, but Amazon recommends that "users can encrypt their data
    before it is uploaded to Amazon S3 so that the data cannot be accessed
    or tampered with by unauthorized parties".

lib/Net/Amazon/S3/Client/GPG.pm  view on Meta::CPAN

extends 'Net::Amazon::S3::Client';

has 'passphrase' => ( is => 'ro', isa => 'Str', required => 0 );
has 'gnupg_interface' =>
    ( is => 'ro', isa => 'GnuPG::Interface', required => 1 );

__PACKAGE__->meta->make_immutable;

Net::Amazon::S3::Client::Object->meta->make_mutable();
Net::Amazon::S3::Client::Object->meta->add_method(
    'gpg_get' => sub {
        my $self = shift;
        my ( $ciphertext_fh, $ciphertext_filename ) = tempfile();
        $ciphertext_fh->close || confess "Error closing filehandle: $!";
        $self->get_filename($ciphertext_filename);

        my ( $tmp_plaintext_fh, $plaintext_filename ) = tempfile();
        $tmp_plaintext_fh->close;

        $self->client->decrypt( $ciphertext_filename, $plaintext_filename );

lib/Net/Amazon/S3/Client/GPG.pm  view on Meta::CPAN

            $plaintext .= $chunk;
        }
        $plaintext_fh->close;

        unlink($plaintext_filename)
            || confess "Error unlinking $plaintext_filename: $!";
        return $plaintext;
    }
);
Net::Amazon::S3::Client::Object->meta->add_method(
    'gpg_get_filename' => sub {
        my ( $self,          $plaintext_filename )  = @_;
        my ( $ciphertext_fh, $ciphertext_filename ) = tempfile();
        $ciphertext_fh->close;
        $self->get_filename($ciphertext_filename);
        $self->client->decrypt( $ciphertext_filename, $plaintext_filename );
        unlink($ciphertext_filename)
            || confess "Error unlinking $ciphertext_filename: $!";
    }
);
Net::Amazon::S3::Client::Object->meta->add_method(
    'gpg_put' => sub {
        my ( $self, $plaintext ) = @_;

        my ( $plaintext_fh, $plaintext_filename ) = tempfile();
        $plaintext_fh->print($plaintext)
            || confess "Error printing the value: $!";
        $plaintext_fh->close || confess "Error closing filehandle: $!";

        my $ciphertext_filename = $self->client->encrypt($plaintext_filename);
        $self->put_filename($ciphertext_filename);

        unlink($plaintext_filename)
            || confess "Error unlinking $plaintext_filename: $!";
        unlink($ciphertext_filename)
            || confess "Error unlinking $ciphertext_filename: $!";
    }
);
Net::Amazon::S3::Client::Object->meta->add_method(
    'gpg_put_filename' => sub {
        my ( $self, $plaintext_filename ) = @_;
        my $ciphertext_filename = $self->client->encrypt($plaintext_filename);
        $self->put_filename($ciphertext_filename);
        unlink($ciphertext_filename)
            || confess "Error unlinking $ciphertext_filename: $!";
    }
);
Net::Amazon::S3::Client::Object->meta->make_immutable();

sub decrypt {

lib/Net/Amazon/S3/Client/GPG.pm  view on Meta::CPAN

=head1 NAME

Net::Amazon::S3::Client::GPG - Use GPG with Amazon S3 - Simple Storage Service

=head1 SYNOPSIS

  use Net::Amazon::S3;
  my $aws_access_key_id     = 'fill me in';
  my $aws_secret_access_key = 'fill me in too';
  my $gpg_recipient         = 'fill@meintoo.com';
  my $gpg_passphrase        = 'secret!';

  my $s3 = Net::Amazon::S3->new(
      aws_access_key_id     => $aws_access_key_id,
      aws_secret_access_key => $aws_secret_access_key,
      retry                 => 1,
  );

  my $gnupg = GnuPG::Interface->new();
  $gnupg->options->hash_init(
      armor            => 0,
      recipients       => [$gpg_recipient],
      meta_interactive => 0,
  );

  my $client = Net::Amazon::S3::Client::GPG->new(
      s3              => $s3,
      gnupg_interface => $gnupg,
      passphrase      => $gpg_passphrase,
  );

  # then can call $object->gpg_get, $object->gpg_get_filename,
  # $object->gpg_put, $object->$gpg_put_filename on
  # Net::Amazon::S3::Client::Object objects.

=head1 DESCRIPTION

L<Net::Amazon::S3> provides a simple interface to Amazon's Simple
Storage Service. L<GnuPG::Interface> provides a Perl interface to
GNU Privacy Guard, an implementation of the OpenPGP standard.
L<Net::Amazon::S3> can use SSL so that data can not be intercepted
while in transit over the internet, but Amazon recommends that
"users can encrypt their data before it is uploaded to Amazon S3

t/02client.t  view on Meta::CPAN

    plan skip_all => 'Testing this module for real costs money.';
} else {
    plan tests => 25;
}

use_ok('Net::Amazon::S3');
use_ok('Net::Amazon::S3::Client::GPG');

my $aws_access_key_id     = $ENV{'AWS_ACCESS_KEY_ID'};
my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'};
my $gpg_recipient         = $ENV{'GPG_RECIPIENT'} || die "No recipient";
my $gpg_passphrase        = $ENV{'GPG_PASSPHRASE'} || die "No passphrase";

my $s3 = Net::Amazon::S3->new(
    aws_access_key_id     => $aws_access_key_id,
    aws_secret_access_key => $aws_secret_access_key,
    retry                 => 1,
);

my $gnupg = GnuPG::Interface->new();
$gnupg->options->hash_init(
    armor            => 0,
    recipients       => [$gpg_recipient],
    meta_interactive => 0,
    always_trust     => 1,
);

my $client = Net::Amazon::S3::Client::GPG->new(
    s3              => $s3,
    gnupg_interface => $gnupg,
    passphrase      => $gpg_passphrase,
);

my @buckets = $client->buckets;

TODO: {
    local $TODO = "These tests only work if you're leon";
    my $first_bucket = $buckets[0];
    like( $first_bucket->owner_id, qr/^46a801915a1711f/, 'have owner id' );
    is( $first_bucket->owner_display_name, '_acme_', 'have display name' );
    is( scalar @buckets, 10, 'have a bunch of buckets' );

t/02client.t  view on Meta::CPAN

$stream = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        $count++;
    }
}

is( $count, 0, 'newly created bucket has no objects' );

my $object = $bucket->object( key => 'this is the key' );
$object->gpg_put('this is the value');

my @objects;

@objects = ();
$stream = $bucket->list( { prefix => 'this is the key' } );
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}

t/02client.t  view on Meta::CPAN

        push @objects, $object;
    }
}
is( @objects, 1, 'bucket list finds newly created key' );

is( $objects[0]->key,
    'this is the key',
    'newly created object has the right key'
);

is( $object->gpg_get,
    'this is the value',
    'newly created object has the right value'
);

isnt(
    $object->get,
    'this is the value',
    'newly created object is not plaintext'
);

is( $bucket->object( key => 'this is the key' )->gpg_get,
    'this is the value',
    'newly created object fetched by name has the right value'
);

is( get( $object->uri ),
    undef, 'newly created object cannot be fetched by uri' );

$object->delete;

my $readme_size   = stat('README')->size;
my $readme_md5hex = file_md5_hex('README');

# upload a file with put_filename

$object = $bucket->object( key => 'the readme' );
$object->gpg_put_filename('README');

@objects = ();
$stream  = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}

is( @objects, 1, 'have newly uploaded object' );

t/02client.t  view on Meta::CPAN

ok( $objects[0]->last_modified, 'newly created object has a last modified' );

$object->delete;

# upload a public object with put_filename

$object = $bucket->object(
    key       => 'the public readme',
    acl_short => 'public-read'
);
$object->gpg_put_filename('README');
$object->delete;

# upload a file with put_filename with known md5hex and size

$object = $bucket->object(
    key => 'the new readme',

    #   etag => $readme_md5hex,
    #   size => $readme_size
);
$object->gpg_put_filename('README');

@objects = ();
$stream  = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}

is( @objects, 1, 'have newly uploaded object' );

t/02client.t  view on Meta::CPAN

    'newly uploaded object has the right key'
);
ok( $objects[0]->last_modified, 'newly created object has a last modified' );

# download an object with get_filename

if ( -f 't/README' ) {
    unlink('t/README') || die $!;
}

$object->gpg_get_filename('t/README');
is( stat('t/README')->size,   $readme_size,   'download has right size' );
is( file_md5_hex('t/README'), $readme_md5hex, 'download has right etag' );

$object->delete;

$bucket->delete;