view release on metacpan or  search on metacpan

lib/Authen/HTTP/Signature.pm  view on Meta::CPAN

package Authen::HTTP::Signature;

use 5.010;
use strict;
use warnings;

use Moo;
use Scalar::Util qw(blessed);
use Carp qw(confess);

use HTTP::Date qw(time2str);
use Data::Dumper;

=head1 NAME

Authen::HTTP::Signature - Sign and validate HTTP headers

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

Create signatures:

    use 5.010;
    use Authen::HTTP::Signature;
    use File::Slurp qw(read_file);
    use HTTP::Request::Common;

    my $key_string = read_file("/my/priv/key.pem") or die $!;

    my $signer = Authen::HTTP::Signature->new(
        key => $key_string,
        key_id => 'Test',
    );

    my $req = POST('http://example.com/foo?param=value&pet=dog',
            Content_Type => 'application/json',
            Content_MD5 => 'Sd/dVLAcvNLSq16eXua5uQ==',
            Content_Length => 18,
            Content => '{"hello": "world"}'
    );

    my $signed_req = $signer->sign($req);

    # adds then signs the 'Date' header with private key using
    # RSA-SHA256, then adds 'Authorization' header to
    # $req

Validate signatures:

    use 5.010;
    use Authen::HTTP::Signature::Parser;
    use HTTP::Request::Common;
    use File::Slurp qw(read_file);
    use Try::Tiny;

    my $req = POST('http://example.com/foo?param=value&pet=dog',
            Content_Type => 'application/json',
            Content_MD5 => 'Sd/dVLAcvNLSq16eXua5uQ==',
            Content_Length => 18,
            Date => 'Thu, 05 Jan 2012 21:31:40 GMT',
            Authorization => q{Signature keyId="Test",algorithm="rsa-sha256",signature="ATp0r26dbMIxOopqw0OfABDT7CKMIoENumuruOtarj8n/97Q3htHFYpH8yOSQk3Z5zh8UxUym6FYTb5+A0Nz3NRsXJibnYi7brE/4tx5But9kkFGzG+xpUmimN4c3TMN7OFH//+r8hBf7BT9/GmHDUVZT2JzWGLZES...
            Content => '{"hello": "world"}'
    );

    my $p;
    try {
        $p = Authen::HTTP::Signature::Parser->new($req)->parse();
    }
    catch {
        die "Parse failed: $_\n";
    };

    my $key_string = read_file("/my/pub/key.pem") or die $!;
    $p->key( $key_string );

    if ( $p->verify() ) {
        say "Request is valid!"
    }
    else {
        say "Request isn't valid";
    };

=head1 PURPOSE

This is an implementation of the IETF HTTP Signatures specification authentication scheme. The idea is to authenticate
connections (over HTTPS ideally) using either an RSA keypair or a symmetric key by signing a set of header
values.

If you wish to use SSH keys for validation as in Joyent's proposal, check out L<Convert::SSH2>.

=head1 ATTRIBUTES

These are Perlish mutators; give an argument to set a value or no argument to get the current value.

=over

=item algorithm

The algorithm to use for signing. Read-only.

One of:

=over

=item * C<rsa-sha1>

=item * C<rsa-sha256> (B<default>)

=item * C<rsa-sha512>

=item * C<hmac-sha1>

=item * C<hmac-sha256>

lib/Authen/HTTP/Signature.pm  view on Meta::CPAN

                    $request->header($name) );
            }
        };
    },
    lazy => 1,
);

=over

=item set_header

Expects a C<CODE> reference.

This callback represents the way to set header values on the object in the C<request> attribute.

The request will be the first parameter.  The name of the header and its value will be the second and
third parameters.

Returns the request object.

=back

=cut

has 'set_header' => (
    is => 'rw',
    isa => sub { die "'set_header' expects a CODE ref\n" unless ref($_[0]) eq "CODE" },
    predicate => 'has_set_header',
    default => sub {
        sub {
            confess "Didn't get 3 arguments" unless @_ == 3;
            my ($request, $name, $value) = @_;
            confess "'request' isn't blessed" unless blessed $request;

            $request->header( $name => $value );

            $request;
        };
    },
    lazy => 1,
);

=over

=item authorizaton_string

The text to identify the HTTP signature authorization scheme. Currently defined as the string
literal 'Signature'.  Read-only.

=back

=cut

has 'authorization_string' => (
    is => 'ro',
    default => sub { 'Signature' },
);

=head1 METHODS

Errors are generally fatal. Use L<Try::Tiny> for more graceful error handling.

=cut

sub _update_signing_string {
    my $self = shift;
    my $request = shift || $self->request;

    confess "I can't update the signing string because I don't have a request" unless $request;
    confess "I can't update the signing string because I don't have a 'get_header' callback" unless $self->has_get_header;

    my $ss = join "\n", map {
        $self->get_header->($request, $_)
            or confess "Couldn't get header value for $_\n" } @{ $self->headers };

    $self->signing_string( $ss );

    return $ss;
}

sub _format_signature {
    my $self = shift;

    my $rv = sprintf(q{%s keyId="%s",algorithm="%s"},
                $self->authorization_string,
                $self->key_id,
                $self->algorithm
             );

    if ( scalar @{ $self->headers } == 1 and $self->headers->[0] =~ /^date$/i ) {
        # if there's only the default header, omit the headers param
    }
    else {
        $rv .= q{,headers="} . lc(join " ", @{$self->headers}) . q{"};
    }

    if ( $self->has_extensions ) {
        $rv .= q{,ext="} . $self->extensions . q{"};
    }

    $rv .= q{,signature="} . $self->signature . q{"};

    return $rv;

}

=over

=item sign()

This method takes signs the values of the specified C<headers> using C<algorithm> and C<key>.

By default, it uses C<request> as its input. You may optionally pass a request object and it
will use that instead.  By default, it uses C<key>. You may optionally pass key material and it
will use that instead.

It will add a C<Date> header to the C<request> if there isn't already one in the request
object.

It adds a C<Authorization> header with the appropriate signature data.