GseTDDUebungKCLR/database/perl/vendor/lib/Crypt/OpenPGP/Cipher.pm

package Crypt::OpenPGP::Cipher;
use strict;

use Crypt::OpenPGP::CFB;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );

use vars qw( %ALG %ALG_BY_NAME );
%ALG = (
    1 => 'IDEA',
    2 => 'DES3',
    3 => 'CAST5',
    4 => 'Blowfish',
    7 => 'Rijndael',
    8 => 'Rijndael192',
    9 => 'Rijndael256',
    10 => 'Twofish',
);
%ALG_BY_NAME = map { $ALG{$_} => $_ } keys %ALG;

sub new {
    my $class = shift;
    my $alg = shift;
    $alg = $ALG{$alg} || $alg;
    return $class->error("Unsupported cipher algorithm '$alg'")
        unless $alg =~ /^\D/;
    my $pkg = join '::', $class, $alg;
    my $ciph = bless { __alg => $alg,
                       __alg_id => $ALG_BY_NAME{$alg} }, $pkg;
    my $impl_class = $ciph->crypt_class;
    my @classes = ref($impl_class) eq 'ARRAY' ? @$impl_class : ($impl_class);
    for my $c (@classes) {
        eval "use $c;";
        $ciph->{__impl} = $c, last unless $@;
    }
    return $class->error("Error loading cipher implementation for " .
                         "'$alg': no implementations installed.")
        unless $ciph->{__impl};
    $ciph->init(@_);
}

sub init {
    my $ciph = shift;
    my($key, $iv) = @_;
    if ($key) {
        my $class = $ciph->{__impl};
        ## Make temp variable, because Rijndael checks SvPOK, which
        ## doesn't seem to like a value that isn't a variable?
        my $tmp = substr $key, 0, $ciph->keysize;
        my $c = $class->new($tmp);
        $ciph->{cipher} = Crypt::OpenPGP::CFB->new($c, $iv);
    }
    $ciph;
}

sub encrypt { $_[0]->{cipher}->encrypt($_[1]) }
sub decrypt { $_[0]->{cipher}->decrypt($_[1]) }

sub sync { $_[0]->{cipher}->sync }

sub alg { $_[0]->{__alg} }
sub alg_id {
    return $_[0]->{__alg_id} if ref($_[0]);
    $ALG_BY_NAME{$_[1]} || $_[1];
}
sub supported {
    my $class = shift;
    my %s;
    for my $cid (keys %ALG) {
        my $cipher = $class->new($cid);
        $s{$cid} = $cipher->alg if $cipher;
    }
    \%s;
}

package Crypt::OpenPGP::Cipher::IDEA;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub init {
    my $ciph = shift;
    my($key, $iv) = @_;
    if ($key) {
        my $c = IDEA->new(substr($key, 0, $ciph->keysize));
        $ciph->{cipher} = Crypt::OpenPGP::CFB->new($c, $iv);
    }
    $ciph;
}

sub crypt_class { 'Crypt::IDEA' }
sub keysize { 16 }
sub blocksize { 8 }

package Crypt::OpenPGP::Cipher::Blowfish;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub crypt_class { 'Crypt::Blowfish' }
sub keysize { 16 }
sub blocksize { 8 }

package Crypt::OpenPGP::Cipher::DES3;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub crypt_class { 'Crypt::DES_EDE3' }
sub keysize { 24 }
sub blocksize { 8 }

package Crypt::OpenPGP::Cipher::CAST5;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub crypt_class { 'Crypt::CAST5_PP' }
sub keysize { 16 }
sub blocksize { 8 }

package Crypt::OpenPGP::Cipher::Twofish;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub crypt_class { 'Crypt::Twofish' }
sub keysize { 32 }
sub blocksize { 16 }

package Crypt::OpenPGP::Cipher::Rijndael;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub crypt_class { 'Crypt::Rijndael' }
sub keysize { 16 }
sub blocksize { 16 }

package Crypt::OpenPGP::Cipher::Rijndael192;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub crypt_class { 'Crypt::Rijndael' }
sub keysize { 24 }
sub blocksize { 16 }

package Crypt::OpenPGP::Cipher::Rijndael256;
use strict;
use base qw( Crypt::OpenPGP::Cipher );

sub crypt_class { 'Crypt::Rijndael' }
sub keysize { 32 }
sub blocksize { 16 }

1;
__END__

=head1 NAME

Crypt::OpenPGP::Cipher - PGP symmetric cipher factory

=head1 SYNOPSIS

    use Crypt::OpenPGP::Cipher;

    my $alg = 'Rijndael';
    my $cipher = Crypt::OpenPGP::Cipher->new( $alg );

    my $plaintext = 'foo bar';
    my $ct = $cipher->encrypt($plaintext);
    my $pt = $cipher->decrypt($ct);

=head1 DESCRIPTION

I<Crypt::OpenPGP::Cipher> is a factory class for PGP symmetric ciphers.
All cipher objects are subclasses of this class and share a common
interface; when creating a new cipher object, the object is blessed
into the subclass to take on algorithm-specific functionality.

A I<Crypt::OpenPGP::Cipher> object is a wrapper around a
I<Crypt::OpenPGP::CFB> object, which in turn wraps around the actual
cipher implementation (eg. I<Crypt::Blowfish> for a Blowfish cipher).
This allows all ciphers to share a common interface and a simple
instantiation method.

=head1 USAGE

=head2 Crypt::OpenPGP::Cipher->new($cipher)

Creates a new symmetric cipher object of type I<$cipher>; I<$cipher>
can be either the name of a cipher (in I<Crypt::OpenPGP> parlance) or
the numeric ID of the cipher (as defined in the OpenPGP RFC). Using
a cipher name is recommended, for the simple reason that it is easier
to understand quickly (not everyone knows the cipher IDs).

Valid cipher names are: C<IDEA>, C<DES3>, C<Blowfish>, C<Rijndael>,
C<Rijndael192>, C<Rijndael256>, C<Twofish>, and C<CAST5>.

Returns the new cipher object on success. On failure returns C<undef>;
the caller should check for failure and call the class method I<errstr>
if a failure occurs. A typical reason this might happen is an
unsupported cipher name or ID.

=head2 $cipher->encrypt($plaintext)

Encrypts the plaintext I<$plaintext> and returns the encrypted text
(ie. ciphertext). The encryption is done in CFB mode using the
underlying cipher implementation.

=head2 $cipher->decrypt($ciphertext)

Decrypts the ciphertext I<$ciphertext> and returns the plaintext. The
decryption is done in CFB mode using the underlying cipher
implementation.

=head2 $cipher->alg

Returns the name of the cipher algorithm (as listed above in I<new>).

=head2 $cipher->alg_id

Returns the numeric ID of the cipher algorithm.

=head2 $cipher->blocksize

Returns the blocksize of the cipher algorithm (in bytes).

=head2 $cipher->keysize

Returns the keysize of the cipher algorithm (in bytes).

=head1 AUTHOR & COPYRIGHTS

Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.

=cut