File Coverage

blib/lib/Crypt/Fernet.pm

Criterion	Covered	Total	%
statement	10	16	62.5
branch			n/a
condition			n/a
subroutine	4	8	50.0
pod			n/a
total	14	24	58.3

package Crypt::Fernet;

use 5.018002;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Crypt::Fernet ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
  fernet_genkey fernet_encrypt fernet_verify fernet_decrypt
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.02';

our $FERNET_TOKEN_VERSION = pack("H*", '80');


# Preloaded methods go here.

sub fernet_genkey { Crypt::Fernet::generate_key() }
sub fernet_encrypt  { Crypt::Fernet::encrypt(@_) }
sub fernet_verify  { Crypt::Fernet::verify(@_) }
sub fernet_decrypt { Crypt::Fernet::decrypt(@_) }


use Crypt::CBC;
use Digest::SHA qw(hmac_sha256);
use MIME::Base64::URLSafe;

sub generate_key {
    return _urlsafe_pading_base64_encode(Crypt::CBC->random_bytes(32));
}

sub encrypt {
    my ($key, $data) = @_;
    my $b64decode_key = urlsafe_b64decode($key);
    my $signkey = substr $b64decode_key, 0, 16;
    my $encryptkey = substr $b64decode_key, 16, 16;
    my $iv = Crypt::CBC->random_bytes(16);
    my $cipher = Crypt::CBC->new(-literal_key => 1,
                                 -key         => $encryptkey,
                                 -iv          => $iv,
                                 -keysize     => 16,
                                 -blocksize   => 16,
                                 -padding     => 'standard',
                                 -cipher      => 'Rijndael',
                                 -header      => 'none',
                             );
    my $ciphertext = $cipher->encrypt($data);
    my $pre_token = $FERNET_TOKEN_VERSION . _timestamp() . $iv . $ciphertext;
    my $digest=hmac_sha256($pre_token, $signkey);
    my $token = $pre_token . $digest;
    return _urlsafe_pading_base64_encode($token);
}

sub decrypt {
    my ($key, $token, $ttl) = @_;
    verify($key, $token, $ttl) or return;
    my $b64decode_key = urlsafe_b64decode($key);
    my $token_data = urlsafe_b64decode($token);

    my $encryptkey = substr $b64decode_key, 16, 16;
    my $iv = substr $token_data, 9, 16;

    my $ciphertextlen = (length $token_data) - 25 - 32;
    my $ciphertext = substr $token_data, 25, $ciphertextlen;

    my $cipher = Crypt::CBC->new(-literal_key => 1,
                                 -key         => $encryptkey,
                                 -iv          => $iv,
                                 -keysize     => 16,
                                 -blocksize   => 16,
                                 -padding     => 'standard',
                                 -cipher      => 'Rijndael',
                                 -header      => 'none',
                             );
    my $plaintext = $cipher->decrypt($ciphertext);
    return $plaintext;
}

sub verify {
    my ($key, $token, $ttl) = @_;
    $ttl ||= 0;
    my $b64decode_key = urlsafe_b64decode($key);
    my $msg = urlsafe_b64decode($token);
    my $token_version = substr $msg, 0, 1;
    ($token_version eq $FERNET_TOKEN_VERSION) or return 0;

    if ($ttl > 0) {
        my $timestamp_bytes = substr $msg, 1, 8;
        my $timestamp = _byte_to_time($timestamp_bytes);
        return 0 if (time - $timestamp > $ttl);
    }

    my $token_sign = substr $msg, (length $msg) - 32, 32;
    my $signkey = substr $b64decode_key, 0, 16;
    my $pre_token = substr $msg, 0, (length $msg) - 32;
    my $verify_digest = hmac_sha256($pre_token , $signkey);
    ($token_sign eq $verify_digest) and return 1;
    return 0;
}

sub _timestamp {
    use bytes;
    my $time = time;
    my $time64bit;
    for my $index (0..7) {
        $time64bit .= substr pack("I", ($time >> $index * 8) & 0xFF), 0, 1;
    }
    my $result = reverse $time64bit;
    no bytes;
    return $result;
}

sub _urlsafe_pading_base64_encode {
    my ($msg) = @_;
    my $s = urlsafe_b64encode($msg);
    return $s.("=" x (4 - length($s) % 4));
}

sub _byte_to_time {
    my ($bytes) = @_;
    use bytes;
    my $rb =  reverse $bytes;
    my $time = unpack 'V', $rb;
    return $time;
}

1;
__END__