File Coverage

blib/lib/CGI/EncryptForm.pm

Criterion	Covered	Total	%
statement	100	119	84.0
branch	24	38	63.1
condition	10	25	40.0
subroutine	16	17	94.1
pod	7	7	100.0
total	157	206	76.2

#
# Copyright 1999, Peter Marelas.  All rights reserved.
#
# This library is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# Bug reports and comments to [e-mail].
#

package CGI::EncryptForm;

use Crypt::HCE_SHA;
use Storable qw(freeze thaw);
use Digest::SHA1 qw(sha1);

use strict;
use vars qw($VERSION $CHARSET);

$VERSION = 1.02;

# Default character set we use for encoding/decoding encrypted string
#
$CHARSET = [qw/AA Aa BA Ba CA Ca DA Da EA Ea AB Ab BB Bb CB Cb DB Db EB Eb AC Ac BC Bc CC Cc DC Dc EC Ec AD Ad BD Bd CD Cd DD Dd ED Ed AE Ae BE Be CE Ce DE De EE Ee AF Af BF Bf CF Cf DF Df EF Ef AG Ag BG Bg CG Cg DG Dg EG Eg AH Ah BH Bh CH Ch DH Dh EH Eh AI Ai BI Bi CI Ci DI Di EI Ei AJ Aj BJ Bj CJ Cj DJ Dj EJ Ej AK Ak BK Bk CK Ck DK Dk EK Ek AL Al BL Bl CL Cl DL Dl EL El AM Am BM Bm CM Cm DM Dm EM Em AN An BN Bn CN Cn DN Dn EN En AO Ao BO Bo CO Co DO Do EO Eo AP Ap BP Bp CP Cp DP Dp EP Ep AQ Aq BQ Bq CQ Cq DQ Dq EQ Eq AR Ar BR Br CR Cr DR Dr ER Er AS As BS Bs CS Cs DS Ds ES Es AT At BT Bt CT Ct DT Dt ET Et AU Au BU Bu CU Cu DU Du EU Eu AV Av BV Bv CV Cv DV Dv EV Ev AW Aw BW Bw CW Cw DW Dw EW Ew AX Ax BX Bx CX Cx DX Dx EX Ex AY Ay BY By CY Cy DY Dy EY Ey yY wW vV uU zU zZ/];

sub new {
	my($this) = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->_initialize(@_);
	return($self);
}

sub DESTROY {
}

# Public Method:
#
# encrypt()
#
# Purpose:
#
# Encrypt the hash reference
#
# Constructs:
#
#   encrypt()
#   Return last encrypted string
#
#   encrypt({a => b})
#   Encrypt hash reference and return encrypted string
#
sub encrypt {
	my($self, $decrypted_hashref) = @_;

	my $secret_key = $self->secret_key() || return undef;

	if (!defined($decrypted_hashref) && !defined($self->{_encrypted_string})) {
		$self->error('encrypt() This is the first time encrypt() has been called and therefore requires an arguement.');
		return undef;
	}
	elsif (!defined($decrypted_hashref)) {
		return($self->{_encrypted_string});
	}

	if (ref($decrypted_hashref) ne 'HASH') {
		$self->error('encrypt() This method accepts a single hash reference only.');
		return undef;
	}

	my $random_key = $self->_random_key();

	my $str = freeze($decrypted_hashref);
	$str = sha1($str) . $str;

	my $cipher = Crypt::HCE_SHA->new($secret_key, $random_key);
	$self->{_encrypted_string} = $self->usecharset() ?
		$self->_encode($random_key . $cipher->hce_block_encrypt($str)) : $random_key . $cipher->hce_block_encrypt($str);
	$self->error('');
	return($self->{_encrypted_string});
}


# Public Method:
#
# decrypt()
#
# Purpose:
#
# Decryption routine
#
# Constructs:
#
#   decrypt()
#   Return last decrypted reference to hash
#
#   decrypt("encrypted string")
#   Decrypt encrypted string and return reference to hash
#
sub decrypt {
	my($self, $encrypted_string) = @_;

	my $secret_key = $self->secret_key() || return undef;
	my $random_key;

	if (!defined($encrypted_string) && !defined($self->{_decrypted_hashref})) {
		$self->error('decrypt() This is the first time decrypt() has been called and therefore requires an arguement.');
		return undef;
	}
	elsif (!defined($encrypted_string)) {
		return($self->{_decrypted_hashref});
	}

	# if using char set ensure string is even number
	if ($self->usecharset() && (length($encrypted_string) % 2) != 0) {
		$self->error('decrypt() Character set is inconsistent.');
		return undef;
	}

	# decode the encrypted string
	my $str = $self->usecharset() ? $self->_decode($encrypted_string) :
																	$encrypted_string;

	# extract the random key (first 4 bytes)
	$random_key = substr($str, 0, 4);
	if (length($random_key) != 4) {
		$self->error('decrypt() Random key is inconsistent.');
		return undef;
	}
	$str = substr($str, 4);

  # decrypt
  my $cipher = Crypt::HCE_SHA->new($secret_key, $random_key);
	my $plaintxt = $cipher->hce_block_decrypt($str);

	# extract sha1 digest from decrypted string which is always
	# 20 bytes long
	my $digest = substr($plaintxt, 0, 20);
	if (length($digest) != 20) {
		$self->error('decrypt() Digest is inconsistent.');
		return undef;
	}
	$plaintxt = substr($plaintxt, 20);

	# check stored decrypted digest against digest of decrypted string
	if ($digest ne sha1($plaintxt)) {
		$self->error('decrypt() Encrypted string is inconsistent.');
		return undef;
	}

	$self->error('');
	return(thaw($plaintxt));
}

# Public Method:
#
# secret_key()
#
# Purpose:
#
# Set/Return secret key
#
# Constructs:
#
#   secret_key()
#   Return current secret_key
#
#   secret_key("secret key")
#   Set secret key
#
sub secret_key {
	my($self, $secret_key) = @_;

	if (defined($secret_key)) {
		$self->{_secret_key} = $secret_key;
	}
	elsif (!defined($self->{_secret_key})) {
		$self->error('secret_key() No secret key has been defined.');
		return undef;
	}

	$self->error('');
	return($self->{_secret_key});
}

# Public Method
#
# charset()
#
# Purpose:
#
# Set character set
#
# Constructors:
#
#		charset([array of 2 character length elements from 0 to 255])
#		Set character set
#
sub charset {
	my($self, $charset) = @_;

	if ((defined($charset) && ref($charset) ne 'ARRAY') || !defined($charset)) {
		$self->error('charset() This methods accepts a single array reference.');
		return undef;
	}
	elsif (defined($charset) && $#$charset != 255) {
		$self->error('charset() The character set is invalid.');
		return undef;
	}

	$self->{'_charset'} = $charset;
	$self->{'_charset_hash'} = {
		map { $self->{'_charset'}->[$_] => $_; } 0..$#{$self->{'_charset'}}
	};

	$self->error('');
}

# Public Method:
#
# usecharset()
#
# Purpose:
#
# Enable/Return character set encoding/decoding of encrypted/decrypted string
# suitable for storage in form fields, cookies or URL's
#
# Constructs:
#
#   usecharset()
#   Return current usecharset value
#
#   usecharset(0 or 1)
#   Set charset encoding/decoding
#
sub usecharset {
	my($self, $usecharset) = @_;

	$self->error('');
	$self->{_usecharset} = $usecharset if defined($usecharset);

	return($self->{_usecharset} ? 1 : 0);
}

# Public/Private Method:
#
# error()
#
# Purpose:
#
# Set/Clear/Get error message for last operation on object
#
# Public Constructors:
#
#		error()
#   Return error from last operation
#
sub error {
	my($self, $errormsg) = @_;

	if ($errormsg) {
		$self->{_errormsg} = "Error: $errormsg\n";
	}
	else {
		return($self->{_errormsg});
	}
}

#
# Private methods - dont call these from your object
#
sub _initialize {
	my($self, %opts) = @_;

	$self->{'_usecharset'} = 1;
	$self->{'_encrypted_string'} = undef;
	$self->{'_decrypted_hashref'} = undef;
	$self->{'_secret_key'} = undef;
	$self->{'_random_key'} = undef;
	$self->{'_errormsg'} = '';
	$self->{'_charset'} = undef;
	$self->{'_charset_hash'} = undef;

	# Set default charset
	$self->charset($CHARSET);

	foreach (keys(%opts)) {
		if (! $self->can($_)) {
			$self->error("_initialize() $_ is not a valid option.");
			return undef;
		}
		$self->$_($opts{$_});
	}
}

#
# Autogenerate the current object's random key every time. i.e. Not Persistent!
#
sub _random_key {
	my($self) = @_;

	$self->{_random_key} = pack("CCCC", rand(255), rand(255), rand(255),
																			rand(255));

	$self->error('');
	return($self->{_random_key});
}

# Decode encrypted string using character set
#
sub _decode {
	my($self, $decode) = @_;

	$decode =~ s/(.{2})/chr($self->{'_charset_hash'}->{$1})/sge;
  return($decode);
}

# Encode encrypted string using character set
#
sub _encode {
		my($self, $encode) = @_;

  	$encode =~ s/(.)/$self->{'_charset'}->[ord($1)]/sge;
    return($encode);
}

1;
__END__