view release on metacpan or  search on metacpan

DES_PP.m4  view on Meta::CPAN

m4_dnl 
m4_dnl When implementing cryptographic algorithms you really have the 
m4_dnl choice between readability and poor performance.  One major 
m4_dnl caveat that imposes a considerable performance penalty is the
m4_dnl lack of inline functions (resp. preprocessor macros) in Perl.
m4_dnl
m4_dnl To circumevent these difficulties, earlier versions of this
m4_dnl file contained C preprocessor directives but that approach was
m4_dnl discarded for several reasons: 
m4_dnl 
m4_dnl o The code after the macro expansion is mostly illegible which
m4_dnl   is undesirable when only the expanded code gets installed.
m4_dnl
m4_dnl o Every here and then spurious errors occur because Perl comments
m4_dnl   are mistakenly interpreted as preprocessor directives.
m4_dnl
m4_dnl o There is neither a standard name nor a standard invocation for
m4_dnl   the C preprocessor.  This problem could be partly solved by
m4_dnl   including Config.pm in Makefile.PL and inquiring the invocation 
m4_dnl   syntax from "$Config{cpprun}".  Unfortunately, many people
m4_dnl   have not compiled the Perl interpreter on their own but
m4_dnl   have installed a pre-comupiled binary instead.  Under these
m4_dnl   circumstances the variable "$Config{cpprun}" can only inform
m4_dnl   about the preprocessor invocation on your vendor's build
m4_dnl   machine that was valid at the time that the Perl interpreter
m4_dnl   was compiled.         ' Dear St. Emacs, will you ever learn?
m4_dnl   
m4_dnl Using m4 instead of the C preprocessor looks much more attractive.
m4_dnl None of the above disadvantages apply.  M4 leaves you infinite
m4_dnl control on the output (it is for example not possible to create
m4_dnl a file with a hash bang in the very first line without the help
m4_dnl of extra tools with the preprocessor).  M4 has been designed 
m4_dnl exactly for purposes like this, thus making it relatively 
m4_dnl straightforward to  avoid conflicts between m4 code interpretation 
m4_dnl and Perl code interpretation.  Finally the m4 syntax is pretty much
m4_dnl standardized compared to the numerous pitfalls that C preprocessor
m4_dnl syntax provides (think of string concatenation, spaces between
m4_dnl the hash sign and the directive, ...).  In brief, m4 is better
m4_dnl for preprocessing Perl code just for the same reasons that GNU
m4_dnl autoconf is better than X11 imake. ;-)
m4_dnl
m4_dnl One additional advantage of m4 over the C preprocessor is the
m4_dnl ability to unroll loops (although it turned out that Perl
m4_dnl itself is much smarter about loops than you would think).
m4_dnl
m4_dnl As you might have quessed already, this m4 source file has to
m4_dnl be called with the command line option ``-P'' in order to
m4_dnl to work.
m4_dnl
m4_dnl Enough of m4/cpp advocacy, here we go:
m4_dnl
m4_dnl Change the quoting character to prevent unintended quoting. 
m4_changequote(`[m4[', `]m4]')m4_dnl Make emacs happy '
m4_dnl
# -*- perl -*-
# DES_PP.pm - Pure perl implementation of DES.
#
# The master file for the module is DES_PP.m4 which needs to be run through
# the m4.  Please edit DES_PP.m4 if you need to modify!

package Crypt::DES_PP;

use strict;
use Carp;
use integer;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw (Exporter);
@EXPORT = qw ();
@EXPORT_OK = qw ();
$VERSION = '1.00';

use constant BLKSIZE => 8;

# Stolen from Crypt::DES.
sub usage {
    my ($package, $filename, $line, $subr) = caller (1);
    $Carp::CarpLevel = 2;
    croak "Usage: $subr (@_)";
}

sub blocksize () { BLKSIZE };
sub keysize () { BLKSIZE };

sub expand_key ($);
sub crypt ($$$);

sub new {
    usage ("new Crypt::DES_PP key") 
	unless @_ == 2;
    my ($package, $key) = @_;
    
    bless { ks => Crypt::DES_PP::expand_key ($key) }, $package;
}

sub encrypt {
    usage ("encrypt data[8 bytes]") unless @_ == 2;
    
    my ($self,$data) = @_;
    return Crypt::DES_PP::crypt ($data, $self->{ks}, 1);
}

sub decrypt {
    usage("decrypt data[8 bytes]") unless @_ == 2;
    
    my ($self,$data) = @_;
    return Crypt::DES_PP::crypt ($data, $self->{ks}, 0);
}

use constant ITERATIONS => 16;

# These used to be a single reference to an array of array references.
# Splitting them up into distinct constants slightly improves performance.
use constant des_SPtrans_0 =>
    [ # Nibble 0
      0x00820200, 0x00020000, 0x80800000, 0x80820200,
      0x00800000, 0x80020200, 0x80020000, 0x80800000,
      0x80020200, 0x00820200, 0x00820000, 0x80000200,
      0x80800200, 0x00800000, 0x00000000, 0x80020000,
      0x00020000, 0x80000000, 0x00800200, 0x00020200,
      0x80820200, 0x00820000, 0x80000200, 0x00800200,
      0x80000000, 0x00000200, 0x00020200, 0x80820000,
      0x00000200, 0x80800200, 0x80820000, 0x00000000,
      0x00000000, 0x80820200, 0x00800200, 0x80020000,
      0x00820200, 0x00020000, 0x80000200, 0x00800200,
      0x80820000, 0x00000200, 0x00020200, 0x80800000,
      0x80020200, 0x80000000, 0x80800000, 0x00820000,
      0x80820200, 0x00020200, 0x00820000, 0x80800200,
      0x00800000, 0x80000200, 0x80020000, 0x00000000,
      0x00020000, 0x00800000, 0x80800200, 0x00820200,
      0x80000000, 0x80820000, 0x00000200, 0x80020200,
      ];
use constant des_SPtrans_1 =>
    [ # Nibble 1
      0x10042004, 0x00000000, 0x00042000, 0x10040000,
      0x10000004, 0x00002004, 0x10002000, 0x00042000,
      0x00002000, 0x10040004, 0x00000004, 0x10002000,
      0x00040004, 0x10042000, 0x10040000, 0x00000004,
      0x00040000, 0x10002004, 0x10040004, 0x00002000,
      0x00042004, 0x10000000, 0x00000000, 0x00040004,
      0x10002004, 0x00042004, 0x10042000, 0x10000004,
      0x10000000, 0x00040000, 0x00002004, 0x10042004,
      0x00040004, 0x10042000, 0x10002000, 0x00042004,
      0x10042004, 0x00040004, 0x10000004, 0x00000000,
      0x10000000, 0x00002004, 0x00040000, 0x10040004,
      0x00002000, 0x10000000, 0x00042004, 0x10002004,
      0x10042000, 0x00002000, 0x00000000, 0x10000004,
      0x00000004, 0x10042004, 0x00042000, 0x10040000,
      0x10040004, 0x00040000, 0x00002004, 0x10002000,
      0x10002004, 0x00000004, 0x10040000, 0x00042000,
      ];
use constant des_SPtrans_2 =>
    [ # Nibble 2
      0x41000000, 0x01010040, 0x00000040, 0x41000040,
      0x40010000, 0x01000000, 0x41000040, 0x00010040,
      0x01000040, 0x00010000, 0x01010000, 0x40000000,
      0x41010040, 0x40000040, 0x40000000, 0x41010000,
      0x00000000, 0x40010000, 0x01010040, 0x00000040,
      0x40000040, 0x41010040, 0x00010000, 0x41000000,
      0x41010000, 0x01000040, 0x40010040, 0x01010000,
      0x00010040, 0x00000000, 0x01000000, 0x40010040,
      0x01010040, 0x00000040, 0x40000000, 0x00010000,
      0x40000040, 0x40010000, 0x01010000, 0x41000040,
      0x00000000, 0x01010040, 0x00010040, 0x41010000,
      0x40010000, 0x01000000, 0x41010040, 0x40000000,
      0x40010040, 0x41000000, 0x01000000, 0x41010040,
      0x00010000, 0x01000040, 0x41000040, 0x00010040,

DES_PP.m4  view on Meta::CPAN

    my ($t, $u);
    
    my ($l, $r) = unpack "VV", $input;
    usage ("at least 8 byte key") unless defined $r;
    
    PERM_OP4($r, $l, $t);
    PERM_OP16($l, $r, $t);
    PERM_OP2($r, $l, $t);
    PERM_OP8($l, $r, $t);
    PERM_OP1($r, $l, $t);
    
    $t = ($r << 1) | (($r >> 31) & 0x1);
    $r = ($l << 1) | (($l >> 31) & 0x1);
    $l = $t;
    
    # Clear the top bits on machines with 8byte longs.
    $l &= 0xffffffff;
    $r &= 0xffffffff;
    
    my @s = unpack ("V32", $ks);
    my $i;
    
    if ($encrypt) {
	for ($i = 0; $i < 32; $i += 4) {
	    D_ENCRYPT($l, $r, ($i + 0));
	    D_ENCRYPT($r, $l, ($i + 2));
	}
    } else {
	for ($i = 30; $i > 0; $i -= 4) {
	    D_ENCRYPT($l, $r, ($i - 0));
	    D_ENCRYPT($r, $l, ($i - 2));
	}		
    }
    
    $l = (($l >> 1) & 0x7fffffff) | ($l << 31);
    $r = (($r >> 1) & 0x7fffffff) | ($r << 31);
    # Clear the top bits on machines with 8byte longs.
    $l &= 0xffffffff;
    $r &= 0xffffffff;
    
    # Swap $l and $r.
    # We will not do the swap so just remember they are
    # Reversed for the rest of the subroutine
    # Luckily FP fixes this problem :-)
    
    PERM_OP1($r, $l, $t);
    PERM_OP8($l, $r, $t);
    PERM_OP2($r, $l, $t);
    PERM_OP16($l, $r, $t);
    PERM_OP4($r, $l, $t);
    
    pack "VV", $l, $r;
}

1;

__END__

=head1 NAME

Crypt::DES_PP - Perl extension for DES encryption

=head1 SYNOPSIS

use Crypt::DES_PP;

    $des = Crypt::DES_PP->new ($key);
    $cipher = $des->encrypt ($plain);
    $plain = $des->decrypt ($cipher);
    $blocksize = $des->blocksize;
    $keysize = $des->keysize;

=head1 DESCRIPTION

The Data Encryption Standard (DES), also known as Data Encryption 
Algorithm  (DEA) is a semi-strong encryption and decryption algorithm.  

The module is 100 % compatible to Crypt::DES but is implemented 
entirely in Perl.  That means that you do not need a C compiler to 
build and install this extension.  

The module implements the Crypt::CBC interface.  You are encouraged
to read the documentation for Crypt::CBC if you intend to use this
module for Cipher Block Chaining.

The minimum (and maximum) key size is 8 bytes.  Shorter keys will
cause an exception, longer keys will get silently truncated.  Data
is encrypted and decrypted in blocks of 8 bytes.

The module implements the Ultra-Fast-Crypt (UFC) algorithm as found
for example in the GNU libc.  On the Perl side a lot has been done
in order to make the module as fast as possible (function inlining,
use integer, ...).

Note: For performance issues the source code for the module is
first preprocessed by m4.  That means that you need an m4 macro
processor in order to hack on the sources.  This is of no concern
for you if you only want to use the module, the preprocessed output
is always included in the distribution.

=head1 BUGS

Nothing known.  The module has not been tested on 64 bit architectures.

=head1 AUTHOR

This implementation was written by Guido Flohr (guido@imperia.net).
It is available under the terms of the Lesser GNU General Public
License (LGPL) version 2 or - at your choice - any later version,
see the file ``COPYING.LIB''.

The original C implementation of the Ultra-Fast-Crypt algorithm
was written by Michael Glad (glad@daimi.aau.dk) and has been donated to 
the Free Software Foundation, Inc.  It is covered by the GNU library 
license version 2, see the file ``COPYING.LIB''.

=head1 SEE ALSO

Crypt::CBC(3), Crypt::DES(3), perl(1), m4(1).

=cut

Local Variables:
mode: perl
perl-indent-level: 4
perl-continued-statement-offset: 4
perl-continued-brace-offset: 0
perl-brace-offset: -4
perl-brace-imaginary-offset: 0
perl-label-offset: -4
tab-width: 4
End: