view release on metacpan or  search on metacpan

lib/WebService/S3/Tiny.pm  view on Meta::CPAN

        %{$query // {}},
        'X-Amz-Algorithm'     => 'AWS4-HMAC-SHA256',
        'X-Amz-Credential'    => "$self->{access_key}/$cred_scope",
        'X-Amz-Date'          => $time,
        'X-Amz-Expires'       => $expires,
        'X-Amz-SignedHeaders' => $signed_headers,
    };

    $query = HTTP::Tiny->www_form_urlencode( $query );

    my $creq = $self->_make_canonical_request(
        $method, $path, $query, $headers, $signed_headers, 'UNSIGNED-PAYLOAD' );

    my $sig = $self->_sign_request( $creq, $time, $cred_scope );

    $query .= '&X-Amz-Signature=' . $sig;

    return "$self->{host}$path?$query";
}

sub _common_prep {
    my ( $self, $bucket, $object ) = @_;

    utf8::encode my $path = _normalize_path( join '/', '', $bucket, $object // () );

    $path =~ s|([^A-Za-z0-9\-\._~/])|$url_enc{$1}|g;

    my ( $s, $m, $h, $d, $M, $y ) = gmtime;

    my $time = sprintf '%d%02d%02dT%02d%02d%02dZ',
        $y + 1900, $M + 1, $d, $h, $m, $s;

    my $date = substr $time, 0, 8;

    my $scope = "$date/$self->{region}/$self->{service}/aws4_request";

    return ( $path, $time, $date, $scope );
}

sub _make_canonical_request {
    my ( $self, $method, $path, $query_string, $headers, $signed_headers, $sha ) = @_;

    my $creq_headers = '';

    for my $k ( sort keys %$headers ) {
        my $v = $headers->{$k};

        $creq_headers .= "\n$k:";

        $creq_headers .= join ',',
            map s/\s+/ /gr =~ s/^\s+|\s+$//gr,
            map split(/\n/), ref $v ? @$v : $v;
    }

    utf8::encode my $creq = "$method\n$path\n$query_string$creq_headers\n\n$signed_headers\n$sha";

    return $creq;
}

sub _normalize_path {
    my @old_parts = split m(/), $_[0], -1;
    my @new_parts;

    for ( 0 .. $#old_parts ) {
        my $part = $old_parts[$_];

        if ( $part eq '..' ) {
            pop @new_parts;
        }
        elsif ( $part ne '.' && ( length $part || $_ == $#old_parts ) ) {
            push @new_parts, $part;
        }
    }

    '/' . join '/', @new_parts;
}

sub _sign_request {
    my ( $self, $creq, $time, $scope ) = @_;

    my $date = substr $time, 0, 8;

    return hmac_sha256_hex(
        "AWS4-HMAC-SHA256\n$time\n$scope\n" . sha256_hex($creq),
        hmac_sha256(
            aws4_request => hmac_sha256(
                $self->{service} => hmac_sha256(
                    $self->{region},
                    hmac_sha256( $date, "AWS4$self->{secret_key}" ),
                ),
            ),
        ),
    );
}

1;