File Coverage

lib/Crypt/PPDES.pm
Criterion Covered Total %
statement 0 117 0.0
branch 0 4 0.0
condition n/a
subroutine 0 5 0.0
pod 0 5 0.0
total 0 131 0.0


line stmt bran cond sub pod time code
1             #!/usr/local/bin/perl
2             # Copyright (C) 1992 Eric Young
3             # des - eric young 22/11/1991 eay@psych.psy.uq.oz.au
4             # eay - 92/08/31 - I think I have fixed all problems for 64bit
5             # versions of perl but I could be wrong since I have not tested it yet :-).
6             #
7             # This is an implementation of DES in perl.
8             # The two routines (des_set_key and des_ecb_encrypt)
9             # take 8 byte objects as arguments.
10             #
11             # des_set_key takes an 8 byte string as a key and returns a key schedule
12             # for use in calls to des_ecb_encrypt.
13             # des_ecb_encrypt takes three arguments, the first is a key schedule
14             # (make sure to pass it by reference with the *), the second is 1
15             # to encrypt, 0 to decrypt. The third argument is an 8 byte object
16             # to encrypt. The function returns an 8 byte object that has been
17             # DES encrypted.
18             #
19             # example:
20             # require 'des'
21             #
22             # $key =pack("C8",0x12,0x23,0x45,0x67,0x89,0xab,0xcd,0xef);
23             # @ks= &des_set_key($key);
24             #
25             # $outbytes= &des_ecb_encrypt(*ks,1,$data);
26             # @enc =unpack("C8",$outbytes);
27             #
28             # Modified by Vipul Ved Prakash on 1st Aug 1999.
29              
30             package Crypt::PPDES;
31              
32             # The following 8 arrays are used in des_set_key
33             @skb0=(
34             # for C bits (numbered as per FIPS 46) 1 2 3 4 5 6
35             0x00000000,0x00000010,0x20000000,0x20000010,
36             0x00010000,0x00010010,0x20010000,0x20010010,
37             0x00000800,0x00000810,0x20000800,0x20000810,
38             0x00010800,0x00010810,0x20010800,0x20010810,
39             0x00000020,0x00000030,0x20000020,0x20000030,
40             0x00010020,0x00010030,0x20010020,0x20010030,
41             0x00000820,0x00000830,0x20000820,0x20000830,
42             0x00010820,0x00010830,0x20010820,0x20010830,
43             0x00080000,0x00080010,0x20080000,0x20080010,
44             0x00090000,0x00090010,0x20090000,0x20090010,
45             0x00080800,0x00080810,0x20080800,0x20080810,
46             0x00090800,0x00090810,0x20090800,0x20090810,
47             0x00080020,0x00080030,0x20080020,0x20080030,
48             0x00090020,0x00090030,0x20090020,0x20090030,
49             0x00080820,0x00080830,0x20080820,0x20080830,
50             0x00090820,0x00090830,0x20090820,0x20090830,
51             );
52             @skb1=(
53             # for C bits (numbered as per FIPS 46) 7 8 10 11 12 13
54             0x00000000,0x02000000,0x00002000,0x02002000,
55             0x00200000,0x02200000,0x00202000,0x02202000,
56             0x00000004,0x02000004,0x00002004,0x02002004,
57             0x00200004,0x02200004,0x00202004,0x02202004,
58             0x00000400,0x02000400,0x00002400,0x02002400,
59             0x00200400,0x02200400,0x00202400,0x02202400,
60             0x00000404,0x02000404,0x00002404,0x02002404,
61             0x00200404,0x02200404,0x00202404,0x02202404,
62             0x10000000,0x12000000,0x10002000,0x12002000,
63             0x10200000,0x12200000,0x10202000,0x12202000,
64             0x10000004,0x12000004,0x10002004,0x12002004,
65             0x10200004,0x12200004,0x10202004,0x12202004,
66             0x10000400,0x12000400,0x10002400,0x12002400,
67             0x10200400,0x12200400,0x10202400,0x12202400,
68             0x10000404,0x12000404,0x10002404,0x12002404,
69             0x10200404,0x12200404,0x10202404,0x12202404,
70             );
71             @skb2=(
72             # for C bits (numbered as per FIPS 46) 14 15 16 17 19 20
73             0x00000000,0x00000001,0x00040000,0x00040001,
74             0x01000000,0x01000001,0x01040000,0x01040001,
75             0x00000002,0x00000003,0x00040002,0x00040003,
76             0x01000002,0x01000003,0x01040002,0x01040003,
77             0x00000200,0x00000201,0x00040200,0x00040201,
78             0x01000200,0x01000201,0x01040200,0x01040201,
79             0x00000202,0x00000203,0x00040202,0x00040203,
80             0x01000202,0x01000203,0x01040202,0x01040203,
81             0x08000000,0x08000001,0x08040000,0x08040001,
82             0x09000000,0x09000001,0x09040000,0x09040001,
83             0x08000002,0x08000003,0x08040002,0x08040003,
84             0x09000002,0x09000003,0x09040002,0x09040003,
85             0x08000200,0x08000201,0x08040200,0x08040201,
86             0x09000200,0x09000201,0x09040200,0x09040201,
87             0x08000202,0x08000203,0x08040202,0x08040203,
88             0x09000202,0x09000203,0x09040202,0x09040203,
89             );
90             @skb3=(
91             # for C bits (numbered as per FIPS 46) 21 23 24 26 27 28
92             0x00000000,0x00100000,0x00000100,0x00100100,
93             0x00000008,0x00100008,0x00000108,0x00100108,
94             0x00001000,0x00101000,0x00001100,0x00101100,
95             0x00001008,0x00101008,0x00001108,0x00101108,
96             0x04000000,0x04100000,0x04000100,0x04100100,
97             0x04000008,0x04100008,0x04000108,0x04100108,
98             0x04001000,0x04101000,0x04001100,0x04101100,
99             0x04001008,0x04101008,0x04001108,0x04101108,
100             0x00020000,0x00120000,0x00020100,0x00120100,
101             0x00020008,0x00120008,0x00020108,0x00120108,
102             0x00021000,0x00121000,0x00021100,0x00121100,
103             0x00021008,0x00121008,0x00021108,0x00121108,
104             0x04020000,0x04120000,0x04020100,0x04120100,
105             0x04020008,0x04120008,0x04020108,0x04120108,
106             0x04021000,0x04121000,0x04021100,0x04121100,
107             0x04021008,0x04121008,0x04021108,0x04121108,
108             );
109             @skb4=(
110             # for D bits (numbered as per FIPS 46) 1 2 3 4 5 6
111             0x00000000,0x10000000,0x00010000,0x10010000,
112             0x00000004,0x10000004,0x00010004,0x10010004,
113             0x20000000,0x30000000,0x20010000,0x30010000,
114             0x20000004,0x30000004,0x20010004,0x30010004,
115             0x00100000,0x10100000,0x00110000,0x10110000,
116             0x00100004,0x10100004,0x00110004,0x10110004,
117             0x20100000,0x30100000,0x20110000,0x30110000,
118             0x20100004,0x30100004,0x20110004,0x30110004,
119             0x00001000,0x10001000,0x00011000,0x10011000,
120             0x00001004,0x10001004,0x00011004,0x10011004,
121             0x20001000,0x30001000,0x20011000,0x30011000,
122             0x20001004,0x30001004,0x20011004,0x30011004,
123             0x00101000,0x10101000,0x00111000,0x10111000,
124             0x00101004,0x10101004,0x00111004,0x10111004,
125             0x20101000,0x30101000,0x20111000,0x30111000,
126             0x20101004,0x30101004,0x20111004,0x30111004,
127             );
128             @skb5=(
129             # for D bits (numbered as per FIPS 46) 8 9 11 12 13 14
130             0x00000000,0x08000000,0x00000008,0x08000008,
131             0x00000400,0x08000400,0x00000408,0x08000408,
132             0x00020000,0x08020000,0x00020008,0x08020008,
133             0x00020400,0x08020400,0x00020408,0x08020408,
134             0x00000001,0x08000001,0x00000009,0x08000009,
135             0x00000401,0x08000401,0x00000409,0x08000409,
136             0x00020001,0x08020001,0x00020009,0x08020009,
137             0x00020401,0x08020401,0x00020409,0x08020409,
138             0x02000000,0x0A000000,0x02000008,0x0A000008,
139             0x02000400,0x0A000400,0x02000408,0x0A000408,
140             0x02020000,0x0A020000,0x02020008,0x0A020008,
141             0x02020400,0x0A020400,0x02020408,0x0A020408,
142             0x02000001,0x0A000001,0x02000009,0x0A000009,
143             0x02000401,0x0A000401,0x02000409,0x0A000409,
144             0x02020001,0x0A020001,0x02020009,0x0A020009,
145             0x02020401,0x0A020401,0x02020409,0x0A020409,
146             );
147             @skb6=(
148             # for D bits (numbered as per FIPS 46) 16 17 18 19 20 21
149             0x00000000,0x00000100,0x00080000,0x00080100,
150             0x01000000,0x01000100,0x01080000,0x01080100,
151             0x00000010,0x00000110,0x00080010,0x00080110,
152             0x01000010,0x01000110,0x01080010,0x01080110,
153             0x00200000,0x00200100,0x00280000,0x00280100,
154             0x01200000,0x01200100,0x01280000,0x01280100,
155             0x00200010,0x00200110,0x00280010,0x00280110,
156             0x01200010,0x01200110,0x01280010,0x01280110,
157             0x00000200,0x00000300,0x00080200,0x00080300,
158             0x01000200,0x01000300,0x01080200,0x01080300,
159             0x00000210,0x00000310,0x00080210,0x00080310,
160             0x01000210,0x01000310,0x01080210,0x01080310,
161             0x00200200,0x00200300,0x00280200,0x00280300,
162             0x01200200,0x01200300,0x01280200,0x01280300,
163             0x00200210,0x00200310,0x00280210,0x00280310,
164             0x01200210,0x01200310,0x01280210,0x01280310,
165             );
166             @skb7=(
167             # for D bits (numbered as per FIPS 46) 22 23 24 25 27 28
168             0x00000000,0x04000000,0x00040000,0x04040000,
169             0x00000002,0x04000002,0x00040002,0x04040002,
170             0x00002000,0x04002000,0x00042000,0x04042000,
171             0x00002002,0x04002002,0x00042002,0x04042002,
172             0x00000020,0x04000020,0x00040020,0x04040020,
173             0x00000022,0x04000022,0x00040022,0x04040022,
174             0x00002020,0x04002020,0x00042020,0x04042020,
175             0x00002022,0x04002022,0x00042022,0x04042022,
176             0x00000800,0x04000800,0x00040800,0x04040800,
177             0x00000802,0x04000802,0x00040802,0x04040802,
178             0x00002800,0x04002800,0x00042800,0x04042800,
179             0x00002802,0x04002802,0x00042802,0x04042802,
180             0x00000820,0x04000820,0x00040820,0x04040820,
181             0x00000822,0x04000822,0x00040822,0x04040822,
182             0x00002820,0x04002820,0x00042820,0x04042820,
183             0x00002822,0x04002822,0x00042822,0x04042822,
184             );
185              
186             @shifts2=(0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0);
187              
188             # used in ecb_encrypt
189             @SP0=(
190             0x00410100, 0x00010000, 0x40400000, 0x40410100,
191             0x00400000, 0x40010100, 0x40010000, 0x40400000,
192             0x40010100, 0x00410100, 0x00410000, 0x40000100,
193             0x40400100, 0x00400000, 0x00000000, 0x40010000,
194             0x00010000, 0x40000000, 0x00400100, 0x00010100,
195             0x40410100, 0x00410000, 0x40000100, 0x00400100,
196             0x40000000, 0x00000100, 0x00010100, 0x40410000,
197             0x00000100, 0x40400100, 0x40410000, 0x00000000,
198             0x00000000, 0x40410100, 0x00400100, 0x40010000,
199             0x00410100, 0x00010000, 0x40000100, 0x00400100,
200             0x40410000, 0x00000100, 0x00010100, 0x40400000,
201             0x40010100, 0x40000000, 0x40400000, 0x00410000,
202             0x40410100, 0x00010100, 0x00410000, 0x40400100,
203             0x00400000, 0x40000100, 0x40010000, 0x00000000,
204             0x00010000, 0x00400000, 0x40400100, 0x00410100,
205             0x40000000, 0x40410000, 0x00000100, 0x40010100,
206             );
207             @SP1=(
208             0x08021002, 0x00000000, 0x00021000, 0x08020000,
209             0x08000002, 0x00001002, 0x08001000, 0x00021000,
210             0x00001000, 0x08020002, 0x00000002, 0x08001000,
211             0x00020002, 0x08021000, 0x08020000, 0x00000002,
212             0x00020000, 0x08001002, 0x08020002, 0x00001000,
213             0x00021002, 0x08000000, 0x00000000, 0x00020002,
214             0x08001002, 0x00021002, 0x08021000, 0x08000002,
215             0x08000000, 0x00020000, 0x00001002, 0x08021002,
216             0x00020002, 0x08021000, 0x08001000, 0x00021002,
217             0x08021002, 0x00020002, 0x08000002, 0x00000000,
218             0x08000000, 0x00001002, 0x00020000, 0x08020002,
219             0x00001000, 0x08000000, 0x00021002, 0x08001002,
220             0x08021000, 0x00001000, 0x00000000, 0x08000002,
221             0x00000002, 0x08021002, 0x00021000, 0x08020000,
222             0x08020002, 0x00020000, 0x00001002, 0x08001000,
223             0x08001002, 0x00000002, 0x08020000, 0x00021000,
224             );
225             @SP2=(
226             0x20800000, 0x00808020, 0x00000020, 0x20800020,
227             0x20008000, 0x00800000, 0x20800020, 0x00008020,
228             0x00800020, 0x00008000, 0x00808000, 0x20000000,
229             0x20808020, 0x20000020, 0x20000000, 0x20808000,
230             0x00000000, 0x20008000, 0x00808020, 0x00000020,
231             0x20000020, 0x20808020, 0x00008000, 0x20800000,
232             0x20808000, 0x00800020, 0x20008020, 0x00808000,
233             0x00008020, 0x00000000, 0x00800000, 0x20008020,
234             0x00808020, 0x00000020, 0x20000000, 0x00008000,
235             0x20000020, 0x20008000, 0x00808000, 0x20800020,
236             0x00000000, 0x00808020, 0x00008020, 0x20808000,
237             0x20008000, 0x00800000, 0x20808020, 0x20000000,
238             0x20008020, 0x20800000, 0x00800000, 0x20808020,
239             0x00008000, 0x00800020, 0x20800020, 0x00008020,
240             0x00800020, 0x00000000, 0x20808000, 0x20000020,
241             0x20800000, 0x20008020, 0x00000020, 0x00808000,
242             );
243             @SP3=(
244             0x00080201, 0x02000200, 0x00000001, 0x02080201,
245             0x00000000, 0x02080000, 0x02000201, 0x00080001,
246             0x02080200, 0x02000001, 0x02000000, 0x00000201,
247             0x02000001, 0x00080201, 0x00080000, 0x02000000,
248             0x02080001, 0x00080200, 0x00000200, 0x00000001,
249             0x00080200, 0x02000201, 0x02080000, 0x00000200,
250             0x00000201, 0x00000000, 0x00080001, 0x02080200,
251             0x02000200, 0x02080001, 0x02080201, 0x00080000,
252             0x02080001, 0x00000201, 0x00080000, 0x02000001,
253             0x00080200, 0x02000200, 0x00000001, 0x02080000,
254             0x02000201, 0x00000000, 0x00000200, 0x00080001,
255             0x00000000, 0x02080001, 0x02080200, 0x00000200,
256             0x02000000, 0x02080201, 0x00080201, 0x00080000,
257             0x02080201, 0x00000001, 0x02000200, 0x00080201,
258             0x00080001, 0x00080200, 0x02080000, 0x02000201,
259             0x00000201, 0x02000000, 0x02000001, 0x02080200,
260             );
261             @SP4=(
262             0x01000000, 0x00002000, 0x00000080, 0x01002084,
263             0x01002004, 0x01000080, 0x00002084, 0x01002000,
264             0x00002000, 0x00000004, 0x01000004, 0x00002080,
265             0x01000084, 0x01002004, 0x01002080, 0x00000000,
266             0x00002080, 0x01000000, 0x00002004, 0x00000084,
267             0x01000080, 0x00002084, 0x00000000, 0x01000004,
268             0x00000004, 0x01000084, 0x01002084, 0x00002004,
269             0x01002000, 0x00000080, 0x00000084, 0x01002080,
270             0x01002080, 0x01000084, 0x00002004, 0x01002000,
271             0x00002000, 0x00000004, 0x01000004, 0x01000080,
272             0x01000000, 0x00002080, 0x01002084, 0x00000000,
273             0x00002084, 0x01000000, 0x00000080, 0x00002004,
274             0x01000084, 0x00000080, 0x00000000, 0x01002084,
275             0x01002004, 0x01002080, 0x00000084, 0x00002000,
276             0x00002080, 0x01002004, 0x01000080, 0x00000084,
277             0x00000004, 0x00002084, 0x01002000, 0x01000004,
278             );
279             @SP5=(
280             0x10000008, 0x00040008, 0x00000000, 0x10040400,
281             0x00040008, 0x00000400, 0x10000408, 0x00040000,
282             0x00000408, 0x10040408, 0x00040400, 0x10000000,
283             0x10000400, 0x10000008, 0x10040000, 0x00040408,
284             0x00040000, 0x10000408, 0x10040008, 0x00000000,
285             0x00000400, 0x00000008, 0x10040400, 0x10040008,
286             0x10040408, 0x10040000, 0x10000000, 0x00000408,
287             0x00000008, 0x00040400, 0x00040408, 0x10000400,
288             0x00000408, 0x10000000, 0x10000400, 0x00040408,
289             0x10040400, 0x00040008, 0x00000000, 0x10000400,
290             0x10000000, 0x00000400, 0x10040008, 0x00040000,
291             0x00040008, 0x10040408, 0x00040400, 0x00000008,
292             0x10040408, 0x00040400, 0x00040000, 0x10000408,
293             0x10000008, 0x10040000, 0x00040408, 0x00000000,
294             0x00000400, 0x10000008, 0x10000408, 0x10040400,
295             0x10040000, 0x00000408, 0x00000008, 0x10040008,
296             );
297             @SP6=(
298             0x00000800, 0x00000040, 0x00200040, 0x80200000,
299             0x80200840, 0x80000800, 0x00000840, 0x00000000,
300             0x00200000, 0x80200040, 0x80000040, 0x00200800,
301             0x80000000, 0x00200840, 0x00200800, 0x80000040,
302             0x80200040, 0x00000800, 0x80000800, 0x80200840,
303             0x00000000, 0x00200040, 0x80200000, 0x00000840,
304             0x80200800, 0x80000840, 0x00200840, 0x80000000,
305             0x80000840, 0x80200800, 0x00000040, 0x00200000,
306             0x80000840, 0x00200800, 0x80200800, 0x80000040,
307             0x00000800, 0x00000040, 0x00200000, 0x80200800,
308             0x80200040, 0x80000840, 0x00000840, 0x00000000,
309             0x00000040, 0x80200000, 0x80000000, 0x00200040,
310             0x00000000, 0x80200040, 0x00200040, 0x00000840,
311             0x80000040, 0x00000800, 0x80200840, 0x00200000,
312             0x00200840, 0x80000000, 0x80000800, 0x80200840,
313             0x80200000, 0x00200840, 0x00200800, 0x80000800,
314             );
315             @SP7=(
316             0x04100010, 0x04104000, 0x00004010, 0x00000000,
317             0x04004000, 0x00100010, 0x04100000, 0x04104010,
318             0x00000010, 0x04000000, 0x00104000, 0x00004010,
319             0x00104010, 0x04004010, 0x04000010, 0x04100000,
320             0x00004000, 0x00104010, 0x00100010, 0x04004000,
321             0x04104010, 0x04000010, 0x00000000, 0x00104000,
322             0x04000000, 0x00100000, 0x04004010, 0x04100010,
323             0x00100000, 0x00004000, 0x04104000, 0x00000010,
324             0x00100000, 0x00004000, 0x04000010, 0x04104010,
325             0x00004010, 0x04000000, 0x00000000, 0x00104000,
326             0x04100010, 0x04004010, 0x04004000, 0x00100010,
327             0x04104000, 0x00000010, 0x00100010, 0x04004000,
328             0x04104010, 0x00100000, 0x04100000, 0x04000010,
329             0x00104000, 0x00004010, 0x04004010, 0x04100000,
330             0x00000010, 0x04104000, 0x00104010, 0x00000000,
331             0x04000000, 0x04100010, 0x00004000, 0x00104010,
332             );
333              
334             sub des_set_key
335             {
336 0     0 0   local($param)=@_;
337 0           local(@key);
338 0           local($c,$d,$i,$s,$t);
339 0           local(@ks)=();
340              
341             # Get the bytes in the order we want.
342 0           @key=unpack("C8",$param);
343 0           push (@key, 0,0,0,0,0,0,0,0);
344              
345 0           $c= ($key[0] )|
346             ($key[1]<< 8)|
347             ($key[2]<<16)|
348             ($key[3]<<24);
349 0           $d= ($key[4] )|
350             ($key[5]<< 8)|
351             ($key[6]<<16)|
352             ($key[7]<<24);
353              
354 0           &doPC1(*c,*d);
355              
356 0           for $i (@shifts2)
357             {
358 0 0         if ($i)
359             {
360 0           $c=($c>>2)|($c<<26);
361 0           $d=($d>>2)|($d<<26);
362             }
363             else
364             {
365 0           $c=($c>>1)|($c<<27);
366 0           $d=($d>>1)|($d<<27);
367             }
368 0           $c&=0x0fffffff;
369 0           $d&=0x0fffffff;
370 0           $s= $skb0[ ($c )&0x3f ]|
371             $skb1[(($c>> 6)&0x03)|(($c>> 7)&0x3c)]|
372             $skb2[(($c>>13)&0x0f)|(($c>>14)&0x30)]|
373             $skb3[(($c>>20)&0x01)|(($c>>21)&0x06) |
374             (($c>>22)&0x38)];
375 0           $t= $skb4[ ($d )&0x3f ]|
376             $skb5[(($d>> 7)&0x03)|(($d>> 8)&0x3c)]|
377             $skb6[ ($d>>15)&0x3f ]|
378             $skb7[(($d>>21)&0x0f)|(($d>>22)&0x30)];
379 0           push(@ks,(($t<<16)|($s&0x0000ffff))&0xffffffff);
380 0           $s= ($s>>16)|($t&0xffff0000) ;
381 0           push(@ks,(($s<<4)|($s>>28))&0xffffffff);
382             }
383 0           @ks;
384             }
385              
386             sub doPC1
387             {
388 0     0 0   local(*a,*b)=@_;
389 0           local($t);
390              
391 0           $t=(($b>>4)^$a)&0x0f0f0f0f;
392 0           $b^=($t<<4); $a^=$t;
  0            
393             # do $a first
394 0           $t=(($a<<18)^$a)&0xcccc0000;
395 0           $a=$a^$t^($t>>18);
396 0           $t=(($a<<17)^$a)&0xaaaa0000;
397 0           $a=$a^$t^($t>>17);
398 0           $t=(($a<< 8)^$a)&0x00ff0000;
399 0           $a=$a^$t^($t>> 8);
400 0           $t=(($a<<17)^$a)&0xaaaa0000;
401 0           $a=$a^$t^($t>>17);
402              
403             # now do $b
404 0           $t=(($b<<24)^$b)&0xff000000;
405 0           $b=$b^$t^($t>>24);
406 0           $t=(($b<< 8)^$b)&0x00ff0000;
407 0           $b=$b^$t^($t>> 8);
408 0           $t=(($b<<14)^$b)&0x33330000;
409 0           $b=$b^$t^($t>>14);
410 0           $b=(($b&0x00aa00aa)<<7)|(($b&0x55005500)>>7)|($b&0xaa55aa55);
411 0           $b=($b>>8)|(($a&0xf0000000)>>4);
412 0           $a&=0x0fffffff;
413             }
414              
415             sub doIP
416             {
417 0     0 0   local(*a,*b)=@_;
418 0           local($t);
419              
420 0           $t=(($b>> 4)^$a)&0x0f0f0f0f;
421 0           $b^=($t<< 4); $a^=$t;
  0            
422 0           $t=(($a>>16)^$b)&0x0000ffff;
423 0           $a^=($t<<16); $b^=$t;
  0            
424 0           $t=(($b>> 2)^$a)&0x33333333;
425 0           $b^=($t<< 2); $a^=$t;
  0            
426 0           $t=(($a>> 8)^$b)&0x00ff00ff;
427 0           $a^=($t<< 8); $b^=$t;
  0            
428 0           $t=(($b>> 1)^$a)&0x55555555;
429 0           $b^=($t<< 1); $a^=$t;
  0            
430 0           $t=$a;
431 0           $a=$b&0xffffffff;
432 0           $b=$t&0xffffffff;
433             }
434              
435             sub doFP
436             {
437 0     0 0   local(*a,*b)=@_;
438 0           local($t);
439              
440 0           $t=(($b>> 1)^$a)&0x55555555;
441 0           $b^=($t<< 1); $a^=$t;
  0            
442 0           $t=(($a>> 8)^$b)&0x00ff00ff;
443 0           $a^=($t<< 8); $b^=$t;
  0            
444 0           $t=(($b>> 2)^$a)&0x33333333;
445 0           $b^=($t<< 2); $a^=$t;
  0            
446 0           $t=(($a>>16)^$b)&0x0000ffff;
447 0           $a^=($t<<16); $b^=$t;
  0            
448 0           $t=(($b>> 4)^$a)&0x0f0f0f0f;
449 0           $b^=($t<< 4); $a^=$t;
  0            
450 0           $a&=0xffffffff;
451 0           $b&=0xffffffff;
452             }
453              
454             sub des_ecb_encrypt
455             {
456 0     0 0   local(*ks,$encrypt,$in)=@_;
457 0           local($l,$r,$inc,$start,$end,$i,$t,$u,@input);
458            
459 0           @input=unpack("C8",$in);
460             # Get the bytes in the order we want.
461 0           $l= ($input[0] )|
462             ($input[1]<< 8)|
463             ($input[2]<<16)|
464             ($input[3]<<24);
465 0           $r= ($input[4] )|
466             ($input[5]<< 8)|
467             ($input[6]<<16)|
468             ($input[7]<<24);
469              
470 0           $l&=0xffffffff;
471 0           $r&=0xffffffff;
472 0           &doIP(*l,*r);
473 0 0         if ($encrypt)
474             {
475 0           for ($i=0; $i<32; $i+=4)
476             {
477 0           $t=(($r<<1)|($r>>31))&0xffffffff;
478 0           $u=$t^$ks[$i ];
479 0           $t=$t^$ks[$i+1];
480 0           $t=(($t>>4)|($t<<28))&0xffffffff;
481 0           $l^= $SP1[ $t &0x3f]|
482             $SP3[($t>> 8)&0x3f]|
483             $SP5[($t>>16)&0x3f]|
484             $SP7[($t>>24)&0x3f]|
485             $SP0[ $u &0x3f]|
486             $SP2[($u>> 8)&0x3f]|
487             $SP4[($u>>16)&0x3f]|
488             $SP6[($u>>24)&0x3f];
489              
490 0           $t=(($l<<1)|($l>>31))&0xffffffff;
491 0           $u=$t^$ks[$i+2];
492 0           $t=$t^$ks[$i+3];
493 0           $t=(($t>>4)|($t<<28))&0xffffffff;
494 0           $r^= $SP1[ $t &0x3f]|
495             $SP3[($t>> 8)&0x3f]|
496             $SP5[($t>>16)&0x3f]|
497             $SP7[($t>>24)&0x3f]|
498             $SP0[ $u &0x3f]|
499             $SP2[($u>> 8)&0x3f]|
500             $SP4[($u>>16)&0x3f]|
501             $SP6[($u>>24)&0x3f];
502             }
503             }
504             else
505             {
506 0           for ($i=30; $i>0; $i-=4)
507             {
508 0           $t=(($r<<1)|($r>>31))&0xffffffff;
509 0           $u=$t^$ks[$i ];
510 0           $t=$t^$ks[$i+1];
511 0           $t=(($t>>4)|($t<<28))&0xffffffff;
512 0           $l^= $SP1[ $t &0x3f]|
513             $SP3[($t>> 8)&0x3f]|
514             $SP5[($t>>16)&0x3f]|
515             $SP7[($t>>24)&0x3f]|
516             $SP0[ $u &0x3f]|
517             $SP2[($u>> 8)&0x3f]|
518             $SP4[($u>>16)&0x3f]|
519             $SP6[($u>>24)&0x3f];
520              
521 0           $t=(($l<<1)|($l>>31))&0xffffffff;
522 0           $u=$t^$ks[$i-2];
523 0           $t=$t^$ks[$i-1];
524 0           $t=(($t>>4)|($t<<28))&0xffffffff;
525 0           $r^= $SP1[ $t &0x3f]|
526             $SP3[($t>> 8)&0x3f]|
527             $SP5[($t>>16)&0x3f]|
528             $SP7[($t>>24)&0x3f]|
529             $SP0[ $u &0x3f]|
530             $SP2[($u>> 8)&0x3f]|
531             $SP4[($u>>16)&0x3f]|
532             $SP6[($u>>24)&0x3f];
533             }
534             }
535 0           &doFP(*l,*r);
536 0           pack("C8",$l&0xff,$l>>8,$l>>16,$l>>24,
537             $r&0xff,$r>>8,$r>>16,$r>>24);
538             }
539              
540             "True Value";
541