1# des.tcl 2# $Revision: 1.1 $ 3# $Date: 2005/09/26 09:16:59 $ 4# 5# Port of Javascript implementation to Tcl 8.4 by Mac A. Cody, 6# October, 2002 - February, 2003 7# August, 2003 - Separated key set generation from encryption/decryption. 8# Renamed "des" procedure to "block" to differentiate from the 9# "stream" procedure used for CFB and OFB modes. 10# Modified the "encrypt" and "decrypt" procedures to support 11# CFB and OFB modes. Changed the procedure arguments. 12# Added the "stream" procedure to support CFB and OFB modes. 13# June, 2004 - Corrected input vector bug in stream-mode processing. Added 14# support for feedback vector storage and management function. 15# This enables a stream of data to be processed over several calls 16# to the encryptor or decryptor. 17# September, 2004 - Added feedback vector to the CBC mode of operation to allow 18# a large data set to be processed over several calls to the 19# encryptor or decryptor. 20# October, 2004 - Added test for weak keys in the createKeys procedure. 21# 22# Paul Tero, July 2001 23# http://www.shopable.co.uk/des.html 24# 25# Optimised for performance with large blocks by Michael Hayworth, 26# November 2001, http://www.netdealing.com 27# 28# This software is copyrighted (c) 2003, 2004 by Mac A. Cody. All rights 29# reserved. The following terms apply to all files associated with 30# the software unless explicitly disclaimed in individual files or 31# directories. 32 33# The authors hereby grant permission to use, copy, modify, distribute, 34# and license this software for any purpose, provided that existing 35# copyright notices are retained in all copies and that this notice is 36# included verbatim in any distributions. No written agreement, license, 37# or royalty fee is required for any of the authorized uses. 38# Modifications to this software may be copyrighted by their authors and 39# need not follow the licensing terms described here, provided that the 40# new terms are clearly indicated on the first page of each file where 41# they apply. 42 43# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 44# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 45# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 46# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 47# POSSIBILITY OF SUCH DAMAGE. 48 49# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 50# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 51# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 52# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 53# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 54# MODIFICATIONS. 55 56# GOVERNMENT USE: If you are acquiring this software on behalf of the 57# U.S. government, the Government shall have only "Restricted Rights" 58# in the software and related documentation as defined in the Federal 59# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you 60# are acquiring the software on behalf of the Department of Defense, the 61# software shall be classified as "Commercial Computer Software" and the 62# Government shall have only "Restricted Rights" as defined in Clause 63# 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the 64# authors grant the U.S. Government and others acting in its behalf 65# permission to use and distribute the software in accordance with the 66# terms specified in this license. 67namespace eval des { 68 variable keysets 69 variable WeakKeysError 70 if {![info exists WeakKeysError]} { set WeakKeysError 1 } 71 set keysets(ndx) 1 72 # Produre: keyset - Create or destroy a keyset created from a 64-bit 73 # DES key or a 192-bit 3DES key. 74 # Inputs: 75 # oper : The operation to be performed. This will be either "create" 76 # (make a new keyset) or "destroy" (delete an existing keyset). 77 # The meaning of the argument "value" depends of the operation 78 # performed. An error is generated if "oper" is not "create" 79 # or "destroy". 80 # 81 # value : If the argument "oper" is "create", then "value" is the 64-bit 82 # DES key or the 192-bit 3DES key. (Note: The lsb of each byte 83 # is ignored; odd parity is not required). If the argument 84 # "oper" is "destroy", then "value" is a handle to a keyset that 85 # was created previously. 86 # 87 # weak: If true then weak keys are allowed. The default is to raise an 88 # error when a weak key is seen. 89 # Output: 90 # If the argument "oper" is "create", then the output is a handle to the 91 # keyset stored in the des namespace. If the argument "oper" is 92 # "destroy", then nothing is returned. 93 proc keyset {oper value {weak 0}} { 94 variable keysets 95 set newset {} 96 switch -exact -- $oper { 97 create { 98 # Create a new keyset handle. 99 set newset keyset$keysets(ndx) 100 # Create key set 101 set keysets($newset) [createKeys $value $weak] 102 # Never use that keyset handle index again. 103 incr keysets(ndx) 104 } 105 destroy { 106 # Determine if the keyset handle is valid. 107 if {[array names keysets $value] != {}} { 108 # Delete the handle and corresponding keyset. 109 unset keysets($value) 110 } else { 111 error "The keyset handle \"$value\" is invalid!" 112 } 113 } 114 default { 115 error {The operator must be either "create" or "destroy".} 116 } 117 } 118 return $newset 119 } 120 121 # Procedure: encrypt - Encryption front-end for the des procedure 122 # Inputs: 123 # keyset : Handle to an existing keyset. 124 # message : String to be encrypted. 125 # mode : DES mode ecb (default), cbc, cfb, or ofb. 126 # iv : Name of the initialization vector used in CBC, CFB, 127 # and OFB modes. 128 # kbits : Number of bits in a data block (default of 64). 129 # Output: 130 # The encrypted data string. 131 proc encrypt {keyset message {mode ecb} {iv {}} {kbits 64}} { 132 switch -exact -- $mode { 133 ecb { 134 return [block $keyset $message 1 0] 135 } 136 cbc - 137 ofb - 138 cfb { 139 # Is the initialization/feedback vector variable is valid? 140 if {[string length $iv] == 0} { 141 error "An initialization variable must be specified." 142 } else { 143 upvar $iv ivec 144 if {![info exists ivec]} { 145 error "The variable $iv does not exist." 146 } 147 } 148 switch -exact -- $mode { 149 cbc { 150 return [block $keyset $message 1 1 ivec] 151 } 152 ofb { 153 return [stream $keyset $message 1 0 ivec $kbits] 154 } 155 cfb { 156 return [stream $keyset $message 1 1 ivec $kbits] 157 } 158 } 159 } 160 default { 161 error {Mode must be ecb, cbc, cfb, or ofb.} 162 } 163 } 164 } 165 166 # Procedure: decrypt - Decryption front-end for the des procedure 167 # Inputs: 168 # keyset : Handle to an existing keyset. 169 # message : String to be decrypted. 170 # mode : DES mode ecb (default), cbc, cfb, or ofb. 171 # iv : Name of the initialization vector used in CBC, CFB, 172 # and OFB modes. 173 # kbits : Number of bits in a data block (default of 64). 174 # Output: 175 # The encrypted or decrypted data string. 176 proc decrypt {keyset message {mode ecb} {iv {}} {kbits 64}} { 177 switch -exact -- $mode { 178 ecb { 179 return [block $keyset $message 0 0] 180 } 181 cbc - 182 ofb - 183 cfb { 184 # Is the initialization/feedback vector variable is valid? 185 if {[string length $iv] < 1} { 186 error "An initialization variable must be specified." 187 } else { 188 upvar $iv ivec 189 if {![info exists ivec]} { 190 error "The variable $iv does not exist." 191 } 192 } 193 switch -exact -- $mode { 194 cbc { 195 return [block $keyset $message 0 1 ivec] 196 } 197 ofb { 198 return [stream $keyset $message 0 0 ivec $kbits] 199 } 200 cfb { 201 return [stream $keyset $message 0 1 ivec $kbits] 202 } 203 } 204 } 205 default { 206 error {Mode must be ecb, cbc, cfb, or ofb.} 207 } 208 } 209 } 210 211 variable spfunction1 [list 0x1010400 0 0x10000 0x1010404 0x1010004 0x10404 0x4 0x10000 0x400 0x1010400 0x1010404 0x400 0x1000404 0x1010004 0x1000000 0x4 0x404 0x1000400 0x1000400 0x10400 0x10400 0x1010000 0x1010000 0x1000404 0x10004 0x1000004 0x1000004 0x10004 0 0x404 0x10404 0x1000000 0x10000 0x1010404 0x4 0x1010000 0x1010400 0x1000000 0x1000000 0x400 0x1010004 0x10000 0x10400 0x1000004 0x400 0x4 0x1000404 0x10404 0x1010404 0x10004 0x1010000 0x1000404 0x1000004 0x404 0x10404 0x1010400 0x404 0x1000400 0x1000400 0 0x10004 0x10400 0 0x1010004]; 212 variable spfunction2 [list 0x80108020 0x80008000 0x8000 0x108020 0x100000 0x20 0x80100020 0x80008020 0x80000020 0x80108020 0x80108000 0x80000000 0x80008000 0x100000 0x20 0x80100020 0x108000 0x100020 0x80008020 0 0x80000000 0x8000 0x108020 0x80100000 0x100020 0x80000020 0 0x108000 0x8020 0x80108000 0x80100000 0x8020 0 0x108020 0x80100020 0x100000 0x80008020 0x80100000 0x80108000 0x8000 0x80100000 0x80008000 0x20 0x80108020 0x108020 0x20 0x8000 0x80000000 0x8020 0x80108000 0x100000 0x80000020 0x100020 0x80008020 0x80000020 0x100020 0x108000 0 0x80008000 0x8020 0x80000000 0x80100020 0x80108020 0x108000]; 213 variable spfunction3 [list 0x208 0x8020200 0 0x8020008 0x8000200 0 0x20208 0x8000200 0x20008 0x8000008 0x8000008 0x20000 0x8020208 0x20008 0x8020000 0x208 0x8000000 0x8 0x8020200 0x200 0x20200 0x8020000 0x8020008 0x20208 0x8000208 0x20200 0x20000 0x8000208 0x8 0x8020208 0x200 0x8000000 0x8020200 0x8000000 0x20008 0x208 0x20000 0x8020200 0x8000200 0 0x200 0x20008 0x8020208 0x8000200 0x8000008 0x200 0 0x8020008 0x8000208 0x20000 0x8000000 0x8020208 0x8 0x20208 0x20200 0x8000008 0x8020000 0x8000208 0x208 0x8020000 0x20208 0x8 0x8020008 0x20200]; 214 variable spfunction4 [list 0x802001 0x2081 0x2081 0x80 0x802080 0x800081 0x800001 0x2001 0 0x802000 0x802000 0x802081 0x81 0 0x800080 0x800001 0x1 0x2000 0x800000 0x802001 0x80 0x800000 0x2001 0x2080 0x800081 0x1 0x2080 0x800080 0x2000 0x802080 0x802081 0x81 0x800080 0x800001 0x802000 0x802081 0x81 0 0 0x802000 0x2080 0x800080 0x800081 0x1 0x802001 0x2081 0x2081 0x80 0x802081 0x81 0x1 0x2000 0x800001 0x2001 0x802080 0x800081 0x2001 0x2080 0x800000 0x802001 0x80 0x800000 0x2000 0x802080]; 215 variable spfunction5 [list 0x100 0x2080100 0x2080000 0x42000100 0x80000 0x100 0x40000000 0x2080000 0x40080100 0x80000 0x2000100 0x40080100 0x42000100 0x42080000 0x80100 0x40000000 0x2000000 0x40080000 0x40080000 0 0x40000100 0x42080100 0x42080100 0x2000100 0x42080000 0x40000100 0 0x42000000 0x2080100 0x2000000 0x42000000 0x80100 0x80000 0x42000100 0x100 0x2000000 0x40000000 0x2080000 0x42000100 0x40080100 0x2000100 0x40000000 0x42080000 0x2080100 0x40080100 0x100 0x2000000 0x42080000 0x42080100 0x80100 0x42000000 0x42080100 0x2080000 0 0x40080000 0x42000000 0x80100 0x2000100 0x40000100 0x80000 0 0x40080000 0x2080100 0x40000100]; 216 variable spfunction6 [list 0x20000010 0x20400000 0x4000 0x20404010 0x20400000 0x10 0x20404010 0x400000 0x20004000 0x404010 0x400000 0x20000010 0x400010 0x20004000 0x20000000 0x4010 0 0x400010 0x20004010 0x4000 0x404000 0x20004010 0x10 0x20400010 0x20400010 0 0x404010 0x20404000 0x4010 0x404000 0x20404000 0x20000000 0x20004000 0x10 0x20400010 0x404000 0x20404010 0x400000 0x4010 0x20000010 0x400000 0x20004000 0x20000000 0x4010 0x20000010 0x20404010 0x404000 0x20400000 0x404010 0x20404000 0 0x20400010 0x10 0x4000 0x20400000 0x404010 0x4000 0x400010 0x20004010 0 0x20404000 0x20000000 0x400010 0x20004010]; 217 variable spfunction7 [list 0x200000 0x4200002 0x4000802 0 0x800 0x4000802 0x200802 0x4200800 0x4200802 0x200000 0 0x4000002 0x2 0x4000000 0x4200002 0x802 0x4000800 0x200802 0x200002 0x4000800 0x4000002 0x4200000 0x4200800 0x200002 0x4200000 0x800 0x802 0x4200802 0x200800 0x2 0x4000000 0x200800 0x4000000 0x200800 0x200000 0x4000802 0x4000802 0x4200002 0x4200002 0x2 0x200002 0x4000000 0x4000800 0x200000 0x4200800 0x802 0x200802 0x4200800 0x802 0x4000002 0x4200802 0x4200000 0x200800 0 0x2 0x4200802 0 0x200802 0x4200000 0x800 0x4000002 0x4000800 0x800 0x200002]; 218 variable spfunction8 [list 0x10001040 0x1000 0x40000 0x10041040 0x10000000 0x10001040 0x40 0x10000000 0x40040 0x10040000 0x10041040 0x41000 0x10041000 0x41040 0x1000 0x40 0x10040000 0x10000040 0x10001000 0x1040 0x41000 0x40040 0x10040040 0x10041000 0x1040 0 0 0x10040040 0x10000040 0x10001000 0x41040 0x40000 0x41040 0x40000 0x10041000 0x1000 0x40 0x10040040 0x1000 0x41040 0x10001000 0x40 0x10000040 0x10040000 0x10040040 0x10000000 0x40000 0x10001040 0 0x10041040 0x40040 0x10000040 0x10040000 0x10001000 0x10001040 0 0x10041040 0x41000 0x41000 0x1040 0x1040 0x40040 0x10000000 0x10041000]; 219 220 variable desEncrypt {0 32 2} 221 variable desDecrypt {30 -2 -2} 222 variable des3Encrypt {0 32 2 62 30 -2 64 96 2} 223 variable des3Decrypt {94 62 -2 32 64 2 30 -2 -2} 224 225 # Procedure: block - DES ECB and CBC mode support 226 # Inputs: 227 # keyset : Handle to an existing keyset. 228 # message : String to be encrypted or decrypted (Note: For encryption, 229 # the string is extended with null characters to an integral 230 # multiple of eight bytes. For decryption, the string length 231 # must be an integral multiple of eight bytes. 232 # encrypt : Perform encryption (1) or decryption (0) 233 # mode : DES mode 1=CBC, 0=ECB (default). 234 # iv : Name of the variable containing the initialization vector 235 # used in CBC mode. The value must be 64 bits in length. 236 # Output: 237 # The encrypted or decrypted data string. 238 proc block {keyset message encrypt {mode 0} {iv {}}} { 239 variable spfunction1 240 variable spfunction2 241 variable spfunction3 242 variable spfunction4 243 variable spfunction5 244 variable spfunction6 245 variable spfunction7 246 variable spfunction8 247 variable desEncrypt 248 variable desDecrypt 249 variable des3Encrypt 250 variable des3Decrypt 251 variable keysets 252 253 # Determine if the keyset handle is valid. 254 if {[array names keysets $keyset] != {}} { 255 # Acquire the 16 or 48 subkeys we will need 256 set keys $keysets($keyset) 257 } else { 258 error "The keyset handle \"$keyset\" is invalid!" 259 } 260 set m 0 261 set cbcleft 0x00; set cbcleft2 0x00 262 set cbcright 0x00; set cbcright2 0x00 263 set len [string length $message]; 264 if {$len == 0} { 265 return -code error "invalid message size: the message may not be empty" 266 } 267 set chunk 0; 268 # Set up the loops for single and triple des 269 set iterations [expr {[llength $keys] == 32 ? 3 : 9}]; 270 if {$iterations == 3} { 271 expr {$encrypt ? [set looping $desEncrypt] : \ 272 [set looping $desDecrypt]} 273 } else { 274 expr {$encrypt ? [set looping $des3Encrypt] : \ 275 [set looping $des3Decrypt]} 276 } 277 278 # Pad the message out with null bytes. 279 append message "\0\0\0\0\0\0\0\0" 280 281 # Store the result here 282 set result {}; 283 set tempresult {}; 284 285 # CBC mode 286 if {$mode == 1} { 287 # Is the initialization/feedback vector variable is valid? 288 if {[string length $iv] < 1} { 289 error "An initialization variable must be specified." 290 } else { 291 upvar $iv ivec 292 if {![info exists ivec]} { 293 error "The variable $iv does not exist." 294 } 295 if {[string length $ivec] != 8} { 296 return -code error "invalid initialization vector size:\ 297 the initialization vector must be 8 bytes" 298 } 299 } 300 # Use the input vector as the intial vector. 301 binary scan $ivec H8H8 cbcleftTemp cbcrightTemp 302 set cbcleft "0x$cbcleftTemp" 303 set cbcright "0x$cbcrightTemp" 304 } 305 306 # Loop through each 64 bit chunk of the message 307 while {$m < $len} { 308 binary scan $message x${m}H8H8 lefttemp righttemp 309 set left {} 310 append left "0x" $lefttemp 311 set right {} 312 append right "0x" $righttemp 313 incr m 8 314 315 #puts "Left start: $left"; 316 #puts "Right start: $right"; 317 # For Cipher Block Chaining mode, xor the 318 # message with the previous result. 319 if {$mode == 1} { 320 if {$encrypt} { 321 set left [expr {$left ^ $cbcleft}] 322 set right [expr {$right ^ $cbcright}] 323 } else { 324 set cbcleft2 $cbcleft; 325 set cbcright2 $cbcright; 326 set cbcleft $left; 327 set cbcright $right; 328 } 329 } 330 331 #puts "Left mode: $left"; 332 #puts "Right mode: $right"; 333 #puts "cbcleft: $cbcleft"; 334 #puts "cbcleft2: $cbcleft2"; 335 #puts "cbcright: $cbcright"; 336 #puts "cbcright2: $cbcright2"; 337 338 # First each 64 but chunk of the message 339 # must be permuted according to IP. 340 set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}]; 341 set right [expr {$right ^ $temp}]; 342 set left [expr {$left ^ ($temp << 4)}]; 343 set temp [expr {(($left >> 16) ^ $right) & 0x0000ffff}]; 344 set right [expr {$right ^ $temp}]; 345 set left [expr {$left ^ ($temp << 16)}]; 346 set temp [expr {(($right >> 2) ^ $left) & 0x33333333}]; 347 set left [expr {$left ^ $temp}] 348 set right [expr {$right ^ ($temp << 2)}]; 349 350 set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}]; 351 set left [expr {$left ^ $temp}]; 352 set right [expr {$right ^ ($temp << 8)}]; 353 set temp [expr {(($left >> 1) ^ $right) & 0x55555555}]; 354 set right [expr {$right ^ $temp}]; 355 set left [expr {$left ^ ($temp << 1)}]; 356 357 set left [expr {((($left << 1) & 0xffffffff) | \ 358 (($left >> 31) & 0x00000001))}]; 359 set right [expr {((($right << 1) & 0xffffffff) | \ 360 (($right >> 31) & 0x00000001))}]; 361 362 #puts "Left IP: [format %x $left]"; 363 #puts "Right IP: [format %x $right]"; 364 365 # Do this either 1 or 3 times for each chunk of the message 366 for {set j 0} {$j < $iterations} {incr j 3} { 367 set endloop [lindex $looping [expr {$j + 1}]]; 368 set loopinc [lindex $looping [expr {$j + 2}]]; 369 370 #puts "endloop: $endloop"; 371 #puts "loopinc: $loopinc"; 372 373 # Now go through and perform the encryption or decryption 374 for {set i [lindex $looping $j]} \ 375 {$i != $endloop} {incr i $loopinc} { 376 # For efficiency 377 set right1 [expr {$right ^ [lindex $keys $i]}]; 378 set right2 [expr {((($right >> 4) & 0x0fffffff) | \ 379 (($right << 28) & 0xffffffff)) ^ \ 380 [lindex $keys [expr {$i + 1}]]}]; 381 382 # puts "right1: [format %x $right1]"; 383 # puts "right2: [format %x $right2]"; 384 385 # The result is attained by passing these 386 # bytes through the S selection functions. 387 set temp $left; 388 set left $right; 389 set right [expr {$temp ^ ([lindex $spfunction2 [expr {($right1 >> 24) & 0x3f}]] | \ 390 [lindex $spfunction4 [expr {($right1 >> 16) & 0x3f}]] | \ 391 [lindex $spfunction6 [expr {($right1 >> 8) & 0x3f}]] | \ 392 [lindex $spfunction8 [expr {$right1 & 0x3f}]] | \ 393 [lindex $spfunction1 [expr {($right2 >> 24) & 0x3f}]] | \ 394 [lindex $spfunction3 [expr {($right2 >> 16) & 0x3f}]] | \ 395 [lindex $spfunction5 [expr {($right2 >> 8) & 0x3f}]] | \ 396 [lindex $spfunction7 [expr {$right2 & 0x3f}]])}]; 397 398 # puts "Left iter: [format %x $left]"; 399 # puts "Right iter: [format %x $right]"; 400 401 } 402 set temp $left; 403 set left $right; 404 set right $temp; # Unreverse left and right 405 }; # For either 1 or 3 iterations 406 407 #puts "Left Iterated: [format %x $left]"; 408 #puts "Right Iterated: [format %x $right]"; 409 410 # Move then each one bit to the right 411 set left [expr {((($left >> 1) & 0x7fffffff) \ 412 | (($left << 31) & 0xffffffff))}]; 413 set right [expr {((($right >> 1) & 0x7fffffff) \ 414 | (($right << 31) & 0xffffffff))}]; 415 416 #puts "Left shifted: [format %x $left]"; 417 #puts "Right shifted: [format %x $right]"; 418 419 # Now perform IP-1, which is IP in the opposite direction 420 set temp [expr {((($left >> 1) & 0x7fffffff) ^ $right) & 0x55555555}]; 421 set right [expr {$right ^ $temp}]; 422 set left [expr {$left ^ ($temp << 1)}]; 423 set temp [expr {((($right >> 8) & 0x00ffffff) ^ $left) & 0x00ff00ff}]; 424 set left [expr {$left ^ $temp}]; 425 set right [expr {$right ^ ($temp << 8)}]; 426 set temp [expr {((($right >> 2) & 0x3fffffff) ^ $left) & 0x33333333}]; 427 set left [expr {$left ^ $temp}]; 428 set right [expr {$right ^ ($temp << 2)}]; 429 set temp [expr {((($left >> 16) & 0x0000ffff) ^ $right) & 0x0000ffff}]; 430 set right [expr {$right ^ $temp}]; 431 set left [expr {$left ^ ($temp << 16)}]; 432 set temp [expr {((($left >> 4) & 0x0fffffff) ^ $right) & 0x0f0f0f0f}]; 433 set right [expr {$right ^ $temp}]; 434 set left [expr {$left ^ ($temp << 4)}]; 435 436 #puts "Left IP-1: [format %x $left]"; 437 #puts "Right IP-1: [format %x $right]"; 438 439 # For Cipher Block Chaining mode, xor 440 # the message with the previous result. 441 if {$mode == 1} { 442 if {$encrypt} { 443 set cbcleft $left; 444 set cbcright $right; 445 } else { 446 set left [expr {$left ^ $cbcleft2}]; 447 set right [expr {$right ^ $cbcright2}]; 448 } 449 } 450 451 append tempresult \ 452 [binary format H16 [format %08x%08x $left $right]] 453 454 #puts "Left final: [format %x $left]"; 455 #puts "Right final: [format %x $right]"; 456 457 incr chunk 8; 458 if {$chunk == 512} { 459 append result $tempresult 460 set tempresult {}; 461 set chunk 0; 462 } 463 }; # For every 8 characters, or 64 bits in the message 464 465 if {$mode == 1} { 466 if {$encrypt} { 467 # Save the left and right registers to the feedback vector. 468 set ivec [binary format H* \ 469 [format %08x $left][format %08x $right]] 470 } else { 471 set ivec [binary format H* \ 472 [format %08x $cbcleft][format %08x $cbcright]] 473 } 474 } 475 476 # Return the result as an array 477 return ${result}$tempresult 478 }; # End of block 479 480 # Procedure: stream - DES CFB and OFB mode support 481 # Inputs: 482 # keyset : Handle to an existing keyset. 483 # message : String to be encrypted or decrypted (Note: The length of the 484 # string is dependent upon the value of kbits. Remember that 485 # the string is part of a stream of data, so it must be sized 486 # properly for subsequent encryptions/decryptions to be 487 # correct. See the man page for correct message lengths for 488 # values of kbits). 489 # encrypt : Perform encryption (1) or decryption (0) 490 # mode : DES mode 0=OFB, 1=CFB. 491 # iv : Name of variable containing the initialization vector. The 492 # value must be 64 bits in length with the first 64-L bits set 493 # to zero. 494 # kbits : Number of bits in a data block (default of 64). 495 # Output: 496 # The encrypted or decrypted data string. 497 proc stream {keyset message encrypt mode iv {kbits 64}} { 498 variable spfunction1 499 variable spfunction2 500 variable spfunction3 501 variable spfunction4 502 variable spfunction5 503 variable spfunction6 504 variable spfunction7 505 variable spfunction8 506 variable desEncrypt 507 variable des3Encrypt 508 variable keysets 509 510 # Determine if the keyset handle is valid. 511 if {[array names keysets $keyset] != {}} { 512 # Acquire the 16 or 48 subkeys we will need. 513 set keys $keysets($keyset) 514 } else { 515 error "The keyset handle \"$keyset\" is invalid!" 516 } 517 518 # Is the initialization/feedback vector variable is valid? 519 if {[string length $iv] < 1} { 520 error "An initialization variable must be specified." 521 } else { 522 upvar $iv ivec 523 if {![info exists ivec]} { 524 error "The variable $iv does not exist." 525 } 526 } 527 528 # Determine if message length (in bits) 529 # is not an integral number of kbits. 530 set len [string length $message]; 531 #puts "len: $len, kbits: $kbits" 532 if {($kbits < 1) || ($kbits > 64)} { 533 error "The valid values of kbits are 1 through 64." 534 } elseif {($kbits % 8) != 0} { 535 set blockSize [expr {$kbits + (8 - ($kbits % 8))}] 536 set fail [expr {(($len * 8) / $blockSize) % $kbits}] 537 } else { 538 set blockSize [expr {$kbits / 8}] 539 set fail [expr {$len % $blockSize}] 540 } 541 if {$fail} { 542 error "Data length (in bits) is not an integral number of kbits." 543 } 544 545 set m 0 546 set n 0 547 set chunk 0; 548 # Set up the loops for single and triple des 549 set iterations [expr {[llength $keys] == 32 ? 3 : 9}]; 550 if {$iterations == 3} { 551 set looping $desEncrypt 552 } else { 553 set looping $des3Encrypt 554 } 555 556 # Set up shifting values. Used for both CFB and OFB modes. 557 if {$kbits < 32} { 558 # Only some bits from left output are needed. 559 set kOutShift [expr {32 - $kbits}] 560 set kOutMask [expr {0x7fffffff >> (31 - $kbits)}] 561 # Determine number of message bytes needed per iteration. 562 set msgBytes [expr {int(ceil(double($kbits) / 8.0))}] 563 # Determine number of message bits needed per iteration. 564 set msgBits [expr {$msgBytes * 8}] 565 set msgBitsSub1 [expr {$msgBits - 1}] 566 # Define bit caches. 567 set bitCacheIn {} 568 set bitCacheOut {} 569 # Variable used to remove bits 0 through 570 # kbits-1 in the input bit cache. 571 set kbitsSub1 [expr {$kbits - 1}] 572 # Variable used to remove leading dummy binary bits. 573 set xbits [expr {32 - $kbits}] 574 } elseif {$kbits == 32} { 575 # Only bits of left output are used. 576 # Four messages bytes are needed per iteration. 577 set msgBytes 4 578 set xbits 32 579 } elseif {$kbits < 64} { 580 # All bits from left output are needed. 581 set kOutShiftLeft [expr {$kbits - 32}] 582 # Some bits from right output are needed. 583 set kOutShiftRight [expr {64 - $kbits}] 584 set kOutMaskRight [expr {0x7fffffff >> (63 - $kbits)}] 585 # Determine number of message bytes needed per iteration. 586 set msgBytes [expr {int(ceil(double($kbits) / 8.0))}] 587 # Determine number of message bits needed per iteration. 588 set msgBits [expr {$msgBytes * 8}] 589 set msgBitsSub1 [expr {$msgBits - 1}] 590 # Define bit caches. 591 set bitCacheIn {} 592 set bitCacheOut {} 593 # Variable used to remove bits 0 through 594 # kbits-1 in the input bit cache. 595 set kbitsSub1 [expr {$kbits - 1}] 596 # Variable used to remove leading dummy binary bits. 597 set xbits [expr {64 - $kbits}] 598 } else { 599 # All 64 bits of output are used. 600 # Eight messages bytes are needed per iteration. 601 set msgBytes 8 602 set xbits 0 603 } 604 605 # Store the result here 606 set result {} 607 set tempresult {} 608 609 # Set up the initialization vector bitstream 610 binary scan $ivec H8H8 leftTemp rightTemp 611 set left "0x$leftTemp" 612 set right "0x$rightTemp" 613 #puts "Retrieved Feedback vector: $fbvec" 614 #puts "Start: |$left| |$right|" 615 616 # Loop through each 64 bit chunk of the message 617 while {$m < $len} { 618 # puts "Left start: $left"; 619 # puts "Right start: $right"; 620 621 # First each 64 but chunk of the 622 # message must be permuted according to IP. 623 set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}]; 624 set right [expr {$right ^ $temp}]; 625 set left [expr {$left ^ ($temp << 4)}]; 626 set temp [expr {(($left >> 16) ^ $right) & 0x0000ffff}]; 627 set right [expr {$right ^ $temp}]; 628 set left [expr {$left ^ ($temp << 16)}]; 629 set temp [expr {(($right >> 2) ^ $left) & 0x33333333}]; 630 set left [expr {$left ^ $temp}]; 631 set right [expr {$right ^ ($temp << 2)}]; 632 633 set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}]; 634 set left [expr {$left ^ $temp}]; 635 set right [expr {$right ^ ($temp << 8)}]; 636 set temp [expr {(($left >> 1) ^ $right) & 0x55555555}]; 637 set right [expr {$right ^ $temp}]; 638 set left [expr {$left ^ ($temp << 1)}]; 639 640 set left [expr {((($left << 1) & 0xffffffff) | \ 641 (($left >> 31) & 0x00000001))}]; 642 set right [expr {((($right << 1) & 0xffffffff) | \ 643 (($right >> 31) & 0x00000001))}]; 644 645 #puts "Left IP: [format %x $left]"; 646 #puts "Right IP: [format %x $right]"; 647 648 # Do this either 1 or 3 times for each chunk of the message 649 for {set j 0} {$j < $iterations} {incr j 3} { 650 set endloop [lindex $looping [expr {$j + 1}]]; 651 set loopinc [lindex $looping [expr {$j + 2}]]; 652 653 #puts "endloop: $endloop"; 654 #puts "loopinc: $loopinc"; 655 656 # Now go through and perform the encryption or decryption 657 for {set i [lindex $looping $j]} \ 658 {$i != $endloop} {incr i $loopinc} { 659 # For efficiency 660 set right1 [expr {$right ^ [lindex $keys $i]}]; 661 set right2 [expr {((($right >> 4) & 0x0fffffff) | \ 662 (($right << 28) & 0xffffffff)) ^ \ 663 [lindex $keys [expr {$i + 1}]]}]; 664 665 # puts "right1: [format %x $right1]"; 666 # puts "right2: [format %x $right2]"; 667 668 # The result is attained by passing these 669 # bytes through the S selection functions. 670 set temp $left; 671 set left $right; 672 set right [expr {$temp ^ ([lindex $spfunction2 [expr {($right1 >> 24) & 0x3f}]] | \ 673 [lindex $spfunction4 [expr {($right1 >> 16) & 0x3f}]] | \ 674 [lindex $spfunction6 [expr {($right1 >> 8) & 0x3f}]] | \ 675 [lindex $spfunction8 [expr {$right1 & 0x3f}]] | \ 676 [lindex $spfunction1 [expr {($right2 >> 24) & 0x3f}]] | \ 677 [lindex $spfunction3 [expr {($right2 >> 16) & 0x3f}]] | \ 678 [lindex $spfunction5 [expr {($right2 >> 8) & 0x3f}]] | \ 679 [lindex $spfunction7 [expr {$right2 & 0x3f}]])}]; 680 681 # puts "Left iter: [format %x $left]"; 682 # puts "Right iter: [format %x $right]"; 683 684 } 685 set temp $left; 686 set left $right; 687 set right $temp; # Unreverse left and right 688 }; # For either 1 or 3 iterations 689 690 #puts "Left Iterated: [format %x $left]"; 691 #puts "Right Iterated: [format %x $right]"; 692 693 # Move then each one bit to the right 694 set left [expr {((($left >> 1) & 0x7fffffff) | \ 695 (($left << 31) & 0xffffffff))}]; 696 set right [expr {((($right >> 1) & 0x7fffffff) | \ 697 (($right << 31) & 0xffffffff))}]; 698 699 #puts "Left shifted: [format %x $left]"; 700 #puts "Right shifted: [format %x $right]"; 701 702 # Now perform IP-1, which is IP in the opposite direction 703 set temp [expr {((($left >> 1) & 0x7fffffff) ^ $right) & 0x55555555}]; 704 set right [expr {$right ^ $temp}]; 705 set left [expr {$left ^ ($temp << 1)}]; 706 set temp [expr {((($right >> 8) & 0x00ffffff) ^ $left) & 0x00ff00ff}]; 707 set left [expr {$left ^ $temp}]; 708 set right [expr {$right ^ ($temp << 8)}]; 709 set temp [expr {((($right >> 2) & 0x3fffffff) ^ $left) & 0x33333333}]; 710 set left [expr {$left ^ $temp}]; 711 set right [expr {$right ^ ($temp << 2)}]; 712 set temp [expr {((($left >> 16) & 0x0000ffff) ^ $right) & 0x0000ffff}]; 713 set right [expr {$right ^ $temp}]; 714 set left [expr {$left ^ ($temp << 16)}]; 715 set temp [expr {((($left >> 4) & 0x0fffffff) ^ $right) & 0x0f0f0f0f}]; 716 set right [expr {$right ^ $temp}]; 717 set left [expr {$left ^ ($temp << 4)}]; 718 719 #puts "Left IP-1: [format %x $left]"; 720 #puts "Right IP-1: [format %x $right]"; 721 722 # Extract the "kbits" most significant bits from the output block. 723 if {$kbits < 32} { 724 # Only some bits from left output are needed. 725 set kData [expr {($left >> $kOutShift) & $kOutMask}] 726 set newBits {} 727 # If necessary, copy message bytes into input bit cache. 728 if {([string length $bitCacheIn] < $kbits) && ($n < $len)} { 729 if {$len - $n < $msgBytes} { 730 set lastBits [expr {($len - $n) * 8}] 731 ###puts -nonewline [binary scan $message x${n}B$lastBits newBits] 732 binary scan $message x${n}B$lastBits newBits 733 } else { 734 # Extract "msgBytes" whole bytes as bits 735 ###puts -nonewline [binary scan $message x${n}B$msgBits newBits] 736 binary scan $message x${n}B$msgBits newBits 737 } 738 incr n $msgBytes 739 #puts " $newBits $n [expr {$len - $n}]" 740 # Add the bits to the input bit cache. 741 append bitCacheIn $newBits 742 } 743 #puts -nonewline "In bit cache: $bitCacheIn" 744 # Set up message data from input bit cache. 745 binary scan [binary format B32 [format %032s [string range $bitCacheIn 0 $kbitsSub1]]] H8 temp 746 set msgData "0x$temp" 747 # Mix message bits with crypto bits. 748 set mixData [expr {$msgData ^ $kData}] 749 # Discard collected bits from the input bit cache. 750 set bitCacheIn [string range $bitCacheIn $kbits end] 751 #puts " After: $bitCacheIn" 752 # Convert back to a bit stream and append to the output bit cache. 753 # Only the lower kbits are wanted. 754 binary scan [binary format H8 [format %08x $mixData]] B32 msgOut 755 append bitCacheOut [string range $msgOut $xbits end] 756 #puts -nonewline "Out bit cache: $bitCacheOut" 757 # If there are sufficient bits, move bytes to the temporary holding string. 758 if {[string length $bitCacheOut] >= $msgBits} { 759 append tempresult [binary format B$msgBits [string range $bitCacheOut 0 $msgBitsSub1]] 760 set bitCacheOut [string range $bitCacheOut $msgBits end] 761 #puts -nonewline " After: $bitCacheOut" 762 incr m $msgBytes 763 ###puts "$m bytes output" 764 incr chunk $msgBytes 765 } 766 #puts "" 767 # For CFB mode 768 if {$mode == 1} { 769 if {$encrypt} { 770 set temp [expr {($right << $kbits) & 0xffffffff}] 771 set left [expr {(($left << $kbits) & 0xffffffff) | (($right >> $kOutShift) & $kOutMask)}] 772 set right [expr {$temp | $mixData}] 773 } else { 774 set temp [expr {($right << $kbits) & 0xffffffff}] 775 set left [expr {(($left << $kbits) & 0xffffffff) | (($right >> $kOutShift) & $kOutMask)}] 776 set right [expr {$temp | $msgData}] 777 } 778 } 779 } elseif {$kbits == 32} { 780 # Only bits of left output are used. 781 set kData $left 782 # Four messages bytes are needed per iteration. 783 binary scan $message x${m}H8 temp 784 incr m 4 785 incr chunk 4 786 set msgData "0x$temp" 787 # Mix message bits with crypto bits. 788 set mixData [expr {$msgData ^ $kData}] 789 # Move bytes to the temporary holding string. 790 append tempresult [binary format H8 [format %08x $mixData]] 791 # For CFB mode 792 if {$mode == 1} { 793 set left $right 794 if {$encrypt} { 795 set right $mixData 796 } else { 797 set right $msgData 798 } 799 } 800 } elseif {$kbits < 64} { 801 set kDataLeft [expr {($left >> $kOutShiftRight) & $kOutMaskRight}] 802 set temp [expr {($left << $kOutShiftLeft) & 0xffffffff}] 803 set kDataRight [expr {(($right >> $kOutShiftRight) & $kOutMaskRight) | $temp}] 804 # If necessary, copy message bytes into input bit cache. 805 if {([string length $bitCacheIn] < $kbits) && ($n < $len)} { 806 if {$len - $n < $msgBytes} { 807 set lastBits [expr {($len - $n) * 8}] 808 ###puts -nonewline [binary scan $message x${n}B$lastBits newBits] 809 binary scan $message x${n}B$lastBits newBits 810 } else { 811 # Extract "msgBytes" whole bytes as bits 812 ###puts -nonewline [binary scan $message x${n}B$msgBits newBits] 813 binary scan $message x${n}B$msgBits newBits 814 } 815 incr n $msgBytes 816 # Add the bits to the input bit cache. 817 append bitCacheIn $newBits 818 } 819 # Set up message data from input bit cache. 820 # puts "Bits from cache: [set temp [string range $bitCacheIn 0 $kbitsSub1]]" 821 # puts "Length of bit string: [string length $temp]" 822 binary scan [binary format B64 [format %064s [string range $bitCacheIn 0 $kbitsSub1]]] H8H8 leftTemp rightTemp 823 set msgDataLeft "0x$leftTemp" 824 set msgDataRight "0x$rightTemp" 825 # puts "msgDataLeft: $msgDataLeft" 826 # puts "msgDataRight: $msgDataRight" 827 # puts "kDataLeft: [format 0x%08x $kDataLeft]" 828 # puts "kDataRight: [format 0x%08x $kDataRight]" 829 # Mix message bits with crypto bits. 830 set mixDataLeft [expr {$msgDataLeft ^ $kDataLeft}] 831 set mixDataRight [expr {$msgDataRight ^ $kDataRight}] 832 # puts "mixDataLeft: $mixDataLeft" 833 # puts "mixDataRight: $mixDataRight" 834 # puts "mixDataLeft: [format 0x%08x $mixDataLeft]" 835 # puts "mixDataRight: [format 0x%08x $mixDataRight]" 836 # Discard collected bits from the input bit cache. 837 set bitCacheIn [string range $bitCacheIn $kbits end] 838 # Convert back to a bit stream and 839 # append to the output bit cache. 840 # Only the lower kbits are wanted. 841 binary scan \ 842 [binary format H8H8 \ 843 [format %08x $mixDataLeft] \ 844 [format %08x $mixDataRight]] B64 msgOut 845 append bitCacheOut [string range $msgOut $xbits end] 846 # If there are sufficient bits, move 847 # bytes to the temporary holding string. 848 if {[string length $bitCacheOut] >= $msgBits} { 849 append tempresult \ 850 [binary format B$msgBits \ 851 [string range $bitCacheOut 0 $msgBitsSub1]] 852 set bitCacheOut [string range $bitCacheOut $msgBits end] 853 incr m $msgBytes 854 incr chunk $msgBytes 855 } 856 # For CFB mode 857 if {$mode == 1} { 858 if {$encrypt} { 859 set temp \ 860 [expr {($right << $kOutShiftRight) & 0xffffffff}] 861 set left [expr {$temp | $mixDataLeft}] 862 set right $mixDataRight 863 } else { 864 set temp \ 865 [expr {($right << $kOutShiftRight) & 0xffffffff}] 866 set left [expr {$temp | $msgDataLeft}] 867 set right $msgDataRight 868 } 869 } 870 } else { 871 # All 64 bits of output are used. 872 set kDataLeft $left 873 set kDataRight $right 874 # Eight messages bytes are needed per iteration. 875 binary scan $message x${m}H8H8 leftTemp rightTemp 876 incr m 8 877 incr chunk 8 878 set msgDataLeft "0x$leftTemp" 879 set msgDataRight "0x$rightTemp" 880 # Mix message bits with crypto bits. 881 set mixDataLeft [expr {$msgDataLeft ^ $kDataLeft}] 882 set mixDataRight [expr {$msgDataRight ^ $kDataRight}] 883 # Move bytes to the temporary holding string. 884 append tempresult \ 885 [binary format H16 \ 886 [format %08x%08x $mixDataLeft $mixDataRight]] 887 # For CFB mode 888 if {$mode == 1} { 889 if {$encrypt} { 890 set left $mixDataLeft 891 set right $mixDataRight 892 } else { 893 set left $msgDataLeft 894 set right $msgDataRight 895 } 896 } 897 } 898 899 #puts "Left final: [format %x $left]"; 900 #puts "Right final: [format %x $right]"; 901 902 if {$chunk >= 512} { 903 append result $tempresult 904 set tempresult {}; 905 set chunk 0; 906 } 907 }; # For every 8 characters, or 64 bits in the message 908 #puts "End: |[format 0x%08x $left]| |[format 0x%08x $right]|" 909 # Save the left and right registers to the feedback vector. 910 set ivec [binary format H* [format %08x $left][format %08x $right]] 911 #puts "Saved Feedback vector: $fbvectors($fbvector)" 912 913 append result $tempresult 914 if {[string length $result] > $len} { 915 set result [string replace $result $len end] 916 } 917 # Return the result as an array 918 return $result 919 }; # End of stream 920 921 variable pc2bytes0 [list 0 0x4 0x20000000 0x20000004 0x10000 0x10004 0x20010000 0x20010004 0x200 0x204 0x20000200 0x20000204 0x10200 0x10204 0x20010200 0x20010204] 922 variable pc2bytes1 [list 0 0x1 0x100000 0x100001 0x4000000 0x4000001 0x4100000 0x4100001 0x100 0x101 0x100100 0x100101 0x4000100 0x4000101 0x4100100 0x4100101] 923 variable pc2bytes2 [list 0 0x8 0x800 0x808 0x1000000 0x1000008 0x1000800 0x1000808 0 0x8 0x800 0x808 0x1000000 0x1000008 0x1000800 0x1000808] 924 variable pc2bytes3 [list 0 0x200000 0x8000000 0x8200000 0x2000 0x202000 0x8002000 0x8202000 0x20000 0x220000 0x8020000 0x8220000 0x22000 0x222000 0x8022000 0x8222000] 925 variable pc2bytes4 [list 0 0x40000 0x10 0x40010 0 0x40000 0x10 0x40010 0x1000 0x41000 0x1010 0x41010 0x1000 0x41000 0x1010 0x41010] 926 variable pc2bytes5 [list 0 0x400 0x20 0x420 0 0x400 0x20 0x420 0x2000000 0x2000400 0x2000020 0x2000420 0x2000000 0x2000400 0x2000020 0x2000420] 927 variable pc2bytes6 [list 0 0x10000000 0x80000 0x10080000 0x2 0x10000002 0x80002 0x10080002 0 0x10000000 0x80000 0x10080000 0x2 0x10000002 0x80002 0x10080002] 928 variable pc2bytes7 [list 0 0x10000 0x800 0x10800 0x20000000 0x20010000 0x20000800 0x20010800 0x20000 0x30000 0x20800 0x30800 0x20020000 0x20030000 0x20020800 0x20030800] 929 variable pc2bytes8 [list 0 0x40000 0 0x40000 0x2 0x40002 0x2 0x40002 0x2000000 0x2040000 0x2000000 0x2040000 0x2000002 0x2040002 0x2000002 0x2040002] 930 variable pc2bytes9 [list 0 0x10000000 0x8 0x10000008 0 0x10000000 0x8 0x10000008 0x400 0x10000400 0x408 0x10000408 0x400 0x10000400 0x408 0x10000408] 931 variable pc2bytes10 [list 0 0x20 0 0x20 0x100000 0x100020 0x100000 0x100020 0x2000 0x2020 0x2000 0x2020 0x102000 0x102020 0x102000 0x102020] 932 variable pc2bytes11 [list 0 0x1000000 0x200 0x1000200 0x200000 0x1200000 0x200200 0x1200200 0x4000000 0x5000000 0x4000200 0x5000200 0x4200000 0x5200000 0x4200200 0x5200200] 933 variable pc2bytes12 [list 0 0x1000 0x8000000 0x8001000 0x80000 0x81000 0x8080000 0x8081000 0x10 0x1010 0x8000010 0x8001010 0x80010 0x81010 0x8080010 0x8081010] 934 variable pc2bytes13 [list 0 0x4 0x100 0x104 0 0x4 0x100 0x104 0x1 0x5 0x101 0x105 0x1 0x5 0x101 0x105] 935 936 # Now define the left shifts which need to be done 937 variable shifts {0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0}; 938 939 # Procedure: createKeys 940 # Input: 941 # key : The 64-bit DES key or the 192-bit 3DES key 942 # (Note: The lsb of each byte is ignored; odd parity 943 # is not required). 944 # 945 # weak: If true then weak keys are allowed. The default is to raise an 946 # error when a weak key is seen. 947 # Output: 948 # The 16 (DES) or 48 (3DES) subkeys. 949 proc createKeys {key {weak 0}} { 950 variable pc2bytes0 951 variable pc2bytes1 952 variable pc2bytes2 953 variable pc2bytes3 954 variable pc2bytes4 955 variable pc2bytes5 956 variable pc2bytes6 957 variable pc2bytes7 958 variable pc2bytes8 959 variable pc2bytes9 960 variable pc2bytes10 961 variable pc2bytes11 962 variable pc2bytes12 963 variable pc2bytes13 964 variable shifts 965 966 # How many iterations (1 for des, 3 for triple des) 967 set iterations [expr {([string length $key] >= 24) ? 3 : 1}]; 968 # Stores the return keys 969 set keys {} 970 # Other variables 971 set lefttemp {}; set righttemp {} 972 set m 0 973 # Either 1 or 3 iterations 974 for {set j 0} {$j < $iterations} {incr j} { 975 binary scan $key x${m}H8H8 lefttemp righttemp 976 set left {} 977 append left "0x" $lefttemp 978 set right {} 979 append right "0x" $righttemp 980 incr m 8 981 982 #puts "Left key: $left" 983 #puts "Right key: $right" 984 985 # Test for weak keys 986 if {! $weak} { 987 set maskedLeft [expr {$left & 0xfefefefe}] 988 set maskedRight [expr {$right & 0xfefefefe}] 989 if {($maskedLeft == 0x00000000) \ 990 && ($maskedRight == 0x00000000)} { 991 error "Key [expr {$j + 1}] is weak!" 992 } elseif {($maskedLeft == 0x1e1e1e1e) \ 993 && ($maskedRight == 0x0e0e0e0e)} { 994 error "Key [expr {$j + 1}] is weak!" 995 } elseif {($maskedLeft == 0xe0e0e0e0) \ 996 && ($maskedRight == 0xf0f0f0f0)} { 997 error "Key [expr {$j + 1}] is weak!" 998 } elseif {($maskedLeft == 0xfefefefe) \ 999 && ($maskedRight == 0xfefefefe)} { 1000 error "Key [expr {$j + 1}] is weak!" 1001 } 1002 } 1003 1004 set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}] 1005 set right [expr {$right ^ $temp}] 1006 set left [expr {$left ^ ($temp << 4)}] 1007 set temp [expr {(($right >> 16) ^ $left) & 0x0000ffff}] 1008 set left [expr {$left ^ $temp}] 1009 set right [expr {$right ^ ($temp << 16)}] 1010 set temp [expr {(($left >> 2) ^ $right) & 0x33333333}] 1011 set right [expr {$right ^ $temp}] 1012 set left [expr {$left ^ ($temp << 2)}] 1013 set temp [expr {(($right >> 16) ^ $left) & 0x0000ffff}] 1014 set left [expr {$left ^ $temp}] 1015 set right [expr {$right ^ ($temp << 16)}] 1016 set temp [expr {(($left >> 1) ^ $right) & 0x55555555}] 1017 set right [expr {$right ^ $temp}] 1018 set left [expr {$left ^ ($temp << 1)}] 1019 set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}] 1020 set left [expr {$left ^ $temp}] 1021 set right [expr {$right ^ ($temp << 8)}] 1022 set temp [expr {(($left >> 1) ^ $right) & 0x55555555}] 1023 set right [expr {$right ^ $temp}] 1024 set left [expr {$left ^ ($temp << 1)}] 1025 1026 #puts "Left key PC1: [format %x $left]" 1027 #puts "Right key PC1: [format %x $right]" 1028 1029 # The right side needs to be shifted and to get 1030 # the last four bits of the left side 1031 set temp [expr {($left << 8) | (($right >> 20) & 0x000000f0)}]; 1032 # Left needs to be put upside down 1033 set left [expr {($right << 24) | (($right << 8) & 0x00ff0000) | \ 1034 (($right >> 8) & 0x0000ff00) \ 1035 | (($right >> 24) & 0x000000f0)}]; 1036 set right $temp; 1037 1038 #puts "Left key juggle: [format %x $left]" 1039 #puts "Right key juggle: [format %x $right]" 1040 1041 # Now go through and perform these 1042 # shifts on the left and right keys. 1043 foreach i $shifts { 1044 # Shift the keys either one or two bits to the left. 1045 if {$i} { 1046 set left [expr {($left << 2) \ 1047 | (($left >> 26) & 0x0000003f)}]; 1048 set right [expr {($right << 2) \ 1049 | (($right >> 26) & 0x0000003f)}]; 1050 } else { 1051 set left [expr {($left << 1) \ 1052 | (($left >> 27) & 0x0000001f)}]; 1053 set right [expr {($right << 1) \ 1054 | (($right >> 27) & 0x0000001f)}]; 1055 } 1056 set left [expr {$left & 0xfffffff0}]; 1057 set right [expr {$right & 0xfffffff0}]; 1058 1059 # Now apply PC-2, in such a way that E is easier when 1060 # encrypting or decrypting this conversion will look like PC-2 1061 # except only the last 6 bits of each byte are used rather than 1062 # 48 consecutive bits and the order of lines will be according 1063 # to how the S selection functions will be applied: S2, S4, S6, 1064 # S8, S1, S3, S5, S7. 1065 set lefttemp [expr {[lindex $pc2bytes0 [expr {($left >> 28) & 0x0000000f}]] | \ 1066 [lindex $pc2bytes1 [expr {($left >> 24) & 0x0000000f}]] | \ 1067 [lindex $pc2bytes2 [expr {($left >> 20) & 0x0000000f}]] | \ 1068 [lindex $pc2bytes3 [expr {($left >> 16) & 0x0000000f}]] | \ 1069 [lindex $pc2bytes4 [expr {($left >> 12) & 0x0000000f}]] | \ 1070 [lindex $pc2bytes5 [expr {($left >> 8) & 0x0000000f}]] | \ 1071 [lindex $pc2bytes6 [expr {($left >> 4) & 0x0000000f}]]}]; 1072 set righttemp [expr {[lindex $pc2bytes7 [expr {($right >> 28) & 0x0000000f}]] | \ 1073 [lindex $pc2bytes8 [expr {($right >> 24) & 0x0000000f}]] | \ 1074 [lindex $pc2bytes9 [expr {($right >> 20) & 0x0000000f}]] | \ 1075 [lindex $pc2bytes10 [expr {($right >> 16) & 0x0000000f}]] | \ 1076 [lindex $pc2bytes11 [expr {($right >> 12) & 0x0000000f}]] | \ 1077 [lindex $pc2bytes12 [expr {($right >> 8) & 0x0000000f}]] | \ 1078 [lindex $pc2bytes13 [expr {($right >> 4) & 0x0000000f}]]}]; 1079 set temp [expr {(($righttemp >> 16) ^ $lefttemp) & 0x0000ffff}]; 1080 lappend keys [expr {$lefttemp ^ $temp}]; 1081 lappend keys [expr {$righttemp ^ ($temp << 16)}]; 1082 } 1083 }; # For each iteration. 1084 # Return the keys we've created. 1085 return $keys; 1086 }; # End of createKeys. 1087}; # End of des namespace eval. 1088 1089package provide tclDES 1.0.0 1090