view release on metacpan or  search on metacpan

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

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

sub _datetime {
    my $self    = shift;
    my $request = shift;
    return $request->header('x-amz-date') || $self->_zulu_time($request);
}

sub _algorithm { return 'AWS4-HMAC-SHA256' }

sub _sign {
    my $self = shift;
    my ( $request, $region, $payload_sha256_hex ) = @_;
    return if $request->header('Authorization');    # don't overwrite

    my $datetime = $self->_datetime($request);

    unless ( $request->header('host') ) {
        my $host = $request->uri->host;
        $request->header( host => $host );
    }

    my $scope = $self->_scope( $request, $region );
    my ( $date, $service );
    ( $date, $region, $service ) = $self->_parse_scope($scope);

    my $secret_key = $self->secret_key;
    my $access_key = $self->access_key;
    my $algorithm  = $self->_algorithm;

    my ( $hashed_request, $signed_headers ) =
      $self->_hash_canonical_request( $request, $payload_sha256_hex );
    my $string_to_sign =
      $self->_string_to_sign( $datetime, $scope, $hashed_request );
    my $signature =
      $self->_calculate_signature( $secret_key, $service, $region, $date,
        $string_to_sign );
    $request->header( Authorization =>
"$algorithm Credential=$access_key/$scope, SignedHeaders=$signed_headers, Signature=$signature"
    );
}

sub _zulu_time {
    my $self     = shift;
    my $request  = shift;
    my $date     = $request->header('Date');
    my @datetime = $date ? gmtime( str2time($date) ) : gmtime();
    return strftime( '%Y%m%dT%H%M%SZ', @datetime );
}

sub _hash_canonical_request {
    my $self = shift;
    my ( $request, $hashed_payload ) =
      @_;    # (HTTP::Request,sha256_hex($content))