view release on metacpan or  search on metacpan

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

    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;
    my ( $kSecret, $service, $region, $date, $string_to_sign ) = @_;
    my $kSigning = $self->signing_key( $kSecret, $service, $region, $date );
    return hmac_sha256_hex( $string_to_sign, $kSigning );
}

1;

=back

=head1 SEE ALSO

L<VM::EC2>

=head1 AUTHOR

Lincoln Stein E<lt>lincoln.stein@gmail.comE<gt>.

Forked by leejo for use in L<AWS::S3>.

Copyright (c) 2014 Ontario Institute for Cancer Research

This package and its accompanying libraries is free software; you can
redistribute it and/or modify it under the terms of the GPL (either
version 1, or at your option, any later version) or the Artistic
License 2.0.  Refer to LICENSE for the full license text. In addition,
please see DISCLAIMER.txt for disclaimers of warranty.