Net::Amazon::AWSSign - Perl extension to create signatures for AWS requests

  use Net::Amazon::AWSSign;
  my $awsKey="AWS_Access_Key";  # Get this from AWS if you don't already have one
  my $awsSecret="AWS_Secret_Key";  # Get this from AWS if you don't already have one
  my $awsSign=new Net::Amazon::AWSSign("$awsKey", "$awsSecret");  # New object
  # SOAP
  my $awsSOAPAction=ItemSearch;
  my ($SOAPTimestamp, $SOAPSignature)=$awsSign->SOAPSig($awsSOAPAction);
  # REST
  my $awsASIN='B000002U82';   # Dark Side of the Moon
  my $awsRESTURI="http://webservices.amazon.com/onca/xml?Service=AWSECommerceService&Operation=ItemLookup&ItemId=$awsASIN&ResponseGroup=Medium"; # Simple lookup
  my $awsSignedRESTURI=$awsSign->addRESTSecret($awsRESTURI);  # Returns signed REST query URI for lwp-get, curl, etc.

package Net::Amazon::AWSSign;

use 5.008;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '0.09';

use MIME::Base64;
use Digest::SHA qw(hmac_sha256_base64);
use URI::Escape;


# General stuff
my $request;
my $SOAPAction;
my $SOAPTimestamp;
my @params;
my $finalString='';
my $finalParams='';
my $AWSSignature='';
my $finalRequestURL;
# My throwaway temp arrays
my @a;
my @b;
# My throwaway temp variables
my $z;
my $y;
# For the secret generator
my $requestProtocol;
my $requestHost;
my $requestPath;


## OO Subs
# Construct an object, called with your AWS key and secret 
sub new
{
  my $class = shift;
  my $self = {
        _AWSKey => shift,
        _AWSSecret  => shift,
  };
  bless $self, $class;
  return $self;
}


sub addRESTSecret {
  my ($self, $request)=@_;
  unless ($request=~m/\&Timestamp=2/) { 
  	$request=$request . "&Timestamp=" . &getAWSTimeStamp(); 
  }
  $finalString="GET\n";
  # Not sure why I thought this was important, but I probably had some rationale, so leaving it in here.
  if ($request=~m/^(http|https)?:\/\/(.*?)\/(.*?)\?/) { 
	$requestProtocol="$1";
  	$requestHost="$2"; 
  	$requestPath="/$3"; 
  	$finalString=$finalString . "$2\n/$3\n"; 
  }else{ 
  	return "ERROR: Cannot determine hostname and base path of request"; 
  }
  # Get just the parameters
  @a=split(/\?/, $request, 2);
  # If we don't already have the subscription ID in the argument list, then add it.
  unless ($a[1]=~m/$self->{_AWSKey}/) { $a[1]="$a[1]&AWSAccessKeyId=$self->{_AWSKey}"; }
  # Ditto for the SHA version and Signature version
  unless ($a[1]=~m/HmacSHA256/) { $a[1]="$a[1]&SignatureMethod=HmacSHA256"; }
  unless ($a[1]=~m/SignatureVersion/) { $a[1]="$a[1]&SignatureVersion=2"; }

  @params=split(/\&/, $a[1]);
  # Sort and URI encode arguments, slam them into @b
  undef @b;
  foreach $z (sort @params) { 
  	@a=split(/=/, $z, 2); 
  	$a[1]=URI::Escape::uri_escape( "$a[1]", "^A-Za-z0-9\-_.~" ); 
  	$z=join('=', @a); 
  	push (@b, $z); 
  }
  $finalString="$finalString" . join ('&', @b);

  $AWSSignature=hmac_sha256_base64("$finalString", "$self->{_AWSSecret}");
  # For some reason we usually need an equals sign appended.  Check if required
  unless ($AWSSignature=~m/=$/) { $AWSSignature=$AWSSignature . "="; }
  $AWSSignature=URI::Escape::uri_escape( "$AWSSignature", "^A-Za-z0-9\-_.~" );
  return "$requestProtocol://" . $requestHost . $requestPath . "?" . join ('&', @b) . "&Signature=" . $AWSSignature;
}

sub SOAPSig {
  my ($self, $SOAPAction)=@_;
  $SOAPTimestamp=&getAWSTimeStamp();
  $finalString=$SOAPAction . $SOAPTimestamp;
  $AWSSignature=hmac_sha256_base64("$finalString", "$self->{_AWSSecret}");
  # For some reason we usually need an equals sign appended.  Check if required
  unless ($AWSSignature=~m/=$/) { $AWSSignature=$AWSSignature . "="; }
  @a=("$SOAPTimestamp", "$AWSSignature");
  return @a;
}


## Internal subs
sub getAWSTimeStamp {
	# The Timestamp must be generated in a specific format.
    return sprintf("%04d-%02d-%02dT%02d:%02d:%02d.000Z",
       sub {    ($_[5]+1900,
                 $_[4]+1,
                 $_[3],
                 $_[2],
                 $_[1],
                 $_[0])
           }->(gmtime(time)));
}

1;

__END__