view release on metacpan or  search on metacpan

lib/AWS/Signature4.pm  view on Meta::CPAN

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))
    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
    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::Signature4->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;

=head1 SEE ALSO

L<VM::EC2>

=head1 AUTHOR

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

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.

=cut