source: main/trunk/greenstone2/perllib/cpan/Crypt/UnixCrypt.pm@ 31781

Last change on this file since 31781 was 11113, checked in by mdewsnip, 18 years ago

Pure Perl version of the crypt function, used by cgi-bin/gliserver.pl. (The version of Perl included with Greenstone on Windows doesn't have crypt built-in).
  • Property svn:keywords set to Author Date Id Revision
File size: 23.9 KB
Line 
1package Crypt::UnixCrypt;
2
3use 5.004; # i.e. not tested under earlier versions
4use strict;
5use vars qw($VERSION @ISA @EXPORT $OVERRIDE_BUILTIN);
6
7$VERSION = '1.0';
8
9require Exporter;
10@ISA = qw(Exporter);
11
12# Don't override built-in crypt() unless forced to to so
13use Config;
14@EXPORT = qw(crypt)
15 if !defined $Config{d_crypt} ||
16 (defined $OVERRIDE_BUILTIN && $OVERRIDE_BUILTIN);
17
18
19my $ITERATIONS = 16;
20
21my @con_salt =
22(
23 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
24 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
25 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
26 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
27 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
28 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01,
29 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09,
30 0x0A, 0x0B, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0A,
31 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, 0x10, 0x11, 0x12,
32 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1A,
33 0x1B, 0x1C, 0x1D, 0x1E, 0x1F, 0x20, 0x21, 0x22,
34 0x23, 0x24, 0x25, 0x20, 0x21, 0x22, 0x23, 0x24,
35 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x2B, 0x2C,
36 0x2D, 0x2E, 0x2F, 0x30, 0x31, 0x32, 0x33, 0x34,
37 0x35, 0x36, 0x37, 0x38, 0x39, 0x3A, 0x3B, 0x3C,
38 0x3D, 0x3E, 0x3F, 0x00, 0x00, 0x00, 0x00, 0x00,
39);
40
41my @shifts2 =
42(
43 0, 0, 1, 1, 1, 1, 1, 1,
44 0, 1, 1, 1, 1, 1, 1, 0
45);
46
47my @skb0 =
48(
49 # for C bits (numbered as per FIPS 46) 1 2 3 4 5 6
50 0x00000000, 0x00000010, 0x20000000, 0x20000010,
51 0x00010000, 0x00010010, 0x20010000, 0x20010010,
52 0x00000800, 0x00000810, 0x20000800, 0x20000810,
53 0x00010800, 0x00010810, 0x20010800, 0x20010810,
54 0x00000020, 0x00000030, 0x20000020, 0x20000030,
55 0x00010020, 0x00010030, 0x20010020, 0x20010030,
56 0x00000820, 0x00000830, 0x20000820, 0x20000830,
57 0x00010820, 0x00010830, 0x20010820, 0x20010830,
58 0x00080000, 0x00080010, 0x20080000, 0x20080010,
59 0x00090000, 0x00090010, 0x20090000, 0x20090010,
60 0x00080800, 0x00080810, 0x20080800, 0x20080810,
61 0x00090800, 0x00090810, 0x20090800, 0x20090810,
62 0x00080020, 0x00080030, 0x20080020, 0x20080030,
63 0x00090020, 0x00090030, 0x20090020, 0x20090030,
64 0x00080820, 0x00080830, 0x20080820, 0x20080830,
65 0x00090820, 0x00090830, 0x20090820, 0x20090830,
66);
67my @skb1 =
68(
69 # for C bits (numbered as per FIPS 46) 7 8 10 11 12 13
70 0x00000000, 0x02000000, 0x00002000, 0x02002000,
71 0x00200000, 0x02200000, 0x00202000, 0x02202000,
72 0x00000004, 0x02000004, 0x00002004, 0x02002004,
73 0x00200004, 0x02200004, 0x00202004, 0x02202004,
74 0x00000400, 0x02000400, 0x00002400, 0x02002400,
75 0x00200400, 0x02200400, 0x00202400, 0x02202400,
76 0x00000404, 0x02000404, 0x00002404, 0x02002404,
77 0x00200404, 0x02200404, 0x00202404, 0x02202404,
78 0x10000000, 0x12000000, 0x10002000, 0x12002000,
79 0x10200000, 0x12200000, 0x10202000, 0x12202000,
80 0x10000004, 0x12000004, 0x10002004, 0x12002004,
81 0x10200004, 0x12200004, 0x10202004, 0x12202004,
82 0x10000400, 0x12000400, 0x10002400, 0x12002400,
83 0x10200400, 0x12200400, 0x10202400, 0x12202400,
84 0x10000404, 0x12000404, 0x10002404, 0x12002404,
85 0x10200404, 0x12200404, 0x10202404, 0x12202404,
86);
87my @skb2 =
88(
89 # for C bits (numbered as per FIPS 46) 14 15 16 17 19 20
90 0x00000000, 0x00000001, 0x00040000, 0x00040001,
91 0x01000000, 0x01000001, 0x01040000, 0x01040001,
92 0x00000002, 0x00000003, 0x00040002, 0x00040003,
93 0x01000002, 0x01000003, 0x01040002, 0x01040003,
94 0x00000200, 0x00000201, 0x00040200, 0x00040201,
95 0x01000200, 0x01000201, 0x01040200, 0x01040201,
96 0x00000202, 0x00000203, 0x00040202, 0x00040203,
97 0x01000202, 0x01000203, 0x01040202, 0x01040203,
98 0x08000000, 0x08000001, 0x08040000, 0x08040001,
99 0x09000000, 0x09000001, 0x09040000, 0x09040001,
100 0x08000002, 0x08000003, 0x08040002, 0x08040003,
101 0x09000002, 0x09000003, 0x09040002, 0x09040003,
102 0x08000200, 0x08000201, 0x08040200, 0x08040201,
103 0x09000200, 0x09000201, 0x09040200, 0x09040201,
104 0x08000202, 0x08000203, 0x08040202, 0x08040203,
105 0x09000202, 0x09000203, 0x09040202, 0x09040203,
106);
107my @skb3 =
108(
109 # for C bits (numbered as per FIPS 46) 21 23 24 26 27 28
110 0x00000000, 0x00100000, 0x00000100, 0x00100100,
111 0x00000008, 0x00100008, 0x00000108, 0x00100108,
112 0x00001000, 0x00101000, 0x00001100, 0x00101100,
113 0x00001008, 0x00101008, 0x00001108, 0x00101108,
114 0x04000000, 0x04100000, 0x04000100, 0x04100100,
115 0x04000008, 0x04100008, 0x04000108, 0x04100108,
116 0x04001000, 0x04101000, 0x04001100, 0x04101100,
117 0x04001008, 0x04101008, 0x04001108, 0x04101108,
118 0x00020000, 0x00120000, 0x00020100, 0x00120100,
119 0x00020008, 0x00120008, 0x00020108, 0x00120108,
120 0x00021000, 0x00121000, 0x00021100, 0x00121100,
121 0x00021008, 0x00121008, 0x00021108, 0x00121108,
122 0x04020000, 0x04120000, 0x04020100, 0x04120100,
123 0x04020008, 0x04120008, 0x04020108, 0x04120108,
124 0x04021000, 0x04121000, 0x04021100, 0x04121100,
125 0x04021008, 0x04121008, 0x04021108, 0x04121108,
126);
127my @skb4 =
128(
129 # for D bits (numbered as per FIPS 46) 1 2 3 4 5 6
130 0x00000000, 0x10000000, 0x00010000, 0x10010000,
131 0x00000004, 0x10000004, 0x00010004, 0x10010004,
132 0x20000000, 0x30000000, 0x20010000, 0x30010000,
133 0x20000004, 0x30000004, 0x20010004, 0x30010004,
134 0x00100000, 0x10100000, 0x00110000, 0x10110000,
135 0x00100004, 0x10100004, 0x00110004, 0x10110004,
136 0x20100000, 0x30100000, 0x20110000, 0x30110000,
137 0x20100004, 0x30100004, 0x20110004, 0x30110004,
138 0x00001000, 0x10001000, 0x00011000, 0x10011000,
139 0x00001004, 0x10001004, 0x00011004, 0x10011004,
140 0x20001000, 0x30001000, 0x20011000, 0x30011000,
141 0x20001004, 0x30001004, 0x20011004, 0x30011004,
142 0x00101000, 0x10101000, 0x00111000, 0x10111000,
143 0x00101004, 0x10101004, 0x00111004, 0x10111004,
144 0x20101000, 0x30101000, 0x20111000, 0x30111000,
145 0x20101004, 0x30101004, 0x20111004, 0x30111004,
146);
147my @skb5 =
148(
149 # for D bits (numbered as per FIPS 46) 8 9 11 12 13 14
150 0x00000000, 0x08000000, 0x00000008, 0x08000008,
151 0x00000400, 0x08000400, 0x00000408, 0x08000408,
152 0x00020000, 0x08020000, 0x00020008, 0x08020008,
153 0x00020400, 0x08020400, 0x00020408, 0x08020408,
154 0x00000001, 0x08000001, 0x00000009, 0x08000009,
155 0x00000401, 0x08000401, 0x00000409, 0x08000409,
156 0x00020001, 0x08020001, 0x00020009, 0x08020009,
157 0x00020401, 0x08020401, 0x00020409, 0x08020409,
158 0x02000000, 0x0A000000, 0x02000008, 0x0A000008,
159 0x02000400, 0x0A000400, 0x02000408, 0x0A000408,
160 0x02020000, 0x0A020000, 0x02020008, 0x0A020008,
161 0x02020400, 0x0A020400, 0x02020408, 0x0A020408,
162 0x02000001, 0x0A000001, 0x02000009, 0x0A000009,
163 0x02000401, 0x0A000401, 0x02000409, 0x0A000409,
164 0x02020001, 0x0A020001, 0x02020009, 0x0A020009,
165 0x02020401, 0x0A020401, 0x02020409, 0x0A020409,
166);
167my @skb6 =
168(
169 # for D bits (numbered as per FIPS 46) 16 17 18 19 20 21
170 0x00000000, 0x00000100, 0x00080000, 0x00080100,
171 0x01000000, 0x01000100, 0x01080000, 0x01080100,
172 0x00000010, 0x00000110, 0x00080010, 0x00080110,
173 0x01000010, 0x01000110, 0x01080010, 0x01080110,
174 0x00200000, 0x00200100, 0x00280000, 0x00280100,
175 0x01200000, 0x01200100, 0x01280000, 0x01280100,
176 0x00200010, 0x00200110, 0x00280010, 0x00280110,
177 0x01200010, 0x01200110, 0x01280010, 0x01280110,
178 0x00000200, 0x00000300, 0x00080200, 0x00080300,
179 0x01000200, 0x01000300, 0x01080200, 0x01080300,
180 0x00000210, 0x00000310, 0x00080210, 0x00080310,
181 0x01000210, 0x01000310, 0x01080210, 0x01080310,
182 0x00200200, 0x00200300, 0x00280200, 0x00280300,
183 0x01200200, 0x01200300, 0x01280200, 0x01280300,
184 0x00200210, 0x00200310, 0x00280210, 0x00280310,
185 0x01200210, 0x01200310, 0x01280210, 0x01280310,
186);
187my @skb7 =
188(
189 # for D bits (numbered as per FIPS 46) 22 23 24 25 27 28
190 0x00000000, 0x04000000, 0x00040000, 0x04040000,
191 0x00000002, 0x04000002, 0x00040002, 0x04040002,
192 0x00002000, 0x04002000, 0x00042000, 0x04042000,
193 0x00002002, 0x04002002, 0x00042002, 0x04042002,
194 0x00000020, 0x04000020, 0x00040020, 0x04040020,
195 0x00000022, 0x04000022, 0x00040022, 0x04040022,
196 0x00002020, 0x04002020, 0x00042020, 0x04042020,
197 0x00002022, 0x04002022, 0x00042022, 0x04042022,
198 0x00000800, 0x04000800, 0x00040800, 0x04040800,
199 0x00000802, 0x04000802, 0x00040802, 0x04040802,
200 0x00002800, 0x04002800, 0x00042800, 0x04042800,
201 0x00002802, 0x04002802, 0x00042802, 0x04042802,
202 0x00000820, 0x04000820, 0x00040820, 0x04040820,
203 0x00000822, 0x04000822, 0x00040822, 0x04040822,
204 0x00002820, 0x04002820, 0x00042820, 0x04042820,
205 0x00002822, 0x04002822, 0x00042822, 0x04042822,
206);
207
208my @SPtrans0 =
209(
210 # nibble 0
211 0x00820200, 0x00020000, 0x80800000, 0x80820200,
212 0x00800000, 0x80020200, 0x80020000, 0x80800000,
213 0x80020200, 0x00820200, 0x00820000, 0x80000200,
214 0x80800200, 0x00800000, 0x00000000, 0x80020000,
215 0x00020000, 0x80000000, 0x00800200, 0x00020200,
216 0x80820200, 0x00820000, 0x80000200, 0x00800200,
217 0x80000000, 0x00000200, 0x00020200, 0x80820000,
218 0x00000200, 0x80800200, 0x80820000, 0x00000000,
219 0x00000000, 0x80820200, 0x00800200, 0x80020000,
220 0x00820200, 0x00020000, 0x80000200, 0x00800200,
221 0x80820000, 0x00000200, 0x00020200, 0x80800000,
222 0x80020200, 0x80000000, 0x80800000, 0x00820000,
223 0x80820200, 0x00020200, 0x00820000, 0x80800200,
224 0x00800000, 0x80000200, 0x80020000, 0x00000000,
225 0x00020000, 0x00800000, 0x80800200, 0x00820200,
226 0x80000000, 0x80820000, 0x00000200, 0x80020200,
227);
228my @SPtrans1 =
229(
230 # nibble 1
231 0x10042004, 0x00000000, 0x00042000, 0x10040000,
232 0x10000004, 0x00002004, 0x10002000, 0x00042000,
233 0x00002000, 0x10040004, 0x00000004, 0x10002000,
234 0x00040004, 0x10042000, 0x10040000, 0x00000004,
235 0x00040000, 0x10002004, 0x10040004, 0x00002000,
236 0x00042004, 0x10000000, 0x00000000, 0x00040004,
237 0x10002004, 0x00042004, 0x10042000, 0x10000004,
238 0x10000000, 0x00040000, 0x00002004, 0x10042004,
239 0x00040004, 0x10042000, 0x10002000, 0x00042004,
240 0x10042004, 0x00040004, 0x10000004, 0x00000000,
241 0x10000000, 0x00002004, 0x00040000, 0x10040004,
242 0x00002000, 0x10000000, 0x00042004, 0x10002004,
243 0x10042000, 0x00002000, 0x00000000, 0x10000004,
244 0x00000004, 0x10042004, 0x00042000, 0x10040000,
245 0x10040004, 0x00040000, 0x00002004, 0x10002000,
246 0x10002004, 0x00000004, 0x10040000, 0x00042000,
247);
248my @SPtrans2 =
249(
250 # nibble 2
251 0x41000000, 0x01010040, 0x00000040, 0x41000040,
252 0x40010000, 0x01000000, 0x41000040, 0x00010040,
253 0x01000040, 0x00010000, 0x01010000, 0x40000000,
254 0x41010040, 0x40000040, 0x40000000, 0x41010000,
255 0x00000000, 0x40010000, 0x01010040, 0x00000040,
256 0x40000040, 0x41010040, 0x00010000, 0x41000000,
257 0x41010000, 0x01000040, 0x40010040, 0x01010000,
258 0x00010040, 0x00000000, 0x01000000, 0x40010040,
259 0x01010040, 0x00000040, 0x40000000, 0x00010000,
260 0x40000040, 0x40010000, 0x01010000, 0x41000040,
261 0x00000000, 0x01010040, 0x00010040, 0x41010000,
262 0x40010000, 0x01000000, 0x41010040, 0x40000000,
263 0x40010040, 0x41000000, 0x01000000, 0x41010040,
264 0x00010000, 0x01000040, 0x41000040, 0x00010040,
265 0x01000040, 0x00000000, 0x41010000, 0x40000040,
266 0x41000000, 0x40010040, 0x00000040, 0x01010000,
267);
268my @SPtrans3 =
269(
270 # nibble 3
271 0x00100402, 0x04000400, 0x00000002, 0x04100402,
272 0x00000000, 0x04100000, 0x04000402, 0x00100002,
273 0x04100400, 0x04000002, 0x04000000, 0x00000402,
274 0x04000002, 0x00100402, 0x00100000, 0x04000000,
275 0x04100002, 0x00100400, 0x00000400, 0x00000002,
276 0x00100400, 0x04000402, 0x04100000, 0x00000400,
277 0x00000402, 0x00000000, 0x00100002, 0x04100400,
278 0x04000400, 0x04100002, 0x04100402, 0x00100000,
279 0x04100002, 0x00000402, 0x00100000, 0x04000002,
280 0x00100400, 0x04000400, 0x00000002, 0x04100000,
281 0x04000402, 0x00000000, 0x00000400, 0x00100002,
282 0x00000000, 0x04100002, 0x04100400, 0x00000400,
283 0x04000000, 0x04100402, 0x00100402, 0x00100000,
284 0x04100402, 0x00000002, 0x04000400, 0x00100402,
285 0x00100002, 0x00100400, 0x04100000, 0x04000402,
286 0x00000402, 0x04000000, 0x04000002, 0x04100400,
287);
288my @SPtrans4 =
289(
290 # nibble 4
291 0x02000000, 0x00004000, 0x00000100, 0x02004108,
292 0x02004008, 0x02000100, 0x00004108, 0x02004000,
293 0x00004000, 0x00000008, 0x02000008, 0x00004100,
294 0x02000108, 0x02004008, 0x02004100, 0x00000000,
295 0x00004100, 0x02000000, 0x00004008, 0x00000108,
296 0x02000100, 0x00004108, 0x00000000, 0x02000008,
297 0x00000008, 0x02000108, 0x02004108, 0x00004008,
298 0x02004000, 0x00000100, 0x00000108, 0x02004100,
299 0x02004100, 0x02000108, 0x00004008, 0x02004000,
300 0x00004000, 0x00000008, 0x02000008, 0x02000100,
301 0x02000000, 0x00004100, 0x02004108, 0x00000000,
302 0x00004108, 0x02000000, 0x00000100, 0x00004008,
303 0x02000108, 0x00000100, 0x00000000, 0x02004108,
304 0x02004008, 0x02004100, 0x00000108, 0x00004000,
305 0x00004100, 0x02004008, 0x02000100, 0x00000108,
306 0x00000008, 0x00004108, 0x02004000, 0x02000008,
307);
308my @SPtrans5 =
309(
310 # nibble 5
311 0x20000010, 0x00080010, 0x00000000, 0x20080800,
312 0x00080010, 0x00000800, 0x20000810, 0x00080000,
313 0x00000810, 0x20080810, 0x00080800, 0x20000000,
314 0x20000800, 0x20000010, 0x20080000, 0x00080810,
315 0x00080000, 0x20000810, 0x20080010, 0x00000000,
316 0x00000800, 0x00000010, 0x20080800, 0x20080010,
317 0x20080810, 0x20080000, 0x20000000, 0x00000810,
318 0x00000010, 0x00080800, 0x00080810, 0x20000800,
319 0x00000810, 0x20000000, 0x20000800, 0x00080810,
320 0x20080800, 0x00080010, 0x00000000, 0x20000800,
321 0x20000000, 0x00000800, 0x20080010, 0x00080000,
322 0x00080010, 0x20080810, 0x00080800, 0x00000010,
323 0x20080810, 0x00080800, 0x00080000, 0x20000810,
324 0x20000010, 0x20080000, 0x00080810, 0x00000000,
325 0x00000800, 0x20000010, 0x20000810, 0x20080800,
326 0x20080000, 0x00000810, 0x00000010, 0x20080010,
327);
328my @SPtrans6 =
329(
330 # nibble 6
331 0x00001000, 0x00000080, 0x00400080, 0x00400001,
332 0x00401081, 0x00001001, 0x00001080, 0x00000000,
333 0x00400000, 0x00400081, 0x00000081, 0x00401000,
334 0x00000001, 0x00401080, 0x00401000, 0x00000081,
335 0x00400081, 0x00001000, 0x00001001, 0x00401081,
336 0x00000000, 0x00400080, 0x00400001, 0x00001080,
337 0x00401001, 0x00001081, 0x00401080, 0x00000001,
338 0x00001081, 0x00401001, 0x00000080, 0x00400000,
339 0x00001081, 0x00401000, 0x00401001, 0x00000081,
340 0x00001000, 0x00000080, 0x00400000, 0x00401001,
341 0x00400081, 0x00001081, 0x00001080, 0x00000000,
342 0x00000080, 0x00400001, 0x00000001, 0x00400080,
343 0x00000000, 0x00400081, 0x00400080, 0x00001080,
344 0x00000081, 0x00001000, 0x00401081, 0x00400000,
345 0x00401080, 0x00000001, 0x00001001, 0x00401081,
346 0x00400001, 0x00401080, 0x00401000, 0x00001001,
347);
348my @SPtrans7 =
349(
350 # nibble 7
351 0x08200020, 0x08208000, 0x00008020, 0x00000000,
352 0x08008000, 0x00200020, 0x08200000, 0x08208020,
353 0x00000020, 0x08000000, 0x00208000, 0x00008020,
354 0x00208020, 0x08008020, 0x08000020, 0x08200000,
355 0x00008000, 0x00208020, 0x00200020, 0x08008000,
356 0x08208020, 0x08000020, 0x00000000, 0x00208000,
357 0x08000000, 0x00200000, 0x08008020, 0x08200020,
358 0x00200000, 0x00008000, 0x08208000, 0x00000020,
359 0x00200000, 0x00008000, 0x08000020, 0x08208020,
360 0x00008020, 0x08000000, 0x00000000, 0x00208000,
361 0x08200020, 0x08008020, 0x08008000, 0x00200020,
362 0x08208000, 0x00000020, 0x00200020, 0x08008000,
363 0x08208020, 0x00200000, 0x08200000, 0x08000020,
364 0x00208000, 0x00008020, 0x08008020, 0x08200000,
365 0x00000020, 0x08208000, 0x00208020, 0x00000000,
366 0x08000000, 0x08200020, 0x00008000, 0x00208020
367);
368
369my @cov_2char =
370(
371 0x2E, 0x2F, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35,
372 0x36, 0x37, 0x38, 0x39, 0x41, 0x42, 0x43, 0x44,
373 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x4B, 0x4C,
374 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0x53, 0x54,
375 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x61, 0x62,
376 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A,
377 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72,
378 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A
379);
380
381sub ushr # only for ints! (mimics the Java >>> operator)
382{
383 my ($n, $s) = @_;
384
385 $s &= 0x1f;
386
387 return( ($n >> $s) & (~0 >> $s) );
388}
389
390sub toByte
391{
392 my $value = shift;
393
394 $value &= 0xff;
395 $value = - ((~$value & 0xff) + 1)
396 if $value & 0x80;
397
398 return $value;
399}
400
401sub toInt
402{
403 my $value = shift;
404
405 $value = - ((~$value & 0xffffffff) + 1)
406 if $value & 0x80000000;
407
408 return $value;
409}
410
411sub byteToUnsigned # int byteToUnsigned(byte b)
412{
413 my $value = shift;
414
415 return( $value >= 0 ? $value : $value + 256 );
416}
417
418sub fourBytesToInt # int fourBytesToInt(byte b[], int offset)
419{
420 my ($b, $offset) = @_;
421 my $value;
422
423 $value = byteToUnsigned($b->[$offset++]);
424 $value |= (byteToUnsigned($b->[$offset++]) << 8);
425 $value |= (byteToUnsigned($b->[$offset++]) << 16);
426 $value |= (byteToUnsigned($b->[$offset++]) << 24);
427
428 return toInt($value);
429}
430
431sub intToFourBytes # void intToFourBytes(int iValue, byte b[], int offset)
432{
433 my ($iValue, $b, $offset) = @_;
434
435 $b->[$offset++] = toByte(ushr($iValue, 0) & 0xff);
436 $b->[$offset++] = toByte(ushr($iValue, 8) & 0xff);
437 $b->[$offset++] = toByte(ushr($iValue,16) & 0xff);
438 $b->[$offset++] = toByte(ushr($iValue,24) & 0xff);
439
440 return undef;
441}
442
443sub PERM_OP # void PERM_OP(int a, int b, int n, int m, int results[])
444{
445 my ($a, $b, $n, $m, $results) = @_;
446 my $t;
447
448 $t = (ushr($a,$n) ^ $b) & $m;
449 $a ^= $t << $n;
450 $b ^= $t;
451
452 $results->[0] = toInt($a);
453 $results->[1] = toInt($b);
454
455 return undef;
456}
457
458sub HPERM_OP # void HPERM_OP(int a, int n, int m)
459{
460 my ($a, $n, $m) = @_;
461 my $t;
462
463 $t = (($a << (16 - $n)) ^ $a) & $m;
464 $a = $a ^ $t ^ ushr($t, 16 - $n);
465
466 return toInt($a);
467}
468
469sub des_set_key # int [] des_set_key(byte key[])
470{
471 my ($key) = @_;
472 my @schedule; $#schedule = $ITERATIONS * 2 -1;
473
474 my $c = fourBytesToInt($key, 0);
475 my $d = fourBytesToInt($key, 4);
476
477 my @results; $#results = 1;
478
479 PERM_OP($d, $c, 4, 0x0f0f0f0f, \@results);
480 $d = $results[0]; $c = $results[1];
481
482 $c = HPERM_OP($c, -2, 0xcccc0000);
483 $d = HPERM_OP($d, -2, 0xcccc0000);
484
485 PERM_OP($d, $c, 1, 0x55555555, \@results);
486 $d = $results[0]; $c = $results[1];
487
488 PERM_OP($c, $d, 8, 0x00ff00ff, \@results);
489 $c = $results[0]; $d = $results[1];
490
491 PERM_OP($d, $c, 1, 0x55555555, \@results);
492 $d = $results[0]; $c = $results[1];
493
494 $d = ( (($d & 0x000000ff) << 16) | ($d & 0x0000ff00) |
495 ushr($d & 0x00ff0000, 16) | ushr($c & 0xf0000000, 4));
496 $c &= 0x0fffffff;
497
498 my ($s, $t);
499 my ($i, $j);
500
501 $j = 0;
502 for($i = 0; $i < $ITERATIONS; $i++)
503 {
504 if($shifts2[$i])
505 {
506 $c = ushr($c, 2) | ($c << 26);
507 $d = ushr($d, 2) | ($d << 26);
508 }
509 else
510 {
511 $c = ushr($c, 1) | ($c << 27);
512 $d = ushr($d, 1) | ($d << 27);
513 }
514
515 $c &= 0x0fffffff;
516 $d &= 0x0fffffff;
517
518 $s = $skb0[ ($c ) & 0x3f ]|
519 $skb1[(ushr($c, 6) & 0x03) | (ushr($c, 7) & 0x3c)]|
520 $skb2[(ushr($c,13) & 0x0f) | (ushr($c,14) & 0x30)]|
521 $skb3[(ushr($c,20) & 0x01) | (ushr($c,21) & 0x06) |
522 (ushr($c,22) & 0x38)];
523
524 $t = $skb4[ ($d ) & 0x3f ]|
525 $skb5[(ushr($d, 7) & 0x03) | (ushr($d, 8) & 0x3c) ]|
526 $skb6[ ushr($d,15) & 0x3f ]|
527 $skb7[(ushr($d,21) & 0x0f) | (ushr($d,22) & 0x30)];
528
529 $schedule[$j++] = ( ($t << 16) | ($s & 0x0000ffff)) & 0xffffffff;
530 $s = (ushr($s, 16) | ($t & 0xffff0000));
531
532 $s = ($s << 4) | ushr($s,28);
533 $schedule[$j++] = $s & 0xffffffff;
534 }
535
536 return \@schedule;
537}
538
539sub D_ENCRYPT # int D_ENCRYPT(int L, int R, int S, int E0, int E1, int s[])
540{
541 my ($L, $R, $S, $E0, $E1, $s) = @_;
542 my ($t, $u, $v);
543
544 $v = $R ^ ushr($R,16);
545 $u = $v & $E0;
546 $v = $v & $E1;
547 $u = ($u ^ ($u << 16)) ^ $R ^ $s->[$S];
548 $t = ($v ^ ($v << 16)) ^ $R ^ $s->[$S + 1];
549 $t = ushr($t, 4) | ($t << 28);
550
551 $L ^= $SPtrans1[ ($t ) & 0x3f] |
552 $SPtrans3[ushr($t, 8) & 0x3f] |
553 $SPtrans5[ushr($t, 16) & 0x3f] |
554 $SPtrans7[ushr($t, 24) & 0x3f] |
555 $SPtrans0[ ($u ) & 0x3f] |
556 $SPtrans2[ushr($u, 8) & 0x3f] |
557 $SPtrans4[ushr($u, 16) & 0x3f] |
558 $SPtrans6[ushr($u, 24) & 0x3f];
559
560 return $L;
561}
562
563sub body # int [] body(int schedule[], int Eswap0, int Eswap1)
564{
565 my ($schedule, $Eswap0, $Eswap1) = @_;
566 my $left = 0;
567 my $right = 0;
568 my $t = 0;
569
570 my ($i, $j);
571 for($j = 0; $j < 25; $j++)
572 {
573 for($i = 0; $i < $ITERATIONS * 2; $i += 4)
574 {
575 $left = D_ENCRYPT($left, $right, $i, $Eswap0, $Eswap1, $schedule);
576 $right = D_ENCRYPT($right, $left, $i + 2, $Eswap0, $Eswap1, $schedule);
577 }
578 $t = $left;
579 $left = $right;
580 $right = $t;
581 }
582
583 $t = $right;
584
585 $right = ushr($left, 1) | ($left << 31);
586 $left = ushr($t , 1) | ($t << 31);
587
588 $left &= 0xffffffff;
589 $right &= 0xffffffff;
590
591 my @results; $#results = 1;
592
593 PERM_OP($right, $left, 1, 0x55555555, \@results);
594 $right = $results[0]; $left = $results[1];
595
596 PERM_OP($left, $right, 8, 0x00ff00ff, \@results);
597 $left = $results[0]; $right = $results[1];
598
599 PERM_OP($right, $left, 2, 0x33333333, \@results);
600 $right = $results[0]; $left = $results[1];
601
602 PERM_OP($left, $right, 16, 0x0000ffff, \@results);
603 $left = $results[0]; $right = $results[1];
604
605 PERM_OP($right, $left, 4, 0x0f0f0f0f, \@results);
606 $right = $results[0]; $left = $results[1];
607
608 my @out; $#out = 1;
609
610 $out[0] = $left; $out[1] = $right;
611
612 return \@out;
613}
614
615sub crypt($$) # String crypt(String plaintext, String salt)
616{
617 my ($plaintext, $salt) = @_;
618 my $buffer = '';
619
620 return $buffer if !defined $salt || $salt eq '';
621
622 $salt .= $salt if length $salt < 2;
623 $plaintext = '' if !defined $plaintext;
624
625 $buffer = substr $salt,0,2;
626
627 my $Eswap0 = $con_salt[ord(substr $salt,0,1)];
628 my $Eswap1 = $con_salt[ord(substr $salt,1,1)] << 4;
629
630 my @key;
631 @key[0..7] = (0) x 8;
632
633 my @iChar = map { ord($_) << 1 } split(//, $plaintext);
634 my $i;
635 for (my $i = 0; $i < @key && $i < @iChar; $i++) {
636 $key[$i] = toByte($iChar[$i]);
637 }
638
639 my $schedule = des_set_key(\@key);
640 my $out = body($schedule, $Eswap0, $Eswap1);
641
642 my @b; $#b = 8;
643
644 intToFourBytes($out->[0], \@b, 0);
645 intToFourBytes($out->[1], \@b, 4);
646 $b[8] = 0;
647
648 my ($j, $c, $y, $u);
649 for($i = 2, $y = 0, $u = 0x80; $i < 13; $i++)
650 {
651 for($j = 0, $c = 0; $j < 6; $j++)
652 {
653 $c <<= 1;
654
655 $c |= 1 if ($b[$y] & $u) != 0;
656
657 $u >>= 1;
658
659 if($u == 0)
660 {
661 $y++;
662 $u = 0x80;
663 }
664 }
665 $buffer .= chr($cov_2char[$c]);
666 }
667
668 return $buffer;
669}
670
6711;
672__END__
673
674=head1 NAME
675
676Crypt::UnixCrypt - perl-only implementation of the C<crypt> function.
677
678=head1 SYNOPSIS
679
680 use Crypt::UnixCrypt;
681 $hashed = crypt($plaintext,$salt);
682
683 # always use this module's crypt
684 BEGIN { $Crypt::UnixCrpyt::OVERRIDE_BUILTIN = 1 }
685 use Crypt::UnixCrypt;
686
687=head1 DESCRIPTION
688
689This module is for all those poor souls whose perl port answers to the
690use of C<crypt()> with the message `The crypt() function is unimplemented
691due to excessive paranoia.'.
692
693This module won't overload a built-in C<crypt()> unless forced by a true
694value of the variable C<$Crypt::UnixCrypt::OVERRIDE_BUILTIN>.
695
696If you use this module, you probably neither have a built-in C<crypt()>
697function nor a L<crypt(3)> manpage; so I'll supply the appropriate portions
698of its description (from my Linux system) here:
699
700crypt is the password encryption function. It is based on the Data
701Encryption Standard algorithm with variations intended (among other
702things) to discourage use of hardware implementations of a key search.
703
704$plaintext is a user's typed password.
705
706$salt is a two-character string chosen from the set [a-zA-Z0-9./]. This
707string is used to perturb the algorithm in one of 4096 different ways.
708
709By taking the lowest 7 bit of each character of $plaintext (filling it up
710to 8 characters with zeros, if needed), a 56-bit key is obtained. This
71156-bit key is used to encrypt repeatedly a constant string (usually a
712string consisting of all zeros). The returned value points to the
713encrypted password, a series of 13 printable ASCII characters (the first
714two characters represent the salt itself).
715
716Warning: The key space consists of 2**56 equal 7.2e16 possible values.
717Exhaustive searches of this key space are possible using massively
718parallel computers. Software, such as crack(1), is available which will
719search the portion of this key space that is generally used by humans
720for passwords. Hence, password selection should, at minimum, avoid
721common words and names. The use of a passwd(1) program that checks for
722crackable passwords during the selection process is recommended.
723
724The DES algorithm itself has a few quirks which make the use of the
725crypt(3) interface a very poor choice for anything other than password
726authentication. If you are planning on using the crypt(3) interface for
727a cryptography project, don't do it: get a good book on encryption and
728one of the widely available DES libraries.
729
730=head1 COPYRIGHT
731
732This module is free software; you may redistribute it and/or modify it
733under the same terms as Perl itself.
734
735=head1 AUTHORS
736
737Written by Martin Vorlaender, [email protected], 11-DEC-1997.
738Based upon Java source code written by [email protected], which in turn is
739based upon C source code written by Eric Young, [email protected].
740
741=head1 CAVEATS
742
743In extreme situations, this function doesn't behave like C<crypt(3)>,
744e.g. when called with a salt not in [A-Za-z0-9./]{2}.
745
746=head1 SEE ALSO
747
748perl(1), perlfunc(1), crypt(3).
749
Note: See TracBrowser for help on using the repository browser.