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