view release on metacpan or  search on metacpan

lib/AWS/S3/Signer/V4.pm  view on Meta::CPAN

    $uri->query_param( 'X-Amz-SignedHeaders' => 'host' );

# If there was a security token passed, we need to supply it as part of the authorization
# because AWS requires it to validate IAM Role temporary credentials.

    if ( defined( $self->{security_token} ) ) {
        $uri->query_param( 'X-Amz-Security-Token' => $self->{security_token} );
    }

# Since we're providing auth via query parameters, we need to include UNSIGNED-PAYLOAD
# http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html
# it seems to only be needed for S3.

    if ( $scope =~ /\/s3\/aws4_request$/ ) {
        $self->_sign( $request, undef, 'UNSIGNED-PAYLOAD' );
    }
    else {
        $self->_sign($request);
    }

    my ( $algorithm, $credential, $signedheaders, $signature ) =
      $request->header('Authorization') =~
      /^(\S+) Credential=(\S+), SignedHeaders=(\S+), Signature=(\S+)/;
    $uri->query_param_append( 'X-Amz-Signature' => $signature );
    return $uri;
}

sub _add_date_header {
    my $self    = shift;
    my $request = shift;
    my $datetime;
    unless ( $datetime = $request->header('x-amz-date') ) {
        $datetime = $self->_zulu_time($request);
        $request->header( 'x-amz-date' => $datetime );
    }
}

sub _scope {
    my $self = shift;
    my ( $request, $region ) = @_;
    my $host     = $request->uri->host;
    my $datetime = $self->_datetime($request);
    my ($date)   = $datetime =~ /^(\d+)T/;
    my $service;

    ( $service, $region ) = $self->parse_host( $host, $region );

    $service ||= $self->{service} || 's3';
    $region  ||= $self->{region}  || 'us-east-1';    # default
    return "$date/$region/$service/aws4_request";
}

sub parse_host {
    my $self = shift;
    my $host = shift;
    my $region = shift;

    # this entire thing should probably refactored into its own
    # distribution, a la https://github.com/zirkelc/amazon-s3-url

    # https://docs.aws.amazon.com/prescriptive-guidance/latest/defining-bucket-names-data-lakes/faq.html
    # Only lowercase letters, numbers, dashes, and dots are allowed in S3 bucket names.
    # Bucket names must be three to 63 characters in length,
    # must begin and end with a number or letter,
    # and cannot be in an IP address format.
    my $bucket_re = '[a-z0-9][a-z0-9\-\.]{1,61}[a-z0-9]';
    my $domain_re = 'amazonaws\.com';
    my $region_re = '(?:af|ap|ca|eu|il|me|mx|sa|us)-[a-z]+-\d';

    my ( $service, $url_style );

    # listed in order of appearance found in the docs:
    # https://community.aws/content/2biM1C0TkMkvJ2BLICiff8MKXS9/format-and-parse-amazon-s3-url?lang=en
    if ( $host =~ /^(\w+)([-.])($region_re)\.$domain_re/ ) {
        $service = $1;
        $region ||= $3;
        $url_style = $2 eq '-' ? 'regional dash-style' : 'regional dot-style';
    }
    elsif ( $host =~ /^$bucket_re\.($region_re)\.s3\.$domain_re/ ) {
        $service = 's3';
        $region ||= $1;
        $url_style = 'regional virtual-hosted-style';
    }
    elsif ( $host =~ /^s3\.$domain_re/ ) {
        $service = 's3';
        $region  = 'us-east-1';
        $url_style = 'legacy with path-style';
    }
    elsif ( $host =~ /^$bucket_re\.s3\.$domain_re/ ) {
        $service = 's3';
        $region ||= 'us-east-1';
        $url_style = 'legacy with virtual-hosted-style';
    }
    elsif ( $host =~ /^$bucket_re\.s3[\.-]($region_re)\.$domain_re/ ) {
        $service = 's3';
        $region ||= $1;
        $url_style = 'regional virtual-hosted-style';
    }
    elsif ($host =~ /^([\w-]+)\.([\w-]+)\.$domain_re/) {
        $service = $1;
        $region    ||= $2;
        $url_style = 'legacy path-style service';
    }
    elsif ( $host =~ /^([\w-]+)\.$domain_re/ ) {
        $service = $1;
        $region    = 'us-east-1';
        $url_style = 'legacy path-style';
    }
    elsif ( exists PAAPI_REGION->{$host} ) {
        $service = 'ProductAdvertisingAPI';
        $region  = PAAPI_REGION->{$host};
    }

    return ( $service, $region, $url_style );
}

sub _parse_scope {
    my $self  = shift;
    my $scope = shift;
    return split '/', $scope;
}