view release on metacpan or  search on metacpan

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

    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))
    my $method  = $request->method;
    my $uri     = $request->uri;
    my $path    = $uri->path || '/';
    my @params  = $uri->query_form;
    my $headers = $request->headers;
    $hashed_payload ||= sha256_hex( $request->content );

    # canonicalize query string

    # in the case of the S3 api, but its still expected to be part of a
    # canonical request.
    if (scalar(@params) == 0 && defined($uri->query) && $uri->query ne '') {
        push @params, ($uri->query, '');
    }

    my %canonical;
    while ( my ( $key, $value ) = splice( @params, 0, 2 ) ) {
        $key   = uri_escape($key);
        $value = uri_escape($value);
        push @{ $canonical{$key} }, $value;
    }
    my $canonical_query_string = join '&', map {
        my $key = $_;
        map { "$key=$_" } sort @{ $canonical{$key} }
    } sort keys %canonical;

    # canonicalize the request headers
    my ( @canonical, %signed_fields );
    for my $header ( sort map { lc } $headers->header_field_names ) {
        next if $header =~ /^date$/i;
        my @values = $headers->header($header);

        # remove redundant whitespace
        foreach (@values) {
            next if /^".+"$/;
            s/^\s+//;
            s/\s+$//;
            s/(\s)\s+/$1/g;
        }
        push @canonical, "$header:" . join( ',', @values );
        $signed_fields{$header}++;
    }
    my $canonical_headers = join "\n", @canonical;
    $canonical_headers .= "\n";
    my $signed_headers = join ';', sort map { lc } keys %signed_fields;

    my $canonical_request = join( "\n",
        $method,            $path,           $canonical_query_string,
        $canonical_headers, $signed_headers, $hashed_payload );
    my $request_digest = sha256_hex($canonical_request);

    return ( $request_digest, $signed_headers );
}

sub _string_to_sign {
    my $self = shift;
    my ( $datetime, $credential_scope, $hashed_request ) = @_;
    return join( "\n",
        'AWS4-HMAC-SHA256', $datetime, $credential_scope, $hashed_request );
}

=item $signing_key = AWS::S3::Signer::V4->signing_key($secret_access_key,$service_name,$region,$date)

Return just the signing key in the event you wish to roll your own signature.

=cut

sub signing_key {
    my $self = shift;
    my ( $kSecret, $service, $region, $date ) = @_;
    my $kDate    = hmac_sha256( $date,          'AWS4' . $kSecret );
    my $kRegion  = hmac_sha256( $region,        $kDate );
    my $kService = hmac_sha256( $service,       $kRegion );
    my $kSigning = hmac_sha256( 'aws4_request', $kService );
    return $kSigning;
}

sub _calculate_signature {
    my $self = shift;