view release on metacpan or  search on metacpan

lib/DBIx/Squirrel/Crypt/Fernet.pm  view on Meta::CPAN

require Crypt::CBC;
require Crypt::Rijndael;
require Exporter;

use Const::Fast 'const';
use Digest::SHA 'hmac_sha256';
use MIME::Base64::URLSafe qw(
    urlsafe_b64decode
    urlsafe_b64encode
);
use namespace::clean;
use overload '""' => \&to_string;    # overload after namespace::clean for stringification to work

const my $TOKEN_VERSION  => pack( "H*", '80' );
const my $LEN_HDR        => 25;
const my $LEN_DIGEST     => 32;
const my $LEN_HDR_DIGEST => $LEN_HDR + $LEN_DIGEST;

# Calculate the age (seconds) of a token from its timestamp field.
sub _age_sec {
    use bytes;
    my($token) = @_;
    return time - unpack( 'V', reverse( substr( $token, 1, 8 ) ) );
}


# Generate a timestamp field that can be embedded in a token.
sub _timestamp {
    use bytes;
    local $_;
    my $t = time();
    my @p = map( substr( pack( 'I', ( $t >> $_ * 8 ) & 0xFF ), 0, 1 ), 0 .. 7 );
    return join( '', reverse(@p) );
}


# Generate a random 32-byte Fernet key.
sub _rand_key {
    return Crypt::CBC->random_bytes(32);
}


# Encode a binary string as Base64 with padding.
sub _pad_b64encode {
    my $b64 = urlsafe_b64encode(shift);
    return $b64 . '=' x ( 4 - length($b64) % 4 );
}


=head2 METHODS

=head3 C<new>

    $obj = DBIx::Squirrel::Crypt::Fernet->new();
    $obj = DBIx::Squirrel::Crypt::Fernet->new($key);

A constructor (also see L<Fernet>).

If no arguments are passed then a random 32-byte Fernet key is generated. If
a Base64-encoded key is passed then it will be decoded and its signing and
encryption key fields extracted.

Take care never to display the binary signing and extraction keys, but to use
the C<to_string> method (or stringification) to recombine them into a Base64-
encoded Fernet key.

=cut

sub new {
    my( $class, $b64key ) = @_;
    my $fernet_key = $b64key ? urlsafe_b64decode($b64key) : _rand_key();
    my $self       = {
        signing_key => substr( $fernet_key, 0,  16 ),
        encrypt_key => substr( $fernet_key, 16, 16 ),
    };
    return bless $self, ref($class) || $class;
}


=head3 C<generatekey>

    $key = $obj->generatekey();
    $key = DBIx::Squirrel::Crypt::Fernet->generatekey();

Returns a Base64-encoded randomly-generated key.

=cut

sub generatekey {
    return _pad_b64encode( _rand_key() );
}


=head3 C<encrypt>

    $token = $obj->encrypt($message);

Encrypts a message, returning a Base64-encode token.

=cut

sub encrypt {
    my( $self_or_b64key, $data )        = @_;
    my( $signing_key,    $encrypt_key ) = do {
        if ( UNIVERSAL::isa( $self_or_b64key, __PACKAGE__ ) ) {
            @{$self_or_b64key}{qw(signing_key encrypt_key)};
        }
        else {
            my $key = urlsafe_b64decode($self_or_b64key);
            substr( $key, 0, 16 ), substr( $key, 16, 16 );
        }
    };
    my $iv = Crypt::CBC->random_bytes(16);
    my $t  = $TOKEN_VERSION . _timestamp() . $iv . Crypt::CBC->new(
        -cipher      => 'Rijndael',
        -header      => 'none',
        -iv          => $iv,
        -key         => $encrypt_key,
        -keysize     => 16,
        -literal_key => 1,

lib/DBIx/Squirrel/Crypt/Fernet.pm  view on Meta::CPAN

=head3 C<verify>

    $bool = $obj->verify($token);
    $bool = $obj->verify($token, $ttl);

Returns true if the token was signed using the same signing key as that
embedded in the Fernet key. If a time-to-live (seconds) is specified (C<$ttl>)
then a further check is made to ensure that the token has not expired.

=cut

sub verify {
    my( $self_or_b64key, $b64token, $ttl ) = @_;
    my $signing_key = do {
        if ( UNIVERSAL::isa( $self_or_b64key, __PACKAGE__ ) ) {
            $self_or_b64key->{signing_key};
        }
        else {
            substr( urlsafe_b64decode($self_or_b64key), 0, 16 );
        }
    };
    my $t = urlsafe_b64decode($b64token);
    return !!0
        if $TOKEN_VERSION ne substr( $t, 0, 1 ) || $ttl && _age_sec($t) > $ttl;
    my $digest = substr( $t, length($t) - $LEN_DIGEST, $LEN_DIGEST, '' );    # 4-arg substr removes $digest from $token
    return $digest eq hmac_sha256( $t, $signing_key );
}


=head3 C<to_string>

    $key = $obj->to_string();
    $key = "$obj";

Returns the Base64-encoded key.

=cut

sub to_string {
    my($self) = @_;
    return _pad_b64encode( join( '', @{$self}{qw(signing_key encrypt_key)} ) );
}


=head2 EXPORTS

This package exports nothing by default.

=head3 C<Fernet>

    $obj = Fernet();
    $obj = Fernet($key);

Alternative constructor (also see L<new>).

Returns a new C<DBIx::Squirrel::Crypt::Fernet> object.

If no arguments are passed then a random 32-byte Fernet key is generated. If
a Base64-encoded key is passed then it will be decoded and its signing and
encryption key fields extracted.

Take care never to display the binary signing and extraction keys, but to use
the C<to_string> method (or stringification) to recombine them into a Base64-
encoded Fernet key.

=cut

sub Fernet {
    return __PACKAGE__->new(@_);
}


=head3 C<generatekey>

    $key = generatekey();

Returns a Base64-encoded randomly-generated key.

=head3 C<encrypt>

    $token = encrypt($key, $message);

Encrypts a message, returning a Base64-encode token.

While a Base64-encoded key may be passed as the first argument, it would be
more efficient to call the "two-faced" C<encrypt> as a method on a Fernet
object to avoid the repeated overhead of decoding and parsing-out the signing
and encryption keys.

=head3 C<decrypt>

    $message = decrypt($key, $token);
    $message = decrypt($key, $token, $ttl);

Returns the decrypted message, or C<undef> if the token could not be
decrypted. If a time-to-live (seconds) is specified (C<$ttl>) then a
further check is made to ensure that the token has not expired.

While a Base64-encoded key may be passed as the first argument, it would be
more efficient to call the "two-faced" C<decrypt> as a method on a Fernet
object to avoid the repeated overhead of decoding and parsing-out the signing
and encryption keys.

=head3 C<verify>

    $bool = verify($key, $token);
    $bool = verify($key, $token, $ttl);

Returns true if the token was signed using the same signing key as that
embedded in the Fernet key. If a time-to-live (seconds) is specified (C<$ttl>)
then a further check is made to ensure that the token has not expired.

While a Base64-encoded key may be passed as the first argument, it would be
more efficient to call the "two-faced" C<verify> as a method on a Fernet
object to avoid the repeated overhead of decoding and parsing-out the signing
and encryption keys.

=cut