crypto/des/des.pl

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