File Coverage

blib/lib/Amazon/CloudFront/Thin.pm

Criterion	Covered	Total	%
statement	91	93	97.8
branch	10	14	71.4
condition	5	11	45.4
subroutine	21	21	100.0
pod	3	3	100.0
total	130	142	91.5

package Amazon::CloudFront::Thin;
use strict;
use warnings;
use URI            ();
use URI::Escape    ();
use Carp           ();
use HTTP::Headers  ();
use HTTP::Date     ();
use HTTP::Request  ();
use Digest::SHA    ();

our $VERSION = '0.03';

sub new {
    my ($class, @extra) = @_;
    my $args;
    my $self = {};

    if (@extra == 1) {
        Carp::croak 'please provide a hash or hash reference to new()'
            unless ref $extra[0] eq 'HASH';
        $args = $extra[0];
    }
    else {
        Carp::croak 'please provide a hash or hash reference to new()'
            unless @extra % 2 == 0;
        $args = {@extra};
    }

    foreach my $key (qw(aws_access_key_id aws_secret_access_key distribution_id)) {
        if (exists $args->{$key}) {
            $self->{$key} = $args->{$key};
        }
        else {
            Carp::croak "argument '$key' missing on call to new()";
        }
    }
    bless $self, $class;
    my $ua = $args->{ua} || _default_ua();
    $self->ua($ua);

    return $self;
}

sub _default_ua {
    require LWP::UserAgent;
    my $ua = LWP::UserAgent->new(
        keep_alive => 10,
#        requests_redirectable => [qw(GET HEAD DELETE PUT)]
    );
    $ua->timeout(10);
    $ua->env_proxy;
    return $ua;
}

sub ua {
    my ($self, $ua) = @_;
    $self->{_ua} = $ua if ($ua);
    return $self->{_ua};
}

sub create_invalidation {
    my ($self, @paths) = @_;
    if (@paths == 1 && ref $paths[0] && ref $paths[0] eq 'ARRAY') {
        @paths = @{$paths[0]};
    }

    my $time = time;

    my $url = URI->new(
        'https://cloudfront.amazonaws.com/2015-04-17/distribution/'
        . $self->{distribution_id} . '/invalidation'
    );

    my $content = _create_xml_payload(\@paths, $time);

    # Amazon unfortunately does not comply with RFC 1123 for the
    # 'date' header, requiring instead that it gets written in
    # ISO-8601 format. Since HTTP::Headers does the right thing
    # for date(), we set the ISO-8601 date in "X-Amz-Date" instead.
    my ($formatted_date, $formatted_time) = _format_date($time);
    my $http_headers = HTTP::Headers->new(
        'Content-Length' => length $content,
        'Content-Type'   => 'text/xml',
        'Host'           => $url->host,
        'X-Amz-Date'     => $formatted_date . 'T' . $formatted_time . 'Z',
    );

    $http_headers->header(
        Authorization => 'AWS4-HMAC-SHA256 Credential='
            . $self->{aws_access_key_id} . '/' . _cloudfront_scope($formatted_date)
            . ', SignedHeaders=' . _signed_headers($http_headers)
            . ', Signature='
            . _calculate_signature(
                    $self->{aws_secret_access_key},
                    $url,
                    $http_headers,
                    $content
            )
    );

    my $request = HTTP::Request->new('POST', $url, $http_headers, $content);
    return $self->ua->request($request);
}

sub _cloudfront_scope {
    my ($date) = @_;
    return sprintf("%s/us-east-1/cloudfront/aws4_request", $date);
}

sub _format_date {
    my ($time) = @_;
    my @date   = gmtime $time;
    $date[5] += 1900; # fix the year
    $date[4] += 1;    # fix the month

    return (
        sprintf('%d%02d%02d', @date[5,4,3]),  # YYYYMMDD
        sprintf('%02d%02d%02d', @date[2,1,0]) # hhmmss
    );
}

sub _calculate_signature {
    my ($aws_secret_access_key, $url, $headers, $content) = @_;

    my $canonical_request = _create_canonical_request($url, $headers, $content);
    my $string_to_sign = _create_string_to_sign($headers, $canonical_request);

    my ($date) = _format_date(
        HTTP::Date::str2time($headers->header('X-Amz-Date'))
    );
    return _create_signature($aws_secret_access_key, $string_to_sign, $date);
}

sub _create_canonical_request {
    my ($url, $headers, $content) = @_;

    # http://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html
    my @sorted_header_names = sort $headers->header_field_names();
    return
        "POST\n"
      . ($url->path || '/') . "\n\n"
      . join( "\n", map {
            lc($_) . ':' . $headers->header($_)
          } @sorted_header_names
      ) . "\n\n"
      . _signed_headers($headers) . "\n"
      . Digest::SHA::sha256_hex($content)
    ;
}

sub _signed_headers {
    my ($headers) = @_;
    return join(';' => map lc, sort $headers->header_field_names());
}

sub _create_string_to_sign {
    my ($headers, $canonical_request) = @_;

    my ($formatted_date, $formatted_time) = _format_date(
        HTTP::Date::str2time($headers->header('X-Amz-Date'))
    );

    return
        "AWS4-HMAC-SHA256\n"
      . $formatted_date . 'T' . $formatted_time . "Z\n"
      . _cloudfront_scope($formatted_date) . "\n"
      . Digest::SHA::sha256_hex($canonical_request)
    ;
}

sub _create_signature {
    my ($aws_secret_access_key, $string_to_sign, $date) = @_;

    return Digest::SHA::hmac_sha256_hex(
        $string_to_sign, Digest::SHA::hmac_sha256(
            'aws4_request', Digest::SHA::hmac_sha256(
                'cloudfront', Digest::SHA::hmac_sha256(
                    'us-east-1', Digest::SHA::hmac_sha256($date, 'AWS4' . $aws_secret_access_key)
                )
            )
        )
    );
}

sub _create_xml_payload {
    my ($paths, $identifier) = @_;
    my $total_paths = scalar @$paths;
    my $path_content;
    foreach my $path (@$paths) {
        # leading '/' is required:
        # http://docs.aws.amazon.com/AmazonCloudFront/latest/APIReference/InvalidationBatchDatatype.html
        $path = '/' . $path unless index($path, '/') == 0;
        # we wrap paths on CDATA so we don't have to escape them
        $path_content .= ''
    }
    return qq{$total_paths$path_content$identifier};
}

42;
__END__