package Amazon::Credentials;

use strict;
use warnings;
use 5.010;

use parent qw/Exporter Class::Accessor::Fast/;

__PACKAGE__->follow_best_practice;

__PACKAGE__->mk_accessors(
  qw{
    _access_key_id
    cache
    cipher
    container
    debug
    decrypt
    encrypt
    encryption
    expiration
    imdsv2
    imdsv2_token
    insecure
    logger
    order
    passkey
    profile
    region
    role
    _secret_access_key
    _session_token
    session_token_required
    source
    timeout
    user_agent
  }
);

use Carp;
use Config::Tiny;
use Data::Dumper;
use Date::Format;
use English qw {-no_match_vars};
use Exporter;
use File::chdir;
use File::HomeDir;
use HTTP::Request;
use JSON::PP;
use LWP::UserAgent;
use MIME::Base64;
use POSIX::strptime qw/strptime/;
use Time::Local;
use Scalar::Util qw/reftype/;
use List::Util qw/pairs any/;

use constant {    ## no critic (ValuesAndExpressions::ProhibitConstantPragma, NamingConventions::Capitalization)
  AWS_METADATA_BASE_URL            => 'http://169.254.169.254/',
  AWS_CONTAINER_CREDENTIALS_URL    => 'http://169.254.170.2/',
  AWS_IAM_SECURITY_CREDENTIALS_URL =>
    'latest/meta-data/iam/security-credentials/',
  AWS_AVAILABILITY_ZONE_URL => 'latest/meta-data/placement/availability-zone',
  COMMA                     => q{,},
  DEFAULT_CIPHER            => 'Cipher::AES',
  DEFAULT_SEARCH_ORDER      => 'env,container,role,file',
  DEFAULT_TIMEOUT           => 3,
  DEFAULT_WINDOW_INTERVAL   => 5,
  EMPTY                     => q{},
  SECONDS_IN_MINUTE         => 60,
  SECONDS_IN_HOUR           => 3600,
  INSECURE_MODE             => 2,
  IMDSv2_URL                => 'latest/api/token',
  IMDSv2_TTL_HEADER         => 'x-aws-ec2-metadata-token-ttl-seconds',
  IMDSv2_HEADER             => 'x-aws-ec2-metadata-token',
  IMDSv2_DEFAULT_TTL        => 21_600,
  PASSKEY_FORMAT            => '%08X%08x',
  RANDOM_VALUE              => 0xffffffff,
  SLASH                     => q{/},
  TRUE                      => 1,
  FALSE                     => 0,
  LOG_FORMAT                => " %s [%s] %s\n",
};

our $VERSION = '1.1.3';

use vars qw{ @EXPORT_OK };

@EXPORT_OK = qw{ create_passkey };

# we only log at debug level, create a default logger
{
  no strict 'refs';    ## no critic (TestingAndDebugging::ProhibitNoStrict)

  *{'Amazon::Credentials::Logger::debug'} = sub {
    my ( $self, @message ) = @_;

    return if !$self->{'debug'};

    my @tm = localtime time;
    print {*STDERR} sprintf LOG_FORMAT, strftime( '%c', @tm ),
      $PROCESS_ID,
      @message;
  };
}

sub new {
  my ( $class, @args ) = @_;
  my $options = ref $args[0] ? $args[0] : {@args};

  my $self = $class->SUPER::new($options);

  $self->_set_defaults;

  $self->_init_logger;

  $self->_init_encryption;

  if ( $self->get_insecure ) {
    $self->get_logger->debug( "!! CAUTION !!\n"
        . "!! You are executing in 'insecure' mode !!\n"
        . "!! Credentials may be exposed in debug messages !!\n" );
  }

  if ( !$options->{'aws_secret_access_key'}
    || !$options->{'aws_access_key_id'} ) {
    $self->set_credentials;

    if ( $self->get__session_token ) {
      $self->set_session_token_required(TRUE);
    }

    if ( !$self->get_cache ) {
      $self->reset_credentials;
    }
  } ## end if ( !$options->{'aws_secret_access_key'...})
  else {
    $self->set_credentials($options);
  }

  if ( !$self->get_region ) {
    $self->set_region( $ENV{'AWS_REGION'}
        || $ENV{'AWS_DEFAULT_REGION'}
        || $self->get_default_region );
  }

  return $self;
} ## end sub new

sub _set_defaults {
  my ($self) = @_;

  $self->set_debug( $self->get_debug // FALSE );

  $self->set_cache( defined $self->get_cache ? $self->get_cache : TRUE );

  if ( !$self->get_user_agent ) {
    # set a very low timeout
    $self->set_user_agent(
      LWP::UserAgent->new( timeout => $self->get_timeout || DEFAULT_TIMEOUT )
    );
  } ## end if ( !$self->get_user_agent)

  my $default_search_order = [ split /\s*,\s*/xsm, DEFAULT_SEARCH_ORDER ];

  if ( !$self->get_order ) {
    $self->set_order($default_search_order);
  }

  if ( !ref $self->get_order ) {
    $self->set_order( [ split /\s*,\s*/xsm, $self->get_order ] );
  }
  elsif ( ref $self->get_order && reftype( $self->get_order ) ne 'ARRAY' ) {
    croak 'order must be a comma delimited string or array ref';
  }

  foreach my $loc ( @{ $self->get_order } ) {
    croak "invalid credential location in search order:  [$loc]"
      if !any {/^$loc$/xsm} @{$default_search_order};
  }

  if ( !$self->get_profile && any {/file/xsm} @{ $self->get_order } ) {
    $self->set_profile( $ENV{'AWS_PROFILE'} );
  }

  return $self;
} ## end sub _set_defaults

sub set_default_logger {
  my ( $self, $debug ) = @_;

  $debug = $debug // $self->get_debug;

  my $logger = bless { debug => $debug }, 'Amazon::Credentials::Logger';

  $self->set_logger($logger);

  return $self;
} ## end sub set_default_logger

sub _init_logger {
  my ($self) = @_;

  if ( !$self->get_logger || !ref $self->get_logger ) {
    $self->set_default_logger;
  }

  $self->get_logger->debug( 'using ' . ref( $self->get_logger ) . ' logger' );

  return $self;
} ## end sub _init_logger

sub reset_credentials {
  my ( $self, $renew ) = @_;

  if ( !$renew ) {
    $self->set__access_key_id(undef);
    $self->set__secret_access_key(undef);
    $self->set__session_token(undef);
  }
  else {
    if ( $self->get_cache ) {
      $self->set_credentials;
    }
  }

  return $self;
} ## end sub reset_credentials

sub get_default_region {
  my ($self) = @_;
  my $region;

  if ( $self->get_source && $self->get_source eq 'IAM' ) {
    # try to get credentials from instance role, but we may not be
    # executing on an EC2 or container
    my $url;

    if ( $self->get_container ) {
      $url = "$ENV{ECS_CONTAINER_METADATA_URI_V4}/task";
    }
    else {
      $url = _create_metadata_url(AWS_AVAILABILITY_ZONE_URL);
    }

    my $ua = ref($self) ? $self->get_user_agent : LWP::UserAgent->new();

    my @headers;

    # add imdsv2 token to metadata request
    if ( !$self->get_container && $self->get_imdsv2_token ) {
      @headers = ( IMDSv2_HEADER => $self->get_imdsv2_token );
    }

    my $req = HTTP::Request->new( GET => $url, \@headers );

    $region = eval {
      my $rsp = $ua->request($req);

      # if not 200, then get out of Dodge
      croak "could not get availability zone\n"
        if !$rsp->is_success;

      my $content = $rsp->content;
      $content =~ s/(\d+)[[:lower:]]+$/$1/xsm;

      return $content;
    };
  } ## end if ( $self->get_source...)

  return $region;
} ## end sub get_default_region

sub set_credentials {
  my ( $self, $creds ) = @_;

  $creds = $creds || $self->find_credentials;

  if ( $creds->{'aws_secret_access_key'} && $creds->{'aws_access_key_id'} ) {

    $self->set_aws_secret_access_key( $creds->{'aws_secret_access_key'} );
    $self->set_aws_access_key_id( $creds->{'aws_access_key_id'} );
    $self->set_token( $creds->{'token'} );
    $self->set_expiration( $creds->{'expiration'} );
  } ## end if ( $creds->{'aws_secret_access_key'...})
  else {
    croak 'no credentials available';
  }

  return $self;
} ## end sub set_credentials

sub get_ec2_credentials {
  goto &find_credentials;
}

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

  my $options = ref( $args[0] ) ? $args[0] : {@args};

  if ( $options->{'profile'} ) {
    $self->set_profile( $options->{'profile'} );
  }

  if ( $options->{'order'} ) {
    $self->set_order( $options->{'order'} );
  }

  my @search_order;

  if ( $self->get_profile ) {
    @search_order = ('file');
  }
  elsif ( ref $self->get_order && reftype( $self->get_order ) eq 'ARRAY' ) {
    @search_order = @{ $self->get_order };
  }
  elsif ( !ref $self->get_order ) {
    @search_order = split /\s*,\s*/xsm, $self->get_order;
  }

  $self->get_logger->debug( 'search order ' . join COMMA, @search_order );

  my $creds = {};

  my %creds_getters = (
    env => sub {
      if ( $ENV{'AWS_ACCESS_KEY_ID'} && $ENV{'AWS_SECRET_ACCESS_KEY'} ) {
        @{$creds}{qw/source aws_access_key_id aws_secret_access_key token/}
          = (
          'ENV',
          @ENV{qw/AWS_ACCESS_KEY_ID AWS_SECRET_ACCESS_KEY AWS_SESSION_TOKEN/}
          );
      } ## end if ( $ENV{'AWS_ACCESS_KEY_ID'...})

      return $creds;
    },
    role => sub {
      return $self->get_creds_from_role;
    },
    container => sub {
      return $self->get_creds_from_container;
    },
    file => sub {
      return $self->get_creds_from_ini_file;
    },
  );

  foreach my $location (@search_order) {

    $self->get_logger->debug( 'searching for credentials in: ' . $location );

    if ( $creds_getters{$location} ) {
      $creds = $creds_getters{$location}->();
    }

    last if $creds->{'source'};
  } ## end foreach my $location (@search_order)

  foreach my $k ( keys %{$creds} ) {

    if ( $k !~ /^aws|token/xsm ) {
      $self->set( $k,, $creds->{$k} );
    }
    elsif ( $self->can("set_$k") ) {
      $self->can("set_$k")->( $self, $creds->{$k} );
    }
  } ## end foreach my $k ( keys %{$creds...})

  return $creds;
} ## end sub find_credentials

sub safe_dumper {
  my ( $self, $obj ) = @_;

  return if !ref $obj;

  my $safe_rsp;

  if ( $self->get_insecure && $self->get_insecure =~ /^2$/xsm ) {
    $safe_rsp = Dumper [$obj];
  }
  elsif ( $self->get_insecure ) {
    $safe_rsp = Dumper [$obj];

    $safe_rsp =~ s/^(.*)(access_?key[^']+)'([^']+)'([^']+)'/$1$2'$3'...'/gxsm;
    $safe_rsp
      =~ s/^(.*)(secret_?access[^']+)'([^']+)'([^']+)'/$1$2'$3'...'/gxsm;
    $safe_rsp =~ s/^(.*)(token[^']+)'([^']+)'([^']+)'/$1$2'$3'...'/gxsm;
  } ## end elsif ( $self->get_insecure)
  else {
    $safe_rsp = '** configuration contents blocked by insecure setting **';
  }

  return $safe_rsp;
} ## end sub safe_dumper

sub get_creds_from_process {
  my ( $self, $process ) = @_;

  $self->get_logger->debug("fetching credentials from $process");

  open my $fh, q{-|}, $process
    or die "could not open pipe to $process\n";

  local $RS = undef;

  my $credentials = <$fh>;
  close $fh
    or croak "could not close filehandle on $process\n";

  $credentials = eval { JSON::PP->new->decode($credentials); };

  if ( $EVAL_ERROR || !$credentials ) {
    croak "could not get credentials from process\n$EVAL_ERROR\n";
  }

  $self->get_logger->debug( $self->safe_dumper($credentials) );

  my @credential_keys = qw{
    aws_access_key_id AccessKeyId
    aws_secret_access_key SecretAccessKey
    token SessionToken
    region Region
    expiration Expiration
  };

  foreach my $pair ( pairs @credential_keys ) {
    my ( $k, $v ) = @{$pair};

    if ( exists $credentials->{$v} ) {
      $credentials->{$k} = $credentials->{$v};
      delete $credentials->{$v};
    }
  } ## end foreach my $pair ( pairs @credential_keys)

  $credentials->{source} = 'process';

  return $credentials;
} ## end sub get_creds_from_process

sub get_creds_from_ini_file {
  my ( $self, $profile ) = @_;

  $profile = $profile || $self->get_profile || 'default';

  my $creds = {};
  my $cwd   = $CWD;
  my $region;

  foreach my $config (qw{ .aws/config .aws/credentials }) {
    last if $creds->{'source'};

    my $profile_name = $profile;

    $CWD = home;

    my $fullpath = $CWD . SLASH . $config;

    if ( !-e $config ) {
      $self->get_logger->debug( 'skipping ' . $fullpath . '...not found' );
      next;
    }

    $self->get_logger->debug( 'reading ' . $fullpath );

    my $ini = Config::Tiny->read($config);

    $self->get_logger->debug( $self->safe_dumper($ini) );

    if ( $profile eq 'default' ) {
      next if !$ini->{'default'}->{'profile'};

      $profile_name = $ini->{'default'}->{'profile'};
    }

    $region = $ini->{'region'};

    my $section;

    if ( $ini->{$profile_name} ) {
      $section = $ini->{$profile_name};
    }
    elsif ( $ini->{"profile $profile_name"} ) {
      $section = $ini->{"profile $profile_name"};
    }

    my $process
      = $ini->{'credential_process'} || $section->{'credential_process'};

    if ($process) {
      $creds  = $self->get_creds_from_process($process);
      $region = $section->{'region'} ? $section->{'region'} : $region;
    }
    elsif ($section) {

      foreach
        my $k (qw{aws_access_key_id aws_secret_access_key token region}) {
        if ( defined $section->{$k} ) {
          $creds->{$k} = $section->{$k};
        }
      } ## end foreach my $k (...)

      $creds->{'source'} = $creds->{'aws_access_key_id'} ? $config : undef;
    } ## end elsif ($section)
  } ## end foreach my $config (qw{ .aws/config .aws/credentials })

  $self->get_logger->debug( $self->safe_dumper($creds) );

  $CWD = $cwd;

  $self->set_region( $creds->{'region'} || $region );

  return $creds;
} ## end sub get_creds_from_ini_file

sub is_token_expired {
  my ( $self, $window_interval ) = @_;
  $window_interval = $window_interval // DEFAULT_WINDOW_INTERVAL;

  my $expiration_date = $self->get_expiration();

  my $expired = 0;

  if ( defined $expiration_date ) {
    # AWS recommends getting credentials 5 minutes prior to expiration
    my $g = _iso8601_to_time($expiration_date);

    # shave 5 minutes or window interval off of the expiration time
    $g -= $window_interval * SECONDS_IN_MINUTE;

    # (expiration_time - window_interval) - current_time = # of seconds left before expiration
    my $seconds_left = $g - time;

    if ( $self->get_debug ) {
      $self->get_logger->debug("seconds left : $seconds_left");
      my $hours   = int( $seconds_left / SECONDS_IN_HOUR );
      my $minutes = int(
        ( $seconds_left - $hours * SECONDS_IN_HOUR ) / SECONDS_IN_MINUTE );
      my $seconds = $seconds_left
        - ( $hours * SECONDS_IN_HOUR + $minutes * SECONDS_IN_MINUTE );
      $self->get_logger->debug(
        "$hours hours $minutes minutes $seconds seconds until expiry");
    } ## end if ( $self->get_debug )

    $expired = ( $seconds_left < 0 ) ? 1 : 0;

    $self->get_logger->debug(
      Dumper [ 'EXPIRATION TIME: ' . $expiration_date,
        'EXPIRED: ' . $expired ]
    );
  } ## end if ( defined $expiration_date)

  return $expired;
} ## end sub is_token_expired

sub dump_response {
  my ( $self, $rsp ) = @_;

  my $safe_rsp;

  if ( $self->get_insecure && $self->get_insecure =~ /^2$/xsm ) {
    $safe_rsp = $rsp;
  }
  elsif ( $self->get_insecure ) {
    $safe_rsp = {};

    foreach my $k ( keys %{$rsp} ) {
      if ( $k =~ /content/xsm ) {
        my $content = $rsp->{$k};
        $content
          =~ s/\"(AccessKeyId|Token|SecretAccessKey)\"\s+\:\s+\"[^\"]+\"/\"$1\" : \"...\"/gxsm;
        $safe_rsp->{$k} = $content;
      } ## end if ( $k =~ /content/xsm)
      else {
        $safe_rsp->{$k} = $rsp->{$k};
      }
    } ## end foreach my $k ( keys %{$rsp...})
  } ## end elsif ( $self->get_insecure)
  else {
    $safe_rsp = '** HTTP RESPONSE blocked by insecure setting **';
  }

  return Dumper [$safe_rsp];
} ## end sub dump_response

sub get_creds_from_role {
  my ($self) = @_;

  # try to get credentials from instance role
  my $url = _create_metadata_url(AWS_IAM_SECURITY_CREDENTIALS_URL);

  my $ua = $self->get_user_agent;
  my $role;

  my $creds = {};

  if ( $self->get_imdsv2 ) {
    my $token_url = _create_metadata_url(IMDSv2_URL);
    my @headers   = ( IMDSv2_TTL_HEADER, IMDSv2_DEFAULT_TTL );
    my $token_req = HTTP::Request->new( PUT => $token_url, \@headers );

    $self->get_logger->debug( Dumper $token_req);

    my $rsp = $ua->request($token_req);

    $self->get_logger->debug( Dumper $rsp);

    if ( $rsp->is_success ) {
      $self->set_imdsv2_token( $rsp->content );
    }
    else {
      croak "could not retrieve IMDSv2 token\n";
    }
  } ## end if ( $self->get_imdsv2)

  $creds = eval {
    # could be infinite, but I don't think so.  Either we get an
    # error ($@), or a non-200 response code
    while ( !$creds->{'token'} ) {

      if ($role) {
        $url .= $role;
      }

      my @headers;

      if ( $self->get_imdsv2 && $self->get_imdsv2_token ) {
        @headers = ( IMDSv2_HEADER, $self->get_imdsv2_token );
      }

      my $req = HTTP::Request->new( GET => $url, \@headers );

      $self->get_logger->debug( Dumper [ "HTTP REQUEST:\n", $req ] );

      my $rsp = $ua->request($req);

      $self->get_logger->debug( $self->dump_response($rsp) );

      # if not 200, then get out of Dodge
      last if !$rsp->is_success;

      if ($role) {
        my $this = JSON::PP->new->utf8->decode( $rsp->content );
        @{$creds}{
          qw/source role aws_access_key_id aws_secret_access_key token expiration/
          } = (
          'IAM', $role,
          @{$this}{qw/AccessKeyId SecretAccessKey Token Expiration/},
          );
      } ## end if ($role)
      else {
        $role = $rsp->content;
        $self->get_logger->debug( Dumper [ 'role', $role ] );

        last if !$role;
      } ## end else [ if ($role) ]
    } ## end while ( !$creds->{'token'...})

    return $creds;
  };

  if ($EVAL_ERROR) {
    $creds->{'error'} = $EVAL_ERROR;
  }
  else {
    $creds->{'error'} = undef;
  }

  return $creds;
} ## end sub get_creds_from_role

sub refresh_credentials {
  goto &refresh_token;
}

sub refresh_token {
  my ($self) = @_;
  my $creds;

  if ( $self->get_container && $self->get_container eq 'ECS' ) {
    $creds = $self->get_creds_from_container;
  }
  elsif ( $self->get_role ) {
    $creds = $self->get_creds_from_role;
  }

  croak 'unable to refresh token!'
    if !ref($creds) || !keys %{$creds};

  return $self->set_credentials($creds);
} ## end sub refresh_token

sub credential_keys {
  my ($self) = @_;

  my %credential_keys;

  if ( !$self->get_cache ) {
    my $creds = $self->find_credentials;

    %credential_keys = (
      AWS_ACCESS_KEY_ID            => $creds->{'aws_access_key_id'},
      AWS_SECRET_ACCESS_KEY        => $creds->{'aws_secret_access_key'},
      AWS_SESSION_TOKEN            => $creds->{'token'},
      AWS_SESSION_TOKEN_EXPIRATION => $creds->{'expiration'},
    );

  } ## end if ( !$self->get_cache)
  else {
    %credential_keys = (
      AWS_ACCESS_KEY_ID            => $self->get_aws_access_key_id,
      AWS_SECRET_ACCESS_KEY        => $self->get_aws_secret_access_key,
      AWS_SESSION_TOKEN            => $self->get_token,
      AWS_SESSION_TOKEN_EXPIRATION => $self->get_expiration,
    );
  } ## end else [ if ( !$self->get_cache)]

  if ( !defined $credential_keys{AWS_SESSION_TOKEN} ) {
    delete $credential_keys{AWS_SESSION_TOKEN};
    delete $credential_keys{AWS_SESSION_TOKEN_EXPIRATION};
  }

  return \%credential_keys;
} ## end sub credential_keys

sub as_string {
  my ($self) = @_;

  return JSON::PP->new->pretty->encode( $self->credential_keys );
}

sub format_credentials {
  my ( $self, $format ) = @_;

  $format = $format || "%s %s\n";

  my $credential_keys = $self->credential_keys;

  return join q{}, map { sprintf $format, $_, $credential_keys->{$_} }
    keys %{$credential_keys};
} ## end sub format_credentials

sub get_creds_from_container {
  my ( $self, $uri ) = @_;

  $uri = $uri || $ENV{AWS_CONTAINER_CREDENTIALS_RELATIVE_URI};

  my $creds = {};

  if ($uri) {
    $self->get_logger->debug( caller(2), $uri );

    $creds = eval {
      # try to get credentials from instance role
      my $url = AWS_CONTAINER_CREDENTIALS_URL . $uri;

      my $ua  = $self->get_user_agent;
      my $req = HTTP::Request->new( GET => $url );
      $req->header(qw{ Accept */* });

      $self->get_logger->debug( Dumper [ "HTTP REQUEST:\n", $req ] );

      $self->get_logger->debug( Dumper [ $req->as_string ] );

      my $rsp = $ua->request($req);

      $self->get_logger->debug( $self->dump_response($rsp) );

      # if not 200, then get out of Dodge
      if ( $rsp->is_success ) {

        my $this = JSON::PP->new->utf8->decode( $rsp->content );

        @{$creds}{
          qw/source container aws_access_key_id aws_secret_access_key token expiration/
          } = (
          'IAM', 'ECS',
          @{$this}{qw/AccessKeyId SecretAccessKey Token Expiration/},
          );
      } ## end if ( $rsp->is_success )
      else {
        $self->get_logger->debug( 'return code: ' . $rsp->status_line );
      }

      return $creds;
    };

    $creds->{'error'} = $EVAL_ERROR;
    $self->get_logger->debug("EVAL_ERROR: $EVAL_ERROR\n");

  } ## end if ($uri)
  else {
    $self->get_logger->debug(
      "not running in a container: no URI in environment\n");
  }

  return $creds;
} ## end sub get_creds_from_container

sub rotate_credentials {
  my ( $self, $new_passkey ) = @_;

  if ( $new_passkey && !ref $new_passkey ) {
    if ( $self->get_cache ) {
      $self->set_aws_access_key_id( $self->get_aws_access_key_id,
        $new_passkey );

      $self->set_aws_secret_access_key( $self->get_aws_secret_access_key,
        $new_passkey );

      $self->set_token( $self->get_token, $new_passkey );
    } ## end if ( $self->get_cache )

    # if caller has his own passkey generator, don't reset
    if ( !ref $self->get_passkey ) {
      $self->set_passkey($new_passkey);
    }
  } ## end if ( $new_passkey && !...)
  else {
    $new_passkey = $self->create_passkey;

    $self->rotate_credentials($new_passkey);
  }

  return $new_passkey;
} ## end sub rotate_credentials

sub get_aws_access_key_id {
  my ($self) = @_;

  if ( !$self->get__access_key_id ) {
    $self->set_credentials;
  }

  my $access_key_id
    = $self->decrypt( $self->get__access_key_id, $self->_fetch_passkey );

  if ( !$self->get_cache ) {
    $self->set__access_key_id(undef);
  }

  return $access_key_id;
} ## end sub get_aws_access_key_id

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

  if ( !$self->get__secret_access_key ) {
    $self->set_credentials;
  }

  my $secret_access_key
    = $self->decrypt( $self->get__secret_access_key, $self->_fetch_passkey );

  if ( !$self->get_cache ) {
    $self->set__secret_access_key(undef);
  }

  return $secret_access_key;
} ## end sub get_aws_secret_access_key

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

  if ( !$self->get__session_token && $self->get_session_token_required ) {
    $self->set_credentials;
  }

  my $token
    = $self->decrypt( $self->get__session_token, $self->_fetch_passkey );

  if ( !$self->get_cache ) {
    $self->set__session_token(undef);
  }

  return $token;
} ## end sub get_token

sub set_aws_access_key_id {
  my ( $self, $aws_access_key_id, $passkey ) = @_;

  my $key = $aws_access_key_id || undef;

  if ($aws_access_key_id) {
    $key = $self->encrypt( $aws_access_key_id, $passkey );
  }

  return $self->set__access_key_id($key);
} ## end sub set_aws_access_key_id

sub set_aws_secret_access_key {
  my ( $self, $aws_secret_access_key, $passkey ) = @_;

  my $key = $aws_secret_access_key || undef;

  if ($aws_secret_access_key) {
    $key = $self->encrypt( $aws_secret_access_key, $passkey );
  }

  return $self->set__secret_access_key($key);

} ## end sub set_aws_secret_access_key

sub set_token {
  my ( $self, $session_token, $passkey ) = @_;

  my $token = $session_token || undef;

  if ($session_token) {
    $token = $self->encrypt( $session_token, $passkey );
  }

  return $self->set__session_token($token);
} ## end sub set_token

# +-----------------+
# | PRIVATE METHODS |
# +-----------------+

sub _fetch_passkey {
  my ($self) = @_;

  my $passkey = eval {
    if ( ref $self->get_passkey && reftype( $self->get_passkey ) eq 'CODE' ) {
      return $self->get_passkey->();
    }
    else {
      return $self->get_passkey;
    }
  };

  return $passkey;
} ## end sub _fetch_passkey

sub _init_encryption {
  my ($self) = @_;

  # if one is set, both must be set
  if ( $self->get_encrypt || $self->get_decrypt ) {
    croak 'must be a code reference to encrypt()'
      if ref $self->get_encrypt ne 'CODE';

    croak 'must be a code reference to decrypt()'
      if ref $self->get_decrypt ne 'CODE';

    $self->set_encryption(TRUE);
  } ## end if ( $self->get_encrypt...)
  else {
    my $has_crypt_cbc = eval { require Crypt::CBC; };

    if ( !defined $self->get_encryption ) {
      # let's make the default to encrypt (if we can)
      $self->set_encryption( $has_crypt_cbc ? TRUE : FALSE );
    }
    else {
      # don't allow encryption if Crypt::CBC not present
      $self->set_encryption( $self->get_encryption && $has_crypt_cbc );
    }

    if ( $self->get_encryption && !$self->get_cipher ) {
      $self->set_cipher(DEFAULT_CIPHER);
    }

  } ## end else [ if ( $self->get_encrypt...)]

  if ( $self->get_encryption && !$self->get_passkey ) {
    $self->set_passkey( $self->create_passkey );
  }

  return $self->get_encryption;
} ## end sub _init_encryption

sub _crypt {
  my ( $self, $str, $op, $passkey ) = @_;

  return if !$str;

  $passkey = $passkey || $self->_fetch_passkey();

  my $cipher;

  if ( $self->get_encryption ) {
    $cipher = Crypt::CBC->new(
      '-pass'        => $passkey,
      '-key'         => $passkey,
      '-cipher'      => $self->get_cipher,
      '-nodeprecate' => 1,
    );
  } ## end if ( $self->get_encryption)

  # at least obfuscate the credentials
  if ( $op eq 'decrypt' ) {
    $str
      = ref($cipher)
      ? $cipher->decrypt( decode_base64($str) )
      : decode_base64($str);
  } ## end if ( $op eq 'decrypt' )
  else {
    $str
      = ref($cipher)
      ? encode_base64( $cipher->encrypt($str) )
      : encode_base64($str);
  } ## end else [ if ( $op eq 'decrypt' )]

  return $str;
} ## end sub _crypt

sub decrypt {
  my ( $self, $str, $passkey ) = @_;

  if ( ref $self->get_decrypt && reftype( $self->get_decrypt ) eq 'CODE' ) {
    return $self->get_decrypt->( $str, $passkey || $self->_fetch_passkey );
  }
  else {
    return $self->_crypt( $str, 'decrypt', $passkey );
  }
} ## end sub decrypt

sub encrypt {
  my ( $self, $str, $passkey ) = @_;

  if ( ref $self->get_encrypt && reftype( $self->get_encrypt ) eq 'CODE' ) {
    return $self->get_encrypt->( $str, $passkey || $self->_fetch_passkey );
  }
  else {
    return $self->_crypt( $str, 'encrypt', $passkey );
  }

} ## end sub encrypt

sub create_passkey {
  return sprintf PASSKEY_FORMAT, rand RANDOM_VALUE, rand RANDOM_VALUE;
}

sub _iso8601_to_time {
  my $iso8601 = shift;

  $iso8601 =~ s/^(.*)Z$/$1\+00:00/xsm;

  my $gmtime = eval {
    local $ENV{TZ} = 'GMT';

    timegm( strptime( $iso8601, '%Y-%m-%dT%H:%M:%S%z' ) );
  };

  return $gmtime;
} ## end sub _iso8601_to_time

sub _create_metadata_url {
  my ($url) = @_;

  return AWS_METADATA_BASE_URL . $url;
}

1;

__END__

=pod

=head1 NAME

Amazon::Credentials - fetch Amazon credentials from file, environment or role

=head1 SYNOPSIS

 my @order = qw{ env file container role };
 my $creds = Amazon::Credentials->new( { order => \@order } );

=head1 DESCRIPTION

Class to find AWS credentials from either the environment,
configuration files, instance meta-data or container role.

You can specify the order using the C<order> option in the constructor
to determine the order in which the class will look for credentials.
The default order is I<environent>, I<file>, I<container>, I<instance
meta-data>. See L</new>.

=head1 VERSION

This document reverse to verion @PACKAGE_VERION@ of
C<Amazon::Credentials>.

=head1 METHODS AND SUBROUTINES

=head2 new

 new( options );

 my $aws_creds = Amazon::Credential->new( { profile => 'sandbox', debug => 1 });

C<options> is a hash of keys that represent various options you can
pass to the constructor to control how it will look for credentials.
Any of the options can also be retrieved using their corresponding
'get_{option} method.

=head3 options

=over 5

=item aws_access_key_id

AWS access key.

=item aws_secret_access_key

AWS secret access key.

I<Note: If you pass the access keys in the constructor then the
constructor will not look in other places for credentials.>

=item cache

boolean when set to false will prevent C<Amazon::Credentials> from
cacheing credentials. B<Cacheing is enabled by default.>

I<Note that the if cacheing is disabled, the module will obtain
credentials on the first call to one of the getters
(C<get_aws_secret_access_key>, C<get_aws_access_key_id> or
C<get_token>). After each method call to retrieve the credential it
will be removed. However, for a brief period before all of them have
been accessed by the getter credentials will be locally stored.>

If you use the C<credential_keys> method for retrieving credentials,
the entire tuple of credentials will be immediately passed to you
without cacheing (if cacheing is disabled).

=item container

If the process is running in a container, this value will contain
'ECS' indicating that the credentials were optained for the task
role. The class will look for credentials using the container metadata
service:

 http://169.254.170.2/$AWS_CONTAINER_CREDENTIALS_RELATIVE_URI

=item debug

Set to true for verbose troubleshooting information. Set C<logger> to
a logger that implements a logging interface (ala
C<Log::Log4perl>.

=item decrypt

Reference to a custom method that will decrypt credentials prior to
returning them from the cache. The method will be passed the string to
decrypt and a passkey.

=item encrypt

Reference to a custom method that will encrypt credentials prior to
storing them in the cache.  The method will be passed a string to
encrypt and the passkey.

=item env - Environment

If there exists an environment variable $AWS_PROFILE, then an attempt
will be made to retrieve credentials from the credentials file using
that profile, otherwise the class will for these environment variables
to provide credentials.

 AWS_ACCESS_KEY_ID
 AWS_SECRET_ACCESS_KEY
 AWS_SESSION_TOKEN

I<Note that when you set the environment variable AWS_PROFILE, the
order essentially is overridden and the class will look in your
credential files (F<~/.aws/config>, F<~/.aws/credentials>) to resolve
your credentials.>

=item file - Configuration Files

=over 10

=item ~/.aws/config

=item ~/.aws/credentials

=back

The class will attempt to resolve credentials by interpretting the
information in these two files. You can also specify a profile to use
for looking up the credentials by passing it into the constructor or
setting it the environment variable C<AWS_PROFILE>.  If no profile is
provided, the default credentials or the first profile found is used.

 my $aws_creds = Amazon::Credentials->new({ order => [qw/environment role file/] });

=item insecure

A debugging mode can be enabled to display information that may aid in
troubleshooting, however output may include credentials.  This
attribute prevents accidental exfiltration of credentials during
troubleshooting. The default setting of C<insecure> is therefore
C<false>. This will prevent debug messages that may contain credentials
(HTTP response, configuration file contents) from exposing sensitive
data.

Set the value to 1 to enable all debug output B<except> the content of
credentials in HTTP responses. Set the value to 2 to enable full debug
output.

I<Note that setting the value to 1 will enable the use of regular
expressions to suppress credential contents. Credentials that do not
conform to these may still be exposed. Caution is advised.>

=item logger

Pass in your own logger that has a C<debug()> method.  Otherwise the
default logger will output debug messages to STDERR.

=item order

An array reference containing tokens that specifies the order in which the class will
search for credentials.

default:  env, role, container, file

Example:

  my $creds = Amazon::Credentials->new( { order => [ qw/file env role/] });

=item passkey

A custom passkey for encryption. You can pass a scalar or a reference
to a subroutine that returns the passkey. The return value of the
subroutine should be idempotent, however you can change the subroutine
used for encryption if you are B<not> cacheing the credentials.  If
you are cacheing credentials you should reset the credentials with the
new passkey method.

 $credentials->set_passkey(\&new_passkey_provider);
 $credentials->reset_credentials(1);


=item profile

The profile name in the configuration file (F<~/.aws/config> or
F<~/.aws/credentials>).

 my $aws_creds = Amazon::Credentials->new({ profile => 'sandbox' });

The class will also look for the environment variable C<AWS_PROFILE>,
so you can invoke your script like this:

 $ AWS_PROFILE=sandbox my-script.pl

=item region

Default region. The class will attempt to find the region in either
the configuration files or the instance unless you specify the region
in the constructor.

=item role - Instance Role

The class will use the
I<http://169.254.169.254/latest/meta-data/iam/security-credential> URL
to look for an instance role and credentials.

Credentials returned by accessing the meta-data include a token that
should be passed to Amazon APIs along with the access key and secret.
That token has an expiration and should be refreshed before it
expires.

 if ( $aws_creds->is_token_expired() ) {
   $aws_creds->refresh_token()
 }

=item timeout

When looking for credentials in metadata URLs, this parameter
specifies the timeout value for C<LWP>.  The default is 3 seconds.

=item user_agent

Pass in your own user agent, otherwise LWP will be used. I<Probably>
only useful to override this for testing purposes.>

=back

=head2 as_string

 as_string()

Returns the credentials as a JSON encode string.

=head2 credential_keys

 my $credential_keys = $creds->credential_keys;

Return a hash reference containing the credential keys with standard
key names. Note that the session token will only be present in the
hash for temporary credentials.

=over 5

=item AWS_ACCESS_KEY_ID

=item AWS_SECRET_ACCESS_KEY

=item AWS_SESSION_TOKEN

=back

=head2 format_credentials

 format_credentials(format-string)

Returns the credentials as a formatted string.  The <format> argument
allows you to include a format string that will be used to output each
of the credential parts.

 format("export %s=%s\n");

The default format is a "%s %s\n".

=head2 find_credentials

 find_credentials( option => value, ...);

You normally don't want to use this method. It's automatically invoked
by the constructor if you don't pass in any credentials. Accepts a
hash or hash reference consisting of keys (C<order> or C<profile>) in
the same manner as the constructor.

=head2 get_creds_from_*

These methods are called internally when the C<new> constructor is
invoked. You should never need to call these methods. All of these
methods will return a hash of credential information and metadata
described below.

=over 5

=item aws_access_key_id

The AWS access key.

=item aws_secret_access_key

The AWS secret key.

=item token

Security token used with access keys.

=item expiration

Token expiration date.

=item role

IAM role if available.

=item source

The source from which the credentials were found. 

=over 3

=item * IAM - retrieved from container or instance role

=item * container - 'ECS' if retrieved from container

=item * file - retrieved from file

=item * process - retrieved from an external process

=item * ENV - retrieved from environment

=back

=back

=head3 get_creds_from_container

 get_creds_from_container()

Retrieves credentials from the container's metadata at
http://169.254.170.2.  Returns a hash of credentials containing:

  aws_access_key_id
  aws_secret_access_key
  aws_session_token

Returns an empty hash if no credentials found.  The environment
variable C<AWS_CONTAINER_CREDENTIALS_RELATIVE_URI> must exist or you
must pass the value of the path as an argument.

=head3 get_creds_from_process

 get_creds_from_process(process)

Retrieves credentials from a helper process defined in the config
file. Returns the credentials tuple.

=head3 get_creds_from_role

 get_creds_from_role()

Returns a hash, possibly containing access keys and a token.

=head2 get_default_region

Returns the region of the currently running instance or container.
The constructor will set the region to this value unless you set your
own C<region> value. Use C<get_region> to retrieve the value after
instantiation or you can call this method again and it will make a
second call to retrieve the instance metadata.

=head2 get_ec2_credentials (deprecated)

See L</find_credentials>

=head2 is_token_expired

 is_token_expired( window-interval )

Returns true if the token is about to expire (or is
expired). C<window-interval> is the time in minutes before the actual
expiration time that the method should consider the token expired.
The default is 5 minutes.  Amazon states that new credentials will be
available I<at least> 5 minutes before a token expires.

=head2 reset_credentials

By default this method will remove credentials from the cache if you
pass a false or no value. Passing a true value will refresh your
credentials from the original source (equivalent to calling
C<set_credentials>).

=head2 refresh_token (deprecated)

use C<refresh_credentials()>

=head2 refresh_credentials()

Retrieves a fresh set of IAM credentials.

 if ( $creds->is_token_expired ) {
   $creds->refresh_token()
 }

=head2 set_credentials

Looks for your credentials according to the order specified by the
C<order> attribute passed in the constructor and stores the
credentials in the cache.

I<Note that you should never have to call
this method. If you call this method it will ignore your cache
setting!>

=head1 SETTERS/GETTERS

All of the options described in the new method can be accessed by a
I<getter> or set using a I<setter> of the same name.

Example:

 $creds->set_cache(0);

=head1 DIAGNOSTICS

Set the C<debug> option when you instantiate a C<Amazon::Credentials>
object to output debug and diagnostic messages. Note that you must
also set the C<insecure> option if you want to output full
diagnostics. I<WARNING: Full diagnostics may include credentials. Be
careful not to expose these values in logs.>

=head1 CONFIGURATION AND ENVIRONMENT

The module will recognize several AWS specific environment variables
described throughout this documentation.

=over 5

=item AWS_ACCESS_KEY_ID

=item AWS_SECRET_ACCESS_KEY

=item AWS_SESSION_TOKEN

=item AWS_REGION

=item AWS_DEFAULT_REGION

=item AWS_CONTAINER_CREDENTIALS_RELATIVE_URI

=back

=head1 BUGS AND LIMITATIONS

C<Amazon::Credentials> will B<not> attempt to retrieve temporary
credentials for profiles that specify a role. If for example you
define a role in your credentials file thusly:

 [developer]

  role_arn = arn:aws:iam::123456789012:role/developer-access-role
  source_profile = dev

The module will not return credentials for the I<developer>
profile. While it would be theoretically possible to return those
credentials, in order to assume a role, one needs credentials (chicken
and egg problem).

=head1 DEPENDENCIES

Lower versions of these modules may be acceptable.

 'Class::Accessor::Fast' => '0.31'
 'Config::Tiny'          => '2.28'
 'Date::Format'          => '2.24'
 'File::HomeDir'         => '1.00'
 'File::chdir'           => '0.1010'
 'HTTP::Request'         => '6.00'
 'List::Util'            => '1.5'
 'LWP::UserAgent'        => '6.36'
 'POSIX::strptime'       => '0.13'

...and possibly others

In order to enable true encryption of your credentials when cached,
C<Crypt::CBC> is also required.

=head1 SECURITY CONSIDERATIONS

The security concern around your credentials is not actually the fact
that the credentials can be retrieved and viewed - any process that
compromises your environment can use the same methods this class does
to resolve those credentials. Let me repeat that. If your environment
is compromised then an actor can use all of the methods employed in
this module to access your credentials.

The major issue you should be concerned about is exposing your
credentials outside of the environment running your program.  Thats
is, the exfiltration of your credentials.  Once you have resolved
these credentials you may inadvertantly reveal them in many
ways. Dumping objects to logs, saving your credentials in files or
even outputing them to your console may expose your credentials. This
module will now at the very least obfuscate them when they are stored
in memory. Accidental dumping of objects will not reveal your
credentials in plain-text.

B<Always take precautions to prevent accidental exfiltration of your
credentials.>

=head2 How C<Amazon::Credentials> Helps Prevent Exfiltration

For performance and historical reasons the default is for
C<Amazon::Credentials> to cache your credentials. Starting with
version I<1.1.0>, the module will attempt to encrypt the credentials
before storing them. The module uses C<Crypt::CBC> (if available) with
the default cipher and a random (or user defined) passkey.

Even if C<Crypt::CBC> is not available, the module will try to
obfuscate the credentials. A determined actor can still decrypt these
keys if they have access to the obfuscated values and your
passkey. You have several options to better secure your credentials
from exposure.

=over 5

=item Option 1 - Do not cache your credentials.

Use the C<set_cache()> method with a false value or set C<cache> to
false when you instantiate the class. B<The default is to cache
credentials.>

 my $credentials = Amazon::Credentials->new(cache => 0);

Normally, your credentials are fetched when the C<Amazon::Credentials>
object is instantiated. With cacheing turned off credentials will not
be fetched until they are first requested.

There are two ways your programs typically will fetch the keys; either
using the getter methods on the individual credentials keys or by
retrieving a hash containing all of the keys.

=over 5

=item C<credential_keys()>

Use the method C<credential_keys> to retrieve all of the keys at once
as a hash. Using this method with cacheing turned off will prevent
C<Amazon::Credentials> from ever saving your credentials to variables
that can be inadvertantly exposed. Each subsequent request for the
keys will cause C<Amazon::Credentials> to fetch the keys again.

=item Getter Methods

If you use the individual getters (C<get_aws_access_key_id>,
C<get_aws_secret_access_key> and C<get_token>), the keys will first be
fetched and stored. As each getter is called the key will be removed
(burn after reading, so to speak). Therefore, for a brief period your
credentials will be cached even if cacheing is turned off.

=back

=item Option 2 - Remove them manually after use

Call the C<reset_credentials()> with a false value after
fetching credentials or after they are used by downstream
processes. Call the C<reset_credential()> method with a true value to
regenerate credentials.

=item Option 3 - Encrypt your credentials

C<Amazon::Credentials> will encrypt your credentials by default
starting with version I<1.1.0>. If C<Crypt::CBC> is available, the
class will use the default cipher and a random passkey to encrypt your
credentials. If the encryption module is not available, the class will
still obfuscate (not encrypt) the credentials. Encryption when the
passkey and method used are known to a determined bad actor is
no better than obfuscation. Accordingly, there are several ways you
can and should encrypt credentials in a more secure way.

=over 3

=item Using a Custom C<passkey>

By default the module will generate its own random passkey during
initialization and use that to encrypt and decrypt the
credentials. Obviously the passkey must be available for
C<Amazon::Credentials> to decrypt the keys and thus it is stored with
the credentials which is less than ideal. To avoid storing the passkey
with the credentials, pass a reference to a subroutine that will
provide the passkey for encryption and decryption. You can even use
the same passkey generator that is used by C<Amazon::Credentials>
(C<create_passkey>).

The point here is to avoid storing credentials in the same object as
the credentials to minimize the likelihood of exposing your
credentials or your methods for encryption in logs...better but
not perfect. It's still possible to expose your passkey and your
credentials if you are not careful.

 use Amazon::Credentials qw{ create_passkey };

 my $passkey = create_passkey();

 my $credentials = Amazon::Credentials( passkey => sub { return $passkey } );

A more secure approach would be for your subroutine to retrieve a
passkey from a source other than your own program and B<never> store
the passkey inside your program.

=item Using a Custom Cipher

As noted, the default C<Crypt::CBC> cipher is used for encrypting your
credentials, however you can pass a custom cipher supported by
C<Crypt::CBC> further obfuscating the methods used to encrypt your
credentials.

 my $credentials = Amazon::Credentials(
   passkey => \&fetch_passkey,
   cipher  => 'Blowfish'
 );

=item Rotating Passkeys and Credentials

For those with the (justifiably) paranoid feeling that no matter what
you do there are those determined to crack even encrypted or obfuscated
credentials once exposed, you can periodically rotate the credentials.

If you are not using a custom passkey...

 $credentials->rotate_credentials;

...or if you have a custom passkey generator your subroutine must
continue to provide the old passkey before you can reset the passkey.

 use Amazon::Credentials qw{ create_passkey };

 my $passkey = create_passkey;

 sub get_passkey {
   my ($regenerate) = shift;
   
   return $regenerate ? create_passkey : $passkey;
 } 
 
 my $credentials = Amazon::Credentials->new( passkey => \&get_passkey );
 
 $passkey = $credentials->rotate_credentials(get_passkey(1));

=item Using Custom Encryption Methods

Finally, you can also provide your own C<encrypt()> and C<decrypt()>
methods when you call the C<new()> constructor. These methods will be
passed the string to encrypt or decrypt and the passkey. Your methods
should return the decrypted or encrypted strings. Your methods can
ignore the passkey if your methods provide their own passkey or
mechanisms for encryption.

 use Amazon::Credentials qw( create_passkey };

 my $passkey = create_passkey();

 sub my_encrypt {
   my ($self, $str) = @_;

   ...
   return $encrypted_str;
 }

 sub my_decrypt {

   ...
   return $deecrypted_str;
 }

 my $creds = Amazon::Credentials->new( encrypt => \&my_encrypt,
                                       decrypt => \&my_decrypt,
                                       passkey => sub { return $passkey },
                                     );

=back

=back

=head2 Securing Your Logs

To troubleshoot potential bugs in this module or to understand what
C<Amazon::Credentials> is doing you can pass a debug flag that will
write potentially helpful info to STDERR.

To prevent possible exposure of credentials in debug messages, the
module will not write log messages that contain your credentials even
if your debug flag is set to a true value. In order to debug output of
all content you the C<insecure> flag to any of the values shown below.

=over 5

=item insecure = false (0, '', undef)

If the debug flag is true, any message that might potentially contain
credentials is not written to STDERR. This is the default.

=item insecure = 1

Setting C<insecure> to 1 will allow more debug messages, however
credentials will be masked.

=item insecure = 2 or 'insecure'

This setting, along with setting the debug mode to a true value will
enable full debugging.

=back

=head2 Use Temporary Credentials

One additional tip to help prevent the use of your credentials even if
they have been exposed in logs or files. I<Use temporary credentials
with short expiration times whenever possible.> C<Amazon::Credentials>
provides methods to determine if your credentials have expired and
a method to refresh them when they have.

 if ( $credentials->is_token_expired ) {
   $credentials->refresh_token;
 }

=head2 Additonal Notes on Logging

Versions I<1.0.18> and I<1.0.19> allowed you to enable debugging by
setting the environment variable DEBUG to any true value to enable
basic debug output. Version I<1.0.18> would log information to STDERR
including payloads that might contain credentials.  Version I<1.0.19>
would prevent writing any payload with credentials I<unless> the debug
mode was set to 2 or 'insecure'.

Starting with version I<1.1.0> the C<Amazon::Credentials> will not use
the environment variable DEBUG to enable debugging. You must
explicitly pass the debug flag in the constructor to enable
debugging. Keep in mind however that you should avoid allowing
upstream programs to use environment variables to set debugging modes
that you might pass to C<Amazon::Credentials>.

=head1 INCOMPATIBILITIES

This module has not been tested on Windows OS.

=head1 CONTRIBUTING

You can find this project on GitHub at
L<https://github.com/rlauer6/perl-Amazon-Credentials>.  PRs are always
welcomed!

=head1 LICENSE AND COPYRIGHT

This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.

=head1 AUTHOR

Rob Lauer - <rlauer6@comcast.net>

=cut
