File Coverage

blib/lib/Amazon/Credentials.pm

Criterion	Covered	Total	%
statement	451	618	72.9
branch	139	264	52.6
condition	79	176	44.8
subroutine	70	84	83.3
pod	19	44	43.1
total	758	1186	63.9

package Amazon::Credentials;
# - module for finding and providing AWS 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
    error
    expiration
    imdsv2
    imdsv2_token
    insecure
    logger
    order
    no_passkey_warning
    print_error
    profile
    raise_error
    region
    role
    _secret_access_key
    _session_token
    session_token_required
    source
    sso_role_name
    sso_account_id
    sso_region
    timeout
    user_agent
  )
);

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

use constant {  ## no critic (ProhibitConstantPragma, Capitalization)
  AWS_AVAILABILITY_ZONE_URL =>
    q{latest/meta-data/placement/availability-zone},
  AWS_CONTAINER_CREDENTIALS_URL    => q{http://169.254.170.2/},
  AWS_IAM_SECURITY_CREDENTIALS_URL =>
    q{latest/meta-data/iam/security-credentials/},
  AWS_METADATA_BASE_URL         => q{http://169.254.169.254/},
  CACHE_DIR                     => '.aws/sso/cache',
  COMMA                         => q{,},
  DEFAULT_CIPHER                => q{Cipher::AES},
  DEFAULT_REGION                => 'us-east-1',
  DEFAULT_SEARCH_ORDER          => q{env,container,role,file},
  DEFAULT_TIMEOUT               => 2,
  DEFAULT_WINDOW_INTERVAL       => 5,
  EMPTY                         => q{},
  FALSE                         => 0,
  GET_ROLE_CREDENTIALS_HOSTNAME => 'portal.sso.%s.amazonaws.com',
  GET_ROLE_CREDENTIALS_QUERY    => '?account_id=%s&role_name=%s',
  GET_ROLE_CREDENTIALS_URI      => 'federation/credentials',
  IMDSv2_DEFAULT_TTL            => 21_600,
  IMDSv2_HEADER                 => q{x-aws-ec2-metadata-token},
  IMDSv2_TTL_HEADER             => q{x-aws-ec2-metadata-token-ttl-seconds},
  IMDSv2_URL                    => q{latest/api/token},
  INSECURE_MODE                 => 2,
  ISO8601_FORMAT                => q{%Y-%m-%dT%H:%M:%S%z},
  LOG_FORMAT                    => qq{ %s [%s] %s\n },
  PASSKEY_FORMAT                => q{%08X%08x},
  RANDOM_VALUE                  => 0xffffffff,
  SECONDS_IN_HOUR               => 3600,
  SECONDS_IN_MINUTE             => 60,
  SLASH                         => q{/},
  TRUE                          => 1,
  X_AMZ_SSO_BEARER_TOKEN        => ':x-amz-sso_bearer_token',
};

our $VERSION = '1.1.20';  ## no critic (RequireInterpolation)

our @EXPORT_OK
  = qw( create_passkey set_sso_credentials get_role_credentials );

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

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

    return if !$self->{debug};

    my @tm = localtime time;

    my $timestamp = strftime '%c', @tm;

    my $message = sprintf LOG_FORMAT, $timestamp, $PROCESS_ID, @message;

    print {*STDERR} $message;
  };
}

caller or __PACKAGE__->main();

########################################################################
sub new {
########################################################################
  my ( $class, @args ) = @_;

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

  my $passkey = delete $options->{passkey};

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

  $self->_set_defaults;

  $self->_init_logger;

  # note that multiple instances of the Amazon::Credentials will share
  # the same passkey...this is probably a bug
  if ( $self->get_passkey && $passkey ) {
    if ( !$self->get_no_passkey_warning ) {
      carp <<'WARNING';
WARNING: the encryption passkey has already been set. Resetting the
passkey will require that you restore the original passkey if you are
using more than one instance of Amazon::Credentials.

To turn this warning off set 'no_passkey_warning' to a true value.
WARNING
    }

    $self->_init_encryption($passkey);
  }
  elsif ( $self->get_passkey ) {
    if ( !$self->get_no_passkey_warning ) {
      carp <<'WARNING';
WARNING: the encryption passkey has already been set. Using the previous passkey.

To turn this warning off set 'no_passkey_warning' to a true value.
WARNING
    }

    $self->_init_encryption( $self->get_passkey );
  }
  else {
    $self->_init_encryption($passkey);
  }

  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 the caller wants us to use his SSO credentials
  if ( $self->get_sso_role_name && $self->get_sso_account_id ) {
    my $region = $self->get_sso_region || $self->get_region;

    # this just sets the environmet
    set_sso_credentials( $self->get_sso_role_name, $self->get_sso_account_id,
      $region );

    # we'll set them from the environment below
    $self->set_order( ['env'] );
  }

  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;
    }
  }
  else {
    $self->get_logger->debug( 'setting credentials from options ',
      Dumper( [$options] ) );

    $self->set_credentials($options);
  }

  if ( !$self->get_region ) {
    $self->set_region( $self->get_region_from_env
        || $self->get_default_region );
  }

  return $self;
}

########################################################################
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;
}

########################################################################
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;
}

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

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

  return $region;
}

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

  my $region = $self->get_region_from_config;

  # only do this if we are sure we are on an EC2
  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;
    };
  }

  return $region;
}

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

  $self->set_error(EMPTY);

  $creds = eval {
    if ( !$creds ) {
      $creds = eval { return $self->find_credentials };
    }

    $self->set_error( $creds->{error} || $EVAL_ERROR );

    croak 'no credentials available'
      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} || $creds->{aws_session_token} );

    $self->set_expiration( $creds->{expiration} );

    return $creds;
  };

  if ( $EVAL_ERROR && !$self->get_error ) {
    $self->set_error($EVAL_ERROR);
  }

  undef $EVAL_ERROR;

  croak $self->get_error
    if $self->get_error && $self->get_raise_error;

  carp $self->get_error
    if $self->get_error && $self->get_print_error;

  return $self;
}

########################################################################
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_getters = (
    env => sub {
      return $self->get_creds_from_env,;
    },
    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;
    },
  );

  my $creds;

  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};
  }

  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} );
    }
  }

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

  return $creds;
}

# +------------------+
# | get_creds_from_* |
# +------------------+

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

  return {}
    if !$ENV{AWS_ACCESS_KEY_ID} || !$ENV{AWS_SECRET_ACCESS_KEY};

  $self->get_logger->debug('fetching credentials from env');

  my @cred_keys = (
    aws_access_key_id     => 'AWS_ACCESS_KEY_ID',
    aws_secret_access_key => 'AWS_SECRET_ACCESS_KEY',
    aws_session_token     => 'AWS_SESSION_TOKEN',
    token                 => 'AWS_SESSION_TOKEN',
  );

  return populate_creds( 'ENV', \@cred_keys, \%ENV );
}

########################################################################
sub populate_creds {
########################################################################
  my ( $source, $cred_keys, $creds_source ) = @_;

  my $creds = { source => $source };

  foreach my $p ( pairs @{$cred_keys} ) {
    my ( $k, $v ) = @{$p};
    $creds->{$k} = $creds_source->{$v};
    next if $source =~ /env/i;

    delete $creds_source->{$v};
  }

  return $creds;
}

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

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

  my $credentials = eval {
    open my $fh, q{-|}, $process
      or croak "could not open pipe to $process\n$OS_ERROR";

    local $RS = undef;

    my $credentials_str = <$fh>;

    close $fh
      or croak "could not close filehandle on $process\n";

    return decode_json($credentials_str);
  };

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

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

  my @cred_keys = (
    aws_access_key_id     => 'AccessKeyId',
    aws_secret_access_key => 'SecretAccessKey',
    token                 => 'SessionToken',
    aws_session_token     => 'SessionToken',
    region                => 'Region',
    expiration            => 'Expiration',
  );

  return populate_creds( 'process', \@cred_keys, $credentials );
}

########################################################################
sub create_config_path {
########################################################################
  my ($config) = @_;

  my $fullpath = home . SLASH . $config;

  return -e $fullpath ? $fullpath : EMPTY;
}

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

  my $config = create_config_path('.aws/config');

  return if !$config;

  $self->get_logger->debug("config: $config");

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

  my $region;

  if ( $ini->{default} ) {
    $region = $ini->{default}->{region};
  }

  $self->get_logger->debug( 'default region: ' . $region // 'undef' );

  return $region;
}

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

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

  my $creds = {};
  my $region;

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

    my $profile_name = $profile;

    my $fullpath = create_config_path($config);

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

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

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

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

    if ( $ini->{default} ) {
      $region = $ini->{default}->{region};
    }

    my $section;

    if ( $ini->{$profile_name} ) {
      $section = $ini->{$profile_name};
    }
    elsif ( $ini->{"profile $profile_name"} ) {  ## config file format
      $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) {

      # credentials in a config file shouldn't really have a session token,
      # but if it does we'll capture it as aws_session_token. For
      # historical reasons pertaining to how other CPAN classes
      # referred to the token we store it internally as token
      my @cred_keys = (
        aws_access_key_id     => 'aws_access_key_id',
        aws_secret_access_key => 'aws_secret_access_key',
        aws_session_token     => 'aws_session_token',
        token                 => 'aws_session_token',
        region                => 'region',
      );

      $creds = populate_creds( $config, \@cred_keys, $section );

      if ( !$creds->{aws_access_key_id} || !$creds->{aws_secret_access_key} )
      {
        $creds = {};
      }
    }
  }

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

  return $creds;
}

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

  if ( $ENV{AWS_EC2_METADATA_DISABLED} eq 'true' ) {
    $self->get_logger->debug(
      'AWS_EC2_METADATA_DISABLED is true, skipping...');

    return {};
  }

  # 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 = { error => undef };

  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";
    }
  }

  my @cred_keys = (
    aws_access_key_id     => 'AccessKeyId',
    aws_secret_access_key => 'SecretAccessKey',
    token                 => 'Token',
    aws_session_token     => 'Token',
    expiration            => 'Expiration',
  );

  $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 $creds_source = decode_json( $rsp->content );

        $creds = populate_creds( 'IAM', \@cred_keys, $creds_source );
        $creds->{role} = $role;
      }
      else {
        $role = $rsp->content;
        $self->get_logger->debug( Dumper [ 'role', $role ] );

        last if !$role;
      }
    }

    return $creds;
  };

  if ( !$creds || $EVAL_ERROR ) {
    $creds->{error} = $EVAL_ERROR;
  }

  return $creds;
}

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

  $uri //= $ENV{AWS_CONTAINER_CREDENTIALS_RELATIVE_URI};

  my $creds = {};

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

  $self->get_logger->debug( Dumper( [ uri => $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 [
        request   => $req,
        as_string => $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 $creds_source = decode_json( $rsp->content );

      my @cred_keys = (
        aws_access_key_id     => 'AccessKeyId',
        aws_secret_access_key => 'SecretAccessKey',
        token                 => 'Token',
        aws_session_token     => 'Token',
        expiration            => 'Expiration',
      );

      $creds = populate_creds( 'IAM', \@cred_keys, $creds_source );
      $creds->{container} = 'ECS';
    }
    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" . Dumper $creds);

  return $creds;
}

# +---------+
# | DUMPERS |
# +---------+

########################################################################
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'...'/ixsmg;

    $safe_rsp
      =~ s/(.*?)(secret_?access[^']+)'([^']+)'([^']+)'/$1$2'$3'...'/ixsmg;

    $safe_rsp =~ s/(.*?)(token[^']+)'([^']+)'([^']+)'/$1$2'$3'...'/ixsmg;
  }
  else {
    $safe_rsp = '** configuration contents blocked by insecure setting **';
  }

  return $safe_rsp;
}

########################################################################
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;
      }
      else {
        $safe_rsp->{$k} = $rsp->{$k};
      }
    }
  }
  else {
    $safe_rsp = '** HTTP RESPONSE blocked by insecure setting **';
  }

  return Dumper [$safe_rsp];
}

# +---------------+
# | TOKEN METHODS |
# +---------------+

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

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

  my $expired = FALSE;

  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");
    }

    $expired = ( $seconds_left < 0 ) ? TRUE : FALSE;

    $self->get_logger->debug(
      Dumper [
        expiration_date => $expiration_date,
        expired         => $expired
      ]
    );
  }

  return $expired;
}

########################################################################
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);
}

########################################################################
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},
    );

  }
  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,
    );
  }

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

  return \%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 EMPTY,
    map { sprintf $format, $_, $credential_keys->{$_} // EMPTY }
    keys %{$credential_keys};
}

# +----------------------------+
# | CREDENTIALS getters/setter |
# +----------------------------+

########################################################################
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;
}

########################################################################
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;
}

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

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

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

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

  return $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);
}

########################################################################
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);
}

########################################################################
sub set_aws_session_token { goto &set_token; }
sub get_aws_session_token { goto &get_token; }
########################################################################

########################################################################
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);
}

# +--------------------+
# | ENCRYPTION METHODS |
# +--------------------+

########################################################################
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 );
  }
}

########################################################################
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 );
  }
}

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

########################################################################
sub rotate_passkey {
########################################################################
  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 );
    }

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

    $self->rotate_credentials($new_passkey);
  }

  return $new_passkey;
}

########################################################################
sub rotate_credentials {
########################################################################
  goto &rotate_passkey;
}

########################################################################
sub set_sso_credentials {
########################################################################
  my ( $role_name, $account_id, $region ) = @_;

  croak "usage: __PACKAGE__::set_sso_credentials(role-name, account-id)\n"
    if ref $role_name;

  my $credentials = get_role_credentials(
    role_name  => $role_name,
    account_id => $account_id,
    region     => $region // EMPTY,
  );

  my @cred_keys = (
    accessKeyId     => 'AWS_ACCESS_KEY_ID',
    secretAccessKey => 'AWS_SECRET_ACCESS_KEY',
    sessionToken    => 'AWS_SESSION_TOKEN',
  );

  # stuff credentials in environment, upstream caller will set order to 'env'
  if ($credentials) {
    foreach my $p ( pairs @cred_keys ) {
      my ( $k, $v ) = @{$p};
      $ENV{$v} = $credentials->{$k};  ## no critic (RequireLocalizedPunctuationVars)
    }
  }

  return $credentials;
}

########################################################################
sub get_role_credentials {
########################################################################
  my (%args) = @_;

  my ( $account_id, $role_name, $access_token, $region )
    = @args{qw(account_id role_name access_token region)};

  if ( !$access_token ) {
    $access_token = _get_access_token();
  }

  croak 'no access token'
    if !$access_token;

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

  my $ua = LWP::UserAgent->new;
  $ua->default_header( X_AMZ_SSO_BEARER_TOKEN, $access_token );

  my $host = sprintf GET_ROLE_CREDENTIALS_HOSTNAME, $region;

  my $query = sprintf GET_ROLE_CREDENTIALS_QUERY, $account_id, $role_name;

  my $url = sprintf 'https://%s/%s%s', $host, GET_ROLE_CREDENTIALS_URI,
    $query;

  my $rsp = $ua->get($url);

  croak "no response from get($url)\n"
    if !$rsp;

  my $content = eval {
    return decode_json( $rsp->content )
      if $rsp && $rsp->content_type eq 'application/json';
  };

  croak sprintf "could not decode response from GetRoleCredentials\n%s",
    $EVAL_ERROR
    if !$content;

  return $content->{roleCredentials}
    if $rsp->is_success;

  croak sprintf "Status: %s\n%s", $rsp->status_line, Dumper( $rsp->content )
    if !ref $content;

  croak sprintf "Status: %s\n%s", $rsp->status_line, $content->{message};
}

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

########################################################################
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;
}

########################################################################
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 )
    );
  }

  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} );
  }

  $self->set_raise_error( $self->get_raise_error // TRUE );
  $self->set_print_error( $self->get_print_error // TRUE );

  return $self;
}

########################################################################
# note that $passkey is a class variable and as such, once initialized
# in the fashion below, will persist for all instances of
# Amazon::Credentials
########################################################################
{
  my $passkey;

########################################################################
  sub get_passkey {
########################################################################
    return $passkey;
  }

########################################################################
  sub set_passkey {
########################################################################
    my ( $self, $key ) = @_;

    $passkey = $key;

    return $passkey;
  }
}

########################################################################
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;
}

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

  $self->set_passkey($passkey);

  # 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);
  }
  else {
    my $has_crypt_cbc = eval {
      require Crypt::CBC;
      require Crypt::Cipher::AES;
    };

    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);
    }

  }

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

  return $self->get_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' => TRUE,
    );
  }

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

  return $str;
}

########################################################################
sub _iso8601_to_time {
########################################################################
  my $iso8601 = shift;

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

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

    timegm( strptime( $iso8601, ISO8601_FORMAT ) );
  };

  return $gmtime;
}

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

  return AWS_METADATA_BASE_URL . $url;
}

########################################################################
sub _get_access_token {
########################################################################
  my ($home) = @_;

  require File::Find;

  File::Find->import('find');

  $home //= $ENV{HOME};
  my $cache_dir = sprintf '%s/%s', $home, CACHE_DIR;

  croak "no $cache_dir found."
    if !-d $cache_dir;

  my $access_token;

  my $cwd = getcwd;

  eval {

    find(
      sub {
        return if !/[.]json$/xsm;

        local $RS = undef;

        open my $fh, '<', $File::Find::name
          or croak 'could not open ' . $File::Find::name;

        my $json = eval { decode_json(<$fh>) };

        close $fh;

        if ( ref $json && $json->{accessToken} ) {
          $access_token = $json->{accessToken};
          croak 'found';
        }

        return;
      },
      $cache_dir
    );
  };

  CORE::chdir $cwd;

  return $access_token;
}

#######################################################################
sub help {
########################################################################

  print {*STDOUT} <<'END_OF_USAGE';
amazon-credentials.sh options

Formats credentials found in env, config, SSO, role

Options
-------
--help, -h     this
--ec2, -E      get credentials from server IAM profile
--env  -e      get credentials from environment variables
--profile, -p  get credentials from profile in credentials configuration
--role, -r     get credentials from SSO role
--account, -a  use with --role, specify AWS account id

 $ amazon-credentials.sh --profile=test
  export AWS_ACCESS_KEY_ID=AKI*****************
  export AWS_SECRET_ACCESS_KEY=****************************************

 $ aws sso login
 $ amazon-credentials.sh --role my-sso-role --account 01234567890
END_OF_USAGE

  exit 0;
}

########################################################################
sub export_credentials {
########################################################################
  my ($credentials) = @_;

  $credentials //= \%ENV;

  my @cred_keys
    = qw(AWS_ACCESS_KEY_ID AWS_SECRET_ACCESS_KEY AWS_SESSION_TOKEN);

  @cred_keys = map { defined $credentials->{$_} ? $_ : () } @cred_keys;

  return join "\n",
    map { sprintf 'export %s=%s', $_, $credentials->{$_} } @cred_keys;
}

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

  use Getopt::Long qw(:config no_ignore_case);

  my %options;

  if (
    !GetOptions(
      \%options,     'help',     'env|e', 'ec2|E',
      'profile|p=s', 'role|r=s', 'account|a=s'
    )
  ) {
    help();
  }

  if ( $options{help} ) {
    help();
  }

  if ( $options{role} && $options{account} ) {
    my $credentials = Amazon::Credentials::set_sso_credentials(
      @options{qw(role account region)} );

    print {*STDOUT} export_credentials($credentials);

    exit 0;
  }

  my @order;

  if ( $options{env} ) {
    push @order, 'env';
  }
  elsif ( $options{ec2} ) {
    push @order, 'ec2';
  }
  elsif ( $options{profile} ) {
    push @order, 'file';
  }

  my $creds = $self->new(
    profile => $options{profile} // EMPTY,
    order   => ( @order ? \@order : DEFAULT_SEARCH_ORDER )
  );

  print {*STDOUT} $creds->format_credentials("export %s=%s\n");

  exit 0;
}

1;

__END__