File Coverage

blib/lib/Convert/PEM/CBC.pm

Criterion	Covered	Total	%
statement	83	84	98.8
branch	25	42	59.5
condition	3	6	50.0
subroutine	13	13	100.0
pod	4	6	66.6
total	128	151	84.7

package Convert::PEM::CBC;
use strict;

our $VERSION = '0.13'; # VERSION
use Carp qw( croak );
use Digest::MD5 qw( md5 );
use base qw( Class::ErrorHandler );
use Crypt::PRNG qw( random_bytes );


sub new {
    my $class = shift;
    my $cbc = bless { }, $class;
    $cbc->init(@_);
}

sub init {
    my $cbc = shift;
    my %param = @_;
    $cbc->{iv} = exists $param{IV} ? $param{IV} : random_bytes(8);
    croak "init: Cipher is required"
        unless my $cipher = $param{Cipher};
    if (ref($cipher)) {
        $cbc->{cipher} = $cipher;
    }
    else {
        eval "use $cipher;";
        croak "Loading '$cipher' failed: $@" if $@;
        my $key = $param{Key};
        if (!$key && exists $param{Passphrase}) {
            $key = bytes_to_key($param{Passphrase}, $cbc->{iv},
                \&md5, $cipher->keysize);
        }
        croak "init: either Key or Passphrase required"
            unless $key;
        $cbc->{cipher} = $cipher->new($key);
    }
    $cbc;
}

sub iv     { $_[0]->{iv} }

sub encrypt {
    my $cbc = shift;
    my ($text) = @_;
    my $cipher = $cbc->{cipher};
    ## special stuff for the old SEED package
    my $seed = ref($cipher) eq "Crypt::SEED";
    my $bs = ($seed ? 16 : $cipher->blocksize())
        or return $cbc->error("This cipher does not support the blocksize method");
    my @blocks = $text =~ /(.{1,$bs})/gs;
    my $last = pop @blocks if length($blocks[-1]) < $bs;
    my $iv = $cbc->{iv};
    my $buf = '';
    for my $block (@blocks) {
        $buf .= $iv = $seed
            ? $cipher->encrypt($iv ^ $block,0)
            : $cipher->encrypt($iv ^ $block);
    }
    $last = pack("C*", ($bs) x $bs) unless $last && length $last;
    if (length $last) {
        $last .= pack("C*", ($bs-length($last)) x ($bs-length($last)))
            if length($last) < $bs;
        $buf .= $iv = $seed
            ? $cipher->encrypt($iv ^ $last,0)
            : $cipher->encrypt($iv ^ $last);
    }
    $cbc->{iv} = $iv;
    $buf;
}

sub decrypt {
    my $cbc = shift;
    my ($text) = @_;
    my $cipher = $cbc->{cipher};
    ## special stuff for the old SEED package
    my $seed = ref($cipher) eq "Crypt::SEED";
    my $bs = ($seed ? 16 : $cipher->blocksize())
        or return $cbc->error("This cipher does not support the blocksize method");
    my @blocks = $text =~ /(.{1,$bs})/gs;
    my $last = length($blocks[-1]) < $bs ?
        join '', splice(@blocks, -2) : pop @blocks;
    my $iv = $cbc->{iv};
    my $buf = '';
    ## more special stuff for the old SEED package
    for my $block (@blocks) {
        $buf .= $iv ^ ($seed
            ? $cipher->decrypt($block,0)
            : $cipher->decrypt($block));
        $iv = $block;
    }
    $last = pack "a$bs", $last;
    if (length($last)) {
        my $tmp = $iv ^ ($seed
            ? $cipher->decrypt($last,0)
            : $cipher->decrypt($last));
        $iv = $last;
        $last = $tmp;
        my $cut = ord substr $last, -1;
        return $cbc->error("Bad key/passphrase")
            if $cut > $bs;
        substr($last, -$cut) = '';
        $buf .= $last;
    }
    $cbc->{iv} = $iv;
    $buf;
}

sub bytes_to_key {
    my ($key, $salt, $md, $ks) = @_;
    my $ckey = $md->($key . substr($salt,0,8));
    while (length($ckey) < $ks) {
        $ckey .= $md->($ckey, $key, substr($salt,0,8));
    }
    substr $ckey, 0, $ks;
}

1;
__END__