view release on metacpan or  search on metacpan

lib/Amazon/S3.pm  view on Meta::CPAN

  my $region = $ENV{AWS_REGION} || $ENV{AWS_DEFAULT_REGION};

  return $region
    if $region;

  my $url
    = 'http://169.254.169.254/latest/meta-data/placement/availability-zone';

  my $request = HTTP::Request->new( 'GET', $url );

  my $ua = LWP::UserAgent->new;
  $ua->timeout(0);

  my $response = eval { return $ua->request($request); };

  if ( $response && $response->is_success ) {
    if ( $response->content =~ /\A([[:lower:]]+[-][[:lower:]]+[-]\d+)/xsm ) {
      $region = $1;
    }
  }

  return $region || $DEFAULT_REGION;
}

# Amazon::Credentials compatibility methods
########################################################################
sub get_aws_access_key_id {
########################################################################
  my ($self) = @_;

  return _decrypt( $self->aws_access_key_id );
}

########################################################################
sub get_aws_secret_access_key {
########################################################################
  my ($self) = @_;

  return _decrypt( $self->aws_secret_access_key );
}

########################################################################
sub get_token {
########################################################################
  my ($self) = @_;

  return _decrypt( $self->token );
}

########################################################################
sub turn_on_special_retry {
########################################################################
  my ($self) = @_;

  if ( $self->retry ) {

    # In the field we are seeing issue of Amazon returning with a 400
    # code in the case of timeout.  From AWS S3 logs: REST.PUT.PART
    # Backups/2017-05-04/<account>.tar.gz "PUT
    # /Backups<path>?partNumber=27&uploadId=<id> - HTTP/1.1" 400
    # RequestTimeout 360 20971520 20478 - "-" "libwww-perl/6.15"
    my $http_codes_hr = $self->ua->codes_to_determinate();
    $http_codes_hr->{$HTTP_BAD_REQUEST} = $TRUE;
  }

  return;
}

########################################################################
sub turn_off_special_retry {
########################################################################
  my ($self) = @_;

  if ( $self->retry ) {

    # In the field we are seeing issue with Amazon returning a 400
    # code in the case of timeout.  From AWS S3 logs: REST.PUT.PART
    # Backups/2017-05-04/<account>.tar.gz "PUT
    # /Backups<path>?partNumber=27&uploadId=<id> - HTTP/1.1" 400
    # RequestTimeout 360 20971520 20478 - "-" "libwww-perl/6.15"
    my $http_codes_hr = $self->ua->codes_to_determinate();
    delete $http_codes_hr->{$HTTP_BAD_REQUEST};
  }

  return;
}

########################################################################
sub region {
########################################################################
  my ( $self, @args ) = @_;

  if (@args) {
    $self->_region( $args[0] );
  }

  $self->get_logger->debug(
    sub { return 'region: ' . ( $self->_region // $EMPTY ) } );

  if ( $self->_region ) {
    my $host = $self->host;
    $self->get_logger->debug( sub { return 'host: ' . $self->host } );

    if ( $host =~ /\As3[.](.*)?amazonaws/xsm ) {
      $self->host( sprintf 's3.%s.amazonaws.com', $self->_region );
    }
  }

  return $self->_region;
}

########################################################################
sub buckets {
########################################################################
  my ( $self, $verify_region ) = @_;

  # The "default" region for Amazon is us-east-1
  # This is the region to set it to for listing buckets
  # You may need to reset the signer's endpoint to 'us-east-1'

  # temporarily cache signer
  my $region = $self->_region;
  my $bucket_list;

  $self->reset_signer_region($DEFAULT_REGION); # default region for buckets op

  my $r = $self->_send_request(
    { method  => 'GET',
      path    => $EMPTY,
      headers => {},
      region  => $DEFAULT_REGION,
    },
  );

  return $bucket_list
    if !$r || $self->errstr;

  my $owner_id          = $r->{Owner}{ID};
  my $owner_displayname = $r->{Owner}{DisplayName};