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