view release on metacpan or  search on metacpan

Encrypted.pm  view on Meta::CPAN

package Apache::Cookie::Encrypted;
#use Apache::Cookie;
use base qw(Apache::Cookie);

require Apache;

use strict;
use warnings;
use Crypt::CBC;
use Carp;
use vars qw($VERSION $key);

$VERSION = '0.03';

# get the encryption key

BEGIN {
    my $r = Apache->request;
    $key = $r->dir_config('COOKIE_KEY');
}

# Our own constructor. Effectivly overrides the new constructor.

sub new {
    my ($class) = shift;
    my @args = @_;

    # variable declaration
    my (@new_args, $r, $params);
    $params = {};


    # we go through the argument to pull the Apache::Request out of the array and
    # put the rest into another one to be parsed after this.
    foreach my $arg (@args) {
        if (ref($arg) eq "Apache::Request" || ref($arg) eq "Apache") {
            $r = $arg;
        } else {
            push(@new_args, $arg);
        }
    }

    # load in options supplied to new()
    for (my $x = 0; $x <= $#new_args; $x += 2) {
        defined($args[($x + 1)]) or croak("Apache::Cookie::Encrypted->new() called with odd number of".
                                          " option parameters - should be of the form -option => value");

        $params->{lc($new_args[$x])} = $new_args[($x + 1)];
    }

    # check for the key and place it in the proper variable
    unless ($key) {
	if (exists($params->{-key})) {
	    $key = $params->{-key};
	    delete $params->{-key};
	} else {
	    croak "No key defined - key must be defined for Apache::Cookie::Encrypted to work\n";
	}
    }

    my $self = $class->SUPER::new($r);

    if (exists($params->{-name})) {
        $self->name($params->{-name});
    }

    if (exists($params->{-value})) {
        $params->{-value} = &_encrypt_data( $params->{-value} );
        $self->value($params->{-value});
    }

    if (exists($params->{-expires})) {
        $self->expires($params->{-expires});
    }

    if (exists($params->{-domain})) {
        $self->domain($params->{-domain});
    }

    if (exists($params->{-path})) {
        $self->path($params->{-path});
    }

    if (exists($params->{-secure})) {
        $self->secure($params->{-secure});
    }

    # return the blessed object
    return bless $self, $class;

}

sub Apache::Cookie::Encrypted::value {
    my $self = shift;

    my $data = shift || undef;

    if ($data) {
        $data = &_encrypt_data($data) if $data ne '';
        $self->SUPER::value($data);
    } else {
        my  @cookie_data = $self->SUPER::value();
        my $data_in;
        if (scalar(@cookie_data) > 1) {
            $data_in = \@cookie_data;
        } else {
            $data_in = $cookie_data[0];
        }
        my $data_out = &_decrypt_data( $data_in );
        return wantarray ? @$data_out : $data_out;
    }
}

sub Apache::Cookie::Encrypted::parse {
    my $self = shift;

    my $data = shift || undef;
    my %parsed;

    if ($data) {
	%parsed = SUPER::parse($data);
    } else {
	%parsed = SUPER::parse();
    }
    
    my %new_parsed;

    foreach (keys %parsed) {
	$new_parsed{$_} = bless $parsed{$_}, $self;
    }

    return wantarray ? %new_parsed : \%new_parsed;
}

sub Apache::Cookie::Encrypted::fetch {
    my $self = shift;

    my %fetched = $self->SUPER::fetch();

    my %enc_fetch_translated;

    foreach (keys %fetched) {
        $enc_fetch_translated{$_} = bless $fetched{$_}, $self;
    }

    return wantarray ? %enc_fetch_translated : \%enc_fetch_translated;
}

# data encryption subroutine
{
sub _encrypt_data {
    my $data = shift;

    croak("Can't encrypt anything without a key!") unless $key;

    my $cipher = new Crypt::CBC($key,'Blowfish');

    if (ref($data) eq "ARRAY") {
        for (my $i = 0; $i <= $#$data; $i++) {
            $data->[$i] = $cipher->encrypt_hex($data->[$i]);
        }
        return $data;
    } else {
        $data = $cipher->encrypt_hex( $data );
        return $data;
    }
}
}

# data decryption subroutine
{
sub _decrypt_data {
    my $data = shift;

    croak("Can't decrypt anything without a key!") unless $key;

    my $cipher = new Crypt::CBC($key,'Blowfish');

    if (ref($data) eq "ARRAY") {
        for (my $i = 0; $i <= $#$data; $i++) {
            $data->[$i] = $cipher->decrypt_hex($data->[$i]);
        }
        return $data;
    } else {
        $data = $cipher->decrypt_hex( $data );
        return $data;
    }
}
}

1;

__END__

=head1 NAME

Apache::Cookie::Encrypted - Encrypted HTTP Cookies Class