view release on metacpan or  search on metacpan

lib/Convert/PEM.pm  view on Meta::CPAN

sub encode {
    my $pem = shift;
    my %param = @_;

    my $buf = $param{DER} || $pem->to_der(%param);
    my (@headers);
    if ($param{Password}) {
        my ($info);
        ($buf, $info) = $pem->encrypt( Plaintext => $buf,
                                       %param )
            or return;
        push @headers, [ 'Proc-Type' => '4,ENCRYPTED' ];
        push @headers, [ 'DEK-Info'  => $info ];
    }

    $pem->implode( Object  => $param{Name} || $pem->name,
                   Headers => \@headers,
                   Content => $buf );
}

sub explode {
    my $pem = shift;
    my ($message) = @_;

    # Canonicalize line endings into "\n".
    $message =~ s/\r\n|\n|\r/\n/g;

    my ($head, $object, $headers, $content, $tail) = $message =~ 
        m:(-----BEGIN ([^\n\-]+)-----)\n(.*?\n\n)?(.+)(-----END .*?-----)$:s;
    my $buf = decode_base64($content);

    my @headers;
    if ($headers) {
        for my $h ( split /\n/, $headers ) {
            my ($k, $v) = split /:\s*/, $h, 2;
            push @headers, [ $k => $v ] if $k;
        }
    }

    { Content => $buf,
      Object  => $object,
      Headers => \@headers }
}

sub implode {
    my $pem = shift;
    my %param = @_;
    my $head = "-----BEGIN $param{Object}-----"; 
    my $tail = "-----END $param{Object}-----";
    my $content = encode_base64( $param{Content}, '' );
    $content =~ s!(.{1,64})!$1\n!g;
    my $headers = join '',
                  map { "$_->[0]: $_->[1]\n" }
                  @{ $param{Headers} };
    $headers .= "\n" if $headers;
    "$head\n$headers$content$tail\n";
}

use vars qw( %CTYPES );
%CTYPES = (
    'DES-CBC'           =>    {c => 'Crypt::DES',         ks=>8,  bs=>8,  },
    'DES-EDE3-CBC'      =>    {c => 'Crypt::DES_EDE3',    ks=>24, bs=>8,  },
    'AES-128-CBC'       =>    {c => 'Crypt::Rijndael',    ks=>16, bs=>16, },
    'AES-192-CBC'       =>    {c => 'Crypt::Rijndael',    ks=>24, bs=>16, },
    'AES-256-CBC'       =>    {c => 'Crypt::Rijndael',    ks=>32, bs=>16, },
    'CAMELLIA-128-CBC'  =>    {c => 'Crypt::Camellia',    ks=>16, bs=>16, },
    'CAMELLIA-192-CBC'  =>    {c => 'Crypt::Camellia',    ks=>24, bs=>16, },
    'CAMELLIA-256-CBC'  =>    {c => 'Crypt::Camellia',    ks=>32, bs=>16, },
    'IDEA-CBC'          =>    {c => 'Crypt::IDEA',        ks=>16, bs=>8,  },
    'SEED-CBC'          =>    {c => 'Crypt::SEED',        ks=>16, bs=>16, },
);

#### cipher module support and configuration
sub list_ciphers { return wantarray ? sort keys %CTYPES : join(':', sort keys %CTYPES); }

sub list_cipher_modules {
    # expect a cipher name, if found, return the module name used for encryption/decryption
    my $pem = ref($_[0]) || $_[0] eq __PACKAGE__ ? shift : '';
    if (defined $_[0]) {
        my $cn = has_cipher(shift) || return undef;
        return $CTYPES{$cn}->{c};
    }
    return wantarray
        ? map { $CTYPES{$_}->{c} } sort keys %CTYPES
        : join(':', map { $CTYPES{$_}->{c} } sort keys %CTYPES);
}

sub has_cipher {
    # expect a cipher name, return the cipher name if found
    my $pem = ref($_[0]) || $_[0] eq __PACKAGE__ ? shift : '';
    my $cn = uc(+shift);
    return $cn if exists $CTYPES{$cn} && exists $CTYPES{$cn}->{c};
    # try to figure out what cipher is meant in an overkill fashion
    $cn =~ s/(DES.*3|3DES|EDE)|(DES)|([a-zA-Z]+)(?:-?(\d+)(?:-?(\w+))?)/
        if ($1) {
            'DES-EDE3-CBC'
        } elsif ($2) {
            'DES-CBC'
        }
        else {
            $3.($4 ? "-".$4 : "").($5 ? "-$5" : "")
        }
    /e;
    my @c = sort grep { $_ =~ m/$cn/ } keys %CTYPES;
    # return undef unless @c;
    $c[0];
}

sub has_cipher_module
{
    my $pem = ref($_[0]) || $_[0] eq __PACKAGE__ ? shift : '';
    if (my $cn = has_cipher($_[0])) {
        eval "use $CTYPES{$cn}->{c};";
        if ($@) { undef $@; return undef; }
        return $CTYPES{$cn}->{c};
    }
}

sub set_cipher_module
{
    my $pem = ref($_[0]) || $_[0] eq __PACKAGE__ ? shift : '';
    # cipher name, cipher module name, replace all

lib/Convert/PEM.pm  view on Meta::CPAN

=back

=head2 Convert::PEM->has_cipher(I<$cipher_name>)

Will see if the cipher is supported and is configured with an encryption
module.

=head2 Convert::PEM->has_cipher_module(I<$cipher_name>)

Will see if the cipher is supported and if the configured encryption
module is usable.  If it is not usable, will return C<undef>.  If it is
usable, will return the name of the cipher module.

=head2 Convert::PEM->set_cipher_module($cipher,$module[,$all])

This function/method  is used to specify a module name for a supported
cipher.  It accepts 2 or 3 arguments.

    Convert::PEM->set_cipher_module(<cipher_name>, <module_name>[,0])
    or
    $OBJ->set_cipher_module(<cipher_name>, <module_name>[,0])

=over 4

=item C<cipher_name>

A supported cipher name. Use Convert::PEM::list_ciphers() to retrieve a
list of supported ciphers.

=item C<module_name>

A cipher module.  The module must support the following methods:

    $cipher_object = Cipher->new($key)
    $cipher_object->encrypt($plaintext)
    $cipher_object->decrypt($ciphertext)
    $cipher_object->blocksize()

=item C<all>

An optional boolean argument.  If true will replace the modules for all
supported ciphers matching the cipher being set.  Default is true. If
setting a cipher, only set this to false if it is desired to use a
separate cipher for different key lengths of the same algorithm.

=back

=head2 Convert::PEM->list_cipher_modules([$cipher_name])

If a I<cipher_name> is provided, will return the module configured for
the matching cipher name or C<undef> if cipher is not supported.
If I<cipher_name> is not provided, will return a list of modules names
configured as an array in array context or as a colon separated list in
scalar context.

Here is a list of the cipher modules used by default.

=over 4

=item * L<Crypt::DES>

=item * L<Crypt::DES_EDE3>

=item * L<Crypt::Rijndael> - C<AES-128-CBC, AES-192-CBC and AES-256-CBC>

=item * L<Crypt::Camellia> - C<CAMELLIA-128-CBC, CAMELLIA-192-CBC and CAMELLIA-256-CBC>

=item * Crypt::L<IDEA>

=item * L<Crypt::SEED>

=back

=head1 ERROR HANDLING

If an error occurs in any of the above methods, the method will return
C<undef>. You should then call the method I<errstr> to determine the
source of the error:

    $pem->errstr

In the case that you do not yet have a I<Convert::PEM> object (that is,
if an error occurs while creating a I<Convert::PEM> object), the error
can be obtained as a class method:

    Convert::PEM->errstr

For example, if you try to decode an encrypted object, and you do not
give a passphrase to decrypt the object:

    my $obj = $pem->read( Filename => "encrypted.pem" )
        or die "Decryption failed: ", $pem->errstr;

=head1 LICENSE

Convert::PEM is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR & COPYRIGHTS

Except where otherwise noted, Convert::PEM is Copyright Benjamin
Trott, cpan@stupidfool.org. All rights reserved.

=cut