1m4_dnl -*- perl -*-
2m4_dnl
3m4_dnl Run this file through "m4 -P" to create the Perl module "DES_PP.pm"!
4m4_dnl
5m4_dnl When implementing cryptographic algorithms you really have the
6m4_dnl choice between readability and poor performance.  One major
7m4_dnl caveat that imposes a considerable performance penalty is the
8m4_dnl lack of inline functions (resp. preprocessor macros) in Perl.
9m4_dnl
10m4_dnl To circumevent these difficulties, earlier versions of this
11m4_dnl file contained C preprocessor directives but that approach was
12m4_dnl discarded for several reasons:
13m4_dnl
14m4_dnl o The code after the macro expansion is mostly illegible which
15m4_dnl   is undesirable when only the expanded code gets installed.
16m4_dnl
17m4_dnl o Every here and then spurious errors occur because Perl comments
18m4_dnl   are mistakenly interpreted as preprocessor directives.
19m4_dnl
20m4_dnl o There is neither a standard name nor a standard invocation for
21m4_dnl   the C preprocessor.  This problem could be partly solved by
22m4_dnl   including Config.pm in Makefile.PL and inquiring the invocation
23m4_dnl   syntax from "$Config{cpprun}".  Unfortunately, many people
24m4_dnl   have not compiled the Perl interpreter on their own but
25m4_dnl   have installed a pre-comupiled binary instead.  Under these
26m4_dnl   circumstances the variable "$Config{cpprun}" can only inform
27m4_dnl   about the preprocessor invocation on your vendor's build
28m4_dnl   machine that was valid at the time that the Perl interpreter
29m4_dnl   was compiled.         ' Dear St. Emacs, will you ever learn?
30m4_dnl
31m4_dnl Using m4 instead of the C preprocessor looks much more attractive.
32m4_dnl None of the above disadvantages apply.  M4 leaves you infinite
33m4_dnl control on the output (it is for example not possible to create
34m4_dnl a file with a hash bang in the very first line without the help
35m4_dnl of extra tools with the preprocessor).  M4 has been designed
36m4_dnl exactly for purposes like this, thus making it relatively
37m4_dnl straightforward to  avoid conflicts between m4 code interpretation
38m4_dnl and Perl code interpretation.  Finally the m4 syntax is pretty much
39m4_dnl standardized compared to the numerous pitfalls that C preprocessor
40m4_dnl syntax provides (think of string concatenation, spaces between
41m4_dnl the hash sign and the directive, ...).  In brief, m4 is better
42m4_dnl for preprocessing Perl code just for the same reasons that GNU
43m4_dnl autoconf is better than X11 imake. ;-)
44m4_dnl
45m4_dnl One additional advantage of m4 over the C preprocessor is the
46m4_dnl ability to unroll loops (although it turned out that Perl
47m4_dnl itself is much smarter about loops than you would think).
48m4_dnl
49m4_dnl As you might have quessed already, this m4 source file has to
50m4_dnl be called with the command line option ``-P'' in order to
51m4_dnl to work.
52m4_dnl
53m4_dnl Enough of m4/cpp advocacy, here we go:
54m4_dnl
55m4_dnl Change the quoting character to prevent unintended quoting.
56m4_changequote(`[m4[', `]m4]')m4_dnl Make emacs happy '
57m4_dnl
58# -*- perl -*-
59# DES_PP.pm - Pure perl implementation of DES.
60#
61# The master file for the module is DES_PP.m4 which needs to be run through
62# the m4.  Please edit DES_PP.m4 if you need to modify!
63
64package Crypt::DES_PP;
65
66use strict;
67use Carp;
68use integer;
69
70use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
71
72require Exporter;
73
74@ISA = qw (Exporter);
75@EXPORT = qw ();
76@EXPORT_OK = qw ();
77$VERSION = '1.00';
78
79use constant BLKSIZE => 8;
80
81# Stolen from Crypt::DES.
82sub usage {
83    my ($package, $filename, $line, $subr) = caller (1);
84    $Carp::CarpLevel = 2;
85    croak "Usage: $subr (@_)";
86}
87
88sub blocksize () { BLKSIZE };
89sub keysize () { BLKSIZE };
90
91sub expand_key ($);
92sub crypt ($$$);
93
94sub new {
95    usage ("new Crypt::DES_PP key")
96	unless @_ == 2;
97    my ($package, $key) = @_;
98
99    bless { ks => Crypt::DES_PP::expand_key ($key) }, $package;
100}
101
102sub encrypt {
103    usage ("encrypt data[8 bytes]") unless @_ == 2;
104
105    my ($self,$data) = @_;
106    return Crypt::DES_PP::crypt ($data, $self->{ks}, 1);
107}
108
109sub decrypt {
110    usage("decrypt data[8 bytes]") unless @_ == 2;
111
112    my ($self,$data) = @_;
113    return Crypt::DES_PP::crypt ($data, $self->{ks}, 0);
114}
115
116use constant ITERATIONS => 16;
117
118# These used to be a single reference to an array of array references.
119# Splitting them up into distinct constants slightly improves performance.
120use constant des_SPtrans_0 =>
121    [ # Nibble 0
122      0x00820200, 0x00020000, 0x80800000, 0x80820200,
123      0x00800000, 0x80020200, 0x80020000, 0x80800000,
124      0x80020200, 0x00820200, 0x00820000, 0x80000200,
125      0x80800200, 0x00800000, 0x00000000, 0x80020000,
126      0x00020000, 0x80000000, 0x00800200, 0x00020200,
127      0x80820200, 0x00820000, 0x80000200, 0x00800200,
128      0x80000000, 0x00000200, 0x00020200, 0x80820000,
129      0x00000200, 0x80800200, 0x80820000, 0x00000000,
130      0x00000000, 0x80820200, 0x00800200, 0x80020000,
131      0x00820200, 0x00020000, 0x80000200, 0x00800200,
132      0x80820000, 0x00000200, 0x00020200, 0x80800000,
133      0x80020200, 0x80000000, 0x80800000, 0x00820000,
134      0x80820200, 0x00020200, 0x00820000, 0x80800200,
135      0x00800000, 0x80000200, 0x80020000, 0x00000000,
136      0x00020000, 0x00800000, 0x80800200, 0x00820200,
137      0x80000000, 0x80820000, 0x00000200, 0x80020200,
138      ];
139use constant des_SPtrans_1 =>
140    [ # Nibble 1
141      0x10042004, 0x00000000, 0x00042000, 0x10040000,
142      0x10000004, 0x00002004, 0x10002000, 0x00042000,
143      0x00002000, 0x10040004, 0x00000004, 0x10002000,
144      0x00040004, 0x10042000, 0x10040000, 0x00000004,
145      0x00040000, 0x10002004, 0x10040004, 0x00002000,
146      0x00042004, 0x10000000, 0x00000000, 0x00040004,
147      0x10002004, 0x00042004, 0x10042000, 0x10000004,
148      0x10000000, 0x00040000, 0x00002004, 0x10042004,
149      0x00040004, 0x10042000, 0x10002000, 0x00042004,
150      0x10042004, 0x00040004, 0x10000004, 0x00000000,
151      0x10000000, 0x00002004, 0x00040000, 0x10040004,
152      0x00002000, 0x10000000, 0x00042004, 0x10002004,
153      0x10042000, 0x00002000, 0x00000000, 0x10000004,
154      0x00000004, 0x10042004, 0x00042000, 0x10040000,
155      0x10040004, 0x00040000, 0x00002004, 0x10002000,
156      0x10002004, 0x00000004, 0x10040000, 0x00042000,
157      ];
158use constant des_SPtrans_2 =>
159    [ # Nibble 2
160      0x41000000, 0x01010040, 0x00000040, 0x41000040,
161      0x40010000, 0x01000000, 0x41000040, 0x00010040,
162      0x01000040, 0x00010000, 0x01010000, 0x40000000,
163      0x41010040, 0x40000040, 0x40000000, 0x41010000,
164      0x00000000, 0x40010000, 0x01010040, 0x00000040,
165      0x40000040, 0x41010040, 0x00010000, 0x41000000,
166      0x41010000, 0x01000040, 0x40010040, 0x01010000,
167      0x00010040, 0x00000000, 0x01000000, 0x40010040,
168      0x01010040, 0x00000040, 0x40000000, 0x00010000,
169      0x40000040, 0x40010000, 0x01010000, 0x41000040,
170      0x00000000, 0x01010040, 0x00010040, 0x41010000,
171      0x40010000, 0x01000000, 0x41010040, 0x40000000,
172      0x40010040, 0x41000000, 0x01000000, 0x41010040,
173      0x00010000, 0x01000040, 0x41000040, 0x00010040,
174      0x01000040, 0x00000000, 0x41010000, 0x40000040,
175      0x41000000, 0x40010040, 0x00000040, 0x01010000,
176      ];
177use constant des_SPtrans_3 =>
178    [ # Nibble 3
179      0x00100402, 0x04000400, 0x00000002, 0x04100402,
180      0x00000000, 0x04100000, 0x04000402, 0x00100002,
181      0x04100400, 0x04000002, 0x04000000, 0x00000402,
182      0x04000002, 0x00100402, 0x00100000, 0x04000000,
183      0x04100002, 0x00100400, 0x00000400, 0x00000002,
184      0x00100400, 0x04000402, 0x04100000, 0x00000400,
185      0x00000402, 0x00000000, 0x00100002, 0x04100400,
186      0x04000400, 0x04100002, 0x04100402, 0x00100000,
187      0x04100002, 0x00000402, 0x00100000, 0x04000002,
188      0x00100400, 0x04000400, 0x00000002, 0x04100000,
189      0x04000402, 0x00000000, 0x00000400, 0x00100002,
190      0x00000000, 0x04100002, 0x04100400, 0x00000400,
191      0x04000000, 0x04100402, 0x00100402, 0x00100000,
192      0x04100402, 0x00000002, 0x04000400, 0x00100402,
193      0x00100002, 0x00100400, 0x04100000, 0x04000402,
194      0x00000402, 0x04000000, 0x04000002, 0x04100400,
195      ];
196use constant des_SPtrans_4 =>
197    [ # Nibble 4
198      0x02000000, 0x00004000, 0x00000100, 0x02004108,
199      0x02004008, 0x02000100, 0x00004108, 0x02004000,
200      0x00004000, 0x00000008, 0x02000008, 0x00004100,
201      0x02000108, 0x02004008, 0x02004100, 0x00000000,
202      0x00004100, 0x02000000, 0x00004008, 0x00000108,
203      0x02000100, 0x00004108, 0x00000000, 0x02000008,
204      0x00000008, 0x02000108, 0x02004108, 0x00004008,
205      0x02004000, 0x00000100, 0x00000108, 0x02004100,
206      0x02004100, 0x02000108, 0x00004008, 0x02004000,
207      0x00004000, 0x00000008, 0x02000008, 0x02000100,
208      0x02000000, 0x00004100, 0x02004108, 0x00000000,
209      0x00004108, 0x02000000, 0x00000100, 0x00004008,
210      0x02000108, 0x00000100, 0x00000000, 0x02004108,
211      0x02004008, 0x02004100, 0x00000108, 0x00004000,
212      0x00004100, 0x02004008, 0x02000100, 0x00000108,
213      0x00000008, 0x00004108, 0x02004000, 0x02000008,
214      ];
215use constant des_SPtrans_5 =>
216    [ # Nibble 5
217      0x20000010, 0x00080010, 0x00000000, 0x20080800,
218      0x00080010, 0x00000800, 0x20000810, 0x00080000,
219      0x00000810, 0x20080810, 0x00080800, 0x20000000,
220      0x20000800, 0x20000010, 0x20080000, 0x00080810,
221      0x00080000, 0x20000810, 0x20080010, 0x00000000,
222      0x00000800, 0x00000010, 0x20080800, 0x20080010,
223      0x20080810, 0x20080000, 0x20000000, 0x00000810,
224      0x00000010, 0x00080800, 0x00080810, 0x20000800,
225      0x00000810, 0x20000000, 0x20000800, 0x00080810,
226      0x20080800, 0x00080010, 0x00000000, 0x20000800,
227      0x20000000, 0x00000800, 0x20080010, 0x00080000,
228      0x00080010, 0x20080810, 0x00080800, 0x00000010,
229      0x20080810, 0x00080800, 0x00080000, 0x20000810,
230      0x20000010, 0x20080000, 0x00080810, 0x00000000,
231      0x00000800, 0x20000010, 0x20000810, 0x20080800,
232      0x20080000, 0x00000810, 0x00000010, 0x20080010,
233      ];
234use constant des_SPtrans_6 =>
235    [ # Nibble 6
236      0x00001000, 0x00000080, 0x00400080, 0x00400001,
237      0x00401081, 0x00001001, 0x00001080, 0x00000000,
238      0x00400000, 0x00400081, 0x00000081, 0x00401000,
239      0x00000001, 0x00401080, 0x00401000, 0x00000081,
240      0x00400081, 0x00001000, 0x00001001, 0x00401081,
241      0x00000000, 0x00400080, 0x00400001, 0x00001080,
242      0x00401001, 0x00001081, 0x00401080, 0x00000001,
243      0x00001081, 0x00401001, 0x00000080, 0x00400000,
244      0x00001081, 0x00401000, 0x00401001, 0x00000081,
245      0x00001000, 0x00000080, 0x00400000, 0x00401001,
246      0x00400081, 0x00001081, 0x00001080, 0x00000000,
247      0x00000080, 0x00400001, 0x00000001, 0x00400080,
248      0x00000000, 0x00400081, 0x00400080, 0x00001080,
249      0x00000081, 0x00001000, 0x00401081, 0x00400000,
250      0x00401080, 0x00000001, 0x00001001, 0x00401081,
251      0x00400001, 0x00401080, 0x00401000, 0x00001001,
252      ];
253use constant des_SPtrans_7 =>
254    [ # Nibble 7
255      0x08200020, 0x08208000, 0x00008020, 0x00000000,
256      0x08008000, 0x00200020, 0x08200000, 0x08208020,
257      0x00000020, 0x08000000, 0x00208000, 0x00008020,
258      0x00208020, 0x08008020, 0x08000020, 0x08200000,
259      0x00008000, 0x00208020, 0x00200020, 0x08008000,
260      0x08208020, 0x08000020, 0x00000000, 0x00208000,
261      0x08000000, 0x00200000, 0x08008020, 0x08200020,
262      0x00200000, 0x00008000, 0x08208000, 0x00000020,
263      0x00200000, 0x00008000, 0x08000020, 0x08208020,
264      0x00008020, 0x08000000, 0x00000000, 0x00208000,
265      0x08200020, 0x08008020, 0x08008000, 0x00200020,
266      0x08208000, 0x00000020, 0x00200020, 0x08008000,
267      0x08208020, 0x00200000, 0x08200000, 0x08000020,
268      0x00208000, 0x00008020, 0x08008020, 0x08200000,
269      0x00000020, 0x08208000, 0x00208020, 0x00000000,
270      0x08000000, 0x08200020, 0x00008000, 0x00208020,
271      ];
272
273# These have also been split up.
274use constant des_skb_0 =>
275    [ # For C bits (numbered as per FIPS 46) 1 2 3 4 5 6.
276      0x00000000, 0x00000010, 0x20000000, 0x20000010,
277      0x00010000, 0x00010010, 0x20010000, 0x20010010,
278      0x00000800, 0x00000810, 0x20000800, 0x20000810,
279      0x00010800, 0x00010810, 0x20010800, 0x20010810,
280      0x00000020, 0x00000030, 0x20000020, 0x20000030,
281      0x00010020, 0x00010030, 0x20010020, 0x20010030,
282      0x00000820, 0x00000830, 0x20000820, 0x20000830,
283      0x00010820, 0x00010830, 0x20010820, 0x20010830,
284      0x00080000, 0x00080010, 0x20080000, 0x20080010,
285      0x00090000, 0x00090010, 0x20090000, 0x20090010,
286      0x00080800, 0x00080810, 0x20080800, 0x20080810,
287      0x00090800, 0x00090810, 0x20090800, 0x20090810,
288      0x00080020, 0x00080030, 0x20080020, 0x20080030,
289      0x00090020, 0x00090030, 0x20090020, 0x20090030,
290      0x00080820, 0x00080830, 0x20080820, 0x20080830,
291      0x00090820, 0x00090830, 0x20090820, 0x20090830,
292      ];
293use constant des_skb_1 =>
294    [ # For C bits (numbered as per FIPS 46) 7 8 10 11 12 13
295      0x00000000, 0x02000000, 0x00002000, 0x02002000,
296      0x00200000, 0x02200000, 0x00202000, 0x02202000,
297      0x00000004, 0x02000004, 0x00002004, 0x02002004,
298      0x00200004, 0x02200004, 0x00202004, 0x02202004,
299      0x00000400, 0x02000400, 0x00002400, 0x02002400,
300      0x00200400, 0x02200400, 0x00202400, 0x02202400,
301      0x00000404, 0x02000404, 0x00002404, 0x02002404,
302      0x00200404, 0x02200404, 0x00202404, 0x02202404,
303      0x10000000, 0x12000000, 0x10002000, 0x12002000,
304      0x10200000, 0x12200000, 0x10202000, 0x12202000,
305      0x10000004, 0x12000004, 0x10002004, 0x12002004,
306      0x10200004, 0x12200004, 0x10202004, 0x12202004,
307      0x10000400, 0x12000400, 0x10002400, 0x12002400,
308      0x10200400, 0x12200400, 0x10202400, 0x12202400,
309      0x10000404, 0x12000404, 0x10002404, 0x12002404,
310      0x10200404, 0x12200404, 0x10202404, 0x12202404,
311      ];
312use constant des_skb_2 =>
313    [ # For C bits (numbered as per FIPS 46) 14 15 16 17 19 20
314      0x00000000, 0x00000001, 0x00040000, 0x00040001,
315      0x01000000, 0x01000001, 0x01040000, 0x01040001,
316      0x00000002, 0x00000003, 0x00040002, 0x00040003,
317      0x01000002, 0x01000003, 0x01040002, 0x01040003,
318      0x00000200, 0x00000201, 0x00040200, 0x00040201,
319      0x01000200, 0x01000201, 0x01040200, 0x01040201,
320      0x00000202, 0x00000203, 0x00040202, 0x00040203,
321      0x01000202, 0x01000203, 0x01040202, 0x01040203,
322      0x08000000, 0x08000001, 0x08040000, 0x08040001,
323      0x09000000, 0x09000001, 0x09040000, 0x09040001,
324      0x08000002, 0x08000003, 0x08040002, 0x08040003,
325      0x09000002, 0x09000003, 0x09040002, 0x09040003,
326      0x08000200, 0x08000201, 0x08040200, 0x08040201,
327      0x09000200, 0x09000201, 0x09040200, 0x09040201,
328      0x08000202, 0x08000203, 0x08040202, 0x08040203,
329      0x09000202, 0x09000203, 0x09040202, 0x09040203,
330      ];
331use constant des_skb_3 =>
332    [ # For C bits (numbered as per FIPS 46) 21 23 24 26 27 28
333      0x00000000, 0x00100000, 0x00000100, 0x00100100,
334      0x00000008, 0x00100008, 0x00000108, 0x00100108,
335      0x00001000, 0x00101000, 0x00001100, 0x00101100,
336      0x00001008, 0x00101008, 0x00001108, 0x00101108,
337      0x04000000, 0x04100000, 0x04000100, 0x04100100,
338      0x04000008, 0x04100008, 0x04000108, 0x04100108,
339      0x04001000, 0x04101000, 0x04001100, 0x04101100,
340      0x04001008, 0x04101008, 0x04001108, 0x04101108,
341      0x00020000, 0x00120000, 0x00020100, 0x00120100,
342      0x00020008, 0x00120008, 0x00020108, 0x00120108,
343      0x00021000, 0x00121000, 0x00021100, 0x00121100,
344      0x00021008, 0x00121008, 0x00021108, 0x00121108,
345      0x04020000, 0x04120000, 0x04020100, 0x04120100,
346      0x04020008, 0x04120008, 0x04020108, 0x04120108,
347      0x04021000, 0x04121000, 0x04021100, 0x04121100,
348      0x04021008, 0x04121008, 0x04021108, 0x04121108,
349      ];
350use constant des_skb_4 =>
351    [ # For D bits (numbered as per FIPS 46) 1 2 3 4 5 6
352      0x00000000, 0x10000000, 0x00010000, 0x10010000,
353      0x00000004, 0x10000004, 0x00010004, 0x10010004,
354      0x20000000, 0x30000000, 0x20010000, 0x30010000,
355      0x20000004, 0x30000004, 0x20010004, 0x30010004,
356      0x00100000, 0x10100000, 0x00110000, 0x10110000,
357      0x00100004, 0x10100004, 0x00110004, 0x10110004,
358      0x20100000, 0x30100000, 0x20110000, 0x30110000,
359      0x20100004, 0x30100004, 0x20110004, 0x30110004,
360      0x00001000, 0x10001000, 0x00011000, 0x10011000,
361      0x00001004, 0x10001004, 0x00011004, 0x10011004,
362      0x20001000, 0x30001000, 0x20011000, 0x30011000,
363      0x20001004, 0x30001004, 0x20011004, 0x30011004,
364      0x00101000, 0x10101000, 0x00111000, 0x10111000,
365      0x00101004, 0x10101004, 0x00111004, 0x10111004,
366      0x20101000, 0x30101000, 0x20111000, 0x30111000,
367      0x20101004, 0x30101004, 0x20111004, 0x30111004,
368      ];
369use constant des_skb_5 =>
370    [ # For D bits (numbered as per FIPS 46) 8 9 11 12 13 14
371      0x00000000, 0x08000000, 0x00000008, 0x08000008,
372      0x00000400, 0x08000400, 0x00000408, 0x08000408,
373      0x00020000, 0x08020000, 0x00020008, 0x08020008,
374      0x00020400, 0x08020400, 0x00020408, 0x08020408,
375      0x00000001, 0x08000001, 0x00000009, 0x08000009,
376      0x00000401, 0x08000401, 0x00000409, 0x08000409,
377      0x00020001, 0x08020001, 0x00020009, 0x08020009,
378      0x00020401, 0x08020401, 0x00020409, 0x08020409,
379      0x02000000, 0x0A000000, 0x02000008, 0x0A000008,
380      0x02000400, 0x0A000400, 0x02000408, 0x0A000408,
381      0x02020000, 0x0A020000, 0x02020008, 0x0A020008,
382      0x02020400, 0x0A020400, 0x02020408, 0x0A020408,
383      0x02000001, 0x0A000001, 0x02000009, 0x0A000009,
384      0x02000401, 0x0A000401, 0x02000409, 0x0A000409,
385      0x02020001, 0x0A020001, 0x02020009, 0x0A020009,
386      0x02020401, 0x0A020401, 0x02020409, 0x0A020409,
387      ];
388use constant des_skb_6 =>
389    [ # For D bits (numbered as per FIPS 46) 16 17 18 19 20 21
390      0x00000000, 0x00000100, 0x00080000, 0x00080100,
391      0x01000000, 0x01000100, 0x01080000, 0x01080100,
392      0x00000010, 0x00000110, 0x00080010, 0x00080110,
393      0x01000010, 0x01000110, 0x01080010, 0x01080110,
394      0x00200000, 0x00200100, 0x00280000, 0x00280100,
395      0x01200000, 0x01200100, 0x01280000, 0x01280100,
396      0x00200010, 0x00200110, 0x00280010, 0x00280110,
397      0x01200010, 0x01200110, 0x01280010, 0x01280110,
398      0x00000200, 0x00000300, 0x00080200, 0x00080300,
399      0x01000200, 0x01000300, 0x01080200, 0x01080300,
400      0x00000210, 0x00000310, 0x00080210, 0x00080310,
401      0x01000210, 0x01000310, 0x01080210, 0x01080310,
402      0x00200200, 0x00200300, 0x00280200, 0x00280300,
403      0x01200200, 0x01200300, 0x01280200, 0x01280300,
404      0x00200210, 0x00200310, 0x00280210, 0x00280310,
405      0x01200210, 0x01200310, 0x01280210, 0x01280310,
406      ];
407use constant des_skb_7 =>
408    [ # For D bits (numbered as per FIPS 46) 22 23 24 25 27 28
409      0x00000000, 0x04000000, 0x00040000, 0x04040000,
410      0x00000002, 0x04000002, 0x00040002, 0x04040002,
411      0x00002000, 0x04002000, 0x00042000, 0x04042000,
412      0x00002002, 0x04002002, 0x00042002, 0x04042002,
413      0x00000020, 0x04000020, 0x00040020, 0x04040020,
414      0x00000022, 0x04000022, 0x00040022, 0x04040022,
415      0x00002020, 0x04002020, 0x00042020, 0x04042020,
416      0x00002022, 0x04002022, 0x00042022, 0x04042022,
417      0x00000800, 0x04000800, 0x00040800, 0x04040800,
418      0x00000802, 0x04000802, 0x00040802, 0x04040802,
419      0x00002800, 0x04002800, 0x00042800, 0x04042800,
420      0x00002802, 0x04002802, 0x00042802, 0x04042802,
421      0x00000820, 0x04000820, 0x00040820, 0x04040820,
422      0x00000822, 0x04000822, 0x00040822, 0x04040822,
423      0x00002820, 0x04002820, 0x00042820, 0x04042820,
424      0x00002822, 0x04002822, 0x00042822, 0x04042822,
425      ];
426
427m4_dnl For enhanced readability all macro definitions are "unsafe",
428m4_dnl i. e. you may have to put parentheses or (m4!) quotes around the
429m4_dnl arguments in order to make the macro expand correctly.  For
430m4_dnl example calling the following macro like "rs(x, y - 1)" would
431m4_dnl be incorrect.  You either have to say "rs(x, [m4[ y - 1 ]m4])",
432m4_dnl or "rs(x, (y - 1))".
433m4_dnl
434m4_dnl Umh, this macro is not needed any longer.  I keep it here
435m4_dnl anyway because it may be useful in other modules.
436m4_dnl m4_define(rs, (($1 >> $2) &  RIGHT_SHIFT_MASK->[$2]))
437m4_dnl # Right-shifting in Perl with use integer is a little tricky.  In the
438m4_dnl # absence of unsigned data types, the sign is always preserved which
439m4_dnl # is undesirable in cryptographic applications.
440m4_dnl #use constant RIGHT_SHIFT_MASK =>
441m4_dnl #    [
442m4_dnl #     0xffffffff, 0x7fffffff, 0x3fffffff, 0x1fffffff,
443m4_dnl #     0x0fffffff, 0x07ffffff, 0x03ffffff, 0x01ffffff,
444m4_dnl #     0x00ffffff, 0x007fffff, 0x003fffff, 0x001fffff,
445m4_dnl #     0x000fffff, 0x0007ffff, 0x0003ffff, 0x0001ffff,
446m4_dnl #     0x0000ffff, 0x00007fff, 0x00003fff, 0x00001fff,
447m4_dnl #     0x00000fff, 0x000007ff, 0x000003ff, 0x000001ff,
448m4_dnl #     0x000000ff, 0x0000007f, 0x0000003f, 0x0000001f,
449m4_dnl #     0x0000000f, 0x00000007, 0x00000003, 0x00000001,
450m4_dnl #     ];
451m4_dnl
452m4_define(PERM_OP1,
453    $3 = (($1 >> 1) ^ $2) & 0x55555555;
454    $2 ^= $3;
455    $1 ^= $3 << 1)
456m4_define(PERM_OP2,
457    $3 = (($1 >> 2) ^ $2) & 0x33333333;
458    $2 ^= $3;
459    $1 ^= $3 << 2)
460m4_define(PERM_OP4,
461    $3 = (($1 >> 4) ^ $2) & 0x0f0f0f0f;
462    $2 ^= $3;
463    $1 ^= $3 << 4)
464m4_define(PERM_OP8,
465    $3 = (($1 >> 8) ^ $2) & 0x00ff00ff;
466    $2 ^= $3;
467    $1 ^= $3 << 8)
468m4_define(PERM_OP16,
469    $3 = (($1 >> 16) ^ $2) & 0x0000ffff;
470    $2 ^= $3;
471    $1 ^= $3 << 16)
472m4_define(HPERM_OP,
473    $2 = (($1 << 18) ^ $1) & 0xcccc0000;
474    $1 = $1 ^ $2 ^ (($2 >> 18) & 0x00003fff))
475
476sub expand_key ($) {
477    my ($c, $d) = unpack "VV", shift;
478
479    usage ("at least 8 byte key") unless defined $d;
480    my @k = ();
481
482    my ($t, $s);
483    PERM_OP4($d, $c,  $t);
484    HPERM_OP($c, $t);
485    HPERM_OP($d, $t);
486    PERM_OP1($d, $c,  $t);
487    PERM_OP8($c, $d,  $t);
488    PERM_OP1($d, $c,  $t);
489    $d =     ((($d & 0x000000ff) << 16) |  ($d & 0x0000ff00)     |
490	      (($d >> 16) & 0x000000ff) | (($c >> 4) & 0x0f000000));
491    $c &= 0x0fffffff;
492
493    use constant shifts2 => [0, 0, 1, 1, 1, 1, 1, 1,
494			     0, 1, 1, 1, 1, 1, 1, 0];
495
496    # Do not try to unroll any of the loops (not this one and not the
497    # one in crypt().  It will make things slower (about 30 %!).
498    foreach my $i (0 .. ITERATIONS - 1) {
499	# No need to mask out the sign here because only the
500	# lower 28 bits are used.
501	if (shifts2->[$i]) {
502	    $c = (($c >> 2) | ($c << 26));
503	    $d = (($d >> 2) | ($d << 26));
504	} else {
505	    $c= (($c >> 1) | ($c << 27));
506	    $d= (($d >> 1) | ($d << 27));
507	}
508	$c &= 0x0fffffff;
509	$d &= 0x0fffffff;
510
511	$s = (des_skb_0->[($c) & 0x3f] |
512	      des_skb_1->[(($c >>  6) & 0x03) |
513			  (($c >>  7) & 0x3c)] |
514	      des_skb_2->[(($c >> 13) & 0x0f) |
515			  (($c >> 14) & 0x30)] |
516	      des_skb_3->[(($c >> 20) & 0x01) |
517			  (($c >> 21) & 0x06) |
518			  (($c >> 22) & 0x38)]);
519	$t = (des_skb_4->[($d) & 0x3f] |
520	      des_skb_5->[(($d >>  7) & 0x03) |
521			  (($d >>  8) & 0x3c)] |
522	      des_skb_6->[ ($d >> 15) & 0x3f] |
523	      des_skb_7->[(($d >> 21) & 0x0f) |
524			  (($d >> 22) & 0x30)]);
525
526	$k[$i << 1] = (($t << 16) | ($s & 0x0000ffff)) & 0xffffffff;
527	$s = ((($s >> 16) & 0x0000ffff) | ($t & 0xffff0000));
528
529	$s = ($s << 4) | (($s >> 28) & 0x0fffffff);
530	$k[($i << 1) + 1] = $s & 0xffffffff;
531    }
532    pack ("V*", @k);
533}
534
535m4_define(D_ENCRYPT,
536            $u  = ($2 ^ $s[$3    ]);
537	    $t =   $2 ^ $s[$3 + 1];
538	    $t = (($t >> 4) & 0x0fffffff) | ($t << 28);
539	    $1 ^= des_SPtrans_1->[($t      ) & 0x3f]|
540	          des_SPtrans_3->[($t >>  8) & 0x3f]|
541	          des_SPtrans_5->[($t >> 16) & 0x3f]|
542	          des_SPtrans_7->[($t >> 24) & 0x3f]|
543	          des_SPtrans_0->[($u      ) & 0x3f]|
544	          des_SPtrans_2->[($u >>  8) & 0x3f]|
545	          des_SPtrans_4->[($u >> 16) & 0x3f]|
546	          des_SPtrans_6->[($u >> 24) & 0x3f])
547sub crypt ($$$) {
548    my ($input, $ks, $encrypt) = @_;
549    my $output;
550
551    my ($t, $u);
552
553    my ($l, $r) = unpack "VV", $input;
554    usage ("at least 8 byte key") unless defined $r;
555
556    PERM_OP4($r, $l, $t);
557    PERM_OP16($l, $r, $t);
558    PERM_OP2($r, $l, $t);
559    PERM_OP8($l, $r, $t);
560    PERM_OP1($r, $l, $t);
561
562    $t = ($r << 1) | (($r >> 31) & 0x1);
563    $r = ($l << 1) | (($l >> 31) & 0x1);
564    $l = $t;
565
566    # Clear the top bits on machines with 8byte longs.
567    $l &= 0xffffffff;
568    $r &= 0xffffffff;
569
570    my @s = unpack ("V32", $ks);
571    my $i;
572
573    if ($encrypt) {
574	for ($i = 0; $i < 32; $i += 4) {
575	    D_ENCRYPT($l, $r, ($i + 0));
576	    D_ENCRYPT($r, $l, ($i + 2));
577	}
578    } else {
579	for ($i = 30; $i > 0; $i -= 4) {
580	    D_ENCRYPT($l, $r, ($i - 0));
581	    D_ENCRYPT($r, $l, ($i - 2));
582	}
583    }
584
585    $l = (($l >> 1) & 0x7fffffff) | ($l << 31);
586    $r = (($r >> 1) & 0x7fffffff) | ($r << 31);
587    # Clear the top bits on machines with 8byte longs.
588    $l &= 0xffffffff;
589    $r &= 0xffffffff;
590
591    # Swap $l and $r.
592    # We will not do the swap so just remember they are
593    # Reversed for the rest of the subroutine
594    # Luckily FP fixes this problem :-)
595
596    PERM_OP1($r, $l, $t);
597    PERM_OP8($l, $r, $t);
598    PERM_OP2($r, $l, $t);
599    PERM_OP16($l, $r, $t);
600    PERM_OP4($r, $l, $t);
601
602    pack "VV", $l, $r;
603}
604
6051;
606
607__END__
608
609=head1 NAME
610
611Crypt::DES_PP - Perl extension for DES encryption
612
613=head1 SYNOPSIS
614
615use Crypt::DES_PP;
616
617    $des = Crypt::DES_PP->new ($key);
618    $cipher = $des->encrypt ($plain);
619    $plain = $des->decrypt ($cipher);
620    $blocksize = $des->blocksize;
621    $keysize = $des->keysize;
622
623=head1 DESCRIPTION
624
625The Data Encryption Standard (DES), also known as Data Encryption
626Algorithm  (DEA) is a semi-strong encryption and decryption algorithm.
627
628The module is 100 % compatible to Crypt::DES but is implemented
629entirely in Perl.  That means that you do not need a C compiler to
630build and install this extension.
631
632The module implements the Crypt::CBC interface.  You are encouraged
633to read the documentation for Crypt::CBC if you intend to use this
634module for Cipher Block Chaining.
635
636The minimum (and maximum) key size is 8 bytes.  Shorter keys will
637cause an exception, longer keys will get silently truncated.  Data
638is encrypted and decrypted in blocks of 8 bytes.
639
640The module implements the Ultra-Fast-Crypt (UFC) algorithm as found
641for example in the GNU libc.  On the Perl side a lot has been done
642in order to make the module as fast as possible (function inlining,
643use integer, ...).
644
645Note: For performance issues the source code for the module is
646first preprocessed by m4.  That means that you need an m4 macro
647processor in order to hack on the sources.  This is of no concern
648for you if you only want to use the module, the preprocessed output
649is always included in the distribution.
650
651=head1 BUGS
652
653Nothing known.  The module has not been tested on 64 bit architectures.
654
655=head1 AUTHOR
656
657This implementation was written by Guido Flohr (guido@imperia.net).
658It is available under the terms of the Lesser GNU General Public
659License (LGPL) version 2 or - at your choice - any later version,
660see the file ``COPYING.LIB''.
661
662The original C implementation of the Ultra-Fast-Crypt algorithm
663was written by Michael Glad (glad@daimi.aau.dk) and has been donated to
664the Free Software Foundation, Inc.  It is covered by the GNU library
665license version 2, see the file ``COPYING.LIB''.
666
667=head1 SEE ALSO
668
669Crypt::CBC(3), Crypt::DES(3), perl(1), m4(1).
670
671=cut
672
673Local Variables:
674mode: perl
675perl-indent-level: 4
676perl-continued-statement-offset: 4
677perl-continued-brace-offset: 0
678perl-brace-offset: -4
679perl-brace-imaginary-offset: 0
680perl-label-offset: -4
681tab-width: 4
682End:
683