package Amazon::Credentials;

use strict;
use warnings;
use 5.012;

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

__PACKAGE__->follow_best_practice;

__PACKAGE__->mk_accessors(
  qw/aws_secret_access_key aws_access_key_id token region
    user_agent profile debug expiration role container order
    serialized logger timeout
    /
);

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 POSIX::strptime qw/strptime/;
use Time::Local;
use Scalar::Util qw/reftype/;

use constant  AWS_IAM_SECURITY_CREDENTIALS_URL       => 'http://169.254.169.254/latest/meta-data/iam/security-credentials/';
use constant  AWS_AVAILABILITY_ZONE_URL              => 'http://169.254.169.254/latest/meta-data/placement/availability-zone';
use constant  AWS_CONTAINER_CREDENTIALS_URL          => 'http://169.254.170.2';
use constant  DEFAULT_SEARCH_ORDER                   => 'env,container,role,file';

our $VERSION = '1.0.16'; $VERSION=~s/\-.*$//;

# we only log at debug level, create a default logger
{
  no strict 'refs';
  
  *{'Amazon::Credentials::Logger::debug'} = sub {
    my $self = shift;

    return if ! $self->{debug};
    
    my @tm = localtime(time);
    print STDERR sprintf(" %s [%s] %s", strftime("%c", @tm), $$, @_);
  };
}

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(ref($_[0]) ? $_[0] : { @_ });

  if ( !$self->get_logger || reftype($self->get_logger) ne 'CODE' ) {
    $self->set_logger(bless { debug => $self->get_debug }, 'Amazon::Credentials::Logger');
    $self->get_logger->debug("WARNING: DEBUG mode using default logger");
  }
  
  if ( !$self->get_user_agent) {
    # set a very low timeout
    $self->set_user_agent(LWP::UserAgent->new(timeout => $self->get_timeout || 3));
  }

  $self->set_profile($ENV{AWS_PROFILE})
    if  !$self->get_profile;

  $self->set_order(DEFAULT_SEARCH_ORDER)
    if !$self->get_order;
  
  if ( !$self->get_aws_secret_access_key || !$self->get_aws_access_key_id ) {
    $self->set_credentials;
  }

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

sub get_default_region {
  my $self = shift;
  
  # try to get credentials from instance role, but we may not be
  # executing on an EC2 or container.
  my $url = AWS_AVAILABILITY_ZONE_URL;
  
  my $ua = ref($self) ? $self->get_user_agent : LWP::UserAgent->new();

  my $req = HTTP::Request->new( GET => $url );
     
  my $region = eval {
    my $rsp = $ua->request($req);
      
    # if not 200, then get out of Dodge
    croak "could not get availability zone\n"
      unless $rsp->is_success;
    
    my $region = $rsp->content;
    $region =~s/([0-9]+)[a-z]+$/$1/;
    
    $region;
  };
  
  return $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});
  }
  else {
    croak "no credentials available\n";
  }
}

sub get_ec2_credentials {
  goto &find_credentials;
}

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

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

  $self->set_order($options->{order})
    if $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*/, $self->get_order;
  }
         
  my $creds = {};

  foreach my $location (@search_order) {
    
    if ( $location eq 'env' ) {
      
      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...})
    } ## end if ( $location eq 'env')
    elsif ( $location eq 'container' ) {
      $creds = $self->get_creds_from_container();
    }
    elsif ( $location eq 'role' ) {
      $creds = $self->get_creds_from_role;
    }
    elsif ( $location eq 'file' ) {
      $creds = $self->get_creds_from_ini_file;
    } ## end elsif ( $location eq 'file')

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

  foreach my $k ( keys %$creds ) {
    $self->set( $k, $creds->{$k} );
  }

  return $creds;
} ## end sub find_credentials


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

  $profile = $profile || $self->get_profile || 'default';
  
  my $creds = {};
  
  foreach my $config ( ".aws/config", ".aws/credentials" ) {
    my $profile_name = $profile;

    local $CWD = home;

    next if !-e $config;

    open my $fh, '<', $config
      or croak 'could not open credentials file!';

    my $last_profile = '';
    my $profile_to_find = $profile_name;

    # look for credentials...by interating through credentials file
    # (could use Config::INI but did not want to add another
    # dependency), maybe Config::Tiny?
    while ( my $current_line = <$fh> ) {

      chomp $current_line;

      $self->get_logger->debug(
        'looking for profile ' . ( $profile_name // '' ) . "\n" );

      # once we find a profile section that matches, undef it
      # ./aws/credentials uses [profile-name]
      # ./aws/config uses [profile profile-name]

      if ( $current_line =~ /^\s*region\s*=\s*(.*?)\s*$/ ) {
        my $region = $1;
        # go ahead and use this region setting IF:
        # 1. this is the default profile (we may reset region later though)
        # 2. the profile we want to use is this profile
        # 3. we are not in a profile at all (this is yet another default)
        if ( $last_profile =~ /default/
          || ( $profile_to_find && $last_profile =~ /$profile_to_find/ )
          || !$last_profile ) {
          $self->set_region($region);
        }
      } ## end if ( $current_line =~ ...)

      if ($profile_name) {
        if ( $current_line =~ /^\s*\[\s*profile\s+$profile_name\s*\]/ ) {
          undef $profile_name;
        }
        elsif ( $current_line =~ /^\s*\[\s*$profile_name\s*\]/ ) {
          undef $profile_name;
          $last_profile = $current_line;
        }
      } ## end if ($profile_name)
      elsif ( defined $profile_name
        && $current_line =~ /^\s*\[\s*profile\s+/ ) {
        last;
      }
      elsif ( $current_line =~ /credential_process/ ) {
        my $process;
        if ( $current_line =~ /\=(.*)$/ ) {
          $process = $1;
        }

        @{$creds}{qw{source aws_access_key_id aws_secret_access_key token}}
          = ('process', $self->get_creds_from_process($process));

        last;
      } ## end elsif ( $current_line =~ ...)
      elsif ( $current_line =~ /^\s*aws_secret_access_key\s*=\s*(.*)$/ ) {
        last if defined $creds->{aws_secret_access_key};    # next profile
        $creds->{aws_secret_access_key} = $1;
      }
      elsif ( $current_line =~ /^\s*aws_access_key_id\s*=\s*(.*)$/ ) {
        last if defined $creds->{aws_access_key_id};        # next profile
        $creds->{aws_access_key_id} = $1;
      }
      elsif ( $current_line =~ /^\s*aws_session_token\s*=\s*(.*)$/ ) {
        last if defined $creds->{token};
        $creds->{token} = $1;
      }
      elsif ( $current_line =~ /^\s*profile\s*=\s*(.*)$/ ) {
        $profile_name = $1;
        seek($fh, 0, 1);
      }
    } ## end while ( my $current_line ...)

    close $fh;

    $creds->{source} = $config
      if $creds->{aws_secret_access_key} && $creds->{aws_access_key_id};
  } ## end foreach my $config ( ".aws/config"...)

  return $creds;
} ## end sub get_credentials_from_file

sub get_creds_from_ini_file {
  my ($self, $profile) = @_;
  
  $profile = $profile || $self->get_profile || 'default';

  my $creds = {};
  
  foreach my $config ( ".aws/config", ".aws/credentials" ) {
    last if $creds->{source};
    
    my $profile_name = $profile;

    local $CWD = home;

    next if !-e $config;

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

    if ($profile eq 'default') {
      next if ! $ini->{default}->{profile};
      
      $profile_name = $ini->{default}->{profile};
    }
    
    $self->set_region($ini->{region})
      if $ini->{region};
    
    my $section;
    
    if ( $ini->{$profile_name} ) {
      $section = $ini->{$profile_name};
    }
    elsif ($ini->{"profile $profile_name"}) {
      $section = $ini->{"profile $profile_name"};
    }
    
    if ($ini->{credential_process}) {
      @{$creds}{qw{source aws_access_key_id aws_secret_access_key token region}}
        = ('process', $self->get_creds_from_process($ini->{credential_process}));
    }

    if ( $section ) {
      if ($section->{credential_process}) {
        @{$creds}{qw{source aws_access_key_id aws_secret_access_key token region}}
          = ('process', $self->get_creds_from_process($section->{credential_process}));
      }
      else {
        foreach my $k (qw{aws_access_key_id aws_secret_access_key token region}) {
          $creds->{$k} = $section->{$k};
        }
      }
      
      $creds->{source} = $config
        if $creds->{aws_access_key_id};
    }
  }

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

  return $creds;
} ## end sub get_credentials_from_file

sub is_token_expired {
  my $self = shift;
  my $window_interval = shift || 5;
  
  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 * 60;

    # (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\n");
      my $hours = int($seconds_left/3600);
      my $minutes = int(($seconds_left - $hours * 3600)/60);
      my $seconds = $seconds_left - ($hours * 3600 + $minutes * 60);
      $self->get_logger->debug(sprintf("%d hours %d minutes %d seconds until expiry\n", $hours, $minutes, $seconds));
    }
    
    $expired = ($seconds_left < 0) ? 1 : 0;
    
    $self->get_logger->debug(Dumper [ "EXPIRATION TIME: " . $expiration_date, "EXPIRED: " . $expired]);
  }

  return $expired;
}

sub _iso8601_to_time {
  my $iso8601 = shift;
  
  $iso8601 =~s/^(.*)Z$/$1\+00:00/;

  my $gmtime = eval {
    local %ENV;
    $ENV{TZ} = 'GMT';
    timegm(strptime($iso8601, "%Y-%m-%dT%H:%M:%S%z"));
  };

  return $gmtime;
}

sub get_creds_from_role {
  my $self = shift;

  my $creds = {};
  
  # try to get credentials from instance role
  my $url = AWS_IAM_SECURITY_CREDENTIALS_URL;
  
  my $ua = $self->get_user_agent;
  my $role;

  eval {
    # could be infinite, but I don't think so.  Either we get an
    # error ($@), or a non-200 response code
    while ( ! $creds->{token} ) {
      
      $url .= $role if $role;
      
      my $req = HTTP::Request->new( GET => $url );
      
      $self->get_logger->debug(Dumper [ "HTTP REQUEST:\n", $req ]);
      
      my $rsp = $ua->request($req);
      
      $self->get_logger->debug(Dumper [ "HTTP RESPONSE:\n", $rsp ]);
      
      # if not 200, then get out of Dodge
      last unless $rsp->is_success;
      
      if ( $role ) {
	$creds->{serialized} = $rsp->content;
	my $this = JSON::PP->new->utf8->decode($creds->{serialized});
	@{$creds}{qw/source role aws_access_key_id aws_secret_access_key token expiration/} =
	  ('IAM',$role, @{$this}{qw/AccessKeyId SecretAccessKey Token Expiration/});
      }
      else {
	$role = $rsp->content;
	$self->get_logger->debug(Dumper ['role', $role]);

	last unless $role;
      }
    }
  };
  
  $creds->{error} = $@ if $@;
  
  $creds;
}

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

  open(my $fh, '-|', $process)
    or die "could not open pipe to $process\n";

  local $RS;
    
  my $credentials = <$fh>;
  close $fh;
 
  $credentials = eval {
    JSON::PP->new->decode($credentials);
  };

  if ( $EVAL_ERROR || !$credentials ) {
    die "could not get credentials from process\n$EVAL_ERROR\n";
  }
  
  return @{$credentials}{qw/AccessKeyId SecretAccessKey SessionToken Region Expiration/};
}

sub refresh_credentials {
  goto &refresh_token;
}

sub refresh_token {
  my $self = shift;
  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;
  
  $self->set_credentials($creds);
}


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);
    
    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( "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( Dumper [ "HTTP RESPONSE:\n", $rsp ] );

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

        $creds->{serialized} = $rsp->content;

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

    $creds->{error} = $@ if $@;

  } ## end if ($uri)

  return $creds;
} ## end sub get_creds_from_container


1;

__END__

=pod

=head1 NAME

 AWS::Credentials

=head1 SYNOPSIS

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

=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 METHODS

=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 container - Task Role

If the process is running in a container, the container may have a
task role.  We'll look 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 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 we'll look in your credential
files (F<~/.aws/config>, F<~/.aws/credentials>) for your credentials.>

=item file - Configuration Files

=over 15

=item ~/.aws/config

=item ~/.aws/credentials

=back

The class will attempt to find the credentials in either of 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 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/] });

=over 10

=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()
 }

=back

=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 find_credentidals

 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 not normally call these methods

=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.

=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

Will be 'IAM' if role and credentials found.

=back

=head2 get_default_region

Returns the region of the currently running instance.  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.

You can also invoke this as a class method:

 AWS_REGION=$(perl -MAmazon::Credentials -e 'print Amazon::Credentials::get_default_region;')

=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 refresh_token

 refresh_token() (deprecated)
 refresh_credentials()

Retrieves a fresh set of IAM credentials.

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

=head1 SETTERS/GETTERS

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

=head1 CONTRIBUTING

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

=head1 AUTHOR

Rob Lauer - <rlauer6@comcast.net>

=head1 LICENSE

(c) Copyright 2022 Robert C. Lauer. All rights reserved.  This module
is free software. It may be used, redistributed and/or modified under
the same terms as Perl itself.

=cut
