File Coverage

blib/lib/Crypt/ECB.pm

Criterion	Covered	Total	%
statement	144	146	98.6
branch	101	110	91.8
condition	14	19	73.6
subroutine	20	21	95.2
pod	15	15	100.0
total	294	311	94.5

package Crypt::ECB;

# Copyright (C) 2000, 2005, 2008, 2016 Christoph Appel ([e-mail])
#  see documentation for details


########################################
# general module startup things
########################################

use strict;
use warnings;

use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);

require Exporter;

@ISA       = qw(Exporter);
@EXPORT_OK = qw(encrypt decrypt encrypt_hex decrypt_hex);
$VERSION   = '2.22';


########################################
# public methods - setting up
########################################

#
# constructor, initialization of vars
#
sub new ($;$$$)
{
	my $class = shift;

	my $self =
	{
		padding		=> 'standard', # default padding method
		mode		=> '',
		key		=> '',
		cipher		=> '',
		module		=> '',
		keysize		=> '',
		blocksize	=> '',

		_cipherobj	=> '', # contains the block cipher object
		_buffer		=> '', # internal buffer used by crypt() and finish()
	};

	bless $self, $class;

	if ($_[0])
	{
		my $options;

		# options Crypt::CBC style
		if ($_[0] =~ /^-[a-zA-Z]+$/)
		{
			my %tmp = @_;
			$options->{substr(lc $_, 1)} = $tmp{$_} for keys %tmp;
		}

		# options like in Crypt::CBC before 2.13
		elsif (ref $_[0] eq 'HASH')
		{
			$options = shift;
		}

		# and like Crypt::CBC before 2.0
		else
		{
			$options->{key}    = shift;
			$options->{cipher} = shift || 'DES';
		}

		# cipher has to be called before keysize and blocksize
		# otherwise it would override values provided by the user
		$self->$_( $options->{$_} ) foreach qw(cipher keysize key blocksize padding);
	}

	return $self;
}

#
# set attributes if argument given, return attribute value
#
sub module	(\$)	{					return $_[0]->{module}    }
sub keysize	(\$;$)	{ $_[0]->{keysize}   = $_[1] if $_[1];	return $_[0]->{keysize}   }
sub blocksize	(\$;$)	{ $_[0]->{blocksize} = $_[1] if $_[1];	return $_[0]->{blocksize} }
sub mode	(\$)	{ 					return $_[0]->{mode}      }

#
# sets key if argument given
#
sub key (\$;$)
{
	my $self = shift;

	if (my $key = shift)
	{
		$self->{key} = $key;

		# forget cipher object to force creating a new one
		# otherwise a key change would not be recognized
		$self->{_cipherobj} = '';
	}

	return $self->{key};
}

#
# sets padding method if argument given
#
sub padding (\$;$)
{
	my $self = shift;

	if (my $padding = shift)
	{
		# if given a custom padding...
		if (ref $padding eq 'CODE')
		{
			# ...for different block sizes...
			for my $bs ((8, 16))
			{
				# ...check whether it works as expected
				for my $i (0 .. $bs-1)
				{
					my $plain = ' ' x $i;

					my $padded = $padding->($plain, $bs, 'e') || '';
					die "Provided padding method does not pad properly: Expected $bs bytes, got ", length $padded, ".\n"
						unless (length $padded == $bs);

					my $trunc = $padding->($padded, $bs, 'd') || '';
					die "Provided padding method does not truncate properly: Expected '$plain', got '$trunc'.\n"
						unless ($trunc eq $plain);
				}
			}
		}

		$self->{padding} = $padding;
	}

	return $self->{padding};
}

#
# sets and loads crypting module if argument given
#
sub cipher (\$;$)
{
	my $self = shift;

	if (my $cipher = shift)
	{
		my $module;

		# if a cipher object is provided...
		if (ref $cipher)
		{
			# ...use it
			$self->{_cipherobj} = $cipher;

			$module = ref $cipher;
			($cipher = $module) =~ s/^Crypt:://;
		}

		# else try to load the specified cipher module
		else
		{
			# for compatibility with Crypt::CBC, cipher modules can be specified
			# with or without the 'Crypt::' in front
			$module = $cipher=~/^Crypt/ ? $cipher : "Crypt::$cipher";

			eval "require $module";
			die "Couldn't load $module: $@"."Are you sure '$cipher' is correct? If so,"
			  . " install $module in the proper path or choose some other cipher.\n"
				if $@;

			# delete possibly existing cipher obj from a previous crypt process
			# otherwise changes in the cipher would not be recognized by start()
			$self->{_cipherobj} = '';
		}

		# some packages like Crypt::DES and Crypt::IDEA behave strange in the way
		# that their methods do not belong to the Crypt::DES or Crypt::IDEA namespace
		# but only DES or IDEA instead
		unless ($module->can('blocksize')) { $module=$cipher }

		die "Can't work because Crypt::$cipher doesn't report blocksize."
		  . " Are you sure $cipher is a valid cipher module?\n"
			unless ($module->can('blocksize') && $module->blocksize);

		$self->{blocksize} = $module->blocksize;

		# In opposition to the blocksize, the keysize need not be known by me,
		# but by the one who provides the key. This is because some modules
		# (e.g. Crypt::Blowfish) report keysize 0; in other cases several keysizes
		# are admitted, so reporting just one number would anyway be to narrow
		$self->{keysize} = $module->can('keysize') ? $module->keysize : '';

		$self->{module} = $module;
		$self->{cipher} = $cipher;
	}

	return $self->{cipher};
}


########################################
# public methods - en-/decryption
########################################

#
# sets mode if argument given, either en- or decrypt
# checks, whether all required vars are set
# returns mode
#
sub start (\$$)
{
	my $self = shift;
	my $mode = shift;

	die "Not yet finished existing crypting process. Call finish() before calling start() anew.\n"
		if $self->{_buffer};

	die "Mode has to be either (e)ncrypt or (d)ecrypt.\n"
		unless ($mode=~/^[de]/i);

	# unless a cipher object is provided (see cipher())...
	unless ($self->{_cipherobj})
	{
		# make sure we have a key...
		die "Key not set. Use '\$ecb->key ('some_key'). The key length is probably specified"
		  . " by the algorithm (for example the Crypt::IDEA module needs a sixteen byte key).\n"
			unless $self->{key};

		# ...as well as a block cipher
		die "Can't start() without cipher. Use '\$ecb->cipher(\$cipher)', \$cipher being some"
		  . "  algorithm like for example 'DES', 'IDEA' or 'Blowfish'. Of course, the corresponding"
		  . "  module 'Crypt::\$cipher' needs to be installed.\n"
			unless $self->{module};

		# initialize cipher obj doing the actual en-/decryption
		$self->{_cipherobj} = $self->{module}->new( $self->{key} );
	}

	$self->{mode} = ($mode=~/^d/i) ? "decrypt" : "encrypt";

	return $self->{mode};
}

#
# calls the crypting module
# returns the en-/decrypted data
#
sub crypt (\$;$)
{
	my $self = shift;
	my $data = shift;

	$data = ($_ || '') unless defined $data;

	my $bs     = $self->{blocksize};
	my $mode   = $self->{mode};

	die "You tried to use crypt() without calling start() before. Use '\$ecb->start(\$mode)'"
	  . " first, \$mode being one of 'decrypt' or 'encrypt'.\n"
		unless $mode;

	$data = $self->{_buffer}.$data;

	# data is split into blocks of proper size which is reported
	# by the cipher module
	my @blocks = $data=~/(.{1,$bs})/gs;

	# last block goes into buffer
	$self->{_buffer} = pop @blocks;

	my ($cipher, $text) = ($self->{_cipherobj}, '');
	$text .= $cipher->$mode($_) foreach (@blocks);
	return $text;
}

#
#
#
sub finish (\$)
{
	my $self = shift;

	my $bs     = $self->{blocksize};
	my $mode   = $self->{mode};
	my $data   = $self->{_buffer};
	my $result = '';

	die "You tried to use finish() without calling start() before. Use '\$ecb->start(\$mode)'"
	  . " first, \$mode being one of 'decrypt' or 'encrypt'.\n"
		unless $mode;

	# cleanup: forget mode, purge buffer
	$self->{mode}		= '';
	$self->{_buffer}	= '';

	return '' unless defined $data;

	my $cipher = $self->{_cipherobj};

	# now we have to distinguish between en- and decryption:
	# when decrypting, data has to be truncated to correct size
	# when encrypting, data has to be padded up to blocksize
	if ($mode =~ /^d/i)
	{
		# pad data with binary 0 up to blocksize
		# in fact, this should not be necessary because correctly
		# encrypted data is always a multiple of the blocksize
		$data = pack("a$bs",$data);

		$result = $cipher->$mode($data);
		$result = $self->_truncate($result);
	}
	else
	{
		# if length is smaller than blocksize, just pad the block
		if (length($data) < $bs)
		{
			$data = $self->_pad($data);
			$result = $cipher->$mode($data);
		}
		# else append another block (depending on padding chosen)
		else
		{
			$result = $cipher->$mode($data);
			$self->_pad('') &&
				($result .= $cipher->$mode( $self->_pad('') ));
		}
	}

	return $result;
}


########################################
# private methods
########################################

#
# pad block to blocksize
#
sub _pad (\$$)
{
	my $self = shift;
	my $data = shift;

	my $bs      = $self->{blocksize};
	my $padding = $self->{padding};

	my $pad = $bs - length $data;

	my $message = "Your message length is not a multiple of $self->{cipher}'s blocksize ($bs bytes)."
		    . " Correct this by hand or tell me to handle padding.\n";

	$padding eq 'standard' ?	$data .= chr($pad) x  $pad				:
	$padding eq 'zeroes' ?		$data .=      "\0" x ($pad-1) . chr($pad)		:
	$padding eq 'oneandzeroes' ?	                   $data .= "\x80" . "\0"x($pad-1)	:
	$padding eq 'rijndael_compat' ?	(length $data) && ($data .= "\x80" . "\0"x($pad-1))	:
	$padding eq 'null' ?		                   $data .=          "\0"x $pad		:
	$padding eq 'space' ?		(length $data) && ($data .=          " " x $pad)	:
	ref $padding eq 'CODE' ?	$data = $padding ->($data, $bs, 'e')			:
	$padding eq 'none' ?		(length($data) % $bs) && die $message			:

	# still here?
	die "Padding style '$padding' not defined.\n";

	return $data;
}

#
# truncates result to correct length
#
sub _truncate (\$$)
{
	my $self = shift;
	my $data = shift;

	my $bs      = $self->{blocksize};
	my $padding = $self->{padding};

	if ($padding =~ /^(standard|zeroes|random)$/)
	{
		my $trunc = ord(substr $data, -1);

		die "Asked to truncate $trunc bytes, which is greater than $self->{cipher}'s blocksize ($bs bytes).\n"
			if $trunc > $bs;

		my $expected =	$padding eq 'standard' ?	chr($trunc) x  $trunc			:
				$padding eq 'zeroes' ?		       "\0" x ($trunc-1) . chr($trunc)	:
				$padding eq 'random' ?	substr($data, -$trunc, $trunc-1) . chr($trunc)	: 'WTF!?';

		die "Block doesn't look $padding padded.\n" unless $expected eq substr($data, -$trunc);

		substr($data, -$trunc) = '';
	}
	else
	{
		$padding eq 'oneandzeroes' ?	$data =~ s/\x80\0*$//s			:
		$padding eq 'rijndael_compat' ?	$data =~ s/\x80\0*$//s			:
		$padding eq 'null' ?		$data =~ s/\0+$//s			:
		$padding eq 'space' ?		$data =~ s/ +$//s			:
		ref $padding eq 'CODE' ?	$data = $padding->($data, $bs, 'd')	:
		$padding eq 'none' ?		()					:

		# still here?
		die "Padding style '$padding' not defined.\n";
	}

	return $data;
}


########################################
# convenience functions/methods
########################################

#
# magic decrypt/encrypt function/method
#
sub _crypt
{
	my ($mode, $self, $key, $cipher, $data, $padding);

	if (ref $_[1])
	{
		($mode, $self, $data) = @_;
	}
	else
	{
		($mode, $key, $cipher, $data, $padding) = @_;

		$self = __PACKAGE__->new($key => $cipher);
		$self->padding($padding) if $padding;

		$data = $_ unless length($data);
	}

	$self->start($mode);
	my $text = $self->crypt($data) . $self->finish;

	return $text;
}

#
# convenience encrypt and decrypt functions/methods
#
sub encrypt ($$;$$) { _crypt('encrypt', @_) }
sub decrypt ($$;$$) { _crypt('decrypt', @_) }

#
# calls encrypt, returns hex packed data
#
sub encrypt_hex ($$;$$)
{
	if (ref $_[0])
	{
		my $self = shift;
		join('',unpack('H*',$self->encrypt(shift)));
	}
	else
	{
		join('',unpack('H*',encrypt($_[0], $_[1], $_[2], $_[3])));
	}
}

#
# calls decrypt, expected input is hex packed
#
sub decrypt_hex ($$;$$)
{
	if (ref $_[0])
	{
		my $self = shift;
		$self->decrypt(pack('H*',shift));
	}
	else
	{
		decrypt($_[0], $_[1], pack('H*',$_[2]), $_[3]);
	}
}


########################################
# finally, to satisfy require
########################################

'The End...';
__END__