File Coverage

blib/lib/Convert/PEM/CBC.pm

Criterion	Covered	Total	%
statement	79	83	95.1
branch	16	26	61.5
condition	3	6	50.0
subroutine	13	13	100.0
pod	4	6	66.6
total	115	134	85.8

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

use Carp qw( croak );
use Digest::MD5 qw( md5 );
use base qw( Class::ErrorHandler );

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} :
        pack("C*", map { rand 255 } 1..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};
    my $bs = $cipher->blocksize;
    my @blocks = $text =~ /(.{1,$bs})/ogs;
    my $last = pop @blocks if length($blocks[-1]) < $bs;
    my $iv = $cbc->{iv};
    my $buf = '';
    for my $block (@blocks) {
        $buf .= $iv = $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 = $cipher->encrypt($iv ^ $last);
    }
    $cbc->{iv} = $iv;
    $buf;
}

sub decrypt {
    my $cbc = shift;
    my($text) = @_;
    my $cipher = $cbc->{cipher};
    my $bs = $cipher->blocksize;
    my @blocks = $text =~ /(.{1,$bs})/ogs;
    my $last = length($blocks[-1]) < $bs ?
        join '', splice(@blocks, -2) : pop @blocks;
    my $iv = $cbc->{iv};
    my $buf = '';
    for my $block (@blocks) {
        $buf .= $iv ^ $cipher->decrypt($block);
        $iv = $block;
    }
    $last = pack "a$bs", $last;
    if (length($last)) {
        my $tmp = $iv ^ $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, $salt);
    while (length($ckey) < $ks) {
        $ckey .= $md->($ckey, $key, $salt);
    }
    substr $ckey, 0, $ks;
}

1;
__END__