view release on metacpan or  search on metacpan

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

sub _generate_presigned_post {
    my ($self, $bucket, $key, $fields, $conditions, $expires_in) = @_;

    # $fields is arrayref of key/value pairs. The order of the fields is important because AWS says "please check the order of the fields"...
    $fields ||= [];
    $conditions ||= [];
    $expires_in ||= 3600;

    my $t = time;
    my $datetime = strftime('%Y%m%dT%H%M%SZ', gmtime($t));
    my $expiration = strftime('%Y-%m-%dT%H:%M:%SZ', gmtime($t + $expires_in));

    my $signer = $self->signer;
    my ($date) = $datetime =~ /^(\d+)T/;
    my $credential = $signer->access_key . '/' . $date . '/' . $self->{region} . '/s3/aws4_request';

    push @$conditions, {bucket => $bucket};

    push @$fields, key => $key;
    if ($key =~ /\$\{filename\}$/) {
        push @$conditions, ['starts-with' => '$key', substr($key, 0, -11)];
    } else {
        push @$conditions, {key => $key};
    }

    push @$fields, 'x-amz-algorithm' => 'AWS4-HMAC-SHA256';
    push @$fields, 'x-amz-credential' => $credential;
    push @$fields, 'x-amz-date' => $datetime;

    push @$conditions, {'x-amz-algorithm' => 'AWS4-HMAC-SHA256'};
    push @$conditions, {'x-amz-credential' => $credential};
    push @$conditions, {'x-amz-date' => $datetime};

    my $session_token = $self->{credentials}->session_token;
    if (defined $session_token) {
        push @$fields, 'x-amz-security-token' => $session_token;
        push @$conditions, {'x-amz-security-token' => $session_token};
    }

    my $policy = $self->_encode_policy({
        expiration => $expiration,
        conditions => $conditions,
    });
    push @$fields, policy => $policy;

    my $signing_key = $signer->signing_key(
        $signer->secret_key,
        's3',
        $self->{region},
        $date,
    );
    push @$fields, 'x-amz-signature' => Digest::SHA::hmac_sha256_hex($policy, $signing_key);

    return $fields;
}

my $_JSON;
sub _encode_policy {
    my $self = shift;
    return MIME::Base64::encode_base64(
        ($_JSON ||= JSON::PP->new->utf8->canonical)->encode(@_),
        ''
    );
}

1;

=head1 LICENSE

Copyright (C) 2016, Robert Showalter

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 AUTHOR

Robert Showalter

=head1 SEE ALSO

L<AWS::Signature4>