view release on metacpan or  search on metacpan

lib/Tie/EncryptedHash.pm  view on Meta::CPAN

        return undef unless $auth;
        return $ptext;
                                          # PUBLIC FIELD
    } elsif ( $key =~ m/([^:]*)$/ || $key =~ m/.*?::([^:]*)/ )  {
        $self->{$1} = $value if $value;
        delete $$self{$1} if $delete;
        return $self->{$1} if $self->{$1};
        return undef;
    }

}

sub encrypt {  # ($plaintext, $password, $cipher)
    $_[0] = qq{REF }. Data::Dumper->new([$_[0]])->Indent(0)->Terse(0)->Purity(1)->Dumpxs if ref $_[0];
    return  qq{$_[2] } . md5_base64($_[0]) .qq{ } . 
            Crypt::CBC->new($_[1],$_[2])->encrypt_hex($_[0]) 
}

sub decrypt { # ($cipher $md5sum $ciphertext, $password)
	return undef unless $_[1];
    my ($m, $d, $c) = split /\s/,$_[0]; 
    my $ptext = Crypt::CBC->new($_[1],$m)->decrypt_hex($c);
    my $check = md5_base64($ptext);
    if ( $d eq $check ) {
      if ($ptext =~ /^REF (.*)/is) { 
        my ($VAR1,$VAR2,$VAR3,$VAR4,$VAR5,$VAR6,$VAR7,$VAR8);
        return eval qq{$1}; 
      }
      return $ptext;  
    }
}

sub verify { # ($self, $key)
    my ($self, $key) = splice @_,0,2;
    # debug ("$self->{__scaffolding}{$key}, $self->{__password}, $self->{$key}");
    return 1 unless $key =~ m:^_:;
    return 1 unless exists $self->{$key};
    return undef if ref $self->{$key} && ($self->{__scaffolding}{$key} ne 
                    $self->{__password});
    my $ptext = decrypt($self->{$key}, $self->{__password}); 
    return $ptext if $ptext;
}
   
sub each	{ CORE::each %{$_[0]} }
sub keys	{ CORE::keys %{$_[0]} }
sub values	{ CORE::values %{$_[0]} }
sub exists	{ CORE::exists $_[0]->{$_[1]} }

sub TIEHASH	# ($class, @args)
{
	my $class = ref($_[0]) || $_[0];
	my $self = bless {}, $class;
    $self->{__password} = $_[1] if $_[1];
    $self->{__cipher} = $_[2] || qq{Blowfish};
    return $self;
}

sub FETCH	# ($self, $key)
{
	my ($self, $key) = @_;
	my $entry = _access($self,$key,(caller)[0..1]);
	return $entry if $entry;
}

sub STORE	# ($self, $key, $value)
{
	my ($self, $key, $value) = @_;
	my $entry = _access($self,$key,(caller)[0..1],$value);
	return $entry if $entry;
}

sub DELETE	# ($self, $key)
{
	my ($self, $key) = @_;
	return _access($self,$key,(caller)[0..1],'',1);
}

sub CLEAR	# ($self)
{
	my ($self) = @_;
	return undef if grep { ! $self->verify($_) } 
                    grep { ! /__/ } CORE::keys %{$self};
	%{$self} = ();
}

sub EXISTS	# ($self, $key)
{
	my ($self, $key) = @_;
	my @context = (caller)[0..1];
	return _access($self,$key,@context) ? 1 : '';
}

sub FIRSTKEY	# ($self)
{
	my ($self) = @_;
	CORE::keys %{$self};
	goto &NEXTKEY;
}

sub NEXTKEY	# ($self)
{
	my $self = $_[0]; my $key;
	my @context = (caller)[0..1];
	while (defined($key = CORE::each %{$self})) {
		last if eval { _access($self,$key,@context) }
	}
	return $key;
}

sub DESTROY	# ($self)
{
}

1;
__END__


=head1 NAME

Tie::EncryptedHash - Hashes (and objects based on hashes) with encrypting fields.

=head1 SYNOPSIS

    use Tie::EncryptedHash;

    my %s = ();
    tie %s, Tie::EncryptedHash, 'passwd';

    $s{foo}  = "plaintext";     # Normal field, stored in plaintext.
    print $s{foo};              # (plaintext)
                                
    $s{_bar} = "signature";     # Fieldnames that begin in single
                                # underscore are encrypted.
    print $s{_bar};             # (signature)  Though, while the password 
                                # is set, they behave like normal fields.
    delete $s{__password};      # Delete password to disable access 
                                # to encrypting fields.
    print $s{_bar};             # (Blowfish NuRVFIr8UCAJu5AWY0w...)

    $s{__password} = 'passwd';  # Restore password to gain access.
    print $s{_bar};             # (signature)
                                
    $s{_baz}{a}{b} = 42;        # Refs are fine, we encrypt them too.


=head1 DESCRIPTION

Tie::EncryptedHash augments Perl hash semantics to build secure, encrypting
containers of data.  Tie::EncryptedHash introduces special hash fields that
are coupled with encrypt/decrypt routines to encrypt assignments at STORE()
and decrypt retrievals at FETCH().  By design, I<encrypting fields> are
associated with keys that begin in single underscore.  The remaining
keyspace is used for accessing normal hash fields, which are retained
without modification.

While the password is set, a Tie::EncryptedHash behaves exactly like a
standard Perl hash.  This is its I<transparent mode> of access.  Encrypting
and normal fields are identical in this mode.  When password is deleted,
encrypting fields are accessible only as ciphertext.  This is
Tie::EncryptedHash's I<opaque mode> of access, optimized for serialization.

Encryption is done with Crypt::CBC(3) which encrypts in the cipher block
chaining mode with Blowfish, DES or IDEA.  Tie::EncryptedHash uses Blowfish