File Coverage

blib/lib/Lemonldap/NG/Common/Crypto.pm

Criterion	Covered	Total	%
statement	58	68	85.2
branch	7	12	58.3
condition	5	7	71.4
subroutine	12	12	100.0
pod	0	5	0.0
total	82	104	78.8

##@file
# Extend Crypt::Rijndael to get several keys from a single secret key,
# add base64 encoding of binary data, and cipher hexadecimal data.

##@class
# Extend Crypt::Rijndael to get several keys from a single secret key,
# add base64 encoding of binary data, and cipher hexadecimal data.
# $Lemonldap::NG::Common::Crypto::msg contains Crypt::Rijndael errors.
package Lemonldap::NG::Common::Crypto;

use strict;
use Crypt::Rijndael;
use MIME::Base64;
use Digest::MD5 qw(md5);
use bytes;

our $VERSION = '1.4.0';

our $msg;

## @cmethod Lemonldap::NG::Common::Crypto new(string key, string mode)
# Constructor
# @param key key defined in LL::NG conf
# @param mode Crypt::Rijndael constant
# @return Lemonldap::NG::Common::Crypto object
sub new {
    my ( $class, $key, $mode ) = @_;
    $mode ||= Crypt::Rijndael::MODE_CBC();
    my $self = {
        key     => $key,
        mode    => $mode,
        ciphers => {}
    };
    return bless $self, $class;
}

## @method private Crypt::Rijndael _getCipher(string key)
# Returns a Crypt::Rijndael object whose key is mainKey ^ secondKey,
# where mainKey is defined in LL::NG conf,
# and secondKey is set in code so as to get different keys
# @param key that secondary key
# @return Crypt::Rijndael object
sub _getCipher {
    my ( $self, $key ) = @_;
    $key ||= "";
    $self->{ciphers}->{$key} ||=
      Crypt::Rijndael->new( md5( $self->{key}, $key ), $self->{mode} );
    return $self->{ciphers}->{$key};
}

## @method string encrypt(string data)
# Encrypt $data and return it in Base64 format
# @param data datas to encrypt
# @return encrypted datas in Base64 format
sub encrypt {
    my ( $self, $data ) = @_;

    # pad $data so that its length be multiple of 16 bytes
    my $l = bytes::length($data) % 16;
    $data .= "\0" x ( 16 - $l ) unless ( $l == 0 );

    eval { $data = encode_base64( $self->_getCipher->encrypt($data) ); };
    if ($@) {
        $msg = "Crypt::Rijndael error : $@";
        return undef;
    }
    else {
        $msg = '';
        chomp $data;
        return $data;
    }
}

## @method string decrypt(string data)
# Decrypt $data and return it
# @param data datas to decrypt in Base64 format
# @return decrypted datas
sub decrypt {
    my ( $self, $data ) = @_;
    $data =~ s/%2B/\+/ig;
    $data =~ s/%2F/\//ig;
    $data =~ s/%3D/=/ig;
    $data =~ s/%0A/\n/ig;
    eval { $data = $self->_getCipher->decrypt( decode_base64($data) ); };
    if ($@) {
        $msg = "Crypt::Rijndael error : $@";
        return undef;
    }
    else {
        $msg = '';

        # Obscure Perl re bug...
        $data .= "\0";
        $data =~ s/\0*$//;
        return $data;
    }
}

## @method string encryptHex(string data, string key)
# Encrypt $data and return it in hexadecimal format
# Data must be hexadecimal and its length must be a multiple of 32
# the encrypted data have same length as the original data
# @param data datas to encrypt
# @param key optional secondary key
# @return encrypted datas in hexadecimal data
sub encryptHex {
    my ( $self, $data, $key ) = @_;
    return _cryptHex( $self, $data, $key, "encrypt" );
}

## @method string decryptHex(string data, string key)
# Decrypt $data and return it in hexadecimal format
# Data must be hexadecimal and its length must be a multiple of 32
# the decrypted data have same length as the encrypted data
# @param data datas to decrypt
# @param key optional secondary key
# @return decrypted datas in hexadecimal data
sub decryptHex {
    my ( $self, $data, $key ) = @_;
    return _cryptHex( $self, $data, $key, "decrypt" );
}

## @method private string _cryptHex (string data, string key, string sub)
# Auxiliary method to share code between encrypt and decrypt
# @param data datas to decrypt
# @param key secondary key
# @param sub may be "encrypt" or "decrypt"
# @return decrypted datas in hexadecimal data
sub _cryptHex {
    my ( $self, $data, $key, $sub ) = @_;
    unless ( $data =~ /^([0-9a-fA-F]{2})*$/ ) {
        $msg =
"Lemonldap::NG::Common::Crypto::${sub}Hex error : data is not hexadecimal";
        return undef;
    }

    # $data's length must be multiple of 32,
    # since Rijndael requires data length multiple of 16
    unless ( bytes::length($data) % 32 == 0 ) {
        $msg =
"Lemonldap::NG::Common::Crypto::${sub}Hex error : data length must be multiple of 32";
        return undef;
    }
    $data = pack "H*", $data;
    eval { $data = $self->_getCipher($key)->$sub($data); };
    if ($@) {
        $msg = "Crypt::Rijndael error : $@";
        return undef;
    }
    $msg = "";
    $data = unpack "H*", $data;
    return $data;
}

1;