view release on metacpan or  search on metacpan

lib/Crypt/PBE/PBES1.pm  view on Meta::CPAN

package Crypt::PBE::PBES1;

use strict;
use warnings;
use utf8;

use Carp;
use Crypt::CBC;
use Exporter qw(import);

use Crypt::PBE::PBKDF1;

our $VERSION = '0.103';

use constant ENCRYPTION => { 'des' => 'Crypt::DES', };

sub new {

    my ( $class, %params ) = @_;

    my $self = {
        password   => $params{password}   || croak('Specify password'),
        count      => $params{count}      || 1_000,
        hash       => $params{hash}       || croak('Specify hash digest algorithm'),
        encryption => $params{encryption} || 'des',                                    # TODO add support for RC2
        dk_len     => 0,
    };

    my $dk_len = 20;
    $dk_len = 16 if ( $self->{hash} =~ '/md(2|5)/' );

    $self->{dk_len} = $dk_len;

    return bless $self, $class;

}

sub encrypt {

    my ( $self, $data ) = @_;

    my $salt = Crypt::CBC->random_bytes(8);
    my $DK   = pbkdf1(
        hash     => $self->{hash},
        password => $self->{password},
        salt     => $salt,
        count    => $self->{count},
        dk_len   => $self->{dl_len}
    );

    my $key = substr( $DK, 0, 8 );
    my $iv  = substr( $DK, 8, 8 );

    my $crypt = Crypt::CBC->new(
        -key         => $key,
        -iv          => $iv,
        -literal_key => 1,
        -header      => 'none',
        -cipher      => 'Crypt::DES',
    );

    my @result = ( $salt, $crypt->encrypt($data) );

    return wantarray ? @result : join( '', @result );

}

sub decrypt {

    my ( $self, $salt, $encrypted ) = @_;

    if ( !$encrypted ) {
        my $data = $salt;
        $salt      = substr( $data, 0, 8 );
        $encrypted = substr( $data, 8 );
    }

    my $DK = pbkdf1(
        hash     => $self->{hash},
        password => $self->{password},
        salt     => $salt,
        count    => $self->{count},
        dk_len   => $self->{dl_len}
    );

    my $key = substr( $DK, 0, 8 );
    my $iv  = substr( $DK, 8, 8 );

    my $ciper = Crypt::CBC->new(
        -key         => $key,
        -iv          => $iv,
        -literal_key => 1,
        -header      => 'none',
        -cipher      => 'Crypt::DES',
    );

    my $decrypted = $ciper->decrypt($encrypted);

    return $decrypted;

}

1;

=head1 NAME

Crypt::PBE::PBES1 - Perl extension for PKCS #5 Password-Based Encryption Schema 1 (PBES1)

=head1 SYNOPSIS

    use Crypt::PBE::PBES1;

    my $pbes1 = Crypt::PBE::PBES1->new(
        'hash'       => 'md5',
        'encryption' => 'des',
        'password'   => 'mypassword'
    );

    my $encrypted = $pbes1->encrypt('secret');
    say $pbes1->decrypt($encrypted); # secret


=head1 DESCRIPTION

PBES1 combines the PBKDF1 function with an underlying block cipher, which shall
be either DES or RC2 in cipher block chaining (CBC) mode.

PBES1 is recommended only for compatibility with existing applications, since it
supports only two underlying encryption schemes, each of which has a key size
(56 or 64 bits) that may not be large enough for some applications.


=head1 CONSTRUCTOR

=head2 Crypt::PBE::PBES1->new ( %params )

Params:

=over 4

=item * C<password> : The password to use for the derivation

=item * C<hash> : Hash algorithm ("md2", "md5 or "sha1")

=item * C<encryption> : Encryption method ("des")

=item * C<count> : The number of internal iteractions to perform for the derivation key (default "1_000")

=back


=head1 METHODS

=head2 $pbes1->encrypt( $message )